From 99bb20747ebcfbf30f3c3cdef11d21930a9db9d3 Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 28 Sep 2003 17:55:03 +0000 Subject: [PATCH] * parent framepointer changed to hidden parameter * tloadparentfpnode added --- compiler/cgbase.pas | 32 +++---------------- compiler/cgobj.pas | 34 +++----------------- compiler/i386/cpupara.pas | 12 +++----- compiler/ncal.pas | 13 +++++++- compiler/ncgcal.pas | 57 +++------------------------------- compiler/ncgld.pas | 25 ++++++++++----- compiler/ncgmem.pas | 63 ++++++++++++++++++++++++++++++++++++-- compiler/ncgutil.pas | 14 ++++----- compiler/nld.pas | 30 +++++++++--------- compiler/nmem.pas | 56 ++++++++++++++++++++++++++++++++- compiler/node.pas | 16 +++++++--- compiler/pass_2.pas | 19 ++++++++++-- compiler/pdecsub.pas | 30 +++++++++++++++++- compiler/powerpc/cpupi.pas | 8 ++++- compiler/psub.pas | 15 +++------ compiler/psystem.pas | 7 ++++- compiler/symconst.pas | 9 ++++-- 17 files changed, 270 insertions(+), 170 deletions(-) diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 1053b405ce..b3ba9461cc 100644 --- a/compiler/cgbase.pas +++ b/compiler/cgbase.pas @@ -72,14 +72,6 @@ unit cgbase; entryswitches : tlocalswitches; { local switches at end of procedure } 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 } para_stack_size : longint; @@ -108,8 +100,6 @@ unit cgbase; constructor create(aparent:tprocinfo);virtual; destructor destroy;override; - procedure allocate_parent_framepointer_parameter;virtual; - { Allocate framepointer so it can not be used by the register allocator } procedure allocate_framepointer_reg;virtual; @@ -310,9 +300,6 @@ implementation parent:=aparent; procdef:=nil; para_stack_size:=0; -{$warning TODO maybe remove parent_framepointer_offset for i386} - parent_framepointer_offset:=0; - firsttemp_offset:=0; flags:=[]; framepointer:=NR_FRAME_POINTER_REG; { asmlists } @@ -331,12 +318,6 @@ implementation end; - procedure tprocinfo.allocate_parent_framepointer_parameter; - begin - parent_framepointer_offset:=target_info.first_parm_offset; - end; - - procedure tprocinfo.allocate_framepointer_reg; begin if framepointer=NR_FRAME_POINTER_REG then @@ -369,13 +350,6 @@ implementation procedure tprocinfo.handle_body_start; 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; @@ -546,7 +520,11 @@ implementation end. { $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 dependent and needs to be done in create_paraloc_info diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 5ce0a58bcb..f658c5ecbc 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -285,9 +285,6 @@ unit cgobj; } 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_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef); {# This should emit the opcode to copy len bytes from the source @@ -1079,31 +1076,6 @@ unit cgobj; 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); var paraloc1,paraloc2,paraloc3 : tparalocation; @@ -1552,7 +1524,11 @@ finalization end. { $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 Revision 1.123 2003/09/25 21:26:24 peter diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index 4e24c7e829..ab67aa2862 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -252,9 +252,6 @@ unit cpupara; parasize : longint; begin 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 to cope with the IRETD and we save 6 register + 4 selectors } @@ -303,9 +300,6 @@ unit cpupara; begin parareg:=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); while assigned(hp) do begin @@ -387,7 +381,11 @@ begin end. { $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 Revision 1.31 2003/09/25 21:30:11 peter diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 26e8799b1b..4d34af1feb 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -1853,6 +1853,13 @@ type if vo_is_vmt in tvarsym(currpara.parasym).varoptions then begin 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; { add the hidden parameter } if not assigned(hiddentree) then @@ -2513,7 +2520,11 @@ begin end. { $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 Revision 1.181 2003/09/23 17:56:05 peter diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index ef221015b6..26669e2cfb 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -59,8 +59,6 @@ interface } function align_parasize:longint;virtual; procedure pop_parasize(pop_size:longint);virtual; - procedure push_framepointer;virtual; - procedure free_pushed_framepointer;virtual; procedure extra_interrupt_code;virtual; public procedure pass_2;override; @@ -261,43 +259,6 @@ implementation 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; var cgsize : tcgsize; @@ -525,12 +486,6 @@ implementation paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]); ppn:=tcgcallparanode(ppn.right); 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; begin @@ -632,12 +587,6 @@ implementation cg.g_maybe_testvmt(exprasmlist,methodpointer.location.register,tprocdef(procdefinition)._class); 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); if (po_virtualmethod in procdefinition.procoptions) and @@ -1162,7 +1111,11 @@ begin end. { $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 Revision 1.117 2003/09/25 21:28:00 peter diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 2ece0b67f4..8ed78c7795 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -172,6 +172,18 @@ implementation cg.a_label(exprasmlist,endrelocatelab); location.reference.base:=hregister; 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 } else begin @@ -211,13 +223,6 @@ implementation internalerror(2003091816); location.reference.base:=tvarsym(symtableentry).localloc.reference.index; 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; globalsymtable, staticsymtable : @@ -916,7 +921,11 @@ begin end. { $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 Revision 1.84 2003/09/25 21:27:31 peter diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index 19fde801ae..d96899d5b8 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -38,6 +38,10 @@ interface procedure pass_2;override; end; + tcgloadparentfpnode = class(tloadparentfpnode) + procedure pass_2;override; + end; + tcgaddrnode = class(taddrnode) procedure pass_2;override; end; @@ -72,6 +76,7 @@ interface procedure pass_2;override; end; + implementation uses @@ -94,7 +99,7 @@ implementation {***************************************************************************** - TCGLOADNODE + TCGLOADVMTADDRNODE *****************************************************************************} procedure tcgloadvmtaddrnode.pass_2; @@ -162,6 +167,55 @@ implementation 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 *****************************************************************************} @@ -803,6 +857,7 @@ implementation begin cloadvmtaddrnode:=tcgloadvmtaddrnode; + cloadparentfpnode:=tcgloadparentfpnode; caddrnode:=tcgaddrnode; cderefnode:=tcgderefnode; csubscriptnode:=tcgsubscriptnode; @@ -811,7 +866,11 @@ begin end. { $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 * tvarsym.localloc contains the location of para/local when generating code for the current procedure diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index a0404df9c8..018749f321 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -1524,10 +1524,6 @@ implementation if assigned(current_procinfo.procdef.parast) and not (po_assembler in current_procinfo.procdef.procoptions) then 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 } { 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 } @@ -1635,11 +1631,11 @@ implementation begin { define calling EBP as pseudo local var PM } { 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 list.concat(Tai_stabs.Create(strpnew( '"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 (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then @@ -2071,7 +2067,11 @@ implementation end. { $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 Revision 1.148 2003/09/25 21:28:00 peter diff --git a/compiler/nld.pas b/compiler/nld.pas index 0e04777352..6604d4c0d3 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -383,6 +383,15 @@ implementation varsym : begin 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 nf_absolute in flags then tvarsym(symtableentry).varstate:=vs_used @@ -463,19 +472,8 @@ implementation end; varsym : begin - if (symtable.symtabletype in [parasymtable,localsymtable]) and - (current_procinfo.procdef.parast.symtablelevel>symtable.symtablelevel) then - 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 assigned(left) then + firstpass(left); if (tvarsym(symtableentry).varspez=vs_const) then expectloc:=LOC_CREFERENCE; { we need a register for call by reference parameters } @@ -1275,7 +1273,11 @@ begin end. { $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 * tvarsym.localloc contains the location of para/local when generating code for the current procedure diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 11974d945f..5dbaeb68fc 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -39,6 +39,15 @@ interface end; 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) getprocvardef : tprocvardef; getprocvardefderef : tderef; @@ -101,6 +110,7 @@ interface var cloadvmtaddrnode : tloadvmtaddrnodeclass; + cloadparentfpnode : tloadparentfpnodeclass; caddrnode : taddrnodeclass; cderefnode : tderefnodeclass; csubscriptnode : tsubscriptnodeclass; @@ -155,6 +165,46 @@ implementation 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 *****************************************************************************} @@ -854,7 +904,11 @@ begin end. { $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 * cosmetic fix in printnode * tobjectdef.gettypename implemented diff --git a/compiler/node.pas b/compiler/node.pas index 75fbca017e..275ebc0c24 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -111,11 +111,12 @@ interface nothingn, {NOP, Do nothing} loadvmtaddrn, {Load the address of the VMT of a class/object} 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 - nodetype2str : array[tnodetype] of string[20] = ( + nodetype2str : array[tnodetype] of string[24] = ( '', 'addn', 'muln', @@ -188,7 +189,8 @@ interface 'nothingn', 'loadvmtaddrn', 'guidconstn', - 'rttin'); + 'rttin', + 'loadparentfpn'); type { all boolean field of ttree are now collected in flags } @@ -975,7 +977,11 @@ implementation end. { $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 * cosmetic fix in printnode * tobjectdef.gettypename implemented @@ -1184,4 +1190,4 @@ end. - list field removed of the tnode class because it's not used currently and can cause hard-to-find bugs -} \ No newline at end of file +} diff --git a/compiler/pass_2.pas b/compiler/pass_2.pas index be36754672..42bafca451 100644 --- a/compiler/pass_2.pas +++ b/compiler/pass_2.pas @@ -142,7 +142,8 @@ implementation 'nothing-nothg', {nothingn} 'loadvmt', {loadvmtn} 'guidconstn', - 'rttin' + 'rttin', + 'loadparentfpn' ); var p: pchar; @@ -248,6 +249,10 @@ implementation end; procedure generatecode(var p : tnode); +{$ifdef EXTDEBUG} + var + sr : tsuperregister; +{$endif EXTDEBUG} begin flowcontrol:=[]; { when size optimization only count occurrence } @@ -291,6 +296,12 @@ implementation 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 current_procinfo.procdef.fpu_used:=p.registersfpu; @@ -301,7 +312,11 @@ implementation end. { $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 Revision 1.63.2.3 2003/08/31 15:46:26 peter diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 6aaf543ba4..23ca53dd76 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -123,6 +123,28 @@ implementation 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); var storepos : tfileposinfo; @@ -1740,6 +1762,8 @@ const insert_self_and_vmt_para(pd); { insert funcret parameter if required } insert_funcret_para(pd); + { insert parentfp parameter if required } + insert_parentfp_para(pd); currpara:=tparaitem(pd.para.first); while assigned(currpara) do @@ -2117,7 +2141,11 @@ const end. { $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 Revision 1.136 2003/09/23 20:36:47 peter diff --git a/compiler/powerpc/cpupi.pas b/compiler/powerpc/cpupi.pas index bbe916e141..b583648e87 100644 --- a/compiler/powerpc/cpupi.pas +++ b/compiler/powerpc/cpupi.pas @@ -34,6 +34,8 @@ unit cpupi; type 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 } maxpushedparasize : aword; constructor create(aparent:tprocinfo);override; @@ -124,7 +126,11 @@ begin end. { $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. Revision 1.26 2003/08/16 14:26:44 jonas diff --git a/compiler/psub.pas b/compiler/psub.pas index b86de28999..ee8abd775c 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -1114,20 +1114,11 @@ implementation { Insert result variables in the localst } 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 } { pi_do_call (if not yet set) } if not(pi_do_call in current_procinfo.flags) then 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 } if (pd.proctypeoption=potype_constructor) then begin @@ -1297,7 +1288,11 @@ begin end. { $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 Revision 1.151 2003/09/25 21:25:13 peter diff --git a/compiler/psystem.pas b/compiler/psystem.pas index e19bf18f91..2ec541bc67 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -444,6 +444,7 @@ implementation nodeclass[loadvmtaddrn]:=cloadvmtaddrnode; nodeclass[guidconstn]:=cguidconstnode; nodeclass[rttin]:=crttinode; + nodeclass[loadparentfpn]:=cloadparentfpnode; end; @@ -504,7 +505,11 @@ implementation end. { $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 * tvarsym.localloc contains the location of para/local when generating code for the current procedure diff --git a/compiler/symconst.pas b/compiler/symconst.pas index a527607650..e1569676d3 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -257,7 +257,8 @@ type vo_is_self, vo_is_vmt, 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; @@ -374,7 +375,11 @@ implementation end. { $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 * tvarsym.localloc contains the location of para/local when generating code for the current procedure