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

* properly fixed allocating procedure symbols, now also works for nested

Browse Source 
procedures

git-svn-id: trunk@2029 -
This commit is contained in:
Jonas Maebe 2005-12-22 20:43:29 +00:00
parent 80fef1e8ad
commit dbf94f4713
2 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/ncgutil.pas
View File

@ -54,6 +54,7 @@ interface
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean; function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
procedure alloc_proc_symbol(pd: tprocdef);
procedure gen_proc_symbol(list:Taasmoutput); procedure gen_proc_symbol(list:Taasmoutput);
procedure gen_proc_symbol_end(list:Taasmoutput); procedure gen_proc_symbol_end(list:Taasmoutput);
procedure gen_proc_entry_code(list:Taasmoutput); procedure gen_proc_entry_code(list:Taasmoutput);
@ -1647,6 +1648,25 @@ implementation
Entry/Exit Entry/Exit
****************************************************************************} ****************************************************************************}
procedure alloc_proc_symbol(pd: tprocdef);
var
sym: tai_symbol;
item: tstringlistitem;
begin
item := tstringlistitem(pd.aliasnames.first);
while assigned(item) do
begin
if (cs_profile in aktmoduleswitches) or
(po_global in current_procinfo.procdef.procoptions) then
sym := Tai_symbol.createname_global(item.str,AT_FUNCTION,0)
else
sym := Tai_symbol.createname(item.str,AT_FUNCTION,0);
sym.free;
item := tstringlistitem(item.next);
end;
end;
procedure gen_proc_symbol(list:Taasmoutput); procedure gen_proc_symbol(list:Taasmoutput);
var var
hs : string; hs : string;

17
compiler/psub.pas
View File

@ -609,7 +609,7 @@ implementation
oldprocinfo : tprocinfo; oldprocinfo : tprocinfo;
oldaktmaxfpuregisters : longint; oldaktmaxfpuregisters : longint;
oldfilepos : tfileposinfo; oldfilepos : tfileposinfo;
templist, symlist : Taasmoutput; templist : Taasmoutput;
headertai : tai; headertai : tai;
curralign : longint; curralign : longint;
begin begin
@ -642,7 +642,6 @@ implementation
aktbreaklabel:=nil; aktbreaklabel:=nil;
aktcontinuelabel:=nil; aktcontinuelabel:=nil;
templist:=Taasmoutput.create; templist:=Taasmoutput.create;
symlist:=Taasmoutput.create;
{ add parast/localst to symtablestack } { add parast/localst to symtablestack }
add_to_symtablestack; add_to_symtablestack;
@ -688,12 +687,6 @@ implementation
set_first_temp_offset; set_first_temp_offset;
generate_parameter_info; generate_parameter_info;
{ allocate the symbol associated with the procedure, so that }
{ references to itself are not treated as references to }
{ externals }
aktfilepos:=entrypos;
gen_proc_symbol(symlist);
{ Allocate space in temp/registers for parast and localst } { Allocate space in temp/registers for parast and localst }
aktfilepos:=entrypos; aktfilepos:=entrypos;
gen_alloc_symtable(aktproccode,procdef.parast); gen_alloc_symtable(aktproccode,procdef.parast);
@ -783,9 +776,10 @@ implementation
{ generate symbol and save end of header position } { generate symbol and save end of header position }
aktfilepos:=entrypos; aktfilepos:=entrypos;
headertai:=tai(symlist.last); gen_proc_symbol(templist);
headertai:=tai(templist.last);
{ insert symbol } { insert symbol }
aktproccode.insertlist(symlist); aktproccode.insertlist(templist);
{ Free space in temp/registers for parast and localst, must be { Free space in temp/registers for parast and localst, must be
done after gen_entry_code } done after gen_entry_code }
@ -911,6 +905,9 @@ implementation
var var
_class,hp : tobjectdef; _class,hp : tobjectdef;
begin begin
{ allocate the symbol for this procedure }
alloc_proc_symbol(procdef);
{ insert symtables for the class, but only if it is no nested function } { insert symtables for the class, but only if it is no nested function }
if assigned(procdef._class) and if assigned(procdef._class) and
not(assigned(parent) and not(assigned(parent) and