freepascal.compiler/compiler/ncgnstmm.pas

{
    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.