paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-06 13:49:38 +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; property VisibleCount:integer read FProcVisibleCnt;
end; 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 const
tok2nodes=24; tok2nodes=24;
tok2node:array[1..tok2nodes] of ttok2noderec=( tok2node:array[1..tok2nodes] of ttok2noderec=(
@ -123,7 +133,7 @@ interface
function isbinaryoverloaded(var t : tnode) : boolean; function isbinaryoverloaded(var t : tnode) : boolean;
{ Register Allocation } { 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); procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
{ procvar handling } { procvar handling }
@ -676,43 +686,68 @@ implementation
****************************************************************************} ****************************************************************************}
{ marks an lvalue as "unregable" } { 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 begin
case p.nodetype of update_regable:=true;
subscriptn: repeat
make_not_regable_intern(tsubscriptnode(p).left,how,true); 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 : typeconvn :
if (ttypeconvnode(p).resultdef.typ = recorddef) then begin
make_not_regable_intern(ttypeconvnode(p).left,how,false) if (ttypeconvnode(p).resultdef.typ = recorddef) then
else records_only:=false;
make_not_regable_intern(ttypeconvnode(p).left,how,records_only); p:=ttypeconvnode(p).left;
end;
loadn : loadn :
if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then begin
begin if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
{ this is overly conservative (make_not_regable is also called in } begin
{ other situations), but it avoids having to do this all over the } if (ra_addr_taken in how) then
{ the compiler } tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true;
tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true; if update_regable and
if (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
((not records_only) or ((not records_only) or
(tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
if (tloadnode(p).symtableentry.typ = paravarsym) then if (tloadnode(p).symtableentry.typ = paravarsym) and
tabstractvarsym(tloadnode(p).symtableentry).varregable:=how (ra_addr_regable in how) then
else tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_addr
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none; else
end; tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
end;
break;
end;
temprefn : temprefn :
begin begin
include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken); if (ra_addr_taken in how) then
if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and 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 ((not records_only) or
(ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg); exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
break;
end; end;
end; else
break;
end;
until false;
end; end;
procedure make_not_regable(p : tnode; how: tvarregable); procedure make_not_regable(p : tnode; how: tregableinfoflags);
begin begin
make_not_regable_intern(p,how,false); make_not_regable_intern(p,how,false);
end; end;
@ -1088,7 +1123,7 @@ implementation
be in a register } be in a register }
if (m_tp7 in current_settings.modeswitches) or if (m_tp7 in current_settings.modeswitches) or
(todef.size<fromdef.size) then (todef.size<fromdef.size) then
make_not_regable(hp,vr_addr) make_not_regable(hp,[ra_addr_regable])
else else
if report_errors then if report_errors then
CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size)); 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 { When the address needs to be pushed then the register is
not regable. Exception is when the location is also a var 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 ( if (
not( not(
(vo_is_hidden_para in parasym.varoptions) and (vo_is_hidden_para in parasym.varoptions) and
(left.resultdef.typ in [pointerdef,classrefdef]) (left.resultdef.typ in [pointerdef,classrefdef])
) and ) and
paramanager.push_addr_param(parasym.varspez,parasym.vardef, paramanager.push_addr_param(parasym.varspez,parasym.vardef,
aktcallnode.procdefinition.proccalloption) and aktcallnode.procdefinition.proccalloption)
not(
(left.nodetype=loadn) and
(tloadnode(left).is_addr_param_load)
)
) then ) 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 if do_count then
begin begin

6
compiler/ncnv.pas
View File

@ -1578,7 +1578,7 @@ implementation
convtype:=tc_equal; convtype:=tc_equal;
if not(tstoreddef(resultdef).is_intregable) and if not(tstoreddef(resultdef).is_intregable) and
not(tstoreddef(resultdef).is_fpuregable) then not(tstoreddef(resultdef).is_fpuregable) then
make_not_regable(left,vr_addr); make_not_regable(left,[ra_addr_regable]);
exit; exit;
end; end;
@ -1731,7 +1731,7 @@ implementation
not(tstoreddef(resultdef).is_fpuregable)) or not(tstoreddef(resultdef).is_fpuregable)) or
((left.resultdef.typ = floatdef) and ((left.resultdef.typ = floatdef) and
(resultdef.typ <> floatdef)) then (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 } { class/interface to class/interface, with checkobject support }
if is_class_or_interface(resultdef) and 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 { 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 } that will load the value in a new register first }
if (resultdef.size<left.resultdef.size) then if (resultdef.size<left.resultdef.size) then
make_not_regable(left,vr_addr); make_not_regable(left,[ra_addr_regable]);
end; end;

5
compiler/nld.pas
View File

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

4
compiler/nmem.pas
View File

@ -353,7 +353,7 @@ implementation
if codegenerror then if codegenerror then
exit; 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 { don't allow constants, for internal use we also
allow taking the address of strings } 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 // don't put records from which we load fields which aren't regable in integer registers
if (left.resultdef.typ = recorddef) and if (left.resultdef.typ = recorddef) and
not(tstoreddef(resultdef).is_intregable) then not(tstoreddef(resultdef).is_intregable) then
make_not_regable(left,vr_addr); make_not_regable(left,[ra_addr_regable]);
end; end;
procedure Tsubscriptnode.mark_write; 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 } { we can't take the size of an open array }
if is_open_array(pt.resultdef) or if is_open_array(pt.resultdef) or
(vs.vardef.size <> pt.resultdef.size) then (vs.vardef.size <> pt.resultdef.size) then
make_not_regable(pt,vr_addr); make_not_regable(pt,[ra_addr_regable]);
end end
else else
Message(parser_e_absolute_only_to_var_or_const); Message(parser_e_absolute_only_to_var_or_const);

2
compiler/rautils.pas
View File

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