mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 18:06:12 +02:00
* qword division fixed
+ code for qword/int64 type casting added:
range checking isn't implemented yet
This commit is contained in:
florian
parent
c93ebedcb3
commit
0fa46763ad
@ -175,7 +175,10 @@ implementation
|
||||
var
|
||||
op : tasmop;
|
||||
opsize : topsize;
|
||||
hregister : tregister;
|
||||
hregister,
|
||||
hregister2 : tregister;
|
||||
l : pasmlabel;
|
||||
|
||||
begin
|
||||
{ insert range check if not explicit conversion }
|
||||
if not(pto^.explizit) then
|
||||
@ -192,6 +195,9 @@ implementation
|
||||
2 : pto^.location.register:=makereg16(pfrom^.location.register);
|
||||
4 : pto^.location.register:=makereg32(pfrom^.location.register);
|
||||
end;
|
||||
{ we can release the upper register }
|
||||
if is_64bitint(pfrom^.resulttype) then
|
||||
ungetregister32(pfrom^.location.registerhigh);
|
||||
end;
|
||||
end
|
||||
|
||||
@ -206,11 +212,14 @@ implementation
|
||||
ungetiftemp(pfrom^.location.reference);
|
||||
end;
|
||||
|
||||
{ get op and opsize, handle separate for constants, becuase
|
||||
{ get op and opsize, handle separate for constants, because
|
||||
movz doesn't support constant values }
|
||||
if (pfrom^.location.loc=LOC_MEM) and (pfrom^.location.reference.is_immediate) then
|
||||
begin
|
||||
opsize:=def_opsize(pto^.resulttype);
|
||||
if is_64bitint(pto^.resulttype) then
|
||||
opsize:=S_L
|
||||
else
|
||||
opsize:=def_opsize(pto^.resulttype);
|
||||
op:=A_MOV;
|
||||
end
|
||||
else
|
||||
@ -229,13 +238,24 @@ implementation
|
||||
hregister:=getregister32
|
||||
else
|
||||
hregister:=pfrom^.location.register;
|
||||
|
||||
{ set the correct register size and location }
|
||||
clear_location(pto^.location);
|
||||
pto^.location.loc:=LOC_REGISTER;
|
||||
|
||||
{ do we need a second register for a 64 bit type ? }
|
||||
if is_64bitint(pto^.resulttype) then
|
||||
begin
|
||||
hregister2:=getregister32;
|
||||
pto^.location.registerhigh:=hregister2;
|
||||
end;
|
||||
case pto^.resulttype^.size of
|
||||
1 : pto^.location.register:=makereg8(hregister);
|
||||
2 : pto^.location.register:=makereg16(hregister);
|
||||
4 : pto^.location.register:=makereg32(hregister);
|
||||
1:
|
||||
pto^.location.register:=makereg8(hregister);
|
||||
2:
|
||||
pto^.location.register:=makereg16(hregister);
|
||||
4,8:
|
||||
pto^.location.register:=makereg32(hregister);
|
||||
end;
|
||||
{ insert the assembler code }
|
||||
if pfrom^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
|
||||
@ -243,6 +263,23 @@ implementation
|
||||
else
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
|
||||
newreference(pfrom^.location.reference),pto^.location.register)));
|
||||
|
||||
{ do we need a sign extension for int64? }
|
||||
if is_64bitint(pto^.resulttype) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,
|
||||
hregister2,hregister2)));
|
||||
if (porddef(pto^.resulttype)^.typ=s64bitint) then
|
||||
begin
|
||||
getlabel(l);
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L,
|
||||
$80000000,hregister)));
|
||||
emitjmp(C_Z,l);
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,
|
||||
hregister2)));
|
||||
emitlab(l);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1300,7 +1337,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.75 1999-05-31 20:35:46 peter
|
||||
Revision 1.76 1999-06-28 22:29:10 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.75 1999/05/31 20:35:46 peter
|
||||
* ansistring fixes, decr_ansistr called after all temp ansi reuses
|
||||
|
||||
Revision 1.74 1999/05/27 19:44:09 peter
|
||||
|
||||
@ -473,12 +473,22 @@ implementation
|
||||
1 : opsize:=S_B;
|
||||
2 : opsize:=S_W;
|
||||
4 : opsize:=S_L;
|
||||
{ S_L is correct, the copy is done }
|
||||
{ with two moves }
|
||||
8 : opsize:=S_L;
|
||||
end;
|
||||
if loc=LOC_CREGISTER then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(p^.right^.location.reference),
|
||||
p^.left^.location.register)));
|
||||
if is_64bitint(p^.right^.resulttype) then
|
||||
begin
|
||||
r:=newreference(p^.right^.location.reference);
|
||||
inc(r^.offset,4);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,r,
|
||||
p^.left^.location.registerhigh)));
|
||||
end;
|
||||
{$IfDef regallocfix}
|
||||
del_reference(p^.right^.location.reference);
|
||||
{$EndIf regallocfix}
|
||||
@ -488,6 +498,13 @@ implementation
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
|
||||
p^.right^.location.reference.offset,
|
||||
newreference(p^.left^.location.reference))));
|
||||
if is_64bitint(p^.right^.resulttype) then
|
||||
begin
|
||||
r:=newreference(p^.left^.location.reference);
|
||||
inc(r^.offset,4);
|
||||
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
|
||||
0,r)));
|
||||
end;
|
||||
{$IfDef regallocfix}
|
||||
del_reference(p^.left^.location.reference);
|
||||
{$EndIf regallocfix}
|
||||
@ -835,7 +852,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.60 1999-05-31 12:42:43 peter
|
||||
Revision 1.61 1999-06-28 22:29:11 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.60 1999/05/31 12:42:43 peter
|
||||
* fixed crash with empty array constructor
|
||||
|
||||
Revision 1.59 1999/05/27 19:44:14 peter
|
||||
|
||||
@ -81,10 +81,6 @@ implementation
|
||||
pushusedregisters(pushedreg,$ff
|
||||
and not($80 shr byte(p^.location.registerlow))
|
||||
and not($80 shr byte(p^.location.registerhigh)));
|
||||
if cs_check_overflow in aktlocalswitches then
|
||||
push_int(1)
|
||||
else
|
||||
push_int(0);
|
||||
{ the left operand is in hloc, because the
|
||||
location of left is p^.location but p^.location
|
||||
is already destroyed
|
||||
@ -934,7 +930,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 1999-06-02 10:11:44 florian
|
||||
Revision 1.27 1999-06-28 22:29:14 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.26 1999/06/02 10:11:44 florian
|
||||
* make cycle fixed i.e. compilation with 0.99.10
|
||||
* some fixes for qword
|
||||
* start of register calling conventions
|
||||
|
||||
@ -165,6 +165,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
1 : o1:=S_B;
|
||||
2 : o1:=S_W;
|
||||
4 : o1:=S_L;
|
||||
{ I don't know if we need it (FK) }
|
||||
8 : o1:=S_L;
|
||||
else
|
||||
internalerror(78);
|
||||
end;
|
||||
@ -178,12 +180,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
else
|
||||
o1:=S_W;
|
||||
end;
|
||||
4 : begin
|
||||
case o1 of
|
||||
S_B : o1:=S_BL;
|
||||
S_W : o1:=S_WL;
|
||||
end;
|
||||
end;
|
||||
4,8:
|
||||
begin
|
||||
case o1 of
|
||||
S_B : o1:=S_BL;
|
||||
S_W : o1:=S_WL;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
def2def_opsize:=o1;
|
||||
@ -1680,6 +1683,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
emitlab(hl);
|
||||
end;
|
||||
|
||||
{ produces range check code, while one of the operands is a 64 bit
|
||||
integer }
|
||||
procedure emitrangecheck64(p : ptree;todef : pdef);
|
||||
|
||||
begin
|
||||
internalerror(28699);
|
||||
end;
|
||||
|
||||
{ produces if necessary rangecheckcode }
|
||||
procedure emitrangecheck(p:ptree;todef:pdef);
|
||||
@ -1711,7 +1721,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
{ only check when assigning to scalar, subranges are different,
|
||||
when todef=fromdef then the check is always generated }
|
||||
fromdef:=p^.resulttype;
|
||||
{we also need lto and hto when checking if we need to use doublebound!
|
||||
if is_64bitint(fromdef) or is_64bitint(todef) then
|
||||
begin
|
||||
emitrangecheck64(p,todef);
|
||||
exit;
|
||||
end;
|
||||
{we also need lto and hto when checking if we need to use doublebound!
|
||||
(JM)}
|
||||
getrange(todef,lto,hto);
|
||||
if todef<>fromdef then
|
||||
@ -3088,7 +3103,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 1999-06-17 13:19:50 pierre
|
||||
Revision 1.8 1999-06-28 22:29:15 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.7 1999/06/17 13:19:50 pierre
|
||||
* merged from 0_99_12 branch
|
||||
|
||||
Revision 1.5.2.2 1999/06/17 12:38:39 pierre
|
||||
|
||||
@ -256,7 +256,7 @@ const msgtxt : array[0..000097,1..240] of char=(
|
||||
'lowed'#000+
|
||||
'W_Label not defined $1'#000+
|
||||
'E_Illegal label declaration'#000+
|
||||
'E_GOTO und LABEL are not supported (use switch -Sg)'#000+
|
||||
'E_GOTO and LABEL are not supported (use switch -Sg)'#000+
|
||||
'E_Label not found'#000+
|
||||
'E_identifier isn'#039't a label'#000+
|
||||
'E_label already defined'#000+
|
||||
|
||||
@ -241,13 +241,13 @@ implementation
|
||||
|
||||
procedure first_int_to_int(var p : ptree);
|
||||
begin
|
||||
if (p^.registers32=0) and
|
||||
(p^.left^.location.loc<>LOC_REGISTER) and
|
||||
if (p^.left^.location.loc<>LOC_REGISTER) and
|
||||
(p^.resulttype^.size>p^.left^.resulttype^.size) then
|
||||
begin
|
||||
p^.registers32:=1;
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
end;
|
||||
if is_64bitint(p^.resulttype) then
|
||||
p^.registers32:=max(p^.registers32,2)
|
||||
else
|
||||
p^.registers32:=max(p^.registers32,1);
|
||||
end;
|
||||
|
||||
|
||||
@ -924,7 +924,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 1999-06-28 19:30:07 peter
|
||||
Revision 1.40 1999-06-28 22:29:21 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.39 1999/06/28 19:30:07 peter
|
||||
* merged
|
||||
|
||||
Revision 1.35.2.5 1999/06/28 19:07:47 peter
|
||||
|
||||
@ -342,7 +342,7 @@ implementation
|
||||
case def^.deftype of
|
||||
orddef : begin
|
||||
dt:=porddef(def)^.typ;
|
||||
is_signed:=(dt in [s8bit,s16bit,s32bit]);
|
||||
is_signed:=(dt in [s8bit,s16bit,s32bit,s64bitint]);
|
||||
end;
|
||||
enumdef : is_signed:=false;
|
||||
else
|
||||
@ -531,45 +531,62 @@ implementation
|
||||
procedure testrange(def : pdef;var l : longint);
|
||||
var
|
||||
lv,hv: longint;
|
||||
|
||||
begin
|
||||
getrange(def,lv,hv);
|
||||
if (def^.deftype=orddef) and
|
||||
(porddef(def)^.typ=u32bit) then
|
||||
{ for 64 bit types we need only to check if it is less than }
|
||||
{ zero, if def is a qword node }
|
||||
if is_64bitint(def) then
|
||||
begin
|
||||
if lv<=hv then
|
||||
if (l<0) and (porddef(def)^.typ=u64bit) then
|
||||
begin
|
||||
if (l<lv) or (l>hv) then
|
||||
begin
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
end;
|
||||
end
|
||||
else
|
||||
{ this happens with the wrap around problem }
|
||||
{ if lv is positive and hv is over $7ffffff }
|
||||
{ so it seems negative }
|
||||
begin
|
||||
if ((l>=0) and (l<lv)) or
|
||||
((l<0) and (l>hv)) then
|
||||
begin
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
end;
|
||||
l:=0;
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
end;
|
||||
end
|
||||
else if (l<lv) or (l>hv) then
|
||||
else
|
||||
begin
|
||||
if (def^.deftype=enumdef) or
|
||||
(cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
{ Fix the value to be in range }
|
||||
l:=lv+(l mod (hv-lv+1));
|
||||
getrange(def,lv,hv);
|
||||
if (def^.deftype=orddef) and
|
||||
(porddef(def)^.typ=u32bit) then
|
||||
begin
|
||||
if lv<=hv then
|
||||
begin
|
||||
if (l<lv) or (l>hv) then
|
||||
begin
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
end;
|
||||
end
|
||||
else
|
||||
{ this happens with the wrap around problem }
|
||||
{ if lv is positive and hv is over $7ffffff }
|
||||
{ so it seems negative }
|
||||
begin
|
||||
if ((l>=0) and (l<lv)) or
|
||||
((l<0) and (l>hv)) then
|
||||
begin
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if (l<lv) or (l>hv) then
|
||||
begin
|
||||
if (def^.deftype=enumdef) or
|
||||
(cs_check_range in aktlocalswitches) then
|
||||
Message(parser_e_range_check_error)
|
||||
else
|
||||
Message(parser_w_range_check_error);
|
||||
{ Fix the value to be in range }
|
||||
l:=lv+(l mod (hv-lv+1));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -930,7 +947,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.72 1999-06-13 22:41:08 peter
|
||||
Revision 1.73 1999-06-28 22:29:22 florian
|
||||
* qword division fixed
|
||||
+ code for qword/int64 type casting added:
|
||||
range checking isn't implemented yet
|
||||
|
||||
Revision 1.72 1999/06/13 22:41:08 peter
|
||||
* merged from fixes
|
||||
|
||||
Revision 1.71.2.1 1999/06/13 22:37:17 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user