paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 05:49:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Improved escape analysis so the improved tretopt no longer fails.

Browse Source 
The downside is that because it is context-insensitive, several
    (correct) optimizations which were performed in the past no longer
    are now (and while some new ones are done now, the downside is bigger
    -- but at least the code should be correct in all cases now)

git-svn-id: trunk@8385 -
This commit is contained in:
Jonas Maebe 2007-09-05 13:29:22 +00:00
parent 0a9b94ca92
commit e1aefdbac5
7 changed files with 89 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
compiler/htypechk.pas
View File

@ -79,6 +79,16 @@ interface
property VisibleCount:integer read FProcVisibleCnt;
end;
type
tregableinfoflag = (
// can be put in a register if it's the address of a var/out/const parameter
ra_addr_regable,
// orthogonal to above flag: the address of the node is taken and may
// possibly escape the block in which this node is declared (e.g. a
// local variable is passed as var parameter to another procedure)
ra_addr_taken);
tregableinfoflags = set of tregableinfoflag;
const
tok2nodes=24;
tok2node:array[1..tok2nodes] of ttok2noderec=(
@ -123,7 +133,7 @@ interface
function isbinaryoverloaded(var t : tnode) : boolean;
{ Register Allocation }
procedure make_not_regable(p : tnode; how: tvarregable);
procedure make_not_regable(p : tnode; how: tregableinfoflags);
procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
{ procvar handling }
@ -676,43 +686,68 @@ implementation
****************************************************************************}
{ marks an lvalue as "unregable" }
procedure make_not_regable_intern(p : tnode; how: tvarregable; records_only: boolean);
procedure make_not_regable_intern(p : tnode; how: tregableinfoflags; records_only: boolean);
var
update_regable: boolean;
begin
case p.nodetype of
subscriptn:
make_not_regable_intern(tsubscriptnode(p).left,how,true);
update_regable:=true;
repeat
case p.nodetype of
subscriptn:
begin
records_only:=true;
p:=tsubscriptnode(p).left;
end;
vecn:
begin
{ arrays are currently never regable and pointers indexed like }
{ arrays do not have be made unregable, but we do need to }
{ propagate the ra_addr_taken info }
update_regable:=false;
p:=tvecnode(p).left;
end;
typeconvn :
if (ttypeconvnode(p).resultdef.typ = recorddef) then
make_not_regable_intern(ttypeconvnode(p).left,how,false)
else
make_not_regable_intern(ttypeconvnode(p).left,how,records_only);
begin
if (ttypeconvnode(p).resultdef.typ = recorddef) then
records_only:=false;
p:=ttypeconvnode(p).left;
end;
loadn :
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;
begin
if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
begin
if (ra_addr_taken in how) then
tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true;
if update_regable 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) and
(ra_addr_regable in how) then
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_addr
else
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
end;
break;
end;
temprefn :
begin
include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken);
if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
if (ra_addr_taken in how) then
include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken);
if update_regable and
(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);
break;
end;
end;
else
break;
end;
until false;
end;
procedure make_not_regable(p : tnode; how: tvarregable);
procedure make_not_regable(p : tnode; how: tregableinfoflags);
begin
make_not_regable_intern(p,how,false);
end;
@ -1088,7 +1123,7 @@ implementation
be in a register }
if (m_tp7 in current_settings.modeswitches) or
(todef.size<fromdef.size) then
make_not_regable(hp,vr_addr)
make_not_regable(hp,[ra_addr_regable])
else
if report_errors then
CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));

22
compiler/ncal.pas
View File

@ -987,20 +987,28 @@ implementation
{ When the address needs to be pushed then the register is
not regable. Exception is when the location is also a var
parameter and we can pass the address transparently }
parameter and we can pass the address transparently (but
that is handled by make_not_regable if ra_addr_regable is
passed, and make_not_regable always needs to called for
the ra_addr_taken info for non-invisble parameters }
if (
not(
(vo_is_hidden_para in parasym.varoptions) and
(left.resultdef.typ in [pointerdef,classrefdef])
) and
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
aktcallnode.procdefinition.proccalloption) and
not(
(left.nodetype=loadn) and
(tloadnode(left).is_addr_param_load)
)
aktcallnode.procdefinition.proccalloption)
) then
make_not_regable(left,vr_addr);
{ pushing the address of a variable to take the place of a temp }
{ as the complex function result of a function does not make its }
{ address escape the current block, as the "address of the }
{ function result" is not something which can be stored }
{ persistently by the callee (it becomes invalid when the callee }
{ returns) }
if not(vo_is_funcret in parasym.varoptions) then
make_not_regable(left,[ra_addr_regable,ra_addr_taken])
else
make_not_regable(left,[ra_addr_regable]);
if do_count then
begin

6
compiler/ncnv.pas
View File

@ -1578,7 +1578,7 @@ implementation
convtype:=tc_equal;
if not(tstoreddef(resultdef).is_intregable) and
not(tstoreddef(resultdef).is_fpuregable) then
make_not_regable(left,vr_addr);
make_not_regable(left,[ra_addr_regable]);
exit;
end;
@ -1731,7 +1731,7 @@ implementation
not(tstoreddef(resultdef).is_fpuregable)) or
((left.resultdef.typ = floatdef) and
(resultdef.typ <> floatdef)) then
make_not_regable(left,vr_addr);
make_not_regable(left,[ra_addr_regable]);
{ class/interface to class/interface, with checkobject support }
if is_class_or_interface(resultdef) and
@ -2644,7 +2644,7 @@ implementation
{ When using only a part of the value it can't be in a register since
that will load the value in a new register first }
if (resultdef.size<left.resultdef.size) then
make_not_regable(left,vr_addr);
make_not_regable(left,[ra_addr_regable]);
end;

5
compiler/nld.pas
View File

@ -272,7 +272,7 @@ implementation
(symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
(current_procinfo.procdef.proctypeoption=potype_unitfinalize)
) then
make_not_regable(self,vr_none);
make_not_regable(self,[ra_addr_taken]);
resultdef:=tabstractvarsym(symtableentry).vardef;
end;
paravarsym,
@ -291,7 +291,8 @@ implementation
{ we can't inline the referenced parent procedure }
exclude(tprocdef(symtable.defowner).procoptions,po_inline);
{ reference in nested procedures, variable needs to be in memory }
make_not_regable(self,vr_none);
{ and behaves as if its address escapes its parent block }
make_not_regable(self,[ra_addr_taken]);
end;
{ fix self type which is declared as voidpointer in the
definition }

4
compiler/nmem.pas
View File

@ -353,7 +353,7 @@ implementation
if codegenerror then
exit;
make_not_regable(left,vr_addr);
make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
{ don't allow constants, for internal use we also
allow taking the address of strings }
@ -607,7 +607,7 @@ implementation
// don't put records from which we load fields which aren't regable in integer registers
if (left.resultdef.typ = recorddef) and
not(tstoreddef(resultdef).is_intregable) then
make_not_regable(left,vr_addr);
make_not_regable(left,[ra_addr_regable]);
end;
procedure Tsubscriptnode.mark_write;

2
compiler/pdecvar.pas
View File

@ -974,7 +974,7 @@ implementation
{ we can't take the size of an open array }
if is_open_array(pt.resultdef) or
(vs.vardef.size <> pt.resultdef.size) then
make_not_regable(pt,vr_addr);
make_not_regable(pt,[ra_addr_regable]);
end
else
Message(parser_e_absolute_only_to_var_or_const);

2
compiler/rautils.pas
View File

@ -802,6 +802,8 @@ Begin
inc(tabstractvarsym(sym).refs);
{ variable can't be placed in a register }
tabstractvarsym(sym).varregable:=vr_none;
{ and anything may happen with its address }
tabstractvarsym(sym).addr_taken:=true;
case sym.typ of
staticvarsym :
begin