+ support for nested procedures for the JVM target

   o since the JVM target has no stack/framepointer that can be passed
     on to nested routines, all local variables and parameters accessed
     from nested routines are grouped into a local record whose address
     is passed to nested routines. The same technique is also required
     for LLVM in the future

git-svn-id: branches/jvmbackend@18588 -

.gitattributes

@@ -348,6 +348,8 @@ compiler/ncginl.pas svneol=native#text/plain
 compiler/ncgld.pas svneol=native#text/plain
 compiler/ncgmat.pas svneol=native#text/plain
 compiler/ncgmem.pas svneol=native#text/plain
+compiler/ncgnstld.pas svneol=native#text/plain
+compiler/ncgnstmm.pas svneol=native#text/plain
 compiler/ncgobjc.pas svneol=native#text/plain
 compiler/ncgopt.pas svneol=native#text/plain
 compiler/ncgrtti.pas svneol=native#text/plain

compiler/jvm/njvmld.pas

@@ -29,10 +29,10 @@ uses
   globtype,
   symtype,
   cgutils,
-  node, ncgld;
+  node, ncgld, ncgnstld;
 
 type
-  tjvmloadnode = class(tcgloadnode)
+  tjvmloadnode = class(tcgnestloadnode)
     function is_addr_param_load: boolean; override;
     procedure pass_generate_code; override;
   end;

compiler/jvm/njvmmem.pas

@@ -28,7 +28,7 @@ interface
     uses
       globtype,
       cgbase,cpubase,
-      node,nmem,ncgmem;
+      node,nmem,ncgmem,ncgnstmm;
 
     type
        tjvmaddrnode = class(tcgaddrnode)
@@ -45,10 +45,6 @@ interface
          procedure pass_generate_code; override;
        end;
 
-       tjvmloadparentfpnode = class(tcgloadparentfpnode)
-         procedure pass_generate_code;override;
-       end;
-
        tjvmvecnode = class(tcgvecnode)
          function pass_1: tnode; override;
          procedure pass_generate_code;override;
@@ -121,7 +117,8 @@ implementation
           end
         else
           begin
-            if not jvmimplicitpointertype(left.resultdef) then
+            if not(nf_internal in flags) and
+               not jvmimplicitpointertype(left.resultdef) then
               begin
                 CGMessage(parser_e_illegal_expression);
                 exit
@@ -134,7 +131,8 @@ implementation
     procedure tjvmaddrnode.pass_generate_code;
       begin
         secondpass(left);
-        if jvmimplicitpointertype(left.resultdef) then
+        if jvmimplicitpointertype(left.resultdef) or
+           (nf_internal in flags) then
           begin
             { this is basically a typecast: the left node is an implicit
               pointer, and we typecast it to a regular 'pointer'
@@ -143,6 +141,7 @@ implementation
           end
         else
           begin
+            { procvar }
 {$ifndef nounsupported}
             location_reset(location,LOC_REGISTER,OS_ADDR);
             location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
@@ -168,19 +167,6 @@ implementation
       end;
 
 
-    { tjvmloadparentfpnode }
-
-    procedure tjvmloadparentfpnode.pass_generate_code;
-      begin
-{$ifndef nounsupported}
-        location_reset(location,LOC_REGISTER,OS_ADDR);
-        location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
-        hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
-{$else}
-       internalerror(2011041301);
-{$endif}
-      end;
-
 {*****************************************************************************
                              TJVMVECNODE
 *****************************************************************************}
@@ -298,6 +284,5 @@ begin
    cderefnode:=tjvmderefnode;
    caddrnode:=tjvmaddrnode;
    cvecnode:=tjvmvecnode;
-   cloadparentfpnode:=tjvmloadparentfpnode;
    cloadvmtaddrnode:=tjvmloadvmtaddrnode;
 end.

compiler/jvmdef.pas

@@ -241,7 +241,11 @@ implementation
               else if jvmimplicitpointertype(tpointerdef(def).pointeddef) then
                 result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror)
               else
-                result:=false;
+                begin
+                  { used for internal pointer constructs }
+                  encodedstr:=encodedstr+'[';
+                  result:=jvmaddencodedtype(tpointerdef(def).pointeddef,false,encodedstr,forcesignature,founderror);
+                end;
             end;
           floatdef :
             begin

compiler/ncgld.pas

@@ -33,6 +33,9 @@ interface
 
     type
        tcgloadnode = class(tloadnode)
+         protected
+          procedure generate_nested_access(vs: tsym);virtual;
+         public
           procedure pass_generate_code;override;
           procedure generate_picvaraccess;virtual;
           procedure changereflocation(const ref: treference);
@@ -235,6 +238,20 @@ implementation
       end;
 
 
+    procedure tcgloadnode.generate_nested_access(vs: tsym);
+      var
+        { paramter declared as tsym to reduce interface unit dependencies }
+        lvs: tabstractnormalvarsym absolute vs;
+      begin
+        secondpass(left);
+        if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+          internalerror(200309286);
+        if lvs.localloc.loc<>LOC_REFERENCE then
+          internalerror(200409241);
+        reference_reset_base(location.reference,left.location.register,lvs.localloc.reference.offset,lvs.localloc.reference.alignment);
+      end;
+
+
     procedure tcgloadnode.pass_generate_code;
       var
         hregister : tregister;
@@ -412,19 +429,10 @@ implementation
             localvarsym :
               begin
                 vs:=tabstractnormalvarsym(symtableentry);
-{$if not defined(jvm) or defined(nounsupported)}
                 { Nested variable }
                 if assigned(left) then
-                  begin
-                    secondpass(left);
-                    if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                      internalerror(200309286);
-                    if vs.localloc.loc<>LOC_REFERENCE then
-                      internalerror(200409241);
-                    reference_reset_base(location.reference,left.location.register,vs.localloc.reference.offset,vs.localloc.reference.alignment);
-                  end
+                  generate_nested_access(vs)
                 else
-{$endif}
                   location:=vs.localloc;
 
                 { handle call by reference variables when they are not

compiler/ncgmem.pas

@@ -151,14 +151,6 @@ implementation
         hsym   : tparavarsym;
         href   : treference;
       begin
-{$ifdef jvm}
-{$ifndef nounsupported}
-         location_reset(location,LOC_REGISTER,OS_ADDR);
-         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
-         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
-         exit;
-{$endif nounsupported}
-{$endif jvm}
         if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);

compiler/ncgnstld.pas

@@ -0,0 +1,197 @@
+{
+    Copyright (c) 2011 by Jonas Maebe
+
+    Support for load nodes on targets that have to group all local variables
+    and parameters accessed by nested routines into structs (and then pass the
+    address of these structs to nested routines rather than the frame pointer,
+    and access the local variables as fields thereof)
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgnstld;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       node,
+       symtype,
+       nld,
+       ncgld;
+
+    type
+       tcgnestloadnode = class(tcgloadnode)
+        protected
+         nestsym: tsym;
+         procedure generate_nested_access(vs: tsym);override;
+        public
+         function  pass_typecheck: tnode; override;
+         function  pass_1:tnode;override;
+         function  dogetcopy: tnode; override;
+         function  docompare(p: tnode): boolean; override;
+       end;
+
+implementation
+
+    uses
+      cutils,verbose,globtype,globals,systems,constexp,
+      symnot,
+      defutil,defcmp,
+      htypechk,pass_1,procinfo,paramgr,
+      cpuinfo,
+      symconst,symbase,symsym,symdef,symtable,symcreat,
+      ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
+      pass_2,cgbase
+      ;
+
+{*****************************************************************************
+                          TCGNESTLOADNODE
+*****************************************************************************}
+
+    procedure tcgnestloadnode.generate_nested_access(vs: tsym);
+      begin
+        { left has been transformed into a string of accesses that result in
+          the location of the original variable's copy in the appropriate
+          parentfpstruct (via tcgnestloadparentfpnode.pass_1). In case it is a
+          var/out/constref parameter, that "copy" will have been a copy of the
+          address so the normal handling of such parameters in ncgld is ok) }
+        secondpass(left);
+        location:=left.location;
+      end;
+
+
+    function tcgnestloadnode.pass_typecheck: tnode;
+      var
+        nestedvars: tsym;
+      begin
+        result:=inherited pass_typecheck;
+        if assigned(result) then
+          exit;
+        case symtableentry.typ of
+          paravarsym,
+          localvarsym :
+            begin
+              { Nested variable? Then we have to move it to a structure that
+                can be passed by reference to nested routines }
+              if assigned(current_procinfo) and
+                 (symtable.symtabletype in [localsymtable,parasymtable]) and
+                 ((symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) or
+                  { also redirect loads of locals/paras that have been moved to
+                     the parentfpstruct inside the routine in which they were
+                     originally declared, except in the initialisation code for
+                     the parentfpstruct (nf_internal flag) }
+                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
+                   not(nf_internal in flags))) then
+                begin
+                  { get struct holding all locals accessed by nested routines }
+                  nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
+                  { don't add the parentfpstruct to itself! }
+                  if nestedvars=symtableentry then
+                    exit;
+                  if not assigned(nestedvars) then
+                    begin
+                      { create this struct }
+                      build_parentfpstruct(tprocdef(symtable.defowner));
+                      nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
+                    end;
+                  {  store result for use in pass_1 }
+                  nestsym:=maybe_add_sym_to_parentfpstruct(tprocdef(symtableentry.owner.defowner),symtableentry,resultdef,is_addr_param_load);
+                  { left normally holds the parentfp node. If it's not assigned,
+                    this is an access to a local variable/para from the routine
+                    in which it was actually declared -> redirect to its
+                    equivalent in the parentfp struct }
+                  if not assigned(left) then
+                    begin
+                      left:=caddrnode.create_internal(cloadnode.create(tprocdef(symtableentry.owner.defowner).parentfpstruct,tprocdef(symtableentry.owner.defowner).parentfpstruct.owner));
+                      include(left.flags,nf_typedaddr);
+                    end;
+                  typecheckpass(left);
+                end;
+            end;
+        end;
+      end;
+
+
+    function tcgnestloadnode.pass_1:tnode;
+      var
+        thissym,
+        nestedvars: tsym;
+        nestedvarsdef: tdef;
+      begin
+        result:=inherited;
+        if assigned(result) then
+          exit;
+        case symtableentry.typ of
+          paravarsym,
+          localvarsym :
+            begin
+              { Nested variable? Then we have to move it to a structure that
+                can be passed by reference to nested routines }
+              if assigned(current_procinfo) and
+                 (symtable.symtabletype in [localsymtable,parasymtable]) and
+                 ((symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) or
+                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
+                   not(nf_internal in flags))) then
+                begin
+                  { get struct holding all locals accessed by nested routines }
+                  nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
+                  if not assigned(nestedvars) then
+                    begin
+                      { create this struct }
+                      build_parentfpstruct(tprocdef(symtable.defowner));
+                      nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
+                    end;
+                  nestedvarsdef:=tlocalvarsym(nestedvars).vardef;
+                  if nestedvars<>symtableentry then
+                    thissym:=nestsym
+                  else
+                    thissym:=find_sym_in_parentfpstruct(tprocdef(symtableentry.owner.defowner),symtableentry);
+                  if not assigned(thissym) then
+                    internalerror(2011060406);
+                  { firstpass the parentfpnode. This will transform it into
+                    a load of the appropriate parentfpstruct }
+                  if not assigned(left) then
+                    internalerror(2011060104);
+                  firstpass(left);
+                  { subscript it to get the variable }
+                  left:=csubscriptnode.create(thissym,cderefnode.create(left));
+                  firstpass(left);
+                 end;
+            end;
+        end;
+      end;
+
+
+    function tcgnestloadnode.dogetcopy: tnode;
+      begin
+        result:=inherited dogetcopy;
+        tcgnestloadnode(result).nestsym:=nestsym;
+      end;
+
+
+    function tcgnestloadnode.docompare(p: tnode): boolean;
+      begin
+        result:=
+          inherited docompare(p) and
+          (tcgnestloadnode(p).nestsym=nestsym);
+      end;
+
+
+begin
+  cloadnode:=tcgnestloadnode;
+end.

compiler/ncgnstmm.pas

@@ -0,0 +1,130 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgnstmm;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,cgbase,cpuinfo,cpubase,
+      node,ncgmem;
+
+    type
+       tcgnestloadparentfpnode = class(tcgloadparentfpnode)
+          function pass_typecheck: tnode; override;
+          function pass_1: tnode; override;
+          procedure pass_generate_code;override;
+       end;
+
+implementation
+
+    uses
+      systems,
+      cutils,cclasses,verbose,globals,constexp,
+      symconst,symdef,symsym,symtable,symcreat,defutil,paramgr,
+      aasmbase,aasmtai,aasmdata,
+      procinfo,pass_2,parabase,
+      pass_1,ncnv,nmem,nld,ncon,nadd,nutils,
+      cgutils,cgobj,hlcgobj,
+      tgobj,ncgutil,objcgutl
+      ;
+
+
+{*****************************************************************************
+                        TCGLOADPARENTFPNODE
+*****************************************************************************}
+
+    function tcgnestloadparentfpnode.pass_typecheck: tnode;
+      var
+        hsym        : tparavarsym;
+        currpi,
+        nextpi      : tprocinfo;
+      begin
+        result:=inherited;
+        if assigned(result) then
+          exit;
+        currpi:=current_procinfo.parent;
+        while (currpi.procdef.parast.symtablelevel>=parentpd.parast.symtablelevel) do
+          begin
+            if not assigned(currpi.procdef.parentfpstruct) then
+              build_parentfpstruct(currpi.procdef);
+            currpi:=currpi.parent;
+          end;
+        { mark all parent parentfp parameters for inclusion in the struct that
+          holds all locals accessed from nested routines }
+        currpi:=current_procinfo.parent;
+        nextpi:=currpi.parent;
+        while (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
+          begin
+            hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
+            maybe_add_sym_to_parentfpstruct(currpi.procdef,hsym,nextpi.procdef.parentfpstructptrtype,false);
+            currpi:=nextpi;
+            nextpi:=nextpi.parent;
+          end;
+      end;
+
+
+    function tcgnestloadparentfpnode.pass_1: tnode;
+      var
+        fsym        : tfieldvarsym;
+        hsym        : tparavarsym;
+        currpi,
+        nextpi      : tprocinfo;
+      begin
+        result:=nil;
+        if not assigned(current_procinfo.procdef.parentfpstruct) then
+          begin
+            hsym:=tparavarsym(current_procinfo.procdef.parast.Find('parentfp'));
+            result:=cloadnode.create(hsym,hsym.owner);
+          end
+        else
+          begin
+            result:=caddrnode.create_internal(cloadnode.create(current_procinfo.procdef.parentfpstruct,current_procinfo.procdef.parentfpstruct.owner));
+            include(result.flags,nf_typedaddr);
+          end;
+        { mark all parent parentfp parameters for inclusion in the struct that
+          holds all locals accessed from nested routines }
+        currpi:=current_procinfo.parent;
+        nextpi:=currpi.parent;
+        while (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
+          begin
+            hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
+            fsym:=tfieldvarsym(find_sym_in_parentfpstruct(currpi.procdef,hsym));
+            if not assigned(fsym) then
+              internalerror(2011060405);
+            result:=csubscriptnode.create(fsym,cderefnode.create(result));
+            currpi:=nextpi;
+            nextpi:=nextpi.parent;
+          end;
+      end;
+
+
+    procedure tcgnestloadparentfpnode.pass_generate_code;
+      begin
+        { should be handled in pass 1 }
+        internalerror(2011060202);
+      end;
+
+
+begin
+   cloadparentfpnode:=tcgnestloadparentfpnode;
+end.

compiler/pdecsub.pas

@@ -87,7 +87,7 @@ implementation
        systems,fpccrc,
        cpuinfo,
        { symtable }
-       symbase,symtable,defutil,defcmp,paramgr,cpupara,
+       symbase,symtable,symcreat,defutil,defcmp,paramgr,cpupara,
        { pass 1 }
        fmodule,node,htypechk,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -229,12 +229,21 @@ implementation
 {$endif i386}
             else
               paranr:=paranr_parentfp_delphi_cc;
-            { Generate result variable accessing function result, it
-              can't be put in a register since it must be accessable
-              from the framepointer }
-            vs:=tparavarsym.create('$parentfp',paranr,vs_value
-                  ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
-            vs.varregable:=vr_none;
+            { Generate frame pointer. It can't be put in a register since it
+              must be accessable from nested routines }
+            if not(target_info.system in systems_fpnestedstruct) then
+              begin
+                vs:=tparavarsym.create('$parentfp',paranr,vs_value
+                      ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
+                vs.varregable:=vr_none;
+              end
+            else
+              begin
+                if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
+                  build_parentfpstruct(tprocdef(pd.owner.defowner));
+                vs:=tparavarsym.create('$parentfp',paranr,vs_value
+                      ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
+              end;
             pd.parast.insert(vs);
 
             current_tokenpos:=storepos;

compiler/psub.pas

@@ -245,7 +245,9 @@ implementation
             end
          else
             begin
+               { parse routine body }
                block:=statement_block(_BEGIN);
+               { initialized variables }
                if current_procinfo.procdef.localst.symtabletype=localsymtable then
                  begin
                    { initialization of local variables with their initial
@@ -255,6 +257,17 @@ implementation
                    current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block);
                    current_filepos:=oldfilepos;
                  end;
+               if assigned(current_procinfo.procdef.parentfpstruct) then
+                 begin
+                   { we only do this after the code has been parsed because
+                     otherwise for-loop counters moved to the struct cause
+                     errors; we still do it nevertheless to prevent false
+                     "unused" symbols warnings and to assist debug info
+                     generation }
+                   redirect_parentfpstruct_local_syms(current_procinfo.procdef);
+                   { finish the parentfpstruct (add padding, ...) }
+                   finish_parentfpstruct(current_procinfo.procdef);
+                 end;
             end;
         block:=cnodeutils.wrap_proc_body(current_procinfo.procdef,block);
       end;
@@ -1486,6 +1499,14 @@ implementation
 
              { Finish type checking pass }
              do_typecheckpass(code);
+
+             if assigned(procdef.parentfpinitblock) then
+               begin
+                 tblocknode(code).left:=cstatementnode.create(procdef.parentfpinitblock,tblocknode(code).left);
+                 do_typecheckpass(tblocknode(code).left);
+                 procdef.parentfpinitblock:=nil;
+               end;
+
            end;
 
          { Check for unused labels, forwards, symbols for procedures. Static

compiler/symcreat.pas

@@ -28,7 +28,7 @@ interface
 
   uses
     finput,tokens,scanner,
-    symconst,symdef,symbase;
+    symconst,symbase,symtype,symdef;
 
 
   type
@@ -70,14 +70,40 @@ interface
 
   procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
 
+  { create "parent frame pointer" record skeleton for procdef, in which local
+    variables and parameters from pd accessed from nested routines can be
+    stored }
+  procedure build_parentfpstruct(pd: tprocdef);
+  { checks whether sym (a local or para of pd) already has a counterpart in
+    pd's parentfpstruct, and if not adds a new field to the struct with type
+    "vardef" (can be different from sym's type in case it's a call-by-reference
+    parameter, which is indicated by addrparam). If it already has a field in
+    the parentfpstruct, this field is returned. }
+  function maybe_add_sym_to_parentfpstruct(pd: tprocdef; sym: tsym; vardef: tdef; addrparam: boolean): tsym;
+  { given a localvarsym or paravarsym of pd, returns the field of the
+    parentfpstruct corresponding to this sym }
+  function find_sym_in_parentfpstruct(pd: tprocdef; sym: tsym): tsym;
+  { replaces all local and paravarsyms that have been mirrored in the
+    parentfpstruct with aliasvarsyms that redirect to these fields (used to
+    make sure that references to these syms in the owning procdef itself also
+    use the ones in the parentfpstructs) }
+  procedure redirect_parentfpstruct_local_syms(pd: tprocdef);
+  { finalises the parentfpstruct (alignment padding, ...) }
+  procedure finish_parentfpstruct(pd: tprocdef);
+
 
 implementation
 
   uses
-    cutils,globtype,globals,verbose,systems,comphook,
-    symtype,symsym,symtable,defutil,
+    cutils,globtype,globals,verbose,systems,comphook,fmodule,
+    symsym,symtable,defutil,
     pbase,pdecobj,pdecsub,psub,
-    defcmp;
+    node,nbas,nld,nmem,
+    defcmp,
+    paramgr
+    {$ifdef jvm}
+    ,pjvm
+    {$endif};
 
   procedure replace_scanner(const tempname: string; out sstate: tscannerstate);
     var
@@ -366,7 +392,12 @@ implementation
       for i:=0 to st.deflist.count-1 do
         begin
           def:=tdef(st.deflist[i]);
-          if (is_javaclass(def) and
+          if (def.typ=procdef) and
+             assigned(tprocdef(def).localst) and
+             { not true for the "main" procedure, whose localsymtable is the staticsymtable }
+             (tprocdef(def).localst.symtabletype=localsymtable) then
+            add_synthetic_method_implementations(tprocdef(def).localst)
+          else if (is_javaclass(def) and
               not(oo_is_external in tobjectdef(def).objectoptions)) or
               (def.typ=recorddef) then
            begin
@@ -386,7 +417,6 @@ implementation
       sym: tsym;
       parasym: tparavarsym;
       ps: tprocsym;
-      hdef: tdef;
       stname: string;
       i: longint;
     begin
@@ -433,5 +463,158 @@ implementation
     end;
 
 
+  procedure build_parentfpstruct(pd: tprocdef);
+    var
+      nestedvars: tsym;
+      nestedvarsst: tsymtable;
+      pnestedvarsdef,
+      nestedvarsdef: tdef;
+      old_symtablestack: tsymtablestack;
+    begin
+      { make sure the defs are not registered in the current symtablestack,
+        because they may be for a parent procdef (changeowner does remove a def
+        from the symtable in which it was originally created, so that by itself
+        is not enough) }
+      old_symtablestack:=symtablestack;
+      symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
+      { create struct to hold local variables and parameters that are
+        accessed from within nested routines }
+      nestedvarsst:=trecordsymtable.create(current_module.realmodulename^+'$$_fpc_nestedvars$'+tostr(pd.procsym.symid),current_settings.alignment.localalignmax);
+      nestedvarsdef:=trecorddef.create(nestedvarsst.name^,nestedvarsst);
+{$ifdef jvm}
+      jvm_guarantee_record_typesym(nestedvarsdef,nestedvarsdef.owner);
+      { don't add clone/FpcDeepCopy, because the field names are not all
+        representable in source form and we don't need them anyway }
+      symtablestack.push(trecorddef(nestedvarsdef).symtable);
+      maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
+      symtablestack.pop(trecorddef(nestedvarsdef).symtable);
+{$endif}
+      symtablestack.free;
+      symtablestack:=old_symtablestack.getcopyuntil(pd.localst);
+      pnestedvarsdef:=tpointerdef.create(nestedvarsdef);
+      nestedvars:=tlocalvarsym.create('$nestedvars',vs_var,nestedvarsdef,[]);
+      pd.localst.insert(nestedvars);
+      pd.parentfpstruct:=nestedvars;
+      pd.parentfpstructptrtype:=pnestedvarsdef;
+
+      pd.parentfpinitblock:=cblocknode.create(nil);
+      symtablestack.free;
+      symtablestack:=old_symtablestack;
+    end;
+
+
+  function maybe_add_sym_to_parentfpstruct(pd: tprocdef; sym: tsym; vardef: tdef; addrparam: boolean): tsym;
+    var
+      fieldvardef,
+      nestedvarsdef: tdef;
+      nestedvarsst: tsymtable;
+      initcode: tnode;
+      old_filepos: tfileposinfo;
+    begin
+      nestedvarsdef:=tlocalvarsym(pd.parentfpstruct).vardef;
+      result:=search_struct_member(trecorddef(nestedvarsdef),sym.name);
+      if not assigned(result) then
+        begin
+          { mark that this symbol is mirrored in the parentfpstruct }
+          tabstractnormalvarsym(sym).inparentfpstruct:=true;
+          { add field to the struct holding all locals accessed
+            by nested routines }
+          nestedvarsst:=trecorddef(nestedvarsdef).symtable;
+          { indicate whether or not this is a var/out/constref/... parameter }
+          if addrparam then
+            fieldvardef:=tpointerdef.create(vardef)
+          else
+            fieldvardef:=vardef;
+          result:=tfieldvarsym.create(sym.realname,vs_value,fieldvardef,[]);
+          if nestedvarsst.symlist.count=0 then
+            include(tfieldvarsym(result).varoptions,vo_is_first_field);
+          nestedvarsst.insert(result);
+          trecordsymtable(nestedvarsst).addfield(tfieldvarsym(result),vis_public);
+
+          { add initialization with original value if it's a parameter }
+          if (sym.typ=paravarsym) then
+            begin
+              old_filepos:=current_filepos;
+              fillchar(current_filepos,sizeof(current_filepos),0);
+              initcode:=cloadnode.create(sym,sym.owner);
+              { indicate that this load should not be transformed into a load
+                from the parentfpstruct, but instead should load the original
+                value }
+              include(initcode.flags,nf_internal);
+              { in case it's a var/out/constref parameter, store the address of the
+                parameter in the struct }
+              if addrparam then
+                begin
+                  initcode:=caddrnode.create_internal(initcode);
+                  include(initcode.flags,nf_typedaddr);
+                end;
+              initcode:=cassignmentnode.create(
+                csubscriptnode.create(result,cloadnode.create(pd.parentfpstruct,pd.parentfpstruct.owner)),
+                initcode);
+              tblocknode(pd.parentfpinitblock).left:=cstatementnode.create
+                (initcode,tblocknode(pd.parentfpinitblock).left);
+              current_filepos:=old_filepos;
+            end;
+        end;
+    end;
+
+
+  procedure redirect_parentfpstruct_local_syms(pd: tprocdef);
+    var
+      nestedvarsdef: trecorddef;
+      sl: tpropaccesslist;
+      fsym,
+      lsym,
+      aliassym: tsym;
+      i: longint;
+    begin
+      nestedvarsdef:=trecorddef(tlocalvarsym(pd.parentfpstruct).vardef);
+      for i:=0 to nestedvarsdef.symtable.symlist.count-1 do
+        begin
+          fsym:=tsym(nestedvarsdef.symtable.symlist[i]);
+          if fsym.typ<>fieldvarsym then
+            continue;
+          lsym:=tsym(pd.localst.find(fsym.name));
+          if not assigned(lsym) then
+            lsym:=tsym(pd.parast.find(fsym.name));
+          if not assigned(lsym) then
+            internalerror(2011060408);
+          { add an absolute variable that redirects to the field }
+          sl:=tpropaccesslist.create;
+          sl.addsym(sl_load,pd.parentfpstruct);
+          sl.addsym(sl_subscript,tfieldvarsym(fsym));
+          aliassym:=tabsolutevarsym.create_ref(lsym.name,tfieldvarsym(fsym).vardef,sl);
+          { hide the original variable (can't delete, because there
+            may be other loadnodes that reference it)
+            -- only for locals; hiding parameters changes the
+            function signature }
+          if lsym.typ<>paravarsym then
+            hidesym(lsym);
+          { insert the absolute variable in the localst of the
+            routine; ignore duplicates, because this will also check the
+            parasymtable and we want to override parameters with our local
+            versions }
+          pd.localst.insert(aliassym,false);
+        end;
+    end;
+
+
+  function find_sym_in_parentfpstruct(pd: tprocdef; sym: tsym): tsym;
+    var
+      nestedvarsdef: tdef;
+    begin
+      nestedvarsdef:=tlocalvarsym(pd.parentfpstruct).vardef;
+      result:=search_struct_member(trecorddef(nestedvarsdef),sym.name);
+    end;
+
+
+  procedure finish_parentfpstruct(pd: tprocdef);
+    begin
+      trecordsymtable(trecorddef(tlocalvarsym(pd.parentfpstruct).vardef).symtable).addalignmentpadding;
+    end;
+
+
+
+
 end.
 

compiler/symdef.pas

@@ -559,6 +559,19 @@ interface
             easily write out all methods grouped per class }
           exprasmlist      : TAsmList;
 {$endif jvm}
+          { temporary reference to structure containing copies of all local
+            variables and parameters accessed by nested routines; reference to
+            this structure is passed as "parent frame pointer" on targets that
+            lack this concept (at least JVM and LLVM); no need to save to/
+            restore from ppu, since nested routines are always in the same
+            unit (no need to save to ppu) }
+          parentfpstruct: tsym;
+          { pointer to parentfpstruct's type (not yet valid during parsing, so
+            cannot be used for $parentfp parameter) (no need to save to ppu) }
+          parentfpstructptrtype: tdef;
+          { code to copy the parameters accessed from nested routines into the
+            parentfpstruct (no need to save to ppu) }
+          parentfpinitblock: tnode;
 {$ifdef oldregvars}
           regvarinfo: pregvarinfo;
 {$endif oldregvars}

compiler/symsym.pas

@@ -173,6 +173,7 @@ interface
           defaultconstsymderef : tderef;
           localloc      : TLocation; { register/reference for local var }
           initialloc    : TLocation; { initial location so it can still be initialized later after the location was changed by SSA }
+          inparentfpstruct : boolean;   { migrated to a parentfpstruct because of nested access (not written to ppu, because not important and would change interface crc) }
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;

compiler/systems.pas

@@ -323,6 +323,13 @@ interface
          system_jvm_java32
        ];
 
+       { all systems that don't use a built-in framepointer for accessing nested
+         variables, but emulate it by wrapping nested variables in records
+         whose address is passed around }
+       systems_fpnestedstruct = [
+         system_jvm_java32
+       ];
+
        cpu2str : array[TSystemCpu] of string[10] =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
              'mips','arm', 'powerpc64', 'avr', 'mipsel','jvm');