Просмотр исходного кода

* aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be
cleaned up properly
* gen_main_procsym changed to create_main_proc and release_main_proc
to also generate a tprocinfo structure
* fixed unit implicit initfinal

peter 22 лет назад
Родитель
Сommit
60978ba89c
61 измененных файлов с 1497 добавлено и 988 удалено
  1. 50 84
      compiler/cgbase.pas
  2. 53 44
      compiler/cgobj.pas
  3. 41 3
      compiler/fmodule.pas
  4. 11 2
      compiler/fppu.pas
  5. 11 2
      compiler/globals.pas
  6. 11 2
      compiler/globtype.pas
  7. 13 4
      compiler/htypechk.pas
  8. 11 2
      compiler/i386/cpupi.pas
  9. 13 4
      compiler/i386/csopt386.pas
  10. 29 20
      compiler/i386/daopt386.pas
  11. 12 3
      compiler/i386/n386set.pas
  12. 16 7
      compiler/i386/popt386.pas
  13. 11 2
      compiler/i386/ra386int.pas
  14. 34 25
      compiler/i386/radirect.pas
  15. 11 2
      compiler/import.pas
  16. 12 3
      compiler/m68k/cgcpu.pas
  17. 12 10
      compiler/nadd.pas
  18. 14 5
      compiler/nbas.pas
  19. 45 42
      compiler/ncal.pas
  20. 19 5
      compiler/ncgbas.pas
  21. 55 47
      compiler/ncgcal.pas
  22. 13 4
      compiler/ncgflw.pas
  23. 11 2
      compiler/ncginl.pas
  24. 16 7
      compiler/ncgld.pas
  25. 17 8
      compiler/ncgmem.pas
  26. 187 177
      compiler/ncgutil.pas
  27. 12 3
      compiler/ncnv.pas
  28. 22 12
      compiler/nflw.pas
  29. 17 4
      compiler/ninl.pas
  30. 13 6
      compiler/nld.pas
  31. 13 4
      compiler/nmem.pas
  32. 12 3
      compiler/nopt.pas
  33. 12 3
      compiler/nset.pas
  34. 11 2
      compiler/paramgr.pas
  35. 16 19
      compiler/parser.pas
  36. 18 9
      compiler/pass_2.pas
  37. 11 2
      compiler/pdecl.pas
  38. 18 9
      compiler/pdecobj.pas
  39. 15 14
      compiler/pdecsub.pas
  40. 30 20
      compiler/pexpr.pas
  41. 57 47
      compiler/pmodules.pas
  42. 34 25
      compiler/powerpc/cgcpu.pas
  43. 23 14
      compiler/powerpc/cpupi.pas
  44. 20 11
      compiler/powerpc/nppccal.pas
  45. 27 18
      compiler/powerpc/radirect.pas
  46. 37 28
      compiler/pstatmnt.pas
  47. 107 104
      compiler/psub.pas
  48. 11 2
      compiler/ptype.pas
  49. 44 35
      compiler/rautils.pas
  50. 30 18
      compiler/regvars.pas
  51. 12 3
      compiler/sparc/cgcpu.pas
  52. 13 4
      compiler/sparc/cpupi.pas
  53. 12 3
      compiler/sparc/ncpucall.pas
  54. 36 27
      compiler/sparc/radirect.pas
  55. 11 2
      compiler/symbase.pas
  56. 11 2
      compiler/symconst.pas
  57. 11 2
      compiler/symdef.pas
  58. 12 3
      compiler/symsym.pas
  59. 15 6
      compiler/symtable.pas
  60. 14 5
      compiler/tgobj.pas
  61. 12 3
      compiler/x86/cgx86.pas

+ 50 - 84
compiler/cgbase.pas

@@ -40,24 +40,22 @@ unit cgbase;
       ;
 
 
-
-    const
-       {# bitmask indicating if the procedure uses asm }
-       pi_uses_asm  = $1;
-       {# bitmask indicating if the procedure is exported by an unit }
-       pi_is_global = $2;
-       {# bitmask indicating if the procedure does a call }
-       pi_do_call   = $4;
-       {# bitmask indicating if the procedure is an operator   }
-       pi_operator  = $8;
-       {# bitmask indicating if the procedure is an external C function }
-       pi_c_import  = $10;
-       {# bitmask indicating if the procedure has a try statement = no register optimization }
-       pi_uses_exceptions = $20;
-       {# bitmask indicating if the procedure is declared as @var(assembler), don't optimize}
-       pi_is_assembler = $40;
-       {# bitmask indicating if the procedure contains data which needs to be finalized }
-       pi_needs_implicit_finally = $80;
+    type
+      tprocinfoflag=(
+        {# procedure uses asm }
+        pi_uses_asm,
+        {# procedure is exported by an unit }
+        pi_is_global,
+        {# procedure does a call }
+        pi_do_call,
+        {# procedure has a try statement = no register optimization }
+        pi_uses_exceptions,
+        {# procedure is declared as @var(assembler), don't optimize}
+        pi_is_assembler,
+        {# procedure contains data which needs to be finalized }
+        pi_needs_implicit_finally
+      );
+      tprocinfoflags=set of tprocinfoflag;
 
     type
        {# This object gives information on the current routine being
@@ -87,20 +85,11 @@ unit cgbase;
           {# some collected informations about the procedure
              see pi_xxxx constants above
           }
-          flags : longint;
+          flags : tprocinfoflags;
 
           {# register used as frame pointer }
           framepointer : tregister;
 
-          {# true, if the procedure is exported by a unit }
-          globalsymbol : boolean;
-
-          {# true, if the procedure should be exported (only OS/2) }
-          exported : boolean;
-
-          {# true, if we can not use fast exit code }
-          no_fast_exit : boolean;
-
           {# Holds the environment reference for default exceptions
 
              The exception reference is created when ansistrings
@@ -149,7 +138,7 @@ unit cgbase;
           aktexitcode: taasmoutput;
           aktlocaldata : taasmoutput;
 
-          constructor create;virtual;
+          constructor create(aparent:tprocinfo);virtual;
           destructor destroy;override;
 
           procedure allocate_interrupt_stackframe;virtual;
@@ -185,10 +174,9 @@ unit cgbase;
        tcprocinfo = class of tprocinfo;
 
     var
-       {# information about the current sub routine being parsed (@var(pprocinfo))}
-       procinfo : tprocinfo;
-
        cprocinfo : tcprocinfo;
+       {# information about the current sub routine being parsed (@var(pprocinfo))}
+       current_procinfo : tprocinfo;
 
        { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : tasmlabel;
@@ -212,9 +200,6 @@ unit cgbase;
        { save the size of pushed parameter, needed for aligning }
        pushedparasize : longint;
 
-       { procinfo instance which is used in procedures created automatically by the compiler }
-       voidprocpi : tprocinfo;
-
     { message calls with codegenerror support }
     procedure cgmessage(t : longint);
     procedure cgmessage1(t : longint;const s : string);
@@ -253,16 +238,9 @@ implementation
         tgobj,rgobj,
         defutil,
         fmodule
-{$ifdef fixLeaksOnError}
-        ,comphook
-{$endif fixLeaksOnError}
         ,symbase,paramgr
         ;
 
-{$ifdef fixLeaksOnError}
-     var procinfoStack: TStack;
-         hcodegen_old_do_stop: tstopprocedure;
-{$endif fixLeaksOnError}
 
 {*****************************************************************************
             override the message calls to set codegenerror
@@ -370,9 +348,9 @@ implementation
                                  TProcInfo
 ****************************************************************************}
 
-    constructor tprocinfo.create;
+    constructor tprocinfo.create(aparent:tprocinfo);
       begin
-        parent:=nil;
+        parent:=aparent;
         procdef:=nil;
         framepointer_offset:=0;
         selfpointer_offset:=0;
@@ -380,12 +358,9 @@ implementation
         inheritedflag_offset:=0;
         return_offset:=0;
         firsttemp_offset:=0;
-        flags:=0;
-        framepointer.enum:=R_NO;
-        framepointer.number:=NR_NO;
-        globalsymbol:=false;
-        exported:=false;
-        no_fast_exit:=false;
+        flags:=[];
+        framepointer.enum:=R_INTREGISTER;
+        framepointer.number:=NR_FRAME_POINTER_REG;
 
         aktentrycode:=Taasmoutput.Create;
         aktexitcode:=Taasmoutput.Create;
@@ -415,9 +390,9 @@ implementation
       begin
          { temporary space is set, while the BEGIN of the procedure }
          if (symtablestack.symtabletype=localsymtable) then
-           procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
+           current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
          else
-           procinfo.firsttemp_offset := 0;
+           current_procinfo.firsttemp_offset := 0;
          { space for the return value }
          { !!!!!   this means that we can not set the return value
          in a subfunction !!!!! }
@@ -443,14 +418,17 @@ implementation
            end;
          if assigned(procdef._class) then
            begin
-              { self pointer offset, must be done after parsing the parameters }
-              { self isn't pushed in nested procedure of methods }
-              if not(po_containsself in procdef.procoptions) and
-                 (procdef.parast.symtablelevel=normal_function_level) then
+              if (po_containsself in procdef.procoptions) then
                begin
-                 selfpointer_offset:=procdef.parast.address_fixup;
-                 inc(procdef.parast.address_fixup,POINTER_SIZE);
-               end;
+                 inc(current_procinfo.selfpointer_offset,tvarsym(procdef.selfpara.parasym).address);
+               end
+              else
+               { self isn't pushed in nested procedure of methods }
+               if (procdef.parast.symtablelevel=normal_function_level) then
+                begin
+                  selfpointer_offset:=procdef.parast.address_fixup;
+                  inc(procdef.parast.address_fixup,POINTER_SIZE);
+                end;
 
               { Special parameters for de-/constructors }
               case procdef.proctypeoption of
@@ -485,10 +463,10 @@ implementation
          { Retrieve function result offset }
          if assigned(procdef.funcretsym) then
            begin
-             procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
+             current_procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
                                      tvarsym(procdef.funcretsym).owner.address_fixup;
              if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
-              procinfo.return_offset:=tg.direction*procinfo.return_offset;
+              current_procinfo.return_offset:=tg.direction*current_procinfo.return_offset;
            end;
       end;
 
@@ -649,32 +627,20 @@ implementation
         commutativeop := list[op];
       end;
 
-{$ifdef fixLeaksOnError}
-procedure hcodegen_do_stop;
-var p: pprocinfo;
-begin
-  p := pprocinfo(procinfoStack.pop);
-  while p <> nil Do
-    begin
-      if p<>voidprocpi then
-        p.free;
-      p := pprocinfo(procinfoStack.pop);
-    end;
-  procinfoStack.done;
-  do_stop := hcodegen_old_do_stop;
-  do_stop{$ifdef FPCPROCVAR}(){$endif};
-end;
-
-begin
-  hcodegen_old_do_stop := do_stop;
-  do_stop := {$ifdef FPCPROCVAR}@{$endif}hcodegen_do_stop;
-  procinfoStack.init;
-{$endif fixLeaksOnError}
 end.
 {
   $Log$
-  Revision 1.44  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.45  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.44  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 53 - 44
compiler/cgobj.pas

@@ -1573,14 +1573,14 @@ unit cgobj;
          p  : tprocinfo;
          self_reg : tregister;
       begin
-         if not assigned(procinfo.procdef._class) then
+         if not assigned(current_procdef._class) then
            internalerror(200303211);
          self_reg:=rg.getaddressregister(list);
-         if procinfo.procdef.parast.symtablelevel>normal_function_level then
+         if current_procdef.parast.symtablelevel>normal_function_level then
            begin
-             reference_reset_base(hp,procinfo.framepointer,procinfo.framepointer_offset);
+             reference_reset_base(hp,current_procinfo.framepointer,current_procinfo.framepointer_offset);
              a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-             p:=procinfo.parent;
+             p:=current_procinfo.parent;
              while (p.procdef.parast.symtablelevel>normal_function_level) do
               begin
                 reference_reset_base(hp,self_reg,p.framepointer_offset);
@@ -1592,7 +1592,7 @@ unit cgobj;
            end
          else
            begin
-             reference_reset_base(hp,procinfo.framepointer,procinfo.selfpointer_offset);
+             reference_reset_base(hp,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
              a_load_ref_reg(list,OS_ADDR,hp,self_reg);
            end;
         g_load_self:=self_reg;
@@ -1644,44 +1644,44 @@ unit cgobj;
        href : treference;
        acc : Tregister;
      begin
-        if procinfo.vmtpointer_offset=0 then
+        if current_procinfo.vmtpointer_offset=0 then
          internalerror(200303251);
-        if procinfo.selfpointer_offset=0 then
+        if current_procinfo.selfpointer_offset=0 then
          internalerror(200303252);
         acc.enum:=R_INTREGISTER;
         acc.number:=NR_ACCUMULATOR;
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
           begin
             if (cs_implicit_exceptions in aktmoduleswitches) then
-              procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
+              include(current_procinfo.flags,pi_needs_implicit_finally);
             { parameter 2 : vmt pointer, 0 when called by inherited }
-            reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_NEW_CLASS');
             { save the self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_load_reg_ref(list,OS_ADDR,acc,href);
             { fail? }
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
           end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
           begin
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt,
               this is required to allow setting the vmt to -1 to indicate
               that memory was allocated }
-            reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
             a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_CONSTRUCTOR');
             { save the self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_load_reg_ref(list,OS_ADDR,acc,href);
             { fail? }
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
@@ -1697,48 +1697,48 @@ unit cgobj;
         href : treference;
         reg  : tregister;
      begin
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
          begin
-           if procinfo.selfpointer_offset=0 then
+           if current_procinfo.selfpointer_offset=0 then
             internalerror(200303253);
            { parameter 2 : flag }
-           if procinfo.inheritedflag_offset=0 then
+           if current_procinfo.inheritedflag_offset=0 then
             internalerror(200303251);
-           reference_reset_base(href, procinfo.framepointer,procinfo.inheritedflag_offset);
+           reference_reset_base(href, current_procinfo.framepointer,current_procinfo.inheritedflag_offset);
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
            { parameter 1 : self }
-           if procinfo.selfpointer_offset=0 then
+           if current_procinfo.selfpointer_offset=0 then
             internalerror(200303252);
-           reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+           reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
          begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303254);
-            if procinfo.vmtpointer_offset=0 then
+            if current_procinfo.vmtpointer_offset=0 then
              internalerror(200303255);
             { must the object be finalized ? }
-            if procinfo.procdef._class.needs_inittable then
+            if current_procdef._class.needs_inittable then
              begin
                objectlibrary.getlabel(nofinal);
-               reference_reset_base(href,procinfo.framepointer,target_info.first_parm_offset);
+               reference_reset_base(href,current_procinfo.framepointer,target_info.first_parm_offset);
                a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
                reg:=g_load_self(list);
                reference_reset_base(href,reg,0);
-               g_finalize(list,procinfo.procdef._class,href,false);
+               g_finalize(list,current_procdef._class,href,false);
                reference_release(list,href);
                a_label(list,nofinal);
              end;
             { actually call destructor }
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt }
-            reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
             a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
             { parameter 1 : address of self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_DESTRUCTOR');
          end
@@ -1751,37 +1751,37 @@ unit cgobj;
       var
         href : treference;
      begin
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
           begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303256);
             { parameter 2 : flag, 0 -> inherited call (=no dispose) }
             a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
             { parameter 1 : self }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DISPOSE_CLASS');
           end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
           begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303257);
-            if procinfo.vmtpointer_offset=0 then
+            if current_procinfo.vmtpointer_offset=0 then
              internalerror(200303258);
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, current_procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt, will be reset to 0 when freed }
-            reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
             a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
-            reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+            reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
             a_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_FAIL');
           end
         else
           internalerror(200006163);
         { set self to nil }
-        reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+        reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
         a_load_const_ref(list,OS_ADDR,0,href);
       end;
 
@@ -1853,8 +1853,17 @@ finalization
 end.
 {
   $Log$
-  Revision 1.91  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.92  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.91  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 41 - 3
compiler/fmodule.pas

@@ -96,6 +96,7 @@ interface
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : tsymtable;{ pointer to the local symtable of this unit }
         scanner       : pointer;  { scanner object used }
+        procinfo      : pointer;  { current procedure being compiled }
         loaded_from   : tmodule;
         uses_imports  : boolean;  { Set if the module imports from DLL's.}
         imports       : tlinkedlist;
@@ -169,7 +170,8 @@ uses
   dos,
 {$endif}
   verbose,systems,
-  scanner;
+  scanner,
+  cgbase;
 
 
 {*****************************************************************************
@@ -391,10 +393,11 @@ uses
 
 
     destructor tmodule.Destroy;
-{$ifdef MEMDEBUG}
       var
+{$ifdef MEMDEBUG}
         d : tmemdebug;
 {$endif}
+        hpi : tprocinfo;
       begin
         if assigned(map) then
          dispose(map);
@@ -412,6 +415,18 @@ uses
              current_scanner:=nil;
             tscannerfile(scanner).free;
          end;
+        if assigned(procinfo) then
+          begin
+            if current_procinfo=tprocinfo(procinfo) then
+             current_procinfo:=nil;
+            { release procinfo tree }
+            while assigned(procinfo) do
+             begin
+               hpi:=tprocinfo(procinfo).parent;
+               tprocinfo(procinfo).free;
+               procinfo:=hpi;
+             end;
+          end;
         used_units.free;
         dependent_units.free;
         resourcefiles.Free;
@@ -459,6 +474,8 @@ uses
 
 
     procedure tmodule.reset;
+      var
+        hpi : tprocinfo;
       begin
         if assigned(scanner) then
           begin
@@ -469,6 +486,18 @@ uses
             tscannerfile(scanner).free;
             scanner:=nil;
           end;
+        if assigned(procinfo) then
+          begin
+            if current_procinfo=tprocinfo(procinfo) then
+             current_procinfo:=nil;
+            { release procinfo tree }
+            while assigned(procinfo) do
+             begin
+               hpi:=tprocinfo(procinfo).parent;
+               tprocinfo(procinfo).free;
+               procinfo:=hpi;
+             end;
+          end;
         if assigned(globalsymtable) then
           begin
             globalsymtable.free;
@@ -610,7 +639,16 @@ uses
 end.
 {
   $Log$
-  Revision 1.32  2002-12-29 14:57:50  peter
+  Revision 1.33  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.32  2002/12/29 14:57:50  peter
     * unit loading changed to first register units and load them
       afterwards. This is needed to support uses xxx in yyy correctly
     * unit dependency check fixed

+ 11 - 2
compiler/fppu.pas

@@ -1342,8 +1342,17 @@ uses
 end.
 {
   $Log$
-  Revision 1.32  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.33  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.32  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/globals.pas

@@ -1528,8 +1528,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.87  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.88  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.87  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/globtype.pas

@@ -208,8 +208,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.38  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.37  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 13 - 4
compiler/htypechk.pas

@@ -631,8 +631,8 @@ implementation
                           (hsym.varstate=vs_set_but_first_not_passed) then
                         begin
                           if (assigned(hsym.owner) and
-                              assigned(aktprocdef) and
-                              (hsym.owner=aktprocdef.localst)) then
+                              assigned(current_procdef) and
+                              (hsym.owner=current_procdef.localst)) then
                            begin
                              if (vo_is_funcret in hsym.varoptions) then
                                CGMessage(sym_w_function_result_not_set)
@@ -998,8 +998,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.62  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.61  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/i386/cpupi.pas

@@ -39,8 +39,8 @@ unit cpupi;
 
   implementation
 
-    procedure ti386procinfo.allocate_interrupt_stackframe;
 
+    procedure ti386procinfo.allocate_interrupt_stackframe;
       begin
          { we push Flags and CS as long
            to cope with the IRETD
@@ -53,7 +53,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2003-04-27 07:48:05  peter
+  Revision 1.3  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.2  2003/04/27 07:48:05  peter
     * updated for removed lexlevel
 
   Revision 1.1  2002/08/17 09:23:44  florian

+ 13 - 4
compiler/i386/csopt386.pas

@@ -411,7 +411,7 @@ Begin {CheckSequence}
                     if (found <> 0) and
                        ((base.enum = R_NO) or
                         regModified[base.enum] or
-                        (base.enum = procinfo.framepointer.enum)) and
+                        (base.enum = current_procinfo.framepointer.enum)) and
                        ((index.enum = R_NO) or
                         regModified[index.enum]) and
                         not(regInRef(tmpReg,Taicpu(hp3).oper[0].ref^)) then
@@ -1418,7 +1418,7 @@ begin
   for regcount := LoGPReg to HiGPReg do
     if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and
        (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1].ref^.base
-         = procinfo.framepointer) then
+         = current_procinfo.framepointer) then
       begin
         pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true;
         clearmemwrites(pTaiProp(t1.optinfo)^.regs[regcount].memwrite,regcount);
@@ -1564,7 +1564,7 @@ Begin
  { If some registers were different in the old and the new sequence, move }
  { the contents of those old registers to the new ones                    }
                                    For RegCounter.enum := R_EAX To R_EDI Do
-                                     If Not(RegCounter.enum in [R_ESP,procinfo.framepointer.enum]) And
+                                     If Not(RegCounter.enum in [R_ESP,current_procinfo.framepointer.enum]) And
                                         (RegInfo.New2OldReg[RegCounter.enum].enum <> R_NO) Then
                                        Begin
                                          AllocRegBetween(AsmL,RegInfo.New2OldReg[RegCounter.enum],
@@ -1997,7 +1997,16 @@ End.
 
 {
   $Log$
-  Revision 1.43  2003-03-28 19:16:57  peter
+  Revision 1.44  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.43  2003/03/28 19:16:57  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

+ 29 - 20
compiler/i386/daopt386.pas

@@ -397,18 +397,18 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
   end;
 
 begin
-    case aktprocdef.rettype.def.deftype of
+    case current_procdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
       orddef:
-        if aktprocdef.rettype.def.size <> 0 then
+        if current_procdef.rettype.def.size <> 0 then
           begin
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             { for int64/qword }
-            if aktprocdef.rettype.def.size = 8 then
+            if current_procdef.rettype.def.size = 8 then
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
           end;
     end;
@@ -418,18 +418,18 @@ procedure getNoDeallocRegs(var regs: TRegSet);
 var regCounter: ToldRegister;
 begin
   regs := [];
-    case aktprocdef.rettype.def.deftype of
+    case current_procdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
        regs := [R_EAX];
       orddef:
-        if aktprocdef.rettype.def.size <> 0 then
+        if current_procdef.rettype.def.size <> 0 then
           begin
             regs := [R_EAX];
             { for int64/qword }
-            if aktprocdef.rettype.def.size = 8 then
+            if current_procdef.rettype.def.size = 8 then
               regs := regs + [R_EDX];
           end;
     end;
@@ -1341,7 +1341,7 @@ Begin
           (Taicpu(p).opcode = A_LEA)) and
          (Taicpu(p).oper[0].typ = top_ref) Then
         With Taicpu(p).oper[0].ref^ Do
-          If ((Base.enum = procinfo.FramePointer.enum) or
+          If ((Base.enum = current_procinfo.FramePointer.enum) or
               (assigned(symbol) and (base.enum = R_NO))) And
              (Index.enum = R_NO) Then
             Begin
@@ -1425,27 +1425,27 @@ Begin
     Begin
       Case Taicpu(p).oper[0].typ Of
         top_reg:
-          If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,procinfo.FramePointer]) Then
+          If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,current_procinfo.FramePointer]) Then
             RegSet := RegSet + [Taicpu(p).oper[0].reg];
         top_ref:
           With TReference(Taicpu(p).oper[0]^) Do
             Begin
-              If Not(Base in [procinfo.FramePointer,R_NO,R_ESP])
+              If Not(Base in [current_procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Base];
-              If Not(Index in [procinfo.FramePointer,R_NO,R_ESP])
+              If Not(Index in [current_procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Index];
             End;
       End;
       Case Taicpu(p).oper[1].typ Of
         top_reg:
-          If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,procinfo.FramePointer]) Then
+          If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,current_procinfo.FramePointer]) Then
             If RegSet := RegSet + [TRegister(TwoWords(Taicpu(p).oper[1]).Word1];
         top_ref:
           With TReference(Taicpu(p).oper[1]^) Do
             Begin
-              If Not(Base in [procinfo.FramePointer,R_NO,R_ESP])
+              If Not(Base in [current_procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Base];
-              If Not(Index in [procinfo.FramePointer,R_NO,R_ESP])
+              If Not(Index in [current_procinfo.FramePointer,R_NO,R_ESP])
                 Then RegSet := RegSet + [Index];
             End;
       End;
@@ -1547,9 +1547,9 @@ Begin {checks whether two Taicpu instructions are equal}
               Begin
                 With Taicpu(p2).oper[0].ref^ Do
                   Begin
-                    If Not(Base.enum in [procinfo.FramePointer.enum, R_NO, R_ESP]) Then
+                    If Not(Base.enum in [current_procinfo.FramePointer.enum, R_NO, R_ESP]) Then
                       RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base.enum];
-                    If Not(Index.enum in [procinfo.FramePointer.enum, R_NO, R_ESP]) Then
+                    If Not(Index.enum in [current_procinfo.FramePointer.enum, R_NO, R_ESP]) Then
                       RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index.enum];
                   End;
  {add the registers from the reference (.oper[0]) to the RegInfo, all registers
@@ -1570,7 +1570,7 @@ Begin {checks whether two Taicpu instructions are equal}
           Begin
             With Taicpu(p2).oper[0].ref^ Do
               Begin
-                If Not(Base.enum in [procinfo.FramePointer.enum,
+                If Not(Base.enum in [current_procinfo.FramePointer.enum,
                      Reg32(Taicpu(p2).oper[1].reg).enum,R_NO,R_ESP]) Then
  {it won't do any harm if the register is already in RegsLoadedForRef}
                   Begin
@@ -1579,7 +1579,7 @@ Begin {checks whether two Taicpu instructions are equal}
                     Writeln(std_reg2str[base], ' added');
 {$endif csdebug}
                   end;
-                If Not(Index.enum in [procinfo.FramePointer.enum,
+                If Not(Index.enum in [current_procinfo.FramePointer.enum,
                      Reg32(Taicpu(p2).oper[1].reg).enum,R_NO,R_ESP]) Then
                   Begin
                     RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index.enum];
@@ -1589,7 +1589,7 @@ Begin {checks whether two Taicpu instructions are equal}
                   end;
 
               End;
-            If Not(Reg32(Taicpu(p2).oper[1].reg).enum In [procinfo.FramePointer.enum,R_NO,R_ESP])
+            If Not(Reg32(Taicpu(p2).oper[1].reg).enum In [current_procinfo.FramePointer.enum,R_NO,R_ESP])
               Then
                 Begin
                   RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
@@ -1738,7 +1738,7 @@ function isSimpleRef(const ref: treference): boolean;
 begin
   isSimpleRef :=
     assigned(ref.symbol) or
-    (ref.base.enum = procinfo.framepointer.enum);
+    (ref.base.enum = current_procinfo.framepointer.enum);
 end;
 
 function containsPointerRef(p: Tai): boolean;
@@ -2669,7 +2669,16 @@ End.
 
 {
   $Log$
-  Revision 1.48  2003-03-28 19:16:57  peter
+  Revision 1.49  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.48  2003/03/28 19:16:57  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

+ 12 - 3
compiler/i386/n386set.pas

@@ -76,7 +76,7 @@ implementation
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo.flags:=procinfo.flags or pi_do_call
+           include(current_procinfo.flags,pi_do_call)
          else
            begin
               { a smallset needs maybe an misc. register }
@@ -612,7 +612,7 @@ implementation
 
       begin
         if (cs_create_smart in aktmoduleswitches) then
-          jumpsegment:=procinfo.aktlocaldata
+          jumpsegment:=current_procinfo.aktlocaldata
         else
           jumpsegment:=datasegment;
         if not(jumptable_no_range) then
@@ -738,7 +738,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.56  2003-04-25 08:25:26  daniel
+  Revision 1.57  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.56  2003/04/25 08:25:26  daniel
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills

+ 16 - 7
compiler/i386/popt386.pas

@@ -75,8 +75,8 @@ begin
          (hp2.typ = ait_instruction) and
          ((Taicpu(hp2).opcode = A_LEAVE) or
           (Taicpu(hp2).opcode = A_RET)) and
-         (Taicpu(p).oper[0].ref^.Base.enum = procinfo.FramePointer.enum) and
-         (Taicpu(p).oper[0].ref^.Offset >= procinfo.Return_Offset) and
+         (Taicpu(p).oper[0].ref^.Base.enum = current_procinfo.FramePointer.enum) and
+         (Taicpu(p).oper[0].ref^.Offset >= current_procinfo.Return_Offset) and
          (Taicpu(p).oper[0].ref^.Index.enum = R_NO) then
         begin
           asml.remove(p);
@@ -994,8 +994,8 @@ Begin
                               If ((Taicpu(hp1).opcode = A_LEAVE) Or
                                   (Taicpu(hp1).opcode = A_RET)) And
                                  (Taicpu(p).oper[1].typ = top_ref) And
-                                 (Taicpu(p).oper[1].ref^.base.enum = procinfo.FramePointer.enum) And
-                                 (Taicpu(p).oper[1].ref^.offset >= procinfo.Return_Offset) And
+                                 (Taicpu(p).oper[1].ref^.base.enum = current_procinfo.FramePointer.enum) And
+                                 (Taicpu(p).oper[1].ref^.offset >= current_procinfo.Return_Offset) And
                                  (Taicpu(p).oper[1].ref^.index.enum = R_NO) And
                                  (Taicpu(p).oper[0].typ = top_reg)
                                 Then
@@ -1561,9 +1561,9 @@ Begin
                      (hp2.typ = ait_instruction) And
                      ((Taicpu(hp2).opcode = A_LEAVE) or
                       (Taicpu(hp2).opcode = A_RET)) And
-                     (Taicpu(p).oper[0].ref^.Base.enum = procinfo.FramePointer.enum) And
+                     (Taicpu(p).oper[0].ref^.Base.enum = current_procinfo.FramePointer.enum) And
                      (Taicpu(p).oper[0].ref^.Index.enum = R_NO) And
-                     (Taicpu(p).oper[0].ref^.Offset >= procinfo.Return_Offset) And
+                     (Taicpu(p).oper[0].ref^.Offset >= current_procinfo.Return_Offset) And
                      (hp1.typ = ait_instruction) And
                      (Taicpu(hp1).opcode = A_MOV) And
                      (Taicpu(hp1).opsize = S_B) And
@@ -2058,7 +2058,16 @@ End.
 
 {
   $Log$
-  Revision 1.42  2003-03-28 19:16:57  peter
+  Revision 1.43  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.42  2003/03/28 19:16:57  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

+ 11 - 2
compiler/i386/ra386int.pas

@@ -1109,7 +1109,7 @@ Begin
               end;
              if GotOffset then
               begin
-                if hasvar and (opr.ref.base.number=procinfo.framepointer.number) then
+                if hasvar and (opr.ref.base.number=current_procinfo.framepointer.number) then
                  begin
                    opr.ref.base.enum:=R_INTREGISTER;
                    opr.ref.base.number:=NR_NO;
@@ -1961,7 +1961,16 @@ finalization
 end.
 {
   $Log$
-  Revision 1.45  2003-04-21 20:05:10  peter
+  Revision 1.46  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.45  2003/04/21 20:05:10  peter
     * removed some ie checks
 
   Revision 1.44  2003/03/28 19:16:57  peter

+ 34 - 25
compiler/i386/radirect.pas

@@ -78,22 +78,22 @@ interface
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
+           if assigned(current_procdef.funcretsym) and
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
          end;
 
      begin
        ende:=false;
        s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
-       framereg:=procinfo.framepointer;
+       if assigned(current_procdef.funcretsym) and
+          is_fpu(current_procdef.rettype.def) then
+         tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
+       framereg:=current_procinfo.framepointer;
        convert_register_to_enum(framereg);
-       if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo.return_offset)+'('+gas_reg2str[framereg.enum]+')')
+       if (not is_void(current_procdef.rettype.def)) then
+         retstr:=upper(tostr(current_procinfo.return_offset)+'('+gas_reg2str[framereg.enum]+')')
        else
          retstr:='';
          c:=current_scanner.asmgetchar;
@@ -137,22 +137,22 @@ interface
                              FwaitWarning
                             else
                             { access to local variables }
-                            if assigned(aktprocdef) then
+                            if assigned(current_procdef) then
                               begin
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) and
+                                    paramanager.ret_in_acc(current_procdef.rettype.def,current_procdef.proccalloption) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
-                                   tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                                   tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
-                                      if assigned(aktprocdef.localst) and
-                                         (aktprocdef.localst.symtablelevel>=normal_function_level) then
-                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                      if assigned(current_procdef.localst) and
+                                         (current_procdef.localst.symtablelevel>=normal_function_level) then
+                                        sym:=tsym(current_procdef.localst.search(upper(hs)))
                                       else
                                         sym:=nil;
                                       if assigned(sym) then
@@ -186,8 +186,8 @@ interface
                                         end
                                       else
                                         begin
-                                           if assigned(aktprocdef.parast) then
-                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                           if assigned(current_procdef.parast) then
+                                             sym:=tsym(current_procdef.parast.search(upper(hs)))
                                            else
                                              sym:=nil;
                                            if assigned(sym) then
@@ -196,7 +196,7 @@ interface
                                                   begin
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
-                                                     inc(l,aktprocdef.parast.address_fixup);
+                                                     inc(l,current_procdef.parast.address_fixup);
                                                      hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
@@ -241,15 +241,15 @@ interface
                                              end
                                            else if upper(hs)='__SELF' then
                                              begin
-                                                if assigned(aktprocdef._class) then
-                                                  hs:=tostr(procinfo.selfpointer_offset)+
+                                                if assigned(current_procdef._class) then
+                                                  hs:=tostr(current_procinfo.selfpointer_offset)+
                                                       '('+gas_reg2str[framereg.enum]+')'
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
                                            else if upper(hs)='__RESULT' then
                                              begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                if (not is_void(current_procdef.rettype.def)) then
                                                   hs:=retstr
                                                 else
                                                   Message(asmr_e_void_function);
@@ -258,8 +258,8 @@ interface
                                              begin
                                                 { complicate to check there }
                                                 { we do it: }
-                                                if aktprocdef.parast.symtablelevel>normal_function_level then
-                                                  hs:=tostr(procinfo.framepointer_offset)+
+                                                if current_procdef.parast.symtablelevel>normal_function_level then
+                                                  hs:=tostr(current_procinfo.framepointer_offset)+
                                                     '('+gas_reg2str[framereg.enum]+')'
                                                 else
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
@@ -273,7 +273,7 @@ interface
                    end;
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
-                        tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                        tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                    end;
@@ -308,8 +308,17 @@ initialization
 end.
 {
   $Log$
-  Revision 1.10  2003-04-27 07:29:52  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.11  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.10  2003/04/27 07:29:52  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/import.pas

@@ -238,8 +238,17 @@ end;
 end.
 {
   $Log$
-  Revision 1.22  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.23  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.22  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/m68k/cgcpu.pas

@@ -1079,10 +1079,10 @@ Implementation
       begin
        {Routines with the poclearstack flag set use only a ret.}
        { also routines with parasize=0     }
-         if (po_clearstack in aktprocdef.procoptions) then
+         if (po_clearstack in current_procdef.procoptions) then
            begin
              { complex return values are removed from stack in C code PM }
-             if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+             if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
                list.concat(taicpu.op_const(A_RTD,S_NO,4))
              else
                list.concat(taicpu.op_none(A_RTS,S_NO));
@@ -1337,7 +1337,16 @@ end.
 
 {
   $Log$
-  Revision 1.19  2003-04-23 13:40:33  peter
+  Revision 1.20  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.19  2003/04/23 13:40:33  peter
     * fix m68k compile
 
   Revision 1.18  2003/02/19 22:00:16  daniel

+ 12 - 10
compiler/nadd.pas

@@ -1745,8 +1745,7 @@ implementation
                  expectloc:=LOC_CREFERENCE;
                  calcregisters(self,0,0,0);
                  { here we call SET... }
-                 if assigned(procinfo) then
-                    procinfo.flags:=procinfo.flags or pi_do_call;
+                 include(current_procinfo.flags,pi_do_call);
               end;
            end
 
@@ -1765,17 +1764,11 @@ implementation
             begin
               if is_widestring(ld) then
                 begin
-                   { we use reference counted widestrings so no fast exit here }
-                   if assigned(procinfo) then
-                     procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
                    expectloc:=LOC_REGISTER;
                 end
               else if is_ansistring(ld) then
                 begin
-                   { we use ansistrings so no fast exit here }
-                   if assigned(procinfo) then
-                     procinfo.no_fast_exit:=true;
                    { this is only for add, the comparisaion is handled later }
                    expectloc:=LOC_REGISTER;
                 end
@@ -1957,7 +1950,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.86  2003-04-26 09:12:55  peter
+  Revision 1.87  2003-04-27 11:21:32  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.86  2003/04/26 09:12:55  peter
     * add string returns in LOC_REFERENCE
 
   Revision 1.85  2003/04/24 22:29:57  florian
@@ -2056,7 +2058,7 @@ end.
       ctypeconvnode.create_explicit() statements
 
   Revision 1.62  2002/08/17 09:23:34  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.61  2002/08/15 15:15:55  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)

+ 14 - 5
compiler/nbas.pas

@@ -383,9 +383,9 @@ implementation
                    { concat function result to exit }
                    { this is wrong for string or other complex
                      result types !!! }
-                   if {ret_in_acc(aktprocdef.rettype.def) and }
-                      (is_ordinal(aktprocdef.rettype.def) or
-                       is_smallset(aktprocdef.rettype.def)) and
+                   if {ret_in_acc(current_procdef.rettype.def) and }
+                      (is_ordinal(current_procdef.rettype.def) or
+                       is_smallset(current_procdef.rettype.def)) and
                       assigned(hp.right) and
                       assigned(tstatementnode(hp.right).left) and
                       (tstatementnode(hp.right).left.nodetype=exitn) and
@@ -559,7 +559,7 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_VOID;
-         procinfo.flags:=procinfo.flags or pi_uses_asm;
+         include(current_procinfo.flags,pi_uses_asm);
       end;
 
 
@@ -803,7 +803,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2003-04-25 20:59:33  peter
+  Revision 1.48  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.47  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

+ 45 - 42
compiler/ncal.pas

@@ -312,7 +312,7 @@ type
             begin
               if (srsym.typ<>procsym) then
                internalerror(200111022);
-              if srsym.is_visible_for_proc(aktprocdef) then
+              if srsym.is_visible_for_proc(current_procdef) then
                begin
                  srsym.add_para_match_to(Aprocsym);
                  { we can stop if the overloads were already added
@@ -1173,7 +1173,7 @@ type
               when the callnode is generated by a property }
             if (nf_isproperty in flags) or
                (pd.owner.symtabletype<>objectsymtable) or
-               pd.is_visible_for_proc(aktprocdef) then
+               pd.is_visible_for_proc(current_procdef) then
              begin
                { only when the # of parameter are supported by the
                  procedure }
@@ -1204,7 +1204,7 @@ type
                   { process only visible procsyms }
                   if assigned(srprocsym) and
                      (srprocsym.typ=procsym) and
-                     srprocsym.is_visible_for_proc(aktprocdef) then
+                     srprocsym.is_visible_for_proc(current_procdef) then
                    begin
                      { if this procedure doesn't have overload we can stop
                        searching }
@@ -1910,13 +1910,8 @@ type
          else
            resulttype:=restype;
 
-
          if resulttype.def.needs_inittable then
-           begin
-             { we use ansistrings so no fast exit here }
-             if assigned(procinfo) then
-              procinfo.no_fast_exit:=true;
-           end;
+           include(current_procinfo.flags,pi_needs_implicit_finally);
 
          if assigned(methodpointer) then
           begin
@@ -1936,7 +1931,7 @@ type
             if (methodpointer.nodetype=typen) and
                (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
                is_object(methodpointer.resulttype.def) and
-               not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) then
+               not(current_procdef.proctypeoption in [potype_constructor,potype_destructor]) then
              CGMessage(cg_w_member_cd_call_from_method);
 
             if not(methodpointer.nodetype in [typen,hnewn]) then
@@ -2085,7 +2080,7 @@ type
 
               { procedure does a call }
               if not (block_type in [bt_const,bt_type]) then
-                procinfo.flags:=procinfo.flags or pi_do_call;
+                include(current_procinfo.flags,pi_do_call);
               rg.incrementintregisterpushed(all_intregisters);
               rg.incrementotherregisterpushed(all_registers);
            end
@@ -2119,7 +2114,7 @@ type
               else
                 begin
                   if not (block_type in [bt_const,bt_type]) then
-                    procinfo.flags:=procinfo.flags or pi_do_call;
+                    include(current_procinfo.flags,pi_do_call);
                 end;
 
              { It doesn't hurt to calculate it already though :) (JM) }
@@ -2441,36 +2436,35 @@ type
         storeparasymtable,
         storelocalsymtable : tsymtabletype;
         oldprocdef : tprocdef;
-        oldprocinfo : tprocinfo;
+        old_current_procinfo : tprocinfo;
         oldinlining_procedure : boolean;
       begin
         result:=nil;
         oldinlining_procedure:=inlining_procedure;
-        oldprocdef:=aktprocdef;
-        oldprocinfo:=procinfo;
+        oldprocdef:=current_procdef;
+        old_current_procinfo:=current_procinfo;
         { we're inlining a procedure }
         inlining_procedure:=true;
-        aktprocdef:=inlineprocdef;
+        current_procdef:=inlineprocdef;
 
-        { clone procinfo, but not the asmlists }
-        procinfo:=tprocinfo(cprocinfo.newinstance);
-        move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
-        procinfo.aktentrycode:=nil;
-        procinfo.aktexitcode:=nil;
-        procinfo.aktproccode:=nil;
-        procinfo.aktlocaldata:=nil;
+        { clone current_procinfo, but not the asmlists }
+        current_procinfo:=tprocinfo(cprocinfo.newinstance);
+        move(pointer(old_current_procinfo)^,pointer(current_procinfo)^,cprocinfo.InstanceSize);
+        current_procinfo.aktentrycode:=nil;
+        current_procinfo.aktexitcode:=nil;
+        current_procinfo.aktproccode:=nil;
+        current_procinfo.aktlocaldata:=nil;
 
-        { set new procinfo }
-        procinfo.return_offset:=retoffset;
-        procinfo.no_fast_exit:=false;
+        { set new current_procinfo }
+        current_procinfo.return_offset:=retoffset;
 
         { set it to the same lexical level }
-        storesymtablelevel:=aktprocdef.localst.symtablelevel;
-        storelocalsymtable:=aktprocdef.localst.symtabletype;
-        storeparasymtable:=aktprocdef.parast.symtabletype;
-        aktprocdef.localst.symtablelevel:=oldprocdef.localst.symtablelevel;
-        aktprocdef.localst.symtabletype:=inlinelocalsymtable;
-        aktprocdef.parast.symtabletype:=inlineparasymtable;
+        storesymtablelevel:=current_procdef.localst.symtablelevel;
+        storelocalsymtable:=current_procdef.localst.symtabletype;
+        storeparasymtable:=current_procdef.parast.symtabletype;
+        current_procdef.localst.symtablelevel:=oldprocdef.localst.symtablelevel;
+        current_procdef.localst.symtabletype:=inlinelocalsymtable;
+        current_procdef.parast.symtabletype:=inlineparasymtable;
 
         { pass inlinetree }
         resulttypepass(inlinetree);
@@ -2483,15 +2477,15 @@ type
         if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
           inc(para_size,POINTER_SIZE);
 
-        { restore procinfo }
-        procinfo.free;
-        procinfo:=oldprocinfo;
+        { restore current_procinfo }
+        current_procinfo.free;
+        current_procinfo:=old_current_procinfo;
         { restore symtable }
-        aktprocdef.localst.symtablelevel:=storesymtablelevel;
-        aktprocdef.localst.symtabletype:=storelocalsymtable;
-        aktprocdef.parast.symtabletype:=storeparasymtable;
+        current_procdef.localst.symtablelevel:=storesymtablelevel;
+        current_procdef.localst.symtabletype:=storelocalsymtable;
+        current_procdef.parast.symtabletype:=storeparasymtable;
         { restore }
-        aktprocdef:=oldprocdef;
+        current_procdef:=oldprocdef;
         inlining_procedure:=oldinlining_procedure;
       end;
 
@@ -2523,12 +2517,21 @@ begin
 end.
 {
   $Log$
-  Revision 1.146  2003-04-27 09:08:44  jonas
+  Revision 1.147  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.146  2003/04/27 09:08:44  jonas
     * do callparatemp stuff only after the parameters have been firstpassed,
       because some nodes are turned into calls during the firstpass
 
   Revision 1.145  2003/04/27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
@@ -2777,7 +2780,7 @@ end.
     * some ppc stuff fixed
 
   Revision 1.85  2002/08/17 09:23:34  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.84  2002/08/16 14:24:57  carl
     * issameref() to test if two references are the same (then emit no opcodes)

+ 19 - 5
compiler/ncgbas.pas

@@ -138,8 +138,8 @@ interface
          if inlining_procedure then
            begin
              objectlibrary.CreateUsedAsmSymbolList;
-             localfixup:=aktprocdef.localst.address_fixup;
-             parafixup:=aktprocdef.parast.address_fixup;
+             localfixup:=current_procdef.localst.address_fixup;
+             parafixup:=current_procdef.parast.address_fixup;
              hp:=tai(p_asm.first);
              while assigned(hp) do
               begin
@@ -212,7 +212,7 @@ interface
            begin
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
-             if (aktprocdef.proccalloption=pocall_inline) then
+             if (current_procdef.proccalloption=pocall_inline) then
                exprasmList.concatlistcopy(p_asm)
              else
                exprasmList.concatlist(p_asm);
@@ -239,7 +239,8 @@ interface
               if assigned(hp.left) then
                begin
                {$ifndef newra}
-                 rg.cleartempgen;
+                 if nf_releasetemps in flags then
+                   rg.cleartempgen;
                {$endif newra}
                  secondpass(hp.left);
                  location_copy(hp.location,hp.left.location);
@@ -315,7 +316,20 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2003-04-22 23:50:22  peter
+  Revision 1.33  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.32  2002/04/25 20:15:39  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.31  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG

+ 55 - 47
compiler/ncgcal.pas

@@ -170,7 +170,7 @@ implementation
                 begin
                   if calloption=pocall_inline then
                     begin
-                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                       reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                        cg.a_load_loc_ref(exprasmlist,left.location,href);
                     end
                   else
@@ -190,7 +190,7 @@ implementation
                        tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                      {$endif newra}
                        cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                       reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                       reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                        cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                      {$ifdef newra}
                        rg.ungetregisterint(exprasmlist,tmpreg);
@@ -228,7 +228,7 @@ implementation
                    tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                 {$endif}
                    cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                   reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                   reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                    cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                 {$ifdef newra}
                    rg.ungetregisterint(exprasmlist,tmpreg);
@@ -281,7 +281,7 @@ implementation
                         tmpreg:=cg.get_scratch_reg_address(exprasmlist);
                      {$endif}
                         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
-                        reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                        reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                         cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
                      {$ifdef newra}
                         rg.ungetregisterint(exprasmlist,tmpreg);
@@ -415,7 +415,7 @@ implementation
                        if not(
                               is_class(methodpointer.resulttype.def) and
                               (procdefinition.proctypeoption=potype_constructor) and
-                              (aktprocdef.proctypeoption<>potype_constructor)
+                              (current_procdef.proctypeoption<>potype_constructor)
                              ) then
                         begin
                           location_reset(selfloc,LOC_REGISTER,OS_ADDR);
@@ -429,8 +429,8 @@ implementation
                        begin
                          { reset self when calling constructor from destructor }
                          if (procdefinition.proctypeoption=potype_constructor) and
-                            assigned(aktprocdef) and
-                            (aktprocdef.proctypeoption=potype_destructor) then
+                            assigned(current_procdef) and
+                            (current_procdef.proctypeoption=potype_destructor) then
                           begin
                             location_release(exprasmlist,selfloc);
                             location_reset(selfloc,LOC_CONSTANT,OS_ADDR);
@@ -576,13 +576,13 @@ implementation
                 { Load VMT from self? }
                 if (
                     (po_classmethod in procdefinition.procoptions) and
-                    not(assigned(aktprocdef) and
-                        (po_classmethod in aktprocdef.procoptions))
+                    not(assigned(current_procdef) and
+                        (po_classmethod in current_procdef.procoptions))
                    ) or
                    (
                     (po_staticmethod in procdefinition.procoptions) and
-                     not(assigned(aktprocdef) and
-                         (po_staticmethod in aktprocdef.procoptions))
+                     not(assigned(current_procdef) and
+                         (po_staticmethod in current_procdef.procoptions))
                    ) then
                   begin
                     if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
@@ -671,26 +671,26 @@ implementation
         i : integer;
       begin
         { this routine is itself not nested }
-        if aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
+        if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
           begin
-            reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
+            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
             cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
           end
         { one nesting level }
-        else if (aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
+        else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
           begin
-            cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paramanager.getintparaloc(1));
+            cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(1));
           end
         { very complex nesting level ... }
-        else if (aktprocdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+        else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
           begin
             hregister:=rg.getaddressregister(exprasmlist);
-            reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
+            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
-            i:=aktprocdef.parast.symtablelevel;
+            i:=current_procdef.parast.symtablelevel;
             while (i>tprocdef(procdefinition).parast.symtablelevel) do
               begin
-                reference_reset_base(href,hregister,procinfo.framepointer_offset);
+                reference_reset_base(href,hregister,current_procinfo.framepointer_offset);
                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                 dec(i);
               end;
@@ -913,7 +913,7 @@ implementation
               right:=nil;
               { set it to the same lexical level as the local symtable, becuase
                 the para's are stored there }
-              tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
+              tprocdef(procdefinition).parast.symtablelevel:=current_procdef.localst.symtablelevel;
               if assigned(left) then
                begin
                  inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment);
@@ -940,7 +940,7 @@ implementation
            begin
               if (cs_check_io in aktlocalswitches) and
                  (po_iocheck in procdefinition.procoptions) and
-                 not(po_iocheck in aktprocdef.procoptions) then
+                 not(po_iocheck in current_procdef.procoptions) then
                 begin
                    objectlibrary.getaddrlabel(iolabel);
                    cg.a_label(exprasmlist,iolabel);
@@ -1040,7 +1040,7 @@ implementation
               { can/will be gottten from the current procedure's symtable }
               { (JM) }
               if not inlined then
-                if (aktprocdef.parast.symtablelevel>=normal_function_level) and
+                if (current_procdef.parast.symtablelevel>=normal_function_level) and
                    assigned(tprocdef(procdefinition).parast) and
                    ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
                   push_framepointer;
@@ -1143,8 +1143,8 @@ implementation
 
 {$ifdef powerpc}
          { this calculation must be done in pass_1 anyway, so don't worry }
-         if tppcprocinfo(procinfo).maxpushedparasize<pushedparasize then
-           tppcprocinfo(procinfo).maxpushedparasize:=pushedparasize;
+         if tppcprocinfo(current_procinfo).maxpushedparasize<pushedparasize then
+           tppcprocinfo(current_procinfo).maxpushedparasize:=pushedparasize;
 {$endif powerpc}
 
          { Restore }
@@ -1160,7 +1160,7 @@ implementation
             (procdefinition.proctypeoption=potype_constructor) and
             assigned(methodpointer) and
             (methodpointer.nodetype=typen) and
-            (aktprocdef.proctypeoption=potype_constructor) then
+            (current_procdef.proctypeoption=potype_constructor) then
           begin
             accreg.enum:=R_INTREGISTER;
             accreg.number:=NR_ACCUMULATOR;
@@ -1276,9 +1276,9 @@ implementation
 {$endif GDB}
        begin
           { deallocate the registers used for the current procedure's regvars }
-          if assigned(aktprocdef.regvarinfo) then
+          if assigned(current_procdef.regvarinfo) then
             begin
-              with pregvarinfo(aktprocdef.regvarinfo)^ do
+              with pregvarinfo(current_procdef.regvarinfo)^ do
                 for i := 1 to maxvarregs do
                   if assigned(regvars[i]) then
                     store_regvar(exprasmlist,regvars[i].reg);
@@ -1305,28 +1305,27 @@ implementation
           oldexitlabel:=aktexitlabel;
           oldexit2label:=aktexit2label;
           oldquickexitlabel:=quickexitlabel;
-          oldprocdef:=aktprocdef;
-          oldprocinfo:=procinfo;
+          oldprocdef:=current_procdef;
+          oldprocinfo:=current_procinfo;
           objectlibrary.getlabel(aktexitlabel);
           objectlibrary.getlabel(aktexit2label);
           { we're inlining a procedure }
           inlining_procedure:=true;
-          aktprocdef:=inlineprocdef;
+          current_procdef:=inlineprocdef;
 
           { clone procinfo, but not the asmlists }
-          procinfo:=tprocinfo(cprocinfo.newinstance);
-          move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
-          procinfo.aktentrycode:=nil;
-          procinfo.aktexitcode:=nil;
-          procinfo.aktproccode:=nil;
-          procinfo.aktlocaldata:=nil;
+          current_procinfo:=tprocinfo(cprocinfo.newinstance);
+          move(pointer(oldprocinfo)^,pointer(current_procinfo)^,cprocinfo.InstanceSize);
+          current_procinfo.aktentrycode:=nil;
+          current_procinfo.aktexitcode:=nil;
+          current_procinfo.aktproccode:=nil;
+          current_procinfo.aktlocaldata:=nil;
 
           { set new procinfo }
-          procinfo.return_offset:=retoffset;
-          procinfo.no_fast_exit:=false;
+          current_procinfo.return_offset:=retoffset;
 
           { arg space has been filled by the parent secondcall }
-          st:=aktprocdef.localst;
+          st:=current_procdef.localst;
           { set it to the same lexical level }
           st.symtablelevel:=oldprocdef.localst.symtablelevel;
           if st.datasize>0 then
@@ -1376,12 +1375,12 @@ implementation
           ps:=para_size;
           make_global:=false; { to avoid warning }
           genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
-          if po_assembler in aktprocdef.procoptions then
+          if po_assembler in current_procdef.procoptions then
             inlineentrycode.insert(Tai_marker.Create(asmblockstart));
           exprasmList.concatlist(inlineentrycode);
           secondpass(inlinetree);
           genexitcode(inlineexitcode,0,false,true);
-          if po_assembler in aktprocdef.procoptions then
+          if po_assembler in current_procdef.procoptions then
             inlineexitcode.concat(Tai_marker.Create(asmblockend));
           exprasmList.concatlist(inlineexitcode);
 
@@ -1399,8 +1398,8 @@ implementation
               st.address_fixup:=0;
             end;
           { restore procinfo }
-          procinfo.free;
-          procinfo:=oldprocinfo;
+          current_procinfo.free;
+          current_procinfo:=oldprocinfo;
 {$ifdef GDB}
           if (cs_debuginfo in aktmoduleswitches) then
             begin
@@ -1416,7 +1415,7 @@ implementation
             end;
 {$endif GDB}
           { restore }
-          aktprocdef:=oldprocdef;
+          current_procdef:=oldprocdef;
           aktexitlabel:=oldexitlabel;
           aktexit2label:=oldexit2label;
           quickexitlabel:=oldquickexitlabel;
@@ -1425,7 +1424,7 @@ implementation
           { reallocate the registers used for the current procedure's regvars, }
           { since they may have been used and then deallocated in the inlined  }
           { procedure (JM)                                                     }
-          if assigned(aktprocdef.regvarinfo) then
+          if assigned(current_procdef.regvarinfo) then
             begin
               rg.restoreStateAfterInline(oldregstate);
             end;
@@ -1439,8 +1438,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.54  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.55  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.54  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 13 - 4
compiler/ncgflw.pas

@@ -751,7 +751,7 @@ implementation
                         goto do_jmp;
                       end;
                   end;
-                  case aktprocdef.rettype.def.deftype of
+                  case current_procdef.rettype.def.deftype of
                     pointerdef,
                     procvardef :
                       begin
@@ -776,7 +776,7 @@ implementation
                       end;
                     else
                       begin
-                        cgsize:=def_cgsize(aktprocdef.rettype.def);
+                        cgsize:=def_cgsize(current_procdef.rettype.def);
                         allocated_acc := true;
 {$ifndef cpu64bit}
 
@@ -819,7 +819,7 @@ implementation
 {$endif cpu64bit}
 {$ifndef i386}
                   r.enum:=fpu_result_reg;
-                  if (aktprocdef.rettype.def.deftype = floatdef) then
+                  if (current_procdef.rettype.def.deftype = floatdef) then
                     cg.a_reg_dealloc(exprasmlist,r);
 {$endif not i386}
                end;
@@ -1531,7 +1531,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2003-04-22 23:50:22  peter
+  Revision 1.56  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.55  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG

+ 11 - 2
compiler/ncginl.pas

@@ -245,7 +245,7 @@ implementation
               LOC_REGISTER :
                 begin
                   if (left.resulttype.def.deftype=classrefdef) or
-                     (po_staticmethod in aktprocdef.procoptions) then
+                     (po_staticmethod in current_procdef.procoptions) then
                     cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,hregister)
                   else
                    begin
@@ -671,7 +671,16 @@ end.
 
 {
   $Log$
-  Revision 1.27  2003-04-25 08:25:26  daniel
+  Revision 1.28  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.27  2003/04/25 08:25:26  daniel
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills

+ 16 - 7
compiler/ncgld.pas

@@ -191,7 +191,7 @@ implementation
                               inlinelocalsymtable,
                               inlineparasymtable :
                                 begin
-                                  location.reference.base:=procinfo.framepointer;
+                                  location.reference.base:=current_procinfo.framepointer;
                                   if (symtabletype in [inlinelocalsymtable,
                                                        localsymtable])
 {$ifdef powerpc}
@@ -215,14 +215,14 @@ implementation
                                          location.reference.offset:=-location.reference.offset;
                                     end;
 {$endif powerpc}
-                                  if (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
+                                  if (current_procdef.parast.symtablelevel>symtable.symtablelevel) then
                                     begin
                                        hregister:=rg.getaddressregister(exprasmlist);
                                        { make a reference }
-                                       reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
+                                       reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
                                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                                        { walk parents }
-                                       i:=aktprocdef.parast.symtablelevel-1;
+                                       i:=current_procdef.parast.symtablelevel-1;
                                        while (i>symtable.symtablelevel) do
                                          begin
                                             { make a reference }
@@ -240,7 +240,7 @@ implementation
                                 end;
                               stt_exceptsymtable:
                                 begin
-                                   location.reference.base:=procinfo.framepointer;
+                                   location.reference.base:=current_procinfo.framepointer;
                                    location.reference.offset:=tvarsym(symtableentry).address;
                                 end;
                               objectsymtable:
@@ -953,8 +953,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.54  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.53  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 17 - 8
compiler/ncgmem.pas

@@ -350,7 +350,7 @@ implementation
       begin
          if (resulttype.def.deftype=classrefdef) or
             (is_class(resulttype.def) or
-             (po_staticmethod in aktprocdef.procoptions)) then
+             (po_staticmethod in current_procdef.procoptions)) then
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);
             location.register:=cg.g_load_self(exprasmlist);
@@ -397,7 +397,7 @@ implementation
 
                usetemp:=false;
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocdef.localst) then
+                  (tloadnode(left).symtable=current_procdef.localst) then
                  begin
                     { for locals use the local storage }
                     withreference:=left.location.reference;
@@ -434,7 +434,7 @@ implementation
                for i:=1 to tablecount do
                 begin
                   if (left.nodetype=loadn) and
-                     (tloadnode(left).symtable=aktprocdef.localst) then
+                     (tloadnode(left).symtable=current_procdef.localst) then
                     twithsymtable(symtable).direct_with:=true;
                   twithsymtable(symtable).withnode:=self;
                   symtable:=symtable.next;
@@ -471,13 +471,13 @@ implementation
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
                          '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
                          tostr(N_LSYM)+',0,0,'+tostr(withreference.offset))));
-                      mangled_length:=length(aktprocdef.mangledname);
+                      mangled_length:=length(current_procdef.mangledname);
                       getmem(pp,mangled_length+50);
                       strpcopy(pp,'192,0,0,'+withstartlabel.name);
                       if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocdef.mangledname);
+                          strpcopy(strend(pp),current_procdef.mangledname);
                         end;
                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                     end;
@@ -499,7 +499,7 @@ implementation
                       if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocdef.mangledname);
+                          strpcopy(strend(pp),current_procdef.mangledname);
                         end;
                        withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        freemem(pp,mangled_length+50);
@@ -580,7 +580,7 @@ implementation
             is_array_of_const(left.resulttype.def) then
           begin
             { cdecl functions don't have high() so we can not check the range }
-            if not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+            if not(current_procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
              begin
                { Get high value }
                hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
@@ -946,7 +946,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2003-04-22 23:50:22  peter
+  Revision 1.49  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.48  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG

+ 187 - 177
compiler/ncgutil.pas

@@ -771,7 +771,7 @@ implementation
                   { this is the easiest case for inlined !! }
                   r.enum:=stack_pointer_reg;
                   if calloption=pocall_inline then
-                   reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize)
+                   reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize)
                   else
                    reference_reset_base(href,r,0);
 
@@ -810,7 +810,7 @@ implementation
                          end;
                         if calloption=pocall_inline then
                          begin
-                           reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                           reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                            cg.a_load_ref_ref(list,cgsize,tempreference,href);
                          end
                         else
@@ -858,7 +858,7 @@ implementation
                        inc(pushedparasize,8);
                        if calloption=pocall_inline then
                         begin
-                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                           if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
                             begin
                               size:=align(p.resulttype.def.size,alignment);
@@ -897,7 +897,7 @@ implementation
                        inc(pushedparasize,alignment);
                        if calloption=pocall_inline then
                         begin
-                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                           if p.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
                             begin
                               size:=align(p.resulttype.def.size,alignment);
@@ -921,7 +921,7 @@ implementation
                      inc(pushedparasize,8);
                      if calloption=pocall_inline then
                        begin
-                          reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
+                          reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
                           cg.a_loadmm_reg_ref(list,p.location.register,href);
                        end
                      else
@@ -948,15 +948,15 @@ implementation
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
            (tvarsym(p).varspez=vs_value) and
-           (paramanager.push_addr_param(tvarsym(p).vartype.def,procinfo.procdef.proccalloption)) then
+           (paramanager.push_addr_param(tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
          begin
-           reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+           reference_reset_base(href1,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
            if is_open_array(tvarsym(p).vartype.def) or
               is_array_of_const(tvarsym(p).vartype.def) then
              cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
            else
             begin
-              reference_reset_base(href2,procinfo.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
+              reference_reset_base(href2,current_procinfo.framepointer,-tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
               if is_shortstring(tvarsym(p).vartype.def) then
                cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
               else
@@ -979,11 +979,10 @@ implementation
            not(is_class(tvarsym(p).vartype.def)) and
            tvarsym(p).vartype.def.needs_inittable then
          begin
-           if assigned(procinfo) and
-              (cs_implicit_exceptions in aktmoduleswitches) then
-            procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
+           if (cs_implicit_exceptions in aktmoduleswitches) then
+            include(current_procinfo.flags,pi_needs_implicit_finally);
            if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
+            reference_reset_base(href,current_procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
            else
             reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
            cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
@@ -1007,7 +1006,7 @@ implementation
                  tvarsym(p).vartype.def.needs_inittable then
                begin
                  if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-                  reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
+                  reference_reset_base(href,current_procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
                  else
                   reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
                  cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
@@ -1043,17 +1042,17 @@ implementation
              vs_value :
                begin
                  if (cs_implicit_exceptions in aktmoduleswitches) then
-                   procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
+                  include(current_procinfo.flags,pi_needs_implicit_finally);
                  if assigned(tvarsym(p).localvarsym) then
-                  reference_reset_base(href,procinfo.framepointer,
+                  reference_reset_base(href,current_procinfo.framepointer,
                       -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
                  else
-                  reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+                  reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
                  cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
                end;
              vs_out :
                begin
-                 reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+                 reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
                {$ifdef newra}
                  tmpreg:=rg.getaddressregister(list);
                {$else}
@@ -1086,10 +1085,10 @@ implementation
            if (tvarsym(p).varspez=vs_value) then
             begin
               if assigned(tvarsym(p).localvarsym) then
-               reference_reset_base(href,procinfo.framepointer,
+               reference_reset_base(href,current_procinfo.framepointer,
                    -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
               else
-               reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+               reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
               cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
             end;
          end;
@@ -1110,8 +1109,8 @@ implementation
                                tt_interfacecom,tt_freeinterfacecom] then
             begin
               if (cs_implicit_exceptions in aktmoduleswitches) then
-                procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
-              reference_reset_base(href,procinfo.framepointer,hp^.pos);
+                include(current_procinfo.flags,pi_needs_implicit_finally);
+              reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
               cg.a_load_const_ref(list,OS_ADDR,0,href);
             end;
            hp:=hp^.next;
@@ -1131,20 +1130,20 @@ implementation
              tt_ansistring,
              tt_freeansistring :
                begin
-                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
+                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                  cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
                end;
              tt_widestring,
              tt_freewidestring :
                begin
-                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
+                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
                end;
              tt_interfacecom :
                begin
-                 reference_reset_base(href,procinfo.framepointer,hp^.pos);
+                 reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
                  cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
                  cg.a_call_name(list,'FPC_INTF_DECR_REF');
                end;
@@ -1161,14 +1160,14 @@ implementation
         hreg,r,r2 : tregister;
         cgsize : TCGSize;
       begin
-        if not is_void(aktprocdef.rettype.def) then
+        if not is_void(current_procdef.rettype.def) then
          begin
-           reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
-           cgsize:=def_cgsize(aktprocdef.rettype.def);
+           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
+           cgsize:=def_cgsize(current_procdef.rettype.def);
            { Here, we return the function result. In most architectures, the value is
              passed into the accumulator, but in a windowed architecure like sparc a
              function returns in a register and the caller receives it in an other one }
-           case aktprocdef.rettype.def.deftype of
+           case current_procdef.rettype.def.deftype of
              orddef,
              enumdef :
                begin
@@ -1206,7 +1205,7 @@ implementation
                end;
              else
                begin
-                 if paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+                 if paramanager.ret_in_acc(current_procdef.rettype.def,current_procdef.proccalloption) then
                   begin
                     uses_acc:=true;
                     r.enum:=R_INTREGISTER;
@@ -1243,11 +1242,11 @@ implementation
         cgsize : TCGSize;
         r,r2 : Tregister;
       begin
-        if not is_void(aktprocdef.rettype.def) then
+        if not is_void(current_procdef.rettype.def) then
          begin
-           reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
-           cgsize:=def_cgsize(aktprocdef.rettype.def);
-           case aktprocdef.rettype.def.deftype of
+           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
+           cgsize:=def_cgsize(current_procdef.rettype.def);
+           case current_procdef.rettype.def.deftype of
              orddef,
              enumdef :
                begin
@@ -1276,7 +1275,7 @@ implementation
              else
                begin
                  r.enum:=accumulator;
-                 if paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+                 if paramanager.ret_in_acc(current_procdef.rettype.def,current_procdef.proccalloption) then
                   cg.a_load_reg_ref(list,cgsize,r,href);
                end;
            end;
@@ -1310,23 +1309,23 @@ implementation
 
         { for the save all registers we can simply use a pusha,popa which
           push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
-        if (po_saveregisters in aktprocdef.procoptions) then
+        if (po_saveregisters in current_procdef.procoptions) then
           cg.g_save_all_registers(list)
         else
          { should we save edi,esi,ebx like C ? }
-         if (po_savestdregs in aktprocdef.procoptions) then
-           cg.g_save_standard_registers(list,aktprocdef.usedintregisters);
+         if (po_savestdregs in current_procdef.procoptions) then
+           cg.g_save_standard_registers(list,current_procdef.usedintregisters);
 
         { Save stackpointer value }
         if not inlined and
-           (procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
-           ((po_savestdregs in aktprocdef.procoptions) or
-            (po_saveregisters in aktprocdef.procoptions)) then
+           (current_procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
+           ((po_savestdregs in current_procdef.procoptions) or
+            (po_saveregisters in current_procdef.procoptions)) then
          begin
-           tg.GetTemp(list,POINTER_SIZE,tt_noreuse,procinfo.save_stackptr_ref);
+           tg.GetTemp(list,POINTER_SIZE,tt_noreuse,current_procinfo.save_stackptr_ref);
            rsp.enum:=R_INTREGISTER;
            rsp.number:=NR_STACK_POINTER_REG;
-           cg.a_load_reg_ref(list,OS_ADDR,rsp,procinfo.save_stackptr_ref);
+           cg.a_load_reg_ref(list,OS_ADDR,rsp,current_procinfo.save_stackptr_ref);
          end;
 
         { the actual profile code can clobber some registers,
@@ -1334,7 +1333,7 @@ implementation
           the actual call to the profile code
         }
         if (cs_profile in aktmoduleswitches) and
-           not(po_assembler in aktprocdef.procoptions) and
+           not(po_assembler in current_procdef.procoptions) and
            not(inlined) then
           begin
             { non-win32 can call mcout even in main }
@@ -1342,28 +1341,28 @@ implementation
               cg.g_profilecode(list)
             else
             { wdosx, and win32 should not call mcount before monstartup has been called }
-            if not (aktprocdef.proctypeoption=potype_proginit) then
+            if not (current_procdef.proctypeoption=potype_proginit) then
               cg.g_profilecode(list);
           end;
 
         { a constructor needs a help procedure }
-        if (aktprocdef.proctypeoption=potype_constructor) then
+        if (current_procdef.proctypeoption=potype_constructor) then
          begin
            cg.g_call_constructor_helper(list);
          end;
 
-        if not is_void(aktprocdef.rettype.def) then
+        if not is_void(current_procdef.rettype.def) then
           begin
              { for now the pointer to the result can't be a register }
-             if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+             if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
                begin
 {$ifdef powerpc}
                   { no stack space is allocated in this case -> can't save the result reg on the stack }
-                  if not(po_assembler in aktprocdef.procoptions) then
+                  if not(po_assembler in current_procdef.procoptions) then
 {$endif powerpc}
                     begin
-                      paraloc:=paramanager.getfuncretparaloc(aktprocdef);
-                      reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
+                      paraloc:=paramanager.getfuncretparaloc(current_procdef);
+                      reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
                       case paraloc.loc of
                         LOC_CREGISTER,
                         LOC_REGISTER:
@@ -1382,21 +1381,21 @@ implementation
                end;
 
              { initialize return value }
-             if (aktprocdef.rettype.def.needs_inittable) then
+             if (current_procdef.rettype.def.needs_inittable) then
                begin
 {$ifdef powerpc}
-                  if (po_assembler in aktprocdef.procoptions) then
+                  if (po_assembler in current_procdef.procoptions) then
                     internalerror(200304161);
 {$endif powerpc}
                   if (cs_implicit_exceptions in aktmoduleswitches) then
-                    procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
-                  reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
-                  cg.g_initialize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption));
+                    include(current_procinfo.flags,pi_needs_implicit_finally);
+                  reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
+                  cg.g_initialize(list,current_procdef.rettype.def,href,paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption));
                end;
           end;
 
         { initialize local data like ansistrings }
-        case aktprocdef.proctypeoption of
+        case current_procdef.proctypeoption of
            potype_unitinit:
              begin
                 { this is also used for initialization of variables in a
@@ -1410,26 +1409,26 @@ implementation
            { program init/final is generated in separate procedure }
            potype_proginit: ;
            else
-             aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
+             current_procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
         end;
 
         { initialisizes temp. ansi/wide string data }
         inittempvariables(list);
 
         { generate copies of call by value parameters }
-        if not(po_assembler in aktprocdef.procoptions) then
-          aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
+        if not(po_assembler in current_procdef.procoptions) then
+          current_procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
 
-        if assigned(aktprocdef.parast) then
+        if assigned(current_procdef.parast) then
           begin
-             aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
+             current_procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
 
-             if not (po_assembler in aktprocdef.procoptions) then
+             if not (po_assembler in current_procdef.procoptions) then
                begin
                  { move register parameters which aren't regable into memory                                          }
                  { we do this after init_paras because it saves some code in init_paras if parameters are in register }
                  { instead in memory                                                                                  }
-                 hp:=tparaitem(aktprocdef.para.first);
+                 hp:=tparaitem(current_procdef.para.first);
                  while assigned(hp) do
                    begin
                      if Tvarsym(hp.parasym).reg.enum>lastreg then
@@ -1450,7 +1449,7 @@ implementation
                       LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
                       (tvarsym(hp.parasym).reg.enum=R_NO) then
                        begin
-                         reference_reset_base(href,procinfo.framepointer,tvarsym(hp.parasym).address+
+                         reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).address+
                            tvarsym(hp.parasym).owner.address_fixup);
                          case hp.paraloc.loc of
                            LOC_CREGISTER,
@@ -1474,7 +1473,7 @@ implementation
         if (not inlined) then
          begin
            { call startup helpers from main program }
-           if (aktprocdef.proctypeoption=potype_proginit) then
+           if (current_procdef.proctypeoption=potype_proginit) then
             begin
               { initialize profiling for win32 }
               if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
@@ -1492,17 +1491,17 @@ implementation
             end;
 
            { do we need an exception frame because of ansi/widestrings/interfaces ? }
-           if ((procinfo.flags and pi_needs_implicit_finally)<>0) and
+           if (pi_needs_implicit_finally in current_procinfo.flags) and
               { but it's useless in init/final code of units }
-              not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
+              not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
             begin
               include(rg.usedinproc,accumulator);
-              tg.GetTemp(list,JMP_BUF_SIZE,tt_noreuse,procinfo.exception_jmp_ref);
-              tg.GetTemp(list,12,tt_noreuse,procinfo.exception_env_ref);
-              tg.GetTemp(list,sizeof(aword),tt_noreuse,procinfo.exception_result_ref);
-              new_exception(list,procinfo.exception_jmp_ref,
-                  procinfo.exception_env_ref,
-                  procinfo.exception_result_ref,1,aktexitlabel);
+              tg.GetTemp(list,JMP_BUF_SIZE,tt_noreuse,current_procinfo.exception_jmp_ref);
+              tg.GetTemp(list,12,tt_noreuse,current_procinfo.exception_env_ref);
+              tg.GetTemp(list,sizeof(aword),tt_noreuse,current_procinfo.exception_result_ref);
+              new_exception(list,current_procinfo.exception_jmp_ref,
+                  current_procinfo.exception_env_ref,
+                  current_procinfo.exception_result_ref,1,aktexitlabel);
             end;
 
 {$ifdef GDB}
@@ -1512,13 +1511,13 @@ implementation
          end;
 
         { maybe call BeforeDestruction for classes }
-        if (aktprocdef.proctypeoption=potype_destructor) and
-           is_class(aktprocdef._class) then
+        if (current_procdef.proctypeoption=potype_destructor) and
+           is_class(current_procdef._class) then
          begin
            objectlibrary.getlabel(inheriteddesctructorlabel);
-           reference_reset_base(href,procinfo.framepointer,procinfo.inheritedflag_offset);
+           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.inheritedflag_offset);
            cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,inheriteddesctructorlabel);
-           reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
+           reference_reset_base(href,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
          {$ifdef newra}
            tmpreg:=rg.getaddressregister(list);
          {$else}
@@ -1555,23 +1554,24 @@ implementation
             stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
 
            if (cs_profile in aktmoduleswitches) or
-              (aktprocdef.owner.symtabletype=globalsymtable) or
-              (assigned(aktprocdef._class) and
-               (aktprocdef._class.owner.symtabletype=globalsymtable)) then
+              (current_procdef.owner.symtabletype=globalsymtable) or
+              (assigned(current_procdef._class) and
+               (current_procdef._class.owner.symtabletype=globalsymtable)) then
             make_global:=true;
 
 {$ifdef GDB}
            if (cs_debuginfo in aktmoduleswitches) then
             begin
-              if make_global or ((procinfo.flags and pi_is_global) <> 0) then
-                tprocsym(aktprocdef.procsym).is_global:=true;
-              aktprocdef.concatstabto(stackalloclist);
-              tprocsym(aktprocdef.procsym).isstabwritten:=true;
+              if make_global or
+                 (pi_is_global in current_procinfo.flags) then
+                tprocsym(current_procdef.procsym).is_global:=true;
+              current_procdef.concatstabto(stackalloclist);
+              tprocsym(current_procdef.procsym).isstabwritten:=true;
             end;
 {$endif GDB}
 
            repeat
-             hs:=aktprocdef.aliasnames.getfirst;
+             hs:=current_procdef.aliasnames.getfirst;
              if hs='' then
               break;
 {$ifdef GDB}
@@ -1594,14 +1594,14 @@ implementation
 {$ifndef powerpc}
            { at least for the ppc this applies always, so this code isn't usable (FK) }
            { omit stack frame ? }
-           if (procinfo.framepointer.number=NR_STACK_POINTER_REG) then
+           if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
             begin
               CGMessage(cg_d_stackframe_omited);
               nostackframe:=true;
-              if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+              if (current_procdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+aktprocdef.parast.address_fixup-4;
+                parasize:=current_procdef.parast.datasize+current_procdef.parast.address_fixup-4;
               if stackframe<>0 then
                 cg.g_stackpointer_alloc(stackalloclist,stackframe);
             end
@@ -1609,12 +1609,12 @@ implementation
 {$endif powerpc}
             begin
               nostackframe:=false;
-              if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+              if (current_procdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+aktprocdef.parast.address_fixup-target_info.first_parm_offset;
+                parasize:=current_procdef.parast.datasize+current_procdef.parast.address_fixup-target_info.first_parm_offset;
 
-              if (po_interrupt in aktprocdef.procoptions) then
+              if (po_interrupt in current_procdef.procoptions) then
                 cg.g_interrupt_stackframe_entry(stackalloclist);
 
               cg.g_stackframe_entry(stackalloclist,stackframe);
@@ -1622,7 +1622,7 @@ implementation
               { never call stack checking before the standard system unit
                 has not been initialized
               }
-              if (cs_check_stack in aktlocalswitches) and (aktprocdef.proctypeoption<>potype_proginit) then
+              if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
                 cg.g_stackcheck(stackalloclist,stackframe);
             end;
             list.insertlist(stackalloclist);
@@ -1651,7 +1651,8 @@ implementation
         rsp,tmpreg,r  : Tregister;
       begin
         if aktexit2label.is_used and
-           ((procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0) then
+           ((pi_needs_implicit_finally in current_procinfo.flags) or
+            (pi_uses_exceptions in current_procinfo.flags)) then
           begin
             cg.a_jmp_always(list,aktexitlabel);
             cg.a_label(list,aktexit2label);
@@ -1664,15 +1665,15 @@ implementation
         cleanup_regvars(list);
 
         { call the destructor help procedure }
-        if (aktprocdef.proctypeoption=potype_destructor) and
-           assigned(aktprocdef._class) then
+        if (current_procdef.proctypeoption=potype_destructor) and
+           assigned(current_procdef._class) then
          cg.g_call_destructor_helper(list);
 
         { finalize temporary data }
         finalizetempvariables(list);
 
         { finalize local data like ansistrings}
-        case aktprocdef.proctypeoption of
+        case current_procdef.proctypeoption of
            potype_unitfinalize:
              begin
                 { this is also used for initialization of variables in a
@@ -1686,52 +1687,52 @@ implementation
            { program init/final is generated in separate procedure }
            potype_proginit: ;
            else
-             aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
+             current_procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
         end;
 
         { finalize paras data }
-        if assigned(aktprocdef.parast) then
-          aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
+        if assigned(current_procdef.parast) then
+          current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
 
         { do we need to handle exceptions because of ansi/widestrings ? }
         if not inlined and
-           ((procinfo.flags and pi_needs_implicit_finally)<>0) and
+           (pi_needs_implicit_finally in current_procinfo.flags) and
            { but it's useless in init/final code of units }
-           not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
+           not(current_procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
           begin
              { the exception helper routines modify all registers }
-             aktprocdef.usedintregisters:=all_intregisters;
-             aktprocdef.usedotherregisters:=all_registers;
+             current_procdef.usedintregisters:=all_intregisters;
+             current_procdef.usedotherregisters:=all_registers;
              objectlibrary.getlabel(noreraiselabel);
              free_exception(list,
-                  procinfo.exception_jmp_ref,
-                  procinfo.exception_env_ref,
-                  procinfo.exception_result_ref,0,
+                  current_procinfo.exception_jmp_ref,
+                  current_procinfo.exception_env_ref,
+                  current_procinfo.exception_result_ref,0,
                   noreraiselabel,false);
-             tg.Ungettemp(list,procinfo.exception_jmp_ref);
-             tg.Ungettemp(list,procinfo.exception_env_ref);
-             tg.Ungettemp(list,procinfo.exception_result_ref);
+             tg.Ungettemp(list,current_procinfo.exception_jmp_ref);
+             tg.Ungettemp(list,current_procinfo.exception_env_ref);
+             tg.Ungettemp(list,current_procinfo.exception_result_ref);
 
-             if (aktprocdef.proctypeoption=potype_constructor) then
+             if (current_procdef.proctypeoption=potype_constructor) then
                begin
-                  if assigned(aktprocdef._class) then
+                  if assigned(current_procdef._class) then
                     begin
-                       pd:=aktprocdef._class.searchdestructor;
+                       pd:=current_procdef._class.searchdestructor;
                        if assigned(pd) then
                          begin
                             objectlibrary.getlabel(nodestroycall);
-                            reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
+                            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.selfpointer_offset);
                             cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
                             r:=cg.g_load_self(list);
-                            if is_class(aktprocdef._class) then
+                            if is_class(current_procdef._class) then
                              begin
                                cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
                                cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
                              end
-                            else if is_object(aktprocdef._class) then
+                            else if is_object(current_procdef._class) then
                              begin
                                cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(2));
-                               reference_reset_symbol(href,objectlibrary.newasmsymboldata(aktprocdef._class.vmt_mangledname),0);
+                               reference_reset_symbol(href,objectlibrary.newasmsymboldata(current_procdef._class.vmt_mangledname),0);
                                cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                              end
                             else
@@ -1740,7 +1741,7 @@ implementation
                              begin
                                reference_reset_base(href,r,0);
                                cg.a_load_ref_reg(list,OS_ADDR,href,r);
-                               reference_reset_base(href,r,aktprocdef._class.vmtmethodoffset(pd.extnumber));
+                               reference_reset_base(href,r,current_procdef._class.vmtmethodoffset(pd.extnumber));
                                cg.a_call_ref(list,href);
                              end
                             else
@@ -1756,13 +1757,13 @@ implementation
               begin
                 { no constructor }
                 { must be the return value finalized before reraising the exception? }
-                if (not is_void(aktprocdef.rettype.def)) and
-                   (aktprocdef.rettype.def.needs_inittable) and
-                   ((aktprocdef.rettype.def.deftype<>objectdef) or
-                    not is_class(aktprocdef.rettype.def)) then
+                if (not is_void(current_procdef.rettype.def)) and
+                   (current_procdef.rettype.def.needs_inittable) and
+                   ((current_procdef.rettype.def.deftype<>objectdef) or
+                    not is_class(current_procdef.rettype.def)) then
                   begin
-                     reference_reset_base(href,procinfo.framepointer,procinfo.return_offset);
-                     cg.g_finalize(list,aktprocdef.rettype.def,href,paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption));
+                     reference_reset_base(href,current_procinfo.framepointer,current_procinfo.return_offset);
+                     cg.g_finalize(list,current_procdef.rettype.def,href,paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption));
                   end;
               end;
 
@@ -1773,7 +1774,7 @@ implementation
         { call __EXIT for main program }
         if (not DLLsource) and
            (not inlined) and
-           (aktprocdef.proctypeoption=potype_proginit) then
+           (current_procdef.proctypeoption=potype_proginit) then
          begin
            cg.a_call_name(list,'FPC_DO_EXIT');
          end;
@@ -1783,11 +1784,11 @@ implementation
         usesacc:=false;
         usesacchi:=false;
         usesself:=false;
-        if not(po_assembler in aktprocdef.procoptions) or
-           (assigned(aktprocdef.funcretsym) and
-            (tvarsym(aktprocdef.funcretsym).refcount>1)) then
+        if not(po_assembler in current_procdef.procoptions) or
+           (assigned(current_procdef.funcretsym) and
+            (tvarsym(current_procdef.funcretsym).refcount>1)) then
           begin
-            if (aktprocdef.proctypeoption=potype_constructor) then
+            if (current_procdef.proctypeoption=potype_constructor) then
               begin
                 objectlibrary.getlabel(inheritedconstructorlabel);
                 objectlibrary.getlabel(okexitlabel);
@@ -1802,12 +1803,12 @@ implementation
                 r.number:=NR_ACCUMULATOR;
                 cg.a_reg_alloc(list,r);
                 { maybe call AfterConstructor for classes }
-                if is_class(aktprocdef._class) then
+                if is_class(current_procdef._class) then
                  begin
-                   reference_reset_base(href,procinfo.framepointer,procinfo.vmtpointer_offset);
+                   reference_reset_base(href,current_procinfo.framepointer,current_procinfo.vmtpointer_offset);
                    cg.a_load_ref_reg(list,OS_ADDR,href,r);
                    cg.a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,r,inheritedconstructorlabel);
-                   reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+                   reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
                    cg.a_load_ref_reg(list,OS_ADDR,href,r);
                    cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
                    reference_reset_base(href,r,0);
@@ -1827,7 +1828,7 @@ implementation
                  end;
                 { return the self pointer }
                 cg.a_label(list,inheritedconstructorlabel);
-                reference_reset_base(href, procinfo.framepointer,procinfo.selfpointer_offset);
+                reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
                 cg.a_load_ref_reg(list,OS_ADDR,href,r);
                 cg.a_reg_dealloc(list,r);
                 usesacc:=true;
@@ -1849,24 +1850,24 @@ implementation
 
         { Restore stackpointer if it was saved }
         if not inlined and
-           (procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
-           ((po_savestdregs in aktprocdef.procoptions) or
-            (po_saveregisters in aktprocdef.procoptions)) then
+           (current_procinfo.framepointer.number<>NR_STACK_POINTER_REG) and
+           ((po_savestdregs in current_procdef.procoptions) or
+            (po_saveregisters in current_procdef.procoptions)) then
          begin
            rsp.enum:=R_INTREGISTER;
            rsp.number:=NR_STACK_POINTER_REG;
-           cg.a_load_ref_reg(list,OS_ADDR,procinfo.save_stackptr_ref,rsp);
-           tg.UngetTemp(list,procinfo.save_stackptr_ref);
+           cg.a_load_ref_reg(list,OS_ADDR,current_procinfo.save_stackptr_ref,rsp);
+           tg.UngetTemp(list,current_procinfo.save_stackptr_ref);
          end;
 
         { for the save all registers we can simply use a pusha,popa which
           push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
-        if (po_saveregisters in aktprocdef.procoptions) then
+        if (po_saveregisters in current_procdef.procoptions) then
           cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
         else
          { should we restore edi ? }
-         if (po_savestdregs in aktprocdef.procoptions) then
-           cg.g_restore_standard_registers(list,aktprocdef.usedintregisters);
+         if (po_savestdregs in current_procdef.procoptions) then
+           cg.g_restore_standard_registers(list,current_procdef.usedintregisters);
 
         { remove stackframe }
         if not inlined then
@@ -1884,7 +1885,7 @@ implementation
         { at last, the return is generated }
         if not inlined then
          begin
-           if (po_interrupt in aktprocdef.procoptions) then
+           if (po_interrupt in current_procdef.procoptions) then
             cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
            else
              begin
@@ -1900,99 +1901,99 @@ implementation
          end;
 
         if not inlined then
-          list.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
+          list.concat(Tai_symbol_end.Createname(current_procdef.mangledname));
 
 {$ifdef GDB}
         if (cs_debuginfo in aktmoduleswitches) and not inlined  then
           begin
-            if assigned(aktprocdef._class) then
-              if (not assigned(procinfo.parent) or
-                  not assigned(procinfo.parent.procdef._class)) then
+            if assigned(current_procdef._class) then
+              if (not assigned(current_procinfo.parent) or
+                  not assigned(current_procinfo.parent.procdef._class)) then
                 begin
-                  if (po_classmethod in aktprocdef.procoptions) or
-                     ((po_virtualmethod in aktprocdef.procoptions) and
-                      (potype_constructor=aktprocdef.proctypeoption)) or
-                     (po_staticmethod in aktprocdef.procoptions) then
+                  if (po_classmethod in current_procdef.procoptions) or
+                     ((po_virtualmethod in current_procdef.procoptions) and
+                      (potype_constructor=current_procdef.proctypeoption)) or
+                     (po_staticmethod in current_procdef.procoptions) then
                     begin
                       list.concat(Tai_stabs.Create(strpnew(
                        '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
+                       tostr(N_tsym)+',0,0,'+tostr(current_procinfo.selfpointer_offset))));
                     end
                   else
                     begin
-                      if not(is_class(aktprocdef._class)) then
+                      if not(is_class(current_procdef._class)) then
                         st:='v'
                       else
                         st:='p';
                       list.concat(Tai_stabs.Create(strpnew(
-                       '"$t:'+st+aktprocdef._class.numberstring+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
+                       '"$t:'+st+current_procdef._class.numberstring+'",'+
+                       tostr(N_tsym)+',0,0,'+tostr(current_procinfo.selfpointer_offset))));
                     end;
                 end
               else
                 begin
-                  if not is_class(aktprocdef._class) then
+                  if not is_class(current_procdef._class) then
                     st:='*'
                   else
                     st:='';
 {$warning GDB self}
                   {list.concat(Tai_stabs.Create(strpnew(
-                   '"$t:r'+st+aktprocdef._class.numberstring+'",'+
+                   '"$t:r'+st+current_procdef._class.numberstring+'",'+
                    tostr(N_RSYM)+',0,0,'+tostr(stab_regindex[SELF_POINTER_REG]))));}
                 end;
 
             { define calling EBP as pseudo local var PM }
             { this enables test if the function is a local one !! }
-            if  assigned(procinfo.parent) and
-                (aktprocdef.parast.symtablelevel>normal_function_level) then
+            if  assigned(current_procinfo.parent) and
+                (current_procdef.parast.symtablelevel>normal_function_level) then
               list.concat(Tai_stabs.Create(strpnew(
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
-               tostr(N_LSYM)+',0,0,'+tostr(procinfo.framepointer_offset))));
+               tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.framepointer_offset))));
 
-            if (not is_void(aktprocdef.rettype.def)) then
+            if (not is_void(current_procdef.rettype.def)) then
               begin
-                if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+                if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
                   list.concat(Tai_stabs.Create(strpnew(
-                   '"'+aktprocdef.procsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
+                   '"'+current_procdef.procsym.name+':X*'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
+                   tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))))
                 else
                   list.concat(Tai_stabs.Create(strpnew(
-                   '"'+aktprocdef.procsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
+                   '"'+current_procdef.procsym.name+':X'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
+                   tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))));
                 if (m_result in aktmodeswitches) then
-                  if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+                  if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
                     list.concat(Tai_stabs.Create(strpnew(
-                     '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
+                     '"RESULT:X*'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
+                     tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))))
                   else
                     list.concat(Tai_stabs.Create(strpnew(
-                     '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
+                     '"RESULT:X'+tstoreddef(current_procdef.rettype.def).numberstring+'",'+
+                     tostr(N_tsym)+',0,0,'+tostr(current_procinfo.return_offset))));
               end;
-            mangled_length:=length(aktprocdef.mangledname);
+            mangled_length:=length(current_procdef.mangledname);
             getmem(p,2*mangled_length+50);
             strpcopy(p,'192,0,0,');
-            strpcopy(strend(p),aktprocdef.mangledname);
+            strpcopy(strend(p),current_procdef.mangledname);
             if (target_info.use_function_relative_addresses) then
               begin
                 strpcopy(strend(p),'-');
-                strpcopy(strend(p),aktprocdef.mangledname);
+                strpcopy(strend(p),current_procdef.mangledname);
               end;
             list.concat(Tai_stabn.Create(strnew(p)));
             {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
-             +aktprocdef.mangledname))));
+             +current_procdef.mangledname))));
             p[0]:='2';p[1]:='2';p[2]:='4';
             strpcopy(strend(p),'_end');}
             strpcopy(p,'224,0,0,'+stabsendlabel.name);
             if (target_info.use_function_relative_addresses) then
               begin
                 strpcopy(strend(p),'-');
-                strpcopy(strend(p),aktprocdef.mangledname);
+                strpcopy(strend(p),current_procdef.mangledname);
               end;
             list.concatlist(withdebuglist);
             list.concat(Tai_stabn.Create(strnew(p)));
              { strpnew('224,0,0,'
-             +aktprocdef.mangledname+'_end'))));}
+             +current_procdef.mangledname+'_end'))));}
             freemem(p,2*mangled_length+50);
           end;
 {$endif GDB}
@@ -2004,8 +2005,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.91  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.92  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.91  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/ncnv.pas

@@ -1126,7 +1126,7 @@ implementation
 
           te_convert_operator :
             begin
-              procinfo.flags:=procinfo.flags or pi_do_call;
+              include(current_procinfo.flags,pi_do_call);
               hp:=ccallnode.create(ccallparanode.create(left,nil),
                                    overloaded_operators[_assignment],nil,nil);
               { tell explicitly which def we must use !! (PM) }
@@ -2091,7 +2091,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.108  2003-04-23 20:16:04  peter
+  Revision 1.109  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.108  2003/04/23 20:16:04  peter
     + added currency support based on int64
     + is_64bit for use in cg units instead of is_64bitint
     * removed cgmessage from n386add, replace with internalerrors
@@ -2235,7 +2244,7 @@ end.
       functions was requested
 
   Revision 1.70  2002/08/17 09:23:36  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.69  2002/08/14 19:26:55  carl
     + generic int_to_real type conversion

+ 22 - 12
compiler/nflw.pas

@@ -739,8 +739,8 @@ implementation
          if (
              (hp.nodetype=loadn) and
              (
-              (tloadnode(hp).symtable.symtablelevel=normal_function_level) or
-              (tloadnode(hp).symtable.symtablelevel=aktprocdef.parast.symtablelevel)
+              (tloadnode(hp).symtable.symtablelevel=main_program_level) or
+              (tloadnode(hp).symtable.symtablelevel=current_procdef.parast.symtablelevel)
              ) and
              not(
                  (tloadnode(hp).symtableentry.typ=varsym) and
@@ -886,21 +886,22 @@ implementation
          begin
            if assigned(left) then
             begin
-              inserttypeconv(left,aktprocdef.rettype);
-              if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) or
-                 (procinfo.no_fast_exit) or
-                 ((procinfo.flags and pi_uses_exceptions)<>0) then
+              inserttypeconv(left,current_procdef.rettype);
+              if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) or
+                 (current_procdef.proctypeoption=potype_constructor) or
+                 (pi_needs_implicit_finally in current_procinfo.flags) or
+                 (pi_uses_exceptions in current_procinfo.flags) then
                begin
                  left:=cassignmentnode.create(
-                     cloadnode.create(aktprocdef.funcretsym,aktprocdef.funcretsym.owner),
+                     cloadnode.create(current_procdef.funcretsym,current_procdef.funcretsym.owner),
                      left);
                  onlyassign:=true;
                end
               else
                begin
                  { mark funcretsym as assigned }
-                 inc(tvarsym(aktprocdef.funcretsym).refs);
-                 tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                 inc(tvarsym(current_procdef.funcretsym).refs);
+                 tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                end;
             end;
          end;
@@ -1498,8 +1499,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.70  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.71  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.70  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
@@ -1614,7 +1624,7 @@ end.
     * some ppc stuff fixed
 
   Revision 1.45  2002/08/17 09:23:37  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.44  2002/07/21 06:58:49  daniel
   * Changed booleans into flags

+ 17 - 4
compiler/ninl.pas

@@ -361,7 +361,7 @@ implementation
         { create a blocknode in which the successive write/read statements will be  }
         { put, since they belong together. Also create a dummy statement already to }
         { make inserting of additional statements easier                            }
-        newblock:=internalstatements(newstatement);
+        newblock:=internalstatements(newstatement,true);
 
         { if we don't have a filepara, create one containing the default }
         if not assigned(filepara) then
@@ -910,7 +910,7 @@ implementation
         { create the blocknode which will hold the generated statements + }
         { an initial dummy statement                                      }
 
-        newblock:=internalstatements(newstatement);
+        newblock:=internalstatements(newstatement,true);
 
         { do we need a temp for code? Yes, if no code specified, or if  }
         { code is not a 32bit parameter (we already checked whether the }
@@ -1388,7 +1388,7 @@ implementation
               in_sizeof_x:
                 begin
                   set_varstate(left,false);
-                  if paramanager.push_high_param(left.resulttype.def,aktprocdef.proccalloption) then
+                  if paramanager.push_high_param(left.resulttype.def,current_procdef.proccalloption) then
                    begin
                      hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
                      if assigned(hightree) then
@@ -2351,7 +2351,20 @@ begin
 end.
 {
   $Log$
-  Revision 1.107  2003-04-23 20:16:04  peter
+  Revision 1.109  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.108  2002/04/25 20:15:39  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.107  2003/04/23 20:16:04  peter
     + added currency support based on int64
     + is_64bit for use in cg units instead of is_64bitint
     * removed cgmessage from n386add, replace with internalerrors

+ 13 - 6
compiler/nld.pas

@@ -371,16 +371,14 @@ implementation
               begin
                  if tconstsym(symtableentry).consttyp=constresourcestring then
                    begin
-                      { we use ansistrings so no fast exit here }
-                      if assigned(procinfo) then
-                        procinfo.no_fast_exit:=true;
+                      include(current_procinfo.flags,pi_needs_implicit_finally);
                       expectloc:=LOC_CREFERENCE;
                    end;
               end;
             varsym :
               begin
                 if (symtable.symtabletype in [parasymtable,localsymtable]) and
-                   (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
+                   (current_procdef.parast.symtablelevel>symtable.symtablelevel) then
                   begin
                     { if the variable is in an other stackframe then we need
                       a register to dereference }
@@ -1129,8 +1127,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.89  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.90  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.89  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 13 - 4
compiler/nmem.pas

@@ -915,7 +915,7 @@ implementation
          result:=nil;
          if (resulttype.def.deftype=classrefdef) or
             is_class(resulttype.def) or
-            (po_staticmethod in aktprocdef.procoptions) then
+            (po_staticmethod in current_procdef.procoptions) then
            expectloc:=LOC_REGISTER
          else
            expectloc:=LOC_CREFERENCE;
@@ -1003,7 +1003,7 @@ implementation
             for i:=1 to tablecount do
              begin
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocdef.localst) then
+                  (tloadnode(left).symtable=current_procdef.localst) then
                 twithsymtable(symtable).direct_with:=true;
                twithsymtable(symtable).withnode:=self;
                symtable:=symtable.next;
@@ -1059,8 +1059,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.51  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.50  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/nopt.pas

@@ -140,7 +140,7 @@ begin
   expectloc:= LOC_REFERENCE;
   calcregisters(self,0,0,0);
   { here we call STRCONCAT or STRCMP or STRCOPY }
-  procinfo.flags:=procinfo.flags or pi_do_call;
+  include(current_procinfo.flags,pi_do_call);
 end;
 
 function taddsstringoptnode.getcopy: tnode;
@@ -278,7 +278,16 @@ end.
 
 {
   $Log$
-  Revision 1.14  2003-04-26 09:12:55  peter
+  Revision 1.15  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.14  2003/04/26 09:12:55  peter
     * add string returns in LOC_REFERENCE
 
   Revision 1.13  2003/04/22 23:50:23  peter
@@ -292,7 +301,7 @@ end.
     * made operator search faster by walking the list only once
 
   Revision 1.11  2002/08/17 09:23:37  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.10  2002/07/20 11:57:55  florian
     * types.pas renamed to defbase.pas because D6 contains a types

+ 12 - 3
compiler/nset.pas

@@ -332,7 +332,7 @@ implementation
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo.flags:=procinfo.flags or pi_do_call
+           include(current_procinfo.flags,pi_do_call)
          else
            begin
               { a smallset needs maybe an misc. register }
@@ -714,7 +714,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2003-04-25 08:25:26  daniel
+  Revision 1.41  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.40  2003/04/25 08:25:26  daniel
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills
@@ -760,7 +769,7 @@ end.
       functions was requested
 
   Revision 1.31  2002/08/17 09:23:38  florian
-    * first part of procinfo rewrite
+    * first part of current_procinfo rewrite
 
   Revision 1.30  2002/07/23 13:19:40  jonas
     * fixed evaluation of expressions with empty sets that are calculated

+ 11 - 2
compiler/paramgr.pas

@@ -402,8 +402,17 @@ end.
 
 {
    $Log$
-   Revision 1.35  2003-04-27 07:29:50  peter
-     * aktprocdef cleanup, aktprocdef is now always nil when parsing
+   Revision 1.36  2003-04-27 11:21:33  peter
+     * aktprocdef renamed to current_procdef
+     * procinfo renamed to current_procinfo
+     * procinfo will now be stored in current_module so it can be
+       cleaned up properly
+     * gen_main_procsym changed to create_main_proc and release_main_proc
+       to also generate a tprocinfo structure
+     * fixed unit implicit initfinal
+
+   Revision 1.35  2003/04/27 07:29:50  peter
+     * current_procdef cleanup, current_procdef is now always nil when parsing
        a new procdef declaration
      * aktprocsym removed
      * lexlevel removed, use symtable.symtablelevel instead

+ 16 - 19
compiler/parser.pas

@@ -68,12 +68,12 @@ implementation
          testcurobject:=0;
 
          { Symtable }
-         aktprocdef:=nil;
+         current_procdef:=nil;
 
          objectlibrary:=nil;
          current_module:=nil;
          compiled_module:=nil;
-         procinfo:=nil;
+         current_procinfo:=nil;
 
          loaded_units:=TLinkedList.Create;
 
@@ -116,15 +116,6 @@ implementation
          { codegen }
          if paraprintnodetree<>0 then
            printnode_reset;
-
-         { for the implicitly generated init/final. procedures for global init. variables,
-           a dummy procinfo is necessary }
-         voidprocpi:=cprocinfo.create;
-         with voidprocpi do
-           begin
-              framepointer.enum:=R_INTREGISTER;
-              framepointer.number:=NR_FRAME_POINTER_REG;
-           end;
       end;
 
 
@@ -151,9 +142,6 @@ implementation
 
          { free list of .o files }
          SmartLinkOFiles.Free;
-
-         { codegen }
-         voidprocpi.free;
       end;
 
 
@@ -264,7 +252,7 @@ implementation
           olddefaultsymtablestack,
           oldsymtablestack : tsymtable;
           oldaktprocsym    : tprocsym;
-          oldaktprocdef    : tprocdef;
+          oldcurrent_procdef    : tprocdef;
           oldoverloaded_operators : toverloaded_operators;
         { cg }
           oldparse_only  : boolean;
@@ -327,7 +315,7 @@ implementation
             oldsymtablestack:=symtablestack;
             olddefaultsymtablestack:=defaultsymtablestack;
             oldrefsymtable:=refsymtable;
-            oldaktprocdef:=aktprocdef;
+            oldcurrent_procdef:=current_procdef;
             oldaktdefproccall:=aktdefproccall;
             move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
           { save scanner state }
@@ -544,7 +532,7 @@ implementation
                  symtablestack:=oldsymtablestack;
                  defaultsymtablestack:=olddefaultsymtablestack;
                  aktdefproccall:=oldaktdefproccall;
-                 aktprocdef:=oldaktprocdef;
+                 current_procdef:=oldcurrent_procdef;
                  move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
                  aktsourcecodepage:=oldsourcecodepage;
                  aktlocalswitches:=oldaktlocalswitches;
@@ -634,8 +622,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.52  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.51  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 18 - 9
compiler/pass_2.pas

@@ -278,36 +278,45 @@ implementation
            begin
               { assign parameter locations }
 {$ifndef i386}
-              setparalocs(procinfo.procdef);
+              setparalocs(current_procinfo.procdef);
 {$endif i386}
 
-              procinfo.after_pass1;
+              current_procinfo.after_pass1;
 
               { process register variable stuff (JM) }
               assign_regvars(p);
-              load_regvars(procinfo.aktentrycode,p);
+              load_regvars(current_procinfo.aktentrycode,p);
 
               { for the i386 it must be done in genexitcode because it has  }
               { to add 'fstp' instructions when using fpu regvars and those }
               { must come after the "exitlabel" (JM)                        }
 {$ifndef i386}
-              cleanup_regvars(procinfo.aktexitcode);
+              cleanup_regvars(current_procinfo.aktexitcode);
 {$endif i386}
 
               do_secondpass(p);
 
-              if assigned(procinfo.procdef) then
-                procinfo.procdef.fpu_used:=p.registersfpu;
+              if assigned(current_procinfo.procdef) then
+                current_procinfo.procdef.fpu_used:=p.registersfpu;
 
            end;
-         procinfo.aktproccode.concatlist(exprasmlist);
+         current_procinfo.aktproccode.concatlist(exprasmlist);
       end;
 
 end.
 {
   $Log$
-  Revision 1.48  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.49  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.48  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/pdecl.pas

@@ -633,8 +633,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.66  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.67  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.66  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 18 - 9
compiler/pdecobj.pas

@@ -52,7 +52,7 @@ implementation
       { Please leave this here, this module should NOT use
         these variables.
         Declaring it as string here results in an error when compiling (PFV) }
-      aktprocdef = 'error';
+      current_procdef = 'error';
 
 
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
@@ -571,7 +571,7 @@ implementation
          pcrd       : tclassrefdef;
          tt     : ttype;
          old_object_option : tsymoptions;
-         oldprocinfo : tprocinfo;
+         old_current_procinfo : tprocinfo;
          oldparse_only : boolean;
          storetypecanbeforward : boolean;
 
@@ -946,9 +946,9 @@ implementation
          testcurobject:=1;
          curobjectname:=Upper(n);
 
-         { new procinfo }
-         oldprocinfo:=procinfo;
-         procinfo:=cprocinfo.create;
+         { temp procinfo }
+         old_current_procinfo:=current_procinfo;
+         current_procinfo:=cprocinfo.create(nil);
 
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
@@ -1134,8 +1134,8 @@ implementation
          symtablestack:=symtablestack.next;
          aktobjectdef:=nil;
          {Restore procinfo}
-         procinfo.free;
-         procinfo:=oldprocinfo;
+         current_procinfo.free;
+         current_procinfo:=old_current_procinfo;
          current_object_option:=old_object_option;
 
          object_dec:=aktclass;
@@ -1144,8 +1144,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.62  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.63  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.62  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 15 - 14
compiler/pdecsub.pas

@@ -93,7 +93,7 @@ implementation
       { Please leave this here, this module should NOT use
         these variables.
         Declaring it as string here results in an error when compiling (PFV) }
-      aktprocdef = 'error';
+      current_procdef = 'error';
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
@@ -285,7 +285,6 @@ implementation
              CGMessage(parser_e_self_call_by_value);
            if (pd.deftype=procdef) then
             begin
-              inc(procinfo.selfpointer_offset,tvarsym(hpara.parasym).address);
               if compare_defs(hpara.paratype.def,tprocdef(pd)._class,nothingn)=te_incompatible then
                 CGMessage2(type_e_incompatible_types,hpara.paratype.def.typename,tprocdef(pd)._class.typename);
             end;
@@ -563,7 +562,7 @@ implementation
               aprocsym:=tprocsym(aclass.symtable.search(sp));
               { The procedure has been found. So it is
                 a global one. Set the flags to mark this.}
-              procinfo.flags:=procinfo.flags or pi_is_global;
+              include(current_procinfo.flags,pi_is_global);
               { we solve this below }
               if assigned(aprocsym) then
                begin
@@ -674,7 +673,7 @@ implementation
            { Set global flag when found in globalsytmable }
            if (not parse_only) and
               (aprocsym.owner.symtabletype=globalsymtable) then
-             procinfo.flags:=procinfo.flags or pi_is_global;
+             include(current_procinfo.flags,pi_is_global);
          end;
 
         { to get the correct symtablelevel we must ignore objectsymtables }
@@ -742,7 +741,7 @@ implementation
                  pd.test_if_fpu_result;
                  if (pd.rettype.def.deftype=stringdef) and
                     (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
-                   procinfo.no_fast_exit:=true;
+                   include(current_procinfo.flags,pi_needs_implicit_finally);
                  dec(testcurobject);
                end;
               if isclassmethod then
@@ -784,7 +783,6 @@ implementation
               consume(_OPERATOR);
               if (token in [first_overloaded..last_overloaded]) then
                begin
-                 procinfo.flags:=procinfo.flags or pi_operator;
                  optoken:=token;
                end
               else
@@ -865,7 +863,6 @@ begin
   if target_info.system in [system_i386_os2,system_i386_emx] then
    begin
      tprocdef(pd).aliasnames.insert(tprocdef(pd).procsym.realname);
-     procinfo.exported:=true;
      if cs_link_deffile in aktglobalswitches then
        deffile.AddExport(tprocdef(pd).mangledname);
    end;
@@ -1867,11 +1864,6 @@ const
         po_comp : tprocoptions;
         aprocsym : tprocsym;
       begin
-        { check if the addresses in parasymtable are calculated }
-        if (pd.para.count>0) and
-           (pd.parast.datasize=0) then
-          internalerror(200304254);
-
         forwardfound:=false;
         aprocsym:=tprocsym(pd.procsym);
 
@@ -2131,8 +2123,17 @@ const
 end.
 {
   $Log$
-  Revision 1.118  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.119  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.118  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 30 - 20
compiler/pexpr.pas

@@ -289,7 +289,7 @@ implementation
                     consume(_RKLAMMER);
                     if (block_type=bt_except) then
                       Message(parser_e_exit_with_argument_not__possible);
-                    if is_void(aktprocdef.rettype.def) then
+                    if is_void(current_procdef.rettype.def) then
                       Message(parser_e_void_function);
                  end
                else
@@ -1075,8 +1075,8 @@ implementation
                       also has objectsymtable. And withsymtable is
                       not possible for self in class methods (PFV) }
                     if (srsymtable.symtabletype=objectsymtable) and
-                       assigned(aktprocdef) and
-                       (po_classmethod in aktprocdef.procoptions) then
+                       assigned(current_procdef) and
+                       (po_classmethod in current_procdef.procoptions) then
                       Message(parser_e_only_class_methods);
                     if (sp_static in srsym.symoptions) then
                      begin
@@ -1124,11 +1124,11 @@ implementation
                            is_object(htype.def) then
                          begin
                            consume(_POINT);
-                           if assigned(procinfo) and
-                              assigned(procinfo.procdef._class) and
+                           if assigned(current_procdef) and
+                              assigned(current_procdef._class) and
                               not(getaddr) then
                             begin
-                              if procinfo.procdef._class.is_related(tobjectdef(htype.def)) then
+                              if current_procdef._class.is_related(tobjectdef(htype.def)) then
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
@@ -1262,8 +1262,8 @@ implementation
                     { are we in a class method ? }
                     possible_error:=(srsym.owner.symtabletype=objectsymtable) and
                                     not(is_interface(tdef(srsym.owner.defowner))) and
-                                    assigned(aktprocdef) and
-                                    (po_classmethod in aktprocdef.procoptions);
+                                    assigned(current_procdef) and
+                                    (po_classmethod in current_procdef.procoptions);
                     do_proc_call(srsym,srsymtable,
                                  (getaddr and not(token in [_CARET,_POINT])),
                                  again,p1);
@@ -1281,8 +1281,8 @@ implementation
                     { access to property in a method }
                     { are we in a class method ? }
                     if (srsym.owner.symtabletype=objectsymtable) and
-                       assigned(aktprocdef) and
-                       (po_classmethod in aktprocdef.procoptions) then
+                       assigned(current_procdef) and
+                       (po_classmethod in current_procdef.procoptions) then
                      Message(parser_e_only_class_methods);
                     { no method pointer }
                     p1:=nil;
@@ -1729,7 +1729,8 @@ implementation
              begin
                again:=true;
                consume(_SELF);
-               if not assigned(procinfo.procdef._class) then
+               if not(assigned(current_procdef) and
+                      assigned(current_procdef._class)) then
                 begin
                   p1:=cerrornode.create;
                   again:=false;
@@ -1737,14 +1738,14 @@ implementation
                 end
                else
                 begin
-                  if (po_classmethod in aktprocdef.procoptions) then
+                  if (po_classmethod in current_procdef.procoptions) then
                    begin
                      { self in class methods is a class reference type }
-                     htype.setdef(procinfo.procdef._class);
+                     htype.setdef(current_procdef._class);
                      p1:=cselfnode.create(tclassrefdef.create(htype));
                    end
                   else
-                   p1:=cselfnode.create(procinfo.procdef._class);
+                   p1:=cselfnode.create(current_procdef._class);
                   postfixoperators(p1,again);
                 end;
              end;
@@ -1753,18 +1754,18 @@ implementation
              begin
                again:=true;
                consume(_INHERITED);
-               if assigned(aktprocdef._class) then
+               if assigned(current_procdef._class) then
                 begin
-                  classh:=aktprocdef._class.childof;
+                  classh:=current_procdef._class.childof;
                   { if inherited; only then we need the method with
                     the same name }
                   if token in endtokens then
                    begin
-                     hs:=aktprocdef.procsym.name;
+                     hs:=current_procdef.procsym.name;
                      anon_inherited:=true;
                      { For message methods we need to search using the message
                        number or string }
-                     pd:=tprocsym(aktprocdef.procsym).first_procdef;
+                     pd:=tprocsym(current_procdef.procsym).first_procdef;
                      if (po_msgint in pd.procoptions) then
                       sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
                      else
@@ -2313,8 +2314,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.112  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.113  2003-04-27 11:21:33  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.112  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 57 - 47
compiler/pmodules.pas

@@ -491,7 +491,7 @@ implementation
          oldprocdef : tprocdef;
          unitsym : tunitsym;
       begin
-         oldprocdef:=aktprocdef;
+         oldprocdef:=current_procdef;
          consume(_USES);
 {$ifdef DEBUG}
          test_symtablestack;
@@ -614,7 +614,7 @@ implementation
                 end;
               pu:=tused_unit(pu.next);
            end;
-          aktprocdef:=oldprocdef;
+          current_procdef:=oldprocdef;
       end;
 
 
@@ -707,12 +707,15 @@ implementation
       end;
 
 
-    function gen_main_procsym(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
+    function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
       var
         stt : tsymtable;
         ps  : tprocsym;
         pd  : tprocdef;
       begin
+        { there should be no current_procinfo available }
+        if assigned(current_procinfo) then
+         internalerror(200304275);
         {Generate a procsym for main}
         make_ref:=false;
         { try to insert in in static symtable ! }
@@ -737,7 +740,29 @@ implementation
           symtable }
         pd.localst.free;
         pd.localst:=st;
-        gen_main_procsym:=pd;
+        { set procinfo and current_procdef }
+        current_procinfo:=cprocinfo.create(nil);
+        current_module.procinfo:=current_procinfo;
+        current_procinfo.procdef:=pd;
+        current_procdef:=pd;
+        { return procdef }
+        create_main_proc:=pd;
+      end;
+
+
+    procedure release_main_proc(pd:tprocdef);
+      begin
+        { this is a main proc, so there should be no parent }
+        if not(assigned(current_procinfo)) or
+           assigned(current_procinfo.parent) or
+           not(current_procinfo.procdef=pd) then
+         internalerror(200304276);
+        { remove procinfo }
+        current_module.procinfo:=nil;
+        current_procinfo.free;
+        current_procinfo:=nil;
+        { remove localst as it was replaced by staticsymtable }
+        pd.localst:=nil;
       end;
 
 
@@ -745,16 +770,10 @@ implementation
       var
         parasize : longint;
         nostackframe : boolean;
-        pd,
-        oldprocdef : tprocdef;
-        oldprocinfo : tprocinfo;
+        pd : tprocdef;
         oldexitlabel,
         oldexit2label : tasmlabel;
       begin
-        oldprocinfo:=procinfo;
-        oldprocdef:=aktprocdef;
-        oldexitlabel:=aktexitlabel;
-        oldexit2label:=aktexit2label;
         { update module flags }
         current_module.flags:=current_module.flags or flag;
         { now we can insert a cut }
@@ -764,23 +783,22 @@ implementation
         case flag of
           uf_init :
             begin
-              pd:=gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
+              pd:=create_main_proc(current_module.modulename^+'_init_implicit',potype_unitinit,st);
               pd.aliasnames.insert('INIT$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
             end;
           uf_finalize :
             begin
-              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd:=create_main_proc(current_module.modulename^+'_finalize_implicit',potype_unitfinalize,st);
               pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
             end;
           else
             internalerror(200304253);
         end;
-        { set procinfo and aktprocdef }
-        procinfo:=voidprocpi;
-        procinfo.procdef:=pd;
-        aktprocdef:=pd;
+        { save labels }
+        oldexitlabel:=aktexitlabel;
+        oldexit2label:=aktexit2label;
         { generate a dummy function }
         parasize:=0;
         nostackframe:=false;
@@ -789,14 +807,10 @@ implementation
         genentrycode(list,true,0,parasize,nostackframe,false);
         genexitcode(list,parasize,nostackframe,false);
         list.convert_registers;
-        { cleanup }
-        pd.localst:=nil;
-        procinfo.procdef:=nil;
+        release_main_proc(pd);
         { restore }
         aktexitlabel:=oldexitlabel;
         aktexit2label:=oldexit2label;
-        aktprocdef:=oldprocdef;
-        procinfo:=oldprocinfo;
       end;
 
 
@@ -1029,15 +1043,11 @@ implementation
 //         Message1(parser_u_parsing_implementation,current_module.modulename^);
 
          { Compile the unit }
-         pd:=gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
+         pd:=create_main_proc(current_module.modulename^+'_init',potype_unitinit,st);
          pd.aliasnames.insert('INIT$$'+current_module.modulename^);
          pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
-         procinfo:=voidprocpi;
-         procinfo.procdef:=pd;
          compile_proc_body(pd,true,false);
-         procinfo.procdef:=nil;
-         { avoid self recursive destructor call }
-         pd.localst:=nil;
+         release_main_proc(pd);
 
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
@@ -1058,14 +1068,11 @@ implementation
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              procinfo:=voidprocpi;
-              procinfo.procdef:=pd;
               compile_proc_body(pd,true,false);
-              procinfo.procdef:=nil;
-              pd.localst:=nil;
+              release_main_proc(pd);
            end
          else if force_init_final then
            begin
@@ -1333,7 +1340,7 @@ implementation
            from the bootstrap code.}
          if islibrary then
           begin
-            pd:=gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
+            pd:=create_main_proc(current_module.modulename^+'_main',potype_proginit,st);
             pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
             { Win32 startup code needs a single name }
 //            if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
@@ -1344,23 +1351,19 @@ implementation
           end
          else
           begin
-            pd:=gen_main_procsym('main',potype_proginit,st);
+            pd:=create_main_proc('main',potype_proginit,st);
             pd.aliasnames.insert('program_init');
             pd.aliasnames.insert('PASCALMAIN');
             pd.aliasnames.insert(target_info.cprefix+'main');
           end;
-         procinfo:=voidprocpi;
-         procinfo.procdef:=pd;
 {$IFDEF SPARC}
-         ProcInfo.After_Header;
+         current_procinfo.After_Header;
 {main function is declared as
   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);
-         procinfo.procdef:=nil;
-         { remove localst, it's not needed anymore }
-         pd.localst:=nil;
+         release_main_proc(pd);
 
          { should we force unit initialization? }
          if tstaticsymtable(current_module.localsymtable).needs_init_final then
@@ -1395,13 +1398,11 @@ So, all parameters are passerd into registers in sparc architecture.}
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd:=create_main_proc(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              procinfo:=voidprocpi;
-              procinfo.procdef:=pd;
               compile_proc_body(pd,true,false);
-              procinfo.procdef:=nil;
+              release_main_proc(pd);
            end;
 
          { consume the last point }
@@ -1492,8 +1493,17 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 {
   $Log$
-  Revision 1.102  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.103  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.102  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 34 - 25
compiler/powerpc/cgcpu.pas

@@ -253,7 +253,7 @@ const
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          if target_info.system=system_powerpc_macos then
            list.concat(taicpu.op_none(A_NOP));
-         procinfo.flags:=procinfo.flags or pi_do_call;
+         include(current_procinfo.flags,pi_do_call);
       end;
 
     { calling a procedure by address }
@@ -284,7 +284,7 @@ const
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
-        procinfo.flags:=procinfo.flags or pi_do_call;
+        include(current_procinfo.flags,pi_do_call);
         //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
       end;
 
@@ -316,7 +316,7 @@ const
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
-        procinfo.flags:=procinfo.flags or pi_do_call;
+        include(current_procinfo.flags,pi_do_call);
         //list.concat(tai_comment.create(strpnew('***** a_call_ref')));
       end;
 
@@ -966,7 +966,7 @@ const
         r.number:=NR_R0;
         a_reg_alloc(list,r);
 
-        if aktprocdef.parast.symtablelevel>1 then
+        if current_procdef.parast.symtablelevel>1 then
           begin
              r.enum:=R_INTREGISTER;
              r.number:=NR_R11;
@@ -981,7 +981,7 @@ const
           end;
 
         usesfpr:=false;
-        if not (po_assembler in aktprocdef.procoptions) then
+        if not (po_assembler in current_procdef.procoptions) then
           for regcounter.enum:=R_F14 to R_F31 do
             if regcounter.enum in rg.usedbyproc then
               begin
@@ -991,7 +991,7 @@ const
               end;
 
         usesgpr:=false;
-        if not (po_assembler in aktprocdef.procoptions) then
+        if not (po_assembler in current_procdef.procoptions) then
           for regcounter2:=RS_R14 to RS_R31 do
             begin
               if regcounter2 in rg.usedintbyproc then
@@ -1004,8 +1004,8 @@ const
             end;
 
         { save link register? }
-        if not (po_assembler in aktprocdef.procoptions) then
-          if (procinfo.flags and pi_do_call)<>0 then
+        if not (po_assembler in current_procdef.procoptions) then
+          if (pi_do_call in current_procinfo.flags) then
             begin
                { save return address... }
                r.enum:=R_INTREGISTER;
@@ -1039,7 +1039,7 @@ const
 
         localsize:=align(localsize,16);
 
-        tppcprocinfo(procinfo).localsize:=localsize;
+        tppcprocinfo(current_procinfo).localsize:=localsize;
 
         if (localsize <> 0) then
           begin
@@ -1124,11 +1124,11 @@ const
         { now comes the AltiVec context save, not yet implemented !!! }
 
         { if we're in a nested procedure, we've to save R11 }
-        if aktprocdef.parast.symtablelevel>2 then
+        if current_procdef.parast.symtablelevel>2 then
           begin
              r.enum:=R_INTREGISTER;
              r.number:=NR_R11;
-             reference_reset_base(href,rsp,procinfo.framepointer_offset);
+             reference_reset_base(href,rsp,current_procinfo.framepointer_offset);
              list.concat(taicpu.op_reg_ref(A_STW,r,href));
           end;
       end;
@@ -1153,7 +1153,7 @@ const
         { AltiVec context restore, not yet implemented !!! }
 
         usesfpr:=false;
-        if not (po_assembler in aktprocdef.procoptions) then
+        if not (po_assembler in current_procdef.procoptions) then
           for regcounter.enum:=R_F14 to R_F31 do
             if regcounter.enum in rg.usedbyproc then
               begin
@@ -1163,7 +1163,7 @@ const
               end;
 
         usesgpr:=false;
-        if not (po_assembler in aktprocdef.procoptions) then
+        if not (po_assembler in current_procdef.procoptions) then
           for regcounter2:=RS_R14 to RS_R30 do
             begin
               if regcounter2 in rg.usedintbyproc then
@@ -1185,9 +1185,9 @@ const
              r2.enum:=R_INTREGISTER;
              r2.number:=NR_R12;
              if usesfpr then
-               a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(procinfo).localsize-(ord(R_F31)-ord(firstregfpu.enum)+1)*8,r,r2)
+               a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(current_procinfo).localsize-(ord(R_F31)-ord(firstregfpu.enum)+1)*8,r,r2)
              else
-               a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(procinfo).localsize,r,r2);
+               a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(current_procinfo).localsize,r,r2);
 
              { restore gprs }
              { at least for now we use LMW }
@@ -1206,7 +1206,7 @@ const
              r.number:=NR_R12;
              list.concat(taicpu.op_reg_reg_const(A_ADDI,r,r,(ord(R_F31)-ord(firstregfpu.enum)+1)*8));
              {
-             if (procinfo.flags and pi_do_call)<>0 then
+             if (pi_do_call in current_procinfo.flags) then
                a_call_name(objectlibrary.newasmsymbol('_restfpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+
                  '_x')
              else
@@ -1222,10 +1222,10 @@ const
              { adjust r1 }
              r.enum:=R_INTREGISTER;
              r.number:=NR_R1;
-             a_op_const_reg(list,OP_ADD,tppcprocinfo(procinfo).localsize,r);
+             a_op_const_reg(list,OP_ADD,tppcprocinfo(current_procinfo).localsize,r);
              { load link register? }
-             if not (po_assembler in aktprocdef.procoptions) then
-               if (procinfo.flags and pi_do_call)<>0 then
+             if not (po_assembler in current_procdef.procoptions) then
+               if (pi_do_call in current_procinfo.flags) then
                  begin
                     r.enum:=R_INTREGISTER;
                     r.number:=NR_STACK_POINTER_REG;
@@ -1253,7 +1253,7 @@ const
 
     begin
       usesfpr:=false;
-      if not (po_assembler in aktprocdef.procoptions) then
+      if not (po_assembler in current_procdef.procoptions) then
         for regcounter.enum:=R_F14 to R_F31 do
           if regcounter.enum in rg.usedbyproc then
             begin
@@ -1263,7 +1263,7 @@ const
             end;
 
       usesgpr:=false;
-      if not (po_assembler in aktprocdef.procoptions) then
+      if not (po_assembler in current_procdef.procoptions) then
         for regcounter2:=RS_R13 to RS_R31 do
           begin
             if regcounter2 in rg.usedintbyproc then
@@ -1332,7 +1332,7 @@ const
 
     begin
       usesfpr:=false;
-      if not (po_assembler in aktprocdef.procoptions) then
+      if not (po_assembler in current_procdef.procoptions) then
         for regcounter.enum:=R_F14 to R_F31 do
           if regcounter.enum in rg.usedbyproc then
             begin
@@ -1342,7 +1342,7 @@ const
             end;
 
       usesgpr:=false;
-      if not (po_assembler in aktprocdef.procoptions) then
+      if not (po_assembler in current_procdef.procoptions) then
         for regcounter2:=RS_R13 to RS_R31 do
           begin
             if regcounter2 in rg.usedintbyproc then
@@ -1480,7 +1480,7 @@ const
         localsize:= align(localsize + macosLinkageAreaSize + registerSaveAreaSize, 16);
         inc(localsize,tg.lasttemp);
         localsize:=align(localsize,16);
-        tppcprocinfo(procinfo).localsize:=localsize;
+        tppcprocinfo(current_procinfo).localsize:=localsize;
 
         if (localsize <> 0) then
           begin
@@ -2364,7 +2364,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.85  2003-04-26 22:56:11  jonas
+  Revision 1.86  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.85  2003/04/26 22:56:11  jonas
     * fix to a_op64_const_reg_reg
 
   Revision 1.84  2003/04/26 16:08:41  jonas

+ 23 - 14
compiler/powerpc/cpupi.pas

@@ -40,7 +40,7 @@ unit cpupi;
           { max. of space need for parameters, currently used by the PowerPC port only }
           maxpushedparasize : aword;
 
-          constructor create;override;
+          constructor create(aparent:tprocinfo);override;
           procedure after_header;override;
           procedure after_pass1;override;
        end;
@@ -55,10 +55,10 @@ unit cpupi;
        tgobj,
        symconst, symsym,paramgr;
 
-    constructor tppcprocinfo.create;
+    constructor tppcprocinfo.create(aparent:tprocinfo);
 
       begin
-         inherited create;
+         inherited create(aparent);
          maxpushedparasize:=0;
          localsize:=0;
       end;
@@ -78,33 +78,33 @@ unit cpupi;
            begin
              ofs:=align(maxpushedparasize+LinkageAreaSize,16);
              inc(procdef.parast.address_fixup,ofs);
-             inc(procinfo.framepointer_offset,ofs);
-             inc(procinfo.selfpointer_offset,ofs);
+             inc(framepointer_offset,ofs);
+             inc(selfpointer_offset,ofs);
              if cs_asm_source in aktglobalswitches then
                aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
 
 //             Already done with an "inc" above now, not sure if it's correct (JM)
              procdef.localst.address_fixup:=procdef.parast.address_fixup+procdef.parast.datasize;
-             if assigned(procinfo.procdef.funcretsym) then
-               procinfo.return_offset:=tvarsym(procinfo.procdef.funcretsym).address+tvarsym(procinfo.procdef.funcretsym).owner.address_fixup;
+             if assigned(procdef.funcretsym) then
+               return_offset:=tvarsym(procdef.funcretsym).address+tvarsym(procdef.funcretsym).owner.address_fixup;
 
 {
              Already done with an "inc" above, should be correct (JM)
              if assigned(procdef.funcretsym) and
                not(paramanager.ret_in_param(procdef.rettype.def,procdef.proccalloption)) then
-               procinfo.return_offset:=tg.direction*tfuncretsym(procdef.funcretsym).address+procdef.localst.address_fixup;
+               return_offset:=tg.direction*tfuncretsym(procdef.funcretsym).address+procdef.localst.address_fixup;
 }
 
              if cs_asm_source in aktglobalswitches then
                aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
 
-             procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
+             firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
              if cs_asm_source in aktglobalswitches then
-               aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(procinfo.firsttemp_offset))));
+               aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(firsttemp_offset))));
 
-             //!!!! tg.setfirsttemp(procinfo.firsttemp_offset);
-             tg.firsttemp:=procinfo.firsttemp_offset;
-             tg.lasttemp:=procinfo.firsttemp_offset;
+             //!!!! tg.setfirsttemp(firsttemp_offset);
+             tg.firsttemp:=firsttemp_offset;
+             tg.lasttemp:=firsttemp_offset;
            end;
       end;
 
@@ -113,7 +113,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2003-04-27 07:48:05  peter
+  Revision 1.12  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.11  2003/04/27 07:48:05  peter
     * updated for removed lexlevel
 
   Revision 1.10  2003/04/26 11:31:00  florian

+ 20 - 11
compiler/powerpc/nppccal.pas

@@ -62,8 +62,8 @@ implementation
          exit;
        if procdefinition is tprocdef then
          begin
-            if tprocdef(procdefinition).parast.datasize>tppcprocinfo(procinfo).maxpushedparasize then
-              tppcprocinfo(procinfo).maxpushedparasize:=tprocdef(procdefinition).parast.datasize
+            if tprocdef(procdefinition).parast.datasize>tppcprocinfo(current_procinfo).maxpushedparasize then
+              tppcprocinfo(current_procinfo).maxpushedparasize:=tprocdef(procdefinition).parast.datasize
          end
        else
          begin
@@ -77,36 +77,36 @@ implementation
        hregister1,hregister2 : tregister;
        i : longint;
     begin
-       if aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
+       if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
          begin
             { pass the same framepointer as the current procedure got }
             hregister2.enum:=R_INTREGISTER;
             hregister2.number:=NR_R11;
-            cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,procinfo.framepointer,hregister2);
+            cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,current_procinfo.framepointer,hregister2);
             { it must be adjusted! }
          end
          { this is only true if the difference is one !!
            but it cannot be more !! }
-       else if (aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
+       else if (current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
          begin
             { pass the same framepointer as the current procedure got }
             hregister1.enum:=R_INTREGISTER;
             hregister1.number:=NR_R1;
             hregister2.enum:=R_INTREGISTER;
             hregister2.number:=NR_R11;
-            exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDI,hregister2,hregister1,procinfo.procdef.localst.address_fixup));
+            exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDI,hregister2,hregister1,current_procinfo.procdef.localst.address_fixup));
          end
-       else if (aktprocdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+       else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
          begin
             hregister1:=rg.getregisterint(exprasmlist,OS_ADDR);
-            reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
+            reference_reset_base(href,current_procinfo.framepointer,current_procinfo.framepointer_offset);
             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
-            i:=aktprocdef.parast.symtablelevel;
+            i:=current_procdef.parast.symtablelevel;
             while (i>tprocdef(procdefinition).parast.symtablelevel) do
               begin
                  {we should get the correct frame_pointer_offset at each level
                  how can we do this !!! }
-                 reference_reset_base(href,hregister2,procinfo.framepointer_offset);
+                 reference_reset_base(href,hregister2,current_procinfo.framepointer_offset);
                  cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
                  dec(i);
               end;
@@ -123,7 +123,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2003-04-27 10:41:47  florian
+  Revision 1.10  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.9  2003/04/27 10:41:47  florian
     * fixed nested procedures to get them working as before
 
   Revision 1.8  2003/04/27 07:48:05  peter

+ 27 - 18
compiler/powerpc/radirect.pas

@@ -96,20 +96,20 @@ interface
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
+           if assigned(current_procdef.funcretsym) and
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
          end;
 
      begin
        ende:=false;
        s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+       if assigned(current_procdef.funcretsym) and
+          is_fpu(current_procdef.rettype.def) then
+         tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
        { !!!!!
-       if (not is_void(aktprocdef.rettype.def)) then
+       if (not is_void(current_procdef.rettype.def)) then
          retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
        else
        }
@@ -155,7 +155,7 @@ interface
                            end
                          else
                            { access to local variables }
-                           if assigned(aktprocdef) then
+                           if assigned(current_procdef) then
                              begin
                                 { I don't know yet, what the ppc port requires }
                                 { we'll see how things settle down             }
@@ -164,16 +164,16 @@ interface
                                 { char ?                                   }
                                 { !!!
                                 if (s[length(s)]='%') and
-                                   ret_in_acc(aktprocdef.rettype.def) and
+                                   ret_in_acc(current_procdef.rettype.def) and
                                    ((pos('AX',upper(hs))>0) or
                                    (pos('AL',upper(hs))>0)) then
-                                  tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                                  tfuncretsym(current_procdef.funcretsym).funcretstate:=vs_assigned;
                                 }
                                 if ((s[length(s)]<>'0') or (hs[1]<>'x')) and not(is_register(hs)) then
                                   begin
-                                     if assigned(aktprocdef.localst) and
-                                        (aktprocdef.localst.symtablelevel >= normal_function_level) then
-                                       sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                     if assigned(current_procdef.localst) and
+                                        (current_procdef.localst.symtablelevel >= normal_function_level) then
+                                       sym:=tsym(current_procdef.localst.search(upper(hs)))
                                      else
                                        sym:=nil;
                                      if assigned(sym) then
@@ -205,8 +205,8 @@ interface
                                        end
                                      else
                                        begin
-                                          if assigned(aktprocdef.parast) then
-                                            sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                          if assigned(current_procdef.parast) then
+                                            sym:=tsym(current_procdef.parast.search(upper(hs)))
                                           else
                                             sym:=nil;
                                           if assigned(sym) then
@@ -215,7 +215,7 @@ interface
                                                  begin
                                                     l:=tvarsym(sym).address;
                                                     { set offset }
-                                                    inc(l,aktprocdef.parast.address_fixup);
+                                                    inc(l,current_procdef.parast.address_fixup);
 //                                                    hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer.enum]+')';
                                                     hs:=tostr(l)+'('+gas_reg2str[STACK_POINTER_REG]+')';
                                                     if pos(',',s) > 0 then
@@ -281,7 +281,7 @@ interface
                                                  end
                                                else if upper(hs)='__RESULT' then
                                                  begin
-                                                    if (not is_void(aktprocdef.rettype.def)) then
+                                                    if (not is_void(current_procdef.rettype.def)) then
                                                       hs:=retstr
                                                     else
                                                       Message(asmr_e_void_function);
@@ -311,7 +311,7 @@ interface
               '{',';',#10,#13:
                 begin
                    if pos(retstr,s) > 0 then
-                     tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                     tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                    writeasmline;
                    c:=current_scanner.asmgetchar;
                 end;
@@ -347,7 +347,16 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2003-04-27 07:48:05  peter
+  Revision 1.13  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.12  2003/04/27 07:48:05  peter
     * updated for removed lexlevel
 
   Revision 1.11  2003/04/25 21:05:22  florian

+ 37 - 28
compiler/pstatmnt.pas

@@ -404,7 +404,7 @@ implementation
                    symtab:=twithsymtable.Create(obj,obj.symtable.symsearch);
                    withsymtable:=symtab;
                    if (p.nodetype=loadn) and
-                      (tloadnode(p).symtable=aktprocdef.localst) then
+                      (tloadnode(p).symtable=current_procdef.localst) then
                      twithsymtable(symtab).direct_with:=true;
                    twithsymtable(symtab).withrefnode:=p;
                    levelcount:=1;
@@ -414,7 +414,7 @@ implementation
                       symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
                       symtab:=symtab.next;
                       if (p.nodetype=loadn) and
-                         (tloadnode(p).symtable=aktprocdef.localst) then
+                         (tloadnode(p).symtable=current_procdef.localst) then
                         twithsymtable(symtab).direct_with:=true;
                       twithsymtable(symtab).withrefnode:=p;
                       obj:=obj.childof;
@@ -429,7 +429,7 @@ implementation
                    levelcount:=1;
                    withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
                    if (p.nodetype=loadn) and
-                      (tloadnode(p).symtable=aktprocdef.localst) then
+                      (tloadnode(p).symtable=current_procdef.localst) then
                    twithsymtable(withsymtable).direct_with:=true;
                    twithsymtable(withsymtable).withrefnode:=p;
                    withsymtable.next:=symtablestack;
@@ -528,7 +528,7 @@ implementation
          oldaktexceptblock: integer;
 
       begin
-         procinfo.flags:=procinfo.flags or pi_uses_exceptions;
+         include(current_procinfo.flags,pi_uses_exceptions);
 
          p_default:=nil;
          p_specific:=nil;
@@ -739,11 +739,11 @@ implementation
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocdef.proccalloption=pocall_inline) then
+               if (current_procdef.proccalloption=pocall_inline) then
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
-                    aktprocdef.proccalloption:=pocall_fpccall;
+                    current_procdef.proccalloption:=pocall_fpccall;
                  End;
                asmstat:=tasmnode(radirect.assemble);
              end;
@@ -878,7 +878,7 @@ implementation
              code:=cnothingnode.create;
            _FAIL :
              begin
-                if (aktprocdef.proctypeoption<>potype_constructor) then
+                if (current_procdef.proctypeoption<>potype_constructor) then
                   Message(parser_e_fail_only_in_constructor);
                 consume(_FAIL);
                 code:=cfailnode.create;
@@ -1014,15 +1014,15 @@ implementation
         i : longint;
       begin
         { replace framepointer with stackpointer }
-        procinfo.framepointer.enum:=R_INTREGISTER;
-        procinfo.framepointer.number:=NR_STACK_POINTER_REG;
+        current_procinfo.framepointer.enum:=R_INTREGISTER;
+        current_procinfo.framepointer.number:=NR_STACK_POINTER_REG;
         { set the right value for parameters }
-        dec(aktprocdef.parast.address_fixup,pointer_size);
+        dec(current_procdef.parast.address_fixup,pointer_size);
         { replace all references to parameters in the instructions,
           the parameters can be identified by the parafixup option
           that is set. For normal user coded [ebp+4] this field is not
           set }
-        parafixup:=aktprocdef.parast.address_fixup;
+        parafixup:=current_procdef.parast.address_fixup;
         hp:=tai(p.p_asm.first);
         while assigned(hp) do
          begin
@@ -1073,13 +1073,13 @@ implementation
         p : tnode;
       begin
          { Rename the funcret so that recursive calls are possible }
-         if not is_void(aktprocdef.rettype.def) then
-           symtablestack.rename(aktprocdef.resultname,'$hiddenresult');
+         if not is_void(current_procdef.rettype.def) then
+           symtablestack.rename(current_procdef.resultname,'$hiddenresult');
 
          { force the asm statement }
          if token<>_ASM then
            consume(_ASM);
-         procinfo.Flags := procinfo.Flags Or pi_is_assembler;
+         include(current_procinfo.flags,pi_is_assembler);
          p:=_asm_statement;
 
          { set the framepointer to esp for assembler functions when the
@@ -1091,20 +1091,20 @@ implementation
            - target processor has optional frame pointer save
              (vm, i386, vm only currently)
          }
-         if (po_assembler in aktprocdef.procoptions) and
+         if (po_assembler in current_procdef.procoptions) and
 {$ifndef powerpc}
             { is this really necessary??? }
-            (aktprocdef.parast.datasize=0) and
+            (current_procdef.parast.datasize=0) and
 {$endif powerpc}
-            (aktprocdef.localst.datasize=aktprocdef.rettype.def.size) and
-            (aktprocdef.owner.symtabletype<>objectsymtable) and
-            (not assigned(aktprocdef.funcretsym) or
-             (tvarsym(aktprocdef.funcretsym).refcount<=1)) and
-            not(paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
+            (current_procdef.localst.datasize=current_procdef.rettype.def.size) and
+            (current_procdef.owner.symtabletype<>objectsymtable) and
+            (not assigned(current_procdef.funcretsym) or
+             (tvarsym(current_procdef.funcretsym).refcount<=1)) and
+            not(paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption)) then
             begin
                { we don't need to allocate space for the locals }
-               aktprocdef.localst.datasize:=0;
-               procinfo.firsttemp_offset:=0;
+               current_procdef.localst.datasize:=0;
+               current_procinfo.firsttemp_offset:=0;
                { only for cpus with different frame- and stack pointer the code must be changed }
                if (NR_STACK_POINTER_REG<>NR_FRAME_POINTER_REG)
 {$ifdef CHECKFORPUSH}
@@ -1117,9 +1117,9 @@ implementation
         { Flag the result as assigned when it is returned in a
           register.
         }
-        if assigned(aktprocdef.funcretsym) and
-           (not paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
-          tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+        if assigned(current_procdef.funcretsym) and
+           (not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption)) then
+          tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
 
         { because the END is already read we need to get the
           last_endtoken_filepos here (PFV) }
@@ -1131,8 +1131,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.93  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.94  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.93  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 107 - 104
compiler/psub.pas

@@ -111,15 +111,15 @@ implementation
          { parse const,types and vars }
          read_declarations(islibrary);
 
-         procinfo.handle_body_start;
+         current_procinfo.handle_body_start;
 
          { do we have an assembler block without the po_assembler?
            we should allow this for Delphi compatibility (PFV) }
          if (token=_ASM) and (m_delphi in aktmodeswitches) then
-          include(aktprocdef.procoptions,po_assembler);
+          include(current_procdef.procoptions,po_assembler);
 
          { Handle assembler block different }
-         if (po_assembler in aktprocdef.procoptions) then
+         if (po_assembler in current_procdef.procoptions) then
           begin
             block:=assembler_block;
             exit;
@@ -127,8 +127,8 @@ implementation
 
          {Unit initialization?.}
          if (
-             assigned(aktprocdef.localst) and
-             (aktprocdef.localst.symtablelevel=main_program_level) and
+             assigned(current_procdef.localst) and
+             (current_procdef.localst.symtablelevel=main_program_level) and
              (current_module.is_unit)
             ) or
             islibrary then
@@ -177,8 +177,6 @@ implementation
             end
          else
             begin
-               if current_module.is_unit then
-                 current_module.flags:=current_module.flags or uf_init;
                block:=statement_block(_BEGIN);
                if symtablestack.symtabletype=localsymtable then
                  symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}initializevars,block);
@@ -220,7 +218,7 @@ implementation
          end;
         writeln(printnodefile);
         writeln(printnodefile,'*******************************************************************************');
-        writeln(printnodefile,aktprocdef.fullprocname(false));
+        writeln(printnodefile,current_procdef.fullprocname(false));
         writeln(printnodefile,'*******************************************************************************');
         printnode(printnodefile,pd.code);
         close(printnodefile);
@@ -250,17 +248,17 @@ implementation
          exitpos   : tfileposinfo;
          oldprocdef : tprocdef;
       begin
-         oldprocdef:=aktprocdef;
-         aktprocdef:=pd;
+         oldprocdef:=current_procdef;
+         current_procdef:=pd;
 
          { calculate the lexical level }
-         if aktprocdef.parast.symtablelevel>maxnesting then
+         if current_procdef.parast.symtablelevel>maxnesting then
            Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
-         if (po_staticmethod in aktprocdef.procoptions) then
+         if (po_staticmethod in current_procdef.procoptions) then
            allow_only_static:=true
-         else if (aktprocdef.parast.symtablelevel=normal_function_level) then
+         else if (current_procdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
 
          { save old labels }
@@ -272,7 +270,7 @@ implementation
          objectlibrary.getlabel(aktexitlabel);
          objectlibrary.getlabel(aktexit2label);
          { exit for fail in constructors }
-         if (aktprocdef.proctypeoption=potype_constructor) then
+         if (current_procdef.proctypeoption=potype_constructor) then
            begin
              objectlibrary.getlabel(faillabel);
              objectlibrary.getlabel(quickexitlabel);
@@ -286,33 +284,33 @@ implementation
     {$endif state_tracking}
 
          { insert symtables for the class, but only if it is no nested function }
-         if assigned(aktprocdef._class) and not(parent_has_class) then
+         if assigned(current_procdef._class) and not(parent_has_class) then
            begin
              { insert them in the reverse order }
              hp:=nil;
              repeat
-               _class:=aktprocdef._class;
+               _class:=current_procdef._class;
                while _class.childof<>hp do
                  _class:=_class.childof;
                hp:=_class;
                _class.symtable.next:=symtablestack;
                symtablestack:=_class.symtable;
-             until hp=aktprocdef._class;
+             until hp=current_procdef._class;
            end;
 
          { insert parasymtable in symtablestack when parsing
            a function }
-         if aktprocdef.parast.symtablelevel>=normal_function_level then
+         if current_procdef.parast.symtablelevel>=normal_function_level then
            begin
-              aktprocdef.parast.next:=symtablestack;
-              symtablestack:=aktprocdef.parast;
+              current_procdef.parast.next:=symtablestack;
+              symtablestack:=current_procdef.parast;
            end;
          { create a local symbol table for this routine }
-         if not assigned(aktprocdef.localst) then
-            aktprocdef.insert_localst;
+         if not assigned(current_procdef.localst) then
+            current_procdef.insert_localst;
          { insert localsymtable in symtablestack}
-         aktprocdef.localst.next:=symtablestack;
-         symtablestack:=aktprocdef.localst;
+         current_procdef.localst.next:=symtablestack;
+         symtablestack:=current_procdef.localst;
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
 
@@ -330,10 +328,10 @@ implementation
          { store a copy of the original tree for inline, for
            normal procedures only store a reference to the
            current tree }
-         if (aktprocdef.proccalloption=pocall_inline) then
-           aktprocdef.code:=code.getcopy
+         if (current_procdef.proccalloption=pocall_inline) then
+           current_procdef.code:=code.getcopy
          else
-           aktprocdef.code:=code;
+           current_procdef.code:=code;
          { get a better entry point }
          if assigned(code) then
            entrypos:=code.fileinfo;
@@ -349,7 +347,7 @@ implementation
           code=nil, when we use aktprocsym.}
 
          { set the start offset to the start of the temp area in the stack }
-         tg.setfirsttemp(procinfo.firsttemp_offset);
+         tg.setfirsttemp(current_procinfo.firsttemp_offset);
 
          { ... and generate assembler }
          { but set the right switches for entry !! }
@@ -359,10 +357,10 @@ implementation
          if assigned(code) then
           begin
             { the procedure is now defined }
-            aktprocdef.forwarddef:=false;
+            current_procdef.forwarddef:=false;
 
             if paraprintnodetree=1 then
-              printnode_procdef(aktprocdef);
+              printnode_procdef(current_procdef);
 
             { only generate the code if no type errors are found, else
               finish at least the type checking pass }
@@ -373,10 +371,11 @@ implementation
                 { first generate entry code with the correct position and switches }
                 aktfilepos:=entrypos;
                 aktlocalswitches:=entryswitches;
-                genentrycode(procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
+                genentrycode(current_procinfo.aktentrycode,make_global,0,parasize,nostackframe,false);
 
                 { FPC_POPADDRSTACK destroys all registers (JM) }
-                if (procinfo.flags and (pi_needs_implicit_finally or pi_uses_exceptions)) <> 0 then
+                if (pi_needs_implicit_finally in current_procinfo.flags) or
+                   (pi_uses_exceptions in current_procinfo.flags) then
                  begin
                    rg.usedinproc := ALL_REGISTERS;
                  end;
@@ -384,13 +383,13 @@ implementation
                 { now generate exit code with the correct position and switches }
                 aktfilepos:=exitpos;
                 aktlocalswitches:=exitswitches;
-                genexitcode(procinfo.aktexitcode,parasize,nostackframe,false);
+                genexitcode(current_procinfo.aktexitcode,parasize,nostackframe,false);
 
                 { now all the registers used are known }
-                aktprocdef.usedintregisters:=rg.usedintinproc;
-                aktprocdef.usedotherregisters:=rg.usedinproc;
-                procinfo.aktproccode.insertlist(procinfo.aktentrycode);
-                procinfo.aktproccode.concatlist(procinfo.aktexitcode);
+                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}
@@ -409,31 +408,31 @@ implementation
                         slow_spill(rg);
                       }
                     until rg.spillednodes='';
-                    procinfo.aktproccode.translate_registers(rg.colour);
-                    procinfo.aktproccode.convert_registers;
+                    current_procinfo.aktproccode.translate_registers(rg.colour);
+                    current_procinfo.aktproccode.convert_registers;
 {$else newra}
-                    procinfo.aktproccode.convert_registers;
+                    current_procinfo.aktproccode.convert_registers;
 {$ifndef NoOpt}
                     if (cs_optimize in aktglobalswitches) and
                     { do not optimize pure assembler procedures }
-                       ((procinfo.flags and pi_is_assembler)=0)  then
-                      optimize(procinfo.aktproccode);
+                       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(procinfo.aktlocaldata) and
-                   (not procinfo.aktlocaldata.empty) then
+                if assigned(current_procinfo.aktlocaldata) and
+                   (not current_procinfo.aktlocaldata.empty) then
                  begin
-                   procinfo.aktproccode.concat(Tai_section.Create(sec_data));
-                   procinfo.aktproccode.concatlist(procinfo.aktlocaldata);
-                   procinfo.aktproccode.concat(Tai_section.Create(sec_code));
+                   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(procinfo.aktproccode);
+                codeSegment.concatlist(current_procinfo.aktproccode);
               end
             else
               do_resulttypepass(code);
@@ -443,7 +442,7 @@ implementation
           end;
 
          { ... remove symbol tables }
-         if aktprocdef.parast.symtablelevel>=normal_function_level then
+         if current_procdef.parast.symtablelevel>=normal_function_level then
            symtablestack:=symtablestack.next.next
          else
            symtablestack:=symtablestack.next;
@@ -455,20 +454,20 @@ implementation
              if (Errorcount=0) then
                begin
                  { check if forwards are resolved }
-                 tstoredsymtable(aktprocdef.localst).check_forwards;
+                 tstoredsymtable(current_procdef.localst).check_forwards;
                  { check if all labels are used }
-                 tstoredsymtable(aktprocdef.localst).checklabels;
+                 tstoredsymtable(current_procdef.localst).checklabels;
                  { remove cross unit overloads }
-                 tstoredsymtable(aktprocdef.localst).unchain_overloaded;
+                 tstoredsymtable(current_procdef.localst).unchain_overloaded;
                end;
-             if (procinfo.flags and pi_uses_asm)=0 then
+             if not(pi_uses_asm in current_procinfo.flags) then
                begin
                   { not for unit init, becuase the var can be used in finalize,
                     it will be done in proc_unit }
-                  if not(aktprocdef.proctypeoption
+                  if not(current_procdef.proctypeoption
                      in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
-                     tstoredsymtable(aktprocdef.localst).allsymbolsused;
-                  tstoredsymtable(aktprocdef.parast).allsymbolsused;
+                     tstoredsymtable(current_procdef.localst).allsymbolsused;
+                  tstoredsymtable(current_procdef.parast).allsymbolsused;
                end;
            end;
 
@@ -480,11 +479,11 @@ implementation
          { so no dispose here !!                              }
          if assigned(code) and
             not(cs_browser in aktmoduleswitches) and
-            (aktprocdef.proccalloption<>pocall_inline) then
+            (current_procdef.proccalloption<>pocall_inline) then
            begin
-             if aktprocdef.parast.symtablelevel>=normal_function_level then
-               aktprocdef.localst.free;
-             aktprocdef.localst:=nil;
+             if current_procdef.parast.symtablelevel>=normal_function_level then
+               current_procdef.localst.free;
+             current_procdef.localst:=nil;
            end;
 
          { all registers can be used again }
@@ -496,10 +495,10 @@ implementation
          if assigned(code) then
           begin
             { the inline procedure has already got a copy of the tree
-              stored in aktprocdef.code }
+              stored in current_procdef.code }
             code.free;
-            if (aktprocdef.proccalloption<>pocall_inline) then
-              aktprocdef.code:=nil;
+            if (current_procdef.proccalloption<>pocall_inline) then
+              current_procdef.code:=nil;
           end;
 
          { remove class member symbol tables }
@@ -520,10 +519,10 @@ implementation
          faillabel:=oldfaillabel;
 
          { reset to normal non static function }
-         if (aktprocdef.parast.symtablelevel=normal_function_level) then
+         if (current_procdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
 
-         aktprocdef:=oldprocdef;
+         current_procdef:=oldprocdef;
       end;
 
 
@@ -568,7 +567,7 @@ implementation
       }
       var
         oldprocdef       : tprocdef;
-        oldprocinfo      : tprocinfo;
+        old_current_procinfo : tprocinfo;
         oldconstsymtable : tsymtable;
         oldselftokenmode,
         oldfailtokenmode : tmodeswitch;
@@ -576,33 +575,25 @@ implementation
         pd               : tprocdef;
       begin
          { save old state }
-         oldprocdef:=aktprocdef;
+         oldprocdef:=current_procdef;
          oldconstsymtable:=constsymtable;
-         oldprocinfo:=procinfo;
+         old_current_procinfo:=current_procinfo;
 
-         { reset aktprocdef to nil to be sure that nothing is writing
+         { reset current_procdef to nil to be sure that nothing is writing
            to an other procdef }
-         aktprocdef:=nil;
+         current_procdef:=nil;
 
          { create a new procedure }
-         procinfo:=cprocinfo.create;
-         with procinfo do
-          begin
-            parent:=oldprocinfo;
-            { clear flags }
-            flags:=0;
-            { standard frame pointer }
-            framepointer.enum:=R_INTREGISTER;
-            framepointer.number:=NR_FRAME_POINTER_REG;
-          end;
+         current_procinfo:=cprocinfo.create(old_current_procinfo);
+         current_module.procinfo:=current_procinfo;
 
          { parse procedure declaration }
-         if assigned(oldprocinfo) and
-            assigned(oldprocinfo.procdef) then
-          pd:=parse_proc_dec(oldprocinfo.procdef._class)
+         if assigned(current_procinfo.parent) and
+            assigned(current_procinfo.parent.procdef) then
+          pd:=parse_proc_dec(current_procinfo.parent.procdef._class)
          else
           pd:=parse_proc_dec(nil);
-         procinfo.procdef:=pd;
+         current_procinfo.procdef:=pd;
 
          { set the default function options }
          if parse_only then
@@ -620,7 +611,6 @@ implementation
              pdflags:=pdflags or pd_implemen;
             if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
-            procinfo.exported:=false;
             pd.forwarddef:=false;
           end;
 
@@ -641,7 +631,7 @@ implementation
            begin
              { A method must be forward defined (in the object declaration) }
              if assigned(pd._class) and
-                (not assigned(oldprocinfo.procdef._class)) then
+                (not assigned(current_procinfo.parent.procdef._class)) then
               begin
                 Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
                 tprocsym(pd.procsym).write_parameter_lists(pd);
@@ -665,7 +655,7 @@ implementation
                    { check the global flag, for delphi this is not
                      required }
                    if not(m_delphi in aktmodeswitches) and
-                      ((procinfo.flags and pi_is_global)<>0) then
+                      (pi_is_global in current_procinfo.flags) then
                      Message(parser_e_overloaded_must_be_all_global);
                  end;
               end;
@@ -673,7 +663,7 @@ implementation
 
          { update procinfo, because the procdef can be
            changed by check_identical_proc (PFV) }
-         procinfo.procdef:=pd;
+         current_procinfo.procdef:=pd;
 
          { compile procedure when a body is needed }
          if (pdflags and pd_body)<>0 then
@@ -688,15 +678,15 @@ implementation
             pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
 
             { Update parameter information }
-            procinfo.allocate_implicit_parameter;
+            current_procinfo.allocate_implicit_parameter;
 {$ifdef i386}
             { add implicit pushes for interrupt routines }
             if (po_interrupt in pd.procoptions) then
-              procinfo.allocate_interrupt_stackframe;
+              current_procinfo.allocate_interrupt_stackframe;
 {$endif i386}
 
             { Calculate offsets }
-            procinfo.after_header;
+            current_procinfo.after_header;
 
             { set _FAIL as keyword if constructor }
             if (pd.proctypeoption=potype_constructor) then
@@ -711,7 +701,7 @@ implementation
                tokeninfo^[_SELF].keyword:=m_all;
              end;
 
-            compile_proc_body(pd,((pdflags and pd_global)<>0),assigned(oldprocinfo.procdef._class));
+            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
@@ -721,13 +711,17 @@ implementation
              consume(_SEMICOLON);
           end;
 
-         { close }
-         procinfo.free;
+         { release procinfo }
+         if tprocinfo(current_module.procinfo)<>current_procinfo then
+          internalerror(200304274);
+         current_module.procinfo:=current_procinfo.parent;
+         current_procinfo.free;
+
          { Restore old state }
          constsymtable:=oldconstsymtable;
 
-         aktprocdef:=oldprocdef;
-         procinfo:=oldprocinfo;
+         current_procdef:=oldprocdef;
+         current_procinfo:=old_current_procinfo;
       end;
 
 
@@ -749,17 +743,17 @@ implementation
 
         procedure Not_supported_for_inline(t : ttoken);
         begin
-           if (aktprocdef.proccalloption=pocall_inline) then
+           if (current_procdef.proccalloption=pocall_inline) then
              Begin
                 Message1(parser_w_not_supported_for_inline,tokenstring(t));
                 Message(parser_w_inlining_disabled);
-                aktprocdef.proccalloption:=pocall_fpccall;
+                current_procdef.proccalloption:=pocall_fpccall;
              End;
         end;
 
       begin
          repeat
-           if not assigned(aktprocdef) then
+           if not assigned(current_procdef) then
              internalerror(200304251);
            case token of
               _LABEL:
@@ -792,8 +786,8 @@ implementation
               _EXPORTS:
                 begin
                    Not_supported_for_inline(token);
-                   if not(assigned(aktprocdef.localst)) or
-                      (aktprocdef.localst.symtablelevel>main_program_level) or
+                   if not(assigned(current_procdef.localst)) or
+                      (current_procdef.localst.symtablelevel>main_program_level) or
                       (current_module.is_unit) then
                      begin
                         Message(parser_e_syntax_error);
@@ -849,8 +843,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.106  2003-04-27 07:29:50  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.107  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.106  2003/04/27 07:29:50  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
@@ -1001,7 +1004,7 @@ end.
     * noopt for non-i386 targets
 
   Revision 1.72  2002/09/10 20:31:48  florian
-    * call to procinfo.after_header added
+    * call to current_procinfo.after_header added
 
   Revision 1.71  2002/09/07 15:25:07  peter
     * old logs removed and tabs fixed

+ 11 - 2
compiler/ptype.pas

@@ -635,8 +635,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.53  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.52  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 44 - 35
compiler/rautils.pas

@@ -732,22 +732,22 @@ Function TOperand.SetupResult:boolean;
 Begin
   SetupResult:=false;
   { replace by correct offset. }
-  if (not is_void(aktprocdef.rettype.def)) then
+  if (not is_void(current_procdef.rettype.def)) then
    begin
      if (m_tp7 in aktmodeswitches) and
-        (not paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
+        (not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption)) then
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
        end;
-     opr.ref.offset:=procinfo.return_offset;
-     opr.ref.base:=procinfo.framepointer;
+     opr.ref.offset:=current_procinfo.return_offset;
+     opr.ref.base:=current_procinfo.framepointer;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
-     tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+     tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
      { increase reference count, this is also used to check
        if the result variable is actually used or not }
-     inc(tvarsym(aktprocdef.funcretsym).refcount);
+     inc(tvarsym(current_procdef.funcretsym).refcount);
      SetupResult:=true;
    end
   else
@@ -758,11 +758,11 @@ end;
 Function TOperand.SetupSelf:boolean;
 Begin
   SetupSelf:=false;
-  if assigned(aktprocdef._class) then
+  if assigned(current_procdef._class) then
    Begin
      opr.typ:=OPR_REFERENCE;
-     opr.ref.offset:=procinfo.selfpointer_offset;
-     opr.ref.base:=procinfo.framepointer;
+     opr.ref.offset:=current_procinfo.selfpointer_offset;
+     opr.ref.base:=current_procinfo.framepointer;
      opr.ref.options:=ref_selffixup;
      SetupSelf:=true;
    end
@@ -774,11 +774,11 @@ end;
 Function TOperand.SetupOldEBP:boolean;
 Begin
   SetupOldEBP:=false;
-  if aktprocdef.parast.symtablelevel>normal_function_level then
+  if current_procdef.parast.symtablelevel>normal_function_level then
    Begin
      opr.typ:=OPR_REFERENCE;
-     opr.ref.offset:=procinfo.framepointer_offset;
-     opr.ref.base:=procinfo.framepointer;
+     opr.ref.offset:=current_procinfo.framepointer_offset;
+     opr.ref.base:=current_procinfo.framepointer;
      opr.ref.options:=ref_parafixup;
      SetupOldEBP:=true;
    end
@@ -825,25 +825,25 @@ Begin
             begin
               { if we only want the offset we don't have to care
                 the base will be zeroed after ! }
-              if (tvarsym(sym).owner=aktprocdef.parast) or
+              if (tvarsym(sym).owner=current_procdef.parast) or
                 GetOffset then
                 begin
-                  opr.ref.base:=procinfo.framepointer;
+                  opr.ref.base:=current_procinfo.framepointer;
                 end
               else
                 begin
-                  if (aktprocdef.localst.datasize=0) and
-                     assigned(procinfo.parent) and
-                     (tvarsym(sym).owner=aktprocdef.parast) and
-                     (aktprocdef.parast.symtablelevel>normal_function_level) then
-                    opr.ref.base:=procinfo.parent.framepointer
+                  if (current_procdef.localst.datasize=0) and
+                     assigned(current_procinfo.parent) and
+                     (tvarsym(sym).owner=current_procdef.parast) and
+                     (current_procdef.parast.symtablelevel>normal_function_level) then
+                    opr.ref.base:=current_procinfo.parent.framepointer
                   else
                     message1(asmr_e_local_para_unreachable,s);
                 end;
               opr.ref.offset:=tvarsym(sym).address;
-              if (aktprocdef.parast.symtablelevel=tvarsym(sym).owner.symtablelevel) then
+              if (current_procdef.parast.symtablelevel=tvarsym(sym).owner.symtablelevel) then
                 begin
-                  opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
+                  opr.ref.offsetfixup:=current_procdef.parast.address_fixup;
                   opr.ref.options:=ref_parafixup;
                 end
               else
@@ -853,7 +853,7 @@ Begin
                 end;
               if (tvarsym(sym).varspez=vs_var) or
                  ((tvarsym(sym).varspez=vs_const) and
-                  paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
+                  paramanager.push_addr_param(tvarsym(sym).vartype.def,current_procdef.proccalloption)) then
                 SetSize(pointer_size,false);
             end;
           localsymtable :
@@ -864,23 +864,23 @@ Begin
                 begin
                   { if we only want the offset we don't have to care
                     the base will be zeroed after ! }
-                  if (tvarsym(sym).owner=aktprocdef.localst) or
+                  if (tvarsym(sym).owner=current_procdef.localst) or
                      GetOffset then
-                    opr.ref.base:=procinfo.framepointer
+                    opr.ref.base:=current_procinfo.framepointer
                   else
                     begin
-                      if (aktprocdef.localst.datasize=0) and
-                         assigned(procinfo.parent) and
-                         (tvarsym(sym).owner=procinfo.parent.procdef.localst) and
-                         (aktprocdef.parast.symtablelevel>normal_function_level) then
-                        opr.ref.base:=procinfo.parent.framepointer
+                      if (current_procdef.localst.datasize=0) and
+                         assigned(current_procinfo.parent) and
+                         (tvarsym(sym).owner=current_procinfo.parent.procdef.localst) and
+                         (current_procdef.parast.symtablelevel>normal_function_level) then
+                        opr.ref.base:=current_procinfo.parent.framepointer
                       else
                         message1(asmr_e_local_para_unreachable,s);
                     end;
                   opr.ref.offset:=-(tvarsym(sym).address);
-                  if (aktprocdef.localst.symtablelevel=tvarsym(sym).owner.symtablelevel) then
+                  if (current_procdef.localst.symtablelevel=tvarsym(sym).owner.symtablelevel) then
                     begin
-                      opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
+                      opr.ref.offsetfixup:=current_procdef.localst.address_fixup;
                       opr.ref.options:=ref_localfixup;
                     end
                   else
@@ -891,7 +891,7 @@ Begin
                 end;
               if (tvarsym(sym).varspez in [vs_var,vs_out]) or
                  ((tvarsym(sym).varspez=vs_const) and
-                  paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
+                  paramanager.push_addr_param(tvarsym(sym).vartype.def,current_procdef.proccalloption)) then
                 SetSize(pointer_size,false);
             end;
         end;
@@ -1298,7 +1298,7 @@ Begin
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   if base='SELF' then
-   st:=aktprocdef._class.symtable
+   st:=current_procdef._class.symtable
   else
    begin
      asmsearchsym(base,sym,srsymtable);
@@ -1574,8 +1574,17 @@ end;
 end.
 {
   $Log$
-  Revision 1.57  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.58  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.57  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 30 - 18
compiler/regvars.pas

@@ -73,7 +73,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxvarregs do
                 begin
-                  with pregvarinfo(aktprocdef.regvarinfo)^ do
+                  with pregvarinfo(current_procdef.regvarinfo)^ do
                    if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxvarregs-1 downto i do
@@ -114,7 +114,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxfpuvarregs do
                 begin
-                  with pregvarinfo(aktprocdef.regvarinfo)^ do
+                  with pregvarinfo(current_procdef.regvarinfo)^ do
                    if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxfpuvarregs-1 downto i do
@@ -146,11 +146,12 @@ implementation
       { only if no asm is used }
       { and no try statement   }
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+         not(pi_uses_asm in current_procinfo.flags) and
+         not(pi_uses_exceptions in current_procinfo.flags) then
         begin
           new(regvarinfo);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
-          aktprocdef.regvarinfo := regvarinfo;
+          current_procdef.regvarinfo := regvarinfo;
           if (p.registers32<4) then
             begin
               parasym:=false;
@@ -184,7 +185,7 @@ implementation
                       { call by reference/const ? }
                       if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
                          ((regvarinfo^.regvars[i].varspez=vs_const) and
-                           paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def,aktprocdef.proccalloption)) then
+                           paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def,current_procdef.proccalloption)) then
                         begin
                            r.enum:=varregs[i];
                            regvarinfo^.regvars[i].reg:=r;
@@ -238,7 +239,7 @@ implementation
                 { with assigning registers                       }
                 if aktmaxfpuregisters=-1 then
                   begin
-                   if (procinfo.flags and pi_do_call)<>0 then
+                   if (pi_do_call in current_procinfo.flags) then
                      begin
                       for i:=maxfpuvarregs downto 2 do
                         regvarinfo^.fpuregvars[i]:=nil;
@@ -288,7 +289,7 @@ implementation
     begin
       if reg.enum>lastreg then
         internalerror(200301081);
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
@@ -307,7 +308,7 @@ implementation
                       hr.offset:=-vsym.address+vsym.owner.address_fixup
                     else
                       hr.offset:=vsym.address+vsym.owner.address_fixup;
-                    hr.base:=procinfo.framepointer;
+                    hr.base:=current_procinfo.framepointer;
                     cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
                   end;
                 asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
@@ -334,10 +335,10 @@ implementation
             hr.offset:=-vsym.address+vsym.owner.address_fixup
           else
             hr.offset:=vsym.address+vsym.owner.address_fixup;
-          hr.base:=procinfo.framepointer;
+          hr.base:=current_procinfo.framepointer;
           if (vsym.varspez in [vs_var,vs_out]) or
              ((vsym.varspez=vs_const) and
-               paramanager.push_addr_param(vsym.vartype.def,aktprocdef.proccalloption)) then
+               paramanager.push_addr_param(vsym.vartype.def,current_procdef.proccalloption)) then
             opsize := OS_ADDR
           else
             opsize := def_cgsize(vsym.vartype.def);
@@ -352,7 +353,7 @@ implementation
       regvarinfo: pregvarinfo;
       reg_spare : tregister;
     begin
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       reg_spare := rg.makeregsize(reg,OS_INT);
@@ -369,7 +370,7 @@ implementation
       i: longint;
       regvarinfo: pregvarinfo;
     begin
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
@@ -386,9 +387,10 @@ implementation
       r:Tregister;
     begin
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
+         not(pi_uses_asm in current_procinfo.flags) and
+         not(pi_uses_exceptions in current_procinfo.flags) then
         begin
-          regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+          regvarinfo := pregvarinfo(current_procdef.regvarinfo);
           { can happen when inlining assembler procedures (JM) }
           if not assigned(regvarinfo) then
             exit;
@@ -466,11 +468,12 @@ implementation
       r,reg : tregister;
     begin
       { can happen when inlining assembler procedures (JM) }
-      if not assigned(aktprocdef.regvarinfo) then
+      if not assigned(current_procdef.regvarinfo) then
         exit;
       if (cs_regalloc in aktglobalswitches) and
-         ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
-        with pregvarinfo(aktprocdef.regvarinfo)^ do
+         not(pi_uses_asm in current_procinfo.flags) and
+         not(pi_uses_exceptions in current_procinfo.flags) then
+        with pregvarinfo(current_procdef.regvarinfo)^ do
           begin
 {$ifdef i386}
             r.enum:=R_ST0;
@@ -497,7 +500,16 @@ end.
 
 {
   $Log$
-  Revision 1.46  2003-03-28 19:16:57  peter
+  Revision 1.47  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.46  2003/03/28 19:16:57  peter
     * generic constructor working for i386
     * remove fixed self register
     * esi added as address register for i386

+ 12 - 3
compiler/sparc/cgcpu.pas

@@ -246,7 +246,7 @@ procedure TCgSparc.a_call_reg(list:TAasmOutput;Reg:TRegister);
     if target_info.system=system_sparc_linux
     then
       list.concat(taicpu.op_none(A_NOP));
-    procinfo.flags:=procinfo.flags or pi_do_call;
+    include(current_procinfo.flags,pi_do_call);
  end;
 {********************** branch instructions ********************}
 procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
@@ -906,7 +906,7 @@ procedure TCgSparc.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;r
   VAR
     ai:taicpu;
     r,hreg:tregister;
-    
+
   BEGIN
     r.enum:=R_PSR;
     hreg := rg.makeregsize(reg,OS_8);
@@ -1428,7 +1428,16 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.42  2003-03-16 20:45:45  mazen
+  Revision 1.43  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.42  2003/03/16 20:45:45  mazen
   * fixing an LD operation without refernce in loading address parameters
 
   Revision 1.41  2003/03/10 21:59:54  mazen

+ 13 - 4
compiler/sparc/cpupi.pas

@@ -33,7 +33,7 @@ type
     LocalSize:aword;
     {max of space need for parameters, currently used by the PowerPC port only}
     maxpushedparasize:aword;
-    constructor create;override;
+    constructor create(aparent:tprocinfo);override;
 {According the the SPARC ABI the standard stack frame must include :
   *  16 word save for the in and local registers in case of overflow/underflow.
 this save area always must exist at the %o6+0,
@@ -52,9 +52,9 @@ implementation
 uses
         tgobj,paramgr,symsym,systems;
 
-constructor TSparcprocinfo.create;
+constructor TSparcprocinfo.create(aparent:tprocinfo);
         begin
-                inherited create;
+                inherited create(aparent);
                 maxpushedparasize:=0;
                 LocalSize:=(16+1)*4;
         {First 16 words are in the frame are used to save registers in case of a
@@ -95,7 +95,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2003-04-27 07:48:05  peter
+  Revision 1.14  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.13  2003/04/27 07:48:05  peter
     * updated for removed lexlevel
 
   Revision 1.12  2003/02/06 22:36:55  mazen

+ 12 - 3
compiler/sparc/ncpucall.pas

@@ -50,9 +50,9 @@ function TSparcCallNode.pass_1:TNode;
     if ProcDefinition is TProcDef
     then
       with TProcDef(procdefinition).parast do
-        if datasize>TSparcProcInfo(procinfo).maxpushedparasize
+        if datasize>TSparcProcInfo(current_procinfo).maxpushedparasize
         then
-          TSparcProcInfo(procinfo).maxpushedparasize:=datasize;
+          TSparcProcInfo(current_procinfo).maxpushedparasize:=datasize;
   end;
 procedure TSparcCallNode.push_framepointer;
   begin
@@ -63,7 +63,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2003-04-04 15:38:56  peter
+  Revision 1.10  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.9  2003/04/04 15:38:56  peter
     * moved generic code from n386cal to ncgcal, i386 now also
       uses the generic ncgcal
 

+ 36 - 27
compiler/sparc/radirect.pas

@@ -86,20 +86,20 @@ end;
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
+           if assigned(current_procdef.funcretsym) and
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
          end;
 
      begin
        ende:=false;
        s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
-       if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo.return_offset)+'('+std_reg2str[procinfo.framepointer.enum]+')')
+       if assigned(current_procdef.funcretsym) and
+          is_fpu(current_procdef.rettype.def) then
+         tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
+       if (not is_void(current_procdef.rettype.def)) then
+         retstr:=upper(tostr(current_procinfo.return_offset)+'('+std_reg2str[current_procinfo.framepointer.enum]+')')
        else
          retstr:='';
          c:=current_scanner.asmgetchar;
@@ -143,22 +143,22 @@ end;
                              FwaitWarning
                             else
                             { access to local variables }
-                            if assigned(aktprocdef) then
+                            if assigned(current_procdef) then
                               begin
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) and
+                                    paramanager.ret_in_acc(current_procdef.rettype.def,current_procdef.proccalloption) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
-                                   tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                                   tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
-                                      if assigned(aktprocdef.localst) and
-                                         (aktprocdef.localst.symtablelevel >= normal_function_level) then
-                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                      if assigned(current_procdef.localst) and
+                                         (current_procdef.localst.symtablelevel >= normal_function_level) then
+                                        sym:=tsym(current_procdef.localst.search(upper(hs)))
                                       else
                                         sym:=nil;
                                       if assigned(sym) then
@@ -180,7 +180,7 @@ end;
                                                hs:=tvarsym(sym).mangledname
                                              else
                                                hs:='-'+tostr(tvarsym(sym).address)+
-                                                   '('+std_reg2str[procinfo.framepointer.enum]+')';
+                                                   '('+std_reg2str[current_procinfo.framepointer.enum]+')';
                                              end
                                            else
                                            { call to local function }
@@ -192,8 +192,8 @@ end;
                                         end
                                       else
                                         begin
-                                           if assigned(aktprocdef.parast) then
-                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                           if assigned(current_procdef.parast) then
+                                             sym:=tsym(current_procdef.parast.search(upper(hs)))
                                            else
                                              sym:=nil;
                                            if assigned(sym) then
@@ -202,8 +202,8 @@ end;
                                                   begin
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
-                                                     inc(l,aktprocdef.parast.address_fixup);
-                                                     hs:=tostr(l)+'('+std_reg2str[procinfo.framepointer.enum]+')';
+                                                     inc(l,current_procdef.parast.address_fixup);
+                                                     hs:=tostr(l)+'('+std_reg2str[current_procinfo.framepointer.enum]+')';
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
                                                   end;
@@ -247,15 +247,15 @@ end;
                                              end
                                            else if upper(hs)='__SELF' then
                                              begin
-                                                if assigned(aktprocdef._class) then
-                                                  hs:=tostr(procinfo.selfpointer_offset)+
-                                                      '('+std_reg2str[procinfo.framepointer.enum]+')'
+                                                if assigned(current_procdef._class) then
+                                                  hs:=tostr(current_procinfo.selfpointer_offset)+
+                                                      '('+std_reg2str[current_procinfo.framepointer.enum]+')'
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
                                            else if upper(hs)='__RESULT' then
                                              begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                if (not is_void(current_procdef.rettype.def)) then
                                                   hs:=retstr
                                                 else
                                                   Message(asmr_e_void_function);
@@ -264,9 +264,9 @@ end;
                                              begin
                                                 { complicate to check there }
                                                 { we do it: }
-                                                if aktprocdef.parast.symtablelevel>normal_function_level then
-                                                  hs:=tostr(procinfo.framepointer_offset)+
-                                                    '('+std_reg2str[procinfo.framepointer.enum]+')'
+                                                if current_procdef.parast.symtablelevel>normal_function_level then
+                                                  hs:=tostr(current_procinfo.framepointer_offset)+
+                                                    '('+std_reg2str[current_procinfo.framepointer.enum]+')'
                                                 else
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                              end;
@@ -279,7 +279,7 @@ end;
                    end;
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
-                        tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                        tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                    end;
@@ -314,7 +314,16 @@ initialization
 end.
 {
   $Log$
-  Revision 1.6  2003-04-27 07:48:05  peter
+  Revision 1.7  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.6  2003/04/27 07:48:05  peter
     * updated for removed lexlevel
 
   Revision 1.5  2003/01/08 18:43:58  daniel

+ 11 - 2
compiler/symbase.pas

@@ -347,8 +347,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.12  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.11  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/symconst.pas

@@ -350,8 +350,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.52  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.51  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/symdef.pas

@@ -5737,8 +5737,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.137  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.138  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.137  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/symsym.pas

@@ -340,7 +340,7 @@ interface
 
 
     var
-       aktprocdef : tprocdef;
+       current_procdef : tprocdef;
 
        aktcallprocdef : tabstractprocdef;  { pointer to the definition of the
                                              currently called procedure,
@@ -2557,12 +2557,21 @@ implementation
 end.
 {
   $Log$
-  Revision 1.99  2003-04-27 10:03:18  jonas
+  Revision 1.100  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.99  2003/04/27 10:03:18  jonas
     * fixed stabs generation for local variables on systems where they have
       a positive offset relative to the stack/framepointer
 
   Revision 1.98  2003/04/27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 15 - 6
compiler/symtable.pas

@@ -1986,7 +1986,7 @@ implementation
            begin
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
               if assigned(srsym) and
-                 tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
+                 tstoredsym(srsym).is_visible_for_proc(current_procdef) then
                begin
                  searchsym:=true;
                  exit;
@@ -2056,7 +2056,7 @@ implementation
                 end
                else
                 begin
-                  if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
+                  if tstoredsym(sym).is_visible_for_proc(current_procdef) then
                    break;
                 end;
              end;
@@ -2101,7 +2101,7 @@ implementation
                    end
                   else
                    begin
-                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                     if tprocdef(def).is_visible_for_proc(current_procdef) then
                       break;
                    end;
                 end;
@@ -2150,7 +2150,7 @@ implementation
                    end
                   else
                    begin
-                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                     if tprocdef(def).is_visible_for_proc(current_procdef) then
                       break;
                    end;
                 end;
@@ -2428,8 +2428,17 @@ implementation
 end.
 {
   $Log$
-  Revision 1.96  2003-04-27 07:29:51  peter
-    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+  Revision 1.97  2003-04-27 11:21:34  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.96  2003/04/27 07:29:51  peter
+    * current_procdef cleanup, current_procdef is now always nil when parsing
       a new procdef declaration
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead

+ 14 - 5
compiler/tgobj.pas

@@ -431,7 +431,7 @@ unit tgobj;
     procedure ttgobj.GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
 
     begin
-      reference_reset_base(ref,procinfo.framepointer,alloctemp(list,size,temptype));
+      reference_reset_base(ref,current_procinfo.framepointer,alloctemp(list,size,temptype));
     end;
 
 
@@ -444,17 +444,17 @@ unit tgobj;
            internalerror(200301225);
          if (ref.index.enum<>R_NO) and (ref.index.enum<>R_INTREGISTER) then
            internalerror(200301225);
-         if procinfo.framepointer.enum<>R_INTREGISTER then
+         if current_procinfo.framepointer.enum<>R_INTREGISTER then
            internalerror(200301225);
          if direction = 1 then
            begin
-             istemp:=((ref.base.number=procinfo.framepointer.number) and
+             istemp:=((ref.base.number=current_procinfo.framepointer.number) and
                      (ref.index.number=NR_NO) and
                       (ref.offset>=firsttemp));
            end
         else
            begin
-             istemp:=((ref.base.number=procinfo.framepointer.number) and
+             istemp:=((ref.base.number=current_procinfo.framepointer.number) and
                      (ref.index.number=NR_NO) and
                       (ref.offset<firsttemp));
            end;
@@ -544,7 +544,16 @@ finalization
 end.
 {
   $Log$
-  Revision 1.30  2003-04-25 20:59:35  peter
+  Revision 1.31  2003-04-27 11:21:35  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.30  2003/04/25 20:59:35  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

+ 12 - 3
compiler/x86/cgx86.pas

@@ -1817,10 +1817,10 @@ unit cgx86;
       begin
         { Routines with the poclearstack flag set use only a ret }
         { also routines with parasize=0     }
-        if (po_clearstack in aktprocdef.procoptions) then
+        if (po_clearstack in current_procdef.procoptions) then
          begin
            { complex return values are removed from stack in C code PM }
-           if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+           if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
              list.concat(Taicpu.Op_const(A_RET,S_NO,4))
            else
              list.concat(Taicpu.Op_none(A_RET,S_NO));
@@ -1938,7 +1938,16 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.42  2003-04-23 14:42:08  daniel
+  Revision 1.43  2003-04-27 11:21:36  peter
+    * aktprocdef renamed to current_procdef
+    * procinfo renamed to current_procinfo
+    * procinfo will now be stored in current_module so it can be
+      cleaned up properly
+    * gen_main_procsym changed to create_main_proc and release_main_proc
+      to also generate a tprocinfo structure
+    * fixed unit implicit initfinal
+
+  Revision 1.42  2003/04/23 14:42:08  daniel
     * Further register allocator work. Compiler now smaller with new
       allocator than without.
     * Somebody forgot to adjust ppu version number