* defer codegeneration for nested procedures

compiler/pdecsub.pas

@@ -29,15 +29,17 @@ interface
     uses
       tokens,symconst,symtype,symdef,symsym;
 
-    const
-      pd_global    = $1;    { directive must be global }
-      pd_body      = $2;    { directive needs a body }
-      pd_implemen  = $4;    { directive can be used implementation section }
-      pd_interface = $8;    { directive can be used interface section }
-      pd_object    = $10;   { directive can be used object declaration }
-      pd_procvar   = $20;   { directive can be used procvar declaration }
-      pd_notobject = $40;   { directive can not be used object declaration }
-      pd_notobjintf= $80;   { directive can not be used interface declaration }
+    type
+      tpdflag=(
+        pd_body,       { directive needs a body }
+        pd_implemen,   { directive can be used implementation section }
+        pd_interface,  { directive can be used interface section }
+        pd_object,     { directive can be used object declaration }
+        pd_procvar,    { directive can be used procvar declaration }
+        pd_notobject,  { directive can not be used object declaration }
+        pd_notobjintf  { directive can not be used interface declaration }
+      );
+      tpdflags=set of tpdflag;
 
     function  is_proc_directive(tok:ttoken):boolean;
 
@@ -50,7 +52,7 @@ interface
     procedure handle_calling_convention(pd:tabstractprocdef);
 
     procedure parse_parameter_dec(pd:tabstractprocdef);
-    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:word);
+    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_object_proc_directives(pd:tabstractprocdef);
     function  parse_proc_head(aclass:tobjectdef;potype:tproctypeoption):tprocdef;
@@ -341,7 +343,6 @@ implementation
         srsym   : tsym;
         hs1 : string;
         varspez : Tvarspez;
-        hpara      : tparaitem;
         tdefaultvalue : tconstsym;
         defaultrequired : boolean;
         old_object_option : tsymoptions;
@@ -484,7 +485,7 @@ implementation
                    paramanager.push_addr_param(tt.def,pd.proccalloption) then
                   include(vs.varoptions,vo_regable);
               end;
-             hpara:=pd.concatpara(nil,tt,vs,tdefaultvalue,false);
+             pd.concatpara(nil,tt,vs,tdefaultvalue,false);
              vs:=tvarsym(vs.listnext);
            end;
         until not try_to_consume(_SEMICOLON);
@@ -588,9 +589,6 @@ implementation
             begin
               aclass:=tobjectdef(ttypesym(sym).restype.def);
               aprocsym:=tprocsym(aclass.symtable.search(sp));
-              { The procedure has been found. So it is
-                a global one. Set the flags to mark this.}
-              include(current_procinfo.flags,pi_is_global);
               { we solve this below }
               if assigned(aprocsym) then
                begin
@@ -695,13 +693,6 @@ implementation
             else
              aprocsym:=tprocsym.create(orgsp);
             symtablestack.insert(aprocsym);
-         end
-        else
-         begin
-           { Set global flag when found in globalsytmable }
-           if (not parse_only) and
-              (aprocsym.owner.symtabletype=globalsymtable) then
-             include(current_procinfo.flags,pi_is_global);
          end;
 
         { to get the correct symtablelevel we must ignore objectsymtables }
@@ -712,6 +703,10 @@ implementation
         pd._class:=aclass;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
+        { methods need to be exported }
+        if assigned(aclass) and
+           (symtablestack.symtablelevel=main_program_level) then
+          include(pd.procoptions,po_public);
 
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
@@ -756,9 +751,6 @@ implementation
                      inc(testcurobject);
                      single_type(pd.rettype,hs,false);
                      pd.test_if_fpu_result;
-                     if (pd.rettype.def.deftype=stringdef) and
-                        (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
-                       include(current_procinfo.flags,pi_needs_implicit_finally);
                      dec(testcurobject);
                    end
                   else
@@ -1174,7 +1166,7 @@ type
    pd_handler=procedure(pd:tabstractprocdef);
    proc_dir_rec=record
      idtok     : ttoken;
-     pd_flags  : longint;
+     pd_flags  : tpdflags;
      handler   : pd_handler;
      pocall    : tproccalloption;
      pooption  : tprocoptions;
@@ -1189,7 +1181,7 @@ const
    (
     (
       idtok:_ABSTRACT;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
       pocall   : pocall_none;
       pooption : [po_abstractmethod];
@@ -1198,7 +1190,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external]
     ),(
       idtok:_ALIAS;
-      pd_flags : pd_implemen+pd_body+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
       pocall   : pocall_none;
       pooption : [];
@@ -1207,7 +1199,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_ASMNAME;
-      pd_flags : pd_interface+pd_implemen+pd_notobjintf;
+      pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
       pocall   : pocall_cdecl;
       pooption : [po_external];
@@ -1216,7 +1208,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_ASSEMBLER;
-      pd_flags : pd_implemen+pd_body+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_assembler];
@@ -1225,7 +1217,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_CDECL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_cdecl;
       pooption : [];
@@ -1234,7 +1226,7 @@ const
       mutexclpo     : [po_assembler,po_external]
     ),(
       idtok:_DYNAMIC;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
       pocall   : pocall_none;
       pooption : [po_virtualmethod];
@@ -1243,16 +1235,16 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external]
     ),(
       idtok:_EXPORT;
-      pd_flags : pd_body+pd_global+pd_interface+pd_implemen{??}+pd_notobjintf;
+      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_export;
       pocall   : pocall_none;
-      pooption : [po_exports];
+      pooption : [po_exports,po_public];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [potype_constructor,potype_destructor];
       mutexclpo     : [po_external,po_interrupt]
     ),(
       idtok:_EXTERNAL;
-      pd_flags : pd_implemen+pd_interface+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_external;
       pocall   : pocall_none;
       pooption : [po_external];
@@ -1261,7 +1253,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_assembler]
     ),(
       idtok:_FAR;
-      pd_flags : pd_implemen+pd_body+pd_interface+pd_procvar+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far;
       pocall   : pocall_none;
       pooption : [];
@@ -1270,7 +1262,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_FAR16;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobject;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject];
       handler  : nil;
       pocall   : pocall_far16;
       pooption : [];
@@ -1279,7 +1271,7 @@ const
       mutexclpo     : [po_external,po_leftright]
     ),(
       idtok:_FORWARD;
-      pd_flags : pd_implemen+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
       pocall   : pocall_none;
       pooption : [];
@@ -1288,7 +1280,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_FPCCALL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_fpccall;
       pooption : [];
@@ -1297,7 +1289,7 @@ const
       mutexclpo     : [po_leftright]
     ),(
       idtok:_INLINE;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
       pocall   : pocall_inline;
       pooption : [];
@@ -1306,7 +1298,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt]
     ),(
       idtok:_INTERNCONST;
-      pd_flags : pd_implemen+pd_body+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
       pocall   : pocall_none;
       pooption : [po_internconst];
@@ -1315,7 +1307,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_INTERNPROC;
-      pd_flags : pd_implemen+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
       pocall   : pocall_internproc;
       pooption : [];
@@ -1324,7 +1316,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_leftright]
     ),(
       idtok:_INTERRUPT;
-      pd_flags : pd_implemen+pd_body+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
       pocall   : pocall_none;
       pooption : [po_interrupt];
@@ -1334,7 +1326,7 @@ const
       mutexclpo     : [po_external,po_leftright,po_clearstack]
     ),(
       idtok:_IOCHECK;
-      pd_flags : pd_implemen+pd_body+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_iocheck];
@@ -1343,7 +1335,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_MESSAGE;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_message;
       pocall   : pocall_none;
       pooption : []; { can be po_msgstr or po_msgint }
@@ -1352,7 +1344,7 @@ const
       mutexclpo     : [po_interrupt,po_external]
     ),(
       idtok:_NEAR;
-      pd_flags : pd_implemen+pd_body+pd_procvar+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_near;
       pocall   : pocall_none;
       pooption : [];
@@ -1361,7 +1353,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERLOAD;
-      pd_flags : pd_implemen+pd_interface+pd_body;
+      pd_flags : [pd_implemen,pd_interface,pd_body];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
       pocall   : pocall_none;
       pooption : [po_overload];
@@ -1370,7 +1362,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERRIDE;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_override;
       pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];
@@ -1379,7 +1371,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt]
     ),(
       idtok:_PASCAL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_pascal;
       pooption : [];
@@ -1388,7 +1380,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_POPSTACK;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_clearstack];
@@ -1397,16 +1389,16 @@ const
       mutexclpo     : [po_assembler,po_external]
     ),(
       idtok:_PUBLIC;
-      pd_flags : pd_implemen+pd_body+pd_global+pd_notobject+pd_notobjintf;
+      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
       handler  : nil;
       pocall   : pocall_none;
-      pooption : [];
+      pooption : [po_public];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_REGISTER;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_register;
       pooption : [];
@@ -1415,7 +1407,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_REINTRODUCE;
-      pd_flags : pd_interface+pd_object;
+      pd_flags : [pd_interface,pd_object];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
       pocall   : pocall_none;
       pooption : [];
@@ -1424,7 +1416,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_SAFECALL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_safecall;
       pooption : [];
@@ -1433,7 +1425,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_SAVEREGISTERS;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobjintf;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobjintf];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_saveregisters];
@@ -1442,7 +1434,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_STATIC;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_static;
       pocall   : pocall_none;
       pooption : [po_staticmethod];
@@ -1451,7 +1443,7 @@ const
       mutexclpo     : [po_external,po_interrupt,po_exports]
     ),(
       idtok:_STDCALL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_stdcall;
       pooption : [];
@@ -1460,7 +1452,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_SYSCALL;
-      pd_flags : pd_interface+pd_implemen+pd_notobjintf;
+      pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
       pocall   : pocall_palmossyscall;
       pooption : [];
@@ -1469,7 +1461,7 @@ const
       mutexclpo     : [po_external,po_assembler,po_interrupt,po_exports]
     ),(
       idtok:_VIRTUAL;
-      pd_flags : pd_interface+pd_object+pd_notobjintf;
+      pd_flags : [pd_interface,pd_object,pd_notobjintf];
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
       pocall   : pocall_none;
       pooption : [po_virtualmethod];
@@ -1478,7 +1470,7 @@ const
       mutexclpo     : [po_external,po_interrupt,po_exports]
     ),(
       idtok:_CPPDECL;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       handler  : nil;
       pocall   : pocall_cppdecl;
       pooption : [po_savestdregs];
@@ -1487,7 +1479,7 @@ const
       mutexclpo     : [po_assembler,po_external,po_virtualmethod]
     ),(
       idtok:_VARARGS;
-      pd_flags : pd_interface+pd_implemen+pd_procvar;
+      pd_flags : [pd_interface,pd_implemen,pd_procvar];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_varargs];
@@ -1497,7 +1489,7 @@ const
       mutexclpo     : [po_assembler,po_interrupt,po_leftright]
     ),(
       idtok:_COMPILERPROC;
-      pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
       handler  : nil;
       pocall   : pocall_compilerproc;
       pooption : [];
@@ -1522,7 +1514,7 @@ const
       end;
 
 
-    function parse_proc_direc(pd:tabstractprocdef;var pdflags:word):boolean;
+    function parse_proc_direc(pd:tabstractprocdef;var pdflags:tpdflags):boolean;
       {
         Parse the procedure directive, returns true if a correct directive is found
       }
@@ -1560,7 +1552,7 @@ const
          begin
             { parsing a procvar type the name can be any
               next variable !! }
-            if (pdflags and (pd_procvar or pd_object))=0 then
+            if (pdflags * [pd_procvar,pd_object])=[] then
               Message1(parser_w_unknown_proc_directive_ignored,name);
             exit;
          end;
@@ -1592,19 +1584,19 @@ const
 
         { check if method and directive not for object, like public.
           This needs to be checked also for procvars }
-        if ((proc_direcdata[p].pd_flags and pd_notobject)<>0) and
+        if (pd_notobject in proc_direcdata[p].pd_flags) and
            (pd.owner.symtabletype=objectsymtable) then
            exit;
 
         if pd.deftype=procdef then
          begin
            { Check if the directive is only for objects }
-           if ((proc_direcdata[p].pd_flags and pd_object)<>0) and
+           if (pd_object in proc_direcdata[p].pd_flags) and
               not assigned(tprocdef(pd)._class) then
             exit;
 
            { check if method and directive not for interface }
-           if ((proc_direcdata[p].pd_flags and pd_notobjintf)<>0) and
+           if (pd_notobjintf in proc_direcdata[p].pd_flags) and
               is_interface(tprocdef(pd)._class) then
             exit;
          end;
@@ -1614,30 +1606,28 @@ const
         parse_proc_direc:=true;
 
         { Check the pd_flags if the directive should be allowed }
-        if ((pdflags and pd_interface)<>0) and
-           ((proc_direcdata[p].pd_flags and pd_interface)=0) then
+        if (pd_interface in pdflags) and
+           not(pd_interface in proc_direcdata[p].pd_flags) then
           begin
             Message1(parser_e_proc_dir_not_allowed_in_interface,name);
             exit;
           end;
-        if ((pdflags and pd_implemen)<>0) and
-           ((proc_direcdata[p].pd_flags and pd_implemen)=0) then
+        if (pd_implemen in pdflags) and
+           not(pd_implemen in proc_direcdata[p].pd_flags) then
           begin
             Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
             exit;
           end;
-        if ((pdflags and pd_procvar)<>0) and
-           ((proc_direcdata[p].pd_flags and pd_procvar)=0) then
+        if (pd_procvar in pdflags) and
+           not(pd_procvar in proc_direcdata[p].pd_flags) then
           begin
             Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
             exit;
           end;
 
         { Return the new pd_flags }
-        if (proc_direcdata[p].pd_flags and pd_body)=0 then
-          pdflags:=pdflags and (not pd_body);
-        if (proc_direcdata[p].pd_flags and pd_global)<>0 then
-          pdflags:=pdflags or pd_global;
+        if not(pd_body in proc_direcdata[p].pd_flags) then
+          exclude(pdflags,pd_body);
 
         { Add the correct flag }
         pd.procoptions:=pd.procoptions+proc_direcdata[p].pooption;
@@ -1826,7 +1816,7 @@ const
 
 
 
-    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:word);
+    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
       {
         Parse the procedure directives. It does not matter if procedure directives
         are written using ;procdir; or ['procdir'] syntax.
@@ -1870,10 +1860,10 @@ const
 
     procedure parse_var_proc_directives(sym:tsym);
       var
-        pdflags : word;
+        pdflags : tpdflags;
         pd      : tabstractprocdef;
       begin
-        pdflags:=pd_procvar;
+        pdflags:=[pd_procvar];
         pd:=nil;
         case sym.typ of
           varsym :
@@ -1894,9 +1884,9 @@ const
 
     procedure parse_object_proc_directives(pd:tabstractprocdef);
       var
-        pdflags : word;
+        pdflags : tpdflags;
       begin
-        pdflags:=pd_object;
+        pdflags:=[pd_object];
         parse_proc_directives(pd,pdflags);
       end;
 
@@ -2173,7 +2163,10 @@ const
 end.
 {
   $Log$
-  Revision 1.124  2003-05-15 18:58:53  peter
+  Revision 1.125  2003-05-22 21:31:35  peter
+    * defer codegeneration for nested procedures
+
+  Revision 1.124  2003/05/15 18:58:53  peter
     * removed selfpointer_offset, vmtpointer_offset
     * tvarsym.adjusted_address
     * address in localsymtable is now in the real direction

compiler/pmodules.pas

@@ -725,6 +725,7 @@ implementation
         inc(ps.refs);
         symtablestack.insert(ps);
         pd:=tprocdef.create(main_program_level);
+        include(pd.procoptions,po_public);
         pd.procsym:=ps;
         ps.addprocdef(pd);
         { restore symtable }
@@ -799,7 +800,7 @@ implementation
         objectlibrary.getlabel(aktexitlabel);
         objectlibrary.getlabel(aktexit2label);
         include(current_procinfo.flags,pi_do_call);
-        genentrycode(list,true,0,parasize,nostackframe,false);
+        genentrycode(list,0,parasize,nostackframe,false);
         genexitcode(list,parasize,nostackframe,false);
         list.convert_registers;
         release_main_proc(pd);
@@ -844,18 +845,15 @@ implementation
 
          if token=_ID then
           begin
-          { create filenames and unit name }
+             { create filenames and unit name }
              main_file := current_scanner.inputfile;
              while assigned(main_file.next) do
                main_file := main_file.next;
 
              current_module.SetFileName(main_file.path^+main_file.name^,true);
+             current_module.SetModuleName(orgpattern);
 
-             stringdispose(current_module.modulename);
-             stringdispose(current_module.realmodulename);
-             current_module.modulename:=stringdup(pattern);
-             current_module.realmodulename:=stringdup(orgpattern);
-          { check for system unit }
+             { check for system unit }
              new(s2);
              s2^:=upper(SplitName(main_file.name^));
              if (cs_check_unit_name in aktglobalswitches) and
@@ -1040,7 +1038,9 @@ implementation
          { Compile the unit }
          pd:=create_main_proc(current_module.modulename^+'_init',potype_unitinit,st);
          pd.aliasnames.insert('INIT$$'+current_module.modulename^);
-         compile_proc_body(pd,true,false);
+         tcgprocinfo(current_procinfo).parse_body;
+         tcgprocinfo(current_procinfo).generate_code;
+         tcgprocinfo(current_procinfo).resetprocdef;
          release_main_proc(pd);
 
          { if the unit contains ansi/widestrings, initialization and
@@ -1064,7 +1064,9 @@ implementation
               { Compile the finalize }
               pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              compile_proc_body(pd,true,false);
+              tcgprocinfo(current_procinfo).parse_body;
+              tcgprocinfo(current_procinfo).generate_code;
+              tcgprocinfo(current_procinfo).resetprocdef;
               release_main_proc(pd);
            end
          else if force_init_final then
@@ -1352,7 +1354,9 @@ implementation
   PROCEDURE main(ArgC:Integer;ArgV,EnvP:ARRAY OF PChar):Integer;CDECL;
 So, all parameters are passerd into registers in sparc architecture.}
 {$ENDIF SPARC}
-         compile_proc_body(pd,true,false);
+         tcgprocinfo(current_procinfo).parse_body;
+         tcgprocinfo(current_procinfo).generate_code;
+         tcgprocinfo(current_procinfo).resetprocdef;
          release_main_proc(pd);
 
          { should we force unit initialization? }
@@ -1390,7 +1394,9 @@ So, all parameters are passerd into registers in sparc architecture.}
               { Compile the finalize }
               pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              compile_proc_body(pd,true,false);
+              tcgprocinfo(current_procinfo).parse_body;
+              tcgprocinfo(current_procinfo).generate_code;
+              tcgprocinfo(current_procinfo).resetprocdef;
               release_main_proc(pd);
            end;
 
@@ -1482,7 +1488,10 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 {
   $Log$
-  Revision 1.106  2003-05-15 18:58:53  peter
+  Revision 1.107  2003-05-22 21:31:35  peter
+    * defer codegeneration for nested procedures
+
+  Revision 1.106  2003/05/15 18:58:53  peter
     * removed selfpointer_offset, vmtpointer_offset
     * tvarsym.adjusted_address
     * address in localsymtable is now in the real direction

compiler/psub.pas

@@ -27,11 +27,26 @@ unit psub;
 interface
 
     uses
-      symdef;
+      cclasses,
+      node,
+      symdef,cgbase;
+
+    type
+      tcgprocinfo=class(tprocinfo)
+        { code for the subroutine as tree }
+        code : tnode;
+        nestedprocs : tlinkedlist;
+        constructor create(aparent:tprocinfo);override;
+        destructor  destroy;override;
+        procedure generate_code;
+        procedure resetprocdef;
+        procedure add_to_symtablestack;
+        procedure remove_from_symtablestack;
+        procedure parse_body;
+      end;
 
-    procedure printnode_reset;
 
-    procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
+    procedure printnode_reset;
 
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
@@ -44,7 +59,7 @@ implementation
 
     uses
        { common }
-       cutils,cclasses,
+       cutils,
        { global }
        globtype,globals,tokens,verbose,comphook,
        systems,
@@ -55,7 +70,6 @@ implementation
        paramgr,
        ppu,fmodule,
        { pass 1 }
-       node,
        nutils,nbas,nld,ncal,ncon,nflw,nadd,ncnv,nmem,
        pass_1,
     {$ifdef state_tracking}
@@ -69,7 +83,7 @@ implementation
        scanner,
        pbase,pstatmnt,pdecl,pdecsub,pexports,
        { codegen }
-       tgobj,cgbase,rgobj,rgcpu,
+       tgobj,rgobj,
        ncgutil
        {$ifndef NOOPT}
          {$ifdef i386}
@@ -80,7 +94,6 @@ implementation
        {$endif}
        ;
 
-
 {****************************************************************************
                       PROCEDURE/FUNCTION BODY PARSING
 ****************************************************************************}
@@ -515,302 +528,339 @@ implementation
       end;
 
 
-    procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
-      {
-        Compile the body of a procedure
-      }
+{****************************************************************************
+                                  TCGProcInfo
+****************************************************************************}
+
+    constructor tcgprocinfo.create(aparent:tprocinfo);
+      begin
+        inherited Create(aparent);
+        nestedprocs:=tlinkedlist.create;
+      end;
+
+
+     destructor tcgprocinfo.destroy;
+       begin
+         inherited destroy;
+         nestedprocs.free;
+       end;
+
+
+    procedure tcgprocinfo.generate_code;
+      var
+        oldprocdef : tprocdef;
+        oldprocinfo : tprocinfo;
+        oldexitlabel,
+        oldexit2label : tasmlabel;
+        oldaktmaxfpuregisters : longint;
+        oldfilepos : tfileposinfo;
+        { true when no stackframe is required }
+        nostackframe:boolean;
+        { number of bytes which have to be cleared by RET }
+        parasize:longint;
+      begin
+        { the initialization procedure can be empty, then we
+          don't need to generate anything. When it was an empty
+          procedure there would be at least a blocknode }
+        if not assigned(code) then
+          exit;
+
+        oldprocinfo:=current_procinfo;
+        oldprocdef:=current_procdef;
+        oldfilepos:=aktfilepos;
+        oldaktmaxfpuregisters:=aktmaxfpuregisters;
+
+        current_procinfo:=self;
+        current_procdef:=procdef;
+
+        { save old labels }
+        oldexitlabel:=aktexitlabel;
+        oldexit2label:=aktexit2label;
+        { get new labels }
+        objectlibrary.getlabel(aktexitlabel);
+        objectlibrary.getlabel(aktexit2label);
+        aktbreaklabel:=nil;
+        aktcontinuelabel:=nil;
+
+        { add parast/localst to symtablestack }
+        add_to_symtablestack;
+
+        { reset the temporary memory }
+        rg.cleartempgen;
+        rg.usedinproc:=[];
+        rg.usedbyproc:=[];
+
+        { set the start offset to the start of the temp area in the stack }
+        tg.setfirsttemp(current_procinfo.firsttemp_offset);
+
+        generatecode(code);
+
+        { first generate entry code with the correct position and switches }
+        aktfilepos:=current_procinfo.entrypos;
+        aktlocalswitches:=current_procinfo.entryswitches;
+        genentrycode(current_procinfo.aktentrycode,0,parasize,nostackframe,false);
+
+        { now generate exit code with the correct position and switches }
+        aktfilepos:=current_procinfo.exitpos;
+        aktlocalswitches:=current_procinfo.exitswitches;
+        genexitcode(current_procinfo.aktexitcode,parasize,nostackframe,false);
+
+        { now all the registers used are known }
+        current_procdef.usedintregisters:=rg.usedintinproc;
+        current_procdef.usedotherregisters:=rg.usedinproc;
+        current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
+        current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
+{$ifdef newra}
+{                rg.writegraph;}
+{$endif}
+        if not(cs_no_regalloc in aktglobalswitches) then
+          begin
+{$ifdef newra}
+            {Do register allocation.}
+            repeat
+              rg.prepare_colouring;
+              rg.colour_registers;
+              rg.epilogue_colouring;
+              {Are there spilled registers? We cannot do that yet.}
+              if rg.spillednodes<>'' then
+                internalerror(200304221);
+              {if not try_fast_spill(rg) then
+                slow_spill(rg);
+              }
+            until rg.spillednodes='';
+            current_procinfo.aktproccode.translate_registers(rg.colour);
+            current_procinfo.aktproccode.convert_registers;
+{$else newra}
+            current_procinfo.aktproccode.convert_registers;
+{$ifndef NoOpt}
+            if (cs_optimize in aktglobalswitches) and
+            { do not optimize pure assembler procedures }
+               not(pi_is_assembler in current_procinfo.flags)  then
+              optimize(current_procinfo.aktproccode);
+{$endif NoOpt}
+{$endif newra}
+          end;
+
+        { save local data (casetable) also in the same file }
+        if assigned(current_procinfo.aktlocaldata) and
+           (not current_procinfo.aktlocaldata.empty) then
+         begin
+           current_procinfo.aktproccode.concat(Tai_section.Create(sec_data));
+           current_procinfo.aktproccode.concatlist(current_procinfo.aktlocaldata);
+           current_procinfo.aktproccode.concat(Tai_section.Create(sec_code));
+        end;
+
+        { add the procedure to the codesegment }
+        if (cs_create_smart in aktmoduleswitches) then
+         codeSegment.concat(Tai_cut.Create);
+        codeSegment.concatlist(current_procinfo.aktproccode);
+
+        { all registers can be used again }
+        rg.resetusableregisters;
+        { only now we can remove the temps }
+        tg.resettempgen;
+
+        { restore symtablestack }
+        remove_from_symtablestack;
+
+        { restore labels }
+        aktexitlabel:=oldexitlabel;
+        aktexit2label:=oldexit2label;
+
+        { restore }
+        aktmaxfpuregisters:=oldaktmaxfpuregisters;
+        aktfilepos:=oldfilepos;
+        current_procdef:=oldprocdef;
+        current_procinfo:=oldprocinfo;
+      end;
+
+
+    procedure tcgprocinfo.add_to_symtablestack;
+      var
+        _class,hp : tobjectdef;
+      begin
+        { insert symtables for the class, but only if it is no nested function }
+        if assigned(procdef._class) and
+           not(assigned(parent) and
+               assigned(parent.procdef) and
+               assigned(parent.procdef._class)) then
+          begin
+            { insert them in the reverse order }
+            hp:=nil;
+            repeat
+              _class:=procdef._class;
+              while _class.childof<>hp do
+                _class:=_class.childof;
+              hp:=_class;
+              _class.symtable.next:=symtablestack;
+              symtablestack:=_class.symtable;
+            until hp=procdef._class;
+          end;
+
+        { insert parasymtable in symtablestack when parsing
+          a function }
+        if procdef.parast.symtablelevel>=normal_function_level then
+          begin
+             procdef.parast.next:=symtablestack;
+             symtablestack:=procdef.parast;
+          end;
+
+        procdef.localst.next:=symtablestack;
+        symtablestack:=procdef.localst;
+      end;
+
+
+    procedure tcgprocinfo.remove_from_symtablestack;
+      begin
+        { remove localst/parast }
+        if procdef.parast.symtablelevel>=normal_function_level then
+          symtablestack:=symtablestack.next.next
+        else
+          symtablestack:=symtablestack.next;
+
+        { remove class member symbol tables }
+        while symtablestack.symtabletype=objectsymtable do
+          symtablestack:=symtablestack.next;
+      end;
+
+
+    procedure tcgprocinfo.resetprocdef;
+      begin
+         { the local symtables can be deleted, but the parast   }
+         { doesn't, (checking definitons when calling a        }
+         { function                                        }
+         { not for a inline procedure !!               (PM)   }
+         { at lexlevel = 1 localst is the staticsymtable itself }
+         { so no dispose here !!                              }
+         if assigned(code) and
+            not(cs_browser in aktmoduleswitches) and
+            (procdef.proccalloption<>pocall_inline) then
+           begin
+             if procdef.parast.symtablelevel>=normal_function_level then
+               procdef.localst.free;
+             procdef.localst:=nil;
+           end;
+
+         { remove code tree, if not inline procedure }
+         if assigned(code) then
+          begin
+            { the inline procedure has already got a copy of the tree
+              stored in current_procdef.code }
+            code.free;
+            if (procdef.proccalloption<>pocall_inline) then
+              procdef.code:=nil;
+          end;
+       end;
+
+
+    procedure tcgprocinfo.parse_body;
       var
-         oldexitlabel,oldexit2label : tasmlabel;
-         oldquickexitlabel:tasmlabel;
-         _class,hp:tobjectdef;
-         { switches can change inside the procedure }
-         entryswitches, exitswitches : tlocalswitches;
-         oldaktmaxfpuregisters,localmaxfpuregisters : longint;
-         { code for the subroutine as tree }
-         code:tnode;
-         { true when no stackframe is required }
-         nostackframe:boolean;
-         { number of bytes which have to be cleared by RET }
-         parasize:longint;
-         { filepositions }
-         entrypos,
-         savepos,
-         exitpos   : tfileposinfo;
          oldprocdef : tprocdef;
+         oldprocinfo : tprocinfo;
       begin
          oldprocdef:=current_procdef;
-         current_procdef:=pd;
+         oldprocinfo:=current_procinfo;
+
+         current_procinfo:=self;
+         current_procdef:=procdef;
 
          { calculate the lexical level }
-         if current_procdef.parast.symtablelevel>maxnesting then
+         if procdef.parast.symtablelevel>maxnesting then
            Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
-         if (po_staticmethod in current_procdef.procoptions) then
+         if (po_staticmethod in procdef.procoptions) then
            allow_only_static:=true
-         else if (current_procdef.parast.symtablelevel=normal_function_level) then
+         else if (procdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
 
-         { save old labels }
-         oldexitlabel:=aktexitlabel;
-         oldexit2label:=aktexit2label;
-         oldquickexitlabel:=quickexitlabel;
-         { get new labels }
-         objectlibrary.getlabel(aktexitlabel);
-         objectlibrary.getlabel(aktexit2label);
-         { exit for fail in constructors }
-         if (current_procdef.proctypeoption=potype_constructor) then
-           objectlibrary.getlabel(quickexitlabel);
          { reset break and continue labels }
          block_type:=bt_general;
-         aktbreaklabel:=nil;
-         aktcontinuelabel:=nil;
     {$ifdef state_tracking}
 {    aktstate:=Tstate_storage.create;}
     {$endif state_tracking}
 
-         { insert symtables for the class, but only if it is no nested function }
-         if assigned(current_procdef._class) and not(parent_has_class) then
-           begin
-             { insert them in the reverse order }
-             hp:=nil;
-             repeat
-               _class:=current_procdef._class;
-               while _class.childof<>hp do
-                 _class:=_class.childof;
-               hp:=_class;
-               _class.symtable.next:=symtablestack;
-               symtablestack:=_class.symtable;
-             until hp=current_procdef._class;
-           end;
-
-         { insert parasymtable in symtablestack when parsing
-           a function }
-         if current_procdef.parast.symtablelevel>=normal_function_level then
-           begin
-              current_procdef.parast.next:=symtablestack;
-              symtablestack:=current_procdef.parast;
-           end;
          { create a local symbol table for this routine }
-         if not assigned(current_procdef.localst) then
-            current_procdef.insert_localst;
-         { insert localsymtable in symtablestack}
-         current_procdef.localst.next:=symtablestack;
-         symtablestack:=current_procdef.localst;
+         if not assigned(procdef.localst) then
+           procdef.insert_localst;
+
+         { add parast/localst to symtablestack }
+         add_to_symtablestack;
+
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
 
-         { reset the temporary memory }
-         rg.cleartempgen;
-         rg.usedinproc:=[];
-         rg.usedbyproc:=[];
-
          { save entry info }
          entrypos:=aktfilepos;
          entryswitches:=aktlocalswitches;
-         localmaxfpuregisters:=aktmaxfpuregisters;
+
          { parse the code ... }
          code:=block(current_module.islibrary);
-         { get a better entry point }
-         if assigned(code) then
-           entrypos:=code.fileinfo;
+
          { save exit info }
          exitswitches:=aktlocalswitches;
          exitpos:=last_endtoken_filepos;
-         { save current filepos }
-         savepos:=aktfilepos;
-         { add implicit entry and exit code }
-         if assigned(code) then
-           add_entry_exit_code(code,entrypos,exitpos);
-         { store a copy of the original tree for inline, for
-           normal procedures only store a reference to the
-           current tree }
-         if (current_procdef.proccalloption=pocall_inline) then
-           current_procdef.code:=code.getcopy
-         else
-           current_procdef.code:=code;
-
-         {When we are called to compile the body of a unit, aktprocsym should
-          point to the unit initialization. If the unit has no initialization,
-          aktprocsym=nil. But in that case code=nil. Thus we should check for
-          code=nil, when we use aktprocsym.}
 
-         { set the start offset to the start of the temp area in the stack }
-         tg.setfirsttemp(current_procinfo.firsttemp_offset);
-
-         { ... and generate assembler }
-         { but set the right switches for entry !! }
-         aktlocalswitches:=entryswitches;
-         oldaktmaxfpuregisters:=aktmaxfpuregisters;
-         aktmaxfpuregisters:=localmaxfpuregisters;
          if assigned(code) then
-          begin
-            { the procedure is now defined }
-            current_procdef.forwarddef:=false;
-
-            if paraprintnodetree=1 then
-              printnode_procdef(current_procdef);
-
-            { only generate the code if no type errors are found, else
-              finish at least the type checking pass }
-{$ifndef NOPASS2}
-            if (status.errorcount=0) then
-              begin
-                generatecode(code);
-                { first generate entry code with the correct position and switches }
-                aktfilepos:=entrypos;
-                aktlocalswitches:=entryswitches;
-                genentrycode(current_procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
-
-                { FPC_POPADDRSTACK destroys all registers (JM) }
-                if (pi_needs_implicit_finally in current_procinfo.flags) or
-                   (pi_uses_exceptions in current_procinfo.flags) then
-                 begin
-                   rg.usedinproc := ALL_REGISTERS;
-                 end;
-
-                { now generate exit code with the correct position and switches }
-                aktfilepos:=exitpos;
-                aktlocalswitches:=exitswitches;
-                genexitcode(current_procinfo.aktexitcode,parasize,nostackframe,false);
-
-                { now all the registers used are known }
-                current_procdef.usedintregisters:=rg.usedintinproc;
-                current_procdef.usedotherregisters:=rg.usedinproc;
-                current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
-                current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
-{$ifdef newra}
-{                rg.writegraph;}
-{$endif}
-                if not(cs_no_regalloc in aktglobalswitches) then
-                  begin
-{$ifdef newra}
-                    {Do register allocation.}
-                    repeat
-                      rg.prepare_colouring;
-                      rg.colour_registers;
-                      rg.epilogue_colouring;
-                      {Are there spilled registers? We cannot do that yet.}
-                      if rg.spillednodes<>'' then
-                        internalerror(200304221);
-                      {if not try_fast_spill(rg) then
-                        slow_spill(rg);
-                      }
-                    until rg.spillednodes='';
-                    current_procinfo.aktproccode.translate_registers(rg.colour);
-                    current_procinfo.aktproccode.convert_registers;
-{$else newra}
-                    current_procinfo.aktproccode.convert_registers;
-{$ifndef NoOpt}
-                    if (cs_optimize in aktglobalswitches) and
-                    { do not optimize pure assembler procedures }
-                       not(pi_is_assembler in current_procinfo.flags)  then
-                      optimize(current_procinfo.aktproccode);
-{$endif NoOpt}
-{$endif newra}
-                  end;
-                { save local data (casetable) also in the same file }
-                if assigned(current_procinfo.aktlocaldata) and
-                   (not current_procinfo.aktlocaldata.empty) then
-                 begin
-                   current_procinfo.aktproccode.concat(Tai_section.Create(sec_data));
-                   current_procinfo.aktproccode.concatlist(current_procinfo.aktlocaldata);
-                   current_procinfo.aktproccode.concat(Tai_section.Create(sec_code));
-                end;
+           begin
+             { get a better entry point }
+             entrypos:=code.fileinfo;
 
-                { add the procedure to the codesegment }
-                if (cs_create_smart in aktmoduleswitches) then
-                 codeSegment.concat(Tai_cut.Create);
-                codeSegment.concatlist(current_procinfo.aktproccode);
-              end
-            else
-              do_resulttypepass(code);
-{$else NOPASS2}
-            do_resulttypepass(code);
-{$endif NOPASS2}
-          end;
+             { the procedure is now defined }
+             procdef.forwarddef:=false;
 
-         { ... remove symbol tables }
-         if current_procdef.parast.symtablelevel>=normal_function_level then
-           symtablestack:=symtablestack.next.next
-         else
-           symtablestack:=symtablestack.next;
+             { add implicit entry and exit code }
+             add_entry_exit_code(code,entrypos,exitpos);
 
-         { ... check for unused symbols      }
-         { but only if there is no asm block }
-         if assigned(code) then
-           begin
              if (Errorcount=0) then
                begin
                  { check if forwards are resolved }
-                 tstoredsymtable(current_procdef.localst).check_forwards;
+                 tstoredsymtable(procdef.localst).check_forwards;
                  { check if all labels are used }
-                 tstoredsymtable(current_procdef.localst).checklabels;
+                 tstoredsymtable(procdef.localst).checklabels;
                  { remove cross unit overloads }
-                 tstoredsymtable(current_procdef.localst).unchain_overloaded;
+                 tstoredsymtable(procdef.localst).unchain_overloaded;
                end;
-             if not(pi_uses_asm in current_procinfo.flags) then
+
+             { check for unused symbols, but only if there is no asm block }
+             if not(pi_uses_asm in flags) then
                begin
                   { not for unit init, becuase the var can be used in finalize,
                     it will be done in proc_unit }
-                  if not(current_procdef.proctypeoption
-                     in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
-                     tstoredsymtable(current_procdef.localst).allsymbolsused;
-                  tstoredsymtable(current_procdef.parast).allsymbolsused;
+                  if not(procdef.proctypeoption in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
+                     tstoredsymtable(procdef.localst).allsymbolsused;
+                  tstoredsymtable(procdef.parast).allsymbolsused;
                end;
-           end;
-
-         { the local symtables can be deleted, but the parast   }
-         { doesn't, (checking definitons when calling a        }
-         { function                                        }
-         { not for a inline procedure !!               (PM)   }
-         { at lexlevel = 1 localst is the staticsymtable itself }
-         { so no dispose here !!                              }
-         if assigned(code) and
-            not(cs_browser in aktmoduleswitches) and
-            (current_procdef.proccalloption<>pocall_inline) then
-           begin
-             if current_procdef.parast.symtablelevel>=normal_function_level then
-               current_procdef.localst.free;
-             current_procdef.localst:=nil;
-           end;
 
-         { all registers can be used again }
-         rg.resetusableregisters;
-         { only now we can remove the temps }
-         tg.resettempgen;
+             { Finish type checking pass }
+             do_resulttypepass(code);
 
-         { remove code tree, if not inline procedure }
-         if assigned(code) then
-          begin
-            { the inline procedure has already got a copy of the tree
-              stored in current_procdef.code }
-            code.free;
-            if (current_procdef.proccalloption<>pocall_inline) then
-              current_procdef.code:=nil;
-          end;
+             { Print the node to tree.log }
+             if paraprintnodetree=1 then
+               printnode_procdef(procdef);
+           end;
 
-         { remove class member symbol tables }
-         while symtablestack.symtabletype=objectsymtable do
-           symtablestack:=symtablestack.next;
+         { store a copy of the original tree for inline, for
+           normal procedures only store a reference to the
+           current tree }
+         if (procdef.proccalloption=pocall_inline) then
+           procdef.code:=code.getcopy
+         else
+           procdef.code:=code;
 
-         aktmaxfpuregisters:=oldaktmaxfpuregisters;
+         { ... remove symbol tables }
+         remove_from_symtablestack;
 
     {$ifdef state_tracking}
 {    aktstate.destroy;}
     {$endif state_tracking}
-         { restore filepos, the switches are already set }
-         aktfilepos:=savepos;
-         { restore labels }
-         aktexitlabel:=oldexitlabel;
-         aktexit2label:=oldexit2label;
-         quickexitlabel:=oldquickexitlabel;
 
          { reset to normal non static function }
          if (current_procdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
 
          current_procdef:=oldprocdef;
+         current_procinfo:=oldprocinfo;
       end;
 
 
@@ -852,14 +902,32 @@ implementation
         Parses the procedure directives, then parses the procedure body, then
         generates the code for it
       }
+
+      procedure do_generate_code(pi:tcgprocinfo);
+        var
+          hpi : tcgprocinfo;
+        begin
+          { process nested procs first }
+          hpi:=tcgprocinfo(pi.nestedprocs.first);
+          while assigned(hpi) do
+           begin
+             do_generate_code(hpi);
+             hpi:=tcgprocinfo(hpi.next);
+           end;
+          { generate code for this procedure }
+          pi.generate_code;
+          pi.resetprocdef;
+        end;
+
       var
         oldprocdef       : tprocdef;
         old_current_procinfo : tprocinfo;
         oldconstsymtable : tsymtable;
         oldselftokenmode,
         oldfailtokenmode : tmodeswitch;
-        pdflags          : word;
+        pdflags          : tpdflags;
         pd               : tprocdef;
+        isnestedproc     : boolean;
       begin
          { save old state }
          oldprocdef:=current_procdef;
@@ -869,18 +937,14 @@ implementation
          { reset current_procdef to nil to be sure that nothing is writing
            to an other procdef }
          current_procdef:=nil;
-
-         { create a new procedure }
-         current_procinfo:=cprocinfo.create(old_current_procinfo);
-         current_module.procinfo:=current_procinfo;
+         current_procinfo:=nil;
 
          { parse procedure declaration }
-         if assigned(current_procinfo.parent) and
-            assigned(current_procinfo.parent.procdef) then
-          pd:=parse_proc_dec(current_procinfo.parent.procdef._class)
+         if assigned(old_current_procinfo) and
+            assigned(old_current_procinfo.procdef) then
+          pd:=parse_proc_dec(old_current_procinfo.procdef._class)
          else
           pd:=parse_proc_dec(nil);
-         current_procinfo.procdef:=pd;
 
          { set the default function options }
          if parse_only then
@@ -889,15 +953,17 @@ implementation
             { set also the interface flag, for better error message when the
               implementation doesn't much this header }
             pd.interfacedef:=true;
-            pdflags:=pd_interface;
+            include(pd.procoptions,po_public);
+            pdflags:=[pd_interface];
           end
          else
           begin
-            pdflags:=pd_body;
+            pdflags:=[pd_body];
             if (not current_module.in_interface) then
-             pdflags:=pdflags or pd_implemen;
-            if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
-             pdflags:=pdflags or pd_global;
+              include(pdflags,pd_implemen);
+            if (not current_module.is_unit) or
+               (cs_create_smart in aktmoduleswitches) then
+              include(pd.procoptions,po_public);
             pd.forwarddef:=false;
           end;
 
@@ -918,7 +984,7 @@ implementation
            begin
              { A method must be forward defined (in the object declaration) }
              if assigned(pd._class) and
-                (not assigned(current_procinfo.parent.procdef._class)) then
+                (not assigned(old_current_procinfo.procdef._class)) then
               begin
                 Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
                 tprocsym(pd.procsym).write_parameter_lists(pd);
@@ -941,79 +1007,81 @@ implementation
                  begin
                    { check the global flag, for delphi this is not
                      required }
-                   if not(m_delphi in aktmodeswitches) and
-                      (pi_is_global in current_procinfo.flags) then
-                     Message(parser_e_overloaded_must_be_all_global);
+                   {if not(m_delphi in aktmodeswitches) and
+                      not(pd.procsym.owner.symtabletype=globalsymtable) then
+                     Message(parser_e_overloaded_must_be_all_global);}
                  end;
               end;
            end;
 
-         { update procinfo, because the procdef can be
-           changed by check_identical_proc (PFV) }
-         current_procinfo.procdef:=pd;
-
          { compile procedure when a body is needed }
-         if (pdflags and pd_body)<>0 then
-          begin
-            Message1(parser_d_procedure_start,pd.fullprocname(false));
-            pd.aliasnames.insert(pd.mangledname);
+         if (pd_body in pdflags) then
+           begin
+             Message1(parser_d_procedure_start,pd.fullprocname(false));
+
+             { create a new procedure }
+             current_procinfo:=cprocinfo.create(old_current_procinfo);
+             current_module.procinfo:=current_procinfo;
+             current_procinfo.procdef:=pd;
+             isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
 
-            { Insert result variables in the localst }
-            insert_funcret_local(pd);
+             { Insert mangledname }
+             pd.aliasnames.insert(pd.mangledname);
 
-            { Insert local copies for value para }
-            pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
+             { 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);
+
+             { Update parameter information }
+             current_procinfo.allocate_implicit_parameter;
 {$ifdef i386}
-            { add implicit pushes for interrupt routines }
-            if (po_interrupt in pd.procoptions) then
-              current_procinfo.allocate_interrupt_stackframe;
+             { add implicit pushes for interrupt routines }
+             if (po_interrupt in pd.procoptions) then
+               current_procinfo.allocate_interrupt_stackframe;
 {$endif i386}
 
-{$ifdef powerpc}
-            { temp hack for nested procedures on ppc }
-
-            { Calculate offsets }
-            current_procinfo.after_header;
-
-            { Update parameter information }
-            current_procinfo.allocate_implicit_parameter;
-{$else powerpc}
-            { Update parameter information }
-            current_procinfo.allocate_implicit_parameter;
-
-            { Calculate offsets }
-            current_procinfo.after_header;
-{$endif powerpc}
-
-            { set _FAIL as keyword if constructor }
-            if (pd.proctypeoption=potype_constructor) then
-             begin
-               oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
-               tokeninfo^[_FAIL].keyword:=m_all;
-             end;
-            { set _SELF as keyword if methods }
-            if assigned(pd._class) then
-             begin
-               oldselftokenmode:=tokeninfo^[_SELF].keyword;
-               tokeninfo^[_SELF].keyword:=m_all;
-             end;
-
-            compile_proc_body(pd,((pdflags and pd_global)<>0),assigned(current_procinfo.parent.procdef._class));
-
-            { reset _FAIL as _SELF normal }
-            if (pd.proctypeoption=potype_constructor) then
-              tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
-            if assigned(pd._class) then
-              tokeninfo^[_SELF].keyword:=oldselftokenmode;
-             consume(_SEMICOLON);
-          end;
+             { Calculate offsets }
+             current_procinfo.after_header;
 
-         { release procinfo }
-         if tprocinfo(current_module.procinfo)<>current_procinfo then
-          internalerror(200304274);
-         current_module.procinfo:=current_procinfo.parent;
-         current_procinfo.free;
+             { set _FAIL as keyword if constructor }
+             if (pd.proctypeoption=potype_constructor) then
+              begin
+                oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
+                tokeninfo^[_FAIL].keyword:=m_all;
+              end;
+             { set _SELF as keyword if methods }
+             if assigned(pd._class) then
+              begin
+                oldselftokenmode:=tokeninfo^[_SELF].keyword;
+                tokeninfo^[_SELF].keyword:=m_all;
+              end;
+
+             tcgprocinfo(current_procinfo).parse_body;
+
+             { When it's a nested procedure then defer the code generation,
+               when back at normal function level then generate the code
+               for all defered nested procedures and the current procedure }
+             if isnestedproc then
+               tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
+             else
+               do_generate_code(tcgprocinfo(current_procinfo));
+
+             { reset _FAIL as _SELF normal }
+             if (pd.proctypeoption=potype_constructor) then
+               tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
+             if assigned(pd._class) then
+               tokeninfo^[_SELF].keyword:=oldselftokenmode;
+              consume(_SEMICOLON);
+
+             { release procinfo }
+             if tprocinfo(current_module.procinfo)<>current_procinfo then
+               internalerror(200304274);
+             current_module.procinfo:=current_procinfo.parent;
+             if not isnestedproc then
+               current_procinfo.free;
+           end;
 
          { Restore old state }
          constsymtable:=oldconstsymtable;
@@ -1138,10 +1206,16 @@ implementation
           symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_forward_class,nil);
       end;
 
+
+begin
+  cprocinfo:=tcgprocinfo;
 end.
 {
   $Log$
-  Revision 1.114  2003-05-16 20:00:39  jonas
+  Revision 1.115  2003-05-22 21:31:35  peter
+    * defer codegeneration for nested procedures
+
+  Revision 1.114  2003/05/16 20:00:39  jonas
     * powerpc nested procedure fixes, should work completely now if all
       local variables of the parent procedure are declared before the
       nested procedures are declared

compiler/symconst.pas

@@ -194,7 +194,8 @@ type
     po_leftright,         { push arguments from left to right }
     po_clearstack,        { caller clears the stack }
     po_internconst,       { procedure has constant evaluator intern }
-    po_addressonly        { flag that only the address of a method is returned and not a full methodpointer }
+    po_addressonly,       { flag that only the address of a method is returned and not a full methodpointer }
+    po_public             { procedure is exported }
   );
   tprocoptions=set of tprocoption;
 
@@ -351,7 +352,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.55  2003-05-15 21:10:32  peter
+  Revision 1.56  2003-05-22 21:31:35  peter
+    * defer codegeneration for nested procedures
+
+  Revision 1.55  2003/05/15 21:10:32  peter
     * remove po_containsself
 
   Revision 1.54  2003/05/09 17:47:03  peter