فهرست منبع

* 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 سال پیش
والد
کامیت
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
     type
        {# This object gives information on the current routine being
        {# This object gives information on the current routine being
@@ -87,20 +85,11 @@ unit cgbase;
           {# some collected informations about the procedure
           {# some collected informations about the procedure
              see pi_xxxx constants above
              see pi_xxxx constants above
           }
           }
-          flags : longint;
+          flags : tprocinfoflags;
 
 
           {# register used as frame pointer }
           {# register used as frame pointer }
           framepointer : tregister;
           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
           {# Holds the environment reference for default exceptions
 
 
              The exception reference is created when ansistrings
              The exception reference is created when ansistrings
@@ -149,7 +138,7 @@ unit cgbase;
           aktexitcode: taasmoutput;
           aktexitcode: taasmoutput;
           aktlocaldata : taasmoutput;
           aktlocaldata : taasmoutput;
 
 
-          constructor create;virtual;
+          constructor create(aparent:tprocinfo);virtual;
           destructor destroy;override;
           destructor destroy;override;
 
 
           procedure allocate_interrupt_stackframe;virtual;
           procedure allocate_interrupt_stackframe;virtual;
@@ -185,10 +174,9 @@ unit cgbase;
        tcprocinfo = class of tprocinfo;
        tcprocinfo = class of tprocinfo;
 
 
     var
     var
-       {# information about the current sub routine being parsed (@var(pprocinfo))}
-       procinfo : tprocinfo;
-
        cprocinfo : tcprocinfo;
        cprocinfo : tcprocinfo;
+       {# information about the current sub routine being parsed (@var(pprocinfo))}
+       current_procinfo : tprocinfo;
 
 
        { labels for BREAK and CONTINUE }
        { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : tasmlabel;
        aktbreaklabel,aktcontinuelabel : tasmlabel;
@@ -212,9 +200,6 @@ unit cgbase;
        { save the size of pushed parameter, needed for aligning }
        { save the size of pushed parameter, needed for aligning }
        pushedparasize : longint;
        pushedparasize : longint;
 
 
-       { procinfo instance which is used in procedures created automatically by the compiler }
-       voidprocpi : tprocinfo;
-
     { message calls with codegenerror support }
     { message calls with codegenerror support }
     procedure cgmessage(t : longint);
     procedure cgmessage(t : longint);
     procedure cgmessage1(t : longint;const s : string);
     procedure cgmessage1(t : longint;const s : string);
@@ -253,16 +238,9 @@ implementation
         tgobj,rgobj,
         tgobj,rgobj,
         defutil,
         defutil,
         fmodule
         fmodule
-{$ifdef fixLeaksOnError}
-        ,comphook
-{$endif fixLeaksOnError}
         ,symbase,paramgr
         ,symbase,paramgr
         ;
         ;
 
 
-{$ifdef fixLeaksOnError}
-     var procinfoStack: TStack;
-         hcodegen_old_do_stop: tstopprocedure;
-{$endif fixLeaksOnError}
 
 
 {*****************************************************************************
 {*****************************************************************************
             override the message calls to set codegenerror
             override the message calls to set codegenerror
@@ -370,9 +348,9 @@ implementation
                                  TProcInfo
                                  TProcInfo
 ****************************************************************************}
 ****************************************************************************}
 
 
-    constructor tprocinfo.create;
+    constructor tprocinfo.create(aparent:tprocinfo);
       begin
       begin
-        parent:=nil;
+        parent:=aparent;
         procdef:=nil;
         procdef:=nil;
         framepointer_offset:=0;
         framepointer_offset:=0;
         selfpointer_offset:=0;
         selfpointer_offset:=0;
@@ -380,12 +358,9 @@ implementation
         inheritedflag_offset:=0;
         inheritedflag_offset:=0;
         return_offset:=0;
         return_offset:=0;
         firsttemp_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;
         aktentrycode:=Taasmoutput.Create;
         aktexitcode:=Taasmoutput.Create;
         aktexitcode:=Taasmoutput.Create;
@@ -415,9 +390,9 @@ implementation
       begin
       begin
          { temporary space is set, while the BEGIN of the procedure }
          { temporary space is set, while the BEGIN of the procedure }
          if (symtablestack.symtabletype=localsymtable) then
          if (symtablestack.symtabletype=localsymtable) then
-           procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
+           current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
          else
          else
-           procinfo.firsttemp_offset := 0;
+           current_procinfo.firsttemp_offset := 0;
          { space for the return value }
          { space for the return value }
          { !!!!!   this means that we can not set the return value
          { !!!!!   this means that we can not set the return value
          in a subfunction !!!!! }
          in a subfunction !!!!! }
@@ -443,14 +418,17 @@ implementation
            end;
            end;
          if assigned(procdef._class) then
          if assigned(procdef._class) then
            begin
            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
                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 }
               { Special parameters for de-/constructors }
               case procdef.proctypeoption of
               case procdef.proctypeoption of
@@ -485,10 +463,10 @@ implementation
          { Retrieve function result offset }
          { Retrieve function result offset }
          if assigned(procdef.funcretsym) then
          if assigned(procdef.funcretsym) then
            begin
            begin
-             procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
+             current_procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
                                      tvarsym(procdef.funcretsym).owner.address_fixup;
                                      tvarsym(procdef.funcretsym).owner.address_fixup;
              if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
              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;
       end;
       end;
 
 
@@ -649,32 +627,20 @@ implementation
         commutativeop := list[op];
         commutativeop := list[op];
       end;
       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.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 53 - 44
compiler/cgobj.pas

@@ -1573,14 +1573,14 @@ unit cgobj;
          p  : tprocinfo;
          p  : tprocinfo;
          self_reg : tregister;
          self_reg : tregister;
       begin
       begin
-         if not assigned(procinfo.procdef._class) then
+         if not assigned(current_procdef._class) then
            internalerror(200303211);
            internalerror(200303211);
          self_reg:=rg.getaddressregister(list);
          self_reg:=rg.getaddressregister(list);
-         if procinfo.procdef.parast.symtablelevel>normal_function_level then
+         if current_procdef.parast.symtablelevel>normal_function_level then
            begin
            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);
              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
              while (p.procdef.parast.symtablelevel>normal_function_level) do
               begin
               begin
                 reference_reset_base(hp,self_reg,p.framepointer_offset);
                 reference_reset_base(hp,self_reg,p.framepointer_offset);
@@ -1592,7 +1592,7 @@ unit cgobj;
            end
            end
          else
          else
            begin
            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);
              a_load_ref_reg(list,OS_ADDR,hp,self_reg);
            end;
            end;
         g_load_self:=self_reg;
         g_load_self:=self_reg;
@@ -1644,44 +1644,44 @@ unit cgobj;
        href : treference;
        href : treference;
        acc : Tregister;
        acc : Tregister;
      begin
      begin
-        if procinfo.vmtpointer_offset=0 then
+        if current_procinfo.vmtpointer_offset=0 then
          internalerror(200303251);
          internalerror(200303251);
-        if procinfo.selfpointer_offset=0 then
+        if current_procinfo.selfpointer_offset=0 then
          internalerror(200303252);
          internalerror(200303252);
         acc.enum:=R_INTREGISTER;
         acc.enum:=R_INTREGISTER;
         acc.number:=NR_ACCUMULATOR;
         acc.number:=NR_ACCUMULATOR;
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
           begin
           begin
             if (cs_implicit_exceptions in aktmoduleswitches) then
             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 }
             { 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));
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
             { 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_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_NEW_CLASS');
             a_call_name(list,'FPC_NEW_CLASS');
             { save the self pointer }
             { 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);
             a_load_reg_ref(list,OS_ADDR,acc,href);
             { fail? }
             { fail? }
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
           end
           end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
           begin
           begin
             { parameter 3 : vmt_offset }
             { 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,
             { parameter 2 : address of pointer to vmt,
               this is required to allow setting the vmt to -1 to indicate
               this is required to allow setting the vmt to -1 to indicate
               that memory was allocated }
               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));
             a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
             { 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_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_CONSTRUCTOR');
             a_call_name(list,'FPC_HELP_CONSTRUCTOR');
             { save the self pointer }
             { 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);
             a_load_reg_ref(list,OS_ADDR,acc,href);
             { fail? }
             { fail? }
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
@@ -1697,48 +1697,48 @@ unit cgobj;
         href : treference;
         href : treference;
         reg  : tregister;
         reg  : tregister;
      begin
      begin
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
          begin
          begin
-           if procinfo.selfpointer_offset=0 then
+           if current_procinfo.selfpointer_offset=0 then
             internalerror(200303253);
             internalerror(200303253);
            { parameter 2 : flag }
            { parameter 2 : flag }
-           if procinfo.inheritedflag_offset=0 then
+           if current_procinfo.inheritedflag_offset=0 then
             internalerror(200303251);
             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));
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(2));
            { parameter 1 : self }
            { parameter 1 : self }
-           if procinfo.selfpointer_offset=0 then
+           if current_procinfo.selfpointer_offset=0 then
             internalerror(200303252);
             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_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
            a_call_name(list,'FPC_DISPOSE_CLASS')
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
          end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
          begin
          begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303254);
              internalerror(200303254);
-            if procinfo.vmtpointer_offset=0 then
+            if current_procinfo.vmtpointer_offset=0 then
              internalerror(200303255);
              internalerror(200303255);
             { must the object be finalized ? }
             { must the object be finalized ? }
-            if procinfo.procdef._class.needs_inittable then
+            if current_procdef._class.needs_inittable then
              begin
              begin
                objectlibrary.getlabel(nofinal);
                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);
                a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
                reg:=g_load_self(list);
                reg:=g_load_self(list);
                reference_reset_base(href,reg,0);
                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);
                reference_release(list,href);
                a_label(list,nofinal);
                a_label(list,nofinal);
              end;
              end;
             { actually call destructor }
             { actually call destructor }
             { parameter 3 : vmt_offset }
             { 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 }
             { 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));
             a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
             { parameter 1 : address of self pointer }
             { 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_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_DESTRUCTOR');
             a_call_name(list,'FPC_HELP_DESTRUCTOR');
          end
          end
@@ -1751,37 +1751,37 @@ unit cgobj;
       var
       var
         href : treference;
         href : treference;
      begin
      begin
-        if is_class(procinfo.procdef._class) then
+        if is_class(current_procdef._class) then
           begin
           begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303256);
              internalerror(200303256);
             { parameter 2 : flag, 0 -> inherited call (=no dispose) }
             { parameter 2 : flag, 0 -> inherited call (=no dispose) }
             a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
             a_param_const(list,OS_32,1,paramanager.getintparaloc(2));
             { parameter 1 : self }
             { 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_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DISPOSE_CLASS');
             a_call_name(list,'FPC_DISPOSE_CLASS');
           end
           end
-        else if is_object(procinfo.procdef._class) then
+        else if is_object(current_procdef._class) then
           begin
           begin
-            if procinfo.selfpointer_offset=0 then
+            if current_procinfo.selfpointer_offset=0 then
              internalerror(200303257);
              internalerror(200303257);
-            if procinfo.vmtpointer_offset=0 then
+            if current_procinfo.vmtpointer_offset=0 then
              internalerror(200303258);
              internalerror(200303258);
             { parameter 3 : vmt_offset }
             { 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 }
             { 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));
             a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
             { parameter 1 : self pointer }
             { 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_param_ref(list,OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_HELP_FAIL');
             a_call_name(list,'FPC_HELP_FAIL');
           end
           end
         else
         else
           internalerror(200006163);
           internalerror(200006163);
         { set self to nil }
         { 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);
         a_load_const_ref(list,OS_ADDR,0,href);
       end;
       end;
 
 
@@ -1853,8 +1853,17 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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 }
         globalsymtable,           { pointer to the global symtable of this unit }
         localsymtable : tsymtable;{ pointer to the local symtable of this unit }
         localsymtable : tsymtable;{ pointer to the local symtable of this unit }
         scanner       : pointer;  { scanner object used }
         scanner       : pointer;  { scanner object used }
+        procinfo      : pointer;  { current procedure being compiled }
         loaded_from   : tmodule;
         loaded_from   : tmodule;
         uses_imports  : boolean;  { Set if the module imports from DLL's.}
         uses_imports  : boolean;  { Set if the module imports from DLL's.}
         imports       : tlinkedlist;
         imports       : tlinkedlist;
@@ -169,7 +170,8 @@ uses
   dos,
   dos,
 {$endif}
 {$endif}
   verbose,systems,
   verbose,systems,
-  scanner;
+  scanner,
+  cgbase;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -391,10 +393,11 @@ uses
 
 
 
 
     destructor tmodule.Destroy;
     destructor tmodule.Destroy;
-{$ifdef MEMDEBUG}
       var
       var
+{$ifdef MEMDEBUG}
         d : tmemdebug;
         d : tmemdebug;
 {$endif}
 {$endif}
+        hpi : tprocinfo;
       begin
       begin
         if assigned(map) then
         if assigned(map) then
          dispose(map);
          dispose(map);
@@ -412,6 +415,18 @@ uses
              current_scanner:=nil;
              current_scanner:=nil;
             tscannerfile(scanner).free;
             tscannerfile(scanner).free;
          end;
          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;
         used_units.free;
         dependent_units.free;
         dependent_units.free;
         resourcefiles.Free;
         resourcefiles.Free;
@@ -459,6 +474,8 @@ uses
 
 
 
 
     procedure tmodule.reset;
     procedure tmodule.reset;
+      var
+        hpi : tprocinfo;
       begin
       begin
         if assigned(scanner) then
         if assigned(scanner) then
           begin
           begin
@@ -469,6 +486,18 @@ uses
             tscannerfile(scanner).free;
             tscannerfile(scanner).free;
             scanner:=nil;
             scanner:=nil;
           end;
           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
         if assigned(globalsymtable) then
           begin
           begin
             globalsymtable.free;
             globalsymtable.free;
@@ -610,7 +639,16 @@ uses
 end.
 end.
 {
 {
   $Log$
   $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
     * unit loading changed to first register units and load them
       afterwards. This is needed to support uses xxx in yyy correctly
       afterwards. This is needed to support uses xxx in yyy correctly
     * unit dependency check fixed
     * unit dependency check fixed

+ 11 - 2
compiler/fppu.pas

@@ -1342,8 +1342,17 @@ uses
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/globals.pas

@@ -1528,8 +1528,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/globtype.pas

@@ -208,8 +208,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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
                           (hsym.varstate=vs_set_but_first_not_passed) then
                         begin
                         begin
                           if (assigned(hsym.owner) and
                           if (assigned(hsym.owner) and
-                              assigned(aktprocdef) and
-                              (hsym.owner=aktprocdef.localst)) then
+                              assigned(current_procdef) and
+                              (hsym.owner=current_procdef.localst)) then
                            begin
                            begin
                              if (vo_is_funcret in hsym.varoptions) then
                              if (vo_is_funcret in hsym.varoptions) then
                                CGMessage(sym_w_function_result_not_set)
                                CGMessage(sym_w_function_result_not_set)
@@ -998,8 +998,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/i386/cpupi.pas

@@ -39,8 +39,8 @@ unit cpupi;
 
 
   implementation
   implementation
 
 
-    procedure ti386procinfo.allocate_interrupt_stackframe;
 
 
+    procedure ti386procinfo.allocate_interrupt_stackframe;
       begin
       begin
          { we push Flags and CS as long
          { we push Flags and CS as long
            to cope with the IRETD
            to cope with the IRETD
@@ -53,7 +53,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * updated for removed lexlevel
 
 
   Revision 1.1  2002/08/17 09:23:44  florian
   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
                     if (found <> 0) and
                        ((base.enum = R_NO) or
                        ((base.enum = R_NO) or
                         regModified[base.enum] or
                         regModified[base.enum] or
-                        (base.enum = procinfo.framepointer.enum)) and
+                        (base.enum = current_procinfo.framepointer.enum)) and
                        ((index.enum = R_NO) or
                        ((index.enum = R_NO) or
                         regModified[index.enum]) and
                         regModified[index.enum]) and
                         not(regInRef(tmpReg,Taicpu(hp3).oper[0].ref^)) then
                         not(regInRef(tmpReg,Taicpu(hp3).oper[0].ref^)) then
@@ -1418,7 +1418,7 @@ begin
   for regcount := LoGPReg to HiGPReg do
   for regcount := LoGPReg to HiGPReg do
     if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and
     if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and
        (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1].ref^.base
        (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1].ref^.base
-         = procinfo.framepointer) then
+         = current_procinfo.framepointer) then
       begin
       begin
         pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true;
         pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true;
         clearmemwrites(pTaiProp(t1.optinfo)^.regs[regcount].memwrite,regcount);
         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 }
  { If some registers were different in the old and the new sequence, move }
  { the contents of those old registers to the new ones                    }
  { the contents of those old registers to the new ones                    }
                                    For RegCounter.enum := R_EAX To R_EDI Do
                                    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
                                         (RegInfo.New2OldReg[RegCounter.enum].enum <> R_NO) Then
                                        Begin
                                        Begin
                                          AllocRegBetween(AsmL,RegInfo.New2OldReg[RegCounter.enum],
                                          AllocRegBetween(AsmL,RegInfo.New2OldReg[RegCounter.enum],
@@ -1997,7 +1997,16 @@ End.
 
 
 {
 {
   $Log$
   $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
     * generic constructor working for i386
     * remove fixed self register
     * remove fixed self register
     * esi added as address register for i386
     * esi added as address register for i386

+ 29 - 20
compiler/i386/daopt386.pas

@@ -397,18 +397,18 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
   end;
   end;
 
 
 begin
 begin
-    case aktprocdef.rettype.def.deftype of
+    case current_procdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
          classrefdef,forwarddef:
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
       orddef:
       orddef:
-        if aktprocdef.rettype.def.size <> 0 then
+        if current_procdef.rettype.def.size <> 0 then
           begin
           begin
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             { for int64/qword }
             { for int64/qword }
-            if aktprocdef.rettype.def.size = 8 then
+            if current_procdef.rettype.def.size = 8 then
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
           end;
           end;
     end;
     end;
@@ -418,18 +418,18 @@ procedure getNoDeallocRegs(var regs: TRegSet);
 var regCounter: ToldRegister;
 var regCounter: ToldRegister;
 begin
 begin
   regs := [];
   regs := [];
-    case aktprocdef.rettype.def.deftype of
+    case current_procdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
          classrefdef,forwarddef:
        regs := [R_EAX];
        regs := [R_EAX];
       orddef:
       orddef:
-        if aktprocdef.rettype.def.size <> 0 then
+        if current_procdef.rettype.def.size <> 0 then
           begin
           begin
             regs := [R_EAX];
             regs := [R_EAX];
             { for int64/qword }
             { for int64/qword }
-            if aktprocdef.rettype.def.size = 8 then
+            if current_procdef.rettype.def.size = 8 then
               regs := regs + [R_EDX];
               regs := regs + [R_EDX];
           end;
           end;
     end;
     end;
@@ -1341,7 +1341,7 @@ Begin
           (Taicpu(p).opcode = A_LEA)) and
           (Taicpu(p).opcode = A_LEA)) and
          (Taicpu(p).oper[0].typ = top_ref) Then
          (Taicpu(p).oper[0].typ = top_ref) Then
         With Taicpu(p).oper[0].ref^ Do
         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
               (assigned(symbol) and (base.enum = R_NO))) And
              (Index.enum = R_NO) Then
              (Index.enum = R_NO) Then
             Begin
             Begin
@@ -1425,27 +1425,27 @@ Begin
     Begin
     Begin
       Case Taicpu(p).oper[0].typ Of
       Case Taicpu(p).oper[0].typ Of
         top_reg:
         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];
             RegSet := RegSet + [Taicpu(p).oper[0].reg];
         top_ref:
         top_ref:
           With TReference(Taicpu(p).oper[0]^) Do
           With TReference(Taicpu(p).oper[0]^) Do
             Begin
             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];
                 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];
                 Then RegSet := RegSet + [Index];
             End;
             End;
       End;
       End;
       Case Taicpu(p).oper[1].typ Of
       Case Taicpu(p).oper[1].typ Of
         top_reg:
         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];
             If RegSet := RegSet + [TRegister(TwoWords(Taicpu(p).oper[1]).Word1];
         top_ref:
         top_ref:
           With TReference(Taicpu(p).oper[1]^) Do
           With TReference(Taicpu(p).oper[1]^) Do
             Begin
             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];
                 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];
                 Then RegSet := RegSet + [Index];
             End;
             End;
       End;
       End;
@@ -1547,9 +1547,9 @@ Begin {checks whether two Taicpu instructions are equal}
               Begin
               Begin
                 With Taicpu(p2).oper[0].ref^ Do
                 With Taicpu(p2).oper[0].ref^ Do
                   Begin
                   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];
                       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];
                       RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index.enum];
                   End;
                   End;
  {add the registers from the reference (.oper[0]) to the RegInfo, all registers
  {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
           Begin
             With Taicpu(p2).oper[0].ref^ Do
             With Taicpu(p2).oper[0].ref^ Do
               Begin
               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
                      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}
  {it won't do any harm if the register is already in RegsLoadedForRef}
                   Begin
                   Begin
@@ -1579,7 +1579,7 @@ Begin {checks whether two Taicpu instructions are equal}
                     Writeln(std_reg2str[base], ' added');
                     Writeln(std_reg2str[base], ' added');
 {$endif csdebug}
 {$endif csdebug}
                   end;
                   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
                      Reg32(Taicpu(p2).oper[1].reg).enum,R_NO,R_ESP]) Then
                   Begin
                   Begin
                     RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index.enum];
                     RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index.enum];
@@ -1589,7 +1589,7 @@ Begin {checks whether two Taicpu instructions are equal}
                   end;
                   end;
 
 
               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
               Then
                 Begin
                 Begin
                   RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
                   RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
@@ -1738,7 +1738,7 @@ function isSimpleRef(const ref: treference): boolean;
 begin
 begin
   isSimpleRef :=
   isSimpleRef :=
     assigned(ref.symbol) or
     assigned(ref.symbol) or
-    (ref.base.enum = procinfo.framepointer.enum);
+    (ref.base.enum = current_procinfo.framepointer.enum);
 end;
 end;
 
 
 function containsPointerRef(p: Tai): boolean;
 function containsPointerRef(p: Tai): boolean;
@@ -2669,7 +2669,16 @@ End.
 
 
 {
 {
   $Log$
   $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
     * generic constructor working for i386
     * remove fixed self register
     * remove fixed self register
     * esi added as address register for i386
     * 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 }
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo.flags:=procinfo.flags or pi_do_call
+           include(current_procinfo.flags,pi_do_call)
          else
          else
            begin
            begin
               { a smallset needs maybe an misc. register }
               { a smallset needs maybe an misc. register }
@@ -612,7 +612,7 @@ implementation
 
 
       begin
       begin
         if (cs_create_smart in aktmoduleswitches) then
         if (cs_create_smart in aktmoduleswitches) then
-          jumpsegment:=procinfo.aktlocaldata
+          jumpsegment:=current_procinfo.aktlocaldata
         else
         else
           jumpsegment:=datasegment;
           jumpsegment:=datasegment;
         if not(jumptable_no_range) then
         if not(jumptable_no_range) then
@@ -738,7 +738,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills
     * Tweak to register allocator to cause less spills

+ 16 - 7
compiler/i386/popt386.pas

@@ -75,8 +75,8 @@ begin
          (hp2.typ = ait_instruction) and
          (hp2.typ = ait_instruction) and
          ((Taicpu(hp2).opcode = A_LEAVE) or
          ((Taicpu(hp2).opcode = A_LEAVE) or
           (Taicpu(hp2).opcode = A_RET)) and
           (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
          (Taicpu(p).oper[0].ref^.Index.enum = R_NO) then
         begin
         begin
           asml.remove(p);
           asml.remove(p);
@@ -994,8 +994,8 @@ Begin
                               If ((Taicpu(hp1).opcode = A_LEAVE) Or
                               If ((Taicpu(hp1).opcode = A_LEAVE) Or
                                   (Taicpu(hp1).opcode = A_RET)) And
                                   (Taicpu(hp1).opcode = A_RET)) And
                                  (Taicpu(p).oper[1].typ = top_ref) 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[1].ref^.index.enum = R_NO) And
                                  (Taicpu(p).oper[0].typ = top_reg)
                                  (Taicpu(p).oper[0].typ = top_reg)
                                 Then
                                 Then
@@ -1561,9 +1561,9 @@ Begin
                      (hp2.typ = ait_instruction) And
                      (hp2.typ = ait_instruction) And
                      ((Taicpu(hp2).opcode = A_LEAVE) or
                      ((Taicpu(hp2).opcode = A_LEAVE) or
                       (Taicpu(hp2).opcode = A_RET)) And
                       (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^.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
                      (hp1.typ = ait_instruction) And
                      (Taicpu(hp1).opcode = A_MOV) And
                      (Taicpu(hp1).opcode = A_MOV) And
                      (Taicpu(hp1).opsize = S_B) And
                      (Taicpu(hp1).opsize = S_B) And
@@ -2058,7 +2058,16 @@ End.
 
 
 {
 {
   $Log$
   $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
     * generic constructor working for i386
     * remove fixed self register
     * remove fixed self register
     * esi added as address register for i386
     * esi added as address register for i386

+ 11 - 2
compiler/i386/ra386int.pas

@@ -1109,7 +1109,7 @@ Begin
               end;
               end;
              if GotOffset then
              if GotOffset then
               begin
               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
                  begin
                    opr.ref.base.enum:=R_INTREGISTER;
                    opr.ref.base.enum:=R_INTREGISTER;
                    opr.ref.base.number:=NR_NO;
                    opr.ref.base.number:=NR_NO;
@@ -1961,7 +1961,16 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
     * removed some ie checks
 
 
   Revision 1.44  2003/03/28 19:16:57  peter
   Revision 1.44  2003/03/28 19:16:57  peter

+ 34 - 25
compiler/i386/radirect.pas

@@ -78,22 +78,22 @@ interface
            if s<>'' then
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
             { 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
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
            s:='';
          end;
          end;
 
 
      begin
      begin
        ende:=false;
        ende:=false;
        s:='';
        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);
        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
        else
          retstr:='';
          retstr:='';
          c:=current_scanner.asmgetchar;
          c:=current_scanner.asmgetchar;
@@ -137,22 +137,22 @@ interface
                              FwaitWarning
                              FwaitWarning
                             else
                             else
                             { access to local variables }
                             { access to local variables }
-                            if assigned(aktprocdef) then
+                            if assigned(current_procdef) then
                               begin
                               begin
                                  { is the last written character an special }
                                  { is the last written character an special }
                                  { char ?                                   }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
                                  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('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
                                     (pos('AL',upper(hs))>0)) then
-                                   tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                                   tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
                                    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
                                       else
                                         sym:=nil;
                                         sym:=nil;
                                       if assigned(sym) then
                                       if assigned(sym) then
@@ -186,8 +186,8 @@ interface
                                         end
                                         end
                                       else
                                       else
                                         begin
                                         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
                                            else
                                              sym:=nil;
                                              sym:=nil;
                                            if assigned(sym) then
                                            if assigned(sym) then
@@ -196,7 +196,7 @@ interface
                                                   begin
                                                   begin
                                                      l:=tvarsym(sym).address;
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
                                                      { set offset }
-                                                     inc(l,aktprocdef.parast.address_fixup);
+                                                     inc(l,current_procdef.parast.address_fixup);
                                                      hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
                                                      hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
                                                      if pos(',',s) > 0 then
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
                                                        tvarsym(sym).varstate:=vs_used;
@@ -241,15 +241,15 @@ interface
                                              end
                                              end
                                            else if upper(hs)='__SELF' then
                                            else if upper(hs)='__SELF' then
                                              begin
                                              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]+')'
                                                       '('+gas_reg2str[framereg.enum]+')'
                                                 else
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
                                              end
                                            else if upper(hs)='__RESULT' then
                                            else if upper(hs)='__RESULT' then
                                              begin
                                              begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                if (not is_void(current_procdef.rettype.def)) then
                                                   hs:=retstr
                                                   hs:=retstr
                                                 else
                                                 else
                                                   Message(asmr_e_void_function);
                                                   Message(asmr_e_void_function);
@@ -258,8 +258,8 @@ interface
                                              begin
                                              begin
                                                 { complicate to check there }
                                                 { complicate to check there }
                                                 { we do it: }
                                                 { 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]+')'
                                                     '('+gas_reg2str[framereg.enum]+')'
                                                 else
                                                 else
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
@@ -273,7 +273,7 @@ interface
                    end;
                    end;
  '{',';',#10,#13 : begin
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
                       if pos(retstr,s) > 0 then
-                        tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                        tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                      writeasmline;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                      c:=current_scanner.asmgetchar;
                    end;
                    end;
@@ -308,8 +308,17 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/import.pas

@@ -238,8 +238,17 @@ end;
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/m68k/cgcpu.pas

@@ -1079,10 +1079,10 @@ Implementation
       begin
       begin
        {Routines with the poclearstack flag set use only a ret.}
        {Routines with the poclearstack flag set use only a ret.}
        { also routines with parasize=0     }
        { also routines with parasize=0     }
-         if (po_clearstack in aktprocdef.procoptions) then
+         if (po_clearstack in current_procdef.procoptions) then
            begin
            begin
              { complex return values are removed from stack in C code PM }
              { 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))
                list.concat(taicpu.op_const(A_RTD,S_NO,4))
              else
              else
                list.concat(taicpu.op_none(A_RTS,S_NO));
                list.concat(taicpu.op_none(A_RTS,S_NO));
@@ -1337,7 +1337,16 @@ end.
 
 
 {
 {
   $Log$
   $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
     * fix m68k compile
 
 
   Revision 1.18  2003/02/19 22:00:16  daniel
   Revision 1.18  2003/02/19 22:00:16  daniel

+ 12 - 10
compiler/nadd.pas

@@ -1745,8 +1745,7 @@ implementation
                  expectloc:=LOC_CREFERENCE;
                  expectloc:=LOC_CREFERENCE;
                  calcregisters(self,0,0,0);
                  calcregisters(self,0,0,0);
                  { here we call SET... }
                  { 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;
            end
            end
 
 
@@ -1765,17 +1764,11 @@ implementation
             begin
             begin
               if is_widestring(ld) then
               if is_widestring(ld) then
                 begin
                 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 }
                    { this is only for add, the comparisaion is handled later }
                    expectloc:=LOC_REGISTER;
                    expectloc:=LOC_REGISTER;
                 end
                 end
               else if is_ansistring(ld) then
               else if is_ansistring(ld) then
                 begin
                 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 }
                    { this is only for add, the comparisaion is handled later }
                    expectloc:=LOC_REGISTER;
                    expectloc:=LOC_REGISTER;
                 end
                 end
@@ -1957,7 +1950,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * add string returns in LOC_REFERENCE
 
 
   Revision 1.85  2003/04/24 22:29:57  florian
   Revision 1.85  2003/04/24 22:29:57  florian
@@ -2056,7 +2058,7 @@ end.
       ctypeconvnode.create_explicit() statements
       ctypeconvnode.create_explicit() statements
 
 
   Revision 1.62  2002/08/17 09:23:34  florian
   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
   Revision 1.61  2002/08/15 15:15:55  carl
     * jmpbuf size allocation for exceptions is now cpu specific (as it should)
     * 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 }
                    { concat function result to exit }
                    { this is wrong for string or other complex
                    { this is wrong for string or other complex
                      result types !!! }
                      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(hp.right) and
                       assigned(tstatementnode(hp.right).left) and
                       assigned(tstatementnode(hp.right).left) and
                       (tstatementnode(hp.right).left.nodetype=exitn) and
                       (tstatementnode(hp.right).left.nodetype=exitn) and
@@ -559,7 +559,7 @@ implementation
       begin
       begin
          result:=nil;
          result:=nil;
          expectloc:=LOC_VOID;
          expectloc:=LOC_VOID;
-         procinfo.flags:=procinfo.flags or pi_uses_asm;
+         include(current_procinfo.flags,pi_uses_asm);
       end;
       end;
 
 
 
 
@@ -803,7 +803,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter
     * vs_hidden parameter for funcret passed in parameter

+ 45 - 42
compiler/ncal.pas

@@ -312,7 +312,7 @@ type
             begin
             begin
               if (srsym.typ<>procsym) then
               if (srsym.typ<>procsym) then
                internalerror(200111022);
                internalerror(200111022);
-              if srsym.is_visible_for_proc(aktprocdef) then
+              if srsym.is_visible_for_proc(current_procdef) then
                begin
                begin
                  srsym.add_para_match_to(Aprocsym);
                  srsym.add_para_match_to(Aprocsym);
                  { we can stop if the overloads were already added
                  { we can stop if the overloads were already added
@@ -1173,7 +1173,7 @@ type
               when the callnode is generated by a property }
               when the callnode is generated by a property }
             if (nf_isproperty in flags) or
             if (nf_isproperty in flags) or
                (pd.owner.symtabletype<>objectsymtable) or
                (pd.owner.symtabletype<>objectsymtable) or
-               pd.is_visible_for_proc(aktprocdef) then
+               pd.is_visible_for_proc(current_procdef) then
              begin
              begin
                { only when the # of parameter are supported by the
                { only when the # of parameter are supported by the
                  procedure }
                  procedure }
@@ -1204,7 +1204,7 @@ type
                   { process only visible procsyms }
                   { process only visible procsyms }
                   if assigned(srprocsym) and
                   if assigned(srprocsym) and
                      (srprocsym.typ=procsym) and
                      (srprocsym.typ=procsym) and
-                     srprocsym.is_visible_for_proc(aktprocdef) then
+                     srprocsym.is_visible_for_proc(current_procdef) then
                    begin
                    begin
                      { if this procedure doesn't have overload we can stop
                      { if this procedure doesn't have overload we can stop
                        searching }
                        searching }
@@ -1910,13 +1910,8 @@ type
          else
          else
            resulttype:=restype;
            resulttype:=restype;
 
 
-
          if resulttype.def.needs_inittable then
          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
          if assigned(methodpointer) then
           begin
           begin
@@ -1936,7 +1931,7 @@ type
             if (methodpointer.nodetype=typen) and
             if (methodpointer.nodetype=typen) and
                (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
                (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
                is_object(methodpointer.resulttype.def) 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);
              CGMessage(cg_w_member_cd_call_from_method);
 
 
             if not(methodpointer.nodetype in [typen,hnewn]) then
             if not(methodpointer.nodetype in [typen,hnewn]) then
@@ -2085,7 +2080,7 @@ type
 
 
               { procedure does a call }
               { procedure does a call }
               if not (block_type in [bt_const,bt_type]) then
               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.incrementintregisterpushed(all_intregisters);
               rg.incrementotherregisterpushed(all_registers);
               rg.incrementotherregisterpushed(all_registers);
            end
            end
@@ -2119,7 +2114,7 @@ type
               else
               else
                 begin
                 begin
                   if not (block_type in [bt_const,bt_type]) then
                   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;
                 end;
 
 
              { It doesn't hurt to calculate it already though :) (JM) }
              { It doesn't hurt to calculate it already though :) (JM) }
@@ -2441,36 +2436,35 @@ type
         storeparasymtable,
         storeparasymtable,
         storelocalsymtable : tsymtabletype;
         storelocalsymtable : tsymtabletype;
         oldprocdef : tprocdef;
         oldprocdef : tprocdef;
-        oldprocinfo : tprocinfo;
+        old_current_procinfo : tprocinfo;
         oldinlining_procedure : boolean;
         oldinlining_procedure : boolean;
       begin
       begin
         result:=nil;
         result:=nil;
         oldinlining_procedure:=inlining_procedure;
         oldinlining_procedure:=inlining_procedure;
-        oldprocdef:=aktprocdef;
-        oldprocinfo:=procinfo;
+        oldprocdef:=current_procdef;
+        old_current_procinfo:=current_procinfo;
         { we're inlining a procedure }
         { we're inlining a procedure }
         inlining_procedure:=true;
         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 }
         { 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 }
         { pass inlinetree }
         resulttypepass(inlinetree);
         resulttypepass(inlinetree);
@@ -2483,15 +2477,15 @@ type
         if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
         if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
           inc(para_size,POINTER_SIZE);
           inc(para_size,POINTER_SIZE);
 
 
-        { restore procinfo }
-        procinfo.free;
-        procinfo:=oldprocinfo;
+        { restore current_procinfo }
+        current_procinfo.free;
+        current_procinfo:=old_current_procinfo;
         { restore symtable }
         { 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 }
         { restore }
-        aktprocdef:=oldprocdef;
+        current_procdef:=oldprocdef;
         inlining_procedure:=oldinlining_procedure;
         inlining_procedure:=oldinlining_procedure;
       end;
       end;
 
 
@@ -2523,12 +2517,21 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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,
     * do callparatemp stuff only after the parameters have been firstpassed,
       because some nodes are turned into calls during the firstpass
       because some nodes are turned into calls during the firstpass
 
 
   Revision 1.145  2003/04/27 07:29:50  peter
   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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead
@@ -2777,7 +2780,7 @@ end.
     * some ppc stuff fixed
     * some ppc stuff fixed
 
 
   Revision 1.85  2002/08/17 09:23:34  florian
   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
   Revision 1.84  2002/08/16 14:24:57  carl
     * issameref() to test if two references are the same (then emit no opcodes)
     * 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
          if inlining_procedure then
            begin
            begin
              objectlibrary.CreateUsedAsmSymbolList;
              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);
              hp:=tai(p_asm.first);
              while assigned(hp) do
              while assigned(hp) do
               begin
               begin
@@ -212,7 +212,7 @@ interface
            begin
            begin
              { if the routine is an inline routine, then we must hold a copy
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
                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)
                exprasmList.concatlistcopy(p_asm)
              else
              else
                exprasmList.concatlist(p_asm);
                exprasmList.concatlist(p_asm);
@@ -239,7 +239,8 @@ interface
               if assigned(hp.left) then
               if assigned(hp.left) then
                begin
                begin
                {$ifndef newra}
                {$ifndef newra}
-                 rg.cleartempgen;
+                 if nf_releasetemps in flags then
+                   rg.cleartempgen;
                {$endif newra}
                {$endif newra}
                  secondpass(hp.left);
                  secondpass(hp.left);
                  location_copy(hp.location,hp.left.location);
                  location_copy(hp.location,hp.left.location);
@@ -315,7 +316,20 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 55 - 47
compiler/ncgcal.pas

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

+ 13 - 4
compiler/ncgflw.pas

@@ -751,7 +751,7 @@ implementation
                         goto do_jmp;
                         goto do_jmp;
                       end;
                       end;
                   end;
                   end;
-                  case aktprocdef.rettype.def.deftype of
+                  case current_procdef.rettype.def.deftype of
                     pointerdef,
                     pointerdef,
                     procvardef :
                     procvardef :
                       begin
                       begin
@@ -776,7 +776,7 @@ implementation
                       end;
                       end;
                     else
                     else
                       begin
                       begin
-                        cgsize:=def_cgsize(aktprocdef.rettype.def);
+                        cgsize:=def_cgsize(current_procdef.rettype.def);
                         allocated_acc := true;
                         allocated_acc := true;
 {$ifndef cpu64bit}
 {$ifndef cpu64bit}
 
 
@@ -819,7 +819,7 @@ implementation
 {$endif cpu64bit}
 {$endif cpu64bit}
 {$ifndef i386}
 {$ifndef i386}
                   r.enum:=fpu_result_reg;
                   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);
                     cg.a_reg_dealloc(exprasmlist,r);
 {$endif not i386}
 {$endif not i386}
                end;
                end;
@@ -1531,7 +1531,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 11 - 2
compiler/ncginl.pas

@@ -245,7 +245,7 @@ implementation
               LOC_REGISTER :
               LOC_REGISTER :
                 begin
                 begin
                   if (left.resulttype.def.deftype=classrefdef) or
                   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)
                     cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,hregister)
                   else
                   else
                    begin
                    begin
@@ -671,7 +671,16 @@ end.
 
 
 {
 {
   $Log$
   $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
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills
     * Tweak to register allocator to cause less spills

+ 16 - 7
compiler/ncgld.pas

@@ -191,7 +191,7 @@ implementation
                               inlinelocalsymtable,
                               inlinelocalsymtable,
                               inlineparasymtable :
                               inlineparasymtable :
                                 begin
                                 begin
-                                  location.reference.base:=procinfo.framepointer;
+                                  location.reference.base:=current_procinfo.framepointer;
                                   if (symtabletype in [inlinelocalsymtable,
                                   if (symtabletype in [inlinelocalsymtable,
                                                        localsymtable])
                                                        localsymtable])
 {$ifdef powerpc}
 {$ifdef powerpc}
@@ -215,14 +215,14 @@ implementation
                                          location.reference.offset:=-location.reference.offset;
                                          location.reference.offset:=-location.reference.offset;
                                     end;
                                     end;
 {$endif powerpc}
 {$endif powerpc}
-                                  if (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
+                                  if (current_procdef.parast.symtablelevel>symtable.symtablelevel) then
                                     begin
                                     begin
                                        hregister:=rg.getaddressregister(exprasmlist);
                                        hregister:=rg.getaddressregister(exprasmlist);
                                        { make a reference }
                                        { 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);
                                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                                        { walk parents }
                                        { walk parents }
-                                       i:=aktprocdef.parast.symtablelevel-1;
+                                       i:=current_procdef.parast.symtablelevel-1;
                                        while (i>symtable.symtablelevel) do
                                        while (i>symtable.symtablelevel) do
                                          begin
                                          begin
                                             { make a reference }
                                             { make a reference }
@@ -240,7 +240,7 @@ implementation
                                 end;
                                 end;
                               stt_exceptsymtable:
                               stt_exceptsymtable:
                                 begin
                                 begin
-                                   location.reference.base:=procinfo.framepointer;
+                                   location.reference.base:=current_procinfo.framepointer;
                                    location.reference.offset:=tvarsym(symtableentry).address;
                                    location.reference.offset:=tvarsym(symtableentry).address;
                                 end;
                                 end;
                               objectsymtable:
                               objectsymtable:
@@ -953,8 +953,17 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 17 - 8
compiler/ncgmem.pas

@@ -350,7 +350,7 @@ implementation
       begin
       begin
          if (resulttype.def.deftype=classrefdef) or
          if (resulttype.def.deftype=classrefdef) or
             (is_class(resulttype.def) or
             (is_class(resulttype.def) or
-             (po_staticmethod in aktprocdef.procoptions)) then
+             (po_staticmethod in current_procdef.procoptions)) then
           begin
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);
             location_reset(location,LOC_REGISTER,OS_ADDR);
             location.register:=cg.g_load_self(exprasmlist);
             location.register:=cg.g_load_self(exprasmlist);
@@ -397,7 +397,7 @@ implementation
 
 
                usetemp:=false;
                usetemp:=false;
                if (left.nodetype=loadn) and
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocdef.localst) then
+                  (tloadnode(left).symtable=current_procdef.localst) then
                  begin
                  begin
                     { for locals use the local storage }
                     { for locals use the local storage }
                     withreference:=left.location.reference;
                     withreference:=left.location.reference;
@@ -434,7 +434,7 @@ implementation
                for i:=1 to tablecount do
                for i:=1 to tablecount do
                 begin
                 begin
                   if (left.nodetype=loadn) and
                   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).direct_with:=true;
                   twithsymtable(symtable).withnode:=self;
                   twithsymtable(symtable).withnode:=self;
                   symtable:=symtable.next;
                   symtable:=symtable.next;
@@ -471,13 +471,13 @@ implementation
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
                          '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
                          '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
                          tostr(N_LSYM)+',0,0,'+tostr(withreference.offset))));
                          tostr(N_LSYM)+',0,0,'+tostr(withreference.offset))));
-                      mangled_length:=length(aktprocdef.mangledname);
+                      mangled_length:=length(current_procdef.mangledname);
                       getmem(pp,mangled_length+50);
                       getmem(pp,mangled_length+50);
                       strpcopy(pp,'192,0,0,'+withstartlabel.name);
                       strpcopy(pp,'192,0,0,'+withstartlabel.name);
                       if (target_info.use_function_relative_addresses) then
                       if (target_info.use_function_relative_addresses) then
                         begin
                         begin
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocdef.mangledname);
+                          strpcopy(strend(pp),current_procdef.mangledname);
                         end;
                         end;
                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                     end;
                     end;
@@ -499,7 +499,7 @@ implementation
                       if (target_info.use_function_relative_addresses) then
                       if (target_info.use_function_relative_addresses) then
                         begin
                         begin
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocdef.mangledname);
+                          strpcopy(strend(pp),current_procdef.mangledname);
                         end;
                         end;
                        withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        freemem(pp,mangled_length+50);
                        freemem(pp,mangled_length+50);
@@ -580,7 +580,7 @@ implementation
             is_array_of_const(left.resulttype.def) then
             is_array_of_const(left.resulttype.def) then
           begin
           begin
             { cdecl functions don't have high() so we can not check the range }
             { 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
              begin
                { Get high value }
                { Get high value }
                hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
                hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
@@ -946,7 +946,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 187 - 177
compiler/ncgutil.pas

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

+ 12 - 3
compiler/ncnv.pas

@@ -1126,7 +1126,7 @@ implementation
 
 
           te_convert_operator :
           te_convert_operator :
             begin
             begin
-              procinfo.flags:=procinfo.flags or pi_do_call;
+              include(current_procinfo.flags,pi_do_call);
               hp:=ccallnode.create(ccallparanode.create(left,nil),
               hp:=ccallnode.create(ccallparanode.create(left,nil),
                                    overloaded_operators[_assignment],nil,nil);
                                    overloaded_operators[_assignment],nil,nil);
               { tell explicitly which def we must use !! (PM) }
               { tell explicitly which def we must use !! (PM) }
@@ -2091,7 +2091,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     + added currency support based on int64
     + is_64bit for use in cg units instead of is_64bitint
     + is_64bit for use in cg units instead of is_64bitint
     * removed cgmessage from n386add, replace with internalerrors
     * removed cgmessage from n386add, replace with internalerrors
@@ -2235,7 +2244,7 @@ end.
       functions was requested
       functions was requested
 
 
   Revision 1.70  2002/08/17 09:23:36  florian
   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
   Revision 1.69  2002/08/14 19:26:55  carl
     + generic int_to_real type conversion
     + generic int_to_real type conversion

+ 22 - 12
compiler/nflw.pas

@@ -739,8 +739,8 @@ implementation
          if (
          if (
              (hp.nodetype=loadn) and
              (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
              ) and
              not(
              not(
                  (tloadnode(hp).symtableentry.typ=varsym) and
                  (tloadnode(hp).symtableentry.typ=varsym) and
@@ -886,21 +886,22 @@ implementation
          begin
          begin
            if assigned(left) then
            if assigned(left) then
             begin
             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
                begin
                  left:=cassignmentnode.create(
                  left:=cassignmentnode.create(
-                     cloadnode.create(aktprocdef.funcretsym,aktprocdef.funcretsym.owner),
+                     cloadnode.create(current_procdef.funcretsym,current_procdef.funcretsym.owner),
                      left);
                      left);
                  onlyassign:=true;
                  onlyassign:=true;
                end
                end
               else
               else
                begin
                begin
                  { mark funcretsym as assigned }
                  { 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;
             end;
          end;
          end;
@@ -1498,8 +1499,17 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead
@@ -1614,7 +1624,7 @@ end.
     * some ppc stuff fixed
     * some ppc stuff fixed
 
 
   Revision 1.45  2002/08/17 09:23:37  florian
   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
   Revision 1.44  2002/07/21 06:58:49  daniel
   * Changed booleans into flags
   * 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  }
         { create a blocknode in which the successive write/read statements will be  }
         { put, since they belong together. Also create a dummy statement already to }
         { put, since they belong together. Also create a dummy statement already to }
         { make inserting of additional statements easier                            }
         { 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 we don't have a filepara, create one containing the default }
         if not assigned(filepara) then
         if not assigned(filepara) then
@@ -910,7 +910,7 @@ implementation
         { create the blocknode which will hold the generated statements + }
         { create the blocknode which will hold the generated statements + }
         { an initial dummy statement                                      }
         { 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  }
         { 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 }
         { code is not a 32bit parameter (we already checked whether the }
@@ -1388,7 +1388,7 @@ implementation
               in_sizeof_x:
               in_sizeof_x:
                 begin
                 begin
                   set_varstate(left,false);
                   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
                    begin
                      hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
                      hightree:=load_high_value(tvarsym(tloadnode(left).symtableentry));
                      if assigned(hightree) then
                      if assigned(hightree) then
@@ -2351,7 +2351,20 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     + added currency support based on int64
     + is_64bit for use in cg units instead of is_64bitint
     + is_64bit for use in cg units instead of is_64bitint
     * removed cgmessage from n386add, replace with internalerrors
     * removed cgmessage from n386add, replace with internalerrors

+ 13 - 6
compiler/nld.pas

@@ -371,16 +371,14 @@ implementation
               begin
               begin
                  if tconstsym(symtableentry).consttyp=constresourcestring then
                  if tconstsym(symtableentry).consttyp=constresourcestring then
                    begin
                    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;
                       expectloc:=LOC_CREFERENCE;
                    end;
                    end;
               end;
               end;
             varsym :
             varsym :
               begin
               begin
                 if (symtable.symtabletype in [parasymtable,localsymtable]) and
                 if (symtable.symtabletype in [parasymtable,localsymtable]) and
-                   (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
+                   (current_procdef.parast.symtablelevel>symtable.symtablelevel) then
                   begin
                   begin
                     { if the variable is in an other stackframe then we need
                     { if the variable is in an other stackframe then we need
                       a register to dereference }
                       a register to dereference }
@@ -1129,8 +1127,17 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 13 - 4
compiler/nmem.pas

@@ -915,7 +915,7 @@ implementation
          result:=nil;
          result:=nil;
          if (resulttype.def.deftype=classrefdef) or
          if (resulttype.def.deftype=classrefdef) or
             is_class(resulttype.def) or
             is_class(resulttype.def) or
-            (po_staticmethod in aktprocdef.procoptions) then
+            (po_staticmethod in current_procdef.procoptions) then
            expectloc:=LOC_REGISTER
            expectloc:=LOC_REGISTER
          else
          else
            expectloc:=LOC_CREFERENCE;
            expectloc:=LOC_CREFERENCE;
@@ -1003,7 +1003,7 @@ implementation
             for i:=1 to tablecount do
             for i:=1 to tablecount do
              begin
              begin
                if (left.nodetype=loadn) and
                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).direct_with:=true;
                twithsymtable(symtable).withnode:=self;
                twithsymtable(symtable).withnode:=self;
                symtable:=symtable.next;
                symtable:=symtable.next;
@@ -1059,8 +1059,17 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/nopt.pas

@@ -140,7 +140,7 @@ begin
   expectloc:= LOC_REFERENCE;
   expectloc:= LOC_REFERENCE;
   calcregisters(self,0,0,0);
   calcregisters(self,0,0,0);
   { here we call STRCONCAT or STRCMP or STRCOPY }
   { here we call STRCONCAT or STRCMP or STRCOPY }
-  procinfo.flags:=procinfo.flags or pi_do_call;
+  include(current_procinfo.flags,pi_do_call);
 end;
 end;
 
 
 function taddsstringoptnode.getcopy: tnode;
 function taddsstringoptnode.getcopy: tnode;
@@ -278,7 +278,16 @@ end.
 
 
 {
 {
   $Log$
   $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
     * add string returns in LOC_REFERENCE
 
 
   Revision 1.13  2003/04/22 23:50:23  peter
   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
     * made operator search faster by walking the list only once
 
 
   Revision 1.11  2002/08/17 09:23:37  florian
   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
   Revision 1.10  2002/07/20 11:57:55  florian
     * types.pas renamed to defbase.pas because D6 contains a types
     * 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 }
          { this is not allways true due to optimization }
          { but if we don't set this we get problems with optimizing self code }
          { but if we don't set this we get problems with optimizing self code }
          if tsetdef(right.resulttype.def).settype<>smallset then
          if tsetdef(right.resulttype.def).settype<>smallset then
-           procinfo.flags:=procinfo.flags or pi_do_call
+           include(current_procinfo.flags,pi_do_call)
          else
          else
            begin
            begin
               { a smallset needs maybe an misc. register }
               { a smallset needs maybe an misc. register }
@@ -714,7 +714,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * Ifdefs around a lot of calls to cleartempgen
     * Fixed registers that are allocated but not freed in several nodes
     * Fixed registers that are allocated but not freed in several nodes
     * Tweak to register allocator to cause less spills
     * Tweak to register allocator to cause less spills
@@ -760,7 +769,7 @@ end.
       functions was requested
       functions was requested
 
 
   Revision 1.31  2002/08/17 09:23:38  florian
   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
   Revision 1.30  2002/07/23 13:19:40  jonas
     * fixed evaluation of expressions with empty sets that are calculated
     * fixed evaluation of expressions with empty sets that are calculated

+ 11 - 2
compiler/paramgr.pas

@@ -402,8 +402,17 @@ end.
 
 
 {
 {
    $Log$
    $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
        a new procdef declaration
      * aktprocsym removed
      * aktprocsym removed
      * lexlevel removed, use symtable.symtablelevel instead
      * lexlevel removed, use symtable.symtablelevel instead

+ 16 - 19
compiler/parser.pas

@@ -68,12 +68,12 @@ implementation
          testcurobject:=0;
          testcurobject:=0;
 
 
          { Symtable }
          { Symtable }
-         aktprocdef:=nil;
+         current_procdef:=nil;
 
 
          objectlibrary:=nil;
          objectlibrary:=nil;
          current_module:=nil;
          current_module:=nil;
          compiled_module:=nil;
          compiled_module:=nil;
-         procinfo:=nil;
+         current_procinfo:=nil;
 
 
          loaded_units:=TLinkedList.Create;
          loaded_units:=TLinkedList.Create;
 
 
@@ -116,15 +116,6 @@ implementation
          { codegen }
          { codegen }
          if paraprintnodetree<>0 then
          if paraprintnodetree<>0 then
            printnode_reset;
            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;
       end;
 
 
 
 
@@ -151,9 +142,6 @@ implementation
 
 
          { free list of .o files }
          { free list of .o files }
          SmartLinkOFiles.Free;
          SmartLinkOFiles.Free;
-
-         { codegen }
-         voidprocpi.free;
       end;
       end;
 
 
 
 
@@ -264,7 +252,7 @@ implementation
           olddefaultsymtablestack,
           olddefaultsymtablestack,
           oldsymtablestack : tsymtable;
           oldsymtablestack : tsymtable;
           oldaktprocsym    : tprocsym;
           oldaktprocsym    : tprocsym;
-          oldaktprocdef    : tprocdef;
+          oldcurrent_procdef    : tprocdef;
           oldoverloaded_operators : toverloaded_operators;
           oldoverloaded_operators : toverloaded_operators;
         { cg }
         { cg }
           oldparse_only  : boolean;
           oldparse_only  : boolean;
@@ -327,7 +315,7 @@ implementation
             oldsymtablestack:=symtablestack;
             oldsymtablestack:=symtablestack;
             olddefaultsymtablestack:=defaultsymtablestack;
             olddefaultsymtablestack:=defaultsymtablestack;
             oldrefsymtable:=refsymtable;
             oldrefsymtable:=refsymtable;
-            oldaktprocdef:=aktprocdef;
+            oldcurrent_procdef:=current_procdef;
             oldaktdefproccall:=aktdefproccall;
             oldaktdefproccall:=aktdefproccall;
             move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
             move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
           { save scanner state }
           { save scanner state }
@@ -544,7 +532,7 @@ implementation
                  symtablestack:=oldsymtablestack;
                  symtablestack:=oldsymtablestack;
                  defaultsymtablestack:=olddefaultsymtablestack;
                  defaultsymtablestack:=olddefaultsymtablestack;
                  aktdefproccall:=oldaktdefproccall;
                  aktdefproccall:=oldaktdefproccall;
-                 aktprocdef:=oldaktprocdef;
+                 current_procdef:=oldcurrent_procdef;
                  move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
                  move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
                  aktsourcecodepage:=oldsourcecodepage;
                  aktsourcecodepage:=oldsourcecodepage;
                  aktlocalswitches:=oldaktlocalswitches;
                  aktlocalswitches:=oldaktlocalswitches;
@@ -634,8 +622,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 18 - 9
compiler/pass_2.pas

@@ -278,36 +278,45 @@ implementation
            begin
            begin
               { assign parameter locations }
               { assign parameter locations }
 {$ifndef i386}
 {$ifndef i386}
-              setparalocs(procinfo.procdef);
+              setparalocs(current_procinfo.procdef);
 {$endif i386}
 {$endif i386}
 
 
-              procinfo.after_pass1;
+              current_procinfo.after_pass1;
 
 
               { process register variable stuff (JM) }
               { process register variable stuff (JM) }
               assign_regvars(p);
               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  }
               { for the i386 it must be done in genexitcode because it has  }
               { to add 'fstp' instructions when using fpu regvars and those }
               { to add 'fstp' instructions when using fpu regvars and those }
               { must come after the "exitlabel" (JM)                        }
               { must come after the "exitlabel" (JM)                        }
 {$ifndef i386}
 {$ifndef i386}
-              cleanup_regvars(procinfo.aktexitcode);
+              cleanup_regvars(current_procinfo.aktexitcode);
 {$endif i386}
 {$endif i386}
 
 
               do_secondpass(p);
               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;
            end;
-         procinfo.aktproccode.concatlist(exprasmlist);
+         current_procinfo.aktproccode.concatlist(exprasmlist);
       end;
       end;
 
 
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/pdecl.pas

@@ -633,8 +633,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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
       { Please leave this here, this module should NOT use
         these variables.
         these variables.
         Declaring it as string here results in an error when compiling (PFV) }
         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;
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
@@ -571,7 +571,7 @@ implementation
          pcrd       : tclassrefdef;
          pcrd       : tclassrefdef;
          tt     : ttype;
          tt     : ttype;
          old_object_option : tsymoptions;
          old_object_option : tsymoptions;
-         oldprocinfo : tprocinfo;
+         old_current_procinfo : tprocinfo;
          oldparse_only : boolean;
          oldparse_only : boolean;
          storetypecanbeforward : boolean;
          storetypecanbeforward : boolean;
 
 
@@ -946,9 +946,9 @@ implementation
          testcurobject:=1;
          testcurobject:=1;
          curobjectname:=Upper(n);
          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 ? }
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
@@ -1134,8 +1134,8 @@ implementation
          symtablestack:=symtablestack.next;
          symtablestack:=symtablestack.next;
          aktobjectdef:=nil;
          aktobjectdef:=nil;
          {Restore procinfo}
          {Restore procinfo}
-         procinfo.free;
-         procinfo:=oldprocinfo;
+         current_procinfo.free;
+         current_procinfo:=old_current_procinfo;
          current_object_option:=old_object_option;
          current_object_option:=old_object_option;
 
 
          object_dec:=aktclass;
          object_dec:=aktclass;
@@ -1144,8 +1144,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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
       { Please leave this here, this module should NOT use
         these variables.
         these variables.
         Declaring it as string here results in an error when compiling (PFV) }
         Declaring it as string here results in an error when compiling (PFV) }
-      aktprocdef = 'error';
+      current_procdef = 'error';
 
 
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_funcret_para(pd:tabstractprocdef);
@@ -285,7 +285,6 @@ implementation
              CGMessage(parser_e_self_call_by_value);
              CGMessage(parser_e_self_call_by_value);
            if (pd.deftype=procdef) then
            if (pd.deftype=procdef) then
             begin
             begin
-              inc(procinfo.selfpointer_offset,tvarsym(hpara.parasym).address);
               if compare_defs(hpara.paratype.def,tprocdef(pd)._class,nothingn)=te_incompatible then
               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);
                 CGMessage2(type_e_incompatible_types,hpara.paratype.def.typename,tprocdef(pd)._class.typename);
             end;
             end;
@@ -563,7 +562,7 @@ implementation
               aprocsym:=tprocsym(aclass.symtable.search(sp));
               aprocsym:=tprocsym(aclass.symtable.search(sp));
               { The procedure has been found. So it is
               { The procedure has been found. So it is
                 a global one. Set the flags to mark this.}
                 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 }
               { we solve this below }
               if assigned(aprocsym) then
               if assigned(aprocsym) then
                begin
                begin
@@ -674,7 +673,7 @@ implementation
            { Set global flag when found in globalsytmable }
            { Set global flag when found in globalsytmable }
            if (not parse_only) and
            if (not parse_only) and
               (aprocsym.owner.symtabletype=globalsymtable) then
               (aprocsym.owner.symtabletype=globalsymtable) then
-             procinfo.flags:=procinfo.flags or pi_is_global;
+             include(current_procinfo.flags,pi_is_global);
          end;
          end;
 
 
         { to get the correct symtablelevel we must ignore objectsymtables }
         { to get the correct symtablelevel we must ignore objectsymtables }
@@ -742,7 +741,7 @@ implementation
                  pd.test_if_fpu_result;
                  pd.test_if_fpu_result;
                  if (pd.rettype.def.deftype=stringdef) and
                  if (pd.rettype.def.deftype=stringdef) and
                     (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
                     (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
-                   procinfo.no_fast_exit:=true;
+                   include(current_procinfo.flags,pi_needs_implicit_finally);
                  dec(testcurobject);
                  dec(testcurobject);
                end;
                end;
               if isclassmethod then
               if isclassmethod then
@@ -784,7 +783,6 @@ implementation
               consume(_OPERATOR);
               consume(_OPERATOR);
               if (token in [first_overloaded..last_overloaded]) then
               if (token in [first_overloaded..last_overloaded]) then
                begin
                begin
-                 procinfo.flags:=procinfo.flags or pi_operator;
                  optoken:=token;
                  optoken:=token;
                end
                end
               else
               else
@@ -865,7 +863,6 @@ begin
   if target_info.system in [system_i386_os2,system_i386_emx] then
   if target_info.system in [system_i386_os2,system_i386_emx] then
    begin
    begin
      tprocdef(pd).aliasnames.insert(tprocdef(pd).procsym.realname);
      tprocdef(pd).aliasnames.insert(tprocdef(pd).procsym.realname);
-     procinfo.exported:=true;
      if cs_link_deffile in aktglobalswitches then
      if cs_link_deffile in aktglobalswitches then
        deffile.AddExport(tprocdef(pd).mangledname);
        deffile.AddExport(tprocdef(pd).mangledname);
    end;
    end;
@@ -1867,11 +1864,6 @@ const
         po_comp : tprocoptions;
         po_comp : tprocoptions;
         aprocsym : tprocsym;
         aprocsym : tprocsym;
       begin
       begin
-        { check if the addresses in parasymtable are calculated }
-        if (pd.para.count>0) and
-           (pd.parast.datasize=0) then
-          internalerror(200304254);
-
         forwardfound:=false;
         forwardfound:=false;
         aprocsym:=tprocsym(pd.procsym);
         aprocsym:=tprocsym(pd.procsym);
 
 
@@ -2131,8 +2123,17 @@ const
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 30 - 20
compiler/pexpr.pas

@@ -289,7 +289,7 @@ implementation
                     consume(_RKLAMMER);
                     consume(_RKLAMMER);
                     if (block_type=bt_except) then
                     if (block_type=bt_except) then
                       Message(parser_e_exit_with_argument_not__possible);
                       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);
                       Message(parser_e_void_function);
                  end
                  end
                else
                else
@@ -1075,8 +1075,8 @@ implementation
                       also has objectsymtable. And withsymtable is
                       also has objectsymtable. And withsymtable is
                       not possible for self in class methods (PFV) }
                       not possible for self in class methods (PFV) }
                     if (srsymtable.symtabletype=objectsymtable) and
                     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);
                       Message(parser_e_only_class_methods);
                     if (sp_static in srsym.symoptions) then
                     if (sp_static in srsym.symoptions) then
                      begin
                      begin
@@ -1124,11 +1124,11 @@ implementation
                            is_object(htype.def) then
                            is_object(htype.def) then
                          begin
                          begin
                            consume(_POINT);
                            consume(_POINT);
-                           if assigned(procinfo) and
-                              assigned(procinfo.procdef._class) and
+                           if assigned(current_procdef) and
+                              assigned(current_procdef._class) and
                               not(getaddr) then
                               not(getaddr) then
                             begin
                             begin
-                              if procinfo.procdef._class.is_related(tobjectdef(htype.def)) then
+                              if current_procdef._class.is_related(tobjectdef(htype.def)) then
                                begin
                                begin
                                  p1:=ctypenode.create(htype);
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
                                  { search also in inherited methods }
@@ -1262,8 +1262,8 @@ implementation
                     { are we in a class method ? }
                     { are we in a class method ? }
                     possible_error:=(srsym.owner.symtabletype=objectsymtable) and
                     possible_error:=(srsym.owner.symtabletype=objectsymtable) and
                                     not(is_interface(tdef(srsym.owner.defowner))) 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,
                     do_proc_call(srsym,srsymtable,
                                  (getaddr and not(token in [_CARET,_POINT])),
                                  (getaddr and not(token in [_CARET,_POINT])),
                                  again,p1);
                                  again,p1);
@@ -1281,8 +1281,8 @@ implementation
                     { access to property in a method }
                     { access to property in a method }
                     { are we in a class method ? }
                     { are we in a class method ? }
                     if (srsym.owner.symtabletype=objectsymtable) and
                     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);
                      Message(parser_e_only_class_methods);
                     { no method pointer }
                     { no method pointer }
                     p1:=nil;
                     p1:=nil;
@@ -1729,7 +1729,8 @@ implementation
              begin
              begin
                again:=true;
                again:=true;
                consume(_SELF);
                consume(_SELF);
-               if not assigned(procinfo.procdef._class) then
+               if not(assigned(current_procdef) and
+                      assigned(current_procdef._class)) then
                 begin
                 begin
                   p1:=cerrornode.create;
                   p1:=cerrornode.create;
                   again:=false;
                   again:=false;
@@ -1737,14 +1738,14 @@ implementation
                 end
                 end
                else
                else
                 begin
                 begin
-                  if (po_classmethod in aktprocdef.procoptions) then
+                  if (po_classmethod in current_procdef.procoptions) then
                    begin
                    begin
                      { self in class methods is a class reference type }
                      { 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));
                      p1:=cselfnode.create(tclassrefdef.create(htype));
                    end
                    end
                   else
                   else
-                   p1:=cselfnode.create(procinfo.procdef._class);
+                   p1:=cselfnode.create(current_procdef._class);
                   postfixoperators(p1,again);
                   postfixoperators(p1,again);
                 end;
                 end;
              end;
              end;
@@ -1753,18 +1754,18 @@ implementation
              begin
              begin
                again:=true;
                again:=true;
                consume(_INHERITED);
                consume(_INHERITED);
-               if assigned(aktprocdef._class) then
+               if assigned(current_procdef._class) then
                 begin
                 begin
-                  classh:=aktprocdef._class.childof;
+                  classh:=current_procdef._class.childof;
                   { if inherited; only then we need the method with
                   { if inherited; only then we need the method with
                     the same name }
                     the same name }
                   if token in endtokens then
                   if token in endtokens then
                    begin
                    begin
-                     hs:=aktprocdef.procsym.name;
+                     hs:=current_procdef.procsym.name;
                      anon_inherited:=true;
                      anon_inherited:=true;
                      { For message methods we need to search using the message
                      { For message methods we need to search using the message
                        number or string }
                        number or string }
-                     pd:=tprocsym(aktprocdef.procsym).first_procdef;
+                     pd:=tprocsym(current_procdef.procsym).first_procdef;
                      if (po_msgint in pd.procoptions) then
                      if (po_msgint in pd.procoptions) then
                       sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
                       sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
                      else
                      else
@@ -2313,8 +2314,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 57 - 47
compiler/pmodules.pas

@@ -491,7 +491,7 @@ implementation
          oldprocdef : tprocdef;
          oldprocdef : tprocdef;
          unitsym : tunitsym;
          unitsym : tunitsym;
       begin
       begin
-         oldprocdef:=aktprocdef;
+         oldprocdef:=current_procdef;
          consume(_USES);
          consume(_USES);
 {$ifdef DEBUG}
 {$ifdef DEBUG}
          test_symtablestack;
          test_symtablestack;
@@ -614,7 +614,7 @@ implementation
                 end;
                 end;
               pu:=tused_unit(pu.next);
               pu:=tused_unit(pu.next);
            end;
            end;
-          aktprocdef:=oldprocdef;
+          current_procdef:=oldprocdef;
       end;
       end;
 
 
 
 
@@ -707,12 +707,15 @@ implementation
       end;
       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
       var
         stt : tsymtable;
         stt : tsymtable;
         ps  : tprocsym;
         ps  : tprocsym;
         pd  : tprocdef;
         pd  : tprocdef;
       begin
       begin
+        { there should be no current_procinfo available }
+        if assigned(current_procinfo) then
+         internalerror(200304275);
         {Generate a procsym for main}
         {Generate a procsym for main}
         make_ref:=false;
         make_ref:=false;
         { try to insert in in static symtable ! }
         { try to insert in in static symtable ! }
@@ -737,7 +740,29 @@ implementation
           symtable }
           symtable }
         pd.localst.free;
         pd.localst.free;
         pd.localst:=st;
         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;
       end;
 
 
 
 
@@ -745,16 +770,10 @@ implementation
       var
       var
         parasize : longint;
         parasize : longint;
         nostackframe : boolean;
         nostackframe : boolean;
-        pd,
-        oldprocdef : tprocdef;
-        oldprocinfo : tprocinfo;
+        pd : tprocdef;
         oldexitlabel,
         oldexitlabel,
         oldexit2label : tasmlabel;
         oldexit2label : tasmlabel;
       begin
       begin
-        oldprocinfo:=procinfo;
-        oldprocdef:=aktprocdef;
-        oldexitlabel:=aktexitlabel;
-        oldexit2label:=aktexit2label;
         { update module flags }
         { update module flags }
         current_module.flags:=current_module.flags or flag;
         current_module.flags:=current_module.flags or flag;
         { now we can insert a cut }
         { now we can insert a cut }
@@ -764,23 +783,22 @@ implementation
         case flag of
         case flag of
           uf_init :
           uf_init :
             begin
             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('INIT$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
             end;
             end;
           uf_finalize :
           uf_finalize :
             begin
             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('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
             end;
             end;
           else
           else
             internalerror(200304253);
             internalerror(200304253);
         end;
         end;
-        { set procinfo and aktprocdef }
-        procinfo:=voidprocpi;
-        procinfo.procdef:=pd;
-        aktprocdef:=pd;
+        { save labels }
+        oldexitlabel:=aktexitlabel;
+        oldexit2label:=aktexit2label;
         { generate a dummy function }
         { generate a dummy function }
         parasize:=0;
         parasize:=0;
         nostackframe:=false;
         nostackframe:=false;
@@ -789,14 +807,10 @@ implementation
         genentrycode(list,true,0,parasize,nostackframe,false);
         genentrycode(list,true,0,parasize,nostackframe,false);
         genexitcode(list,parasize,nostackframe,false);
         genexitcode(list,parasize,nostackframe,false);
         list.convert_registers;
         list.convert_registers;
-        { cleanup }
-        pd.localst:=nil;
-        procinfo.procdef:=nil;
+        release_main_proc(pd);
         { restore }
         { restore }
         aktexitlabel:=oldexitlabel;
         aktexitlabel:=oldexitlabel;
         aktexit2label:=oldexit2label;
         aktexit2label:=oldexit2label;
-        aktprocdef:=oldprocdef;
-        procinfo:=oldprocinfo;
       end;
       end;
 
 
 
 
@@ -1029,15 +1043,11 @@ implementation
 //         Message1(parser_u_parsing_implementation,current_module.modulename^);
 //         Message1(parser_u_parsing_implementation,current_module.modulename^);
 
 
          { Compile the unit }
          { 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('INIT$$'+current_module.modulename^);
          pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
          pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
-         procinfo:=voidprocpi;
-         procinfo.procdef:=pd;
          compile_proc_body(pd,true,false);
          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
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
            finalization code must be forced }
@@ -1058,14 +1068,11 @@ implementation
               current_module.flags:=current_module.flags or uf_finalize;
               current_module.flags:=current_module.flags or uf_finalize;
 
 
               { Compile the 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('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              procinfo:=voidprocpi;
-              procinfo.procdef:=pd;
               compile_proc_body(pd,true,false);
               compile_proc_body(pd,true,false);
-              procinfo.procdef:=nil;
-              pd.localst:=nil;
+              release_main_proc(pd);
            end
            end
          else if force_init_final then
          else if force_init_final then
            begin
            begin
@@ -1333,7 +1340,7 @@ implementation
            from the bootstrap code.}
            from the bootstrap code.}
          if islibrary then
          if islibrary then
           begin
           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');
             pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
             { Win32 startup code needs a single name }
             { Win32 startup code needs a single name }
 //            if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
 //            if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
@@ -1344,23 +1351,19 @@ implementation
           end
           end
          else
          else
           begin
           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('program_init');
             pd.aliasnames.insert('PASCALMAIN');
             pd.aliasnames.insert('PASCALMAIN');
             pd.aliasnames.insert(target_info.cprefix+'main');
             pd.aliasnames.insert(target_info.cprefix+'main');
           end;
           end;
-         procinfo:=voidprocpi;
-         procinfo.procdef:=pd;
 {$IFDEF SPARC}
 {$IFDEF SPARC}
-         ProcInfo.After_Header;
+         current_procinfo.After_Header;
 {main function is declared as
 {main function is declared as
   PROCEDURE main(ArgC:Integer;ArgV,EnvP:ARRAY OF PChar):Integer;CDECL;
   PROCEDURE main(ArgC:Integer;ArgV,EnvP:ARRAY OF PChar):Integer;CDECL;
 So, all parameters are passerd into registers in sparc architecture.}
 So, all parameters are passerd into registers in sparc architecture.}
 {$ENDIF SPARC}
 {$ENDIF SPARC}
          compile_proc_body(pd,true,false);
          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? }
          { should we force unit initialization? }
          if tstaticsymtable(current_module.localsymtable).needs_init_final then
          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;
               current_module.flags:=current_module.flags or uf_finalize;
 
 
               { Compile the 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('FINALIZE$$'+current_module.modulename^);
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              procinfo:=voidprocpi;
-              procinfo.procdef:=pd;
               compile_proc_body(pd,true,false);
               compile_proc_body(pd,true,false);
-              procinfo.procdef:=nil;
+              release_main_proc(pd);
            end;
            end;
 
 
          { consume the last point }
          { consume the last point }
@@ -1492,8 +1493,17 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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)));
          list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
          if target_info.system=system_powerpc_macos then
          if target_info.system=system_powerpc_macos then
            list.concat(taicpu.op_none(A_NOP));
            list.concat(taicpu.op_none(A_NOP));
-         procinfo.flags:=procinfo.flags or pi_do_call;
+         include(current_procinfo.flags,pi_do_call);
       end;
       end;
 
 
     { calling a procedure by address }
     { calling a procedure by address }
@@ -284,7 +284,7 @@ const
         //if target_info.system=system_powerpc_macos then
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
         //  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')));
         //list.concat(tai_comment.create(strpnew('***** a_call_reg')));
       end;
       end;
 
 
@@ -316,7 +316,7 @@ const
         //if target_info.system=system_powerpc_macos then
         //if target_info.system=system_powerpc_macos then
         //  //NOP is not needed here.
         //  //NOP is not needed here.
         //  list.concat(taicpu.op_none(A_NOP));
         //  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')));
         //list.concat(tai_comment.create(strpnew('***** a_call_ref')));
       end;
       end;
 
 
@@ -966,7 +966,7 @@ const
         r.number:=NR_R0;
         r.number:=NR_R0;
         a_reg_alloc(list,r);
         a_reg_alloc(list,r);
 
 
-        if aktprocdef.parast.symtablelevel>1 then
+        if current_procdef.parast.symtablelevel>1 then
           begin
           begin
              r.enum:=R_INTREGISTER;
              r.enum:=R_INTREGISTER;
              r.number:=NR_R11;
              r.number:=NR_R11;
@@ -981,7 +981,7 @@ const
           end;
           end;
 
 
         usesfpr:=false;
         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
           for regcounter.enum:=R_F14 to R_F31 do
             if regcounter.enum in rg.usedbyproc then
             if regcounter.enum in rg.usedbyproc then
               begin
               begin
@@ -991,7 +991,7 @@ const
               end;
               end;
 
 
         usesgpr:=false;
         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
           for regcounter2:=RS_R14 to RS_R31 do
             begin
             begin
               if regcounter2 in rg.usedintbyproc then
               if regcounter2 in rg.usedintbyproc then
@@ -1004,8 +1004,8 @@ const
             end;
             end;
 
 
         { save link register? }
         { 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
             begin
                { save return address... }
                { save return address... }
                r.enum:=R_INTREGISTER;
                r.enum:=R_INTREGISTER;
@@ -1039,7 +1039,7 @@ const
 
 
         localsize:=align(localsize,16);
         localsize:=align(localsize,16);
 
 
-        tppcprocinfo(procinfo).localsize:=localsize;
+        tppcprocinfo(current_procinfo).localsize:=localsize;
 
 
         if (localsize <> 0) then
         if (localsize <> 0) then
           begin
           begin
@@ -1124,11 +1124,11 @@ const
         { now comes the AltiVec context save, not yet implemented !!! }
         { now comes the AltiVec context save, not yet implemented !!! }
 
 
         { if we're in a nested procedure, we've to save R11 }
         { 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
           begin
              r.enum:=R_INTREGISTER;
              r.enum:=R_INTREGISTER;
              r.number:=NR_R11;
              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));
              list.concat(taicpu.op_reg_ref(A_STW,r,href));
           end;
           end;
       end;
       end;
@@ -1153,7 +1153,7 @@ const
         { AltiVec context restore, not yet implemented !!! }
         { AltiVec context restore, not yet implemented !!! }
 
 
         usesfpr:=false;
         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
           for regcounter.enum:=R_F14 to R_F31 do
             if regcounter.enum in rg.usedbyproc then
             if regcounter.enum in rg.usedbyproc then
               begin
               begin
@@ -1163,7 +1163,7 @@ const
               end;
               end;
 
 
         usesgpr:=false;
         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
           for regcounter2:=RS_R14 to RS_R30 do
             begin
             begin
               if regcounter2 in rg.usedintbyproc then
               if regcounter2 in rg.usedintbyproc then
@@ -1185,9 +1185,9 @@ const
              r2.enum:=R_INTREGISTER;
              r2.enum:=R_INTREGISTER;
              r2.number:=NR_R12;
              r2.number:=NR_R12;
              if usesfpr then
              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
              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 }
              { restore gprs }
              { at least for now we use LMW }
              { at least for now we use LMW }
@@ -1206,7 +1206,7 @@ const
              r.number:=NR_R12;
              r.number:=NR_R12;
              list.concat(taicpu.op_reg_reg_const(A_ADDI,r,r,(ord(R_F31)-ord(firstregfpu.enum)+1)*8));
              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)+
                a_call_name(objectlibrary.newasmsymbol('_restfpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+
                  '_x')
                  '_x')
              else
              else
@@ -1222,10 +1222,10 @@ const
              { adjust r1 }
              { adjust r1 }
              r.enum:=R_INTREGISTER;
              r.enum:=R_INTREGISTER;
              r.number:=NR_R1;
              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? }
              { 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
                  begin
                     r.enum:=R_INTREGISTER;
                     r.enum:=R_INTREGISTER;
                     r.number:=NR_STACK_POINTER_REG;
                     r.number:=NR_STACK_POINTER_REG;
@@ -1253,7 +1253,7 @@ const
 
 
     begin
     begin
       usesfpr:=false;
       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
         for regcounter.enum:=R_F14 to R_F31 do
           if regcounter.enum in rg.usedbyproc then
           if regcounter.enum in rg.usedbyproc then
             begin
             begin
@@ -1263,7 +1263,7 @@ const
             end;
             end;
 
 
       usesgpr:=false;
       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
         for regcounter2:=RS_R13 to RS_R31 do
           begin
           begin
             if regcounter2 in rg.usedintbyproc then
             if regcounter2 in rg.usedintbyproc then
@@ -1332,7 +1332,7 @@ const
 
 
     begin
     begin
       usesfpr:=false;
       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
         for regcounter.enum:=R_F14 to R_F31 do
           if regcounter.enum in rg.usedbyproc then
           if regcounter.enum in rg.usedbyproc then
             begin
             begin
@@ -1342,7 +1342,7 @@ const
             end;
             end;
 
 
       usesgpr:=false;
       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
         for regcounter2:=RS_R13 to RS_R31 do
           begin
           begin
             if regcounter2 in rg.usedintbyproc then
             if regcounter2 in rg.usedintbyproc then
@@ -1480,7 +1480,7 @@ const
         localsize:= align(localsize + macosLinkageAreaSize + registerSaveAreaSize, 16);
         localsize:= align(localsize + macosLinkageAreaSize + registerSaveAreaSize, 16);
         inc(localsize,tg.lasttemp);
         inc(localsize,tg.lasttemp);
         localsize:=align(localsize,16);
         localsize:=align(localsize,16);
-        tppcprocinfo(procinfo).localsize:=localsize;
+        tppcprocinfo(current_procinfo).localsize:=localsize;
 
 
         if (localsize <> 0) then
         if (localsize <> 0) then
           begin
           begin
@@ -2364,7 +2364,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * fix to a_op64_const_reg_reg
 
 
   Revision 1.84  2003/04/26 16:08:41  jonas
   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 }
           { max. of space need for parameters, currently used by the PowerPC port only }
           maxpushedparasize : aword;
           maxpushedparasize : aword;
 
 
-          constructor create;override;
+          constructor create(aparent:tprocinfo);override;
           procedure after_header;override;
           procedure after_header;override;
           procedure after_pass1;override;
           procedure after_pass1;override;
        end;
        end;
@@ -55,10 +55,10 @@ unit cpupi;
        tgobj,
        tgobj,
        symconst, symsym,paramgr;
        symconst, symsym,paramgr;
 
 
-    constructor tppcprocinfo.create;
+    constructor tppcprocinfo.create(aparent:tprocinfo);
 
 
       begin
       begin
-         inherited create;
+         inherited create(aparent);
          maxpushedparasize:=0;
          maxpushedparasize:=0;
          localsize:=0;
          localsize:=0;
       end;
       end;
@@ -78,33 +78,33 @@ unit cpupi;
            begin
            begin
              ofs:=align(maxpushedparasize+LinkageAreaSize,16);
              ofs:=align(maxpushedparasize+LinkageAreaSize,16);
              inc(procdef.parast.address_fixup,ofs);
              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
              if cs_asm_source in aktglobalswitches then
                aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
                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)
 //             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;
              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)
              Already done with an "inc" above, should be correct (JM)
              if assigned(procdef.funcretsym) and
              if assigned(procdef.funcretsym) and
                not(paramanager.ret_in_param(procdef.rettype.def,procdef.proccalloption)) then
                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
              if cs_asm_source in aktglobalswitches then
                aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
                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
              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;
       end;
       end;
 
 
@@ -113,7 +113,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * updated for removed lexlevel
 
 
   Revision 1.10  2003/04/26 11:31:00  florian
   Revision 1.10  2003/04/26 11:31:00  florian

+ 20 - 11
compiler/powerpc/nppccal.pas

@@ -62,8 +62,8 @@ implementation
          exit;
          exit;
        if procdefinition is tprocdef then
        if procdefinition is tprocdef then
          begin
          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
          end
        else
        else
          begin
          begin
@@ -77,36 +77,36 @@ implementation
        hregister1,hregister2 : tregister;
        hregister1,hregister2 : tregister;
        i : longint;
        i : longint;
     begin
     begin
-       if aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
+       if current_procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
          begin
          begin
             { pass the same framepointer as the current procedure got }
             { pass the same framepointer as the current procedure got }
             hregister2.enum:=R_INTREGISTER;
             hregister2.enum:=R_INTREGISTER;
             hregister2.number:=NR_R11;
             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! }
             { it must be adjusted! }
          end
          end
          { this is only true if the difference is one !!
          { this is only true if the difference is one !!
            but it cannot be more !! }
            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
          begin
             { pass the same framepointer as the current procedure got }
             { pass the same framepointer as the current procedure got }
             hregister1.enum:=R_INTREGISTER;
             hregister1.enum:=R_INTREGISTER;
             hregister1.number:=NR_R1;
             hregister1.number:=NR_R1;
             hregister2.enum:=R_INTREGISTER;
             hregister2.enum:=R_INTREGISTER;
             hregister2.number:=NR_R11;
             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
          end
-       else if (aktprocdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+       else if (current_procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
          begin
          begin
             hregister1:=rg.getregisterint(exprasmlist,OS_ADDR);
             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);
             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
             while (i>tprocdef(procdefinition).parast.symtablelevel) do
               begin
               begin
                  {we should get the correct frame_pointer_offset at each level
                  {we should get the correct frame_pointer_offset at each level
                  how can we do this !!! }
                  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);
                  cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
                  dec(i);
                  dec(i);
               end;
               end;
@@ -123,7 +123,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * fixed nested procedures to get them working as before
 
 
   Revision 1.8  2003/04/27 07:48:05  peter
   Revision 1.8  2003/04/27 07:48:05  peter

+ 27 - 18
compiler/powerpc/radirect.pas

@@ -96,20 +96,20 @@ interface
            if s<>'' then
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
             { 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
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
            s:='';
          end;
          end;
 
 
      begin
      begin
        ende:=false;
        ende:=false;
        s:='';
        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]+')')
          retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
        else
        else
        }
        }
@@ -155,7 +155,7 @@ interface
                            end
                            end
                          else
                          else
                            { access to local variables }
                            { access to local variables }
-                           if assigned(aktprocdef) then
+                           if assigned(current_procdef) then
                              begin
                              begin
                                 { I don't know yet, what the ppc port requires }
                                 { I don't know yet, what the ppc port requires }
                                 { we'll see how things settle down             }
                                 { we'll see how things settle down             }
@@ -164,16 +164,16 @@ interface
                                 { char ?                                   }
                                 { char ?                                   }
                                 { !!!
                                 { !!!
                                 if (s[length(s)]='%') and
                                 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('AX',upper(hs))>0) or
                                    (pos('AL',upper(hs))>0)) then
                                    (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
                                 if ((s[length(s)]<>'0') or (hs[1]<>'x')) and not(is_register(hs)) then
                                   begin
                                   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
                                      else
                                        sym:=nil;
                                        sym:=nil;
                                      if assigned(sym) then
                                      if assigned(sym) then
@@ -205,8 +205,8 @@ interface
                                        end
                                        end
                                      else
                                      else
                                        begin
                                        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
                                           else
                                             sym:=nil;
                                             sym:=nil;
                                           if assigned(sym) then
                                           if assigned(sym) then
@@ -215,7 +215,7 @@ interface
                                                  begin
                                                  begin
                                                     l:=tvarsym(sym).address;
                                                     l:=tvarsym(sym).address;
                                                     { set offset }
                                                     { 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[procinfo.framepointer.enum]+')';
                                                     hs:=tostr(l)+'('+gas_reg2str[STACK_POINTER_REG]+')';
                                                     hs:=tostr(l)+'('+gas_reg2str[STACK_POINTER_REG]+')';
                                                     if pos(',',s) > 0 then
                                                     if pos(',',s) > 0 then
@@ -281,7 +281,7 @@ interface
                                                  end
                                                  end
                                                else if upper(hs)='__RESULT' then
                                                else if upper(hs)='__RESULT' then
                                                  begin
                                                  begin
-                                                    if (not is_void(aktprocdef.rettype.def)) then
+                                                    if (not is_void(current_procdef.rettype.def)) then
                                                       hs:=retstr
                                                       hs:=retstr
                                                     else
                                                     else
                                                       Message(asmr_e_void_function);
                                                       Message(asmr_e_void_function);
@@ -311,7 +311,7 @@ interface
               '{',';',#10,#13:
               '{',';',#10,#13:
                 begin
                 begin
                    if pos(retstr,s) > 0 then
                    if pos(retstr,s) > 0 then
-                     tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                     tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                    writeasmline;
                    writeasmline;
                    c:=current_scanner.asmgetchar;
                    c:=current_scanner.asmgetchar;
                 end;
                 end;
@@ -347,7 +347,16 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
     * updated for removed lexlevel
 
 
   Revision 1.11  2003/04/25 21:05:22  florian
   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);
                    symtab:=twithsymtable.Create(obj,obj.symtable.symsearch);
                    withsymtable:=symtab;
                    withsymtable:=symtab;
                    if (p.nodetype=loadn) and
                    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).direct_with:=true;
                    twithsymtable(symtab).withrefnode:=p;
                    twithsymtable(symtab).withrefnode:=p;
                    levelcount:=1;
                    levelcount:=1;
@@ -414,7 +414,7 @@ implementation
                       symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
                       symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
                       symtab:=symtab.next;
                       symtab:=symtab.next;
                       if (p.nodetype=loadn) and
                       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).direct_with:=true;
                       twithsymtable(symtab).withrefnode:=p;
                       twithsymtable(symtab).withrefnode:=p;
                       obj:=obj.childof;
                       obj:=obj.childof;
@@ -429,7 +429,7 @@ implementation
                    levelcount:=1;
                    levelcount:=1;
                    withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
                    withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
                    if (p.nodetype=loadn) and
                    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).direct_with:=true;
                    twithsymtable(withsymtable).withrefnode:=p;
                    twithsymtable(withsymtable).withrefnode:=p;
                    withsymtable.next:=symtablestack;
                    withsymtable.next:=symtablestack;
@@ -528,7 +528,7 @@ implementation
          oldaktexceptblock: integer;
          oldaktexceptblock: integer;
 
 
       begin
       begin
-         procinfo.flags:=procinfo.flags or pi_uses_exceptions;
+         include(current_procinfo.flags,pi_uses_exceptions);
 
 
          p_default:=nil;
          p_default:=nil;
          p_specific:=nil;
          p_specific:=nil;
@@ -739,11 +739,11 @@ implementation
              begin
              begin
                if not target_asm.allowdirect then
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
                  Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocdef.proccalloption=pocall_inline) then
+               if (current_procdef.proccalloption=pocall_inline) then
                  Begin
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
                     Message(parser_w_inlining_disabled);
-                    aktprocdef.proccalloption:=pocall_fpccall;
+                    current_procdef.proccalloption:=pocall_fpccall;
                  End;
                  End;
                asmstat:=tasmnode(radirect.assemble);
                asmstat:=tasmnode(radirect.assemble);
              end;
              end;
@@ -878,7 +878,7 @@ implementation
              code:=cnothingnode.create;
              code:=cnothingnode.create;
            _FAIL :
            _FAIL :
              begin
              begin
-                if (aktprocdef.proctypeoption<>potype_constructor) then
+                if (current_procdef.proctypeoption<>potype_constructor) then
                   Message(parser_e_fail_only_in_constructor);
                   Message(parser_e_fail_only_in_constructor);
                 consume(_FAIL);
                 consume(_FAIL);
                 code:=cfailnode.create;
                 code:=cfailnode.create;
@@ -1014,15 +1014,15 @@ implementation
         i : longint;
         i : longint;
       begin
       begin
         { replace framepointer with stackpointer }
         { 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 }
         { 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,
         { replace all references to parameters in the instructions,
           the parameters can be identified by the parafixup option
           the parameters can be identified by the parafixup option
           that is set. For normal user coded [ebp+4] this field is not
           that is set. For normal user coded [ebp+4] this field is not
           set }
           set }
-        parafixup:=aktprocdef.parast.address_fixup;
+        parafixup:=current_procdef.parast.address_fixup;
         hp:=tai(p.p_asm.first);
         hp:=tai(p.p_asm.first);
         while assigned(hp) do
         while assigned(hp) do
          begin
          begin
@@ -1073,13 +1073,13 @@ implementation
         p : tnode;
         p : tnode;
       begin
       begin
          { Rename the funcret so that recursive calls are possible }
          { 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 }
          { force the asm statement }
          if token<>_ASM then
          if token<>_ASM then
            consume(_ASM);
            consume(_ASM);
-         procinfo.Flags := procinfo.Flags Or pi_is_assembler;
+         include(current_procinfo.flags,pi_is_assembler);
          p:=_asm_statement;
          p:=_asm_statement;
 
 
          { set the framepointer to esp for assembler functions when the
          { set the framepointer to esp for assembler functions when the
@@ -1091,20 +1091,20 @@ implementation
            - target processor has optional frame pointer save
            - target processor has optional frame pointer save
              (vm, i386, vm only currently)
              (vm, i386, vm only currently)
          }
          }
-         if (po_assembler in aktprocdef.procoptions) and
+         if (po_assembler in current_procdef.procoptions) and
 {$ifndef powerpc}
 {$ifndef powerpc}
             { is this really necessary??? }
             { is this really necessary??? }
-            (aktprocdef.parast.datasize=0) and
+            (current_procdef.parast.datasize=0) and
 {$endif powerpc}
 {$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
             begin
                { we don't need to allocate space for the locals }
                { 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 }
                { only for cpus with different frame- and stack pointer the code must be changed }
                if (NR_STACK_POINTER_REG<>NR_FRAME_POINTER_REG)
                if (NR_STACK_POINTER_REG<>NR_FRAME_POINTER_REG)
 {$ifdef CHECKFORPUSH}
 {$ifdef CHECKFORPUSH}
@@ -1117,9 +1117,9 @@ implementation
         { Flag the result as assigned when it is returned in a
         { Flag the result as assigned when it is returned in a
           register.
           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
         { because the END is already read we need to get the
           last_endtoken_filepos here (PFV) }
           last_endtoken_filepos here (PFV) }
@@ -1131,8 +1131,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 107 - 104
compiler/psub.pas

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

+ 11 - 2
compiler/ptype.pas

@@ -635,8 +635,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 44 - 35
compiler/rautils.pas

@@ -732,22 +732,22 @@ Function TOperand.SetupResult:boolean;
 Begin
 Begin
   SetupResult:=false;
   SetupResult:=false;
   { replace by correct offset. }
   { replace by correct offset. }
-  if (not is_void(aktprocdef.rettype.def)) then
+  if (not is_void(current_procdef.rettype.def)) then
    begin
    begin
      if (m_tp7 in aktmodeswitches) and
      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
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
          exit;
        end;
        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;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
      { 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
      { increase reference count, this is also used to check
        if the result variable is actually used or not }
        if the result variable is actually used or not }
-     inc(tvarsym(aktprocdef.funcretsym).refcount);
+     inc(tvarsym(current_procdef.funcretsym).refcount);
      SetupResult:=true;
      SetupResult:=true;
    end
    end
   else
   else
@@ -758,11 +758,11 @@ end;
 Function TOperand.SetupSelf:boolean;
 Function TOperand.SetupSelf:boolean;
 Begin
 Begin
   SetupSelf:=false;
   SetupSelf:=false;
-  if assigned(aktprocdef._class) then
+  if assigned(current_procdef._class) then
    Begin
    Begin
      opr.typ:=OPR_REFERENCE;
      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;
      opr.ref.options:=ref_selffixup;
      SetupSelf:=true;
      SetupSelf:=true;
    end
    end
@@ -774,11 +774,11 @@ end;
 Function TOperand.SetupOldEBP:boolean;
 Function TOperand.SetupOldEBP:boolean;
 Begin
 Begin
   SetupOldEBP:=false;
   SetupOldEBP:=false;
-  if aktprocdef.parast.symtablelevel>normal_function_level then
+  if current_procdef.parast.symtablelevel>normal_function_level then
    Begin
    Begin
      opr.typ:=OPR_REFERENCE;
      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;
      opr.ref.options:=ref_parafixup;
      SetupOldEBP:=true;
      SetupOldEBP:=true;
    end
    end
@@ -825,25 +825,25 @@ Begin
             begin
             begin
               { if we only want the offset we don't have to care
               { if we only want the offset we don't have to care
                 the base will be zeroed after ! }
                 the base will be zeroed after ! }
-              if (tvarsym(sym).owner=aktprocdef.parast) or
+              if (tvarsym(sym).owner=current_procdef.parast) or
                 GetOffset then
                 GetOffset then
                 begin
                 begin
-                  opr.ref.base:=procinfo.framepointer;
+                  opr.ref.base:=current_procinfo.framepointer;
                 end
                 end
               else
               else
                 begin
                 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
                   else
                     message1(asmr_e_local_para_unreachable,s);
                     message1(asmr_e_local_para_unreachable,s);
                 end;
                 end;
               opr.ref.offset:=tvarsym(sym).address;
               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
                 begin
-                  opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
+                  opr.ref.offsetfixup:=current_procdef.parast.address_fixup;
                   opr.ref.options:=ref_parafixup;
                   opr.ref.options:=ref_parafixup;
                 end
                 end
               else
               else
@@ -853,7 +853,7 @@ Begin
                 end;
                 end;
               if (tvarsym(sym).varspez=vs_var) or
               if (tvarsym(sym).varspez=vs_var) or
                  ((tvarsym(sym).varspez=vs_const) and
                  ((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);
                 SetSize(pointer_size,false);
             end;
             end;
           localsymtable :
           localsymtable :
@@ -864,23 +864,23 @@ Begin
                 begin
                 begin
                   { if we only want the offset we don't have to care
                   { if we only want the offset we don't have to care
                     the base will be zeroed after ! }
                     the base will be zeroed after ! }
-                  if (tvarsym(sym).owner=aktprocdef.localst) or
+                  if (tvarsym(sym).owner=current_procdef.localst) or
                      GetOffset then
                      GetOffset then
-                    opr.ref.base:=procinfo.framepointer
+                    opr.ref.base:=current_procinfo.framepointer
                   else
                   else
                     begin
                     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
                       else
                         message1(asmr_e_local_para_unreachable,s);
                         message1(asmr_e_local_para_unreachable,s);
                     end;
                     end;
                   opr.ref.offset:=-(tvarsym(sym).address);
                   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
                     begin
-                      opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
+                      opr.ref.offsetfixup:=current_procdef.localst.address_fixup;
                       opr.ref.options:=ref_localfixup;
                       opr.ref.options:=ref_localfixup;
                     end
                     end
                   else
                   else
@@ -891,7 +891,7 @@ Begin
                 end;
                 end;
               if (tvarsym(sym).varspez in [vs_var,vs_out]) or
               if (tvarsym(sym).varspez in [vs_var,vs_out]) or
                  ((tvarsym(sym).varspez=vs_const) and
                  ((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);
                 SetSize(pointer_size,false);
             end;
             end;
         end;
         end;
@@ -1298,7 +1298,7 @@ Begin
   base:=Copy(s,1,i-1);
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   delete(s,1,i);
   if base='SELF' then
   if base='SELF' then
-   st:=aktprocdef._class.symtable
+   st:=current_procdef._class.symtable
   else
   else
    begin
    begin
      asmsearchsym(base,sym,srsymtable);
      asmsearchsym(base,sym,srsymtable);
@@ -1574,8 +1574,17 @@ end;
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 30 - 18
compiler/regvars.pas

@@ -73,7 +73,7 @@ implementation
               { walk through all momentary register variables }
               { walk through all momentary register variables }
               for i:=1 to maxvarregs do
               for i:=1 to maxvarregs do
                 begin
                 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
                    if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
                      begin
                      begin
                         for k:=maxvarregs-1 downto i do
                         for k:=maxvarregs-1 downto i do
@@ -114,7 +114,7 @@ implementation
               { walk through all momentary register variables }
               { walk through all momentary register variables }
               for i:=1 to maxfpuvarregs do
               for i:=1 to maxfpuvarregs do
                 begin
                 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
                    if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
                      begin
                      begin
                         for k:=maxfpuvarregs-1 downto i do
                         for k:=maxfpuvarregs-1 downto i do
@@ -146,11 +146,12 @@ implementation
       { only if no asm is used }
       { only if no asm is used }
       { and no try statement   }
       { and no try statement   }
       if (cs_regalloc in aktglobalswitches) and
       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
         begin
           new(regvarinfo);
           new(regvarinfo);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
-          aktprocdef.regvarinfo := regvarinfo;
+          current_procdef.regvarinfo := regvarinfo;
           if (p.registers32<4) then
           if (p.registers32<4) then
             begin
             begin
               parasym:=false;
               parasym:=false;
@@ -184,7 +185,7 @@ implementation
                       { call by reference/const ? }
                       { call by reference/const ? }
                       if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
                       if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
                          ((regvarinfo^.regvars[i].varspez=vs_const) and
                          ((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
                         begin
                            r.enum:=varregs[i];
                            r.enum:=varregs[i];
                            regvarinfo^.regvars[i].reg:=r;
                            regvarinfo^.regvars[i].reg:=r;
@@ -238,7 +239,7 @@ implementation
                 { with assigning registers                       }
                 { with assigning registers                       }
                 if aktmaxfpuregisters=-1 then
                 if aktmaxfpuregisters=-1 then
                   begin
                   begin
-                   if (procinfo.flags and pi_do_call)<>0 then
+                   if (pi_do_call in current_procinfo.flags) then
                      begin
                      begin
                       for i:=maxfpuvarregs downto 2 do
                       for i:=maxfpuvarregs downto 2 do
                         regvarinfo^.fpuregvars[i]:=nil;
                         regvarinfo^.fpuregvars[i]:=nil;
@@ -288,7 +289,7 @@ implementation
     begin
     begin
       if reg.enum>lastreg then
       if reg.enum>lastreg then
         internalerror(200301081);
         internalerror(200301081);
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
       if not assigned(regvarinfo) then
         exit;
         exit;
       for i := 1 to maxvarregs do
       for i := 1 to maxvarregs do
@@ -307,7 +308,7 @@ implementation
                       hr.offset:=-vsym.address+vsym.owner.address_fixup
                       hr.offset:=-vsym.address+vsym.owner.address_fixup
                     else
                     else
                       hr.offset:=vsym.address+vsym.owner.address_fixup;
                       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);
                     cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
                   end;
                   end;
                 asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
                 asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
@@ -334,10 +335,10 @@ implementation
             hr.offset:=-vsym.address+vsym.owner.address_fixup
             hr.offset:=-vsym.address+vsym.owner.address_fixup
           else
           else
             hr.offset:=vsym.address+vsym.owner.address_fixup;
             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
           if (vsym.varspez in [vs_var,vs_out]) or
              ((vsym.varspez=vs_const) and
              ((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
             opsize := OS_ADDR
           else
           else
             opsize := def_cgsize(vsym.vartype.def);
             opsize := def_cgsize(vsym.vartype.def);
@@ -352,7 +353,7 @@ implementation
       regvarinfo: pregvarinfo;
       regvarinfo: pregvarinfo;
       reg_spare : tregister;
       reg_spare : tregister;
     begin
     begin
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
       if not assigned(regvarinfo) then
         exit;
         exit;
       reg_spare := rg.makeregsize(reg,OS_INT);
       reg_spare := rg.makeregsize(reg,OS_INT);
@@ -369,7 +370,7 @@ implementation
       i: longint;
       i: longint;
       regvarinfo: pregvarinfo;
       regvarinfo: pregvarinfo;
     begin
     begin
-      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+      regvarinfo := pregvarinfo(current_procdef.regvarinfo);
       if not assigned(regvarinfo) then
       if not assigned(regvarinfo) then
         exit;
         exit;
       for i := 1 to maxvarregs do
       for i := 1 to maxvarregs do
@@ -386,9 +387,10 @@ implementation
       r:Tregister;
       r:Tregister;
     begin
     begin
       if (cs_regalloc in aktglobalswitches) and
       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
         begin
-          regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
+          regvarinfo := pregvarinfo(current_procdef.regvarinfo);
           { can happen when inlining assembler procedures (JM) }
           { can happen when inlining assembler procedures (JM) }
           if not assigned(regvarinfo) then
           if not assigned(regvarinfo) then
             exit;
             exit;
@@ -466,11 +468,12 @@ implementation
       r,reg : tregister;
       r,reg : tregister;
     begin
     begin
       { can happen when inlining assembler procedures (JM) }
       { can happen when inlining assembler procedures (JM) }
-      if not assigned(aktprocdef.regvarinfo) then
+      if not assigned(current_procdef.regvarinfo) then
         exit;
         exit;
       if (cs_regalloc in aktglobalswitches) and
       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
           begin
 {$ifdef i386}
 {$ifdef i386}
             r.enum:=R_ST0;
             r.enum:=R_ST0;
@@ -497,7 +500,16 @@ end.
 
 
 {
 {
   $Log$
   $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
     * generic constructor working for i386
     * remove fixed self register
     * remove fixed self register
     * esi added as address register for i386
     * 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
     if target_info.system=system_sparc_linux
     then
     then
       list.concat(taicpu.op_none(A_NOP));
       list.concat(taicpu.op_none(A_NOP));
-    procinfo.flags:=procinfo.flags or pi_do_call;
+    include(current_procinfo.flags,pi_do_call);
  end;
  end;
 {********************** branch instructions ********************}
 {********************** branch instructions ********************}
 procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
 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
   VAR
     ai:taicpu;
     ai:taicpu;
     r,hreg:tregister;
     r,hreg:tregister;
-    
+
   BEGIN
   BEGIN
     r.enum:=R_PSR;
     r.enum:=R_PSR;
     hreg := rg.makeregsize(reg,OS_8);
     hreg := rg.makeregsize(reg,OS_8);
@@ -1428,7 +1428,16 @@ BEGIN
 END.
 END.
 {
 {
   $Log$
   $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
   * fixing an LD operation without refernce in loading address parameters
 
 
   Revision 1.41  2003/03/10 21:59:54  mazen
   Revision 1.41  2003/03/10 21:59:54  mazen

+ 13 - 4
compiler/sparc/cpupi.pas

@@ -33,7 +33,7 @@ type
     LocalSize:aword;
     LocalSize:aword;
     {max of space need for parameters, currently used by the PowerPC port only}
     {max of space need for parameters, currently used by the PowerPC port only}
     maxpushedparasize:aword;
     maxpushedparasize:aword;
-    constructor create;override;
+    constructor create(aparent:tprocinfo);override;
 {According the the SPARC ABI the standard stack frame must include :
 {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.
   *  16 word save for the in and local registers in case of overflow/underflow.
 this save area always must exist at the %o6+0,
 this save area always must exist at the %o6+0,
@@ -52,9 +52,9 @@ implementation
 uses
 uses
         tgobj,paramgr,symsym,systems;
         tgobj,paramgr,symsym,systems;
 
 
-constructor TSparcprocinfo.create;
+constructor TSparcprocinfo.create(aparent:tprocinfo);
         begin
         begin
-                inherited create;
+                inherited create(aparent);
                 maxpushedparasize:=0;
                 maxpushedparasize:=0;
                 LocalSize:=(16+1)*4;
                 LocalSize:=(16+1)*4;
         {First 16 words are in the frame are used to save registers in case of a
         {First 16 words are in the frame are used to save registers in case of a
@@ -95,7 +95,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * updated for removed lexlevel
 
 
   Revision 1.12  2003/02/06 22:36:55  mazen
   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
     if ProcDefinition is TProcDef
     then
     then
       with TProcDef(procdefinition).parast do
       with TProcDef(procdefinition).parast do
-        if datasize>TSparcProcInfo(procinfo).maxpushedparasize
+        if datasize>TSparcProcInfo(current_procinfo).maxpushedparasize
         then
         then
-          TSparcProcInfo(procinfo).maxpushedparasize:=datasize;
+          TSparcProcInfo(current_procinfo).maxpushedparasize:=datasize;
   end;
   end;
 procedure TSparcCallNode.push_framepointer;
 procedure TSparcCallNode.push_framepointer;
   begin
   begin
@@ -63,7 +63,16 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * moved generic code from n386cal to ncgcal, i386 now also
       uses the generic ncgcal
       uses the generic ncgcal
 
 

+ 36 - 27
compiler/sparc/radirect.pas

@@ -86,20 +86,20 @@ end;
            if s<>'' then
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
             { 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
               (pos(retstr,upper(s))>0) then
-             tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+             tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
            s:='';
            s:='';
          end;
          end;
 
 
      begin
      begin
        ende:=false;
        ende:=false;
        s:='';
        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
        else
          retstr:='';
          retstr:='';
          c:=current_scanner.asmgetchar;
          c:=current_scanner.asmgetchar;
@@ -143,22 +143,22 @@ end;
                              FwaitWarning
                              FwaitWarning
                             else
                             else
                             { access to local variables }
                             { access to local variables }
-                            if assigned(aktprocdef) then
+                            if assigned(current_procdef) then
                               begin
                               begin
                                  { is the last written character an special }
                                  { is the last written character an special }
                                  { char ?                                   }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
                                  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('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
                                     (pos('AL',upper(hs))>0)) then
-                                   tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                                   tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
                                    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
                                       else
                                         sym:=nil;
                                         sym:=nil;
                                       if assigned(sym) then
                                       if assigned(sym) then
@@ -180,7 +180,7 @@ end;
                                                hs:=tvarsym(sym).mangledname
                                                hs:=tvarsym(sym).mangledname
                                              else
                                              else
                                                hs:='-'+tostr(tvarsym(sym).address)+
                                                hs:='-'+tostr(tvarsym(sym).address)+
-                                                   '('+std_reg2str[procinfo.framepointer.enum]+')';
+                                                   '('+std_reg2str[current_procinfo.framepointer.enum]+')';
                                              end
                                              end
                                            else
                                            else
                                            { call to local function }
                                            { call to local function }
@@ -192,8 +192,8 @@ end;
                                         end
                                         end
                                       else
                                       else
                                         begin
                                         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
                                            else
                                              sym:=nil;
                                              sym:=nil;
                                            if assigned(sym) then
                                            if assigned(sym) then
@@ -202,8 +202,8 @@ end;
                                                   begin
                                                   begin
                                                      l:=tvarsym(sym).address;
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
                                                      { 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
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
                                                        tvarsym(sym).varstate:=vs_used;
                                                   end;
                                                   end;
@@ -247,15 +247,15 @@ end;
                                              end
                                              end
                                            else if upper(hs)='__SELF' then
                                            else if upper(hs)='__SELF' then
                                              begin
                                              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
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
                                              end
                                            else if upper(hs)='__RESULT' then
                                            else if upper(hs)='__RESULT' then
                                              begin
                                              begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                if (not is_void(current_procdef.rettype.def)) then
                                                   hs:=retstr
                                                   hs:=retstr
                                                 else
                                                 else
                                                   Message(asmr_e_void_function);
                                                   Message(asmr_e_void_function);
@@ -264,9 +264,9 @@ end;
                                              begin
                                              begin
                                                 { complicate to check there }
                                                 { complicate to check there }
                                                 { we do it: }
                                                 { 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
                                                 else
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                                   Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                              end;
                                              end;
@@ -279,7 +279,7 @@ end;
                    end;
                    end;
  '{',';',#10,#13 : begin
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
                       if pos(retstr,s) > 0 then
-                        tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
+                        tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
                      writeasmline;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                      c:=current_scanner.asmgetchar;
                    end;
                    end;
@@ -314,7 +314,16 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
     * updated for removed lexlevel
 
 
   Revision 1.5  2003/01/08 18:43:58  daniel
   Revision 1.5  2003/01/08 18:43:58  daniel

+ 11 - 2
compiler/symbase.pas

@@ -347,8 +347,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/symconst.pas

@@ -350,8 +350,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 11 - 2
compiler/symdef.pas

@@ -5737,8 +5737,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 12 - 3
compiler/symsym.pas

@@ -340,7 +340,7 @@ interface
 
 
 
 
     var
     var
-       aktprocdef : tprocdef;
+       current_procdef : tprocdef;
 
 
        aktcallprocdef : tabstractprocdef;  { pointer to the definition of the
        aktcallprocdef : tabstractprocdef;  { pointer to the definition of the
                                              currently called procedure,
                                              currently called procedure,
@@ -2557,12 +2557,21 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * fixed stabs generation for local variables on systems where they have
       a positive offset relative to the stack/framepointer
       a positive offset relative to the stack/framepointer
 
 
   Revision 1.98  2003/04/27 07:29:51  peter
   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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * lexlevel removed, use symtable.symtablelevel instead

+ 15 - 6
compiler/symtable.pas

@@ -1986,7 +1986,7 @@ implementation
            begin
            begin
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
               if assigned(srsym) and
               if assigned(srsym) and
-                 tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
+                 tstoredsym(srsym).is_visible_for_proc(current_procdef) then
                begin
                begin
                  searchsym:=true;
                  searchsym:=true;
                  exit;
                  exit;
@@ -2056,7 +2056,7 @@ implementation
                 end
                 end
                else
                else
                 begin
                 begin
-                  if tstoredsym(sym).is_visible_for_proc(aktprocdef) then
+                  if tstoredsym(sym).is_visible_for_proc(current_procdef) then
                    break;
                    break;
                 end;
                 end;
              end;
              end;
@@ -2101,7 +2101,7 @@ implementation
                    end
                    end
                   else
                   else
                    begin
                    begin
-                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                     if tprocdef(def).is_visible_for_proc(current_procdef) then
                       break;
                       break;
                    end;
                    end;
                 end;
                 end;
@@ -2150,7 +2150,7 @@ implementation
                    end
                    end
                   else
                   else
                    begin
                    begin
-                     if tprocdef(def).is_visible_for_proc(aktprocdef) then
+                     if tprocdef(def).is_visible_for_proc(current_procdef) then
                       break;
                       break;
                    end;
                    end;
                 end;
                 end;
@@ -2428,8 +2428,17 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
       a new procdef declaration
     * aktprocsym removed
     * aktprocsym removed
     * lexlevel removed, use symtable.symtablelevel instead
     * 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);
     procedure ttgobj.GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
 
 
     begin
     begin
-      reference_reset_base(ref,procinfo.framepointer,alloctemp(list,size,temptype));
+      reference_reset_base(ref,current_procinfo.framepointer,alloctemp(list,size,temptype));
     end;
     end;
 
 
 
 
@@ -444,17 +444,17 @@ unit tgobj;
            internalerror(200301225);
            internalerror(200301225);
          if (ref.index.enum<>R_NO) and (ref.index.enum<>R_INTREGISTER) then
          if (ref.index.enum<>R_NO) and (ref.index.enum<>R_INTREGISTER) then
            internalerror(200301225);
            internalerror(200301225);
-         if procinfo.framepointer.enum<>R_INTREGISTER then
+         if current_procinfo.framepointer.enum<>R_INTREGISTER then
            internalerror(200301225);
            internalerror(200301225);
          if direction = 1 then
          if direction = 1 then
            begin
            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.index.number=NR_NO) and
                       (ref.offset>=firsttemp));
                       (ref.offset>=firsttemp));
            end
            end
         else
         else
            begin
            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.index.number=NR_NO) and
                       (ref.offset<firsttemp));
                       (ref.offset<firsttemp));
            end;
            end;
@@ -544,7 +544,16 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter
     * vs_hidden parameter for funcret passed in parameter

+ 12 - 3
compiler/x86/cgx86.pas

@@ -1817,10 +1817,10 @@ unit cgx86;
       begin
       begin
         { Routines with the poclearstack flag set use only a ret }
         { Routines with the poclearstack flag set use only a ret }
         { also routines with parasize=0     }
         { also routines with parasize=0     }
-        if (po_clearstack in aktprocdef.procoptions) then
+        if (po_clearstack in current_procdef.procoptions) then
          begin
          begin
            { complex return values are removed from stack in C code PM }
            { 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))
              list.concat(Taicpu.Op_const(A_RET,S_NO,4))
            else
            else
              list.concat(Taicpu.Op_none(A_RET,S_NO));
              list.concat(Taicpu.Op_none(A_RET,S_NO));
@@ -1938,7 +1938,16 @@ unit cgx86;
 end.
 end.
 {
 {
   $Log$
   $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
     * Further register allocator work. Compiler now smaller with new
       allocator than without.
       allocator than without.
     * Somebody forgot to adjust ppu version number
     * Somebody forgot to adjust ppu version number