* call taddnode.simplify at the very end of taddnode.pass_typecheck, so

it doesn't have to duplicate any type checking code, and so constant
    expressions get the same resultdefs as non-constant expressions
  * properly fixed resultdef determination of "set + setelementn" (follows
    same rules now as "set + set")
  * also convert "longint or/xor cardinal" to int64 (needed for correct
    results with negative numbers and Delphi-compatible) + test
  * extended 64-to-32 type conversion simplification to also handle
    or/xor nodes (so if the result is typecasted back to 32 bit, the
    evaluation can still be done entirely in 32 bit). These changes also
    enable that optimization in some extra cases (not just anymore for
    expressions containing only uint32)

git-svn-id: trunk@10418 -
This commit is contained in:
Jonas Maebe 2008-03-01 20:48:50 +00:00
parent 288fb08f09
commit 97f4c0a130
4 changed files with 251 additions and 216 deletions

1
.gitattributes vendored
View File

@ -6853,6 +6853,7 @@ tests/test/cg/ptest.pp svneol=native#text/plain
tests/test/cg/taddbool.pp svneol=native#text/plain
tests/test/cg/taddcard.pp svneol=native#text/plain
tests/test/cg/taddcurr.pp svneol=native#text/plain
tests/test/cg/taddint.pp svneol=native#text/plain
tests/test/cg/taddlong.pp svneol=native#text/plain
tests/test/cg/taddr1.pp svneol=native#text/plain
tests/test/cg/taddr2.pp svneol=native#text/plain

View File

@ -140,8 +140,9 @@ implementation
function taddnode.simplify : tnode;
var
t : tnode;
t, hp : tnode;
lt,rt : tnodetype;
realdef : tdef;
rd,ld : tdef;
rv,lv,v : tconstexprint;
rvd,lvd : bestreal;
@ -204,28 +205,6 @@ implementation
) then
begin
t:=nil;
{ 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 current_settings.moduleswitches) and
not(nodetype in [equaln,unequaln]) then
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename)
else
if (nodetype <> subn) and
is_voidpointer(rd) then
inserttypeconv(right,left.resultdef)
else if (nodetype <> subn) and
is_voidpointer(ld) then
inserttypeconv(left,right.resultdef)
else if not(equal_defs(ld,rd)) then
IncompatibleTypes(ld,rd);
end
else if (ld.typ=enumdef) and (rd.typ=enumdef) then
begin
if not(equal_defs(ld,rd)) then
inserttypeconv(right,left.resultdef);
end;
{ load values }
case lt of
@ -248,12 +227,8 @@ implementation
else
internalerror(2002080203);
end;
if (lt = pointerconstn) and
(rt <> pointerconstn) then
rv := rv * tpointerdef(left.resultdef).pointeddef.size;
if (rt = pointerconstn) and
(lt <> pointerconstn) then
lv := lv * tpointerdef(right.resultdef).pointeddef.size;
{ type checking already took care of multiplying }
{ integer constants with pointeddef.size if necessary }
case nodetype of
addn :
begin
@ -265,12 +240,12 @@ implementation
t:=genintconstnode(0)
end
else if (lt=pointerconstn) then
t := cpointerconstnode.create(qword(v),left.resultdef)
t := cpointerconstnode.create(qword(v),resultdef)
else
if is_integer(ld) then
t := genintconstnode(v)
else
t := cordconstnode.create(v,left.resultdef,(ld.typ<>enumdef));
t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
end;
subn :
begin
@ -284,14 +259,18 @@ implementation
else if (lt=pointerconstn) then
{ pointer-pointer results in an integer }
if (rt=pointerconstn) then
t := genintconstnode(v div tpointerdef(ld).pointeddef.size)
begin
if not(nf_has_pointerdiv in flags) then
internalerror(2008030101);
t := genintconstnode(v)
end
else
t := cpointerconstnode.create(qword(v),left.resultdef)
t := cpointerconstnode.create(qword(v),resultdef)
else
if is_integer(ld) then
t:=genintconstnode(v)
else
t:=cordconstnode.create(v,left.resultdef,(ld.typ<>enumdef));
t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
end;
muln :
begin
@ -309,17 +288,17 @@ implementation
if is_integer(ld) then
t:=genintconstnode(lv xor rv)
else
t:=cordconstnode.create(lv xor rv,left.resultdef,true);
t:=cordconstnode.create(lv xor rv,resultdef,true);
orn :
if is_integer(ld) then
t:=genintconstnode(lv or rv)
else
t:=cordconstnode.create(lv or rv,left.resultdef,true);
t:=cordconstnode.create(lv or rv,resultdef,true);
andn :
if is_integer(ld) then
t:=genintconstnode(lv and rv)
else
t:=cordconstnode.create(lv and rv,left.resultdef,true);
t:=cordconstnode.create(lv and rv,resultdef,true);
ltn :
t:=cordconstnode.create(ord(lv<rv),booltype,true);
lten :
@ -340,10 +319,7 @@ implementation
t:=crealconstnode.create(lvd/rvd,resultrealdef);
end;
else
begin
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
t:=cnothingnode.create;
end;
internalerror(2008022101);
end;
result:=t;
exit;
@ -358,8 +334,17 @@ implementation
is_subequal(left.resultdef,right.resultdef) then
begin
t:=nil;
hp:=right;
realdef:=hp.resultdef;
while (hp.nodetype=typeconvn) and
([nf_internal,nf_explicit] * hp.flags = []) and
is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
begin
hp:=ttypeconvnode(hp).left;
realdef:=hp.resultdef;
end;
lv:=Tordconstnode(left).value;
with Torddef(right.resultdef) do
with torddef(realdef) do
case nodetype of
ltn:
if lv<low then
@ -395,15 +380,21 @@ implementation
end
end
else if (left.resultdef.typ=orddef) and is_constintnode(right) and
(* { all type limits are stored using tconstexprint = int64 }
{ currently, so u64bit support would need extra type casts }
(Torddef(left.resultdef).ordtype<>u64bit) and*)
{ don't ignore type checks }
is_subequal(left.resultdef,right.resultdef) then
begin
t:=nil;
hp:=left;
realdef:=hp.resultdef;
while (hp.nodetype=typeconvn) and
([nf_internal,nf_explicit] * hp.flags = []) and
is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
begin
hp:=ttypeconvnode(hp).left;
realdef:=hp.resultdef;
end;
rv:=Tordconstnode(right).value;
with Torddef(left.resultdef) do
with torddef(realdef) do
case nodetype of
ltn:
if high<rv then
@ -448,7 +439,7 @@ implementation
addn,subn:
result := left.getcopy;
muln:
result:=cordconstnode.create(0,left.resultdef,true);
result:=cordconstnode.create(0,resultdef,true);
end;
end
else if tordconstnode(right).value = 1 then
@ -546,10 +537,7 @@ implementation
unequaln :
t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
else
begin
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
t:=cnothingnode.create;
end;
internalerror(2008022102);
end;
result:=t;
exit;
@ -588,10 +576,7 @@ implementation
unequaln :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
else
begin
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
t:=cnothingnode.create;
end;
internalerror(2008022103);
end;
donewidestring(ws1);
donewidestring(ws2);
@ -661,10 +646,7 @@ implementation
unequaln :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
else
begin
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
t:=cnothingnode.create;
end;
internalerror(2008022104);
end;
result:=t;
exit;
@ -676,42 +658,26 @@ implementation
(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.resultdef).settype=smallset) and
(tsetdef(left.resultdef).settype<>smallset) then
right.resultdef:=tsetdef.create(tsetdef(right.resultdef).elementdef,0,255);
{ check base types, keep the original type if right was an empty set }
if assigned(tsetdef(right.resultdef).elementdef) then
inserttypeconv(left,right.resultdef);
if codegenerror then
begin
{ recover by only returning the left part }
result:=left;
left:=nil;
exit;
end;
case nodetype of
addn :
begin
resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resultdef);
t:=csetconstnode.create(@resultset,resultdef);
end;
muln :
begin
resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resultdef);
t:=csetconstnode.create(@resultset,resultdef);
end;
subn :
begin
resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^;
t:=csetconstnode.create(@resultset,left.resultdef);
t:=csetconstnode.create(@resultset,resultdef);
end;
symdifn :
begin
resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resultdef);
t:=csetconstnode.create(@resultset,resultdef);
end;
unequaln :
begin
@ -734,10 +700,7 @@ implementation
t:=cordconstnode.create(byte(b),booltype,true);
end;
else
begin
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
t:=cnothingnode.create;
end;
internalerror(2008022105);
end;
result:=t;
exit;
@ -880,10 +843,6 @@ implementation
inserttypeconv(left,cwidestringtype);
end;
result:=simplify;
if assigned(result) then
exit;
{ load easier access variables }
rd:=right.resultdef;
ld:=left.resultdef;
@ -1087,19 +1046,35 @@ implementation
if (torddef(rd).ordtype<>scurrency) then
inserttypeconv(right,s64currencytype);
end
{ and,or,xor work on bit patterns and don't care
about the sign of integers }
{ compares don't need extension to native int size either }
{ as long as both values are signed or unsigned }
{ "and" does't care about the sign of integers }
{ "xor", "or" and compares don't need extension to native int }
{ size either as long as both values are signed or unsigned }
{ "xor" and "or" also don't care about the sign if the values }
{ occupy an entire register }
else if is_integer(ld) and is_integer(rd) and
((nodetype in [andn,orn,xorn]) or
((nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and
((nodetype=andn) or
((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and
not(is_signed(ld) xor is_signed(rd)))) then
begin
if rd.size>ld.size then
if (rd.size>ld.size) or
{ Delphi-compatible: prefer unsigned type for "and" with equal size }
((rd.size=ld.size) and
not is_signed(rd)) then
begin
if (rd.size=ld.size) and
is_signed(ld) then
inserttypeconv_internal(left,right.resultdef)
else
inserttypeconv_internal(right,left.resultdef);
inserttypeconv(left,right.resultdef)
end
else
begin
if (rd.size=ld.size) and
is_signed(rd) then
inserttypeconv_internal(right,left.resultdef)
else
inserttypeconv(right,left.resultdef)
end
end
{ is there a signed 64 bit type ? }
else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
@ -1148,8 +1123,9 @@ implementation
{ mustn't do it here because that would change }
{ overload choosing behaviour etc. The code in }
{ ncnv.pas is run after that is already decided }
if not is_signed(left.resultdef) and
not is_signed(right.resultdef) then
if (not is_signed(left.resultdef) and
not is_signed(right.resultdef)) or
(nodetype in [orn,xorn]) then
include(flags,nf_internal);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
@ -1259,27 +1235,18 @@ implementation
{ left side a setdef, must be before string processing,
else array constructor can be seen as array of char (PFV) }
else if (ld.typ=setdef) then
begin
{ trying to add a set element? }
if (nodetype=addn) and (rd.typ<>setdef) then
begin
if (rt=setelementn) then
begin
if not(equal_defs(tsetdef(ld).elementdef,rd)) then
inserttypeconv(right,tsetdef(ld).elementdef);
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 must either be a set or a set element }
if (rd.typ<>setdef) and
(rt<>setelementn) then
CGMessage(type_e_mismatch)
{ Make operands the same setdef. If one's elementtype fits }
{ entirely inside the other's, pick the one with the largest }
{ range. Otherwise create a new setdef with a range which }
{ can contain both. }
if not(equal_defs(ld,rd)) then
else if not(equal_defs(ld,rd)) then
begin
{ note: ld cannot be an empty set with elementdef=nil in }
{ case right is not a set, arrayconstructor_to_set takes }
@ -1292,7 +1259,7 @@ implementation
assigned(tsetdef(rd).elementdef) and
(not assigned(tsetdef(ld).elementdef) or
is_in_limit(ld,rd))) then
inserttypeconv(left,right.resultdef)
inserttypeconv(left,rd)
{ 2: rd is either an empty set without elementdef or a set }
{ whose elementdef fits in ld's elementdef, or a set }
{ element whose def fits in ld's elementdef -> convert }
@ -1303,7 +1270,10 @@ implementation
is_in_limit(rd,ld))) or
((rd.typ<>setdef) and
is_in_limit(rd,tsetdef(ld).elementdef)) then
inserttypeconv(right,left.resultdef)
if (rd.typ=setdef) then
inserttypeconv(right,ld)
else
inserttypeconv(right,tsetdef(ld).elementdef)
{ 3: otherwise create setdef which encompasses both, taking }
{ into account empty sets without elementdef }
else
@ -1334,8 +1304,10 @@ implementation
end;
nd:=tsetdef.create(tsetdef(ld).elementdef,min(llow,rlow),max(lhigh,rhigh));
inserttypeconv(left,nd);
inserttypeconv(right,nd);
end;
if (rd.typ=setdef) then
inserttypeconv(right,nd)
else
inserttypeconv(right,tsetdef(nd).elementdef);
end;
end;
end
@ -1802,6 +1774,10 @@ implementation
end;
end;
end;
if not codegenerror and
not assigned(result) then
result:=simplify;
end;

View File

@ -1958,37 +1958,52 @@ implementation
{ the result of this node tree is downcasted again to a }
{ 8/16/32 bit value afterwards }
function checkremove64bittypeconvs(n: tnode): boolean;
var
gotmuldivmod, gotsint: boolean;
{ checks whether a node is either an u32bit, or originally }
{ was one but was implicitly converted to s64bit }
function wasoriginallyuint32(n: tnode): boolean;
function wasoriginallyint32(n: tnode): boolean;
begin
if (n.resultdef.typ<>orddef) then
exit(false);
if (torddef(n.resultdef).ordtype=u32bit) then
if (torddef(n.resultdef).ordtype in [s32bit,u32bit]) then
begin
if (torddef(n.resultdef).ordtype=s32bit) then
gotsint:=true;
exit(true);
result:=
(torddef(n.resultdef).ordtype=s64bit) and
end;
if (torddef(n.resultdef).ordtype=s64bit) and
{ nf_explicit is also set for explicitly typecasted }
{ ordconstn's }
([nf_internal,nf_explicit]*n.flags=[]) and
{ either a typeconversion node coming from u32bit }
(((n.nodetype=typeconvn) and
(ttypeconvnode(n).left.resultdef.typ=orddef) and
(torddef(ttypeconvnode(n).left.resultdef).ordtype=u32bit)) or
(torddef(ttypeconvnode(n).left.resultdef).ordtype in [s32bit,u32bit])) or
{ or an ordconstnode which was/is a valid cardinal }
((n.nodetype=ordconstn) and
(tordconstnode(n).value>=0) and
(tordconstnode(n).value<=high(cardinal))));
(tordconstnode(n).value>=low(longint)) and
(tordconstnode(n).value<=high(cardinal)))) then
begin
if ((n.nodetype=typeconvn) and
(torddef(ttypeconvnode(n).left.resultdef).ordtype=s32bit)) or
((n.nodetype=ordconstn) and
(tordconstnode(n).value<0)) then
gotsint:=true;
exit(true);
end;
result:=false;
end;
function docheckremove64bittypeconvs(n: tnode): boolean;
begin
result:=false;
if wasoriginallyuint32(n) then
if wasoriginallyint32(n) then
exit(true);
case n.nodetype of
subn:
subn,orn,xorn:
begin
{ nf_internal is set by taddnode.typecheckpass in }
{ case the arguments of this subn were u32bit, but }
@ -2000,18 +2015,28 @@ implementation
result:=true
else
result:=
checkremove64bittypeconvs(tbinarynode(n).left) and
checkremove64bittypeconvs(tbinarynode(n).right);
docheckremove64bittypeconvs(tbinarynode(n).left) and
docheckremove64bittypeconvs(tbinarynode(n).right);
end;
addn,muln,divn,modn,xorn,andn,orn:
addn,muln,divn,modn,andn:
begin
if n.nodetype in [muln,divn,modn] then
gotmuldivmod:=true;
result:=
checkremove64bittypeconvs(tbinarynode(n).left) and
checkremove64bittypeconvs(tbinarynode(n).right);
docheckremove64bittypeconvs(tbinarynode(n).left) and
docheckremove64bittypeconvs(tbinarynode(n).right);
end;
end;
end;
begin { checkremove64bittypeconvs }
gotmuldivmod:=false;
gotsint:=false;
result:=
docheckremove64bittypeconvs(n) and
not(gotmuldivmod and gotsint);
end;
procedure doremove64bittypeconvs(var n: tnode; todef: tdef);
begin

33
tests/test/cg/taddint.pp Normal file
View File

@ -0,0 +1,33 @@
var
b: byte;
s: shortint;
l: longint;
c: cardinal;
i: int64;
begin
b:=10;
s:=-128;
l:=b or s;
writeln(l);
if (l<>-118) then
halt(1);
l:=b xor s;
writeln(l);
if (l<>-118) then
halt(2);
b:=129;
s:=-127;
l:=b and s;
writeln(l);
if (l<>129) then
halt(3);
l:=s and b;
writeln(l);
if (l<>129) then
halt(4);
l:=-127;
c:=129;
i:=l and c;
writeln(i);
end.