* aktprocdef cleanup, aktprocdef is now always nil when parsing

    a new procdef declaration
  * aktprocsym removed
  * lexlevel removed, use symtable.symtablelevel instead
  * implicit init/final code uses the normal genentry/genexit
  * funcret state checking updated for new funcret handling

compiler/cgbase.pas

@@ -66,8 +66,6 @@ unit cgbase;
        tprocinfo = class
           { pointer to parent in nested procedures }
           parent : tprocinfo;
-          {# current class, if we are in a method }
-          _class : tobjectdef;
           {# the definition of the routine itself }
           procdef : tprocdef;
           {# offset from frame pointer to get parent frame pointer reference
@@ -85,8 +83,6 @@ unit cgbase;
           return_offset : longint;
           {# firsttemp position }
           firsttemp_offset : longint;
-          {# offset from frame pointer to parameters }
-          para_offset : longint;
 
           {# some collected informations about the procedure
              see pi_xxxx constants above
@@ -158,6 +154,8 @@ unit cgbase;
 
           procedure allocate_interrupt_stackframe;virtual;
 
+          procedure allocate_implicit_parameter;virtual;
+
           { Does the necessary stuff before a procedure body is compiled }
           procedure handle_body_start;virtual;
 
@@ -229,10 +227,8 @@ unit cgbase;
 
     { initialize respectively terminates the code generator }
     { for a new module or procedure                      }
-    procedure codegen_doneprocedure;
-    procedure codegen_donemodule;
     procedure codegen_newmodule;
-    procedure codegen_newprocedure;
+    procedure codegen_donemodule;
 
     {# From a definition return the abstract code generator size enum. It is
        to note that the value returned can be @var(OS_NO) }
@@ -377,7 +373,6 @@ implementation
     constructor tprocinfo.create;
       begin
         parent:=nil;
-        _class:=nil;
         procdef:=nil;
         framepointer_offset:=0;
         selfpointer_offset:=0;
@@ -385,7 +380,6 @@ implementation
         inheritedflag_offset:=0;
         return_offset:=0;
         firsttemp_offset:=0;
-        para_offset:=0;
         flags:=0;
         framepointer.enum:=R_NO;
         framepointer.number:=NR_NO;
@@ -430,7 +424,7 @@ implementation
          { because we don't know yet where the address is }
          if not is_void(procdef.rettype.def) then
            begin
-              if paramanager.ret_in_reg(procdef.rettype.def,procdef.proccalloption) then
+              if not paramanager.ret_in_param(procdef.rettype.def,procdef.proccalloption) then
                 begin
                    rg.usedinproc := rg.usedinproc +
                       getfuncretusedregisters(procdef.rettype.def,procdef.proccalloption);
@@ -439,52 +433,74 @@ implementation
       end;
 
 
-    procedure tprocinfo.after_header;
-      begin
-        if assigned(procdef.funcretsym) then
-         begin
-           procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
-                                  tvarsym(procdef.funcretsym).owner.address_fixup;
-           if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
-            procinfo.return_offset:=tg.direction*procinfo.return_offset;
-         end;
-      end;
-
-    procedure tprocinfo.after_pass1;
+    procedure tprocinfo.allocate_implicit_parameter;
       begin
+         { Insert implicit parameters, will be removed in the future }
+         if (procdef.parast.symtablelevel>normal_function_level) then
+           begin
+              framepointer_offset:=procdef.parast.address_fixup;
+              inc(procdef.parast.address_fixup,POINTER_SIZE);
+           end;
+         if assigned(procdef._class) then
+           begin
+              { self pointer offset, must be done after parsing the parameters }
+              { self isn't pushed in nested procedure of methods }
+              if not(po_containsself in procdef.procoptions) and
+                 (procdef.parast.symtablelevel=normal_function_level) then
+               begin
+                 selfpointer_offset:=procdef.parast.address_fixup;
+                 inc(procdef.parast.address_fixup,POINTER_SIZE);
+               end;
+
+              { Special parameters for de-/constructors }
+              case procdef.proctypeoption of
+                potype_constructor :
+                  begin
+                    vmtpointer_offset:=procdef.parast.address_fixup;
+                    inc(procdef.parast.address_fixup,POINTER_SIZE);
+                  end;
+                potype_destructor :
+                  begin
+                    if is_object(procdef._class) then
+                     begin
+                       vmtpointer_offset:=procdef.parast.address_fixup;
+                       inc(procdef.parast.address_fixup,POINTER_SIZE);
+                     end
+                    else
+                     if is_class(procdef._class) then
+                      begin
+                        inheritedflag_offset:=procdef.parast.address_fixup;
+                        inc(procdef.parast.address_fixup,POINTER_SIZE);
+                      end
+                    else
+                     internalerror(200303261);
+                  end;
+              end;
+           end;
       end;
 
 
-{*****************************************************************************
-         initialize/terminate the codegen for procedure and modules
-*****************************************************************************}
-
-    procedure codegen_newprocedure;
+    procedure tprocinfo.after_header;
       begin
-         aktbreaklabel:=nil;
-         aktcontinuelabel:=nil;
-         { aktexitlabel:=0; is store in oldaktexitlabel
-           so it must not be reset to zero before this storage !}
-         { new procinfo }
-         procinfo:=cprocinfo.create;
-{$ifdef fixLeaksOnError}
-         procinfoStack.push(procinfo);
-{$endif fixLeaksOnError}
+         { Retrieve function result offset }
+         if assigned(procdef.funcretsym) then
+           begin
+             procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
+                                     tvarsym(procdef.funcretsym).owner.address_fixup;
+             if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
+              procinfo.return_offset:=tg.direction*procinfo.return_offset;
+           end;
       end;
 
 
-
-    procedure codegen_doneprocedure;
+    procedure tprocinfo.after_pass1;
       begin
-{$ifdef fixLeaksOnError}
-         if procinfo <> procinfoStack.pop then
-           writeln('problem with procinfoStack!');
-{$endif fixLeaksOnError}
-         procinfo.free;
-         procinfo:=nil;
       end;
 
 
+{*****************************************************************************
+         initialize/terminate the codegen for procedure and modules
+*****************************************************************************}
 
     procedure codegen_newmodule;
       begin
@@ -504,14 +520,6 @@ implementation
          ResourceStrings:=TResourceStrings.Create;
          { use the librarydata from current_module }
          objectlibrary:=current_module.librarydata;
-         { 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;
 
 
@@ -546,7 +554,6 @@ implementation
          { resource strings }
          ResourceStrings.free;
          objectlibrary:=nil;
-         // voidprocpi.free;
       end;
 
 
@@ -666,7 +673,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2003-04-26 00:31:42  peter
+  Revision 1.44  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.43  2003/04/26 00:31:42  peter
     * set return_offset moved to after_header
 
   Revision 1.42  2003/04/25 20:59:33  peter

compiler/cgobj.pas

@@ -503,7 +503,7 @@ unit cgobj;
 
     uses
        globals,globtype,options,systems,cgbase,
-       verbose,defutil,paramgr,
+       verbose,defutil,paramgr,symsym,
        rgobj,cutils;
 
     const
@@ -1570,24 +1570,23 @@ unit cgobj;
     function tcg.g_load_self(list : taasmoutput):tregister;
       var
          hp : treference;
-         p : tprocinfo;
-         i : longint;
+         p  : tprocinfo;
          self_reg : tregister;
       begin
-         if not assigned(procinfo._class) then
+         if not assigned(procinfo.procdef._class) then
            internalerror(200303211);
          self_reg:=rg.getaddressregister(list);
-         if lexlevel>normal_function_level then
+         if procinfo.procdef.parast.symtablelevel>normal_function_level then
            begin
              reference_reset_base(hp,procinfo.framepointer,procinfo.framepointer_offset);
              a_load_ref_reg(list,OS_ADDR,hp,self_reg);
              p:=procinfo.parent;
-             for i:=3 to lexlevel-1 do
-               begin
-                  reference_reset_base(hp,self_reg,p.framepointer_offset);
-                  a_load_ref_reg(list,OS_ADDR,hp,self_reg);
-                  p:=p.parent;
-               end;
+             while (p.procdef.parast.symtablelevel>normal_function_level) do
+              begin
+                reference_reset_base(hp,self_reg,p.framepointer_offset);
+                a_load_ref_reg(list,OS_ADDR,hp,self_reg);
+                p:=p.parent;
+              end;
              reference_reset_base(hp,self_reg,p.selfpointer_offset);
              a_load_ref_reg(list,OS_ADDR,hp,self_reg);
            end
@@ -1651,7 +1650,7 @@ unit cgobj;
          internalerror(200303252);
         acc.enum:=R_INTREGISTER;
         acc.number:=NR_ACCUMULATOR;
-        if is_class(procinfo._class) then
+        if is_class(procinfo.procdef._class) then
           begin
             if (cs_implicit_exceptions in aktmoduleswitches) then
               procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
@@ -1668,10 +1667,10 @@ unit cgobj;
             { fail? }
             a_cmp_const_reg_label(list,OS_ADDR,OC_EQ,0,acc,faillabel);
           end
-        else if is_object(procinfo._class) then
+        else if is_object(procinfo.procdef._class) then
           begin
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : address of pointer to vmt,
               this is required to allow setting the vmt to -1 to indicate
               that memory was allocated }
@@ -1698,7 +1697,7 @@ unit cgobj;
         href : treference;
         reg  : tregister;
      begin
-        if is_class(procinfo._class) then
+        if is_class(procinfo.procdef._class) then
          begin
            if procinfo.selfpointer_offset=0 then
             internalerror(200303253);
@@ -1714,27 +1713,27 @@ unit cgobj;
            a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
            a_call_name(list,'FPC_DISPOSE_CLASS')
          end
-        else if is_object(procinfo._class) then
+        else if is_object(procinfo.procdef._class) then
          begin
             if procinfo.selfpointer_offset=0 then
              internalerror(200303254);
             if procinfo.vmtpointer_offset=0 then
              internalerror(200303255);
             { must the object be finalized ? }
-            if procinfo._class.needs_inittable then
+            if procinfo.procdef._class.needs_inittable then
              begin
                objectlibrary.getlabel(nofinal);
                reference_reset_base(href,procinfo.framepointer,target_info.first_parm_offset);
                a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nofinal);
                reg:=g_load_self(list);
                reference_reset_base(href,reg,0);
-               g_finalize(list,procinfo._class,href,false);
+               g_finalize(list,procinfo.procdef._class,href,false);
                reference_release(list,href);
                a_label(list,nofinal);
              end;
             { actually call destructor }
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt }
             reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
             a_param_ref(list, OS_ADDR, href ,paramanager.getintparaloc(2));
@@ -1752,7 +1751,7 @@ unit cgobj;
       var
         href : treference;
      begin
-        if is_class(procinfo._class) then
+        if is_class(procinfo.procdef._class) then
           begin
             if procinfo.selfpointer_offset=0 then
              internalerror(200303256);
@@ -1763,14 +1762,14 @@ unit cgobj;
             a_param_ref(list, OS_ADDR,href,paramanager.getintparaloc(1));
             a_call_name(list,'FPC_DISPOSE_CLASS');
           end
-        else if is_object(procinfo._class) then
+        else if is_object(procinfo.procdef._class) then
           begin
             if procinfo.selfpointer_offset=0 then
              internalerror(200303257);
             if procinfo.vmtpointer_offset=0 then
              internalerror(200303258);
             { parameter 3 : vmt_offset }
-            a_param_const(list, OS_32, procinfo._class.vmt_offset, paramanager.getintparaloc(3));
+            a_param_const(list, OS_32, procinfo.procdef._class.vmt_offset, paramanager.getintparaloc(3));
             { parameter 2 : pointer to vmt, will be reset to 0 when freed }
             reference_reset_base(href, procinfo.framepointer,procinfo.vmtpointer_offset);
             a_paramaddr_ref(list,href,paramanager.getintparaloc(2));
@@ -1854,7 +1853,15 @@ finalization
 end.
 {
   $Log$
-  Revision 1.90  2003-04-26 20:57:17  florian
+  Revision 1.91  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.90  2003/04/26 20:57:17  florian
     * fixed para locations of fpc_class_new helper call
 
   Revision 1.89  2003/04/26 17:21:08  florian

compiler/fppu.pas

@@ -985,6 +985,10 @@ uses
          crc:=ppufile.crc;
          interface_crc:=ppufile.interface_crc;
 
+         { end of implementation, to generate a correct ppufile
+           for ppudump when using INTFPPU define }
+         ppufile.writeentry(ibendimplementation);
+
 {$ifdef Test_Double_checksum}
          crc_array:=ppufile.crc_test;
          ppufile.crc_test:=nil;
@@ -1338,7 +1342,15 @@ uses
 end.
 {
   $Log$
-  Revision 1.31  2003-04-26 00:30:52  peter
+  Revision 1.32  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.31  2003/04/26 00:30:52  peter
     * reset aktfilepos when setting new module for compile
 
   Revision 1.30  2003/03/27 17:44:13  peter

compiler/globals.pas

@@ -1216,8 +1216,7 @@ implementation
          'PASCAL',
          'REGISTER',
          'SAFECALL',
-         'STDCALL',
-         'SYSTEM'
+         'STDCALL'
         );
       var
         t : tproccalloption;
@@ -1529,7 +1528,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.86  2003-04-25 20:59:33  peter
+  Revision 1.87  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.86  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/globtype.pas

@@ -139,8 +139,7 @@ interface
          pocall_pascal,        { pascal standard left to right }
          pocall_register,      { procedure uses register (fastcall) calling }
          pocall_safecall,      { safe call calling conventions }
-         pocall_stdcall,       { procedure uses stdcall call }
-         pocall_system         { system call }
+         pocall_stdcall        { procedure uses stdcall call }
        );
        tproccalloptions = set of tproccalloption;
 
@@ -157,8 +156,7 @@ interface
            'Pascal',
            'Register',
            'SafeCall',
-           'StdCall',
-           'System'
+           'StdCall'
          );
 
     type
@@ -210,7 +208,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2003-04-22 23:50:22  peter
+  Revision 1.37  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.36  2003/04/22 23:50:22  peter
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG

compiler/htypechk.pas

@@ -574,7 +574,8 @@ implementation
     { local routines can't be assigned to procvars }
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
       begin
-         if (from_def.symtablelevel>1) and (to_def.deftype=procvardef) then
+         if (from_def.parast.symtablelevel>normal_function_level) and
+            (to_def.deftype=procvardef) then
            CGMessage(type_e_cannot_local_proc_to_procvar);
       end;
 
@@ -630,8 +631,8 @@ implementation
                           (hsym.varstate=vs_set_but_first_not_passed) then
                         begin
                           if (assigned(hsym.owner) and
-                             assigned(aktprocsym) and
-                             (hsym.owner = aktprocdef.localst)) then
+                              assigned(aktprocdef) and
+                              (hsym.owner=aktprocdef.localst)) then
                            begin
                              if (vo_is_funcret in hsym.varoptions) then
                                CGMessage(sym_w_function_result_not_set)
@@ -997,7 +998,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2003-04-25 20:59:33  peter
+  Revision 1.61  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.60  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/i386/radirect.pas

@@ -151,7 +151,7 @@ interface
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
                                       if assigned(aktprocdef.localst) and
-                                         (lexlevel >= normal_function_level) then
+                                         (aktprocdef.localst.symtablelevel>=normal_function_level) then
                                         sym:=tsym(aktprocdef.localst.search(upper(hs)))
                                       else
                                         sym:=nil;
@@ -241,7 +241,7 @@ interface
                                              end
                                            else if upper(hs)='__SELF' then
                                              begin
-                                                if assigned(procinfo._class) then
+                                                if assigned(aktprocdef._class) then
                                                   hs:=tostr(procinfo.selfpointer_offset)+
                                                       '('+gas_reg2str[framereg.enum]+')'
                                                 else
@@ -258,7 +258,7 @@ interface
                                              begin
                                                 { complicate to check there }
                                                 { we do it: }
-                                                if lexlevel>normal_function_level then
+                                                if aktprocdef.parast.symtablelevel>normal_function_level then
                                                   hs:=tostr(procinfo.framepointer_offset)+
                                                     '('+gas_reg2str[framereg.enum]+')'
                                                 else
@@ -308,7 +308,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.9  2003-04-25 20:59:35  peter
+  Revision 1.10  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.9  2003/04/25 20:59:35  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/import.pas

@@ -58,8 +58,7 @@ type
       constructor Create;virtual;
       destructor Destroy;override;
       procedure preparelib(const s:string);virtual;
-      procedure importproceduredef(aprocdef : tprocdef; const module:string;index:longint;const name:string);virtual;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);virtual;
       procedure importvariable(vs:tvarsym;const name,module:string);virtual;
       procedure generatelib;virtual;
       procedure generatesmartlib;virtual;
@@ -181,13 +180,7 @@ begin
 end;
 
 
-procedure timportlib.importproceduredef(aprocdef : tprocdef; const module:string;index:longint;const name:string);
-begin
-  importprocedure(aprocdef.mangledname, module, index, name);
-end;
-
-
-procedure timportlib.importprocedure(const func,module:string;index:longint;const name:string);
+procedure timportlib.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   NotSupported;
 end;
@@ -245,7 +238,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.21  2002-11-15 01:58:48  peter
+  Revision 1.22  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.21  2002/11/15 01:58:48  peter
     * merged changes from 1.0.7 up to 04-11
       - -V option for generating bug report tracing
       - more tracing for option parsing

compiler/ncal.pas

@@ -1896,35 +1896,26 @@ type
 
          { ensure that the result type is set }
          if not restypeset then
-           resulttype:=procdefinition.rettype
+          begin
+            { constructors return their current class type, not the type where the
+              constructor is declared, this can be different because of inheritance }
+            if (procdefinition.proctypeoption=potype_constructor) and
+               assigned(methodpointer) and
+               assigned(methodpointer.resulttype.def) and
+               (methodpointer.resulttype.def.deftype=classrefdef) then
+              resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype
+            else
+              resulttype:=procdefinition.rettype;
+           end
          else
            resulttype:=restype;
 
-         { modify the exit code, in case of special cases }
-         if (not is_void(resulttype.def)) then
-          begin
-            if paramanager.ret_in_reg(resulttype.def,procdefinition.proccalloption) then
-             begin
-               { wide- and ansistrings are returned in EAX    }
-               { but they are imm. moved to a memory location }
-               if is_widestring(resulttype.def) or
-                  is_ansistring(resulttype.def) then
-                 begin
-                   { we use ansistrings so no fast exit here }
-                   if assigned(procinfo) then
-                    procinfo.no_fast_exit:=true;
-                 end;
-             end;
-          end;
 
-         { constructors return their current class type, not the type where the
-           constructor is declared, this can be different because of inheritance }
-         if (procdefinition.proctypeoption=potype_constructor) then
+         if resulttype.def.needs_inittable then
            begin
-             if assigned(methodpointer) and
-                assigned(methodpointer.resulttype.def) and
-                (methodpointer.resulttype.def.deftype=classrefdef) then
-               resulttype:=tclassrefdef(methodpointer.resulttype.def).pointertype;
+             { we use ansistrings so no fast exit here }
+             if assigned(procinfo) then
+              procinfo.no_fast_exit:=true;
            end;
 
          if assigned(methodpointer) then
@@ -2473,7 +2464,6 @@ type
 
         { set new procinfo }
         procinfo.return_offset:=retoffset;
-        procinfo.para_offset:=para_offset;
         procinfo.no_fast_exit:=false;
 
         { set it to the same lexical level }
@@ -2535,7 +2525,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.144  2003-04-25 20:59:33  peter
+  Revision 1.145  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.144  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/ncgcal.pas

@@ -671,26 +671,28 @@ implementation
         i : integer;
       begin
         { this routine is itself not nested }
-        if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
+        if aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
           begin
             reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
             cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
           end
         { one nesting level }
-        else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
+        else if (aktprocdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
           begin
             cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paramanager.getintparaloc(1));
           end
         { very complex nesting level ... }
-        else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
+        else if (aktprocdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
           begin
             hregister:=rg.getaddressregister(exprasmlist);
             reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
             cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
-            for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
+            i:=aktprocdef.parast.symtablelevel;
+            while (i>tprocdef(procdefinition).parast.symtablelevel) do
               begin
                 reference_reset_base(href,hregister,procinfo.framepointer_offset);
                 cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
+                dec(i);
               end;
             cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(1));
             rg.ungetaddressregister(exprasmlist,hregister);
@@ -1036,10 +1038,11 @@ implementation
               { push base pointer ?}
               { never when inlining, since if necessary, the base pointer }
               { can/will be gottten from the current procedure's symtable }
-              { (JM)}
+              { (JM) }
               if not inlined then
-                if (lexlevel>=normal_function_level) and assigned(tprocdef(procdefinition).parast) and
-                  ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
+                if (aktprocdef.parast.symtablelevel>=normal_function_level) and
+                   assigned(tprocdef(procdefinition).parast) and
+                   ((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
                   push_framepointer;
 
               rg.saveintregvars(exprasmlist,regs_to_push_int);
@@ -1320,7 +1323,6 @@ implementation
 
           { set new procinfo }
           procinfo.return_offset:=retoffset;
-          procinfo.para_offset:=para_offset;
           procinfo.no_fast_exit:=false;
 
           { arg space has been filled by the parent secondcall }
@@ -1437,7 +1439,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2003-04-25 20:59:33  peter
+  Revision 1.54  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.53  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/ncgld.pas

@@ -215,14 +215,14 @@ implementation
                                          location.reference.offset:=-location.reference.offset;
                                     end;
 {$endif powerpc}
-                                  if (lexlevel>symtable.symtablelevel) then
+                                  if (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
                                     begin
                                        hregister:=rg.getaddressregister(exprasmlist);
                                        { make a reference }
                                        reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
                                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
                                        { walk parents }
-                                       i:=lexlevel-1;
+                                       i:=aktprocdef.parast.symtablelevel-1;
                                        while (i>symtable.symtablelevel) do
                                          begin
                                             { make a reference }
@@ -953,7 +953,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2003-04-25 20:59:33  peter
+  Revision 1.53  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.52  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/ncgutil.pas

@@ -69,8 +69,6 @@ interface
                            var nostackframe:boolean;
                            inlined : boolean);
    procedure genexitcode(list : TAAsmoutput;parasize:longint;nostackframe:boolean;inlined:boolean);
-   procedure genimplicitunitinit(list : TAAsmoutput);
-   procedure genimplicitunitfinal(list : TAAsmoutput);
 
    {#
       Allocate the buffers for exception management and setjmp environment.
@@ -952,7 +950,7 @@ implementation
            (tvarsym(p).varspez=vs_value) and
            (paramanager.push_addr_param(tvarsym(p).vartype.def,procinfo.procdef.proccalloption)) then
          begin
-           reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
+           reference_reset_base(href1,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
            if is_open_array(tvarsym(p).vartype.def) or
               is_array_of_const(tvarsym(p).vartype.def) then
              cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
@@ -1050,12 +1048,12 @@ implementation
                   reference_reset_base(href,procinfo.framepointer,
                       -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
                  else
-                  reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
+                  reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
                  cg.g_incrrefcount(list,tvarsym(p).vartype.def,href);
                end;
              vs_out :
                begin
-                 reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
+                 reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
                {$ifdef newra}
                  tmpreg:=rg.getaddressregister(list);
                {$else}
@@ -1091,7 +1089,7 @@ implementation
                reference_reset_base(href,procinfo.framepointer,
                    -tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
               else
-               reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
+               reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
               cg.g_decrrefcount(list,tvarsym(p).vartype.def,href);
             end;
          end;
@@ -1357,7 +1355,7 @@ implementation
         if not is_void(aktprocdef.rettype.def) then
           begin
              { for now the pointer to the result can't be a register }
-             if not(paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
+             if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
                begin
 {$ifdef powerpc}
                   { no stack space is allocated in this case -> can't save the result reg on the stack }
@@ -1401,9 +1399,10 @@ implementation
         case aktprocdef.proctypeoption of
            potype_unitinit:
              begin
-                { using current_module.globalsymtable is hopefully      }
-                { more robust than symtablestack and symtablestack.next }
-                tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
+                { this is also used for initialization of variables in a
+                  program which does not have a globalsymtable }
+                if assigned(current_module.globalsymtable) then
+                  tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
                 tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
              end;
            { units have seperate code for initilization and finalization }
@@ -1430,7 +1429,7 @@ implementation
                  { move register parameters which aren't regable into memory                                          }
                  { we do this after init_paras because it saves some code in init_paras if parameters are in register }
                  { instead in memory                                                                                  }
-                 hp:=tparaitem(procinfo.procdef.para.first);
+                 hp:=tparaitem(aktprocdef.para.first);
                  while assigned(hp) do
                    begin
                      if Tvarsym(hp.parasym).reg.enum>lastreg then
@@ -1557,17 +1556,17 @@ implementation
 
            if (cs_profile in aktmoduleswitches) or
               (aktprocdef.owner.symtabletype=globalsymtable) or
-              (assigned(procinfo._class) and (procinfo._class.owner.symtabletype=globalsymtable)) then
+              (assigned(aktprocdef._class) and
+               (aktprocdef._class.owner.symtabletype=globalsymtable)) then
             make_global:=true;
 
-           if make_global or ((procinfo.flags and pi_is_global) <> 0) then
-            aktprocsym.is_global := True;
-
 {$ifdef GDB}
            if (cs_debuginfo in aktmoduleswitches) then
             begin
+              if make_global or ((procinfo.flags and pi_is_global) <> 0) then
+                tprocsym(aktprocdef.procsym).is_global:=true;
               aktprocdef.concatstabto(stackalloclist);
-              aktprocsym.isstabwritten:=true;
+              tprocsym(aktprocdef.procsym).isstabwritten:=true;
             end;
 {$endif GDB}
 
@@ -1602,7 +1601,7 @@ implementation
               if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+procinfo.para_offset-4;
+                parasize:=aktprocdef.parast.datasize+aktprocdef.parast.address_fixup-4;
               if stackframe<>0 then
                 cg.g_stackpointer_alloc(stackalloclist,stackframe);
             end
@@ -1613,7 +1612,7 @@ implementation
               if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocdef.parast.datasize+procinfo.para_offset-target_info.first_parm_offset;
+                parasize:=aktprocdef.parast.datasize+aktprocdef.parast.address_fixup-target_info.first_parm_offset;
 
               if (po_interrupt in aktprocdef.procoptions) then
                 cg.g_interrupt_stackframe_entry(stackalloclist);
@@ -1666,7 +1665,7 @@ implementation
 
         { call the destructor help procedure }
         if (aktprocdef.proctypeoption=potype_destructor) and
-           assigned(procinfo._class) then
+           assigned(aktprocdef._class) then
          cg.g_call_destructor_helper(list);
 
         { finalize temporary data }
@@ -1676,9 +1675,10 @@ implementation
         case aktprocdef.proctypeoption of
            potype_unitfinalize:
              begin
-                { using current_module.globalsymtable is hopefully      }
-                { more robust than symtablestack and symtablestack.next }
-                tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
+                { this is also used for initialization of variables in a
+                  program which does not have a globalsymtable }
+                if assigned(current_module.globalsymtable) then
+                  tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
                 tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
              end;
            { units/progs have separate code for initialization and finalization }
@@ -1714,24 +1714,24 @@ implementation
 
              if (aktprocdef.proctypeoption=potype_constructor) then
                begin
-                  if assigned(procinfo._class) then
+                  if assigned(aktprocdef._class) then
                     begin
-                       pd:=procinfo._class.searchdestructor;
+                       pd:=aktprocdef._class.searchdestructor;
                        if assigned(pd) then
                          begin
                             objectlibrary.getlabel(nodestroycall);
                             reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
                             cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,nodestroycall);
                             r:=cg.g_load_self(list);
-                            if is_class(procinfo._class) then
+                            if is_class(aktprocdef._class) then
                              begin
                                cg.a_param_const(list,OS_INT,1,paramanager.getintparaloc(2));
                                cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
                              end
-                            else if is_object(procinfo._class) then
+                            else if is_object(aktprocdef._class) then
                              begin
                                cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(2));
-                               reference_reset_symbol(href,objectlibrary.newasmsymboldata(procinfo._class.vmt_mangledname),0);
+                               reference_reset_symbol(href,objectlibrary.newasmsymboldata(aktprocdef._class.vmt_mangledname),0);
                                cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(1));
                              end
                             else
@@ -1740,7 +1740,7 @@ implementation
                              begin
                                reference_reset_base(href,r,0);
                                cg.a_load_ref_reg(list,OS_ADDR,href,r);
-                               reference_reset_base(href,r,procinfo._class.vmtmethodoffset(pd.extnumber));
+                               reference_reset_base(href,r,aktprocdef._class.vmtmethodoffset(pd.extnumber));
                                cg.a_call_ref(list,href);
                              end
                             else
@@ -1905,9 +1905,9 @@ implementation
 {$ifdef GDB}
         if (cs_debuginfo in aktmoduleswitches) and not inlined  then
           begin
-            if assigned(procinfo._class) then
+            if assigned(aktprocdef._class) then
               if (not assigned(procinfo.parent) or
-                 not assigned(procinfo.parent._class)) then
+                  not assigned(procinfo.parent.procdef._class)) then
                 begin
                   if (po_classmethod in aktprocdef.procoptions) or
                      ((po_virtualmethod in aktprocdef.procoptions) and
@@ -1920,30 +1920,31 @@ implementation
                     end
                   else
                     begin
-                      if not(is_class(procinfo._class)) then
+                      if not(is_class(aktprocdef._class)) then
                         st:='v'
                       else
                         st:='p';
                       list.concat(Tai_stabs.Create(strpnew(
-                       '"$t:'+st+procinfo._class.numberstring+'",'+
+                       '"$t:'+st+aktprocdef._class.numberstring+'",'+
                        tostr(N_tsym)+',0,0,'+tostr(procinfo.selfpointer_offset))));
                     end;
                 end
               else
                 begin
-                  if not is_class(procinfo._class) then
+                  if not is_class(aktprocdef._class) then
                     st:='*'
                   else
                     st:='';
 {$warning GDB self}
                   {list.concat(Tai_stabs.Create(strpnew(
-                   '"$t:r'+st+procinfo._class.numberstring+'",'+
+                   '"$t:r'+st+aktprocdef._class.numberstring+'",'+
                    tostr(N_RSYM)+',0,0,'+tostr(stab_regindex[SELF_POINTER_REG]))));}
                 end;
 
             { define calling EBP as pseudo local var PM }
             { this enables test if the function is a local one !! }
-            if  assigned(procinfo.parent) and (lexlevel>normal_function_level) then
+            if  assigned(procinfo.parent) and
+                (aktprocdef.parast.symtablelevel>normal_function_level) then
               list.concat(Tai_stabs.Create(strpnew(
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
                tostr(N_LSYM)+',0,0,'+tostr(procinfo.framepointer_offset))));
@@ -1952,11 +1953,11 @@ implementation
               begin
                 if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
                   list.concat(Tai_stabs.Create(strpnew(
-                   '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
+                   '"'+aktprocdef.procsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                    tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))))
                 else
                   list.concat(Tai_stabs.Create(strpnew(
-                   '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
+                   '"'+aktprocdef.procsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                    tostr(N_tsym)+',0,0,'+tostr(procinfo.return_offset))));
                 if (m_result in aktmodeswitches) then
                   if paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption) then
@@ -2000,64 +2001,18 @@ implementation
          cleanup_regvars(list);
       end;
 
-
-    procedure genimplicitunitinit(list : TAAsmoutput);
-      var
-         oldprocinfo : tprocinfo;
-      begin
-         oldprocinfo:=procinfo;
-         procinfo:=voidprocpi;
-{$ifdef GDB}
-         if (cs_debuginfo in aktmoduleswitches) and
-            target_info.use_function_relative_addresses then
-           list.concat(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
-{$endif GDB}
-         list.concat(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
-         list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
-{$ifndef i386}
-         { on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
-         cg.g_stackframe_entry(list,0);
-{$endif i386}
-         { using current_module.globalsymtable is hopefully      }
-         { more robust than symtablestack and symtablestack.next }
-         if assigned(current_module.globalsymtable) then
-           tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
-         tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
-         cg.g_return_from_proc(list,0);
-         procinfo:=oldprocinfo;
-      end;
-
-
-    procedure genimplicitunitfinal(list : TAAsmoutput);
-      var
-         oldprocinfo : tprocinfo;
-      begin
-         oldprocinfo:=procinfo;
-         procinfo:=voidprocpi;
-{$ifdef GDB}
-         if (cs_debuginfo in aktmoduleswitches) and
-            target_info.use_function_relative_addresses then
-           list.concat(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
-{$endif GDB}
-         list.concat(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
-         list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
-{$ifndef i386}
-         { on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
-         cg.g_stackframe_entry(list,0);
-{$endif i386}
-         { using current_module.globalsymtable is hopefully      }
-         { more robust than symtablestack and symtablestack.next }
-         if assigned(current_module.globalsymtable) then
-           tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
-         tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
-         cg.g_return_from_proc(list,0);
-         procinfo:=oldprocinfo;
-      end;
-
 end.
 {
   $Log$
-  Revision 1.90  2003-04-26 17:21:08  florian
+  Revision 1.91  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.90  2003/04/26 17:21:08  florian
     * fixed passing of fpu values by fpu register
 
   Revision 1.89  2003/04/25 20:59:33  peter

compiler/nflw.pas

@@ -735,12 +735,12 @@ implementation
                 is_constintnode(tvecnode(hp).right)) do
            hp:=tunarynode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
-           in the same lexlevel }
+           in the same level as the para of the current proc }
          if (
              (hp.nodetype=loadn) and
              (
-              (tloadnode(hp).symtable.symtablelevel<=1) or
-              (tloadnode(hp).symtable.symtablelevel=lexlevel)
+              (tloadnode(hp).symtable.symtablelevel=normal_function_level) or
+              (tloadnode(hp).symtable.symtablelevel=aktprocdef.parast.symtablelevel)
              ) and
              not(
                  (tloadnode(hp).symtableentry.typ=varsym) and
@@ -879,8 +879,6 @@ implementation
 
 
     function texitnode.det_resulttype:tnode;
-      var
-         pt : tnode;
       begin
         result:=nil;
         { Check the 2 types }
@@ -897,8 +895,13 @@ implementation
                      cloadnode.create(aktprocdef.funcretsym,aktprocdef.funcretsym.owner),
                      left);
                  onlyassign:=true;
+               end
+              else
+               begin
+                 { mark funcretsym as assigned }
+                 inc(tvarsym(aktprocdef.funcretsym).refs);
+                 tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
                end;
-              tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
             end;
          end;
         if assigned(left) then
@@ -1495,7 +1498,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.69  2003-04-26 00:28:41  peter
+  Revision 1.70  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.69  2003/04/26 00:28:41  peter
     * removed load_funcret
 
   Revision 1.68  2003/04/25 20:59:33  peter

compiler/nld.pas

@@ -378,50 +378,44 @@ implementation
                    end;
               end;
             varsym :
-                begin
-                  if (symtable.symtabletype in [parasymtable,localsymtable]) and
-                      (lexlevel>symtable.symtablelevel) then
+              begin
+                if (symtable.symtabletype in [parasymtable,localsymtable]) and
+                   (aktprocdef.parast.symtablelevel>symtable.symtablelevel) then
+                  begin
+                    { if the variable is in an other stackframe then we need
+                      a register to dereference }
+                    if symtable.symtablelevel>normal_function_level then
                      begin
-                       { if the variable is in an other stackframe then we need
-                         a register to dereference }
-                       if (symtable.symtablelevel)>0 then
-                        begin
-                          registers32:=1;
-                          { further, the variable can't be put into a register }
-                          tvarsym(symtableentry).varoptions:=
-                            tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
-                        end;
+                       registers32:=1;
+                       { further, the variable can't be put into a register }
+                       tvarsym(symtableentry).varoptions:=
+                         tvarsym(symtableentry).varoptions-[vo_fpuregable,vo_regable];
                      end;
-                   if (tvarsym(symtableentry).varspez=vs_const) then
-                     expectloc:=LOC_CREFERENCE;
-                   { we need a register for call by reference parameters }
-                   if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
-                      ((tvarsym(symtableentry).varspez=vs_const) and
-                      paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,pocall_none)) or
-                      { call by value open arrays are also indirect addressed }
-                      is_open_array(tvarsym(symtableentry).vartype.def) then
-                     registers32:=1;
-                   if symtable.symtabletype in [withsymtable,objectsymtable] then
-                     inc(registers32);
-
-                   if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
-                     registers32:=1;
-                    if nf_write in flags then
-                      Tvarsym(symtableentry).trigger_notifications(vn_onwrite)
-                    else
-                      Tvarsym(symtableentry).trigger_notifications(vn_onread);
-                   { count variable references }
-
-                     { this will create problem with local var set by
-                     under_procedures
-                     if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
-                       and ((tvarsym(symtableentry).owner = aktprocdef.localst)
-                       or (tvarsym(symtableentry).owner = aktprocdef.localst))) then }
-                   if rg.t_times<1 then
-                     inc(tvarsym(symtableentry).refs)
-                   else
-                     inc(tvarsym(symtableentry).refs,rg.t_times);
-                end;
+                  end;
+                if (tvarsym(symtableentry).varspez=vs_const) then
+                  expectloc:=LOC_CREFERENCE;
+                { we need a register for call by reference parameters }
+                if (tvarsym(symtableentry).varspez in [vs_var,vs_out]) or
+                   ((tvarsym(symtableentry).varspez=vs_const) and
+                    paramanager.push_addr_param(tvarsym(symtableentry).vartype.def,pocall_none)) or
+                    { call by value open arrays are also indirect addressed }
+                    is_open_array(tvarsym(symtableentry).vartype.def) then
+                  registers32:=1;
+                if symtable.symtabletype in [withsymtable,objectsymtable] then
+                  inc(registers32);
+
+                if ([vo_is_thread_var,vo_is_dll_var]*tvarsym(symtableentry).varoptions)<>[] then
+                  registers32:=1;
+                if nf_write in flags then
+                  Tvarsym(symtableentry).trigger_notifications(vn_onwrite)
+                else
+                  Tvarsym(symtableentry).trigger_notifications(vn_onread);
+                { count variable references }
+                if rg.t_times<1 then
+                  inc(tvarsym(symtableentry).refs)
+                else
+                  inc(tvarsym(symtableentry).refs,rg.t_times);
+              end;
             typedconstsym :
                 ;
             procsym :
@@ -1135,7 +1129,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.88  2003-04-26 00:28:42  peter
+  Revision 1.89  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.88  2003/04/26 00:28:42  peter
     * removed load_funcret
 
   Revision 1.87  2003/04/25 20:59:33  peter

compiler/nmem.pas

@@ -414,12 +414,11 @@ implementation
 
 
                  { create procvardef }
-                 resulttype.setdef(tprocvardef.create);
+                 resulttype.setdef(tprocvardef.create(hp3.parast.symtablelevel));
                  tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
                  tprocvardef(resulttype.def).proccalloption:=hp3.proccalloption;
                  tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
                  tprocvardef(resulttype.def).rettype:=hp3.rettype;
-                 tprocvardef(resulttype.def).symtablelevel:=hp3.symtablelevel;
 
                  { method ? then set the methodpointer flag }
                  if (hp3.owner.symtabletype=objectsymtable) then
@@ -1060,7 +1059,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2003-04-23 10:10:54  peter
+  Revision 1.50  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.49  2003/04/23 10:10:54  peter
     * procvar is not compared in addrn
 
   Revision 1.48  2003/04/22 23:50:23  peter

compiler/paramgr.pas

@@ -40,12 +40,6 @@ unit paramgr;
        tparamanager = class
           {# Returns true if the return value can be put in accumulator }
           function ret_in_acc(def : tdef;calloption : tproccalloption) : boolean;virtual;
-          {# Returns true if the return value is put in a register
-
-             Either a floating point register, or a general purpose
-             register.
-          }
-          function ret_in_reg(def : tdef;calloption : tproccalloption) : boolean;virtual;
 
           {# Returns true if the return value is actually a parameter
              pointer.
@@ -131,10 +125,6 @@ unit paramgr;
                      ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
       end;
 
-    function tparamanager.ret_in_reg(def : tdef;calloption : tproccalloption) : boolean;
-      begin
-        ret_in_reg:=ret_in_acc(def,calloption) or (def.deftype=floatdef);
-      end;
 
     { true if uses a parameter as return value }
     function tparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean;
@@ -308,7 +298,7 @@ unit paramgr;
              end;
           else
              begin
-                if ret_in_reg(def,calloption) then
+                if ret_in_acc(def,calloption) then
                   begin
                     result.loc := LOC_REGISTER;
                     result.register.enum := accumulator;
@@ -346,7 +336,7 @@ unit paramgr;
           its useless to continue on in this
           routine
         }
-        if not paramanager.ret_in_reg(def,calloption) then
+        if paramanager.ret_in_param(def,calloption) then
           exit;
         paramloc := paramanager.getfuncresultloc(def,calloption);
         case paramloc.loc of
@@ -412,7 +402,15 @@ end.
 
 {
    $Log$
-   Revision 1.34  2003-04-23 13:15:04  peter
+   Revision 1.35  2003-04-27 07:29:50  peter
+     * aktprocdef cleanup, aktprocdef is now always nil when parsing
+       a new procdef declaration
+     * aktprocsym removed
+     * lexlevel removed, use symtable.symtablelevel instead
+     * implicit init/final code uses the normal genentry/genexit
+     * funcret state checking updated for new funcret handling
+
+   Revision 1.34  2003/04/23 13:15:04  peter
      * fix push_high_param for cdecl
 
    Revision 1.33  2003/04/23 10:14:30  peter

compiler/parser.pas

@@ -41,7 +41,7 @@ implementation
       symbase,symtable,symdef,symsym,
       finput,fmodule,fppu,
       aasmbase,aasmtai,
-      cgbase,
+      cpubase,cgbase,
       script,gendef,
 {$ifdef BrowserLog}
       browlog,
@@ -68,7 +68,6 @@ implementation
          testcurobject:=0;
 
          { Symtable }
-         aktprocsym:=nil;
          aktprocdef:=nil;
 
          objectlibrary:=nil;
@@ -117,6 +116,15 @@ implementation
          { codegen }
          if paraprintnodetree<>0 then
            printnode_reset;
+
+         { for the implicitly generated init/final. procedures for global init. variables,
+           a dummy procinfo is necessary }
+         voidprocpi:=cprocinfo.create;
+         with voidprocpi do
+           begin
+              framepointer.enum:=R_INTREGISTER;
+              framepointer.number:=NR_FRAME_POINTER_REG;
+           end;
       end;
 
 
@@ -143,6 +151,9 @@ implementation
 
          { free list of .o files }
          SmartLinkOFiles.Free;
+
+         { codegen }
+         voidprocpi.free;
       end;
 
 
@@ -316,7 +327,6 @@ implementation
             oldsymtablestack:=symtablestack;
             olddefaultsymtablestack:=defaultsymtablestack;
             oldrefsymtable:=refsymtable;
-            oldaktprocsym:=aktprocsym;
             oldaktprocdef:=aktprocdef;
             oldaktdefproccall:=aktdefproccall;
             move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
@@ -379,7 +389,6 @@ implementation
          defaultsymtablestack:=nil;
          systemunit:=nil;
          refsymtable:=nil;
-         aktprocsym:=nil;
          aktdefproccall:=initdefproccall;
          registerdef:=true;
          statement_level:=0;
@@ -535,7 +544,6 @@ implementation
                  symtablestack:=oldsymtablestack;
                  defaultsymtablestack:=olddefaultsymtablestack;
                  aktdefproccall:=oldaktdefproccall;
-                 aktprocsym:=oldaktprocsym;
                  aktprocdef:=oldaktprocdef;
                  move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
                  aktsourcecodepage:=oldsourcecodepage;
@@ -626,7 +634,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2003-04-26 00:30:52  peter
+  Revision 1.51  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.50  2003/04/26 00:30:52  peter
     * reset aktfilepos when setting new module for compile
 
   Revision 1.49  2003/04/25 20:59:33  peter

compiler/pass_2.pas

@@ -276,51 +276,6 @@ implementation
          { only do secondpass if there are no errors }
          if ErrorCount=0 then
            begin
-{$ifdef OMITSTACKFRAME}
-             if (cs_regalloc in aktglobalswitches) and
-                ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
-               begin
-                 { can we omit the stack frame ? }
-                 { conditions:
-                   1. procedure (not main block)
-                   2. no constructor or destructor
-                   3. no call to other procedures
-                   4. no interrupt handler
-                 }
-                 {!!!!!! this doesn work yet, because of problems with
-                    with linux and windows
-                 }
-                 (*
-                 if assigned(aktprocsym) then
-                   begin
-                     if not(assigned(procinfo^._class)) and
-                        not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
-                        not(po_interrupt in aktprocdef.procoptions) and
-                        ((procinfo^.flags and pi_do_call)=0) and
-                        (lexlevel>=normal_function_level) then
-                       begin
-                        { use ESP as frame pointer }
-                         procinfo^.framepointer:=STACK_POINTER_REG;
-                         use_esp_stackframe:=true;
-
-                        { calc parameter distance new }
-                         dec(procinfo^.framepointer_offset,4);
-                         dec(procinfo^.selfpointer_offset,4);
-
-                        { is this correct ???}
-                        { retoffset can be negativ for results in eax !! }
-                        { the value should be decreased only if positive }
-                         if procinfo.retoffset>=0 then
-                           dec(procinfo.retoffset,4);
-
-                         dec(procinfo.para_offset,4);
-                         aktprocdef.parast.address_fixup:=procinfo.para_offset;
-                       end;
-                   end;
-                  *)
-                end;
-{$endif OMITSTACKFRAME}
-
               { assign parameter locations }
 {$ifndef i386}
               setparalocs(procinfo.procdef);
@@ -351,7 +306,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  2003-04-25 20:59:33  peter
+  Revision 1.48  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.47  2003/04/25 20:59:33  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/pdecl.pas

@@ -218,7 +218,7 @@ implementation
                           parse_var_proc_directives(sym);
                        end;
                       { add default calling convention }
-                      handle_calling_convention(nil,tabstractprocdef(tt.def));
+                      handle_calling_convention(tabstractprocdef(tt.def));
                       paramanager.create_param_loc_info(tabstractprocdef(tt.def));
                     end;
                    if not skipequal then
@@ -633,7 +633,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.65  2003-04-01 16:17:15  peter
+  Revision 1.66  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.65  2003/04/01 16:17:15  peter
     * reset symbol for unique types
 
   Revision 1.64  2003/01/05 15:54:15  florian

compiler/pdecobj.pas

@@ -48,6 +48,13 @@ implementation
 {$endif}
       ;
 
+    const
+      { Please leave this here, this module should NOT use
+        these variables.
+        Declaring it as string here results in an error when compiling (PFV) }
+      aktprocdef = 'error';
+
+
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
       var
@@ -56,32 +63,25 @@ implementation
          childof : tobjectdef;
          aktclass : tobjectdef;
 
-      procedure constructor_head;
-
+      function constructor_head:tprocdef;
+        var
+          pd : tprocdef;
         begin
            consume(_CONSTRUCTOR);
            { must be at same level as in implementation }
-           inc(lexlevel);
-           parse_proc_head(potype_constructor);
-           dec(lexlevel);
-
-           if (cs_constructor_name in aktglobalswitches) and (aktprocsym.name<>'INIT') then
-            Message(parser_e_constructorname_must_be_init);
-
-           include(aktclass.objectoptions,oo_has_constructor);
+           pd:=parse_proc_head(aktclass,potype_constructor);
+           if (cs_constructor_name in aktglobalswitches) and
+              (pd.procsym.name<>'INIT') then
+             Message(parser_e_constructorname_must_be_init);
            consume(_SEMICOLON);
-             begin
-                if is_class(aktclass) then
-                  begin
-                     { CLASS constructors return the created instance }
-                     aktprocdef.rettype.def:=aktclass;
-                  end
-                else
-                  begin
-                     { OBJECT constructors return a boolean }
-                     aktprocdef.rettype:=booltype;
-                  end;
-             end;
+           include(aktclass.objectoptions,oo_has_constructor);
+           { Set return type, class constructors return the
+             created instance, object constructors return boolean }
+           if is_class(pd._class) then
+            pd.rettype.setdef(pd._class)
+           else
+            pd.rettype:=booltype;
+           constructor_head:=pd;
         end;
 
 
@@ -220,8 +220,6 @@ implementation
            writeprocdef : tprocvardef;
         begin
            { check for a class }
-           aktprocsym:=nil;
-           aktprocdef:=nil;
            if not((is_class_or_interface(aktclass)) or
               ((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
              Message(parser_e_syntax_error);
@@ -231,8 +229,8 @@ implementation
              procedures. the readprocdef will store all definitions }
            oldregisterdef:=registerdef;
            registerdef:=false;
-           readprocdef:=tprocvardef.create;
-           writeprocdef:=tprocvardef.create;
+           readprocdef:=tprocvardef.create(normal_function_level);
+           writeprocdef:=tprocvardef.create(normal_function_level);
            registerdef:=oldregisterdef;
 
            if token<>_ID then
@@ -384,8 +382,7 @@ implementation
                        { read is function returning the type of the property }
                        readprocdef.rettype:=p.proptype;
                        { Insert hidden parameters }
-                       insert_hidden_para(readprocdef);
-                       insert_funcret_para(readprocdef);
+                       calc_parast(readprocdef);
                        { search procdefs matching readprocdef }
                        pd:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,true,false);
                        if not(assigned(pd)) then
@@ -428,8 +425,7 @@ implementation
                        writeprocdef.parast.insert(hvs);
                        writeprocdef.concatpara(nil,p.proptype,hvs,vs_value,nil);
                        { Insert hidden parameters }
-                       insert_hidden_para(writeprocdef);
-                       insert_funcret_para(writeprocdef);
+                       calc_parast(writeprocdef);
                        { search procdefs matching writeprocdef }
                        pd:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,true,false);
                        if not(assigned(pd)) then
@@ -551,21 +547,23 @@ implementation
         end;
 
 
-      procedure destructor_head;
+      function destructor_head:tprocdef;
+        var
+          pd : tprocdef;
         begin
            consume(_DESTRUCTOR);
-           inc(lexlevel);
-           parse_proc_head(potype_destructor);
-           dec(lexlevel);
-           if (cs_constructor_name in aktglobalswitches) and (aktprocsym.name<>'DONE') then
-            Message(parser_e_destructorname_must_be_done);
-           include(aktclass.objectoptions,oo_has_destructor);
+           pd:=parse_proc_head(aktclass,potype_destructor);
+           if (cs_constructor_name in aktglobalswitches) and
+              (pd.procsym.name<>'DONE') then
+             Message(parser_e_destructorname_must_be_done);
+           if not(pd.Para.empty) and
+              (m_fpc in aktmodeswitches) then
+             Message(parser_e_no_paras_for_destructor);
            consume(_SEMICOLON);
-           if not(aktprocdef.Para.empty) then
-             if (m_fpc in aktmodeswitches) then
-               Message(parser_e_no_paras_for_destructor);
+           include(aktclass.objectoptions,oo_has_destructor);
            { no return value }
-           aktprocdef.rettype:=voidtype;
+           pd.rettype:=voidtype;
+           destructor_head:=pd;
         end;
 
       var
@@ -574,8 +572,6 @@ implementation
          tt     : ttype;
          old_object_option : tsymoptions;
          oldprocinfo : tprocinfo;
-         oldprocsym : tprocsym;
-         oldprocdef : tprocdef;
          oldparse_only : boolean;
          storetypecanbeforward : boolean;
 
@@ -900,22 +896,18 @@ implementation
                end;
         end;
 
-      procedure chkcpp;
-
+        procedure chkcpp(pd:tprocdef);
         begin
-           if is_cppclass(aktclass) then
-             begin
-                aktprocdef.proccalloption:=pocall_cppdecl;
-                aktprocdef.setmangledname(
-                  target_info.Cprefix+aktprocdef.cplusplusmangledname);
-             end;
+           if is_cppclass(pd._class) then
+            begin
+              pd.proccalloption:=pocall_cppdecl;
+              pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
+            end;
         end;
 
+      var
+        pd : tprocdef;
       begin
-         {Nowadays aktprocsym may already have a value, so we need to save
-          it.}
-         oldprocdef:=aktprocdef;
-         oldprocsym:=aktprocsym;
          old_object_option:=current_object_option;
 
          { forward is resolved }
@@ -957,7 +949,6 @@ implementation
          { new procinfo }
          oldprocinfo:=procinfo;
          procinfo:=cprocinfo.create;
-         procinfo._class:=aktclass;
 
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
@@ -1023,32 +1014,34 @@ implementation
                 _CLASS :
                   begin
                     if (sp_published in current_object_option) and
-                      not(oo_can_have_published in aktclass.objectoptions) then
+                       not(oo_can_have_published in aktclass.objectoptions) then
                       Message(parser_e_cant_have_published);
 
                     oldparse_only:=parse_only;
                     parse_only:=true;
-                    parse_proc_dec;
+                    pd:=parse_proc_dec(aktclass);
+
                     { this is for error recovery as well as forward }
                     { interface mappings, i.e. mapping to a method  }
                     { which isn't declared yet                      }
-                    if assigned(aktprocsym) then
-                      begin
-                          parse_object_proc_directives(aktprocsym);
+                    if assigned(pd) then
+                     begin
+                       parse_object_proc_directives(pd);
+                       calc_parast(pd);
 
-                          { add definition to procsym }
-                          proc_add_definition(aktprocsym,aktprocdef);
+                       { add definition to procsym }
+                       proc_add_definition(pd);
 
-                          { add procdef options to objectdef options }
-                          if (po_msgint in aktprocdef.procoptions) then
-                           include(aktclass.objectoptions,oo_has_msgint);
-                          if (po_msgstr in aktprocdef.procoptions) then
-                            include(aktclass.objectoptions,oo_has_msgstr);
-                          if (po_virtualmethod in aktprocdef.procoptions) then
-                            include(aktclass.objectoptions,oo_has_virtual);
+                       { add procdef options to objectdef options }
+                       if (po_msgint in pd.procoptions) then
+                        include(aktclass.objectoptions,oo_has_msgint);
+                       if (po_msgstr in pd.procoptions) then
+                         include(aktclass.objectoptions,oo_has_msgstr);
+                       if (po_virtualmethod in pd.procoptions) then
+                         include(aktclass.objectoptions,oo_has_virtual);
 
-                          chkcpp;
-                       end;
+                       chkcpp(pd);
+                     end;
 
                     parse_only:=oldparse_only;
                   end;
@@ -1066,18 +1059,17 @@ implementation
 
                     oldparse_only:=parse_only;
                     parse_only:=true;
-                    constructor_head;
-                    parse_object_proc_directives(aktprocsym);
+                    pd:=constructor_head;
+                    parse_object_proc_directives(pd);
+                    calc_parast(pd);
 
                     { add definition to procsym }
-                    proc_add_definition(aktprocsym,aktprocdef);
+                    proc_add_definition(pd);
 
                     { add procdef options to objectdef options }
-                    if (po_virtualmethod in aktprocdef.procoptions) then
+                    if (po_virtualmethod in pd.procoptions) then
                       include(aktclass.objectoptions,oo_has_virtual);
-
-                    chkcpp;
-
+                    chkcpp(pd);
                     parse_only:=oldparse_only;
                   end;
                 _DESTRUCTOR :
@@ -1098,17 +1090,18 @@ implementation
                     there_is_a_destructor:=true;
                     oldparse_only:=parse_only;
                     parse_only:=true;
-                    destructor_head;
-                    parse_object_proc_directives(aktprocsym);
+                    pd:=destructor_head;
+                    parse_object_proc_directives(pd);
+                    calc_parast(pd);
 
                     { add definition to procsym }
-                    proc_add_definition(aktprocsym,aktprocdef);
+                    proc_add_definition(pd);
 
                     { add procdef options to objectdef options }
-                    if (po_virtualmethod in aktprocdef.procoptions) then
+                    if (po_virtualmethod in pd.procoptions) then
                       include(aktclass.objectoptions,oo_has_virtual);
 
-                    chkcpp;
+                    chkcpp(pd);
 
                     parse_only:=oldparse_only;
                   end;
@@ -1143,9 +1136,6 @@ implementation
          {Restore procinfo}
          procinfo.free;
          procinfo:=oldprocinfo;
-         {Restore the aktprocsym.}
-         aktprocsym:=oldprocsym;
-         aktprocdef:=oldprocdef;
          current_object_option:=old_object_option;
 
          object_dec:=aktclass;
@@ -1154,7 +1144,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2003-04-26 00:32:37  peter
+  Revision 1.62  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.61  2003/04/26 00:32:37  peter
     * start search for overriden properties in the parent class
 
   Revision 1.60  2003/04/25 20:59:33  peter

compiler/pexpr.pas

@@ -1075,7 +1075,7 @@ implementation
                       also has objectsymtable. And withsymtable is
                       not possible for self in class methods (PFV) }
                     if (srsymtable.symtabletype=objectsymtable) and
-                       assigned(aktprocsym) and
+                       assigned(aktprocdef) and
                        (po_classmethod in aktprocdef.procoptions) then
                       Message(parser_e_only_class_methods);
                     if (sp_static in srsym.symoptions) then
@@ -1125,10 +1125,10 @@ implementation
                          begin
                            consume(_POINT);
                            if assigned(procinfo) and
-                              assigned(procinfo._class) and
+                              assigned(procinfo.procdef._class) and
                               not(getaddr) then
                             begin
-                              if procinfo._class.is_related(tobjectdef(htype.def)) then
+                              if procinfo.procdef._class.is_related(tobjectdef(htype.def)) then
                                begin
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
@@ -1262,7 +1262,7 @@ implementation
                     { are we in a class method ? }
                     possible_error:=(srsym.owner.symtabletype=objectsymtable) and
                                     not(is_interface(tdef(srsym.owner.defowner))) and
-                                    assigned(aktprocsym) and
+                                    assigned(aktprocdef) and
                                     (po_classmethod in aktprocdef.procoptions);
                     do_proc_call(srsym,srsymtable,
                                  (getaddr and not(token in [_CARET,_POINT])),
@@ -1281,7 +1281,7 @@ implementation
                     { access to property in a method }
                     { are we in a class method ? }
                     if (srsym.owner.symtabletype=objectsymtable) and
-                       assigned(aktprocsym) and
+                       assigned(aktprocdef) and
                        (po_classmethod in aktprocdef.procoptions) then
                      Message(parser_e_only_class_methods);
                     { no method pointer }
@@ -1677,17 +1677,18 @@ implementation
       ---------------------------------------------}
 
       var
-         l      : longint;
-         card   : cardinal;
-         ic     : TConstExprInt;
+         l        : longint;
+         card     : cardinal;
+         ic       : TConstExprInt;
          oldp1,
-         p1     : tnode;
-         code   : integer;
+         p1       : tnode;
+         code     : integer;
          again    : boolean;
          sym      : tsym;
+         pd       : tprocdef;
          classh   : tobjectdef;
-         d      : bestreal;
-         hs : string;
+         d        : bestreal;
+         hs       : string;
          htype    : ttype;
          filepos  : tfileposinfo;
 
@@ -1728,7 +1729,7 @@ implementation
              begin
                again:=true;
                consume(_SELF);
-               if not assigned(procinfo._class) then
+               if not assigned(procinfo.procdef._class) then
                 begin
                   p1:=cerrornode.create;
                   again:=false;
@@ -1739,11 +1740,11 @@ implementation
                   if (po_classmethod in aktprocdef.procoptions) then
                    begin
                      { self in class methods is a class reference type }
-                     htype.setdef(procinfo._class);
+                     htype.setdef(procinfo.procdef._class);
                      p1:=cselfnode.create(tclassrefdef.create(htype));
                    end
                   else
-                   p1:=cselfnode.create(procinfo._class);
+                   p1:=cselfnode.create(procinfo.procdef._class);
                   postfixoperators(p1,again);
                 end;
              end;
@@ -1752,22 +1753,23 @@ implementation
              begin
                again:=true;
                consume(_INHERITED);
-               if assigned(procinfo._class) then
+               if assigned(aktprocdef._class) then
                 begin
-                  classh:=procinfo._class.childof;
+                  classh:=aktprocdef._class.childof;
                   { if inherited; only then we need the method with
                     the same name }
                   if token in endtokens then
                    begin
-                     hs:=aktprocsym.name;
+                     hs:=aktprocdef.procsym.name;
                      anon_inherited:=true;
                      { For message methods we need to search using the message
                        number or string }
-                     if (po_msgint in aktprocsym.first_procdef.procoptions) then
-                      sym:=searchsym_in_class_by_msgint(classh,aktprocsym.first_procdef.messageinf.i)
+                     pd:=tprocsym(aktprocdef.procsym).first_procdef;
+                     if (po_msgint in pd.procoptions) then
+                      sym:=searchsym_in_class_by_msgint(classh,pd.messageinf.i)
                      else
-                      if (po_msgstr in aktprocsym.first_procdef.procoptions) then
-                       sym:=searchsym_in_class_by_msgstr(classh,aktprocsym.first_procdef.messageinf.str)
+                      if (po_msgstr in pd.procoptions) then
+                       sym:=searchsym_in_class_by_msgstr(classh,pd.messageinf.str)
                      else
                       sym:=searchsym_in_class(classh,hs);
                    end
@@ -2311,7 +2313,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.111  2003-04-26 00:33:07  peter
+  Revision 1.112  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.111  2003/04/26 00:33:07  peter
     * vo_is_result flag added for the special RESULT symbol
 
   Revision 1.110  2003/04/25 20:59:33  peter

compiler/pmodules.pas

@@ -488,11 +488,9 @@ implementation
          pu     : tused_unit;
          hp2    : tmodule;
          hp3    : tsymtable;
-         oldprocsym:tprocsym;
-         oldprocdef:tprocdef;
+         oldprocdef : tprocdef;
          unitsym : tunitsym;
       begin
-         oldprocsym:=aktprocsym;
          oldprocdef:=aktprocdef;
          consume(_USES);
 {$ifdef DEBUG}
@@ -616,7 +614,6 @@ implementation
                 end;
               pu:=tused_unit(pu.next);
            end;
-          aktprocsym:=oldprocsym;
           aktprocdef:=oldprocdef;
       end;
 
@@ -710,42 +707,96 @@ implementation
       end;
 
 
-    procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
+    function gen_main_procsym(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
       var
         stt : tsymtable;
+        ps  : tprocsym;
+        pd  : tprocdef;
       begin
         {Generate a procsym for main}
         make_ref:=false;
-        aktprocsym:=tprocsym.create('$'+name);
-        { main are allways used }
-        inc(aktprocsym.refs);
-        {Try to insert in in static symtable ! }
+        { try to insert in in static symtable ! }
         stt:=symtablestack;
         symtablestack:=st;
-        aktprocdef:=tprocdef.create;
-        aktprocsym.addprocdef(aktprocdef);
-        aktprocdef.procsym:=aktprocsym;
-        symtablestack:=stt;
-        aktprocdef.proctypeoption:=options;
-        aktprocdef.setmangledname(target_info.cprefix+name);
-        aktprocdef.forwarddef:=false;
+        { generate procsym }
+        ps:=tprocsym.create('$'+name);
+        { main are allways used }
+        inc(ps.refs);
+        symtablestack.insert(ps);
+        pd:=tprocdef.create(main_program_level);
+        pd.procsym:=ps;
+        ps.addprocdef(pd);
+        { restore symtable }
         make_ref:=true;
-        { The localst is a local symtable. Change it into the static
+        symtablestack:=stt;
+        { set procdef options }
+        pd.proctypeoption:=potype;
+        pd.setmangledname(target_info.cprefix+name);
+        pd.forwarddef:=false;
+        { We don't need is a local symtable. Change it into the static
           symtable }
-        aktprocdef.localst.free;
-        aktprocdef.localst:=st;
-        { and insert the procsym in symtable }
-        st.insert(aktprocsym);
-        { set some informations about the main program }
-        with procinfo do
-         begin
-           _class:=nil;
-           para_offset:=target_info.first_parm_offset;
-           framepointer.enum:=R_INTREGISTER;
-           framepointer.number:=NR_FRAME_POINTER_REG;
-           flags:=0;
-           procdef:=aktprocdef;
-         end;
+        pd.localst.free;
+        pd.localst:=st;
+        gen_main_procsym:=pd;
+      end;
+
+
+    procedure gen_implicit_initfinal(list:taasmoutput;flag:word;st:tsymtable);
+      var
+        parasize : longint;
+        nostackframe : boolean;
+        pd,
+        oldprocdef : tprocdef;
+        oldprocinfo : tprocinfo;
+        oldexitlabel,
+        oldexit2label : tasmlabel;
+      begin
+        oldprocinfo:=procinfo;
+        oldprocdef:=aktprocdef;
+        oldexitlabel:=aktexitlabel;
+        oldexit2label:=aktexit2label;
+        { update module flags }
+        current_module.flags:=current_module.flags or flag;
+        { now we can insert a cut }
+        if (cs_create_smart in aktmoduleswitches) then
+          codeSegment.concat(Tai_cut.Create);
+        { create procdef }
+        case flag of
+          uf_init :
+            begin
+              pd:=gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
+              pd.aliasnames.insert('INIT$$'+current_module.modulename^);
+              pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
+            end;
+          uf_finalize :
+            begin
+              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
+            end;
+          else
+            internalerror(200304253);
+        end;
+        { set procinfo and aktprocdef }
+        procinfo:=voidprocpi;
+        procinfo.procdef:=pd;
+        aktprocdef:=pd;
+        { generate a dummy function }
+        parasize:=0;
+        nostackframe:=false;
+        objectlibrary.getlabel(aktexitlabel);
+        objectlibrary.getlabel(aktexit2label);
+        genentrycode(list,true,0,parasize,nostackframe,false);
+        genexitcode(list,parasize,nostackframe,false);
+        list.convert_registers;
+        { cleanup }
+        pd.localst:=nil;
+        procinfo.procdef:=nil;
+        { restore }
+        aktexitlabel:=oldexitlabel;
+        aktexit2label:=oldexit2label;
+        aktprocdef:=oldprocdef;
+        procinfo:=oldprocinfo;
       end;
 
 
@@ -775,6 +826,7 @@ implementation
          s2  : ^string; {Saves stack space}
          force_init_final : boolean;
          initfinalcode : taasmoutput;
+         pd : tprocdef;
       begin
          initfinalcode:=taasmoutput.create;
          consume(_UNIT);
@@ -846,7 +898,6 @@ implementation
 
          { reset }
          make_ref:=true;
-         lexlevel:=0;
 
          { insert qualifier for the system unit (allows system.writeln) }
          if not(cs_compilesystem in aktmoduleswitches) then
@@ -978,15 +1029,15 @@ implementation
 //         Message1(parser_u_parsing_implementation,current_module.modulename^);
 
          { Compile the unit }
-         codegen_newprocedure;
-         gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
-         aktprocdef.aliasnames.insert('INIT$$'+current_module.modulename^);
-         aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
-         compile_proc_body(true,false);
-         codegen_doneprocedure;
-
-         { avoid self recursive destructor call !! PM }
-         aktprocdef.localst:=nil;
+         pd:=gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
+         pd.aliasnames.insert('INIT$$'+current_module.modulename^);
+         pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
+         procinfo:=voidprocpi;
+         procinfo.procdef:=pd;
+         compile_proc_body(pd,true,false);
+         procinfo.procdef:=nil;
+         { avoid self recursive destructor call }
+         pd.localst:=nil;
 
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
@@ -997,12 +1048,7 @@ implementation
          { this is a hack, but how can it be done better ? }
          if force_init_final and ((current_module.flags and uf_init)=0) then
            begin
-              current_module.flags:=current_module.flags or uf_init;
-              { now we can insert a cut }
-              if (cs_create_smart in aktmoduleswitches) then
-                codeSegment.concat(Tai_cut.Create);
-              genimplicitunitinit(initfinalcode);
-              initfinalcode.convert_registers;
+              gen_implicit_initfinal(initfinalcode,uf_init,st);
               codesegment.concatlist(initfinalcode);
            end;
          { finalize? }
@@ -1012,21 +1058,18 @@ implementation
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              codegen_newprocedure;
-              gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              compile_proc_body(true,false);
-              codegen_doneprocedure;
+              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
+              procinfo:=voidprocpi;
+              procinfo.procdef:=pd;
+              compile_proc_body(pd,true,false);
+              procinfo.procdef:=nil;
+              pd.localst:=nil;
            end
          else if force_init_final then
            begin
-              current_module.flags:=current_module.flags or uf_finalize;
-              { now we can insert a cut }
-              if (cs_create_smart in aktmoduleswitches) then
-                codeSegment.concat(Tai_cut.Create);
-              genimplicitunitfinal(initfinalcode);
-              initfinalcode.convert_registers;
+              gen_implicit_initfinal(initfinalcode,uf_finalize,st);
               codesegment.concatlist(initfinalcode);
            end;
 
@@ -1046,10 +1089,6 @@ implementation
              ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
           end;
 
-         { avoid self recursive destructor call !! PM }
-         aktprocdef.localst:=nil;
-         { absence does not matter here !! }
-         aktprocdef.forwarddef:=false;
          { test static symtable }
          if (Errorcount=0) then
            begin
@@ -1175,7 +1214,6 @@ implementation
         initfinalcode.free;
 
         Comment(V_Used,'Finished compiling module '+current_module.modulename^);
-
       end;
 
 
@@ -1185,6 +1223,7 @@ implementation
          st    : tsymtable;
          hp    : tmodule;
          initfinalcode : taasmoutput;
+         pd : tprocdef;
       begin
         initfinalcode:=taasmoutput.create;
          DLLsource:=islibrary;
@@ -1268,9 +1307,6 @@ implementation
          { load standard units (system,objpas,profile unit) }
          loaddefaultunits;
 
-         { reset }
-         lexlevel:=0;
-
          {Load the units used by the program we compile.}
          if token=_USES then
            loadunits;
@@ -1293,50 +1329,47 @@ implementation
 
          Message1(parser_u_parsing_implementation,current_module.mainsource^);
 
-         {The program intialization needs an alias, so it can be called
-          from the bootstrap code.}
-         codegen_newprocedure;
+         { The program intialization needs an alias, so it can be called
+           from the bootstrap code.}
          if islibrary then
           begin
-            gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
-            aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
+            pd:=gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
+            pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
             { Win32 startup code needs a single name }
 //            if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
-              aktprocdef.aliasnames.insert('PASCALMAIN');
+            pd.aliasnames.insert('PASCALMAIN');
             { this code is called from C so we need to save some
               registers }
-            include(aktprocdef.procoptions,po_savestdregs);
+            include(pd.procoptions,po_savestdregs);
           end
          else
           begin
-            gen_main_procsym('main',potype_proginit,st);
-            aktprocdef.aliasnames.insert('program_init');
-            aktprocdef.aliasnames.insert('PASCALMAIN');
-            aktprocdef.aliasnames.insert(target_info.cprefix+'main');
+            pd:=gen_main_procsym('main',potype_proginit,st);
+            pd.aliasnames.insert('program_init');
+            pd.aliasnames.insert('PASCALMAIN');
+            pd.aliasnames.insert(target_info.cprefix+'main');
           end;
+         procinfo:=voidprocpi;
+         procinfo.procdef:=pd;
 {$IFDEF SPARC}
          ProcInfo.After_Header;
 {main function is declared as
   PROCEDURE main(ArgC:Integer;ArgV,EnvP:ARRAY OF PChar):Integer;CDECL;
 So, all parameters are passerd into registers in sparc architecture.}
 {$ENDIF SPARC}
-         compile_proc_body(true,false);
+         compile_proc_body(pd,true,false);
+         procinfo.procdef:=nil;
+         { remove localst, it's not needed anymore }
+         pd.localst:=nil;
 
          { should we force unit initialization? }
          if tstaticsymtable(current_module.localsymtable).needs_init_final then
            begin
-              current_module.flags:=current_module.flags or (uf_init or uf_finalize);
-              { Add initialize section }
-              if (cs_create_smart in aktmoduleswitches) then
-                codeSegment.concat(Tai_cut.Create);
-              genimplicitunitinit(initfinalcode);
-              initfinalcode.convert_registers;
+              { initialize section }
+              gen_implicit_initfinal(initfinalcode,uf_init,st);
               codesegment.concatlist(initfinalcode);
-              { Add finalize section }
-              if (cs_create_smart in aktmoduleswitches) then
-                codeSegment.concat(Tai_cut.Create);
-              genimplicitunitfinal(initfinalcode);
-              initfinalcode.convert_registers;
+              { finalize section }
+              gen_implicit_initfinal(initfinalcode,uf_finalize,st);
               codesegment.concatlist(initfinalcode);
            end;
 
@@ -1347,15 +1380,6 @@ So, all parameters are passerd into registers in sparc architecture.}
             assigned(current_module._exports.first) then
            codesegment.concat(tai_const_symbol.create(exportlib.edatalabel));
 
-         { avoid self recursive destructor call !! PM }
-         aktprocdef.localst:=nil;
-
-         { consider these symbols as global ones for browser
-           but the typecasting of the globalsymtable with tglobalsymtable
-           can then lead to problems (PFV)
-         current_module.globalsymtable:=current_module.localsymtable;
-         current_module.localsymtable:=nil;}
-
          If ResourceStrings.ResStrCount>0 then
           begin
             ResourceStrings.CreateResourceStringList;
@@ -1364,8 +1388,6 @@ So, all parameters are passerd into registers in sparc architecture.}
              ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
           end;
 
-         codegen_doneprocedure;
-
          { finalize? }
          if token=_FINALIZATION then
            begin
@@ -1373,12 +1395,13 @@ So, all parameters are passerd into registers in sparc architecture.}
               current_module.flags:=current_module.flags or uf_finalize;
 
               { Compile the finalize }
-              codegen_newprocedure;
-              gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
-              compile_proc_body(true,false);
-              codegen_doneprocedure;
+              pd:=gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
+              pd.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              pd.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
+              procinfo:=voidprocpi;
+              procinfo.procdef:=pd;
+              compile_proc_body(pd,true,false);
+              procinfo.procdef:=nil;
            end;
 
          { consume the last point }
@@ -1469,7 +1492,15 @@ So, all parameters are passerd into registers in sparc architecture.}
 end.
 {
   $Log$
-  Revision 1.101  2003-04-23 12:35:34  florian
+  Revision 1.102  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.101  2003/04/23 12:35:34  florian
     * fixed several issues with powerpc
     + applied a patch from Jonas for nested function calls (PowerPC only)
     * ...

compiler/pstatmnt.pas

@@ -680,7 +680,7 @@ implementation
                      { remove exception symtable }
                      if assigned(exceptsymtable) then
                        begin
-                         dellexlevel;
+                         symtablestack:=symtablestack.next;
                          if last.nodetype <> onn then
                            exceptsymtable.free;
                        end;
@@ -1018,7 +1018,6 @@ implementation
         procinfo.framepointer.number:=NR_STACK_POINTER_REG;
         { set the right value for parameters }
         dec(aktprocdef.parast.address_fixup,pointer_size);
-        dec(procinfo.para_offset,pointer_size);
         { replace all references to parameters in the instructions,
           the parameters can be identified by the parafixup option
           that is set. For normal user coded [ebp+4] this field is not
@@ -1075,7 +1074,7 @@ implementation
       begin
          { Rename the funcret so that recursive calls are possible }
          if not is_void(aktprocdef.rettype.def) then
-           symtablestack.rename(aktprocdef.funcretsym.name,'$result');
+           symtablestack.rename(aktprocdef.resultname,'$hiddenresult');
 
          { force the asm statement }
          if token<>_ASM then
@@ -1083,7 +1082,6 @@ implementation
          procinfo.Flags := procinfo.Flags Or pi_is_assembler;
          p:=_asm_statement;
 
-
          { set the framepointer to esp for assembler functions when the
            following conditions are met:
            - if the are no local variables (except the allocated result)
@@ -1120,7 +1118,7 @@ implementation
           register.
         }
         if assigned(aktprocdef.funcretsym) and
-           paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+           (not paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
           tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
 
         { because the END is already read we need to get the
@@ -1133,7 +1131,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.92  2003-04-26 11:30:59  florian
+  Revision 1.93  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.92  2003/04/26 11:30:59  florian
     * fixed the powerpc to work with the new function result handling
 
   Revision 1.91  2003/04/25 20:59:34  peter

compiler/psub.pas

@@ -26,9 +26,12 @@ unit psub;
 
 interface
 
+    uses
+      symdef;
+
     procedure printnode_reset;
 
-    procedure compile_proc_body(make_global,parent_has_class:boolean);
+    procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
 
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
@@ -48,7 +51,7 @@ implementation
        { aasm }
        cpubase,cpuinfo,aasmbase,aasmtai,
        { symtable }
-       symconst,symbase,symdef,symsym,symtype,symtable,defutil,
+       symconst,symbase,symsym,symtype,symtable,defutil,
        paramgr,
        ppu,fmodule,
        { pass 1 }
@@ -123,8 +126,12 @@ implementation
           end;
 
          {Unit initialization?.}
-         if (lexlevel=unit_init_level) and (current_module.is_unit)
-            or islibrary then
+         if (
+             assigned(aktprocdef.localst) and
+             (aktprocdef.localst.symtablelevel=main_program_level) and
+             (current_module.is_unit)
+            ) or
+            islibrary then
            begin
              if (token=_END) then
                 begin
@@ -170,6 +177,8 @@ implementation
             end
          else
             begin
+               if current_module.is_unit then
+                 current_module.flags:=current_module.flags or uf_init;
                block:=statement_block(_BEGIN);
                if symtablestack.symtabletype=localsymtable then
                  symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}initializevars,block);
@@ -218,7 +227,7 @@ implementation
       end;
 
 
-    procedure compile_proc_body(make_global,parent_has_class:boolean);
+    procedure compile_proc_body(pd:tprocdef;make_global,parent_has_class:boolean);
       {
         Compile the body of a procedure
       }
@@ -239,16 +248,19 @@ implementation
          entrypos,
          savepos,
          exitpos   : tfileposinfo;
+         oldprocdef : tprocdef;
       begin
+         oldprocdef:=aktprocdef;
+         aktprocdef:=pd;
+
          { calculate the lexical level }
-         inc(lexlevel);
-         if lexlevel>maxnesting then
+         if aktprocdef.parast.symtablelevel>maxnesting then
            Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
          if (po_staticmethod in aktprocdef.procoptions) then
            allow_only_static:=true
-         else if (lexlevel=normal_function_level) then
+         else if (aktprocdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
 
          { save old labels }
@@ -273,29 +285,27 @@ implementation
 {    aktstate:=Tstate_storage.create;}
     {$endif state_tracking}
 
-         { insert symtables for the class, by only if it is no nested function }
-         if assigned(procinfo._class) and not(parent_has_class) then
+         { insert symtables for the class, but only if it is no nested function }
+         if assigned(aktprocdef._class) and not(parent_has_class) then
            begin
-             { insert them in the reverse order ! }
+             { insert them in the reverse order }
              hp:=nil;
              repeat
-               _class:=procinfo._class;
+               _class:=aktprocdef._class;
                while _class.childof<>hp do
                  _class:=_class.childof;
                hp:=_class;
                _class.symtable.next:=symtablestack;
                symtablestack:=_class.symtable;
-             until hp=procinfo._class;
+             until hp=aktprocdef._class;
            end;
 
-         { insert parasymtable in symtablestack}
-         { only if lexlevel > 1 !!! global symtable should be right after staticsymtazble
-           for checking of same names used in interface and implementation !! }
-         if lexlevel>=normal_function_level then
+         { insert parasymtable in symtablestack when parsing
+           a function }
+         if aktprocdef.parast.symtablelevel>=normal_function_level then
            begin
               aktprocdef.parast.next:=symtablestack;
               symtablestack:=aktprocdef.parast;
-              symtablestack.symtablelevel:=lexlevel;
            end;
          { create a local symbol table for this routine }
          if not assigned(aktprocdef.localst) then
@@ -303,7 +313,6 @@ implementation
          { insert localsymtable in symtablestack}
          aktprocdef.localst.next:=symtablestack;
          symtablestack:=aktprocdef.localst;
-         symtablestack.symtablelevel:=lexlevel;
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
 
@@ -434,7 +443,7 @@ implementation
           end;
 
          { ... remove symbol tables }
-         if lexlevel>=normal_function_level then
+         if aktprocdef.parast.symtablelevel>=normal_function_level then
            symtablestack:=symtablestack.next.next
          else
            symtablestack:=symtablestack.next;
@@ -473,10 +482,8 @@ implementation
             not(cs_browser in aktmoduleswitches) and
             (aktprocdef.proccalloption<>pocall_inline) then
            begin
-             if lexlevel>=normal_function_level then
-              begin
+             if aktprocdef.parast.symtablelevel>=normal_function_level then
                aktprocdef.localst.free;
-              end;
              aktprocdef.localst:=nil;
            end;
 
@@ -513,10 +520,10 @@ implementation
          faillabel:=oldfaillabel;
 
          { reset to normal non static function }
-         if (lexlevel=normal_function_level) then
+         if (aktprocdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
-         { previous lexlevel }
-         dec(lexlevel);
+
+         aktprocdef:=oldprocdef;
       end;
 
 
@@ -524,10 +531,10 @@ implementation
                         PROCEDURE/FUNCTION PARSING
 ****************************************************************************}
 
-    procedure checkvaluepara(p:tnamedindexitem;arg:pointer);
+    procedure insert_local_value_para(p:tnamedindexitem;arg:pointer);
       var
         vs : tvarsym;
-        s  : string;
+        pd : tprocdef;
       begin
         if tsym(p).typ<>varsym then
          exit;
@@ -535,27 +542,20 @@ implementation
          begin
            if copy(name,1,3)='val' then
             begin
-              s:=Copy(name,4,255);
-              if not(po_assembler in aktprocdef.procoptions) then
-               begin
-                 vs:=tvarsym.create(s,vartype);
-                 vs.fileinfo:=fileinfo;
-                 vs.varspez:=varspez;
-                 if not assigned(aktprocdef.localst) then
-                    aktprocdef.insert_localst;
-                 aktprocdef.localst.insert(vs);
-                 aktprocdef.localst.insertvardata(vs);
-                 include(vs.varoptions,vo_is_local_copy);
-                 vs.varstate:=vs_assigned;
-                 localvarsym:=vs;
-                 inc(refs); { the para was used to set the local copy ! }
-                 { warnings only on local copy ! }
-                 varstate:=vs_used;
-               end
-              else
-               begin
-                 aktprocdef.parast.rename(name,s);
-               end;
+              pd:=tprocdef(owner.defowner);
+              vs:=tvarsym.create(Copy(name,4,255),vartype);
+              vs.fileinfo:=fileinfo;
+              vs.varspez:=varspez;
+              if not assigned(pd.localst) then
+                pd.insert_localst;
+              pd.localst.insert(vs);
+              pd.localst.insertvardata(vs);
+              include(vs.varoptions,vo_is_local_copy);
+              vs.varstate:=vs_assigned;
+              localvarsym:=vs;
+              inc(refs); { the para was used to set the local copy ! }
+              { warnings only on local copy ! }
+              varstate:=vs_used;
             end;
          end;
       end;
@@ -567,46 +567,50 @@ implementation
         generates the code for it
       }
       var
-        oldprocsym       : tprocsym;
         oldprocdef       : tprocdef;
         oldprocinfo      : tprocinfo;
         oldconstsymtable : tsymtable;
-        oldfilepos       : tfileposinfo;
         oldselftokenmode,
         oldfailtokenmode : tmodeswitch;
         pdflags          : word;
+        pd               : tprocdef;
       begin
-      { save old state }
+         { save old state }
          oldprocdef:=aktprocdef;
-         oldprocsym:=aktprocsym;
          oldconstsymtable:=constsymtable;
          oldprocinfo:=procinfo;
-      { create a new procedure }
-         codegen_newprocedure;
+
+         { reset aktprocdef to nil to be sure that nothing is writing
+           to an other procdef }
+         aktprocdef:=nil;
+
+         { create a new procedure }
+         procinfo:=cprocinfo.create;
          with procinfo do
           begin
             parent:=oldprocinfo;
-          { clear flags }
+            { clear flags }
             flags:=0;
-          { standard frame pointer }
+            { standard frame pointer }
             framepointer.enum:=R_INTREGISTER;
             framepointer.number:=NR_FRAME_POINTER_REG;
-          { is this a nested function of a method ? }
-            if assigned(oldprocinfo) then
-              _class:=oldprocinfo._class;
           end;
 
-         parse_proc_dec;
-
-         procinfo.procdef:=aktprocdef;
+         { parse procedure declaration }
+         if assigned(oldprocinfo) and
+            assigned(oldprocinfo.procdef) then
+          pd:=parse_proc_dec(oldprocinfo.procdef._class)
+         else
+          pd:=parse_proc_dec(nil);
+         procinfo.procdef:=pd;
 
          { set the default function options }
          if parse_only then
           begin
-            aktprocdef.forwarddef:=true;
+            pd.forwarddef:=true;
             { set also the interface flag, for better error message when the
               implementation doesn't much this header }
-            aktprocdef.interfacedef:=true;
+            pd.interfacedef:=true;
             pdflags:=pd_interface;
           end
          else
@@ -617,68 +621,44 @@ implementation
             if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
             procinfo.exported:=false;
-            aktprocdef.forwarddef:=false;
+            pd.forwarddef:=false;
           end;
 
          { parse the directives that may follow }
-         inc(lexlevel);
-         parse_proc_directives(pdflags);
-         dec(lexlevel);
+         parse_proc_directives(pd,pdflags);
 
          { hint directives, these can be separated by semicolons here,
-           that need to be handled here with a loop (PFV) }
-         while try_consume_hintdirective(aktprocsym.symoptions) do
+           that needs to be handled here with a loop (PFV) }
+         while try_consume_hintdirective(pd.symoptions) do
           Consume(_SEMICOLON);
 
-         { set aktfilepos to the beginning of the function declaration }
-         oldfilepos:=aktfilepos;
-         aktfilepos:=aktprocdef.fileinfo;
-
-         { For varargs directive also cdecl and external must be defined }
-         if (po_varargs in aktprocdef.procoptions) then
-          begin
-            { check first for external in the interface, if available there
-              then the cdecl must also be there since there is no implementation
-              available to contain it }
-            if parse_only then
-             begin
-               { if external is available, then cdecl must also be available }
-               if (po_external in aktprocdef.procoptions) and
-                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-                Message(parser_e_varargs_need_cdecl_and_external);
-             end
-            else
-             begin
-               { both must be defined now }
-               if not(po_external in aktprocdef.procoptions) or
-                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-                Message(parser_e_varargs_need_cdecl_and_external);
-             end;
-          end;
+         { everything of the proc definition is known, we can now
+           calculate the parameters }
+         calc_parast(pd);
 
          { search for forward declarations }
-         if not proc_add_definition(aktprocsym,aktprocdef) then
+         if not proc_add_definition(pd) then
            begin
              { A method must be forward defined (in the object declaration) }
-             if assigned(procinfo._class) and
-                (not assigned(oldprocinfo._class)) then
+             if assigned(pd._class) and
+                (not assigned(oldprocinfo.procdef._class)) then
               begin
-                Message1(parser_e_header_dont_match_any_member,aktprocdef.fullprocname(false));
-                aktprocsym.write_parameter_lists(aktprocdef);
+                Message1(parser_e_header_dont_match_any_member,pd.fullprocname(false));
+                tprocsym(pd.procsym).write_parameter_lists(pd);
               end
              else
               begin
                 { Give a better error if there is a forward def in the interface and only
                   a single implementation }
-                if (not aktprocdef.forwarddef) and
-                   (not aktprocdef.interfacedef) and
-                   (aktprocsym.procdef_count>1) and
-                   aktprocsym.first_procdef.forwarddef and
-                   aktprocsym.first_procdef.interfacedef and
-                   not(aktprocsym.procdef_count>2) then
+                if (not pd.forwarddef) and
+                   (not pd.interfacedef) and
+                   (tprocsym(pd.procsym).procdef_count>1) and
+                   tprocsym(pd.procsym).first_procdef.forwarddef and
+                   tprocsym(pd.procsym).first_procdef.interfacedef and
+                   not(tprocsym(pd.procsym).procdef_count>2) then
                  begin
-                   Message1(parser_e_header_dont_match_forward,aktprocdef.fullprocname(false));
-                   aktprocsym.write_parameter_lists(aktprocdef);
+                   Message1(parser_e_header_dont_match_forward,pd.fullprocname(false));
+                   tprocsym(pd.procsym).write_parameter_lists(pd);
                  end
                 else
                  begin
@@ -691,75 +671,61 @@ implementation
               end;
            end;
 
-         { restore file pos }
-         aktfilepos:=oldfilepos;
-
-         { update procinfo, because the aktprocdef can be
+         { update procinfo, because the procdef can be
            changed by check_identical_proc (PFV) }
-         procinfo.procdef:=aktprocdef;
+         procinfo.procdef:=pd;
 
          { compile procedure when a body is needed }
          if (pdflags and pd_body)<>0 then
           begin
-            Message1(parser_d_procedure_start,aktprocdef.fullprocname(false));
-
-            if assigned(aktprocsym.owner) then
-              aktprocdef.aliasnames.insert(aktprocdef.mangledname);
+            Message1(parser_d_procedure_start,pd.fullprocname(false));
+            pd.aliasnames.insert(pd.mangledname);
 
             { Insert result variables in the localst }
-            insert_funcret_local(aktprocdef);
-
-            { when it is a value para and it needs a local copy then rename
-              the parameter and insert a copy in the localst. This is not done
-              for assembler procedures }
-            aktprocdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara,nil);
+            insert_funcret_local(pd);
 
-            { calculate addresses in parasymtable }
-            aktprocdef.parast.address_fixup:=procinfo.para_offset;
-            calc_parasymtable_addresses(aktprocdef);
+            { Insert local copies for value para }
+            pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
 
+            { Update parameter information }
+            procinfo.allocate_implicit_parameter;
 {$ifdef i386}
             { add implicit pushes for interrupt routines }
-            if (po_interrupt in aktprocdef.procoptions) then
+            if (po_interrupt in pd.procoptions) then
               procinfo.allocate_interrupt_stackframe;
 {$endif i386}
 
+            { Calculate offsets }
             procinfo.after_header;
 
             { set _FAIL as keyword if constructor }
-            if (aktprocdef.proctypeoption=potype_constructor) then
+            if (pd.proctypeoption=potype_constructor) then
              begin
                oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
                tokeninfo^[_FAIL].keyword:=m_all;
              end;
             { set _SELF as keyword if methods }
-            if assigned(aktprocdef._class) then
+            if assigned(pd._class) then
              begin
                oldselftokenmode:=tokeninfo^[_SELF].keyword;
                tokeninfo^[_SELF].keyword:=m_all;
              end;
 
-            compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
+            compile_proc_body(pd,((pdflags and pd_global)<>0),assigned(oldprocinfo.procdef._class));
 
             { reset _FAIL as _SELF normal }
-            if (aktprocdef.proctypeoption=potype_constructor) then
+            if (pd.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
-            if assigned(aktprocdef._class) and (lexlevel=main_program_level) then
+            if assigned(pd._class) then
               tokeninfo^[_SELF].keyword:=oldselftokenmode;
              consume(_SEMICOLON);
           end;
 
          { close }
-         codegen_doneprocedure;
+         procinfo.free;
          { Restore old state }
          constsymtable:=oldconstsymtable;
-         { release procsym when it was not stored in the symtable }
-         if not assigned(aktprocsym.owner) then
-          begin
-            aktprocsym.free;
-            aktprocdef.procsym:=nil;
-          end;
-         aktprocsym:=oldprocsym;
+
          aktprocdef:=oldprocdef;
          procinfo:=oldprocinfo;
       end;
@@ -783,8 +749,7 @@ implementation
 
         procedure Not_supported_for_inline(t : ttoken);
         begin
-           if assigned(aktprocsym) and
-              (aktprocdef.proccalloption=pocall_inline) then
+           if (aktprocdef.proccalloption=pocall_inline) then
              Begin
                 Message1(parser_w_not_supported_for_inline,tokenstring(t));
                 Message(parser_w_inlining_disabled);
@@ -794,6 +759,8 @@ implementation
 
       begin
          repeat
+           if not assigned(aktprocdef) then
+             internalerror(200304251);
            case token of
               _LABEL:
                 begin
@@ -825,8 +792,8 @@ implementation
               _EXPORTS:
                 begin
                    Not_supported_for_inline(token);
-                   { here we should be at lexlevel 1, no ? PM }
-                   if (lexlevel<>main_program_level) or
+                   if not(assigned(aktprocdef.localst)) or
+                      (aktprocdef.localst.symtablelevel>main_program_level) or
                       (current_module.is_unit) then
                      begin
                         Message(parser_e_syntax_error);
@@ -853,9 +820,6 @@ implementation
 
     procedure read_interface_declarations;
       begin
-         {Since the body is now parsed at lexlevel 1, and the declarations
-          must be parsed at the same lexlevel we increase the lexlevel.}
-         inc(lexlevel);
          repeat
            case token of
              _CONST :
@@ -876,7 +840,6 @@ implementation
                break;
            end;
          until false;
-         dec(lexlevel);
          { check for incomplete class definitions, this is only required
            for fpc modes }
          if (m_fpc in aktmodeswitches) then
@@ -886,7 +849,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.105  2003-04-26 00:31:42  peter
+  Revision 1.106  2003-04-27 07:29:50  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.105  2003/04/26 00:31:42  peter
     * set return_offset moved to after_header
 
   Revision 1.104  2003/04/25 20:59:34  peter

compiler/ptype.pas

@@ -454,7 +454,6 @@ implementation
 
       var
         p  : tnode;
-        vs : tvarsym;
         pd : tabstractprocdef;
         enumdupmsg : boolean;
       begin
@@ -597,9 +596,9 @@ implementation
             _PROCEDURE:
               begin
                 consume(_PROCEDURE);
-                tt.setdef(tprocvardef.create);
+                tt.setdef(tprocvardef.create(normal_function_level));
                 if token=_LKLAMMER then
-                 parameter_dec(tprocvardef(tt.def));
+                  parse_parameter_dec(tprocvardef(tt.def));
                 if token=_OF then
                   begin
                     consume(_OF);
@@ -611,9 +610,9 @@ implementation
             _FUNCTION:
               begin
                 consume(_FUNCTION);
-                pd:=tprocvardef.create;
+                pd:=tprocvardef.create(normal_function_level);
                 if token=_LKLAMMER then
-                 parameter_dec(pd);
+                  parse_parameter_dec(pd);
                 consume(_COLON);
                 single_type(pd.rettype,hs,false);
                 if token=_OF then
@@ -623,8 +622,7 @@ implementation
                     include(pd.procoptions,po_methodpointer);
                   end;
                 { Add implicit hidden parameters and function result }
-                insert_hidden_para(pd);
-                insert_funcret_para(pd);
+                calc_parast(pd);
                 tt.def:=pd;
               end;
             else
@@ -637,7 +635,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2003-04-25 20:59:34  peter
+  Revision 1.52  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.51  2003/04/25 20:59:34  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/rautils.pas

@@ -735,13 +735,13 @@ Begin
   if (not is_void(aktprocdef.rettype.def)) then
    begin
      if (m_tp7 in aktmodeswitches) and
-        paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption) then
+        (not paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) then
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
        end;
      opr.ref.offset:=procinfo.return_offset;
-     opr.ref.base:= procinfo.framepointer;
+     opr.ref.base:=procinfo.framepointer;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
      tvarsym(aktprocdef.funcretsym).varstate:=vs_assigned;
@@ -758,7 +758,7 @@ end;
 Function TOperand.SetupSelf:boolean;
 Begin
   SetupSelf:=false;
-  if assigned(procinfo._class) then
+  if assigned(aktprocdef._class) then
    Begin
      opr.typ:=OPR_REFERENCE;
      opr.ref.offset:=procinfo.selfpointer_offset;
@@ -774,7 +774,7 @@ end;
 Function TOperand.SetupOldEBP:boolean;
 Begin
   SetupOldEBP:=false;
-  if lexlevel>normal_function_level then
+  if aktprocdef.parast.symtablelevel>normal_function_level then
    Begin
      opr.typ:=OPR_REFERENCE;
      opr.ref.offset:=procinfo.framepointer_offset;
@@ -825,11 +825,7 @@ Begin
             begin
               { if we only want the offset we don't have to care
                 the base will be zeroed after ! }
-              if (lexlevel=tvarsym(sym).owner.symtablelevel) or
-              { this below is wrong because there are two parast
-                for global functions one of interface the second of
-                implementation
-              if (tvarsym(sym).owner=procinfo.def.parast) or }
+              if (tvarsym(sym).owner=aktprocdef.parast) or
                 GetOffset then
                 begin
                   opr.ref.base:=procinfo.framepointer;
@@ -838,16 +834,14 @@ Begin
                 begin
                   if (aktprocdef.localst.datasize=0) and
                      assigned(procinfo.parent) and
-                     (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
-                     { same problem as above !!
-                     (procinfo.parent^.sym.definition.parast=tvarsym(sym).owner) and }
-                     (lexlevel>normal_function_level) then
+                     (tvarsym(sym).owner=aktprocdef.parast) and
+                     (aktprocdef.parast.symtablelevel>normal_function_level) then
                     opr.ref.base:=procinfo.parent.framepointer
                   else
                     message1(asmr_e_local_para_unreachable,s);
                 end;
               opr.ref.offset:=tvarsym(sym).address;
-              if (lexlevel=tvarsym(sym).owner.symtablelevel) then
+              if (aktprocdef.parast.symtablelevel=tvarsym(sym).owner.symtablelevel) then
                 begin
                   opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
                   opr.ref.options:=ref_parafixup;
@@ -870,23 +864,21 @@ Begin
                 begin
                   { if we only want the offset we don't have to care
                     the base will be zeroed after ! }
-                  if (lexlevel=tvarsym(sym).owner.symtablelevel) or
-                  {if (tvarsym(sym).owner=procinfo.def.localst) or}
-                    GetOffset then
+                  if (tvarsym(sym).owner=aktprocdef.localst) or
+                     GetOffset then
                     opr.ref.base:=procinfo.framepointer
                   else
                     begin
                       if (aktprocdef.localst.datasize=0) and
                          assigned(procinfo.parent) and
-                         (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
-                         {(procinfo.parent^.sym.definition.localst=tvarsym(sym).owner) and}
-                         (lexlevel>normal_function_level) then
+                         (tvarsym(sym).owner=procinfo.parent.procdef.localst) and
+                         (aktprocdef.parast.symtablelevel>normal_function_level) then
                         opr.ref.base:=procinfo.parent.framepointer
                       else
                         message1(asmr_e_local_para_unreachable,s);
                     end;
                   opr.ref.offset:=-(tvarsym(sym).address);
-                  if (lexlevel=tvarsym(sym).owner.symtablelevel) then
+                  if (aktprocdef.localst.symtablelevel=tvarsym(sym).owner.symtablelevel) then
                     begin
                       opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
                       opr.ref.options:=ref_localfixup;
@@ -1306,7 +1298,7 @@ Begin
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   if base='SELF' then
-   st:=procinfo._class.symtable
+   st:=aktprocdef._class.symtable
   else
    begin
      asmsearchsym(base,sym,srsymtable);
@@ -1582,7 +1574,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.56  2003-04-25 20:59:34  peter
+  Revision 1.57  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.56  2003/04/25 20:59:34  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/symbase.pas

@@ -106,11 +106,10 @@ interface
           { only used for parameter symtable to determine the offset relative }
           { to the frame pointer and for local inline }
           address_fixup : longint;
-          symtabletype : tsymtabletype;
+          symtabletype  : tsymtabletype;
           { each symtable gets a number }
-          unitid    : word;
-          { this saves all definition to allow a proper clean up }
-          { separate lexlevel from symtable type }
+          unitid        : word;
+          { level of symtable, used for nested procedures }
           symtablelevel : byte;
           dataalignment : byte;
           constructor Create(const s:string);
@@ -348,7 +347,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2002-12-07 14:27:09  carl
+  Revision 1.11  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.10  2002/12/07 14:27:09  carl
     * 3% memory optimization
     * changed some types
     + added type checking with different size for call node and for

compiler/symconst.pas

@@ -84,12 +84,8 @@ const
   pfReference= 16;
   pfOut      = 32;
 
-  {# These are the different possible base values that can
-     be taken from the lexlevel variable when parsing. The
-     lexlevel can be bigger if parsding recursive routines.
-  }
-  main_program_level = 1;
-  unit_init_level = 1;
+  unknown_level         = 0;
+  main_program_level    = 1;
   normal_function_level = 2;
 
 
@@ -354,7 +350,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2003-04-26 00:33:07  peter
+  Revision 1.51  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.50  2003/04/26 00:33:07  peter
     * vo_is_result flag added for the special RESULT symbol
 
   Revision 1.49  2003/04/25 20:59:35  peter

compiler/symdef.pas

@@ -421,9 +421,8 @@ interface
           procoptions     : tprocoptions;
           maxparacount,
           minparacount    : byte;
-          symtablelevel   : byte;
           fpu_used        : byte;    { how many stack fpu must be empty }
-          constructor create;
+          constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure  ppuwrite(ppufile:tcompilerppufile);override;
@@ -445,7 +444,7 @@ interface
        end;
 
        tprocvardef = class(tabstractprocdef)
-          constructor create;
+          constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  getsymtable(t:tgetsymtable):tsymtable;override;
@@ -519,7 +518,7 @@ interface
           { small set which contains the modified registers }
           usedintregisters:Tsupregset;
           usedotherregisters:Tregisterset;
-          constructor create;
+          constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -3042,10 +3041,10 @@ implementation
                        TABSTRACTPROCDEF
 ***************************************************************************}
 
-    constructor tabstractprocdef.create;
+    constructor tabstractprocdef.create(level:byte);
       begin
          inherited create;
-         parast:=tparasymtable.create;
+         parast:=tparasymtable.create(level);
          parast.defowner:=self;
          para:=TLinkedList.Create;
          selfpara:=nil;
@@ -3055,7 +3054,6 @@ implementation
          proccalloption:=pocall_none;
          procoptions:=[];
          rettype:=voidtype;
-         symtablelevel:=0;
          fpu_used:=0;
          savesize:=POINTER_SIZE;
       end;
@@ -3189,6 +3187,7 @@ implementation
       var
          hp : TParaItem;
          count,i : word;
+         paraloclen : byte;
       begin
          inherited ppuloaddef(ppufile);
          parast:=nil;
@@ -3212,6 +3211,9 @@ implementation
             hp.defaultvalue:=tsym(ppufile.getderef);
             hp.parasym:=tsym(ppufile.getderef);
             { later, we'll gerate this on the fly (FK) }
+            paraloclen:=ppufile.getbyte;
+            if paraloclen<>sizeof(tparalocation) then
+              internalerror(200304261);
             ppufile.getdata(hp.paraloc,sizeof(tparalocation));
             { Don't count hidden parameters }
             if (hp.paratyp<>vs_hidden) then
@@ -3251,6 +3253,9 @@ implementation
             ppufile.puttype(hp.paratype);
             ppufile.putderef(hp.defaultvalue);
             ppufile.putderef(hp.parasym);
+            { write the length of tparalocation so ppudump can
+              parse the .ppu without knowing the tparalocation size }
+            ppufile.putbyte(sizeof(tparalocation));
             ppufile.putdata(hp.paraloc,sizeof(tparalocation));
             hp:=TParaItem(hp.next);
           end;
@@ -3400,9 +3405,9 @@ implementation
                                   TPROCDEF
 ***************************************************************************}
 
-    constructor tprocdef.create;
+    constructor tprocdef.create(level:byte);
       begin
-         inherited create;
+         inherited create(level);
          deftype:=procdef;
          has_mangledname:=false;
          _mangledname:=nil;
@@ -3466,14 +3471,14 @@ implementation
             funcretsym:=nil;
           end;
          { load para symtable }
-         parast:=tparasymtable.create;
+         parast:=tparasymtable.create(unknown_level);
          tparasymtable(parast).ppuload(ppufile);
          parast.defowner:=self;
          { load local symtable }
          if (proccalloption=pocall_inline) or
             ((current_module.flags and uf_local_browser)<>0) then
           begin
-            localst:=tlocalsymtable.create;
+            localst:=tlocalsymtable.create(unknown_level);
             tlocalsymtable(localst).ppuload(ppufile);
             localst.defowner:=self;
           end
@@ -3600,7 +3605,7 @@ implementation
             ppufile.do_crc:=false;
             if not assigned(localst) then
              begin
-               localst:=tlocalsymtable.create;
+               localst:=tlocalsymtable.create(unknown_level);
                localst.defowner:=self;
              end;
             tlocalsymtable(localst).ppuwrite(ppufile);
@@ -3611,7 +3616,7 @@ implementation
 
     procedure tprocdef.insert_localst;
      begin
-         localst:=tlocalsymtable.create;
+         localst:=tlocalsymtable.create(parast.symtablelevel);
          localst.defowner:=self;
          { this is used by insert
            to check same names in parast and localst }
@@ -3923,7 +3928,7 @@ implementation
       { local type defs and vars should not be written
         inside the main proc stab }
       if assigned(localst) and
-         (lexlevel>main_program_level) then
+         (localst.symtablelevel>main_program_level) then
         tstoredsymtable(localst).concatstabto(asmlist);
       is_def_stab_written := written;
     end;
@@ -4085,9 +4090,9 @@ implementation
                                  TPROCVARDEF
 ***************************************************************************}
 
-    constructor tprocvardef.create;
+    constructor tprocvardef.create(level:byte);
       begin
-         inherited create;
+         inherited create(level);
          deftype:=procvardef;
       end;
 
@@ -4097,7 +4102,7 @@ implementation
          inherited ppuload(ppufile);
          deftype:=procvardef;
          { load para symtable }
-         parast:=tparasymtable.create;
+         parast:=tparasymtable.create(unknown_level);
          tparasymtable(parast).ppuload(ppufile);
          parast.defowner:=self;
       end;
@@ -5732,7 +5737,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.136  2003-04-25 20:59:35  peter
+  Revision 1.137  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.136  2003/04/25 20:59:35  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/symsym.pas

@@ -114,7 +114,9 @@ interface
           function getprocdef(nr:cardinal):Tprocdef;
        public
           procdef_count : byte;
+{$ifdef GDB}
           is_global : boolean;
+{$endif GDB}
           overloadchecked : boolean;
           overloadcount : word;    { amount of overloaded functions in this module }
           property procdef[nr:cardinal]:Tprocdef read getprocdef;
@@ -338,8 +340,6 @@ interface
 
 
     var
-       aktprocsym : tprocsym;      { pointer to the symbol for the
-                                     currently be parsed procedure }
        aktprocdef : tprocdef;
 
        aktcallprocdef : tabstractprocdef;  { pointer to the definition of the
@@ -2557,7 +2557,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.97  2003-04-25 20:59:35  peter
+  Revision 1.98  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.97  2003/04/25 20:59:35  peter
     * removed funcretn,funcretsym, function result is now in varsym
       and aliases for result and function name are added using absolutesym
     * vs_hidden parameter for funcret passed in parameter

compiler/symtable.pas

@@ -123,7 +123,7 @@ interface
 
        tlocalsymtable = class(tabstractlocalsymtable)
        public
-          constructor create;
+          constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
           procedure insertvardata(sym : tsymentry);override;
           procedure insertconstdata(sym : tsymentry);override;
@@ -131,7 +131,7 @@ interface
 
        tparasymtable = class(tabstractlocalsymtable)
        public
-          constructor create;
+          constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
           procedure insertvardata(sym : tsymentry);override;
        end;
@@ -202,11 +202,6 @@ interface
        constsymtable  : tsymtable;      { symtable were the constants can be inserted }
        systemunit     : tglobalsymtable; { pointer to the system unit }
 
-       lexlevel       : byte;          { level of code }
-                                       { 1 for main procedure }
-                                       { 2 for normal function or proc }
-                                       { higher for locals }
-
 {****************************************************************************
                              Functions
 ****************************************************************************}
@@ -230,7 +225,6 @@ interface
     function search_default_property(pd : tobjectdef) : tpropertysym;
 
 {*** symtable stack ***}
-    procedure dellexlevel;
     procedure RestoreUnitSyms;
 {$ifdef DEBUG}
     procedure test_symtablestack;
@@ -727,32 +721,35 @@ implementation
              exit;
            if (tvarsym(p).refs=0) then
              begin
-                if (tsym(p).owner.symtabletype=parasymtable) or (vo_is_local_copy in tvarsym(p).varoptions) then
+                if (vo_is_funcret in tvarsym(p).varoptions) then
+                  begin
+                    { don't warn about the result of constructors }
+                    if (tsym(p).owner.symtabletype<>localsymtable) or
+                       (tprocdef(tsym(p).owner.defowner).proctypeoption<>potype_constructor) then
+                      MessagePos(tsym(p).fileinfo,sym_w_function_result_not_set)
+                  end
+                else if (tsym(p).owner.symtabletype=parasymtable) or
+                        (vo_is_local_copy in tvarsym(p).varoptions) then
                   MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname)
                 else if (tsym(p).owner.symtabletype=objectsymtable) then
                   MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
-                else if p.name='result' then
-                  MessagePos(tsym(p).fileinfo,sym_w_function_result_not_set)
                 else
                   MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_not_used,tsym(p).realname);
              end
            else if tvarsym(p).varstate=vs_assigned then
              begin
-                if (tsym(p).owner.symtabletype=parasymtable) then
+                if (tsym(p).owner.symtabletype=parasymtable) or
+                   (vo_is_local_copy in tvarsym(p).varoptions) then
                   begin
-                    if not(tvarsym(p).varspez in [vs_var,vs_out])  then
+                    if not(tvarsym(p).varspez in [vs_var,vs_out]) and
+                       not(vo_is_funcret in tvarsym(p).varoptions) then
                       MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname)
                   end
-                else if (vo_is_local_copy in tvarsym(p).varoptions) then
-                  begin
-                    if not(tvarsym(p).varspez in [vs_var,vs_out]) then
-                      MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_only_set,tsym(p).realname);
-                  end
                 else if (tsym(p).owner.symtabletype=objectsymtable) then
                   MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_only_set,tsym(p).owner.realname^,tsym(p).realname)
-                else if (tsym(p).owner.symtabletype<>parasymtable) then
-                  if not (vo_is_exported in tvarsym(p).varoptions) then
-                    MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
+                else if not(vo_is_exported in tvarsym(p).varoptions) and
+                        not(vo_is_funcret in tvarsym(p).varoptions) then
+                  MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
              end;
          end
       else if ((tsym(p).owner.symtabletype in
@@ -765,13 +762,21 @@ implementation
            if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
              MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
            { units references are problematic }
-           else if (tstoredsym(p).refs=0) and not(tsym(p).typ in [enumsym,unitsym]) then
-             if (tsym(p).typ<>procsym) or not (tprocsym(p).is_global) or
-             { all program functions are declared global
-               but unused should still be signaled PM }
-                ((tsym(p).owner.symtabletype=staticsymtable) and
-                not current_module.is_unit) then
-             MessagePos2(tsym(p).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(p).typ],tsym(p).realname);
+           else
+            begin
+              if (tstoredsym(p).refs=0) and
+                 not(tsym(p).typ in [enumsym,unitsym]) and
+                 not(is_funcret_sym(tsym(p))) and
+                 (
+                  (tsym(p).typ<>procsym) or
+                  not (tprocsym(p).is_global) or
+                  { all program functions are declared global
+                    but unused should still be signaled PM }
+                  ((tsym(p).owner.symtabletype=staticsymtable) and
+                   not current_module.is_unit)
+                 ) then
+                MessagePos2(tsym(p).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(p).typ],tsym(p).realname);
+            end;
           end;
       end;
 
@@ -1235,10 +1240,11 @@ implementation
                               TLocalSymtable
 ****************************************************************************}
 
-    constructor tlocalsymtable.create;
+    constructor tlocalsymtable.create(level:byte);
       begin
         inherited create('');
         symtabletype:=localsymtable;
+        symtablelevel:=level;
       end;
 
 
@@ -1373,11 +1379,13 @@ implementation
                               TParaSymtable
 ****************************************************************************}
 
-    constructor tparasymtable.create;
+    constructor tparasymtable.create(level:byte);
       begin
         inherited create('');
         symtabletype:=parasymtable;
+        symtablelevel:=level;
         dataalignment:=aktalignment.paraalign;
+        address_fixup:=target_info.first_parm_offset;
       end;
 
 
@@ -1386,25 +1394,20 @@ implementation
          hsym : tsym;
       begin
          { check for duplicate id in para symtable of methods }
-         if assigned(procinfo) and
-            assigned(procinfo._class) and
-            { but not in nested procedures !}
-            (not(assigned(procinfo.parent)) or
-             (assigned(procinfo.parent) and
-              not(assigned(procinfo.parent._class)))
-            ) and
-            { funcretsym is allowed !! }
+         if assigned(next) and
+            (next.symtabletype=objectsymtable) and
+            { funcretsym is allowed }
             (not is_funcret_sym(sym)) then
            begin
-              hsym:=search_class_member(procinfo._class,sym.name);
+              hsym:=search_class_member(tobjectdef(next.defowner),sym.name);
               { private ids can be reused }
               if assigned(hsym) and
-                 tstoredsym(hsym).is_visible_for_object(procinfo._class) then
+                 tstoredsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
                begin
                  { delphi allows to reuse the names in a class, but not
                    in object (tp7 compatible) }
                  if not((m_delphi in aktmodeswitches) and
-                        is_class_or_interface(procinfo._class)) then
+                        is_class_or_interface(tobjectdef(next.defowner))) then
                   begin
                     DuplicateSym(hsym);
                     exit;
@@ -1595,6 +1598,7 @@ implementation
       begin
         inherited create(n);
         symtabletype:=staticsymtable;
+        symtablelevel:=main_program_level;
       end;
 
 
@@ -1685,6 +1689,7 @@ implementation
       begin
          inherited create(n);
          symtabletype:=globalsymtable;
+         symtablelevel:=main_program_level;
          unitid:=0;
          unitsym:=nil;
 {$ifdef GDB}
@@ -1737,8 +1742,6 @@ implementation
            end;
 {$endif GDB}
 
-         symtablelevel:=0;
-
          next:=symtablestack;
          symtablestack:=self;
 
@@ -2328,18 +2331,6 @@ implementation
                             Symtable Stack
 ****************************************************************************}
 
-    procedure dellexlevel;
-      var
-         p : tsymtable;
-      begin
-         p:=symtablestack;
-         symtablestack:=p.next;
-         { symbol tables of unit interfaces are never disposed }
-         { this is handle by the unit unitm                 }
-         if not(p.symtabletype in [globalsymtable,stt_exceptsymtable]) then
-          p.free;
-      end;
-
     procedure RestoreUnitSyms;
       var
          p : tsymtable;
@@ -2411,7 +2402,7 @@ implementation
         pglobaltypecount:=@globaltypecount;
 {$endif GDB}
         { defs for internal use }
-        voidprocdef:=tprocdef.create;
+        voidprocdef:=tprocdef.create(unknown_level);
         { create error syms and def }
         generrorsym:=terrorsym.create;
         generrortype.setdef(terrordef.create);
@@ -2437,7 +2428,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.95  2003-04-26 00:33:07  peter
+  Revision 1.96  2003-04-27 07:29:51  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.95  2003/04/26 00:33:07  peter
     * vo_is_result flag added for the special RESULT symbol
 
   Revision 1.94  2003/04/25 20:59:35  peter

compiler/systems/t_beos.pas

@@ -28,13 +28,13 @@ unit t_beos;
 interface
 
   uses
-    symsym,
+    symsym,symdef,
     import,export,link;
 
   type
     timportlibbeos=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
     end;
@@ -79,13 +79,13 @@ begin
 end;
 
 
-procedure timportlibbeos.importprocedure(const func,module : string;index : longint;const name : string);
+procedure timportlibbeos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocdef.setmangledname(name)
+    aprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -470,7 +470,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2003-04-26 09:16:08  peter
+  Revision 1.5  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.4  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_emx.pas

@@ -46,14 +46,14 @@ implementation
      dos,
 {$endif Delphi}
      cutils,cclasses,
-     globtype,comphook,systems,symsym,
+     globtype,comphook,systems,symsym,symdef,
      globals,verbose,fmodule,script,
      import,link,i_emx,ppu;
 
   type
     TImportLibEMX=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure generatelib;override;
     end;
 
@@ -285,7 +285,7 @@ begin
     blockwrite(out_file,ar_magic,sizeof(ar_magic));
 end;
 
-procedure TImportLibEMX.ImportProcedure(const func,module:string;index:longint;const name:string);
+procedure TImportLibEMX.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 {func       = Name of function to import.
  module     = Name of DLL to import from.
  index      = Index of function in DLL. Use 0 to import by name.
@@ -293,9 +293,11 @@ procedure TImportLibEMX.ImportProcedure(const func,module:string;index:longint;c
 var tmp1,tmp2,tmp3:string;
     sym_mcount,sym_import:longint;
     fixup_mcount,fixup_import:longint;
+    func : string;
 begin
     { force the current mangledname }
-    aktprocdef.has_mangledname:=true;
+    aprocdef.has_mangledname:=true;
+    func:=aprocdef.mangledname;
 
     aout_init;
     tmp2:=func;
@@ -516,7 +518,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.2  2003-04-26 09:16:08  peter
+  Revision 1.3  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.2  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_fbsd.pas

@@ -35,13 +35,13 @@ implementation
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef,
     import,export,link,i_fbsd;
 
   type
     timportlibfreebsd=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
     end;
@@ -76,13 +76,15 @@ begin
 end;
 
 
-procedure timportlibfreebsd.importprocedure(const func,module : string;index : longint;const name : string);
+procedure timportlibfreebsd.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocdef.setmangledname(name)
+   begin
+     aprocdef.setmangledname(name);
+   end
   else
     message(parser_e_empty_import_name);
 end;
@@ -516,7 +518,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2003-04-26 09:16:08  peter
+  Revision 1.5  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.4  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_linux.pas

@@ -28,13 +28,13 @@ unit t_linux;
 interface
 
   uses
-    symsym,
+    symsym,symdef,
     import,export,link;
 
   type
     timportliblinux=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
     end;
@@ -79,14 +79,14 @@ begin
 end;
 
 
-procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
+procedure timportliblinux.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
    begin
-     aktprocdef.setmangledname(name);
+     aprocdef.setmangledname(name);
    end
   else
     message(parser_e_empty_import_name);
@@ -549,7 +549,15 @@ end.
 
 {
   $Log$
-  Revision 1.7  2003-04-26 09:16:08  peter
+  Revision 1.8  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.7  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_nwm.pas

@@ -96,13 +96,13 @@ implementation
     cutils,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef,
     import,export,link,i_nwm;
 
   type
     timportlibnetware=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
     end;
@@ -136,14 +136,14 @@ begin
 end;
 
 
-procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
+procedure timportlibnetware.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
    begin
-     aktprocdef.setmangledname(name);
+     aprocdef.setmangledname(name);
    end
   else
     message(parser_e_empty_import_name);
@@ -548,7 +548,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.7  2003-04-26 09:16:08  peter
+  Revision 1.8  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.7  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_os2.pas

@@ -46,14 +46,14 @@ implementation
      dos,
 {$endif Delphi}
      cutils,cclasses,
-     globtype,comphook,systems,symsym,
+     globtype,comphook,systems,symsym,symdef,
      globals,verbose,fmodule,script,
      import,link,i_os2,ppu;
 
   type
     timportlibos2=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure generatelib;override;
     end;
 
@@ -285,7 +285,7 @@ begin
     blockwrite(out_file,ar_magic,sizeof(ar_magic));
 end;
 
-procedure timportlibos2.importprocedure(const func,module:string;index:longint;const name:string);
+procedure timportlibos2.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 {func       = Name of function to import.
  module     = Name of DLL to import from.
  index      = Index of function in DLL. Use 0 to import by name.
@@ -293,9 +293,11 @@ procedure timportlibos2.importprocedure(const func,module:string;index:longint;c
 var tmp1,tmp2,tmp3:string;
     sym_mcount,sym_import:longint;
     fixup_mcount,fixup_import:longint;
+    func : string;
 begin
     { force the current mangledname }
-    aktprocdef.has_mangledname:=true;
+    aprocdef.has_mangledname:=true;
+    func:=aprocdef.mangledname;
 
     aout_init;
     tmp2:=func;
@@ -516,7 +518,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.6  2003-04-26 09:16:08  peter
+  Revision 1.7  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.6  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_sunos.pas

@@ -38,13 +38,13 @@ implementation
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef,
     import,export,link,i_sunos;
 
   type
     timportlibsunos=class(timportlib)
       procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
     end;
@@ -81,7 +81,7 @@ begin
 end;
 
 
-procedure timportlibsunos.importprocedure(const func,module : string;index : longint;const name : string);
+procedure timportlibsunos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
 begin
   { insert sharedlibrary }
 {$ifDef LinkTest}
@@ -90,7 +90,9 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocdef.setmangledname(name)
+   begin
+     aprocdef.setmangledname(name);
+   end
   else
     message(parser_e_empty_import_name);
 end;
@@ -486,7 +488,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.3  2003-04-26 09:16:08  peter
+  Revision 1.4  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.3  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/systems/t_wdosx.pas

@@ -74,7 +74,7 @@ begin
  b := Inherited MakeExecutable;
  if b then
   DoExec(FindUtil('stubit'),current_module.exefilename^,false,false);
- Result := b; 
+ Result := b;
 end;
 
 {****************************************************************************
@@ -102,7 +102,15 @@ end.
 
 {
   $Log$
-  Revision 1.2  2002-10-05 12:43:29  carl
+  Revision 1.3  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.2  2002/10/05 12:43:29  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/systems/t_win32.pas

@@ -58,11 +58,11 @@ interface
     private
       procedure win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string);
       procedure importvariable_str(const s:string;const name,module:string);
+      procedure importprocedure_str(const func,module:string;index:longint;const name:string);
     public
       procedure GetDefExt(var N:longint;var P:pStr4);virtual;
       procedure preparelib(const s:string);override;
-      procedure importproceduredef(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tvarsym;const name,module:string);override;
       procedure generatelib;override;
       procedure generatenasmlib;virtual;
@@ -184,13 +184,13 @@ const
       end;
 
 
-    procedure timportlibwin32.importproceduredef(aprocdef:tprocdef;const module : string;index : longint;const name : string);
+    procedure timportlibwin32.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string);
       begin
         win32importproc(aprocdef,aprocdef.mangledname,module,index,name);
       end;
 
 
-    procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
+    procedure timportlibwin32.importprocedure_str(const func,module : string;index : longint;const name : string);
       begin
         win32importproc(nil,func,module,index,name);
       end;
@@ -1482,7 +1482,7 @@ function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool;
    if IsData then
     timportlibwin32(importlib).importvariable_str(name,_n,name)
    else
-    importlib.importprocedure(name,_n,index,name);
+    timportlibwin32(importlib).importprocedure_str(name,_n,index,name);
   end;
 
  procedure ProcessEdata;
@@ -1628,7 +1628,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.13  2003-04-26 09:16:08  peter
+  Revision 1.14  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
+
+  Revision 1.13  2003/04/26 09:16:08  peter
     * .o files belonging to the unit are first searched in the same dir
       as the .ppu
 

compiler/utils/ppudump.pp

@@ -1937,8 +1937,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2003-04-26 09:56:24  peter
-    * length of tparalocation is now stored in ppu
+  Revision 1.41  2003-04-27 07:29:52  peter
+    * aktprocdef cleanup, aktprocdef is now always nil when parsing
+      a new procdef declaration
+    * aktprocsym removed
+    * lexlevel removed, use symtable.symtablelevel instead
+    * implicit init/final code uses the normal genentry/genexit
+    * funcret state checking updated for new funcret handling
 
   Revision 1.39  2003/04/25 20:59:35  peter
     * removed funcretn,funcretsym, function result is now in varsym