mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 14:51:35 +01:00
1786 lines
69 KiB
ObjectPascal
1786 lines
69 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
Type checking and register allocation for add nodes
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit nadd;
|
|
|
|
{$i defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node;
|
|
|
|
type
|
|
taddnode = class(tbinopnode)
|
|
constructor create(tt : tnodetype;l,r : tnode);override;
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
protected
|
|
{ override the following if you want to implement }
|
|
{ parts explicitely in the code generator (JM) }
|
|
function first_addstring: tnode; virtual;
|
|
function first_addset: tnode; virtual;
|
|
{ only implements "muln" nodes, the rest always has to be done in }
|
|
{ the code generator for performance reasons (JM) }
|
|
function first_add64bitint: tnode; virtual;
|
|
end;
|
|
taddnodeclass = class of taddnode;
|
|
|
|
var
|
|
{ caddnode is used to create nodes of the add type }
|
|
{ the virtual constructor allows to assign }
|
|
{ another class type to caddnode => processor }
|
|
{ specific node types can be created }
|
|
caddnode : taddnodeclass;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,systems,
|
|
cutils,verbose,globals,widestr,
|
|
symconst,symtype,symbase,symdef,symsym,symtable,types,
|
|
cpuinfo,
|
|
cgbase,
|
|
htypechk,pass_1,
|
|
nmat,ncnv,nld,ncon,nset,nopt,ncal,ninl,
|
|
cpubase;
|
|
|
|
|
|
{*****************************************************************************
|
|
TADDNODE
|
|
*****************************************************************************}
|
|
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters 0}
|
|
{$endif fpc}
|
|
|
|
constructor taddnode.create(tt : tnodetype;l,r : tnode);
|
|
begin
|
|
inherited create(tt,l,r);
|
|
end;
|
|
|
|
|
|
function taddnode.det_resulttype:tnode;
|
|
var
|
|
hp,t : tnode;
|
|
lt,rt : tnodetype;
|
|
rd,ld : tdef;
|
|
htype : ttype;
|
|
ot : tnodetype;
|
|
concatstrings : boolean;
|
|
resultset : pconstset;
|
|
i : longint;
|
|
b : boolean;
|
|
s1,s2 : pchar;
|
|
ws1,ws2 : pcompilerwidestring;
|
|
l1,l2 : longint;
|
|
rv,lv : tconstexprint;
|
|
rvd,lvd : bestreal;
|
|
|
|
begin
|
|
result:=nil;
|
|
|
|
{ first do the two subtrees }
|
|
resulttypepass(left);
|
|
resulttypepass(right);
|
|
{ both left and right need to be valid }
|
|
set_varstate(left,true);
|
|
set_varstate(right,true);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ convert array constructors to sets, because there is no other operator
|
|
possible for array constructors }
|
|
if is_array_constructor(left.resulttype.def) then
|
|
begin
|
|
arrayconstructor_to_set(tarrayconstructornode(left));
|
|
resulttypepass(left);
|
|
end;
|
|
if is_array_constructor(right.resulttype.def) then
|
|
begin
|
|
arrayconstructor_to_set(tarrayconstructornode(right));
|
|
resulttypepass(right);
|
|
end;
|
|
|
|
{ allow operator overloading }
|
|
hp:=self;
|
|
if isbinaryoverloaded(hp) then
|
|
begin
|
|
result:=hp;
|
|
exit;
|
|
end;
|
|
|
|
{ Kylix allows enum+ordconstn in an enum declaration (blocktype
|
|
is bt_type), we need to do the conversion here before the
|
|
constant folding }
|
|
if (m_delphi in aktmodeswitches) and
|
|
(blocktype=bt_type) then
|
|
begin
|
|
if (left.resulttype.def.deftype=enumdef) and
|
|
(right.resulttype.def.deftype=orddef) then
|
|
begin
|
|
{ insert explicit typecast to s32bit }
|
|
left:=ctypeconvnode.create(left,s32bittype);
|
|
include(left.flags,nf_explizit);
|
|
resulttypepass(left);
|
|
end
|
|
else
|
|
if (left.resulttype.def.deftype=orddef) and
|
|
(right.resulttype.def.deftype=enumdef) then
|
|
begin
|
|
{ insert explicit typecast to s32bit }
|
|
right:=ctypeconvnode.create(right,s32bittype);
|
|
include(right.flags,nf_explizit);
|
|
resulttypepass(right);
|
|
end;
|
|
end;
|
|
|
|
{ is one a real float, then both need to be floats, this
|
|
need to be done before the constant folding so constant
|
|
operation on a float and int are also handled }
|
|
if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
|
|
begin
|
|
inserttypeconv(right,pbestrealtype^);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
end;
|
|
|
|
{ if one operand is a widechar or a widestring, both operands }
|
|
{ are converted to widestring. This must be done before constant }
|
|
{ folding to allow char+widechar etc. }
|
|
if is_widestring(right.resulttype.def) or
|
|
is_widestring(left.resulttype.def) or
|
|
is_widechar(right.resulttype.def) or
|
|
is_widechar(left.resulttype.def) then
|
|
begin
|
|
inserttypeconv(right,cwidestringtype);
|
|
inserttypeconv(left,cwidestringtype);
|
|
end;
|
|
|
|
{ load easier access variables }
|
|
rd:=right.resulttype.def;
|
|
ld:=left.resulttype.def;
|
|
rt:=right.nodetype;
|
|
lt:=left.nodetype;
|
|
|
|
{ both are int constants }
|
|
if (((is_constintnode(left) and is_constintnode(right)) or
|
|
(is_constboolnode(left) and is_constboolnode(right) and
|
|
(nodetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])))) or
|
|
{ support pointer arithmetics on constants (JM) }
|
|
((lt = pointerconstn) and is_constintnode(right) and
|
|
(nodetype in [addn,subn])) or
|
|
((lt = pointerconstn) and (rt = pointerconstn) and
|
|
(nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
|
|
begin
|
|
{ when comparing/substracting pointers, make sure they are }
|
|
{ of the same type (JM) }
|
|
if (lt = pointerconstn) and (rt = pointerconstn) then
|
|
begin
|
|
if not(cs_extsyntax in aktmoduleswitches) and
|
|
not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch)
|
|
else
|
|
if (nodetype <> subn) and
|
|
is_voidpointer(rd) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else if (nodetype <> subn) and
|
|
is_voidpointer(ld) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else if not(is_equal(ld,rd)) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else if (lt=ordconstn) and (rt=ordconstn) then
|
|
begin
|
|
{ make left const type the biggest, this type will be used
|
|
for orn,andn,xorn }
|
|
if rd.size>ld.size then
|
|
inserttypeconv(left,right.resulttype);
|
|
end;
|
|
|
|
{ load values }
|
|
if (lt = ordconstn) then
|
|
lv:=tordconstnode(left).value
|
|
else
|
|
lv:=tpointerconstnode(left).value;
|
|
if (rt = ordconstn) then
|
|
rv:=tordconstnode(right).value
|
|
else
|
|
rv:=tpointerconstnode(right).value;
|
|
if (lt = pointerconstn) and
|
|
(rt <> pointerconstn) then
|
|
rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
|
|
if (rt = pointerconstn) and
|
|
(lt <> pointerconstn) then
|
|
lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
|
|
case nodetype of
|
|
addn :
|
|
if (lt <> pointerconstn) then
|
|
t := genintconstnode(lv+rv)
|
|
else
|
|
t := cpointerconstnode.create(lv+rv,left.resulttype);
|
|
subn :
|
|
if (lt <> pointerconstn) or (rt = pointerconstn) then
|
|
t := genintconstnode(lv-rv)
|
|
else
|
|
t := cpointerconstnode.create(lv-rv,left.resulttype);
|
|
muln :
|
|
t:=genintconstnode(lv*rv);
|
|
xorn :
|
|
t:=cordconstnode.create(lv xor rv,left.resulttype);
|
|
orn :
|
|
t:=cordconstnode.create(lv or rv,left.resulttype);
|
|
andn :
|
|
t:=cordconstnode.create(lv and rv,left.resulttype);
|
|
ltn :
|
|
t:=cordconstnode.create(ord(lv<rv),booltype);
|
|
lten :
|
|
t:=cordconstnode.create(ord(lv<=rv),booltype);
|
|
gtn :
|
|
t:=cordconstnode.create(ord(lv>rv),booltype);
|
|
gten :
|
|
t:=cordconstnode.create(ord(lv>=rv),booltype);
|
|
equaln :
|
|
t:=cordconstnode.create(ord(lv=rv),booltype);
|
|
unequaln :
|
|
t:=cordconstnode.create(ord(lv<>rv),booltype);
|
|
slashn :
|
|
begin
|
|
{ int/int becomes a real }
|
|
rvd:=rv;
|
|
lvd:=lv;
|
|
if int(rvd)=0 then
|
|
begin
|
|
Message(parser_e_invalid_float_operation);
|
|
t:=crealconstnode.create(0,pbestrealtype^);
|
|
end
|
|
else
|
|
t:=crealconstnode.create(int(lvd)/int(rvd),pbestrealtype^);
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ both real constants ? }
|
|
if (lt=realconstn) and (rt=realconstn) then
|
|
begin
|
|
lvd:=trealconstnode(left).value_real;
|
|
rvd:=trealconstnode(right).value_real;
|
|
case nodetype of
|
|
addn :
|
|
t:=crealconstnode.create(lvd+rvd,pbestrealtype^);
|
|
subn :
|
|
t:=crealconstnode.create(lvd-rvd,pbestrealtype^);
|
|
muln :
|
|
t:=crealconstnode.create(lvd*rvd,pbestrealtype^);
|
|
starstarn,
|
|
caretn :
|
|
begin
|
|
if lvd<0 then
|
|
begin
|
|
Message(parser_e_invalid_float_operation);
|
|
t:=crealconstnode.create(0,pbestrealtype^);
|
|
end
|
|
else if lvd=0 then
|
|
t:=crealconstnode.create(1.0,pbestrealtype^)
|
|
else
|
|
t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^);
|
|
end;
|
|
slashn :
|
|
begin
|
|
if rvd=0 then
|
|
begin
|
|
Message(parser_e_invalid_float_operation);
|
|
t:=crealconstnode.create(0,pbestrealtype^);
|
|
end
|
|
else
|
|
t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
|
|
end;
|
|
ltn :
|
|
t:=cordconstnode.create(ord(lvd<rvd),booltype);
|
|
lten :
|
|
t:=cordconstnode.create(ord(lvd<=rvd),booltype);
|
|
gtn :
|
|
t:=cordconstnode.create(ord(lvd>rvd),booltype);
|
|
gten :
|
|
t:=cordconstnode.create(ord(lvd>=rvd),booltype);
|
|
equaln :
|
|
t:=cordconstnode.create(ord(lvd=rvd),booltype);
|
|
unequaln :
|
|
t:=cordconstnode.create(ord(lvd<>rvd),booltype);
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ first, we handle widestrings, so we can check later for }
|
|
{ stringconstn only }
|
|
|
|
{ widechars are converted above to widestrings too }
|
|
{ this isn't veryy efficient, but I don't think }
|
|
{ that it does matter that much (FK) }
|
|
if (lt=stringconstn) and (rt=stringconstn) and
|
|
(tstringconstnode(left).st_type=st_widestring) and
|
|
(tstringconstnode(right).st_type=st_widestring) then
|
|
begin
|
|
initwidestring(ws1);
|
|
initwidestring(ws2);
|
|
copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
|
|
copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
|
|
case nodetype of
|
|
addn :
|
|
begin
|
|
concatwidestrings(ws1,ws2);
|
|
t:=cstringconstnode.createwstr(ws1);
|
|
end;
|
|
ltn :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype);
|
|
lten :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype);
|
|
gtn :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype);
|
|
gten :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype);
|
|
equaln :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype);
|
|
unequaln :
|
|
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype);
|
|
end;
|
|
donewidestring(ws1);
|
|
donewidestring(ws2);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ concating strings ? }
|
|
concatstrings:=false;
|
|
s1:=nil;
|
|
s2:=nil;
|
|
|
|
if (lt=ordconstn) and (rt=ordconstn) and
|
|
is_char(ld) and is_char(rd) then
|
|
begin
|
|
s1:=strpnew(char(byte(tordconstnode(left).value)));
|
|
s2:=strpnew(char(byte(tordconstnode(right).value)));
|
|
l1:=1;
|
|
l2:=1;
|
|
concatstrings:=true;
|
|
end
|
|
else
|
|
if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
|
|
begin
|
|
s1:=tstringconstnode(left).getpcharcopy;
|
|
l1:=tstringconstnode(left).len;
|
|
s2:=strpnew(char(byte(tordconstnode(right).value)));
|
|
l2:=1;
|
|
concatstrings:=true;
|
|
end
|
|
else
|
|
if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
|
|
begin
|
|
s1:=strpnew(char(byte(tordconstnode(left).value)));
|
|
l1:=1;
|
|
s2:=tstringconstnode(right).getpcharcopy;
|
|
l2:=tstringconstnode(right).len;
|
|
concatstrings:=true;
|
|
end
|
|
else if (lt=stringconstn) and (rt=stringconstn) then
|
|
begin
|
|
s1:=tstringconstnode(left).getpcharcopy;
|
|
l1:=tstringconstnode(left).len;
|
|
s2:=tstringconstnode(right).getpcharcopy;
|
|
l2:=tstringconstnode(right).len;
|
|
concatstrings:=true;
|
|
end;
|
|
if concatstrings then
|
|
begin
|
|
case nodetype of
|
|
addn :
|
|
t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
|
|
ltn :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype);
|
|
lten :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype);
|
|
gtn :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype);
|
|
gten :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype);
|
|
equaln :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype);
|
|
unequaln :
|
|
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype);
|
|
end;
|
|
ansistringdispose(s1,l1);
|
|
ansistringdispose(s2,l2);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ set constant evaluation }
|
|
if (right.nodetype=setconstn) and
|
|
not assigned(tsetconstnode(right).left) and
|
|
(left.nodetype=setconstn) and
|
|
not assigned(tsetconstnode(left).left) then
|
|
begin
|
|
{ check if size adjusting is needed, only for left
|
|
to right as the other way is checked in the typeconv }
|
|
if (tsetdef(right.resulttype.def).settype=smallset) and
|
|
(tsetdef(left.resulttype.def).settype<>smallset) then
|
|
tsetdef(right.resulttype.def).changesettype(normset);
|
|
{ check base types }
|
|
inserttypeconv(left,right.resulttype);
|
|
|
|
if codegenerror then
|
|
begin
|
|
{ recover by only returning the left part }
|
|
result:=left;
|
|
left:=nil;
|
|
exit;
|
|
end;
|
|
new(resultset);
|
|
case nodetype of
|
|
addn :
|
|
begin
|
|
for i:=0 to 31 do
|
|
resultset^[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
|
|
t:=csetconstnode.create(resultset,left.resulttype);
|
|
end;
|
|
muln :
|
|
begin
|
|
for i:=0 to 31 do
|
|
resultset^[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
|
|
t:=csetconstnode.create(resultset,left.resulttype);
|
|
end;
|
|
subn :
|
|
begin
|
|
for i:=0 to 31 do
|
|
resultset^[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
|
|
t:=csetconstnode.create(resultset,left.resulttype);
|
|
end;
|
|
symdifn :
|
|
begin
|
|
for i:=0 to 31 do
|
|
resultset^[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
|
|
t:=csetconstnode.create(resultset,left.resulttype);
|
|
end;
|
|
unequaln :
|
|
begin
|
|
b:=true;
|
|
for i:=0 to 31 do
|
|
if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
|
|
begin
|
|
b:=false;
|
|
break;
|
|
end;
|
|
t:=cordconstnode.create(ord(b),booltype);
|
|
end;
|
|
equaln :
|
|
begin
|
|
b:=true;
|
|
for i:=0 to 31 do
|
|
if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
|
|
begin
|
|
b:=false;
|
|
break;
|
|
end;
|
|
t:=cordconstnode.create(ord(b),booltype);
|
|
end;
|
|
lten :
|
|
begin
|
|
b := true;
|
|
For i := 0 to 31 Do
|
|
If (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
|
|
tsetconstnode(left).value_set^[i] Then
|
|
Begin
|
|
b := false;
|
|
Break
|
|
End;
|
|
t := cordconstnode.create(ord(b),booltype);
|
|
End;
|
|
gten :
|
|
Begin
|
|
b := true;
|
|
For i := 0 to 31 Do
|
|
If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
|
|
tsetconstnode(right).value_set^[i] Then
|
|
Begin
|
|
b := false;
|
|
Break
|
|
End;
|
|
t := cordconstnode.create(ord(b),booltype);
|
|
End;
|
|
end;
|
|
dispose(resultset);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ but an int/int gives real/real! }
|
|
if nodetype=slashn then
|
|
begin
|
|
CGMessage(type_h_use_div_for_int);
|
|
inserttypeconv(right,pbestrealtype^);
|
|
inserttypeconv(left,pbestrealtype^);
|
|
end
|
|
|
|
{ if both are orddefs then check sub types }
|
|
else if (ld.deftype=orddef) and (rd.deftype=orddef) then
|
|
begin
|
|
{ 2 booleans? Make them equal to the largest boolean }
|
|
if is_boolean(ld) and is_boolean(rd) then
|
|
begin
|
|
if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
|
|
begin
|
|
inserttypeconv(right,left.resulttype);
|
|
ttypeconvnode(right).convtype:=tc_bool_2_int;
|
|
include(right.flags,nf_explizit);
|
|
end
|
|
else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
|
|
begin
|
|
inserttypeconv(left,right.resulttype);
|
|
ttypeconvnode(left).convtype:=tc_bool_2_int;
|
|
include(left.flags,nf_explizit);
|
|
end;
|
|
case nodetype of
|
|
xorn,
|
|
ltn,
|
|
lten,
|
|
gtn,
|
|
gten,
|
|
andn,
|
|
orn:
|
|
begin
|
|
end;
|
|
unequaln,
|
|
equaln:
|
|
begin
|
|
if not(cs_full_boolean_eval in aktlocalswitches) then
|
|
begin
|
|
{ Remove any compares with constants }
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
hp:=right;
|
|
b:=(tordconstnode(left).value<>0);
|
|
ot:=nodetype;
|
|
left.free;
|
|
left:=nil;
|
|
right:=nil;
|
|
if (not(b) and (ot=equaln)) or
|
|
(b and (ot=unequaln)) then
|
|
begin
|
|
hp:=cnotnode.create(hp);
|
|
end;
|
|
result:=hp;
|
|
exit;
|
|
end;
|
|
if (right.nodetype=ordconstn) then
|
|
begin
|
|
hp:=left;
|
|
b:=(tordconstnode(right).value<>0);
|
|
ot:=nodetype;
|
|
right.free;
|
|
right:=nil;
|
|
left:=nil;
|
|
if (not(b) and (ot=equaln)) or
|
|
(b and (ot=unequaln)) then
|
|
begin
|
|
hp:=cnotnode.create(hp);
|
|
end;
|
|
result:=hp;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end
|
|
{ Both are chars? }
|
|
else if is_char(rd) and is_char(ld) then
|
|
begin
|
|
if nodetype=addn then
|
|
begin
|
|
resulttype:=cshortstringtype;
|
|
if not(is_constcharnode(left) and is_constcharnode(right)) then
|
|
begin
|
|
inserttypeconv(left,cshortstringtype);
|
|
hp := genaddsstringcharoptnode(self);
|
|
result := hp;
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
{ is there a signed 64 bit type ? }
|
|
else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
|
|
begin
|
|
if (torddef(ld).typ<>s64bit) then
|
|
inserttypeconv(left,cs64bittype);
|
|
if (torddef(rd).typ<>s64bit) then
|
|
inserttypeconv(right,cs64bittype);
|
|
end
|
|
{ is there a unsigned 64 bit type ? }
|
|
else if ((torddef(rd).typ=u64bit) or (torddef(ld).typ=u64bit)) then
|
|
begin
|
|
if (torddef(ld).typ<>u64bit) then
|
|
inserttypeconv(left,cu64bittype);
|
|
if (torddef(rd).typ<>u64bit) then
|
|
inserttypeconv(right,cu64bittype);
|
|
end
|
|
{ is there a cardinal? }
|
|
else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
|
|
begin
|
|
if is_signed(ld) and
|
|
{ then rd = u32bit }
|
|
{ convert positive constants to u32bit }
|
|
not(is_constintnode(left) and
|
|
(tordconstnode(left).value >= 0)) and
|
|
{ range/overflow checking on mixed signed/cardinal expressions }
|
|
{ is only possible if you convert everything to 64bit (JM) }
|
|
((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
|
|
(nodetype in [addn,subn,muln])) then
|
|
begin
|
|
{ perform the operation in 64bit }
|
|
CGMessage(type_w_mixed_signed_unsigned);
|
|
inserttypeconv(left,cs64bittype);
|
|
inserttypeconv(right,cs64bittype);
|
|
end
|
|
else
|
|
begin
|
|
if is_signed(ld) and
|
|
not(is_constintnode(left) and
|
|
(tordconstnode(left).value >= 0)) and
|
|
(cs_check_range in aktlocalswitches) then
|
|
CGMessage(type_w_mixed_signed_unsigned2);
|
|
inserttypeconv(left,u32bittype);
|
|
|
|
if is_signed(rd) and
|
|
{ then ld = u32bit }
|
|
{ convert positive constants to u32bit }
|
|
not(is_constintnode(right) and
|
|
(tordconstnode(right).value >= 0)) and
|
|
((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
|
|
(nodetype in [addn,subn,muln])) then
|
|
begin
|
|
{ perform the operation in 64bit }
|
|
CGMessage(type_w_mixed_signed_unsigned);
|
|
inserttypeconv(left,cs64bittype);
|
|
inserttypeconv(right,cs64bittype);
|
|
end
|
|
else
|
|
begin
|
|
if is_signed(rd) and
|
|
not(is_constintnode(right) and
|
|
(tordconstnode(right).value >= 0)) and
|
|
(cs_check_range in aktlocalswitches) then
|
|
CGMessage(type_w_mixed_signed_unsigned2);
|
|
inserttypeconv(right,u32bittype);
|
|
end;
|
|
end;
|
|
end
|
|
{ generic ord conversion is s32bit }
|
|
else
|
|
begin
|
|
inserttypeconv(right,s32bittype);
|
|
inserttypeconv(left,s32bittype);
|
|
end;
|
|
end
|
|
|
|
{ if both are floatdefs, conversion is already done before constant folding }
|
|
else if (ld.deftype=floatdef) then
|
|
begin
|
|
{ already converted }
|
|
end
|
|
|
|
{ left side a setdef, must be before string processing,
|
|
else array constructor can be seen as array of char (PFV) }
|
|
else if (ld.deftype=setdef) then
|
|
begin
|
|
{ trying to add a set element? }
|
|
if (nodetype=addn) and (rd.deftype<>setdef) then
|
|
begin
|
|
if (rt=setelementn) then
|
|
begin
|
|
if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
|
|
CGMessage(type_e_set_element_are_not_comp);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch)
|
|
end
|
|
else
|
|
begin
|
|
if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
|
|
CGMessage(type_e_set_operation_unknown);
|
|
{ right def must be a also be set }
|
|
if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
|
|
CGMessage(type_e_set_element_are_not_comp);
|
|
end;
|
|
|
|
{ ranges require normsets }
|
|
if (tsetdef(ld).settype=smallset) and
|
|
(rt=setelementn) and
|
|
assigned(tsetelementnode(right).right) then
|
|
begin
|
|
{ generate a temporary normset def, it'll be destroyed
|
|
when the symtable is unloaded }
|
|
htype.setdef(tsetdef.create(tsetdef(ld).elementtype,255));
|
|
inserttypeconv(left,htype);
|
|
end;
|
|
|
|
{ if the destination is not a smallset then insert a typeconv
|
|
which loads a smallset into a normal set }
|
|
if (tsetdef(ld).settype<>smallset) and
|
|
(tsetdef(rd).settype=smallset) then
|
|
begin
|
|
if (right.nodetype=setconstn) then
|
|
begin
|
|
t:=csetconstnode.create(tsetconstnode(right).value_set,left.resulttype);
|
|
tsetconstnode(t).left:=tsetconstnode(right).left;
|
|
tsetconstnode(right).left := nil;
|
|
right.free;
|
|
right:=t;
|
|
end
|
|
else
|
|
inserttypeconv(right,left.resulttype);
|
|
resulttypepass(right);
|
|
end;
|
|
end
|
|
|
|
{ compare pchar to char arrays by addresses like BP/Delphi }
|
|
else if (is_pchar(ld) and is_chararray(rd)) or
|
|
(is_pchar(rd) and is_chararray(ld)) then
|
|
begin
|
|
if is_chararray(rd) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else
|
|
inserttypeconv(left,right.resulttype);
|
|
end
|
|
|
|
{ is one of the operands a string?,
|
|
chararrays are also handled as strings (after conversion), also take
|
|
care of chararray+chararray and chararray+char }
|
|
else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
|
|
((is_chararray(rd) or is_char(rd)) and
|
|
(is_chararray(ld) or is_char(ld))) then
|
|
begin
|
|
if is_widestring(rd) or is_widestring(ld) then
|
|
begin
|
|
if not(is_widestring(rd)) then
|
|
inserttypeconv(right,cwidestringtype);
|
|
if not(is_widestring(ld)) then
|
|
inserttypeconv(left,cwidestringtype);
|
|
end
|
|
else if is_ansistring(rd) or is_ansistring(ld) then
|
|
begin
|
|
if not(is_ansistring(rd)) then
|
|
inserttypeconv(right,cansistringtype);
|
|
if not(is_ansistring(ld)) then
|
|
inserttypeconv(left,cansistringtype);
|
|
end
|
|
else if is_longstring(rd) or is_longstring(ld) then
|
|
begin
|
|
if not(is_longstring(rd)) then
|
|
inserttypeconv(right,clongstringtype);
|
|
if not(is_longstring(ld)) then
|
|
inserttypeconv(left,clongstringtype);
|
|
location.loc:=LOC_MEM;
|
|
end
|
|
else
|
|
begin
|
|
if not(is_shortstring(ld)) then
|
|
inserttypeconv(left,cshortstringtype);
|
|
{ don't convert char, that can be handled by the optimized node }
|
|
if not(is_shortstring(rd) or is_char(rd)) then
|
|
inserttypeconv(right,cshortstringtype);
|
|
end;
|
|
|
|
end
|
|
|
|
{ pointer comparision and subtraction }
|
|
else if (rd.deftype=pointerdef) and (ld.deftype=pointerdef) then
|
|
begin
|
|
case nodetype of
|
|
equaln,unequaln :
|
|
begin
|
|
if is_voidpointer(right.resulttype.def) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else if is_voidpointer(left.resulttype.def) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else if not(is_equal(ld,rd)) then
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
ltn,lten,gtn,gten:
|
|
begin
|
|
if (cs_extsyntax in aktmoduleswitches) then
|
|
begin
|
|
if is_voidpointer(right.resulttype.def) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else if is_voidpointer(left.resulttype.def) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else if not(is_equal(ld,rd)) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
subn:
|
|
begin
|
|
if (cs_extsyntax in aktmoduleswitches) then
|
|
begin
|
|
if is_voidpointer(right.resulttype.def) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else if is_voidpointer(left.resulttype.def) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else if not(is_equal(ld,rd)) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
resulttype:=s32bittype;
|
|
exit;
|
|
end;
|
|
addn:
|
|
begin
|
|
if (cs_extsyntax in aktmoduleswitches) then
|
|
begin
|
|
if is_voidpointer(right.resulttype.def) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else if is_voidpointer(left.resulttype.def) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else if not(is_equal(ld,rd)) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
resulttype:=s32bittype;
|
|
exit;
|
|
end;
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end
|
|
|
|
{ class or interface equation }
|
|
else if is_class_or_interface(rd) or is_class_or_interface(ld) then
|
|
begin
|
|
if is_class_or_interface(rd) and is_class_or_interface(ld) then
|
|
begin
|
|
if tobjectdef(rd).is_related(tobjectdef(ld)) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else
|
|
inserttypeconv(left,right.resulttype);
|
|
end
|
|
else if is_class_or_interface(rd) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else
|
|
inserttypeconv(right,left.resulttype);
|
|
|
|
if not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
else if (rd.deftype=classrefdef) and (ld.deftype=classrefdef) then
|
|
begin
|
|
if tobjectdef(tclassrefdef(rd).pointertype.def).is_related(
|
|
tobjectdef(tclassrefdef(ld).pointertype.def)) then
|
|
inserttypeconv(right,left.resulttype)
|
|
else
|
|
inserttypeconv(left,right.resulttype);
|
|
|
|
if not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
{ allows comperasion with nil pointer }
|
|
else if is_class_or_interface(rd) or (rd.deftype=classrefdef) then
|
|
begin
|
|
inserttypeconv(left,right.resulttype);
|
|
if not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
else if is_class_or_interface(ld) or (ld.deftype=classrefdef) then
|
|
begin
|
|
inserttypeconv(right,left.resulttype);
|
|
if not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
{ support procvar=nil,procvar<>nil }
|
|
else if ((ld.deftype=procvardef) and (rt=niln)) or
|
|
((rd.deftype=procvardef) and (lt=niln)) then
|
|
begin
|
|
if not(nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
{ mmx support, this must be before the zero based array
|
|
check }
|
|
else if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(ld) and
|
|
is_mmx_able_array(rd) and
|
|
is_equal(ld,rd) then
|
|
begin
|
|
case nodetype of
|
|
addn,subn,xorn,orn,andn:
|
|
;
|
|
{ mul is a little bit restricted }
|
|
muln:
|
|
if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
|
|
CGMessage(type_e_mismatch);
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end
|
|
{$endif SUPPORT_MMX}
|
|
|
|
{ this is a little bit dangerous, also the left type }
|
|
{ pointer to should be checked! This broke the mmx support }
|
|
else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
|
|
begin
|
|
if is_zero_based_array(rd) then
|
|
begin
|
|
resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
|
|
inserttypeconv(right,resulttype);
|
|
end;
|
|
inserttypeconv(left,s32bittype);
|
|
if nodetype=addn then
|
|
begin
|
|
if not(cs_extsyntax in aktmoduleswitches) or
|
|
(not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
|
|
CGMessage(type_e_mismatch);
|
|
if (rd.deftype=pointerdef) and
|
|
(tpointerdef(rd).pointertype.def.size>1) then
|
|
left:=caddnode.create(muln,left,cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype));
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
|
|
begin
|
|
if is_zero_based_array(ld) then
|
|
begin
|
|
resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
|
|
inserttypeconv(left,resulttype);
|
|
end;
|
|
inserttypeconv(right,s32bittype);
|
|
if nodetype in [addn,subn] then
|
|
begin
|
|
if not(cs_extsyntax in aktmoduleswitches) or
|
|
(not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
|
|
CGMessage(type_e_mismatch);
|
|
if (ld.deftype=pointerdef) and
|
|
(tpointerdef(ld).pointertype.def.size>1) then
|
|
right:=caddnode.create(muln,right,cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype));
|
|
end
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
|
|
begin
|
|
if not (nodetype in [equaln,unequaln]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
{ enums }
|
|
else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
|
|
begin
|
|
if not(is_equal(ld,rd)) then
|
|
inserttypeconv(right,left.resulttype);
|
|
if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
|
|
CGMessage(type_e_mismatch);
|
|
end
|
|
|
|
{ generic conversion, this is for error recovery }
|
|
else
|
|
begin
|
|
inserttypeconv(left,s32bittype);
|
|
inserttypeconv(right,s32bittype);
|
|
end;
|
|
|
|
{ set resulttype if not already done }
|
|
if not assigned(resulttype.def) then
|
|
begin
|
|
case nodetype of
|
|
ltn,lten,gtn,gten,equaln,unequaln :
|
|
resulttype:=booltype;
|
|
slashn :
|
|
resulttype:=pbestrealtype^;
|
|
addn:
|
|
begin
|
|
{ for strings, return is always a 255 char string }
|
|
if is_shortstring(left.resulttype.def) then
|
|
resulttype:=cshortstringtype
|
|
else
|
|
resulttype:=left.resulttype;
|
|
end;
|
|
else
|
|
resulttype:=left.resulttype;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function taddnode.first_addstring: tnode;
|
|
var
|
|
p: tnode;
|
|
begin
|
|
{ when we get here, we are sure that both the left and the right }
|
|
{ node are both strings of the same stringtype (JM) }
|
|
case nodetype of
|
|
addn:
|
|
begin
|
|
{ note: if you implemented an fpc_shortstr_concat similar to the }
|
|
{ one in i386.inc, you have to override first_addstring like in }
|
|
{ ti386addnode.first_string and implement the shortstring concat }
|
|
{ manually! The generic routine is different from the i386 one (JM) }
|
|
|
|
{ create the call to the concat routine both strings as arguments }
|
|
result := ccallnode.createintern('fpc_'+
|
|
lower(tstringdef(resulttype.def).stringtypname)+'_concat',
|
|
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
|
{ we reused the arguments }
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
ltn,lten,gtn,gten,equaln,unequaln :
|
|
begin
|
|
{ generate better code for s='' and s<>'' }
|
|
if (nodetype in [equaln,unequaln]) and
|
|
(((left.nodetype=stringconstn) and (str_length(left)=0)) or
|
|
((right.nodetype=stringconstn) and (str_length(right)=0))) then
|
|
begin
|
|
{ switch so that the constant is always on the right }
|
|
if left.nodetype = stringconstn then
|
|
begin
|
|
p := left;
|
|
left := right;
|
|
right := p;
|
|
end;
|
|
if is_shortstring(left.resulttype.def) then
|
|
{ compare the length with 0 }
|
|
result := caddnode.create(nodetype,
|
|
cinlinenode.create(in_length_x,false,left),
|
|
cordconstnode.create(0,s32bittype))
|
|
else
|
|
begin
|
|
{ compare the pointer with nil (for ansistrings etc), }
|
|
{ faster than getting the length (JM) }
|
|
result:= caddnode.create(nodetype,
|
|
ctypeconvnode.create(left,voidpointertype),
|
|
cpointerconstnode.create(0,voidpointertype));
|
|
taddnode(result).left.toggleflag(nf_explizit);
|
|
end;
|
|
{ left is reused }
|
|
left := nil;
|
|
{ right isn't }
|
|
right.free;
|
|
right := nil;
|
|
firstpass(result);
|
|
exit;
|
|
end;
|
|
{ no string constant -> call compare routine }
|
|
result := ccallnode.createintern('fpc_'+
|
|
lower(tstringdef(left.resulttype.def).stringtypname)+'_compare',
|
|
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
|
{ and compare its result with 0 according to the original operator }
|
|
result := caddnode.create(nodetype,result,
|
|
cordconstnode.create(0,s32bittype));
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function taddnode.first_addset: tnode;
|
|
var
|
|
procname: string[31];
|
|
tempn: tnode;
|
|
paras: tcallparanode;
|
|
srsym: ttypesym;
|
|
begin
|
|
{ get the sym that represents the fpc_normal_set type }
|
|
if not searchsystype('FPC_NORMAL_SET',srsym) then
|
|
internalerror(200108313);
|
|
|
|
case nodetype of
|
|
equaln,unequaln,lten,gten:
|
|
begin
|
|
case nodetype of
|
|
equaln,unequaln:
|
|
procname := 'fpc_set_comp_sets';
|
|
lten,gten:
|
|
begin
|
|
procname := 'fpc_set_contains_sets';
|
|
{ (left >= right) = (right <= left) }
|
|
if nodetype = gten then
|
|
begin
|
|
tempn := left;
|
|
left := right;
|
|
right := tempn;
|
|
end;
|
|
end;
|
|
end;
|
|
{ convert the arguments (explicitely) to fpc_normal_set's }
|
|
left := ctypeconvnode.create(left,srsym.restype);
|
|
left.toggleflag(nf_explizit);
|
|
right := ctypeconvnode.create(right,srsym.restype);
|
|
right.toggleflag(nf_explizit);
|
|
result := ccallnode.createintern(procname,ccallparanode.create(right,
|
|
ccallparanode.create(left,nil)));
|
|
{ left and right are reused as parameters }
|
|
left := nil;
|
|
right := nil;
|
|
{ for an unequaln, we have to negate the result of comp_sets }
|
|
if nodetype = unequaln then
|
|
result := cnotnode.create(result);
|
|
end;
|
|
addn:
|
|
begin
|
|
{ optimize first loading of a set }
|
|
if (right.nodetype=setelementn) and
|
|
not(assigned(tsetelementnode(right).right)) and
|
|
is_emptyset(left) then
|
|
begin
|
|
{ type cast the value to pass as argument to a byte, }
|
|
{ since that's what the helper expects }
|
|
tsetelementnode(right).left :=
|
|
ctypeconvnode.create(tsetelementnode(right).left,u8bittype);
|
|
tsetelementnode(right).left.toggleflag(nf_explizit);
|
|
{ set the resulttype to the actual one (otherwise it's }
|
|
{ "fpc_normal_set") }
|
|
result := ccallnode.createinternres('fpc_set_create_element',
|
|
ccallparanode.create(tsetelementnode(right).left,nil),
|
|
resulttype);
|
|
{ reused }
|
|
tsetelementnode(right).left := nil;
|
|
end
|
|
else
|
|
begin
|
|
if right.nodetype=setelementn then
|
|
begin
|
|
{ convert the arguments to bytes, since that's what }
|
|
{ the helper expects }
|
|
tsetelementnode(right).left :=
|
|
ctypeconvnode.create(tsetelementnode(right).left,
|
|
u8bittype);
|
|
tsetelementnode(right).left.toggleflag(nf_explizit);
|
|
|
|
{ convert the original set (explicitely) to an }
|
|
{ fpc_normal_set so we can pass it to the helper }
|
|
left := ctypeconvnode.create(left,srsym.restype);
|
|
left.toggleflag(nf_explizit);
|
|
|
|
{ add a range or a single element? }
|
|
if assigned(tsetelementnode(right).right) then
|
|
begin
|
|
tsetelementnode(right).right :=
|
|
ctypeconvnode.create(tsetelementnode(right).right,
|
|
u8bittype);
|
|
tsetelementnode(right).right.toggleflag(nf_explizit);
|
|
|
|
{ create the call }
|
|
result := ccallnode.createinternres('fpc_set_set_range',
|
|
ccallparanode.create(tsetelementnode(right).right,
|
|
ccallparanode.create(tsetelementnode(right).left,
|
|
ccallparanode.create(left,nil))),resulttype);
|
|
end
|
|
else
|
|
begin
|
|
result := ccallnode.createinternres('fpc_set_set_byte',
|
|
ccallparanode.create(tsetelementnode(right).left,
|
|
ccallparanode.create(left,nil)),resulttype);
|
|
end;
|
|
{ remove reused parts from original node }
|
|
tsetelementnode(right).right := nil;
|
|
tsetelementnode(right).left := nil;
|
|
left := nil;
|
|
end
|
|
else
|
|
begin
|
|
{ add two sets }
|
|
|
|
{ convert the sets to fpc_normal_set's }
|
|
left := ctypeconvnode.create(left,srsym.restype);
|
|
left.toggleflag(nf_explizit);
|
|
right := ctypeconvnode.create(right,srsym.restype);
|
|
right.toggleflag(nf_explizit);
|
|
result := ccallnode.createinternres('fpc_set_add_sets',
|
|
ccallparanode.create(right,
|
|
ccallparanode.create(left,nil)),resulttype);
|
|
{ remove reused parts from original node }
|
|
left := nil;
|
|
right := nil;
|
|
end;
|
|
end
|
|
end;
|
|
subn,symdifn,muln:
|
|
begin
|
|
{ convert the sets to fpc_normal_set's }
|
|
left := ctypeconvnode.create(left,srsym.restype);
|
|
left.toggleflag(nf_explizit);
|
|
right := ctypeconvnode.create(right,srsym.restype);
|
|
right.toggleflag(nf_explizit);
|
|
paras := ccallparanode.create(right,
|
|
ccallparanode.create(left,nil));
|
|
case nodetype of
|
|
subn:
|
|
result := ccallnode.createinternres('fpc_set_sub_sets',
|
|
paras,resulttype);
|
|
symdifn:
|
|
result := ccallnode.createinternres('fpc_set_symdif_sets',
|
|
paras,resulttype);
|
|
muln:
|
|
result := ccallnode.createinternres('fpc_set_mul_sets',
|
|
paras,resulttype);
|
|
end;
|
|
{ remove reused parts from original node }
|
|
left := nil;
|
|
right := nil;
|
|
end;
|
|
else
|
|
internalerror(200108311);
|
|
end;
|
|
firstpass(result);
|
|
end;
|
|
|
|
|
|
function taddnode.first_add64bitint: tnode;
|
|
var
|
|
procname: string[31];
|
|
temp: tnode;
|
|
power: longint;
|
|
begin
|
|
result := nil;
|
|
{ create helper calls mul }
|
|
if nodetype <> muln then
|
|
exit;
|
|
|
|
{ make sure that if there is a constant, that it's on the right }
|
|
if left.nodetype = ordconstn then
|
|
begin
|
|
temp := right;
|
|
right := left;
|
|
left := temp;
|
|
end;
|
|
|
|
{ can we use a shift instead of a mul? }
|
|
if (right.nodetype = ordconstn) and
|
|
ispowerof2(tordconstnode(right).value,power) then
|
|
begin
|
|
tordconstnode(right).value := power;
|
|
result := cshlshrnode.create(shln,left,right);
|
|
{ left and right are reused }
|
|
left := nil;
|
|
right := nil;
|
|
{ return firstpassed new node }
|
|
firstpass(result);
|
|
exit;
|
|
end;
|
|
|
|
{ otherwise, create the parameters for the helper }
|
|
right := ccallparanode.create(
|
|
cordconstnode.create(ord(cs_check_overflow in aktlocalswitches),booltype),
|
|
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
|
left := nil;
|
|
if torddef(resulttype.def).typ = s64bit then
|
|
procname := 'fpc_mul_int64'
|
|
else
|
|
procname := 'fpc_mul_qword';
|
|
result := ccallnode.createintern(procname,right);
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
|
|
function taddnode.pass_1 : tnode;
|
|
var
|
|
hp : tnode;
|
|
lt,rt : tnodetype;
|
|
rd,ld : tdef;
|
|
begin
|
|
result:=nil;
|
|
{ first do the two subtrees }
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ load easier access variables }
|
|
rd:=right.resulttype.def;
|
|
ld:=left.resulttype.def;
|
|
rt:=right.nodetype;
|
|
lt:=left.nodetype;
|
|
|
|
{ int/int gives real/real! }
|
|
if nodetype=slashn then
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
{ maybe we need an integer register to save }
|
|
{ a reference }
|
|
if ((left.location.loc<>LOC_FPU) or
|
|
(right.location.loc<>LOC_FPU)) and
|
|
(left.registers32=right.registers32) then
|
|
calcregisters(self,1,1,0)
|
|
else
|
|
calcregisters(self,0,1,0);
|
|
{ an add node always first loads both the left and the }
|
|
{ right in the fpu before doing the calculation. However, }
|
|
{ calcregisters(0,2,0) will overestimate the number of }
|
|
{ necessary registers (it will make it 3 in case one of }
|
|
{ the operands is already in the fpu) (JM) }
|
|
if ((left.location.loc <> LOC_FPU) or
|
|
(right.location.loc <> LOC_FPU)) and
|
|
(registersfpu < 2) then
|
|
inc(registersfpu);
|
|
end
|
|
|
|
{ if both are orddefs then check sub types }
|
|
else if (ld.deftype=orddef) and (rd.deftype=orddef) then
|
|
begin
|
|
{ 2 booleans ? }
|
|
if is_boolean(ld) and is_boolean(rd) then
|
|
begin
|
|
if not(cs_full_boolean_eval in aktlocalswitches) and
|
|
(nodetype in [andn,orn]) then
|
|
begin
|
|
location.loc:=LOC_JUMP;
|
|
calcregisters(self,0,0,0);
|
|
end
|
|
else
|
|
begin
|
|
location.loc := LOC_FLAGS;
|
|
if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
|
|
(left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
|
|
calcregisters(self,2,0,0)
|
|
else
|
|
calcregisters(self,1,0,0);
|
|
end;
|
|
end
|
|
else
|
|
{ Both are chars? only convert to shortstrings for addn }
|
|
if is_char(ld) then
|
|
begin
|
|
if nodetype=addn then
|
|
internalerror(200103291);
|
|
location.loc := LOC_FLAGS;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
{ is there a 64 bit type ? }
|
|
else if (torddef(ld).typ in [s64bit,u64bit]) then
|
|
begin
|
|
result := first_add64bitint;
|
|
if assigned(result) then
|
|
exit;
|
|
if nodetype in [addn,subn,muln,andn,orn,xorn] then
|
|
location.loc := LOC_REGISTER
|
|
else
|
|
location.loc := LOC_JUMP;
|
|
calcregisters(self,2,0,0)
|
|
end
|
|
{ is there a cardinal? }
|
|
else if (torddef(ld).typ=u32bit) then
|
|
begin
|
|
if nodetype in [addn,subn,muln,andn,orn,xorn] then
|
|
location.loc := LOC_REGISTER
|
|
else
|
|
location.loc := LOC_FLAGS;
|
|
calcregisters(self,1,0,0);
|
|
{ for unsigned mul we need an extra register }
|
|
if nodetype=muln then
|
|
inc(registers32);
|
|
end
|
|
{ generic s32bit conversion }
|
|
else
|
|
begin
|
|
if nodetype in [addn,subn,muln,andn,orn,xorn] then
|
|
location.loc := LOC_REGISTER
|
|
else
|
|
location.loc := LOC_FLAGS;
|
|
calcregisters(self,1,0,0);
|
|
end;
|
|
end
|
|
|
|
{ left side a setdef, must be before string processing,
|
|
else array constructor can be seen as array of char (PFV) }
|
|
else if (ld.deftype=setdef) then
|
|
begin
|
|
if tsetdef(ld).settype=smallset then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
{ are we adding set elements ? }
|
|
if right.nodetype=setelementn then
|
|
calcregisters(self,2,0,0)
|
|
else
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
else
|
|
begin
|
|
result := first_addset;
|
|
if assigned(result) then
|
|
exit;
|
|
location.loc:=LOC_MEM;
|
|
calcregisters(self,0,0,0);
|
|
{ here we call SET... }
|
|
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
|
end;
|
|
end
|
|
|
|
{ compare pchar by addresses like BP/Delphi }
|
|
else if is_pchar(ld) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
{ is one of the operands a string }
|
|
else if (ld.deftype=stringdef) then
|
|
begin
|
|
if is_widestring(ld) then
|
|
begin
|
|
{ we use reference counted widestrings so no fast exit here }
|
|
procinfo^.no_fast_exit:=true;
|
|
{ this is only for add, the comparisaion is handled later }
|
|
location.loc:=LOC_REGISTER;
|
|
end
|
|
else if is_ansistring(ld) then
|
|
begin
|
|
{ we use ansistrings so no fast exit here }
|
|
procinfo^.no_fast_exit:=true;
|
|
{ this is only for add, the comparisaion is handled later }
|
|
location.loc:=LOC_REGISTER;
|
|
end
|
|
else if is_longstring(ld) then
|
|
begin
|
|
{ this is only for add, the comparisaion is handled later }
|
|
location.loc:=LOC_MEM;
|
|
end
|
|
else
|
|
begin
|
|
if canbeaddsstringcharoptnode(self) then
|
|
begin
|
|
hp := genaddsstringcharoptnode(self);
|
|
firstpass(hp);
|
|
pass_1 := hp;
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
{ Fix right to be shortstring }
|
|
if is_char(right.resulttype.def) then
|
|
begin
|
|
inserttypeconv(right,cshortstringtype);
|
|
firstpass(right);
|
|
end;
|
|
end;
|
|
if canbeaddsstringcsstringoptnode(self) then
|
|
begin
|
|
hp := genaddsstringcsstringoptnode(self);
|
|
firstpass(hp);
|
|
pass_1 := hp;
|
|
exit;
|
|
end;
|
|
end;
|
|
{ otherwise, let addstring convert everything }
|
|
result := first_addstring;
|
|
exit;
|
|
end
|
|
|
|
{ is one a real float ? }
|
|
else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
calcregisters(self,0,1,0);
|
|
{ an add node always first loads both the left and the }
|
|
{ right in the fpu before doing the calculation. However, }
|
|
{ calcregisters(0,2,0) will overestimate the number of }
|
|
{ necessary registers (it will make it 3 in case one of }
|
|
{ the operands is already in the fpu) (JM) }
|
|
if ((left.location.loc <> LOC_FPU) or
|
|
(right.location.loc <> LOC_FPU)) and
|
|
(registersfpu < 2) then
|
|
inc(registersfpu);
|
|
end
|
|
|
|
{ pointer comperation and subtraction }
|
|
else if (ld.deftype=pointerdef) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
else if is_class_or_interface(ld) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
else if (ld.deftype=classrefdef) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
{ support procvar=nil,procvar<>nil }
|
|
else if ((ld.deftype=procvardef) and (rt=niln)) or
|
|
((rd.deftype=procvardef) and (lt=niln)) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
{ mmx support, this must be before the zero based array
|
|
check }
|
|
else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
|
|
is_mmx_able_array(rd) then
|
|
begin
|
|
location.loc:=LOC_MMXREGISTER;
|
|
calcregisters(self,0,0,1);
|
|
end
|
|
{$endif SUPPORT_MMX}
|
|
|
|
else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
else if (ld.deftype=enumdef) then
|
|
begin
|
|
location.loc := LOC_FLAGS;
|
|
calcregisters(self,1,0,0);
|
|
end
|
|
|
|
{$ifdef SUPPORT_MMX}
|
|
else if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(ld) and
|
|
is_mmx_able_array(rd) then
|
|
begin
|
|
location.loc:=LOC_MMXREGISTER;
|
|
calcregisters(self,0,0,1);
|
|
end
|
|
{$endif SUPPORT_MMX}
|
|
|
|
{ the general solution is to convert to 32 bit int }
|
|
else
|
|
begin
|
|
location.loc:=LOC_REGISTER;
|
|
calcregisters(self,1,0,0);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
caddnode:=taddnode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.42 2001-12-27 15:33:58 jonas
|
|
* fixed fpuregister counting errors ("merged")
|
|
|
|
Revision 1.41 2001/10/20 19:28:37 peter
|
|
* interface 2 guid support
|
|
* guid constants support
|
|
|
|
Revision 1.40 2001/10/12 13:51:51 jonas
|
|
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")
|
|
* fixed bug in n386add (introduced after compilerproc changes for string
|
|
operations) where calcregisters wasn't called for shortstring addnodes
|
|
* NOTE: from now on, the location of a binary node must now always be set
|
|
before you call calcregisters() for it
|
|
|
|
Revision 1.39 2001/09/05 15:22:09 jonas
|
|
* made multiplying, dividing and mod'ing of int64 and qword processor
|
|
independent with compilerprocs (+ small optimizations by using shift/and
|
|
where possible)
|
|
|
|
Revision 1.38 2001/09/04 11:38:54 jonas
|
|
+ searchsystype() and searchsystype() functions in symtable
|
|
* changed ninl and nadd to use these functions
|
|
* i386 set comparison functions now return their results in al instead
|
|
of in the flags so that they can be sued as compilerprocs
|
|
- removed all processor specific code from n386add.pas that has to do
|
|
with set handling, it's now all done in nadd.pas
|
|
* fixed fpc_set_contains_sets in genset.inc
|
|
* fpc_set_in_byte is now coded inline in n386set.pas and doesn't use a
|
|
helper anymore
|
|
* some small fixes in compproc.inc/set.inc regarding the declaration of
|
|
internal helper types (fpc_small_set and fpc_normal_set)
|
|
|
|
Revision 1.37 2001/09/03 13:27:42 jonas
|
|
* compilerproc implementation of set addition/substraction/...
|
|
* changed the declaration of some set helpers somewhat to accomodate the
|
|
above change
|
|
* i386 still uses the old code for comparisons of sets, because its
|
|
helpers return the results in the flags
|
|
* dummy tc_normal_2_small_set type conversion because I need the original
|
|
resulttype of the set add nodes
|
|
NOTE: you have to start a cycle with 1.0.5!
|
|
|
|
Revision 1.36 2001/09/02 21:12:06 peter
|
|
* move class of definitions into type section for delphi
|
|
|
|
Revision 1.35 2001/08/31 15:42:15 jonas
|
|
* added missing type conversion from small to normal sets
|
|
|
|
Revision 1.34 2001/08/30 15:43:14 jonas
|
|
* converted adding/comparing of strings to compileproc. Note that due
|
|
to the way the shortstring helpers for i386 are written, they are
|
|
still handled by the old code (reason: fpc_shortstr_compare returns
|
|
results in the flags instead of in eax and fpc_shortstr_concat
|
|
has wierd parameter conventions). The compilerproc stuff should work
|
|
fine with the generic implementations though.
|
|
* removed some nested comments warnings
|
|
|
|
Revision 1.33 2001/08/26 13:36:38 florian
|
|
* some cg reorganisation
|
|
* some PPC updates
|
|
|
|
Revision 1.32 2001/08/06 21:40:46 peter
|
|
* funcret moved from tprocinfo to tprocdef
|
|
|
|
Revision 1.31 2001/07/08 21:00:14 peter
|
|
* various widestring updates, it works now mostly without charset
|
|
mapping supported
|
|
|
|
Revision 1.30 2001/06/04 21:41:26 peter
|
|
* readded generic conversion to s32bit that i removed yesterday. It
|
|
is still used for error recovery, added a small note about that
|
|
|
|
Revision 1.29 2001/06/04 18:13:53 peter
|
|
* Support kylix hack of having enum+integer in a enum declaration.
|
|
|
|
Revision 1.28 2001/05/27 14:30:55 florian
|
|
+ some widestring stuff added
|
|
|
|
Revision 1.27 2001/05/19 21:11:50 peter
|
|
* first check for overloaded operator before doing inserting any
|
|
typeconvs
|
|
|
|
Revision 1.26 2001/05/19 12:53:52 peter
|
|
* check set types when doing constant set evaluation
|
|
|
|
Revision 1.25 2001/04/13 01:22:08 peter
|
|
* symtable change to classes
|
|
* range check generation and errors fixed, make cycle DEBUG=1 works
|
|
* memory leaks fixed
|
|
|
|
Revision 1.24 2001/04/04 22:42:39 peter
|
|
* move constant folding into det_resulttype
|
|
|
|
Revision 1.23 2001/04/02 21:20:30 peter
|
|
* resulttype rewrite
|
|
|
|
Revision 1.22 2001/02/04 11:12:17 jonas
|
|
* fixed web bug 1377 & const pointer arithmtic
|
|
|
|
Revision 1.21 2001/01/14 22:13:13 peter
|
|
* constant calculation fixed. The type of the new constant is now
|
|
defined after the calculation is done. This should remove a lot
|
|
of wrong warnings (and errors with -Cr).
|
|
|
|
Revision 1.20 2000/12/31 11:14:10 jonas
|
|
+ implemented/fixed docompare() mathods for all nodes (not tested)
|
|
+ nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
|
|
and constant strings/chars together
|
|
* n386add.pas: don't copy temp strings (of size 256) to another temp string
|
|
when adding
|
|
|
|
Revision 1.19 2000/12/16 15:55:32 jonas
|
|
+ warning when there is a chance to get a range check error because of
|
|
automatic type conversion to u32bit
|
|
* arithmetic operations with a cardinal and a signed operand are carried
|
|
out in 64bit when range checking is on ("merged" from fixes branch)
|
|
|
|
Revision 1.18 2000/11/29 00:30:31 florian
|
|
* unused units removed from uses clause
|
|
* some changes for widestrings
|
|
|
|
Revision 1.17 2000/11/20 15:30:42 jonas
|
|
* changed types of values used for constant expression evaluation to
|
|
tconstexprint
|
|
|
|
Revision 1.16 2000/11/13 11:30:55 florian
|
|
* some bugs with interfaces and NIL fixed
|
|
|
|
Revision 1.15 2000/11/04 14:25:20 florian
|
|
+ merged Attila's changes for interfaces, not tested yet
|
|
|
|
Revision 1.14 2000/10/31 22:02:47 peter
|
|
* symtable splitted, no real code changes
|
|
|
|
Revision 1.13 2000/10/14 10:14:50 peter
|
|
* moehrendorf oct 2000 rewrite
|
|
|
|
Revision 1.12 2000/10/01 19:48:23 peter
|
|
* lot of compile updates for cg11
|
|
|
|
Revision 1.11 2000/09/30 16:08:45 peter
|
|
* more cg11 updates
|
|
|
|
Revision 1.10 2000/09/28 19:49:52 florian
|
|
*** empty log message ***
|
|
|
|
Revision 1.9 2000/09/27 21:33:22 florian
|
|
* finally nadd.pas compiles
|
|
|
|
Revision 1.8 2000/09/27 20:25:44 florian
|
|
* more stuff fixed
|
|
|
|
Revision 1.7 2000/09/27 18:14:31 florian
|
|
* fixed a lot of syntax errors in the n*.pas stuff
|
|
|
|
Revision 1.6 2000/09/24 15:06:19 peter
|
|
* use defines.inc
|
|
|
|
Revision 1.5 2000/09/22 22:42:52 florian
|
|
* more fixes
|
|
|
|
Revision 1.4 2000/09/21 12:22:42 jonas
|
|
* put piece of code between -dnewoptimizations2 since it wasn't
|
|
necessary otherwise
|
|
+ support for full boolean evaluation (from tcadd)
|
|
|
|
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
|
|
|
|
Revision 1.1 2000/08/26 12:24:20 florian
|
|
* initial release
|
|
}
|