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

* when simplifying ordinal expressions during inlining, keep the resultdef

Browse Source 
that was set during the typecheck pass because typeconversion nodes
    may have been optimised away previously and sometimes the resultdef is
    important (e.g. for the value of callparanodes) (mantis #17458)

git-svn-id: trunk@16101 -
This commit is contained in:
Jonas Maebe 2010-10-07 15:08:52 +00:00
parent d2939bce3d
commit 94d976bc87
14 changed files with 113 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10689,6 +10689,7 @@ tests/webtbs/tw17402a.pp svneol=native#text/pascal
tests/webtbs/tw17413.pp svneol=native#text/plain
tests/webtbs/tw17430.pp svneol=native#text/plain
tests/webtbs/tw1744.pp svneol=native#text/plain
tests/webtbs/tw17458.pp svneol=native#text/plain
tests/webtbs/tw17514.pp svneol=native#text/plain
tests/webtbs/tw17546.pp svneol=native#text/plain
tests/webtbs/tw1754c.pp svneol=native#text/plain

20
compiler/nadd.pas
View File

@ -44,7 +44,7 @@ interface
procedure derefimpl;override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline: boolean) : tnode;override;
function dogetcopy : tnode;override;
function docompare(p: tnode): boolean; override;
{$ifdef state_tracking}
@ -173,7 +173,7 @@ implementation
end;
function taddnode.simplify : tnode;
function taddnode.simplify(forinline : boolean) : tnode;
var
t, hp : tnode;
lt,rt : tnodetype;
@ -277,7 +277,7 @@ implementation
t := cpointerconstnode.create(qword(v),resultdef)
else
if is_integer(ld) then
t := genintconstnode(v)
t := create_simplified_ord_const(v,resultdef,forinline)
else
t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
end;
@ -296,13 +296,13 @@ implementation
begin
if not(nf_has_pointerdiv in flags) then
internalerror(2008030101);
t := genintconstnode(v)
t := cpointerconstnode.create(qword(v),resultdef)
end
else
t := cpointerconstnode.create(qword(v),resultdef)
else
if is_integer(ld) then
t:=genintconstnode(v)
t := create_simplified_ord_const(v,resultdef,forinline)
else
t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
end;
@ -316,21 +316,21 @@ implementation
t:=genintconstnode(0)
end
else
t:=genintconstnode(v)
t := create_simplified_ord_const(v,resultdef,forinline)
end;
xorn :
if is_integer(ld) then
t:=genintconstnode(lv xor rv)
t := create_simplified_ord_const(lv xor rv,resultdef,forinline)
else
t:=cordconstnode.create(lv xor rv,resultdef,true);
orn :
if is_integer(ld) then
t:=genintconstnode(lv or rv)
t:=create_simplified_ord_const(lv or rv,resultdef,forinline)
else
t:=cordconstnode.create(lv or rv,resultdef,true);
andn :
if is_integer(ld) then
t:=genintconstnode(lv and rv)
t:=create_simplified_ord_const(lv and rv,resultdef,forinline)
else
t:=cordconstnode.create(lv and rv,resultdef,true);
ltn :
@ -1890,7 +1890,7 @@ implementation
if not codegenerror and
not assigned(result) then
result:=simplify;
result:=simplify(false);
end;

8
compiler/nbas.pas
View File

@ -70,7 +70,7 @@ interface
tstatementnode = class(tbinarynode)
constructor create(l,r : tnode);virtual;
function simplify : tnode; override;
function simplify(forinline : boolean) : tnode; override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
procedure printnodetree(var t:text);override;
@ -82,7 +82,7 @@ interface
tblocknode = class(tunarynode)
constructor create(l : tnode);virtual;
destructor destroy; override;
function simplify : tnode; override;
function simplify(forinline : boolean) : tnode; override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
{$ifdef state_tracking}
@ -333,7 +333,7 @@ implementation
end;
function tstatementnode.simplify : tnode;
function tstatementnode.simplify(forinline: boolean) : tnode;
begin
result:=nil;
{ these "optimizations" are only to make it more easy to recognise }
@ -456,7 +456,7 @@ implementation
end;
function tblocknode.simplify: tnode;
function tblocknode.simplify(forinline : boolean): tnode;
begin
result := nil;
{ Warning: never replace a blocknode with another node type, }

6
compiler/ncal.pas
View File

@ -3269,12 +3269,12 @@ implementation
if assigned(callinitblock) then
begin
typecheckpass(tnode(callinitblock));
dosimplify(tnode(callinitblock));
doinlinesimplify(tnode(callinitblock));
end;
if assigned(callcleanupblock) then
begin
typecheckpass(tnode(callcleanupblock));
dosimplify(tnode(callcleanupblock));
doinlinesimplify(tnode(callcleanupblock));
end;
{ Continue with checking a normal call or generate the inlined code }
@ -3770,7 +3770,7 @@ implementation
again inside the args or itself }
exclude(procdefinition.procoptions,po_inline);
typecheckpass(tnode(inlineblock));
dosimplify(tnode(inlineblock));
doinlinesimplify(tnode(inlineblock));
firstpass(tnode(inlineblock));
include(procdefinition.procoptions,po_inline);
result:=inlineblock;

8
compiler/ncnv.pas
View File

@ -51,7 +51,7 @@ interface
procedure printnodeinfo(var t : text);override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify:tnode; override;
function simplify(forinline : boolean):tnode; override;
procedure mark_write;override;
function docompare(p: tnode) : boolean; override;
function retains_value_location:boolean;
@ -1752,7 +1752,7 @@ implementation
te_exact,
te_equal :
begin
result := simplify;
result := simplify(false);
if assigned(result) then
exit;
@ -2011,7 +2011,7 @@ implementation
simplify does not do }
if (convtype<>tc_cord_2_pointer) then
begin
result := simplify;
result := simplify(false);
if assigned(result) then
exit;
end;
@ -2137,7 +2137,7 @@ implementation
{$endif not cpu64bitalu}
function ttypeconvnode.simplify: tnode;
function ttypeconvnode.simplify(forinline : boolean): tnode;
var
hp: tnode;
{$ifndef cpu64bitalu}

12
compiler/nflw.pas
View File

@ -86,7 +86,7 @@ interface
constructor create(l,r,_t1 : tnode);virtual;reintroduce;
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
private
function internalsimplify(warn: boolean) : tnode;
end;
@ -102,7 +102,7 @@ interface
procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
end;
tfornodeclass = class of tfornode;
@ -187,7 +187,7 @@ interface
constructor create_implicit(l,r,_t1:tnode);virtual;
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
function simplify: tnode;override;
function simplify(forinline:boolean): tnode;override;
end;
ttryfinallynodeclass = class of ttryfinallynode;
@ -1342,7 +1342,7 @@ implementation
end;
function tifnode.simplify : tnode;
function tifnode.simplify(forinline : boolean) : tnode;
begin
result:=internalsimplify(false);
end;
@ -1433,7 +1433,7 @@ implementation
end;
function tfornode.simplify : tnode;
function tfornode.simplify(forinline : boolean) : tnode;
begin
result:=nil;
if (t1.nodetype=ordconstn) and
@ -2015,7 +2015,7 @@ implementation
end;
function ttryfinallynode.simplify: tnode;
function ttryfinallynode.simplify(forinline : boolean): tnode;
begin
result:=nil;
{ if the try contains no code, we can kill

23
compiler/ninl.pas
View File

@ -39,7 +39,7 @@ interface
function dogetcopy : tnode;override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify: tnode;override;
function simplify(forinline : boolean): tnode;override;
function docompare(p: tnode): boolean; override;
{ pack and unpack are changed into for-loops by the compiler }
@ -1350,7 +1350,7 @@ implementation
end;
function tinlinenode.simplify: tnode;
function tinlinenode.simplify(forinline : boolean): tnode;
function do_lowhigh(def:tdef) : tnode;
var
@ -1545,14 +1545,14 @@ implementation
case inlinenumber of
in_const_abs :
if vl.signed then
hp:=genintconstnode(abs(vl.svalue))
hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline)
else
hp:=genintconstnode(vl.uvalue);
hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline);
in_const_sqr:
if vl.signed then
hp:=genintconstnode(sqr(vl.svalue))
hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline)
else
hp:=genintconstnode(sqr(vl.uvalue));
hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
in_const_odd :
hp:=cordconstnode.create(qword(odd(int64(vl))),booltype,true);
in_const_swap_word :
@ -1741,8 +1741,9 @@ implementation
vl:=tordconstnode(left).value-1;
if is_integer(left.resultdef) then
{ the type of the original integer constant is irrelevant,
it should be automatically adapted to the new value }
result:=genintconstnode(vl)
it should be automatically adapted to the new value
(except when inlining) }
result:=create_simplified_ord_const(vl,resultdef,forinline)
else
{ check the range for enums, chars, booleans }
result:=cordconstnode.create(vl,left.resultdef,true)
@ -1815,7 +1816,9 @@ implementation
end;
in_round_real :
begin
if left.nodetype in [ordconstn,realconstn] then
{ can't evaluate while inlining, may depend on fpu setting }
if (not forinline) and
(left.nodetype in [ordconstn,realconstn]) then
begin
vr:=getconstrealvalue;
if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
@ -2612,7 +2615,7 @@ implementation
if not assigned(result) and not
codegenerror then
result:=simplify;
result:=simplify(false);
end;

4
compiler/nld.pas
View File

@ -73,7 +73,7 @@ interface
function dogetcopy : tnode;override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
{$ifdef state_tracking}
function track_state_pass(exec_known:boolean):boolean;override;
{$endif state_tracking}
@ -493,7 +493,7 @@ implementation
end;
function tassignmentnode.simplify : tnode;
function tassignmentnode.simplify(forinline : boolean) : tnode;
begin
result:=nil;
{ assignment nodes can perform several floating point }

39
compiler/nmat.pas
View File

@ -32,7 +32,7 @@ interface
tmoddivnode = class(tbinopnode)
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
protected
{$ifndef cpu64bitalu}
{ override the following if you want to implement }
@ -47,7 +47,7 @@ interface
tshlshrnode = class(tbinopnode)
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
{$ifndef cpu64bitalu}
{ override the following if you want to implement }
{ parts explicitely in the code generator (CEC)
@ -63,7 +63,7 @@ interface
constructor create(expr : tnode);virtual;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
end;
tunaryminusnodeclass = class of tunaryminusnode;
@ -71,7 +71,7 @@ interface
constructor create(expr : tnode);virtual;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify : tnode;override;
function simplify(forinline : boolean) : tnode;override;
{$ifdef state_tracking}
function track_state_pass(exec_known:boolean):boolean;override;
{$endif}
@ -101,7 +101,7 @@ implementation
TMODDIVNODE
****************************************************************************}
function tmoddivnode.simplify:tnode;
function tmoddivnode.simplify(forinline : boolean):tnode;
var
t : tnode;
rv,lv : tconstexprint;
@ -135,9 +135,9 @@ implementation
case nodetype of
modn:
t:=genintconstnode(lv mod rv);
t:=create_simplified_ord_const(lv mod rv,resultdef,forinline);
divn:
t:=genintconstnode(lv div rv);
t:=create_simplified_ord_const(lv div rv,resultdef,forinline);
end;
result:=t;
exit;
@ -162,7 +162,7 @@ implementation
maybe_call_procvar(left,true);
maybe_call_procvar(right,true);
result:=simplify;
result:=simplify(false);
if assigned(result) then
exit;
@ -451,7 +451,7 @@ implementation
TSHLSHRNODE
****************************************************************************}
function tshlshrnode.simplify:tnode;
function tshlshrnode.simplify(forinline : boolean):tnode;
var
t : tnode;
begin
@ -461,9 +461,9 @@ implementation
begin
case nodetype of
shrn:
t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
t:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline);
shln:
t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
t:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline);
end;
result:=t;
exit;
@ -488,7 +488,7 @@ implementation
maybe_call_procvar(left,true);
maybe_call_procvar(right,true);
result:=simplify;
result:=simplify(false);
if assigned(result) then
exit;
@ -582,13 +582,13 @@ implementation
end;
function tunaryminusnode.simplify:tnode;
function tunaryminusnode.simplify(forinline : boolean):tnode;
begin
result:=nil;
{ constant folding }
if is_constintnode(left) then
begin
result:=genintconstnode(-tordconstnode(left).value);
result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline);
exit;
end;
if is_constrealnode(left) then
@ -612,7 +612,7 @@ implementation
if codegenerror then
exit;
result:=simplify;
result:=simplify(false);
if assigned(result) then
exit;
@ -746,7 +746,7 @@ implementation
end;
function tnotnode.simplify:tnode;
function tnotnode.simplify(forinline : boolean):tnode;
var
v : tconstexprint;
t : tnode;
@ -824,7 +824,10 @@ implementation
else
CGMessage(type_e_mismatch);
end;
t:=cordconstnode.create(v,def,false);
if not forinline then
t:=cordconstnode.create(v,def,false)
else
t:=create_simplified_ord_const(v,resultdef,true);
result:=t;
exit;
end;
@ -846,7 +849,7 @@ implementation
resultdef:=left.resultdef;
result:=simplify;
result:=simplify(false);
if assigned(result) then
exit;

4
compiler/node.pas
View File

@ -337,7 +337,7 @@ interface
{ tries to simplify the node, returns a value <>nil if a simplified
node has been created }
function simplify : tnode;virtual;
function simplify(forinline : boolean) : tnode;virtual;
{$ifdef state_tracking}
{ Does optimizations by keeping track of the variable states
in a procedure }
@ -807,7 +807,7 @@ implementation
end;
function tnode.simplify : tnode;
function tnode.simplify(forinline : boolean) : tnode;
begin
result:=nil;
end;

6
compiler/nset.pas
View File

@ -75,7 +75,7 @@ interface
tinnode = class(tbinopnode)
constructor create(l,r : tnode);virtual;reintroduce;
function pass_typecheck:tnode;override;
function simplify:tnode;override;
function simplify(forinline : boolean):tnode;override;
function pass_1 : tnode;override;
end;
tinnodeclass = class of tinnode;
@ -305,11 +305,11 @@ implementation
exit;
end;
result:=simplify;
result:=simplify(false);
end;
function tinnode.simplify:tnode;
function tinnode.simplify(forinline : boolean):tnode;
var
t : tnode;
begin

31
compiler/nutils.pas
View File

@ -26,7 +26,7 @@ unit nutils;
interface
uses
globtype,
globtype,constexp,
symtype,symsym,symbase,symtable,
node;
@ -80,8 +80,16 @@ interface
function node_resources_fpu(p: tnode): cardinal;
procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo);
{ tries to simplify the given node }
procedure dosimplify(var n : tnode);
{ tries to simplify the given node after inlining }
procedure doinlinesimplify(var n : tnode);
{ creates an ordinal constant, optionally based on the result from a
simplify operation: normally the type is the smallest integer type
that can hold the value, but when inlining the "def" will be used instead,
which was determined during an earlier typecheck pass (because the value
may e.g. be a parameter to a call, which needs to be of the declared
parameter type) }
function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
{ returns true if n is only a tree of administrative nodes
containing no code }
@ -105,7 +113,7 @@ interface
implementation
uses
cutils,verbose,constexp,globals,
cutils,verbose,globals,
symconst,symdef,
defutil,defcmp,
nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl,
@ -970,7 +978,7 @@ implementation
not (lnf_simplify_processing in tloopnode(n).loopflags) then
begin
// Try to simplify condition
dosimplify(tloopnode(n).left);
doinlinesimplify(tloopnode(n).left);
// call directly second part below,
// which might change the loopnode into
// something else if the conditino is a constant node
@ -982,7 +990,7 @@ implementation
end
else
begin
hn:=n.simplify;
hn:=n.simplify(true);
if assigned(hn) then
begin
treechanged := arg;
@ -999,7 +1007,7 @@ implementation
{ tries to simplify the given node calling the simplify method recursively }
procedure dosimplify(var n : tnode);
procedure doinlinesimplify(var n : tnode);
var
treechanged : boolean;
begin
@ -1011,6 +1019,15 @@ implementation
end;
function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode;
begin
if not forinline then
result:=genintconstnode(value)
else
result:=cordconstnode.create(value,def,cs_check_range in current_settings.localswitches);
end;
function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
var
hpropsym : tpropertysym;

2
compiler/pass_1.pas
View File

@ -195,7 +195,7 @@ implementation
begin
{ inlining happens in pass_1 and can cause new }
{ simplify opportunities }
hp:=p.simplify;
hp:=p.simplify(true);
if assigned(hp) then
begin
p.free;

19
tests/webtbs/tw17458.pp Normal file
View File

@ -0,0 +1,19 @@
function TailRecFibonacci(const n: Byte): QWord;
function InnerFibo(const n: Byte; const r1,r2: QWord): QWord; inline;
begin
case n of
0: InnerFibo := r1;
1: InnerFibo := r2;
else InnerFibo := InnerFibo(n - 1,r2,r1 + r2);
end;
end;
begin
TailRecFibonacci := InnerFibo(n,0,1);
end;
begin
if TailRecFibonacci(10)<>55 then
halt(1);
end.