paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 20:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updated

Browse Source
This commit is contained in:
florian 2000-09-20 21:50:59 +00:00
parent d7abdc5840
commit c537853371
1 changed files with 140 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

348
compiler/nadd.pas
View File

@ -30,6 +30,7 @@ interface
taddnode = class(tbinopnode) taddnode = class(tbinopnode)
procedure make_bool_equal_size; procedure make_bool_equal_size;
function firstpass : tnode;override; function firstpass : tnode;override;
procedure make_bool_equal_size;
end; end;
tcaddnode : class of taddnode; tcaddnode : class of taddnode;
@ -40,7 +41,7 @@ interface
{ specific node types can be created } { specific node types can be created }
caddnode : tcaddnode; caddnode : tcaddnode;
function isbinaryoverloaded(var p : ptree) : boolean; function isbinaryoverloaded(var p : pnode) : boolean;
implementation implementation
@ -55,90 +56,9 @@ implementation
hcodegen, hcodegen,
{$endif newcg} {$endif newcg}
htypechk,pass_1, htypechk,pass_1,
cpubase,tccnv cpubase,ncnv,ncal,
; ;
function isbinaryoverloaded(var p : ptree) : boolean;
var
rd,ld : pdef;
t : ptree;
optoken : ttoken;
begin
isbinaryoverloaded:=false;
{ overloaded operator ? }
{ load easier access variables }
rd:=p^.right^.resulttype;
ld:=p^.left^.resulttype;
if isbinaryoperatoroverloadable(ld,rd,voiddef,p^.treetype) then
begin
isbinaryoverloaded:=true;
{!!!!!!!!! handle paras }
case p^.treetype of
{ the nil as symtable signs firstcalln that this is
an overloaded operator }
addn:
optoken:=_PLUS;
subn:
optoken:=_MINUS;
muln:
optoken:=_STAR;
starstarn:
optoken:=_STARSTAR;
slashn:
optoken:=_SLASH;
ltn:
optoken:=tokens._lt;
gtn:
optoken:=tokens._gt;
lten:
optoken:=_lte;
gten:
optoken:=_gte;
equaln,unequaln :
optoken:=_EQUAL;
symdifn :
optoken:=_SYMDIF;
modn :
optoken:=_OP_MOD;
orn :
optoken:=_OP_OR;
xorn :
optoken:=_OP_XOR;
andn :
optoken:=_OP_AND;
divn :
optoken:=_OP_DIV;
shln :
optoken:=_OP_SHL;
shrn :
optoken:=_OP_SHR;
else
exit;
end;
t:=gencallnode(overloaded_operators[optoken],nil);
{ we have to convert p^.left and p^.right into
callparanodes }
if t^.symtableprocentry=nil then
begin
CGMessage(parser_e_operator_not_overloaded);
putnode(t);
end
else
begin
inc(t^.symtableprocentry^.refs);
t^.left:=gencallparanode(p^.left,nil);
t^.left:=gencallparanode(p^.right,t^.left);
if p^.treetype=unequaln then
t:=gensinglenode(notn,t);
firstpass(t);
putnode(p);
p:=t;
end;
end;
end;
{***************************************************************************** {*****************************************************************************
FirstAdd FirstAdd
*****************************************************************************} *****************************************************************************}
@ -150,19 +70,19 @@ implementation
procedure taddnode.make_bool_equal_size; procedure taddnode.make_bool_equal_size;
begin begin
if porddef(left^.resulttype)^.typ>porddef(right^.resulttype)^.typ then if porddef(left.resulttype)^.typ>porddef(right.resulttype)^.typ then
begin begin
right:=gentypeconvnode(right,porddef(left^.resulttype)); right:=gentypeconvnode(right,porddef(left.resulttype));
right^.convtyp:=tc_bool_2_int; right.convtyp:=tc_bool_2_int;
right^.explizit:=true; right.explizit:=true;
firstpass(right); firstpass(right);
end end
else else
if porddef(left^.resulttype)^.typ<porddef(right^.resulttype)^.typ then if porddef(left.resulttype)^.typ<porddef(right.resulttype)^.typ then
begin begin
left:=gentypeconvnode(left,porddef(right^.resulttype)); left:=gentypeconvnode(left,porddef(right.resulttype));
left^.convtyp:=tc_bool_2_int; left.convtyp:=tc_bool_2_int;
left^.explizit:=true; left.explizit:=true;
firstpass(left); firstpass(left);
end; end;
end; end;
@ -170,10 +90,10 @@ implementation
function taddnode.pass_1 : tnode; function taddnode.pass_1 : tnode;
var var
t,hp : ptree; t,hp : tnode;
ot, ot,
lt,rt : ttreetyp; lt,rt : ttreetyp;
rv,lv : TConstExprInt; rv,lv : longint;
rvd,lvd : bestreal; rvd,lvd : bestreal;
resdef, resdef,
rd,ld : pdef; rd,ld : pdef;
@ -198,9 +118,9 @@ implementation
{ convert array constructors to sets, because there is no other operator { convert array constructors to sets, because there is no other operator
possible for array constructors } possible for array constructors }
if is_array_constructor(left^.resulttype) then if is_array_constructor(left.resulttype) then
arrayconstructor_to_set(left); arrayconstructor_to_set(left);
if is_array_constructor(right^.resulttype) then if is_array_constructor(right.resulttype) then
arrayconstructor_to_set(right); arrayconstructor_to_set(right);
{ both left and right need to be valid } { both left and right need to be valid }
@ -208,28 +128,31 @@ implementation
set_varstate(right,true); set_varstate(right,true);
{ load easier access variables } { load easier access variables }
lt:=left^.treetype; lt:=left.treetype;
rt:=right^.treetype; rt:=right.treetype;
rd:=right^.resulttype; rd:=right.resulttype;
ld:=left^.resulttype; ld:=left.resulttype;
convdone:=false; convdone:=false;
if isbinaryoverloaded(p) then if isbinaryoverloaded(hp) then
exit; begin
pass_1:=hp;
exit;
end
{ compact consts } { compact consts }
{ convert int consts to real consts, if the } { convert int consts to real consts, if the }
{ other operand is a real const } { other operand is a real const }
if (rt=realconstn) and is_constintnode(left) then if (rt=realconstn) and is_constintnode(left) then
begin begin
t:=genrealconstnode(left^.value,right^.resulttype); t:=genrealconstnode(left.value,right.resulttype);
disposetree(left); disposetree(left);
left:=t; left:=t;
lt:=realconstn; lt:=realconstn;
end; end;
if (lt=realconstn) and is_constintnode(right) then if (lt=realconstn) and is_constintnode(right) then
begin begin
t:=genrealconstnode(right^.value,left^.resulttype); t:=genrealconstnode(right.value,left.resulttype);
disposetree(right); disposetree(right);
right:=t; right:=t;
rt:=realconstn; rt:=realconstn;
@ -242,20 +165,24 @@ implementation
(is_constboolnode(left) and is_constboolnode(right) and (is_constboolnode(left) and is_constboolnode(right) and
(treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then (treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
begin begin
{ xor, and, or are handled different from arithmetic }
{ operations regarding the result type }
{ return a boolean for boolean operations (and,xor,or) } { return a boolean for boolean operations (and,xor,or) }
if is_constboolnode(left) then if is_constboolnode(left) then
resdef:=booldef resdef:=booldef
else if is_64bitint(rd) or is_64bitint(ld) then
resdef:=cs64bitdef
else else
resdef:=s32bitdef; resdef:=s32bitdef;
lv:=left^.value; lv:=left.value;
rv:=right^.value; rv:=right.value;
case treetype of case treetype of
addn : t:=genordinalconstnode(lv+rv,resdef); addn : t:=genintconstnode(lv+rv);
subn : t:=genordinalconstnode(lv-rv,resdef); subn : t:=genintconstnode(lv-rv);
muln : t:=genordinalconstnode(lv*rv,resdef); muln : t:=genintconstnode(lv*rv);
xorn : t:=genordinalconstnode(lv xor rv,resdef); xorn : t:=genordinalconstnode(lv xor rv,resdef);
orn : t:=genordinalconstnode(lv or rv,resdef); orn: t:=genordinalconstnode(lv or rv,resdef);
andn : t:=genordinalconstnode(lv and rv,resdef); andn: t:=genordinalconstnode(lv and rv,resdef);
ltn : t:=genordinalconstnode(ord(lv<rv),booldef); ltn : t:=genordinalconstnode(ord(lv<rv),booldef);
lten : t:=genordinalconstnode(ord(lv<=rv),booldef); lten : t:=genordinalconstnode(ord(lv<=rv),booldef);
gtn : t:=genordinalconstnode(ord(lv>rv),booldef); gtn : t:=genordinalconstnode(ord(lv>rv),booldef);
@ -276,17 +203,15 @@ implementation
else else
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
firstpass(t); pass_1:=t
{ the caller disposes the old tree }
pass_1:=t;
exit; exit;
end; end;
{ both real constants ? } { both real constants ? }
if (lt=realconstn) and (rt=realconstn) then if (lt=realconstn) and (rt=realconstn) then
begin begin
lvd:=left^.value_real; lvd:=left.value_real;
rvd:=right^.value_real; rvd:=right.value_real;
case treetype of case treetype of
addn : t:=genrealconstnode(lvd+rvd,bestrealdef^); addn : t:=genrealconstnode(lvd+rvd,bestrealdef^);
subn : t:=genrealconstnode(lvd-rvd,bestrealdef^); subn : t:=genrealconstnode(lvd-rvd,bestrealdef^);
@ -322,7 +247,6 @@ implementation
else else
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
firstpass(t);
pass_1:=t; pass_1:=t;
exit; exit;
end; end;
@ -334,8 +258,8 @@ implementation
if (lt=ordconstn) and (rt=ordconstn) and if (lt=ordconstn) and (rt=ordconstn) and
is_char(ld) and is_char(rd) then is_char(ld) and is_char(rd) then
begin begin
s1:=strpnew(char(byte(left^.value))); s1:=strpnew(char(byte(left.value)));
s2:=strpnew(char(byte(right^.value))); s2:=strpnew(char(byte(right.value)));
l1:=1; l1:=1;
l2:=1; l2:=1;
concatstrings:=true; concatstrings:=true;
@ -344,26 +268,26 @@ implementation
if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
begin begin
s1:=getpcharcopy(left); s1:=getpcharcopy(left);
l1:=left^.length; l1:=left.length;
s2:=strpnew(char(byte(right^.value))); s2:=strpnew(char(byte(right.value)));
l2:=1; l2:=1;
concatstrings:=true; concatstrings:=true;
end end
else else
if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
begin begin
s1:=strpnew(char(byte(left^.value))); s1:=strpnew(char(byte(left.value)));
l1:=1; l1:=1;
s2:=getpcharcopy(right); s2:=getpcharcopy(right);
l2:=right^.length; l2:=right.length;
concatstrings:=true; concatstrings:=true;
end end
else if (lt=stringconstn) and (rt=stringconstn) then else if (lt=stringconstn) and (rt=stringconstn) then
begin begin
s1:=getpcharcopy(left); s1:=getpcharcopy(left);
l1:=left^.length; l1:=left.length;
s2:=getpcharcopy(right); s2:=getpcharcopy(right);
l2:=right^.length; l2:=right.length;
concatstrings:=true; concatstrings:=true;
end; end;
@ -388,7 +312,6 @@ implementation
end; end;
ansistringdispose(s1,l1); ansistringdispose(s1,l1);
ansistringdispose(s2,l2); ansistringdispose(s2,l2);
firstpass(t);
pass_1:=t; pass_1:=t;
exit; exit;
end; end;
@ -410,8 +333,8 @@ implementation
xorn,ltn,lten,gtn,gten: xorn,ltn,lten,gtn,gten:
begin begin
make_bool_equal_size(p); make_bool_equal_size(p);
if (left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
(left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
calcregisters(p,2,0,0) calcregisters(p,2,0,0)
else else
calcregisters(p,1,0,0); calcregisters(p,1,0,0);
@ -421,10 +344,10 @@ implementation
begin begin
make_bool_equal_size(p); make_bool_equal_size(p);
{ Remove any compares with constants } { Remove any compares with constants }
if (left^.treetype=ordconstn) then if (left.treetype=ordconstn) then
begin begin
hp:=right; hp:=right;
b:=(left^.value<>0); b:=(left.value<>0);
ot:=treetype; ot:=treetype;
disposetree(left); disposetree(left);
putnode(p); putnode(p);
@ -432,15 +355,15 @@ implementation
if (not(b) and (ot=equaln)) or if (not(b) and (ot=equaln)) or
(b and (ot=unequaln)) then (b and (ot=unequaln)) then
begin begin
p:=gensinglenode(notn,p); p:=gensinglenode(notn,hp);
firstpass(p); firstpass(hp);
end; end;
exit; exit;
end; end;
if (right^.treetype=ordconstn) then if (right.treetype=ordconstn) then
begin begin
hp:=left; hp:=left;
b:=(right^.value<>0); b:=(right.value<>0);
ot:=treetype; ot:=treetype;
disposetree(right); disposetree(right);
putnode(p); putnode(p);
@ -453,8 +376,8 @@ implementation
end; end;
exit; exit;
end; end;
if (left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
(left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
calcregisters(p,2,0,0) calcregisters(p,2,0,0)
else else
calcregisters(p,1,0,0); calcregisters(p,1,0,0);
@ -462,27 +385,34 @@ implementation
else else
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
(*
{ these one can't be in flags! } { these one can't be in flags! }
Yes they can, secondadd converts the loc_flags to a register.
The typeconversions below are simply removed by firsttypeconv()
because the resulttype of left = left.resulttype
(surprise! :) (JM)
if treetype in [xorn,unequaln,equaln] then if treetype in [xorn,unequaln,equaln] then
begin begin
if left^.location.loc=LOC_FLAGS then if left.location.loc=LOC_FLAGS then
begin begin
left:=gentypeconvnode(left,porddef(left^.resulttype)); left:=gentypeconvnode(left,porddef(left.resulttype));
left^.convtyp:=tc_bool_2_int; left.convtyp:=tc_bool_2_int;
left^.explizit:=true; left.explizit:=true;
firstpass(left); firstpass(left);
end; end;
if right^.location.loc=LOC_FLAGS then if right.location.loc=LOC_FLAGS then
begin begin
right:=gentypeconvnode(right,porddef(right^.resulttype)); right:=gentypeconvnode(right,porddef(right.resulttype));
right^.convtyp:=tc_bool_2_int; right.convtyp:=tc_bool_2_int;
right^.explizit:=true; right.explizit:=true;
firstpass(right); firstpass(right);
end; end;
{ readjust registers } { readjust registers }
calcregisters(p,1,0,0); calcregisters(p,1,0,0);
end; end;
*)
convdone:=true; convdone:=true;
end end
else else
@ -579,29 +509,29 @@ implementation
begin begin
{ can we make them both unsigned? } { can we make them both unsigned? }
if (porddef(ld)^.typ in [u8bit,u16bit]) or if (porddef(ld)^.typ in [u8bit,u16bit]) or
(is_constintnode(p^.left) and (is_constintnode(left) and
(p^.treetype <> subn) and (treetype <> subn) and
(p^.left^.value > 0)) then (left.value > 0)) then
p^.left:=gentypeconvnode(p^.left,u32bitdef) left:=gentypeconvnode(left,u32bitdef)
else else
p^.left:=gentypeconvnode(p^.left,s32bitdef); left:=gentypeconvnode(left,s32bitdef);
firstpass(p^.left); firstpass(left);
end end
else {if (porddef(ld)^.typ=u32bit) then} else {if (porddef(ld)^.typ=u32bit) then}
begin begin
{ can we make them both unsigned? } { can we make them both unsigned? }
if (porddef(rd)^.typ in [u8bit,u16bit]) or if (porddef(rd)^.typ in [u8bit,u16bit]) or
(is_constintnode(p^.right) and (is_constintnode(right) and
(p^.right^.value > 0)) then (right.value > 0)) then
p^.right:=gentypeconvnode(p^.right,u32bitdef) right:=gentypeconvnode(right,u32bitdef)
else else
p^.right:=gentypeconvnode(p^.right,s32bitdef); right:=gentypeconvnode(right,s32bitdef);
firstpass(p^.right); firstpass(right);
end; end;
{$endif cardinalmulfix} {$endif cardinalmulfix}
calcregisters(p,1,0,0); calcregisters(p,1,0,0);
{ for unsigned mul we need an extra register } { for unsigned mul we need an extra register }
{ registers32:=left^.registers32+right^.registers32; } { registers32:=left.registers32+right.registers32; }
if treetype=muln then if treetype=muln then
inc(registers32); inc(registers32);
convdone:=true; convdone:=true;
@ -640,14 +570,14 @@ implementation
{ ranges require normsets } { ranges require normsets }
if (psetdef(ld)^.settype=smallset) and if (psetdef(ld)^.settype=smallset) and
(rt=setelementn) and (rt=setelementn) and
assigned(right^.right) then assigned(right.right) then
begin begin
{ generate a temporary normset def } { generate a temporary normset def, it'll be destroyed
when the symtable is unloaded }
tempdef:=new(psetdef,init(psetdef(ld)^.elementtype.def,255)); tempdef:=new(psetdef,init(psetdef(ld)^.elementtype.def,255));
left:=gentypeconvnode(left,tempdef); left:=gentypeconvnode(left,tempdef);
firstpass(left); firstpass(left);
dispose(tempdef,done); ld:=left.resulttype;
ld:=left^.resulttype;
end; end;
{ if the destination is not a smallset then insert a typeconv { if the destination is not a smallset then insert a typeconv
@ -655,54 +585,54 @@ implementation
if (psetdef(ld)^.settype<>smallset) and if (psetdef(ld)^.settype<>smallset) and
(psetdef(rd)^.settype=smallset) then (psetdef(rd)^.settype=smallset) then
begin begin
if (right^.treetype=setconstn) then if (right.treetype=setconstn) then
begin begin
t:=gensetconstnode(right^.value_set,psetdef(left^.resulttype)); t:=gensetconstnode(right.value_set,psetdef(left.resulttype));
t^.left:=right^.left; t^.left:=right.left;
putnode(right); putnode(right);
right:=t; right:=t;
end end
else else
right:=gentypeconvnode(right,psetdef(left^.resulttype)); right:=gentypeconvnode(right,psetdef(left.resulttype));
firstpass(right); firstpass(right);
end; end;
{ do constant evaluation } { do constant evaluation }
if (right^.treetype=setconstn) and if (right.treetype=setconstn) and
not assigned(right^.left) and not assigned(right.left) and
(left^.treetype=setconstn) and (left.treetype=setconstn) and
not assigned(left^.left) then not assigned(left.left) then
begin begin
new(resultset); new(resultset);
case treetype of case treetype of
addn : begin addn : begin
for i:=0 to 31 do for i:=0 to 31 do
resultset^[i]:= resultset^[i]:=
right^.value_set^[i] or left^.value_set^[i]; right.value_set^[i] or left.value_set^[i];
t:=gensetconstnode(resultset,psetdef(ld)); t:=gensetconstnode(resultset,psetdef(ld));
end; end;
muln : begin muln : begin
for i:=0 to 31 do for i:=0 to 31 do
resultset^[i]:= resultset^[i]:=
right^.value_set^[i] and left^.value_set^[i]; right.value_set^[i] and left.value_set^[i];
t:=gensetconstnode(resultset,psetdef(ld)); t:=gensetconstnode(resultset,psetdef(ld));
end; end;
subn : begin subn : begin
for i:=0 to 31 do for i:=0 to 31 do
resultset^[i]:= resultset^[i]:=
left^.value_set^[i] and not(right^.value_set^[i]); left.value_set^[i] and not(right.value_set^[i]);
t:=gensetconstnode(resultset,psetdef(ld)); t:=gensetconstnode(resultset,psetdef(ld));
end; end;
symdifn : begin symdifn : begin
for i:=0 to 31 do for i:=0 to 31 do
resultset^[i]:= resultset^[i]:=
left^.value_set^[i] xor right^.value_set^[i]; left.value_set^[i] xor right.value_set^[i];
t:=gensetconstnode(resultset,psetdef(ld)); t:=gensetconstnode(resultset,psetdef(ld));
end; end;
unequaln : begin unequaln : begin
b:=true; b:=true;
for i:=0 to 31 do for i:=0 to 31 do
if right^.value_set^[i]=left^.value_set^[i] then if right.value_set^[i]=left.value_set^[i] then
begin begin
b:=false; b:=false;
break; break;
@ -712,7 +642,7 @@ implementation
equaln : begin equaln : begin
b:=true; b:=true;
for i:=0 to 31 do for i:=0 to 31 do
if right^.value_set^[i]<>left^.value_set^[i] then if right.value_set^[i]<>left.value_set^[i] then
begin begin
b:=false; b:=false;
break; break;
@ -723,8 +653,8 @@ implementation
lten : Begin lten : Begin
b := true; b := true;
For i := 0 to 31 Do For i := 0 to 31 Do
If (right^.value_set^[i] And left^.value_set^[i]) <> If (right.value_set^[i] And left.value_set^[i]) <>
left^.value_set^[i] Then left.value_set^[i] Then
Begin Begin
b := false; b := false;
Break Break
@ -734,8 +664,8 @@ implementation
gten : Begin gten : Begin
b := true; b := true;
For i := 0 to 31 Do For i := 0 to 31 Do
If (left^.value_set^[i] And right^.value_set^[i]) <> If (left.value_set^[i] And right.value_set^[i]) <>
right^.value_set^[i] Then right.value_set^[i] Then
Begin Begin
b := false; b := false;
Break Break
@ -754,7 +684,7 @@ implementation
if psetdef(ld)^.settype=smallset then if psetdef(ld)^.settype=smallset then
begin begin
{ are we adding set elements ? } { are we adding set elements ? }
if right^.treetype=setelementn then if right.treetype=setelementn then
calcregisters(p,2,0,0) calcregisters(p,2,0,0)
else else
calcregisters(p,1,0,0); calcregisters(p,1,0,0);
@ -848,9 +778,9 @@ implementation
end; end;
{ only if there is a type cast we need to do again } { only if there is a type cast we need to do again }
{ the first pass } { the first pass }
if left^.treetype=typeconvn then if left.treetype=typeconvn then
firstpass(left); firstpass(left);
if right^.treetype=typeconvn then if right.treetype=typeconvn then
firstpass(right); firstpass(right);
{ here we call STRCONCAT or STRCMP or STRCOPY } { here we call STRCONCAT or STRCMP or STRCOPY }
procinfo^.flags:=procinfo^.flags or pi_do_call; procinfo^.flags:=procinfo^.flags or pi_do_call;
@ -908,12 +838,12 @@ implementation
case treetype of case treetype of
equaln,unequaln : equaln,unequaln :
begin begin
if is_equal(right^.resulttype,voidpointerdef) then if is_equal(right.resulttype,voidpointerdef) then
begin begin
right:=gentypeconvnode(right,ld); right:=gentypeconvnode(right,ld);
firstpass(right); firstpass(right);
end end
else if is_equal(left^.resulttype,voidpointerdef) then else if is_equal(left.resulttype,voidpointerdef) then
begin begin
left:=gentypeconvnode(left,rd); left:=gentypeconvnode(left,rd);
firstpass(left); firstpass(left);
@ -923,12 +853,12 @@ implementation
end; end;
ltn,lten,gtn,gten: ltn,lten,gtn,gten:
begin begin
if is_equal(right^.resulttype,voidpointerdef) then if is_equal(right.resulttype,voidpointerdef) then
begin begin
right:=gentypeconvnode(right,ld); right:=gentypeconvnode(right,ld);
firstpass(right); firstpass(right);
end end
else if is_equal(left^.resulttype,voidpointerdef) then else if is_equal(left.resulttype,voidpointerdef) then
begin begin
left:=gentypeconvnode(left,rd); left:=gentypeconvnode(left,rd);
firstpass(left); firstpass(left);
@ -1075,7 +1005,7 @@ implementation
; ;
{ mul is a little bit restricted } { mul is a little bit restricted }
muln: muln:
if not(mmx_type(left^.resulttype) in if not(mmx_type(left.resulttype) in
[mmxu16bit,mmxs16bit,mmxfixed16]) then [mmxu16bit,mmxs16bit,mmxfixed16]) then
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
else else
@ -1200,9 +1130,9 @@ implementation
firstpass(right); firstpass(right);
{ maybe we need an integer register to save } { maybe we need an integer register to save }
{ a reference } { a reference }
if ((left^.location.loc<>LOC_FPU) or if ((left.location.loc<>LOC_FPU) or
(right^.location.loc<>LOC_FPU)) and (right.location.loc<>LOC_FPU)) and
(left^.registers32=right^.registers32) then (left.registers32=right.registers32) then
calcregisters(p,1,1,0) calcregisters(p,1,1,0)
else else
calcregisters(p,0,1,0); calcregisters(p,0,1,0);
@ -1233,7 +1163,7 @@ implementation
if (not assigned(resulttype)) or if (not assigned(resulttype)) or
(resulttype^.deftype=stringdef) then (resulttype^.deftype=stringdef) then
resulttype:=booldef; resulttype:=booldef;
if is_64bitint(left^.resulttype) then if is_64bitint(left.resulttype) then
location.loc:=LOC_JUMP location.loc:=LOC_JUMP
else else
location.loc:=LOC_FLAGS; location.loc:=LOC_FLAGS;
@ -1241,7 +1171,7 @@ implementation
xorn: xorn:
begin begin
if not assigned(resulttype) then if not assigned(resulttype) then
resulttype:=left^.resulttype; resulttype:=left.resulttype;
location.loc:=LOC_REGISTER; location.loc:=LOC_REGISTER;
end; end;
addn: addn:
@ -1249,10 +1179,10 @@ implementation
if not assigned(resulttype) then if not assigned(resulttype) then
begin begin
{ for strings, return is always a 255 char string } { for strings, return is always a 255 char string }
if is_shortstring(left^.resulttype) then if is_shortstring(left.resulttype) then
resulttype:=cshortstringdef resulttype:=cshortstringdef
else else
resulttype:=left^.resulttype; resulttype:=left.resulttype;
end; end;
end; end;
{$ifdef cardinalmulfix} {$ifdef cardinalmulfix}
@ -1260,32 +1190,32 @@ implementation
{ if we multiply an unsigned with a signed number, the result is signed } { if we multiply an unsigned with a signed number, the result is signed }
{ in the other cases, the result remains signed or unsigned depending on } { in the other cases, the result remains signed or unsigned depending on }
{ the multiplication factors (JM) } { the multiplication factors (JM) }
if (left^.resulttype^.deftype = orddef) and if (left.resulttype^.deftype = orddef) and
(right^.resulttype^.deftype = orddef) and (right.resulttype^.deftype = orddef) and
is_signed(right^.resulttype) then is_signed(right.resulttype) then
resulttype := right^.resulttype resulttype := right.resulttype
else resulttype := left^.resulttype; else resulttype := left.resulttype;
(* (*
subn: subn:
{ if we substract a u32bit from a positive constant, the result becomes } { if we substract a u32bit from a positive constant, the result becomes }
{ s32bit as well (JM) } { s32bit as well (JM) }
begin begin
if (right^.resulttype^.deftype = orddef) and if (right.resulttype^.deftype = orddef) and
(left^.resulttype^.deftype = orddef) and (left.resulttype^.deftype = orddef) and
(porddef(right^.resulttype)^.typ = u32bit) and (porddef(right.resulttype)^.typ = u32bit) and
is_constintnode(left) and is_constintnode(left) and
{ (porddef(left^.resulttype)^.typ <> u32bit) and} { (porddef(left.resulttype)^.typ <> u32bit) and}
(left^.value > 0) then (left.value > 0) then
begin begin
left := gentypeconvnode(left,u32bitdef); left := gentypeconvnode(left,u32bitdef);
firstpass(left); firstpass(left);
end; end;
resulttype:=left^.resulttype; resulttype:=left.resulttype;
end; end;
*) *)
{$endif cardinalmulfix} {$endif cardinalmulfix}
else else
resulttype:=left^.resulttype; resulttype:=left.resulttype;
end; end;
end; end;
@ -1294,10 +1224,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-08-29 08:24:45 jonas Revision 1.3 2000-09-20 21:50:59 florian
* updated
Revision 1.2 2000/08/29 08:24:45 jonas
* some modifications to -dcardinalmulfix code * some modifications to -dcardinalmulfix code
Revision 1.1 2000/08/26 12:24:20 florian Revision 1.1 2000/08/26 12:24:20 florian
* initial release * initial release
} }