|
@@ -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^.convtyp:=tc_bool_2_int;
|
|
|
|
|
- right^.explizit:=true;
|
|
|
|
|
|
|
+ right:=gentypeconvnode(right,porddef(left.resulttype));
|
|
|
|
|
+ right.convtyp:=tc_bool_2_int;
|
|
|
|
|
+ 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^.convtyp:=tc_bool_2_int;
|
|
|
|
|
- left^.explizit:=true;
|
|
|
|
|
|
|
+ left:=gentypeconvnode(left,porddef(right.resulttype));
|
|
|
|
|
+ left.convtyp:=tc_bool_2_int;
|
|
|
|
|
+ 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;
|
|
|
|
|
- rt:=right^.treetype;
|
|
|
|
|
- rd:=right^.resulttype;
|
|
|
|
|
- ld:=left^.resulttype;
|
|
|
|
|
|
|
+ lt:=left.treetype;
|
|
|
|
|
+ rt:=right.treetype;
|
|
|
|
|
+ rd:=right.resulttype;
|
|
|
|
|
+ ld:=left.resulttype;
|
|
|
convdone:=false;
|
|
convdone:=false;
|
|
|
|
|
|
|
|
- if isbinaryoverloaded(p) then
|
|
|
|
|
- exit;
|
|
|
|
|
|
|
+ if isbinaryoverloaded(hp) then
|
|
|
|
|
+ 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;
|
|
|
|
|
- lv:=left^.value;
|
|
|
|
|
- rv:=right^.value;
|
|
|
|
|
|
|
+ resdef:=s32bitdef;
|
|
|
|
|
+ lv:=left.value;
|
|
|
|
|
+ rv:=right.value;
|
|
|
case treetype of
|
|
case treetype of
|
|
|
- addn : t:=genordinalconstnode(lv+rv,resdef);
|
|
|
|
|
- subn : t:=genordinalconstnode(lv-rv,resdef);
|
|
|
|
|
- muln : t:=genordinalconstnode(lv*rv,resdef);
|
|
|
|
|
|
|
+ addn : t:=genintconstnode(lv+rv);
|
|
|
|
|
+ subn : t:=genintconstnode(lv-rv);
|
|
|
|
|
+ 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);
|
|
|
|
|
- andn : t:=genordinalconstnode(lv and rv,resdef);
|
|
|
|
|
|
|
+ orn: t:=genordinalconstnode(lv or 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);
|
|
|
|
|
- { the caller disposes the old tree }
|
|
|
|
|
- pass_1:=t;
|
|
|
|
|
|
|
+ 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;
|
|
|
|
|
- rvd:=right^.value_real;
|
|
|
|
|
|
|
+ lvd:=left.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)));
|
|
|
|
|
- s2:=strpnew(char(byte(right^.value)));
|
|
|
|
|
|
|
+ s1:=strpnew(char(byte(left.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;
|
|
|
|
|
- s2:=strpnew(char(byte(right^.value)));
|
|
|
|
|
|
|
+ l1:=left.length;
|
|
|
|
|
+ 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
|
|
|
|
|
- (left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
|
|
|
|
|
|
|
+ if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
|
|
|
|
|
+ (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);
|
|
|
|
|
- firstpass(p);
|
|
|
|
|
|
|
+ p:=gensinglenode(notn,hp);
|
|
|
|
|
+ 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
|
|
|
|
|
- (left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
|
|
|
|
|
|
|
+ if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
|
|
|
|
|
+ (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^.convtyp:=tc_bool_2_int;
|
|
|
|
|
- left^.explizit:=true;
|
|
|
|
|
|
|
+ left:=gentypeconvnode(left,porddef(left.resulttype));
|
|
|
|
|
+ left.convtyp:=tc_bool_2_int;
|
|
|
|
|
+ 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^.convtyp:=tc_bool_2_int;
|
|
|
|
|
- right^.explizit:=true;
|
|
|
|
|
|
|
+ right:=gentypeconvnode(right,porddef(right.resulttype));
|
|
|
|
|
+ right.convtyp:=tc_bool_2_int;
|
|
|
|
|
+ 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
|
|
|
|
|
- (p^.treetype <> subn) and
|
|
|
|
|
- (p^.left^.value > 0)) then
|
|
|
|
|
- p^.left:=gentypeconvnode(p^.left,u32bitdef)
|
|
|
|
|
|
|
+ (is_constintnode(left) and
|
|
|
|
|
+ (treetype <> subn) and
|
|
|
|
|
+ (left.value > 0)) then
|
|
|
|
|
+ left:=gentypeconvnode(left,u32bitdef)
|
|
|
else
|
|
else
|
|
|
- p^.left:=gentypeconvnode(p^.left,s32bitdef);
|
|
|
|
|
- firstpass(p^.left);
|
|
|
|
|
|
|
+ left:=gentypeconvnode(left,s32bitdef);
|
|
|
|
|
+ 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
|
|
|
|
|
- (p^.right^.value > 0)) then
|
|
|
|
|
- p^.right:=gentypeconvnode(p^.right,u32bitdef)
|
|
|
|
|
|
|
+ (is_constintnode(right) and
|
|
|
|
|
+ (right.value > 0)) then
|
|
|
|
|
+ right:=gentypeconvnode(right,u32bitdef)
|
|
|
else
|
|
else
|
|
|
- p^.right:=gentypeconvnode(p^.right,s32bitdef);
|
|
|
|
|
- firstpass(p^.right);
|
|
|
|
|
|
|
+ right:=gentypeconvnode(right,s32bitdef);
|
|
|
|
|
+ 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^.left:=right^.left;
|
|
|
|
|
|
|
+ t:=gensetconstnode(right.value_set,psetdef(left.resulttype));
|
|
|
|
|
+ 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
|
|
|
|
|
- not assigned(right^.left) and
|
|
|
|
|
- (left^.treetype=setconstn) and
|
|
|
|
|
- not assigned(left^.left) then
|
|
|
|
|
|
|
+ if (right.treetype=setconstn) and
|
|
|
|
|
+ not assigned(right.left) and
|
|
|
|
|
+ (left.treetype=setconstn) and
|
|
|
|
|
+ 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]) <>
|
|
|
|
|
- left^.value_set^[i] Then
|
|
|
|
|
|
|
+ If (right.value_set^[i] And left.value_set^[i]) <>
|
|
|
|
|
+ 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]) <>
|
|
|
|
|
- right^.value_set^[i] Then
|
|
|
|
|
|
|
+ If (left.value_set^[i] And right.value_set^[i]) <>
|
|
|
|
|
+ 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
|
|
|
|
|
- (right^.location.loc<>LOC_FPU)) and
|
|
|
|
|
- (left^.registers32=right^.registers32) then
|
|
|
|
|
|
|
+ if ((left.location.loc<>LOC_FPU) or
|
|
|
|
|
+ (right.location.loc<>LOC_FPU)) and
|
|
|
|
|
+ (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
|
|
|
|
|
- (right^.resulttype^.deftype = orddef) and
|
|
|
|
|
- is_signed(right^.resulttype) then
|
|
|
|
|
- resulttype := right^.resulttype
|
|
|
|
|
- else resulttype := left^.resulttype;
|
|
|
|
|
|
|
+ if (left.resulttype^.deftype = orddef) and
|
|
|
|
|
+ (right.resulttype^.deftype = orddef) and
|
|
|
|
|
+ is_signed(right.resulttype) then
|
|
|
|
|
+ resulttype := right.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
|
|
|
|
|
- (left^.resulttype^.deftype = orddef) and
|
|
|
|
|
- (porddef(right^.resulttype)^.typ = u32bit) and
|
|
|
|
|
|
|
+ if (right.resulttype^.deftype = orddef) and
|
|
|
|
|
+ (left.resulttype^.deftype = orddef) and
|
|
|
|
|
+ (porddef(right.resulttype)^.typ = u32bit) and
|
|
|
is_constintnode(left) and
|
|
is_constintnode(left) and
|
|
|
-{ (porddef(left^.resulttype)^.typ <> u32bit) and}
|
|
|
|
|
- (left^.value > 0) then
|
|
|
|
|
|
|
+{ (porddef(left.resulttype)^.typ <> u32bit) and}
|
|
|
|
|
+ (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
|
|
|
-
|
|
|
|
|
}
|
|
}
|
florian