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

* optimize away unnecessary implicit upcasts to int64 for subtractions

Browse Source 
of u32bit values on 32 bit platforms (after the int64 values have 
    already been used for overload selection etc, i.e., semantically
    nothing changes)
  + test which checks that not too many typecasts are optimized away

git-svn-id: trunk@9664 -
This commit is contained in:
Jonas Maebe 2008-01-06 23:30:19 +00:00
parent 7fd43e42e8
commit 84159b3cbb
5 changed files with 215 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6585,6 +6585,7 @@ tests/tbs/tb0539.pp svneol=native#text/plain
tests/tbs/tb0540.pp svneol=native#text/x-pascal
tests/tbs/tb0541.pp svneol=native#text/plain
tests/tbs/tb0542.pp svneol=native#text/plain
tests/tbs/tb0543.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain

10
compiler/nadd.pas
View File

@ -1162,6 +1162,16 @@ implementation
begin
if nodetype<>subn then
CGMessage(type_w_mixed_signed_unsigned);
{ mark as internal in case added for a subn, so }
{ ttypeconvnode.simplify can remove the 64 bit }
{ typecast again if semantically correct. Even }
{ if we could detect that here already, we }
{ 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
include(flags,nf_internal);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end

122
compiler/ncnv.pas
View File

@ -1953,6 +1953,96 @@ implementation
end;
{$ifndef cpu64bit}
{ checks whether we can safely remove 64 bit typeconversions }
{ in case range and overflow checking are off, and in case }
{ the result of thise node tree is downcasted again to a }
{ 8/16/32 bit value afterwards }
function checkremove64bittypeconvs(n: tnode): boolean;
{ checks whether a node is either an u32bit, or originally }
{ was one but was implicitly converted to s64bit }
function wasoriginallyuint32(n: tnode): boolean;
begin
if (n.resultdef.typ<>orddef) then
exit(false);
if (torddef(n.resultdef).ordtype=u32bit) then
exit(true);
result:=
(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
{ or an ordconstnode which was/is a valid cardinal }
((n.nodetype=ordconstn) and
(tordconstnode(n).value>=0) and
(tordconstnode(n).value<=high(cardinal))));
end;
begin
result:=false;
if wasoriginallyuint32(n) then
exit(true);
case n.nodetype of
subn:
begin
{ nf_internal is set by taddnode.typecheckpass in }
{ case the arguments of this subn were u32bit, but }
{ upcasted to s64bit for calculation correctness }
{ (normally only needed when range checking, but }
{ also done otherwise so there is no difference }
{ in overload choosing etc between $r+ and $r-) }
if (nf_internal in n.flags) then
result:=true
else
result:=
checkremove64bittypeconvs(tbinarynode(n).left) and
checkremove64bittypeconvs(tbinarynode(n).right);
end;
addn,muln,divn,modn,xorn,andn,orn:
begin
result:=
checkremove64bittypeconvs(tbinarynode(n).left) and
checkremove64bittypeconvs(tbinarynode(n).right);
end;
end;
end;
procedure doremove64bittypeconvs(var n: tnode; todef: tdef);
begin
case n.nodetype of
subn,addn,muln,divn,modn,xorn,andn,orn:
begin
exclude(n.flags,nf_internal);
if is_signed(n.resultdef) then
begin
doremove64bittypeconvs(tbinarynode(n).left,s32inttype);
doremove64bittypeconvs(tbinarynode(n).right,s32inttype);
n.resultdef:=s32inttype
end
else
begin
doremove64bittypeconvs(tbinarynode(n).left,u32inttype);
doremove64bittypeconvs(tbinarynode(n).right,u32inttype);
n.resultdef:=u32inttype
end;
end;
ordconstn:
inserttypeconv_internal(n,todef);
typeconvn:
n.resultdef:=todef;
end;
end;
{$endif not cpu64bit}
function ttypeconvnode.simplify: tnode;
var
hp: tnode;
@ -2041,7 +2131,10 @@ implementation
begin
{ replace the resultdef and recheck the range }
if ([nf_explicit,nf_internal] * flags <> []) then
include(left.flags, nf_explicit);
include(left.flags, nf_explicit)
else
{ no longer an ordconst with an explicit typecast }
exclude(left.flags, nf_explicit);
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
left.resultdef:=resultdef;
result:=left;
@ -2057,7 +2150,10 @@ implementation
begin
left.resultdef:=resultdef;
if ([nf_explicit,nf_internal] * flags <> []) then
include(left.flags, nf_explicit);
include(left.flags, nf_explicit)
else
{ no longer an ordconst with an explicit typecast }
exclude(left.flags, nf_explicit);
result:=left;
left:=nil;
exit;
@ -2074,6 +2170,28 @@ implementation
end;
end;
end;
{$ifndef cpu64bit}
{ must be done before code below, because we need the
typeconversions for ordconstn's as well }
case convtype of
tc_int_2_int:
begin
if (localswitches * [cs_check_range,cs_check_overflow] = []) and
(resultdef.typ in [pointerdef,orddef,enumdef]) and
(resultdef.size <= 4) and
is_64bitint(left.resultdef) and
(left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn]) and
checkremove64bittypeconvs(left) then
begin
{ avoid unnecessary widening of intermediary calculations }
{ to 64 bit }
doremove64bittypeconvs(left,generrordef);
end;
end;
end;
{$endif cpu64bit}
end;

1
compiler/node.pas
View File

@ -240,6 +240,7 @@ interface
nf_novariaallowed,
{ ttypeconvnode, and the first one also treal/ord/pointerconstn }
{ second one also for subtractions of u32-u32 implicitly upcasted to s64 }
nf_explicit,
nf_internal, { no warnings/hints generated }
nf_load_procvar,

83
tests/tbs/tb0543.pp Normal file
View File

@ -0,0 +1,83 @@
procedure check(l: longint; v,c: int64);
begin
if (v<>c) then
begin
writeln('error near ',l);
halt(l);
end;
end;
var
l1,l2,l3: longint;
c1,c2,c3: cardinal;
i: int64;
begin
l1:=low(longint);
l2:=-2;
c1:=$80000000;
c2:=cardinal(-2);
l3:=$80000000 div l2;
writeln(l3);
check(1,l3,-1073741824);
c3:=$80000000 div l2;
writeln(c3);
check(2,c3,3221225472);
i:=$80000000 div l2;
writeln(i);
check(3,i,-1073741824);
l3:=c1 div -2;
writeln(l3);
check(4,l3,-1073741824);
c3:=c1 div -2;
writeln(c3);
check(5,c3,3221225472);
i:=c1 div -2;
writeln(i);
check(6,i,-1073741824);
l3:=c1 div l2;
writeln(l3);
check(7,l3,-1073741824);
c3:=c1 div l2;
writeln(c3);
check(8,c3,3221225472);
i:=c1 div l2;
writeln(i);
check(9,i,-1073741824);
l3:=l1 div c2;
writeln(l3);
check(10,l3,0);
c3:=l1 div c2;
check(11,c3,0);
writeln(c3);
i:=l1 div c2;
writeln(i);
check(12,i,0);
l3:=l1 div cardinal(-2);
writeln(l3);
check(13,l3,0);
c3:=l1 div cardinal(-2);
writeln(c3);
check(14,c3,0);
i:=l1 div cardinal(-2);
writeln(i);
check(15,i,0);
l3:=low(longint) div c2;
writeln(l3);
check(16,l3,0);
c3:=low(longint) div c2;
writeln(c3);
check(17,c3,0);
i:=low(longint) div c2;
writeln(i);
check(18,i,0);
end.