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

* Improvements of tprocinfo class:

Browse Source 
* Moved nestedprocs from tcgprocinfo to tprocinfo, in order to be able to access the entire nested procedure hierarchy without depending on psub.pas or code generator.
  * Creating an instance of tprocinfo automatically inserts it into list of parent's nested procedures.
  * nestedprocs list is created on demand. Public read-only access is provided by has_nestedprocs and get_first_nestedproc functions.
  + Method destroy_tree is provided for destroying the entire hierarchy of procinfo's. It can be called on any procinfo object in the tree.
  + Also added methods save_jump_labels and restore_jump_labels for asmlabel maintenance, which is currently being repeatedly done all over the codegenerator.

git-svn-id: trunk@17197 -
This commit is contained in:
sergei 2011-03-27 17:21:48 +00:00
parent ad52fe0f23
commit 1c01d52ea6
4 changed files with 74 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/fmodule.pas
View File

@ -544,7 +544,6 @@ implementation
destructor tmodule.Destroy;
var
i : longint;
hpi : tprocinfo;
begin
if assigned(unitmap) then
freemem(unitmap);
@ -582,12 +581,7 @@ implementation
current_specializedef:=nil;
end;
{ release procinfo tree }
while assigned(procinfo) do
begin
hpi:=tprocinfo(procinfo).parent;
tprocinfo(procinfo).free;
procinfo:=hpi;
end;
tprocinfo(procinfo).destroy_tree;
end;
DoneDebugInfo(self);
used_units.free;
@ -642,7 +636,6 @@ implementation
procedure tmodule.reset;
var
hpi : tprocinfo;
i : longint;
begin
if assigned(scanner) then
@ -664,12 +657,7 @@ implementation
current_specializedef:=nil;
end;
{ release procinfo tree }
while assigned(procinfo) do
begin
hpi:=tprocinfo(procinfo).parent;
tprocinfo(procinfo).free;
procinfo:=hpi;
end;
tprocinfo(procinfo).destroy_tree;
end;
if assigned(asmdata) then
begin

65
compiler/procinfo.pas
View File

@ -47,10 +47,17 @@ unit procinfo;
type
tsavedlabels = array[Boolean] of TAsmLabel;
{# This object gives information on the current routine being
compiled.
}
tprocinfo = class(tlinkedlistitem)
private
{ list to store the procinfo's of the nested procedures }
nestedprocs : tlinkedlist;
procedure addnestedproc(child: tprocinfo);
public
{ pointer to parent in nested procedures }
parent : tprocinfo;
{# the definition of the routine itself }
@ -123,6 +130,18 @@ unit procinfo;
{ Allocate got register }
procedure allocate_got_register(list: TAsmList);virtual;
{ Destroy the entire procinfo tree, starting from the outermost parent }
procedure destroy_tree;
{ Store CurrTrueLabel and CurrFalseLabel to saved and generate new ones }
procedure save_jump_labels(out saved: tsavedlabels);
{ Restore CurrTrueLabel and CurrFalseLabel from saved }
procedure restore_jump_labels(const saved: tsavedlabels);
function get_first_nestedproc: tprocinfo;
function has_nestedprocs: boolean;
end;
tcprocinfo = class of tprocinfo;
@ -165,15 +184,61 @@ implementation
CurrTrueLabel:=nil;
CurrFalseLabel:=nil;
maxpushedparasize:=0;
if Assigned(parent) and (parent.procdef.parast.symtablelevel>=normal_function_level) then
parent.addnestedproc(Self);
end;
destructor tprocinfo.destroy;
begin
nestedprocs.free;
aktproccode.free;
aktlocaldata.free;
end;
procedure tprocinfo.destroy_tree;
var
hp: tprocinfo;
begin
hp:=Self;
while Assigned(hp.parent) do
hp:=hp.parent;
hp.Free;
end;
procedure tprocinfo.addnestedproc(child: tprocinfo);
begin
if nestedprocs=nil then
nestedprocs:=TLinkedList.Create;
nestedprocs.insert(child);
end;
function tprocinfo.get_first_nestedproc: tprocinfo;
begin
if assigned(nestedprocs) then
result:=tprocinfo(nestedprocs.first)
else
result:=nil;
end;
function tprocinfo.has_nestedprocs: boolean;
begin
result:=assigned(nestedprocs) and (nestedprocs.count>0);
end;
procedure tprocinfo.save_jump_labels(out saved: tsavedlabels);
begin
saved[false]:=CurrFalseLabel;
saved[true]:=CurrTrueLabel;
current_asmdata.getjumplabel(CurrTrueLabel);
current_asmdata.getjumplabel(CurrFalseLabel);
end;
procedure tprocinfo.restore_jump_labels(const saved: tsavedlabels);
begin
CurrFalseLabel:=saved[false];
CurrTrueLabel:=saved[true];
end;
procedure tprocinfo.allocate_push_parasize(size:longint);
begin

25
compiler/psub.pas
View File

@ -45,10 +45,7 @@ interface
stackcheck_asmnode,
init_asmnode,
final_asmnode : tasmnode;
{ list to store the procinfo's of the nested procedures }
nestedprocs : tlinkedlist;
dfabuilder : TDFABuilder;
constructor create(aparent:tprocinfo);override;
destructor destroy;override;
procedure printproc(pass:string);
procedure generate_code;
@ -555,16 +552,8 @@ implementation
TCGProcInfo
****************************************************************************}
constructor tcgprocinfo.create(aparent:tprocinfo);
begin
inherited Create(aparent);
nestedprocs:=tlinkedlist.create;
end;
destructor tcgprocinfo.destroy;
begin
nestedprocs.free;
if assigned(code) then
code.free;
inherited destroy;
@ -794,10 +783,10 @@ implementation
function tcgprocinfo.has_assembler_child : boolean;
var
hp : tcgprocinfo;
hp : tprocinfo;
begin
result:=false;
hp:=tcgprocinfo(nestedprocs.first);
hp:=get_first_nestedproc;
while assigned(hp) do
begin
if (hp.flags*[pi_has_assembler_block,pi_is_assembler])<>[] then
@ -805,7 +794,7 @@ implementation
result:=true;
exit;
end;
hp:=tcgprocinfo(hp.next);
hp:=tprocinfo(hp.next);
end;
end;
@ -1549,7 +1538,7 @@ implementation
{ generate code for this procedure }
pi.generate_code;
{ process nested procs }
hpi:=tcgprocinfo(pi.nestedprocs.first);
hpi:=tcgprocinfo(pi.get_first_nestedproc);
while assigned(hpi) do
begin
do_generate_code(hpi);
@ -1602,7 +1591,7 @@ implementation
{ We can't support inlining for procedures that have nested
procedures because the nested procedures use a fixed offset
for accessing locals in the parent procedure (PFV) }
if (tcgprocinfo(current_procinfo).nestedprocs.count>0) then
if current_procinfo.has_nestedprocs then
begin
if (df_generic in current_procinfo.procdef.defoptions) then
Comment(V_Error,'Generic methods cannot have nested procedures')
@ -1618,9 +1607,7 @@ implementation
{ When it's a nested procedure then defer the code generation,
when back at normal function level then generate the code
for all defered nested procedures and the current procedure }
if isnestedproc then
tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
else
if not isnestedproc then
begin
if not(df_generic in current_procinfo.procdef.defoptions) then
do_generate_code(tcgprocinfo(current_procinfo));

2
compiler/regvars.pas
View File

@ -148,7 +148,7 @@ implementation
if (cs_opt_regvar in current_settings.optimizerswitches) and
{ we have to store regvars back to memory in this case (the nested }
{ procedures can access the variables of the parent) }
(tcgprocinfo(current_procinfo).nestedprocs.count = 0) and
(not current_procinfo.has_nestedprocs) and
not(pi_has_assembler_block in current_procinfo.flags) and
not(pi_uses_exceptions in current_procinfo.flags) then
begin