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

* parent framepointer changed to hidden parameter

Browse Source 
* tloadparentfpnode added
This commit is contained in:
peter 2003-09-28 17:55:03 +00:00
parent a561878746
commit 99bb20747e
17 changed files with 270 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compiler/cgbase.pas
View File

@ -72,14 +72,6 @@ unit cgbase;
entryswitches : tlocalswitches; entryswitches : tlocalswitches;
{ local switches at end of procedure } { local switches at end of procedure }
exitswitches : tlocalswitches; exitswitches : tlocalswitches;
{# offset from frame pointer to get parent frame pointer reference
(used in nested routines only)
On the PowerPC, this is used to store the offset where the
frame pointer from the outer procedure is stored.
}
parent_framepointer_offset : longint;
{# firsttemp position }
firsttemp_offset : longint;
{ Size of the parameters on the stack } { Size of the parameters on the stack }
para_stack_size : longint; para_stack_size : longint;
@ -108,8 +100,6 @@ unit cgbase;
constructor create(aparent:tprocinfo);virtual; constructor create(aparent:tprocinfo);virtual;
destructor destroy;override; destructor destroy;override;
procedure allocate_parent_framepointer_parameter;virtual;
{ Allocate framepointer so it can not be used by the { Allocate framepointer so it can not be used by the
register allocator } register allocator }
procedure allocate_framepointer_reg;virtual; procedure allocate_framepointer_reg;virtual;
@ -310,9 +300,6 @@ implementation
parent:=aparent; parent:=aparent;
procdef:=nil; procdef:=nil;
para_stack_size:=0; para_stack_size:=0;
{$warning TODO maybe remove parent_framepointer_offset for i386}
parent_framepointer_offset:=0;
firsttemp_offset:=0;
flags:=[]; flags:=[];
framepointer:=NR_FRAME_POINTER_REG; framepointer:=NR_FRAME_POINTER_REG;
{ asmlists } { asmlists }
@ -331,12 +318,6 @@ implementation
end; end;
procedure tprocinfo.allocate_parent_framepointer_parameter;
begin
parent_framepointer_offset:=target_info.first_parm_offset;
end;
procedure tprocinfo.allocate_framepointer_reg; procedure tprocinfo.allocate_framepointer_reg;
begin begin
if framepointer=NR_FRAME_POINTER_REG then if framepointer=NR_FRAME_POINTER_REG then
@ -369,13 +350,6 @@ implementation
procedure tprocinfo.handle_body_start; procedure tprocinfo.handle_body_start;
begin begin
(*
{ temporary space is set, while the BEGIN of the procedure }
if (symtablestack.symtabletype=localsymtable) then
current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
else
current_procinfo.firsttemp_offset := 0;
*)
end; end;
@ -546,7 +520,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.65 2003-09-25 21:25:13 peter Revision 1.66 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.65 2003/09/25 21:25:13 peter
* remove allocate_intterupt_parameter, allocation is platform * remove allocate_intterupt_parameter, allocation is platform
dependent and needs to be done in create_paraloc_info dependent and needs to be done in create_paraloc_info

34
compiler/cgobj.pas
View File

@ -285,9 +285,6 @@ unit cgobj;
} }
procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual; procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
procedure g_load_parent_framepointer(list:taasmoutput;parentsymtable:tsymtable;reg:tregister);
procedure g_save_parent_framepointer_param(list:taasmoutput);virtual;
procedure g_maybe_testself(list : taasmoutput;reg:tregister); procedure g_maybe_testself(list : taasmoutput;reg:tregister);
procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef); procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
{# This should emit the opcode to copy len bytes from the source {# This should emit the opcode to copy len bytes from the source
@ -1079,31 +1076,6 @@ unit cgobj;
end; end;
procedure tcg.g_load_parent_framepointer(list:taasmoutput;parentsymtable:tsymtable;reg:tregister);
var
href : treference;
i : integer;
begin
{ make a reference }
reference_reset_base(href,current_procinfo.framepointer,PARENT_FRAMEPOINTER_OFFSET);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
{ walk parents }
i:=current_procinfo.procdef.parast.symtablelevel-1;
while (i>parentsymtable.symtablelevel) do
begin
{ make a reference }
reference_reset_base(href,reg,PARENT_FRAMEPOINTER_OFFSET);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
dec(i);
end;
end;
procedure tcg.g_save_parent_framepointer_param(list:taasmoutput);
begin
end;
procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean); procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
var var
paraloc1,paraloc2,paraloc3 : tparalocation; paraloc1,paraloc2,paraloc3 : tparalocation;
@ -1552,7 +1524,11 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.124 2003-09-28 13:40:13 peter Revision 1.125 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.124 2003/09/28 13:40:13 peter
* a_call_ref removed * a_call_ref removed
Revision 1.123 2003/09/25 21:26:24 peter Revision 1.123 2003/09/25 21:26:24 peter

12
compiler/i386/cpupara.pas
View File

@ -252,9 +252,6 @@ unit cpupara;
parasize : longint; parasize : longint;
begin begin
parasize:=0; parasize:=0;
{$warning HACK: framepointer reg shall be a normal parameter}
if p.parast.symtablelevel>normal_function_level then
inc(parasize,POINTER_SIZE);
{ we push Flags and CS as long { we push Flags and CS as long
to cope with the IRETD to cope with the IRETD
and we save 6 register + 4 selectors } and we save 6 register + 4 selectors }
@ -303,9 +300,6 @@ unit cpupara;
begin begin
parareg:=0; parareg:=0;
parasize:=0; parasize:=0;
{$warning HACK: framepointer reg shall be a normal parameter}
if p.parast.symtablelevel>normal_function_level then
inc(parareg);
hp:=tparaitem(p.para.first); hp:=tparaitem(p.para.first);
while assigned(hp) do while assigned(hp) do
begin begin
@ -387,7 +381,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.32 2003-09-28 13:35:24 peter Revision 1.33 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.32 2003/09/28 13:35:24 peter
* register calling updates * register calling updates
Revision 1.31 2003/09/25 21:30:11 peter Revision 1.31 2003/09/25 21:30:11 peter

13
compiler/ncal.pas
View File

@ -1853,6 +1853,13 @@ type
if vo_is_vmt in tvarsym(currpara.parasym).varoptions then if vo_is_vmt in tvarsym(currpara.parasym).varoptions then
begin begin
hiddentree:=gen_vmt_tree; hiddentree:=gen_vmt_tree;
end
else
if vo_is_parentfp in tvarsym(currpara.parasym).varoptions then
begin
if not(assigned(procdefinition.owner.defowner)) then
internalerror(200309287);
hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner));
end; end;
{ add the hidden parameter } { add the hidden parameter }
if not assigned(hiddentree) then if not assigned(hiddentree) then
@ -2513,7 +2520,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.182 2003-09-25 21:28:00 peter Revision 1.183 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.182 2003/09/25 21:28:00 peter
* parameter fixes * parameter fixes
Revision 1.181 2003/09/23 17:56:05 peter Revision 1.181 2003/09/23 17:56:05 peter

57
compiler/ncgcal.pas
View File

@ -59,8 +59,6 @@ interface
} }
function align_parasize:longint;virtual; function align_parasize:longint;virtual;
procedure pop_parasize(pop_size:longint);virtual; procedure pop_parasize(pop_size:longint);virtual;
procedure push_framepointer;virtual;
procedure free_pushed_framepointer;virtual;
procedure extra_interrupt_code;virtual; procedure extra_interrupt_code;virtual;
public public
procedure pass_2;override; procedure pass_2;override;
@ -261,43 +259,6 @@ implementation
end; end;
procedure tcgcallnode.push_framepointer;
var
href : treference;
hregister : tregister;
begin
framepointer_paraloc:=paramanager.getintparaloc(procdefinition.proccalloption,1);
paramanager.allocparaloc(exprasmlist,framepointer_paraloc);
{ this routine is itself not nested }
if current_procinfo.procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
begin
reference_reset_base(href,current_procinfo.framepointer,current_procinfo.parent_framepointer_offset);
cg.a_param_ref(exprasmlist,OS_ADDR,href,framepointer_paraloc);
end
{ one nesting level }
else if (current_procinfo.procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
begin
cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,framepointer_paraloc);
end
{ very complex nesting level ... }
else if (current_procinfo.procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
begin
hregister:=rg.getaddressregister(exprasmlist);
{ we need to push the framepointer of the owner of the called
nested procedure }
cg.g_load_parent_framepointer(exprasmlist,procdefinition.owner,hregister);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,framepointer_paraloc);
rg.ungetaddressregister(exprasmlist,hregister);
end;
end;
procedure tcgcallnode.free_pushed_framepointer;
begin
paramanager.freeparaloc(exprasmlist,framepointer_paraloc);
end;
procedure tcgcallnode.handle_return_value; procedure tcgcallnode.handle_return_value;
var var
cgsize : tcgsize; cgsize : tcgsize;
@ -525,12 +486,6 @@ implementation
paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]); paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
ppn:=tcgcallparanode(ppn.right); ppn:=tcgcallparanode(ppn.right);
end; end;
{ free pushed base pointer }
if (right=nil) and
(current_procinfo.procdef.parast.symtablelevel>=normal_function_level) and
assigned(tprocdef(procdefinition).parast) and
((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
free_pushed_framepointer;
end; end;
begin begin
@ -632,12 +587,6 @@ implementation
cg.g_maybe_testvmt(exprasmlist,methodpointer.location.register,tprocdef(procdefinition)._class); cg.g_maybe_testvmt(exprasmlist,methodpointer.location.register,tprocdef(procdefinition)._class);
end; end;
{ push base pointer ?}
if (current_procinfo.procdef.parast.symtablelevel>=normal_function_level) and
assigned(tprocdef(procdefinition).parast) and
((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
push_framepointer;
rg.saveotherregvars(exprasmlist,regs_to_push_other); rg.saveotherregvars(exprasmlist,regs_to_push_other);
if (po_virtualmethod in procdefinition.procoptions) and if (po_virtualmethod in procdefinition.procoptions) and
@ -1162,7 +1111,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.118 2003-09-28 13:54:43 peter Revision 1.119 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.118 2003/09/28 13:54:43 peter
* removed a_call_ref * removed a_call_ref
Revision 1.117 2003/09/25 21:28:00 peter Revision 1.117 2003/09/25 21:28:00 peter

25
compiler/ncgld.pas
View File

@ -172,6 +172,18 @@ implementation
cg.a_label(exprasmlist,endrelocatelab); cg.a_label(exprasmlist,endrelocatelab);
location.reference.base:=hregister; location.reference.base:=hregister;
end end
{ nested variable }
else if assigned(left) then
begin
if not(symtabletype in [localsymtable,parasymtable]) then
internalerror(200309285);
secondpass(left);
if left.location.loc<>LOC_REGISTER then
internalerror(200309286);
hregister:=left.location.register;
location.reference.base:=hregister;
location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
end
{ normal variable } { normal variable }
else else
begin begin
@ -211,13 +223,6 @@ implementation
internalerror(2003091816); internalerror(2003091816);
location.reference.base:=tvarsym(symtableentry).localloc.reference.index; location.reference.base:=tvarsym(symtableentry).localloc.reference.index;
location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset; location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
if (current_procinfo.procdef.parast.symtablelevel>symtable.symtablelevel) then
begin
hregister:=rg.getaddressregister(exprasmlist);
cg.g_load_parent_framepointer(exprasmlist,symtable,hregister);
location.reference.base:=hregister;
end;
end; end;
globalsymtable, globalsymtable,
staticsymtable : staticsymtable :
@ -916,7 +921,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.85 2003-09-28 13:39:38 peter Revision 1.86 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.85 2003/09/28 13:39:38 peter
* optimized releasing of registers * optimized releasing of registers
Revision 1.84 2003/09/25 21:27:31 peter Revision 1.84 2003/09/25 21:27:31 peter

63
compiler/ncgmem.pas
View File

@ -38,6 +38,10 @@ interface
procedure pass_2;override; procedure pass_2;override;
end; end;
tcgloadparentfpnode = class(tloadparentfpnode)
procedure pass_2;override;
end;
tcgaddrnode = class(taddrnode) tcgaddrnode = class(taddrnode)
procedure pass_2;override; procedure pass_2;override;
end; end;
@ -72,6 +76,7 @@ interface
procedure pass_2;override; procedure pass_2;override;
end; end;
implementation implementation
uses uses
@ -94,7 +99,7 @@ implementation
{***************************************************************************** {*****************************************************************************
TCGLOADNODE TCGLOADVMTADDRNODE
*****************************************************************************} *****************************************************************************}
procedure tcgloadvmtaddrnode.pass_2; procedure tcgloadvmtaddrnode.pass_2;
@ -162,6 +167,55 @@ implementation
end; end;
{*****************************************************************************
TCGLOADPARENTFPNODE
*****************************************************************************}
procedure tcgloadparentfpnode.pass_2;
var
currpi : tprocinfo;
hsym : tvarsym;
href : treference;
begin
if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=current_procinfo.framepointer;
end
else
begin
currpi:=current_procinfo;
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=rg.getaddressregister(exprasmlist);
{ load framepointer of current proc }
hsym:=tvarsym(currpi.procdef.parast.search('parentfp'));
if not assigned(hsym) then
internalerror(200309281);
case hsym.localloc.loc of
LOC_REFERENCE :
begin
reference_reset_base(href,hsym.localloc.reference.index,hsym.localloc.reference.offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
end;
LOC_REGISTER :
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hsym.localloc.register,location.register);
end;
{ walk parents }
while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do
begin
hsym:=tvarsym(currpi.procdef.parast.search('parentfp'));
if not assigned(hsym) then
internalerror(200309282);
if hsym.localloc.loc<>LOC_REFERENCE then
internalerror(200309283);
reference_reset_base(href,location.register,hsym.localloc.reference.offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
currpi:=currpi.parent;
end;
end;
end;
{***************************************************************************** {*****************************************************************************
TCGADDRNODE TCGADDRNODE
*****************************************************************************} *****************************************************************************}
@ -803,6 +857,7 @@ implementation
begin begin
cloadvmtaddrnode:=tcgloadvmtaddrnode; cloadvmtaddrnode:=tcgloadvmtaddrnode;
cloadparentfpnode:=tcgloadparentfpnode;
caddrnode:=tcgaddrnode; caddrnode:=tcgaddrnode;
cderefnode:=tcgderefnode; cderefnode:=tcgderefnode;
csubscriptnode:=tcgsubscriptnode; csubscriptnode:=tcgsubscriptnode;
@ -811,7 +866,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.73 2003-09-23 17:56:05 peter Revision 1.74 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.73 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure

14
compiler/ncgutil.pas
View File

@ -1524,10 +1524,6 @@ implementation
if assigned(current_procinfo.procdef.parast) and if assigned(current_procinfo.procdef.parast) and
not (po_assembler in current_procinfo.procdef.procoptions) then not (po_assembler in current_procinfo.procdef.procoptions) then
begin begin
{ save framepointer in memory }
if current_procinfo.procdef.parast.symtablelevel>normal_function_level then
cg.g_save_parent_framepointer_param(list);
{ move register parameters which aren't regable into memory } { move register parameters which aren't regable into memory }
{ we do this before init_paras because that one calls routines which may overwrite these } { we do this before init_paras because that one calls routines which may overwrite these }
{ registers and it also expects the values to be in memory } { registers and it also expects the values to be in memory }
@ -1635,11 +1631,11 @@ implementation
begin begin
{ define calling EBP as pseudo local var PM } { define calling EBP as pseudo local var PM }
{ this enables test if the function is a local one !! } { this enables test if the function is a local one !! }
if assigned(current_procinfo.parent) and {if assigned(current_procinfo.parent) and
(current_procinfo.procdef.parast.symtablelevel>normal_function_level) then (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
list.concat(Tai_stabs.Create(strpnew( list.concat(Tai_stabs.Create(strpnew(
'"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+ '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
if (not is_void(current_procinfo.procdef.rettype.def)) and if (not is_void(current_procinfo.procdef.rettype.def)) and
(tvarsym(current_procinfo.procdef.funcretsym).refs>0) then (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
@ -2071,7 +2067,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.149 2003-09-28 13:39:38 peter Revision 1.150 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.149 2003/09/28 13:39:38 peter
* optimized releasing of registers * optimized releasing of registers
Revision 1.148 2003/09/25 21:28:00 peter Revision 1.148 2003/09/25 21:28:00 peter

30
compiler/nld.pas
View File

@ -383,6 +383,15 @@ implementation
varsym : varsym :
begin begin
inc(tvarsym(symtableentry).refs); inc(tvarsym(symtableentry).refs);
{ Nested variable? The we need to load the framepointer of
the parent procedure }
if (symtable.symtabletype in [localsymtable,parasymtable]) and
(symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
begin
if assigned(left) then
internalerror(200309289);
left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
end;
{ if it's refered by absolute then it's used } { if it's refered by absolute then it's used }
if nf_absolute in flags then if nf_absolute in flags then
tvarsym(symtableentry).varstate:=vs_used tvarsym(symtableentry).varstate:=vs_used
@ -463,19 +472,8 @@ implementation
end; end;
varsym : varsym :
begin begin
if (symtable.symtabletype in [parasymtable,localsymtable]) and if assigned(left) then
(current_procinfo.procdef.parast.symtablelevel>symtable.symtablelevel) then firstpass(left);
begin
{ if the variable is in an other stackframe then we need
a register to dereference }
if symtable.symtablelevel>normal_function_level then
begin
registers32:=1;
{ further, the variable can't be put into a register }
tvarsym(symtableentry).varoptions:=
tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
end;
end;
if (tvarsym(symtableentry).varspez=vs_const) then if (tvarsym(symtableentry).varspez=vs_const) then
expectloc:=LOC_CREFERENCE; expectloc:=LOC_CREFERENCE;
{ we need a register for call by reference parameters } { we need a register for call by reference parameters }
@ -1275,7 +1273,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.106 2003-09-23 17:56:05 peter Revision 1.107 2003-09-28 17:55:03 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.106 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure

56
compiler/nmem.pas
View File

@ -39,6 +39,15 @@ interface
end; end;
tloadvmtaddrnodeclass = class of tloadvmtaddrnode; tloadvmtaddrnodeclass = class of tloadvmtaddrnode;
tloadparentfpnode = class(tunarynode)
parentpd : tprocdef;
constructor create(pd:tprocdef);virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
function getcopy : tnode;override;
end;
tloadparentfpnodeclass = class of tloadparentfpnode;
taddrnode = class(tunarynode) taddrnode = class(tunarynode)
getprocvardef : tprocvardef; getprocvardef : tprocvardef;
getprocvardefderef : tderef; getprocvardefderef : tderef;
@ -101,6 +110,7 @@ interface
var var
cloadvmtaddrnode : tloadvmtaddrnodeclass; cloadvmtaddrnode : tloadvmtaddrnodeclass;
cloadparentfpnode : tloadparentfpnodeclass;
caddrnode : taddrnodeclass; caddrnode : taddrnodeclass;
cderefnode : tderefnodeclass; cderefnode : tderefnodeclass;
csubscriptnode : tsubscriptnodeclass; csubscriptnode : tsubscriptnodeclass;
@ -155,6 +165,46 @@ implementation
end; end;
{*****************************************************************************
TLOADPARENTFPNODE
*****************************************************************************}
constructor tloadparentfpnode.create(pd:tprocdef);
begin
inherited create(loadparentfpn,nil);
if not assigned(pd) then
internalerror(200309288);
if (pd.parast.symtablelevel>current_procinfo.procdef.parast.symtablelevel) then
internalerror(200309284);
parentpd:=pd;
end;
function tloadparentfpnode.getcopy : tnode;
var
p : tloadparentfpnode;
begin
p:=tloadparentfpnode(inherited getcopy);
p.parentpd:=parentpd;
getcopy:=p;
end;
function tloadparentfpnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidpointertype;
end;
function tloadparentfpnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_REGISTER;
registers32:=1;
end;
{***************************************************************************** {*****************************************************************************
TADDRNODE TADDRNODE
*****************************************************************************} *****************************************************************************}
@ -854,7 +904,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.62 2003-09-06 22:27:08 florian Revision 1.63 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.62 2003/09/06 22:27:08 florian
* fixed web bug 2669 * fixed web bug 2669
* cosmetic fix in printnode * cosmetic fix in printnode
* tobjectdef.gettypename implemented * tobjectdef.gettypename implemented

14
compiler/node.pas
View File

@ -111,11 +111,12 @@ interface
nothingn, {NOP, Do nothing} nothingn, {NOP, Do nothing}
loadvmtaddrn, {Load the address of the VMT of a class/object} loadvmtaddrn, {Load the address of the VMT of a class/object}
guidconstn, {A GUID COM Interface constant } guidconstn, {A GUID COM Interface constant }
rttin {Rtti information so they can be accessed in result/firstpass} rttin, {Rtti information so they can be accessed in result/firstpass}
loadparentfpn { Load the framepointer of the parent for nested procedures }
); );
const const
nodetype2str : array[tnodetype] of string[20] = ( nodetype2str : array[tnodetype] of string[24] = (
'<emptynode>', '<emptynode>',
'addn', 'addn',
'muln', 'muln',
@ -188,7 +189,8 @@ interface
'nothingn', 'nothingn',
'loadvmtaddrn', 'loadvmtaddrn',
'guidconstn', 'guidconstn',
'rttin'); 'rttin',
'loadparentfpn');
type type
{ all boolean field of ttree are now collected in flags } { all boolean field of ttree are now collected in flags }
@ -975,7 +977,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.66 2003-09-06 22:27:08 florian Revision 1.67 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.66 2003/09/06 22:27:08 florian
* fixed web bug 2669 * fixed web bug 2669
* cosmetic fix in printnode * cosmetic fix in printnode
* tobjectdef.gettypename implemented * tobjectdef.gettypename implemented

19
compiler/pass_2.pas
View File

@ -142,7 +142,8 @@ implementation
'nothing-nothg', {nothingn} 'nothing-nothg', {nothingn}
'loadvmt', {loadvmtn} 'loadvmt', {loadvmtn}
'guidconstn', 'guidconstn',
'rttin' 'rttin',
'loadparentfpn'
); );
var var
p: pchar; p: pchar;
@ -248,6 +249,10 @@ implementation
end; end;
procedure generatecode(var p : tnode); procedure generatecode(var p : tnode);
{$ifdef EXTDEBUG}
var
sr : tsuperregister;
{$endif EXTDEBUG}
begin begin
flowcontrol:=[]; flowcontrol:=[];
{ when size optimization only count occurrence } { when size optimization only count occurrence }
@ -291,6 +296,12 @@ implementation
do_secondpass(p); do_secondpass(p);
{$ifdef EXTDEBUG}
for sr:=first_int_imreg to last_int_imreg do
if not(sr in rg.unusedregsint) then
Comment(V_Warning,'Register '+std_regname(newreg(R_INTREGISTER,sr,R_SUBWHOLE))+' not released');
{$endif EXTDEBUG}
if assigned(current_procinfo.procdef) then if assigned(current_procinfo.procdef) then
current_procinfo.procdef.fpu_used:=p.registersfpu; current_procinfo.procdef.fpu_used:=p.registersfpu;
@ -301,7 +312,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.64 2003-09-03 15:55:01 peter Revision 1.65 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.64 2003/09/03 15:55:01 peter
* NEWRA branch merged * NEWRA branch merged
Revision 1.63.2.3 2003/08/31 15:46:26 peter Revision 1.63.2.3 2003/08/31 15:46:26 peter

30
compiler/pdecsub.pas
View File

@ -123,6 +123,28 @@ implementation
end; end;
procedure insert_parentfp_para(pd:tabstractprocdef);
var
storepos : tfileposinfo;
vs : tvarsym;
begin
if pd.parast.symtablelevel>normal_function_level then
begin
storepos:=akttokenpos;
if pd.deftype=procdef then
akttokenpos:=tprocdef(pd).fileinfo;
{ Generate result variable accessing function result }
vs:=tvarsym.create('$parentfp',vs_var,pd.rettype);
include(vs.varoptions,vo_is_parentfp);
pd.parast.insert(vs);
pd.insertpara(vs.vartype,vs,nil,true);
akttokenpos:=storepos;
end;
end;
procedure insert_self_and_vmt_para(pd:tabstractprocdef); procedure insert_self_and_vmt_para(pd:tabstractprocdef);
var var
storepos : tfileposinfo; storepos : tfileposinfo;
@ -1740,6 +1762,8 @@ const
insert_self_and_vmt_para(pd); insert_self_and_vmt_para(pd);
{ insert funcret parameter if required } { insert funcret parameter if required }
insert_funcret_para(pd); insert_funcret_para(pd);
{ insert parentfp parameter if required }
insert_parentfp_para(pd);
currpara:=tparaitem(pd.para.first); currpara:=tparaitem(pd.para.first);
while assigned(currpara) do while assigned(currpara) do
@ -2117,7 +2141,11 @@ const
end. end.
{ {
$Log$ $Log$
Revision 1.137 2003-09-25 21:24:09 peter Revision 1.138 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.137 2003/09/25 21:24:09 peter
* don't include vo_has_local_copy for open array/array of const * don't include vo_has_local_copy for open array/array of const
Revision 1.136 2003/09/23 20:36:47 peter Revision 1.136 2003/09/23 20:36:47 peter

8
compiler/powerpc/cpupi.pas
View File

@ -34,6 +34,8 @@ unit cpupi;
type type
tppcprocinfo = class(tcgprocinfo) tppcprocinfo = class(tcgprocinfo)
{ offset where the frame pointer from the outer procedure is stored. }
parent_framepointer_offset : longint;
{ max. of space need for parameters, currently used by the PowerPC port only } { max. of space need for parameters, currently used by the PowerPC port only }
maxpushedparasize : aword; maxpushedparasize : aword;
constructor create(aparent:tprocinfo);override; constructor create(aparent:tprocinfo);override;
@ -124,7 +126,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.27 2003-08-18 11:51:19 olle Revision 1.28 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.27 2003/08/18 11:51:19 olle
+ cleaning up in proc entry and exit, now calc_stack_frame always is used. + cleaning up in proc entry and exit, now calc_stack_frame always is used.
Revision 1.26 2003/08/16 14:26:44 jonas Revision 1.26 2003/08/16 14:26:44 jonas

15
compiler/psub.pas
View File

@ -1114,20 +1114,11 @@ implementation
{ Insert result variables in the localst } { Insert result variables in the localst }
insert_funcret_local(pd); insert_funcret_local(pd);
(*
{ Insert local copies for value para }
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
*)
{ check if there are para's which require initing -> set } { check if there are para's which require initing -> set }
{ pi_do_call (if not yet set) } { pi_do_call (if not yet set) }
if not(pi_do_call in current_procinfo.flags) then if not(pi_do_call in current_procinfo.flags) then
pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil); pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_init_paras,nil);
{ Update parameter information }
if (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
current_procinfo.allocate_parent_framepointer_parameter;
{ set _FAIL as keyword if constructor } { set _FAIL as keyword if constructor }
if (pd.proctypeoption=potype_constructor) then if (pd.proctypeoption=potype_constructor) then
begin begin
@ -1297,7 +1288,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.152 2003-09-27 13:29:43 peter Revision 1.153 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.152 2003/09/27 13:29:43 peter
* fix reported file position for not matched forwards * fix reported file position for not matched forwards
Revision 1.151 2003/09/25 21:25:13 peter Revision 1.151 2003/09/25 21:25:13 peter

7
compiler/psystem.pas
View File

@ -444,6 +444,7 @@ implementation
nodeclass[loadvmtaddrn]:=cloadvmtaddrnode; nodeclass[loadvmtaddrn]:=cloadvmtaddrnode;
nodeclass[guidconstn]:=cguidconstnode; nodeclass[guidconstn]:=cguidconstnode;
nodeclass[rttin]:=crttinode; nodeclass[rttin]:=crttinode;
nodeclass[loadparentfpn]:=cloadparentfpnode;
end; end;
@ -504,7 +505,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.55 2003-09-23 17:56:06 peter Revision 1.56 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.55 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure

9
compiler/symconst.pas
View File

@ -257,7 +257,8 @@ type
vo_is_self, vo_is_self,
vo_is_vmt, vo_is_vmt,
vo_is_result, { special result variable } vo_is_result, { special result variable }
vo_is_reg_para { register parameter, no space allocation in parast, but in localst } vo_is_reg_para, { register parameter, no space allocation in parast, but in localst }
vo_is_parentfp
); );
tvaroptions=set of tvaroption; tvaroptions=set of tvaroption;
@ -374,7 +375,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.64 2003-09-23 17:56:06 peter Revision 1.65 2003-09-28 17:55:04 peter
* parent framepointer changed to hidden parameter
* tloadparentfpnode added
Revision 1.64 2003/09/23 17:56:06 peter
* locals and paras are allocated in the code generation * locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when * tvarsym.localloc contains the location of para/local when
generating code for the current procedure generating code for the current procedure