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

* fixed tests/cg/opt/tretopt, and also in more cases

Browse Source 
perform the transformation of x:=f(hiddencomplexresult, ..)
    -> f(x, ...) (the compiler now performs some very
    conservative escape analysis for such types)

git-svn-id: trunk@8361 -
This commit is contained in:
Jonas Maebe 2007-09-02 21:27:37 +00:00
parent f908846dab
commit df84ca49b4
6 changed files with 73 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
compiler/htypechk.pas
View File

@ -687,19 +687,28 @@ implementation
else
make_not_regable_intern(ttypeconvnode(p).left,how,records_only);
loadn :
if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) and
(tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
((not records_only) or
(tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
if (tloadnode(p).symtableentry.typ = paravarsym) then
tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
else
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
begin
{ this is overly conservative (make_not_regable is also called in }
{ other situations), but it avoids having to do this all over the }
{ the compiler }
tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true;
if (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
((not records_only) or
(tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
if (tloadnode(p).symtableentry.typ = paravarsym) then
tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
else
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
end;
temprefn :
if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
((not records_only) or
(ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
begin
include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken);
if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
((not records_only) or
(ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
end;
end;
end;

5
compiler/nbas.pas
View File

@ -94,11 +94,12 @@ interface
ttempcreatenode = class;
ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result);
ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result,
ti_addr_taken);
ttempinfoflags = set of ttempinfoflag;
const
tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result];
tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result,ti_addr_taken];
type
{ to allow access to the location by temp references even after the temp has }

9
compiler/ncal.pas
View File

@ -2472,6 +2472,9 @@ implementation
addstatement(tempinfo^.createstatement,tempnode);
addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
end;
{ inherit addr_taken flag }
if (tabstractvarsym(p).addr_taken) then
include(tempnode.tempinfo^.flags,ti_addr_taken);
inlinelocals[indexnr] := ctemprefnode.create(tempnode);
end;
end;
@ -2629,6 +2632,9 @@ implementation
tempnode := ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size,tt_persistent,tparavarsym(para.parasym).is_regvar(false));
addstatement(createstatement,tempnode);
{ inherit addr_taken flag }
if (tabstractvarsym(para.parasym).addr_taken) then
include(tempnode.tempinfo^.flags,ti_addr_taken);
{ assign the value of the parameter to the temp, except in case of the function result }
{ (in that case, para.left is a block containing the creation of a new temp, while we }
{ only need a temprefnode, so delete the old stuff) }
@ -2657,6 +2663,9 @@ implementation
begin
tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,tparavarsym(para.parasym).is_regvar(true));
addstatement(createstatement,tempnode);
{ inherit addr_taken flag }
if (tabstractvarsym(para.parasym).addr_taken) then
include(tempnode.tempinfo^.flags,ti_addr_taken);
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
caddrnode.create_internal(para.left)));
para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resultdef);

33
compiler/nld.pas
View File

@ -781,6 +781,16 @@ implementation
if codegenerror then
exit;
{ if right is a function call for which the address of the result }
{ is allocated by the caller and passed to the function via an }
{ invisible function result, try to pass the x in "x:=f(...)" as }
{ that function result instead. Condition: x cannot be accessible }
{ from within f. This is the case if x is a temp, or x is a local }
{ variable or value parameter of the current block and its address }
{ is not passed to f. One problem: what if someone takes the }
{ address of x, puts it in a pointer variable/field and then }
{ accesses it that way from within the function? This is solved }
{ (in a conservative way) using the ti_addr_taken/addr_taken flags }
if (cs_opt_level1 in current_settings.optimizerswitches) and
(right.nodetype = calln) and
(right.resultdef=left.resultdef) and
@ -790,7 +800,25 @@ implementation
{ function }
(
(
(left.nodetype = temprefn) and
(((left.nodetype = temprefn) and
not(ti_addr_taken in ttemprefnode(left).tempinfo^.flags) and
not(ti_may_be_in_reg in ttemprefnode(left).tempinfo^.flags)) or
((left.nodetype = loadn) and
{ nested procedures may access the current procedure's locals }
(tcallnode(right).procdefinition.parast.symtablelevel=normal_function_level) and
{ must be a local variable or a value para }
((tloadnode(left).symtableentry.typ = localvarsym) or
((tloadnode(left).symtableentry.typ = paravarsym) and
(tparavarsym(tloadnode(left).symtableentry).varspez = vs_value)
)
) and
{ the address may not have been taken of the variable/parameter, because }
{ otherwise it's possible that the called function can access it via a }
{ global variable or other stored state }
not(tabstractvarsym(tloadnode(left).symtableentry).addr_taken) and
(tabstractvarsym(tloadnode(left).symtableentry).varregable in [vr_none,vr_addr])
)
) and
paramanager.ret_in_param(right.resultdef,tcallnode(right).procdefinition.proccalloption)
) or
{ there's special support for ansi/widestrings in the callnode }
@ -798,7 +826,8 @@ implementation
is_widestring(right.resultdef)
) then
begin
make_not_regable(left,vr_addr);
if assigned(tcallnode(right).funcretnode) then
internalerror(2007080201);
tcallnode(right).funcretnode := left;
result := right;
left := nil;

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=84;
CurrentPPUVersion=85;
{ buffer sizes }
maxentrysize = 1024;

9
compiler/symsym.pas
View File

@ -119,10 +119,15 @@ interface
tabstractvarsym = class(tstoredsym)
varoptions : tvaroptions;
notifications : Tlinkedlist;
varspez : tvarspez; { sets the type of access }
varregable : tvarregable;
varstate : tvarstate;
notifications : Tlinkedlist;
{ Has the address of this variable potentially escaped the }
{ block in which is was declared? }
{ could also be part of tabstractnormalvarsym, but there's }
{ one byte left here till the next 4 byte alignment }
addr_taken : boolean;
constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
destructor destroy;override;
@ -922,6 +927,7 @@ implementation
varstate:=vs_readwritten;
varspez:=tvarspez(ppufile.getbyte);
varregable:=tvarregable(ppufile.getbyte);
addr_taken:=boolean(ppufile.getbyte);
ppufile.getderef(vardefderef);
ppufile.getsmallset(varoptions);
end;
@ -964,6 +970,7 @@ implementation
oldintfcrc:=ppufile.do_crc;
ppufile.do_crc:=false;
ppufile.putbyte(byte(varregable));
ppufile.putbyte(byte(addr_taken));
ppufile.do_crc:=oldintfcrc;
ppufile.putderef(vardefderef);
ppufile.putsmallset(varoptions);