Browse Source

* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure

peter 22 years ago
parent
commit
8af51ea6d3
52 changed files with 3807 additions and 3371 deletions
  1. 42 2
      compiler/aasmtai.pas
  2. 18 7
      compiler/aggas.pas
  3. 14 3
      compiler/assemble.pas
  4. 14 9
      compiler/cgbase.pas
  5. 16 1
      compiler/cginfo.pas
  6. 6 3
      compiler/i386/ag386int.pas
  7. 6 3
      compiler/i386/ag386nsm.pas
  8. 69 33
      compiler/i386/cpupara.pas
  9. 8 2
      compiler/i386/cpupi.pas
  10. 8 3
      compiler/i386/n386cal.pas
  11. 10 7
      compiler/i386/n386obj.pas
  12. 34 13
      compiler/i386/ra386att.pas
  13. 31 20
      compiler/i386/ra386int.pas
  14. 6 23
      compiler/nbas.pas
  15. 8 3
      compiler/ncal.pas
  16. 89 36
      compiler/ncgbas.pas
  17. 13 2
      compiler/ncgcal.pas
  18. 27 7
      compiler/ncgflw.pas
  19. 32 16
      compiler/ncgld.pas
  20. 7 2
      compiler/ncgmem.pas
  21. 432 147
      compiler/ncgutil.pas
  22. 7 2
      compiler/ninl.pas
  23. 6 8
      compiler/nld.pas
  24. 28 11
      compiler/nobj.pas
  25. 7 7
      compiler/paramgr.pas
  26. 10 6
      compiler/pass_1.pas
  27. 6 4
      compiler/pbase.pas
  28. 9 2
      compiler/pdecl.pas
  29. 32 15
      compiler/pdecsub.pas
  30. 39 26
      compiler/pdecvar.pas
  31. 6 4
      compiler/pexpr.pas
  32. 7 2
      compiler/pinline.pas
  33. 22 8
      compiler/pmodules.pas
  34. 7 2
      compiler/ppu.pas
  35. 39 98
      compiler/pstatmnt.pas
  36. 38 40
      compiler/psub.pas
  37. 12 7
      compiler/psystem.pas
  38. 19 14
      compiler/ptconst.pas
  39. 7 2
      compiler/ptype.pas
  40. 23 65
      compiler/rautils.pas
  41. 36 27
      compiler/regvars.pas
  42. 6 11
      compiler/symbase.pas
  43. 7 2
      compiler/symconst.pas
  44. 41 30
      compiler/symdef.pas
  45. 114 91
      compiler/symsym.pas
  46. 40 239
      compiler/symtable.pas
  47. 33 20
      compiler/tgobj.pas
  48. 2262 2236
      compiler/x86/aasmcpu.pas
  49. 6 4
      compiler/x86/agx86att.pas
  50. 6 22
      compiler/x86/cpubase.pas
  51. 33 23
      compiler/x86/radirect.pas
  52. 9 1
      compiler/x86/rax86.pas

+ 42 - 2
compiler/aasmtai.pas

@@ -36,7 +36,7 @@ interface
        cutils,cclasses,
        cutils,cclasses,
        globtype,globals,systems,
        globtype,globals,systems,
        cginfo,cpuinfo,cpubase,
        cginfo,cpuinfo,cpubase,
-       symppu,
+       symppu,symtype,
        aasmbase;
        aasmbase;
 
 
     type
     type
@@ -141,6 +141,23 @@ interface
           'marker'
           'marker'
           );
           );
 
 
+    type
+      { Types of operand }
+      toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_local);
+
+      toper=record
+        ot : longint;
+        case typ : toptype of
+         top_none   : ();
+         top_reg    : (reg:tregister);
+         top_ref    : (ref:preference);
+         top_const  : (val:aword);
+         top_symbol : (sym:tasmsymbol;symofs:longint);
+         { local varsym that will be inserted in pass_2 }
+         top_local  : (localsym:pointer;localsymderef:tderef;localsymofs:longint);
+      end;
+
+
 { ait_* types which don't result in executable code or which don't influence   }
 { ait_* types which don't result in executable code or which don't influence   }
 { the way the program runs/behaves, but which may be encountered by the        }
 { the way the program runs/behaves, but which may be encountered by the        }
 { optimizer (= if it's sometimes added to the exprasm list). Update if you add }
 { optimizer (= if it's sometimes added to the exprasm list). Update if you add }
@@ -439,6 +456,7 @@ interface
           procedure SetCondition(const c:TAsmCond);
           procedure SetCondition(const c:TAsmCond);
           procedure loadconst(opidx:longint;l:aword);
           procedure loadconst(opidx:longint;l:aword);
           procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
           procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+          procedure loadlocal(opidx:longint;s:pointer;sofs:longint);
           procedure loadref(opidx:longint;const r:treference);
           procedure loadref(opidx:longint;const r:treference);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
           procedure loadoper(opidx:longint;o:toper);
@@ -1538,6 +1556,23 @@ implementation
       end;
       end;
 
 
 
 
+    procedure taicpu_abstract.loadlocal(opidx:longint;s:pointer;sofs:longint);
+      begin
+        if not assigned(s) then
+         internalerror(200204251);
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ<>top_local then
+             clearop(opidx);
+           localsym:=s;
+           localsymofs:=sofs;
+           typ:=top_local;
+         end;
+      end;
+
+
     procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
     procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
       begin
       begin
         if opidx>=ops then
         if opidx>=ops then
@@ -2106,7 +2141,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.39  2003-09-07 22:09:34  peter
+  Revision 1.40  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.39  2003/09/07 22:09:34  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 18 - 7
compiler/aggas.pas

@@ -681,16 +681,22 @@ var
 {$ifdef GDB}
 {$ifdef GDB}
            ait_stabs :
            ait_stabs :
              begin
              begin
-               AsmWrite(#9'.stabs ');
-               AsmWritePChar(tai_stabs(hp).str);
-               AsmLn;
+               if assigned(tai_stabs(hp).str) then
+                 begin
+                   AsmWrite(#9'.stabs ');
+                   AsmWritePChar(tai_stabs(hp).str);
+                   AsmLn;
+                 end;
              end;
              end;
 
 
            ait_stabn :
            ait_stabn :
              begin
              begin
-               AsmWrite(#9'.stabn ');
-               AsmWritePChar(tai_stabn(hp).str);
-               AsmLn;
+               if assigned(tai_stabn(hp).str) then
+                 begin
+                   AsmWrite(#9'.stabn ');
+                   AsmWritePChar(tai_stabn(hp).str);
+                   AsmLn;
+                 end;
              end;
              end;
 
 
            ait_force_line :
            ait_force_line :
@@ -826,7 +832,12 @@ var
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.34  2003-09-06 16:47:24  florian
+  Revision 1.35  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.34  2003/09/06 16:47:24  florian
     + support of NaN and Inf in the compiler as values of real constants
     + support of NaN and Inf in the compiler as values of real constants
 
 
   Revision 1.33  2003/09/04 00:15:29  florian
   Revision 1.33  2003/09/04 00:15:29  florian

+ 14 - 3
compiler/assemble.pas

@@ -1120,9 +1120,15 @@ Implementation
                end;
                end;
 {$ifdef GDB}
 {$ifdef GDB}
              ait_stabn :
              ait_stabn :
-               convertstabs(Tai_stabn(hp).str);
+               begin
+                 if assigned(Tai_stabn(hp).str) then
+                   convertstabs(Tai_stabn(hp).str);
+               end;
              ait_stabs :
              ait_stabs :
-               convertstabs(Tai_stabs(hp).str);
+               begin
+                 if assigned(Tai_stabs(hp).str) then
+                   convertstabs(Tai_stabs(hp).str);
+               end;
              ait_stab_function_name :
              ait_stab_function_name :
                begin
                begin
                  if assigned(Tai_stab_function_name(hp).str) then
                  if assigned(Tai_stab_function_name(hp).str) then
@@ -1640,7 +1646,12 @@ Implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.54  2003-09-03 15:55:00  peter
+  Revision 1.55  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.54  2003/09/03 15:55:00  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.53.2.1  2003/09/01 21:02:55  peter
   Revision 1.53.2.1  2003/09/01 21:02:55  peter

+ 14 - 9
compiler/cgbase.pas

@@ -81,6 +81,9 @@ unit cgbase;
           {# firsttemp position }
           {# firsttemp position }
           firsttemp_offset : longint;
           firsttemp_offset : longint;
 
 
+          { Size of the parameters on the stack }
+          para_stack_size : longint;
+
           {# some collected informations about the procedure
           {# some collected informations about the procedure
              see pi_xxxx constants above
              see pi_xxxx constants above
           }
           }
@@ -308,6 +311,8 @@ implementation
       begin
       begin
         parent:=aparent;
         parent:=aparent;
         procdef:=nil;
         procdef:=nil;
+        para_stack_size:=0;
+{$warning TODO maybe remove parent_framepointer_offset for i386}
         parent_framepointer_offset:=0;
         parent_framepointer_offset:=0;
         firsttemp_offset:=0;
         firsttemp_offset:=0;
         flags:=[];
         flags:=[];
@@ -330,8 +335,7 @@ implementation
 
 
     procedure tprocinfo.allocate_parent_framepointer_parameter;
     procedure tprocinfo.allocate_parent_framepointer_parameter;
       begin
       begin
-        parent_framepointer_offset:=procdef.parast.address_fixup;
-        inc(procdef.parast.address_fixup,POINTER_SIZE);
+        parent_framepointer_offset:=target_info.first_parm_offset;
       end;
       end;
 
 
 
 
@@ -364,18 +368,14 @@ implementation
 
 
 
 
     procedure tprocinfo.handle_body_start;
     procedure tprocinfo.handle_body_start;
-      var
-        paramloc : tparalocation;
-        regidx : tregisterindex;
       begin
       begin
-         { generate callee paraloc register info }
-         paramanager.create_paraloc_info(current_procinfo.procdef,calleeside);
-
+(*
          { temporary space is set, while the BEGIN of the procedure }
          { temporary space is set, while the BEGIN of the procedure }
          if (symtablestack.symtabletype=localsymtable) then
          if (symtablestack.symtabletype=localsymtable) then
            current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
            current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
          else
          else
            current_procinfo.firsttemp_offset := 0;
            current_procinfo.firsttemp_offset := 0;
+*)
       end;
       end;
 
 
 
 
@@ -546,7 +546,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.63  2003-09-14 19:18:10  peter
+  Revision 1.64  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.63  2003/09/14 19:18:10  peter
     * remove obsolete code already in comments
     * remove obsolete code already in comments
 
 
   Revision 1.62  2003/09/07 22:09:34  peter
   Revision 1.62  2003/09/07 22:09:34  peter

+ 16 - 1
compiler/cginfo.pas

@@ -162,6 +162,16 @@ interface
       { Set type definition for registers }
       { Set type definition for registers }
       tsuperregisterset = set of tsuperregister;
       tsuperregisterset = set of tsuperregister;
 
 
+      { Temp types }
+      ttemptype = (tt_none,
+                   tt_free,tt_normal,tt_persistent,
+                   tt_noreuse,tt_freenoreuse,
+                   tt_ansistring,tt_freeansistring,
+                   tt_widestring,tt_freewidestring,
+                   tt_interfacecom,tt_freeinterfacecom);
+      ttemptypeset = set of ttemptype;
+
+
     const
     const
        { Invalid register number }
        { Invalid register number }
        RS_INVALID    = $ff;
        RS_INVALID    = $ff;
@@ -306,7 +316,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.26  2003-09-14 19:30:58  daniel
+  Revision 1.27  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.26  2003/09/14 19:30:58  daniel
     * Fixed endian problem in Tregisterrec record
     * Fixed endian problem in Tregisterrec record
 
 
   Revision 1.25  2003/09/04 21:07:03  florian
   Revision 1.25  2003/09/04 21:07:03  florian

+ 6 - 3
compiler/i386/ag386int.pas

@@ -158,8 +158,6 @@ implementation
         with ref do
         with ref do
          begin
          begin
            first:=true;
            first:=true;
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
            if segment<>NR_NO then
            if segment<>NR_NO then
             AsmWrite(masm_regname(segment)+':[')
             AsmWrite(masm_regname(segment)+':[')
            else
            else
@@ -892,7 +890,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.38  2003-09-05 17:41:13  florian
+  Revision 1.39  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.38  2003/09/05 17:41:13  florian
     * merged Wiktor's Watcom patches in 1.1
     * merged Wiktor's Watcom patches in 1.1
 
 
   Revision 1.37  2003/09/03 15:55:01  peter
   Revision 1.37  2003/09/03 15:55:01  peter

+ 6 - 3
compiler/i386/ag386nsm.pas

@@ -227,8 +227,6 @@ interface
          begin
          begin
            AsmWrite('[');
            AsmWrite('[');
            first:=true;
            first:=true;
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
            if (segment<>NR_NO) then
            if (segment<>NR_NO) then
              AsmWrite(nasm_regname(segment)+':');
              AsmWrite(nasm_regname(segment)+':');
            if assigned(symbol) then
            if assigned(symbol) then
@@ -902,7 +900,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.38  2003-09-03 15:55:01  peter
+  Revision 1.39  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.38  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.37.2.1  2003/08/31 15:46:26  peter
   Revision 1.37.2.1  2003/08/31 15:46:26  peter

+ 69 - 33
compiler/i386/cpupara.pas

@@ -48,17 +48,17 @@ unit cpupara;
           function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
           function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
           function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
-          function getselflocation(p : tabstractprocdef) : tparalocation;override;
        private
        private
           procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
           procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
-          procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
-          procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+          function create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+          function create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
        end;
        end;
 
 
   implementation
   implementation
 
 
     uses
     uses
-       systems,verbose,
+       cutils,
+       systems,globals,verbose,
        symsym,
        symsym,
        cpuinfo,
        cpuinfo,
        cgbase;
        cgbase;
@@ -237,11 +237,19 @@ unit cpupara;
       end;
       end;
 
 
 
 
-    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+    function ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
       var
         hp : tparaitem;
         hp : tparaitem;
         paraloc : tparalocation;
         paraloc : tparalocation;
+        l,
+        varalign,
+        parasize : longint;
       begin
       begin
+        parasize:=0;
+{$warning HACK: framepointer reg shall be a normal parameter}
+        if p.parast.symtablelevel>normal_function_level then
+          inc(parasize,POINTER_SIZE);
+{$warning callerparaloc shall not be the same as calleeparaloc}
         hp:=tparaitem(p.para.first);
         hp:=tparaitem(p.para.first);
         while assigned(hp) do
         while assigned(hp) do
           begin
           begin
@@ -254,22 +262,36 @@ unit cpupara;
               paraloc.reference.index:=current_procinfo.framepointer
               paraloc.reference.index:=current_procinfo.framepointer
             else
             else
               paraloc.reference.index:=NR_FRAME_POINTER_REG;
               paraloc.reference.index:=NR_FRAME_POINTER_REG;
-            paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
+            l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+            varalign:=size_2_align(l);
+            paraloc.reference.offset:=parasize+target_info.first_parm_offset;
+            varalign:=used_align(varalign,p.paraalign,p.paraalign);
+            parasize:=align(parasize+l,varalign);
             hp.paraloc[side]:=paraloc;
             hp.paraloc[side]:=paraloc;
-{$warning callerparaloc shall not be the same as calleeparaloc}
             hp:=tparaitem(hp.next);
             hp:=tparaitem(hp.next);
           end;
           end;
+        { We need to return the size allocated }
+        result:=parasize;
       end;
       end;
 
 
 
 
-    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+    function ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
       var
         hp : tparaitem;
         hp : tparaitem;
         paraloc : tparalocation;
         paraloc : tparalocation;
         sr : tsuperregister;
         sr : tsuperregister;
         subreg : tsubregister;
         subreg : tsubregister;
+        is_64bit : boolean;
+        l,
+        varalign,
+        parasize : longint;
       begin
       begin
         sr:=RS_EAX;
         sr:=RS_EAX;
+        parasize:=0;
+{$warning HACK: framepointer reg shall be a normal parameter}
+        if p.parast.symtablelevel>normal_function_level then
+          inc(parasize,POINTER_SIZE);
+{$warning callerparaloc shall not be the same as calleeparaloc}
         hp:=tparaitem(p.para.first);
         hp:=tparaitem(p.para.first);
         while assigned(hp) do
         while assigned(hp) do
           begin
           begin
@@ -277,22 +299,35 @@ unit cpupara;
               paraloc.size:=OS_ADDR
               paraloc.size:=OS_ADDR
             else
             else
               paraloc.size:=def_cgsize(hp.paratype.def);
               paraloc.size:=def_cgsize(hp.paratype.def);
+            is_64bit:=(paraloc.size in [OS_64,OS_S64,OS_F64]);
             {
             {
               EAX
               EAX
               EDX
               EDX
               ECX
               ECX
               Stack
               Stack
               Stack
               Stack
+
+              64bit values are in EAX:EDX or on the stack.
             }
             }
-            if sr<=NR_ECX then
+            if (sr<=NR_ECX) and not(is_64bit) then
               begin
               begin
                 paraloc.loc:=LOC_REGISTER;
                 paraloc.loc:=LOC_REGISTER;
-                if paraloc.size=OS_NO then
-                  subreg:=R_SUBWHOLE
+                if is_64bit then
+                  begin
+                    paraloc.registerlow:=newreg(R_INTREGISTER,sr,R_SUBD);
+                    inc(sr);
+                    paraloc.registerhigh:=newreg(R_INTREGISTER,sr,R_SUBD);
+                    inc(sr);
+                  end
                 else
                 else
-                  subreg:=cgsize2subreg(paraloc.size);
-                paraloc.register:=newreg(R_INTREGISTER,sr,subreg);
-                inc(sr);
+                  begin
+                    if (paraloc.size=OS_NO) or is_64bit then
+                      subreg:=R_SUBWHOLE
+                    else
+                      subreg:=cgsize2subreg(paraloc.size);
+                    paraloc.register:=newreg(R_INTREGISTER,sr,subreg);
+                    inc(sr);
+                  end;
               end
               end
             else
             else
               begin
               begin
@@ -301,38 +336,34 @@ unit cpupara;
                   paraloc.reference.index:=current_procinfo.framepointer
                   paraloc.reference.index:=current_procinfo.framepointer
                 else
                 else
                   paraloc.reference.index:=NR_FRAME_POINTER_REG;
                   paraloc.reference.index:=NR_FRAME_POINTER_REG;
-                paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
+                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                varalign:=size_2_align(l);
+                paraloc.reference.offset:=parasize+target_info.first_parm_offset;
+                varalign:=used_align(varalign,p.paraalign,p.paraalign);
+                parasize:=align(parasize+l,varalign);
               end;
               end;
             hp.paraloc[side]:=paraloc;
             hp.paraloc[side]:=paraloc;
-{$warning callerparaloc shall not be the same as calleeparaloc}
             hp:=tparaitem(hp.next);
             hp:=tparaitem(hp.next);
           end;
           end;
+        { We need to return the size allocated }
+        result:=parasize;
       end;
       end;
 
 
 
 
     procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
     procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+      var
+        l : longint;
       begin
       begin
         if (p.proccalloption=pocall_register) or
         if (p.proccalloption=pocall_register) or
            ((pocall_default=pocall_register) and
            ((pocall_default=pocall_register) and
             (p.proccalloption in [pocall_compilerproc,pocall_internproc])) then
             (p.proccalloption in [pocall_compilerproc,pocall_internproc])) then
-          create_register_paraloc_info(p,side)
+          l:=create_register_paraloc_info(p,side)
         else
         else
-          create_stdcall_paraloc_info(p,side);
+          l:=create_stdcall_paraloc_info(p,side);
         create_funcret_paraloc_info(p,side);
         create_funcret_paraloc_info(p,side);
-      end;
-
-
-    function ti386paramanager.getselflocation(p : tabstractprocdef) : tparalocation;
-      var
-        hsym : tvarsym;
-      begin
-         hsym:=tvarsym(trecorddef(methodpointertype.def).symtable.search('self'));
-         if not assigned(hsym) then
-           internalerror(200305251);
-         getselflocation.loc:=LOC_REFERENCE;
-         getselflocation.sp_fixup:=POINTER_SIZE;
-         getselflocation.reference.index:=NR_STACK_POINTER_REG;
-         getselflocation.reference.offset:=hsym.adjusted_address;
+        { Store the size of the parameters on the stack }
+        if (side=calleeside) then
+          current_procinfo.para_stack_size:=l;
       end;
       end;
 
 
 
 
@@ -341,7 +372,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.29  2003-09-16 16:17:01  peter
+  Revision 1.30  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.29  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.28  2003/09/10 08:31:47  marco
   Revision 1.28  2003/09/10 08:31:47  marco

+ 8 - 2
compiler/i386/cpupi.pas

@@ -49,7 +49,8 @@ unit cpupi;
          { we push Flags and CS as long
          { we push Flags and CS as long
            to cope with the IRETD
            to cope with the IRETD
            and we save 6 register + 4 selectors }
            and we save 6 register + 4 selectors }
-         inc(procdef.parast.address_fixup,8+6*4+4*2);
+         {$warning TODO interrupt allocation}
+//         inc(procdef.parast.address_fixup,8+6*4+4*2);
       end;
       end;
 
 
 
 
@@ -76,7 +77,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.11  2003-09-09 21:03:17  peter
+  Revision 1.12  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.11  2003/09/09 21:03:17  peter
     * basics for x86 register calling
     * basics for x86 register calling
 
 
   Revision 1.10  2003/09/03 15:55:01  peter
   Revision 1.10  2003/09/03 15:55:01  peter

+ 8 - 3
compiler/i386/n386cal.pas

@@ -84,7 +84,7 @@ implementation
       begin
       begin
         pop_size:=0;
         pop_size:=0;
         { This parasize aligned on 4 ? }
         { This parasize aligned on 4 ? }
-        i:=procdefinition.parast.datasize and 3;
+        i:=pushedparasize and 3;
         if i>0 then
         if i>0 then
          inc(pop_size,4-i);
          inc(pop_size,4-i);
         { insert the opcode and update pushedparasize }
         { insert the opcode and update pushedparasize }
@@ -104,7 +104,7 @@ implementation
          if pop_allowed and (cs_align in aktglobalswitches) then
          if pop_allowed and (cs_align in aktglobalswitches) then
            begin
            begin
               pop_esp:=true;
               pop_esp:=true;
-              push_size:=procdefinition.parast.datasize;
+              push_size:=pushedparasize;
               { !!!! here we have to take care of return type, self
               { !!!! here we have to take care of return type, self
                 and nested procedures
                 and nested procedures
               }
               }
@@ -170,7 +170,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.94  2003-09-03 15:55:01  peter
+  Revision 1.95  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.94  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.93.2.1  2003/08/29 17:29:00  peter
   Revision 1.93.2.1  2003/08/29 17:29:00  peter

+ 10 - 7
compiler/i386/n386obj.pas

@@ -89,13 +89,11 @@ virtual(2):      OK     OK    OK(3)  OK       OK          OK(4)
 
 
 function getselfoffsetfromsp(procdef: tprocdef): longint;
 function getselfoffsetfromsp(procdef: tprocdef): longint;
 begin
 begin
-  if not assigned(procdef.parast.symindex.first) then
-    getselfoffsetfromsp:=4
+  { framepointer is pushed for nested procs }
+  if procdef.parast.symtablelevel>normal_function_level then
+    getselfoffsetfromsp:=8
   else
   else
-    if tsym(procdef.parast.symindex.first).typ=varsym then
-      getselfoffsetfromsp:=tvarsym(procdef.parast.symindex.first).address+4
-    else
-      Internalerror(2000061310);
+    getselfoffsetfromsp:=4;
 end;
 end;
 
 
 
 
@@ -228,7 +226,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.22  2003-09-07 22:09:35  peter
+  Revision 1.23  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.22  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 34 - 13
compiler/i386/ra386att.pas

@@ -1311,14 +1311,24 @@ var
      end;
      end;
     if actasmtoken in [AS_PLUS,AS_MINUS] then
     if actasmtoken in [AS_PLUS,AS_MINUS] then
      inc(l,BuildConstExpression(true,false));
      inc(l,BuildConstExpression(true,false));
-    if opr.typ=OPR_REFERENCE then
-     begin
-       if hasdot and (not hastype) and (opr.ref.options=ref_parafixup) then
-        Message(asmr_e_cannot_access_field_directly_for_parameters);
-       inc(opr.ref.offset,l)
-     end
-    else
-     inc(opr.val,l);
+    case opr.typ of
+      OPR_LOCAL :
+        begin
+          { don't allow direct access to fields of parameters, becuase that
+            will generate buggy code. Allow it only for explicit typecasting }
+          if hasdot and
+             (not hastype) and
+             (tvarsym(pointer(opr.ref.symbol)).owner.symtabletype=parasymtable) then
+            Message(asmr_e_cannot_access_field_directly_for_parameters);
+          inc(opr.localsymofs,l)
+        end;
+      OPR_CONSTANT :
+        inc(opr.val,l);
+      OPR_REFERENCE :
+        inc(opr.ref.offset);
+      else
+        internalerror(200309221);
+    end;
   end;
   end;
 
 
   function MaybeBuildReference:boolean;
   function MaybeBuildReference:boolean;
@@ -1502,10 +1512,16 @@ Begin
                     if (actasmtoken=AS_PLUS) then
                     if (actasmtoken=AS_PLUS) then
                      begin
                      begin
                        l:=BuildConstExpression(true,false);
                        l:=BuildConstExpression(true,false);
-                       if opr.typ=OPR_CONSTANT then
-                        inc(opr.val,l)
-                       else
-                        inc(opr.ref.offset,l);
+                       case opr.typ of
+                         OPR_CONSTANT :
+                           inc(opr.val,l);
+                         OPR_LOCAL :
+                           inc(opr.localsymofs,l);
+                         OPR_REFERENCE :
+                           inc(opr.ref.offset,l);
+                         else
+                           internalerror(200309202);
+                       end;
                      end
                      end
                   end
                   end
                  else
                  else
@@ -2113,7 +2129,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.46  2003-09-03 15:55:01  peter
+  Revision 1.47  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.46  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.45.2.2  2003/08/31 15:46:26  peter
   Revision 1.45.2.2  2003/08/31 15:46:26  peter

+ 31 - 20
compiler/i386/ra386int.pas

@@ -1360,23 +1360,23 @@ var
      end;
      end;
     if actasmtoken in [AS_PLUS,AS_MINUS] then
     if actasmtoken in [AS_PLUS,AS_MINUS] then
      inc(l,BuildConstExpression);
      inc(l,BuildConstExpression);
-    if (opr.typ=OPR_REFERENCE) then
-     begin
-       { don't allow direct access to fields of parameters, becuase that
-         will generate buggy code. Allow it only for explicit typecasting }
-       if (not hastype) then
+    case opr.typ of
+      OPR_LOCAL :
         begin
         begin
-          case opr.ref.options of
-            ref_parafixup :
-              Message(asmr_e_cannot_access_field_directly_for_parameters);
-            ref_selffixup :
-              Message(asmr_e_cannot_access_object_field_directly);
-          end;
+          { don't allow direct access to fields of parameters, becuase that
+            will generate buggy code. Allow it only for explicit typecasting }
+          if (not hastype) and
+             (tvarsym(pointer(opr.ref.symbol)).owner.symtabletype=parasymtable) then
+            Message(asmr_e_cannot_access_field_directly_for_parameters);
+          inc(opr.localsymofs,l)
         end;
         end;
-       inc(opr.ref.offset,l)
-     end
-    else
-     inc(opr.val,l);
+      OPR_CONSTANT :
+        inc(opr.val,l);
+      OPR_REFERENCE :
+        inc(opr.ref.offset);
+      else
+        internalerror(200309222);
+    end;
   end;
   end;
 
 
 Begin
 Begin
@@ -1492,10 +1492,16 @@ Begin
                      if (actasmtoken=AS_PLUS) then
                      if (actasmtoken=AS_PLUS) then
                       begin
                       begin
                         l:=BuildConstExpression;
                         l:=BuildConstExpression;
-                        if opr.typ=OPR_CONSTANT then
-                         inc(opr.val,l)
-                        else
-                         inc(opr.ref.offset,l);
+                        case opr.typ of
+                          OPR_CONSTANT :
+                            inc(opr.val,l);
+                          OPR_LOCAL :
+                            inc(opr.localsymofs,l);
+                          OPR_REFERENCE :
+                            inc(opr.ref.offset,l);
+                          else
+                            internalerror(200309203);
+                        end;
                       end
                       end
                    end
                    end
                   else
                   else
@@ -1923,7 +1929,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.50  2003-09-03 15:55:01  peter
+  Revision 1.51  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.50  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.49.2.2  2003/08/31 15:46:26  peter
   Revision 1.49.2.2  2003/08/31 15:46:26  peter

+ 6 - 23
compiler/nbas.pas

@@ -30,7 +30,6 @@ interface
        cpubase,cginfo,
        cpubase,cginfo,
        aasmbase,aasmtai,aasmcpu,
        aasmbase,aasmtai,aasmcpu,
        node,
        node,
-       tgobj,
        symtype,symppu;
        symtype,symppu;
 
 
     type
     type
@@ -132,11 +131,6 @@ interface
           function det_resulttype : tnode; override;
           function det_resulttype : tnode; override;
           procedure mark_write;override;
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           function docompare(p: tnode): boolean; override;
-          { Changes the location of this temp to ref. Useful when assigning }
-          { another temp to this one. The current location will be freed.   }
-          { Can only be called in pass 2 (since earlier, the temp location  }
-          { isn't known yet)                                                }
-          procedure changelocation(const ref: treference);
          protected
          protected
           tempinfo: ptempinfo;
           tempinfo: ptempinfo;
           offset : longint;
           offset : longint;
@@ -751,22 +745,6 @@ implementation
     end;
     end;
 
 
 
 
-    procedure ttemprefnode.changelocation(const ref: treference);
-      begin
-        { check if the temp is valid }
-        if not tempinfo^.valid then
-          internalerror(200306081);
-        if (tempinfo^.temptype = tt_persistent) then
-          tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal);
-        tg.ungettemp(exprasmlist,tempinfo^.ref);
-        tempinfo^.ref := ref;
-        tg.ChangeTempType(exprasmlist,tempinfo^.ref,tempinfo^.temptype);
-        { adapt location }
-        location.reference := ref;
-        inc(location.reference.offset,offset);
-      end;
-
-
 {*****************************************************************************
 {*****************************************************************************
                              TEMPDELETENODE
                              TEMPDELETENODE
 *****************************************************************************}
 *****************************************************************************}
@@ -854,7 +832,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.61  2003-09-07 22:09:35  peter
+  Revision 1.62  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.61  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 8 - 3
compiler/ncal.pas

@@ -187,7 +187,7 @@ implementation
       htypechk,pass_1,cpubase,
       htypechk,pass_1,cpubase,
       ncnv,nld,ninl,nadd,ncon,nmem,
       ncnv,nld,ninl,nadd,ncon,nmem,
       nutils,
       nutils,
-      tgobj,rgobj,cginfo,cgbase
+      rgobj,cginfo,cgbase
       ;
       ;
 
 
 type
 type
@@ -1864,7 +1864,7 @@ type
               pt.used_by_callnode:=used_by_callnode;
               pt.used_by_callnode:=used_by_callnode;
               oldppt^:=pt;
               oldppt^:=pt;
             end;
             end;
-           { Bind paraitem to this node }
+           { Bind paraitem to this node and varsym }
            pt.paraitem:=currpara;
            pt.paraitem:=currpara;
            { Next node and paraitem }
            { Next node and paraitem }
            oldppt:[email protected];
            oldppt:[email protected];
@@ -2514,7 +2514,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.180  2003-09-16 16:17:01  peter
+  Revision 1.181  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.180  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.179  2003/09/07 22:09:35  peter
   Revision 1.179  2003/09/07 22:09:35  peter

+ 89 - 36
compiler/ncgbas.pas

@@ -27,6 +27,7 @@ unit ncgbas;
 interface
 interface
 
 
     uses
     uses
+       cpubase,
        node,nbas;
        node,nbas;
 
 
     type
     type
@@ -52,6 +53,11 @@ interface
 
 
        tcgtemprefnode = class(ttemprefnode)
        tcgtemprefnode = class(ttemprefnode)
           procedure pass_2;override;
           procedure pass_2;override;
+          { Changes the location of this temp to ref. Useful when assigning }
+          { another temp to this one. The current location will be freed.   }
+          { Can only be called in pass 2 (since earlier, the temp location  }
+          { isn't known yet)                                                }
+          procedure changelocation(const ref: treference);
        end;
        end;
 
 
        tcgtempdeletenode = class(ttempdeletenode)
        tcgtempdeletenode = class(ttempdeletenode)
@@ -64,7 +70,6 @@ interface
       globtype,systems,
       globtype,systems,
       cutils,verbose,globals,
       cutils,verbose,globals,
       aasmbase,aasmtai,aasmcpu,symsym,
       aasmbase,aasmtai,aasmcpu,symsym,
-      cpubase,
       nflw,pass_2,
       nflw,pass_2,
       cgbase,cginfo,cgobj,tgobj,rgobj
       cgbase,cginfo,cgobj,tgobj,rgobj
       ;
       ;
@@ -124,9 +129,36 @@ interface
            end;
            end;
         end;
         end;
 
 
+      procedure ResolveRef(var op:toper);
+        var
+          sym : tvarsym;
+          sofs : longint;
+        begin
+          if (op.typ=top_local) then
+            begin
+              sofs:=op.localsymofs;
+              sym:=tvarsym(pointer(op.localsym));
+              case sym.localloc.loc of
+                LOC_REFERENCE :
+                  begin
+                    op.typ:=top_ref;
+                    new(op.ref);
+                    reference_reset_base(op.ref^,sym.localloc.reference.index,
+                        sym.localloc.reference.offset+sofs);
+                  end;
+                LOC_REGISTER :
+                  begin
+                    op.typ:=top_reg;
+                    op.reg:=sym.localloc.register;
+                    if sofs<>0 then
+                      internalerror(200309231);
+                  end;
+              end;
+            end;
+        end;
+
       var
       var
         hp,hp2 : tai;
         hp,hp2 : tai;
-        localfixup,parafixup,
         i : longint;
         i : longint;
         skipnode : boolean;
         skipnode : boolean;
       begin
       begin
@@ -141,11 +173,9 @@ interface
          { Allocate registers used in the assembler block }
          { Allocate registers used in the assembler block }
          rg.allocexplicitregistersint(exprasmlist,used_regs_int);
          rg.allocexplicitregistersint(exprasmlist,used_regs_int);
 
 
-         if inlining_procedure then
+         if (current_procinfo.procdef.proccalloption=pocall_inline) then
            begin
            begin
              objectlibrary.CreateUsedAsmSymbolList;
              objectlibrary.CreateUsedAsmSymbolList;
-             localfixup:=current_procinfo.procdef.localst.address_fixup;
-             parafixup:=current_procinfo.procdef.parast.address_fixup;
              hp:=tai(p_asm.first);
              hp:=tai(p_asm.first);
              while assigned(hp) do
              while assigned(hp) do
               begin
               begin
@@ -153,15 +183,10 @@ interface
                 skipnode:=false;
                 skipnode:=false;
                 case hp2.typ of
                 case hp2.typ of
                   ait_label :
                   ait_label :
-                     begin
-                       { regenerate the labels by setting altsymbol }
-                       ReLabel(tasmsymbol(tai_label(hp2).l));
-                     end;
+                     ReLabel(tasmsymbol(tai_label(hp2).l));
                   ait_const_rva,
                   ait_const_rva,
                   ait_const_symbol :
                   ait_const_symbol :
-                     begin
-                       ReLabel(tai_const_symbol(hp2).sym);
-                     end;
+                     ReLabel(tai_const_symbol(hp2).sym);
                   ait_instruction :
                   ait_instruction :
                      begin
                      begin
                        { remove cached insentry, because the new code can
                        { remove cached insentry, because the new code can
@@ -174,25 +199,16 @@ interface
                        { fixup the references }
                        { fixup the references }
                        for i:=1 to taicpu(hp2).ops do
                        for i:=1 to taicpu(hp2).ops do
                         begin
                         begin
+                          ResolveRef(taicpu(hp2).oper[i-1]);
                           with taicpu(hp2).oper[i-1] do
                           with taicpu(hp2).oper[i-1] do
                            begin
                            begin
                              case typ of
                              case typ of
                                top_ref :
                                top_ref :
-                                 begin
-                                   case ref^.options of
-                                     ref_parafixup :
-                                       ref^.offsetfixup:=parafixup;
-                                     ref_localfixup :
-                                       ref^.offsetfixup:=localfixup;
-                                   end;
-                                   if assigned(ref^.symbol) then
-                                    ReLabel(ref^.symbol);
-                                 end;
+                                 if assigned(ref^.symbol) then
+                                   ReLabel(ref^.symbol);
                                top_symbol :
                                top_symbol :
-                                 begin
-                                   ReLabel(sym);
-                                 end;
-                              end;
+                                 ReLabel(sym);
+                             end;
                            end;
                            end;
                         end;
                         end;
                      end;
                      end;
@@ -202,12 +218,11 @@ interface
                        if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
                        if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
                         skipnode:=true;
                         skipnode:=true;
                      end;
                      end;
-                   else
                 end;
                 end;
                 if not skipnode then
                 if not skipnode then
-                 exprasmList.concat(hp2)
+                  exprasmList.concat(hp2)
                 else
                 else
-                 hp2.free;
+                  hp2.free;
                 hp:=tai(hp.next);
                 hp:=tai(hp.next);
               end;
               end;
              { restore used symbols }
              { restore used symbols }
@@ -216,12 +231,28 @@ interface
            end
            end
          else
          else
            begin
            begin
-             { if the routine is an inline routine, then we must hold a copy
-               because it can be necessary for inlining later }
-             if (current_procinfo.procdef.proccalloption=pocall_inline) then
-               exprasmList.concatlistcopy(p_asm)
-             else
-               exprasmList.concatlist(p_asm);
+             hp:=tai(p_asm.first);
+             while assigned(hp) do
+              begin
+                case hp.typ of
+                  ait_instruction :
+                     begin
+                       { remove cached insentry, because the new code can
+                         require an other less optimized instruction }
+{$ifdef i386}
+{$ifndef NOAG386BIN}
+                       taicpu(hp).ResetPass1;
+{$endif}
+{$endif}
+                       { fixup the references }
+                       for i:=1 to taicpu(hp).ops do
+                         ResolveRef(taicpu(hp).oper[i-1]);
+                     end;
+                end;
+                hp:=tai(hp.next);
+              end;
+             { insert the list }
+             exprasmList.concatlist(p_asm);
            end;
            end;
 
 
          { Release register used in the assembler block }
          { Release register used in the assembler block }
@@ -289,6 +320,23 @@ interface
         inc(location.reference.offset,offset);
         inc(location.reference.offset,offset);
       end;
       end;
 
 
+
+    procedure tcgtemprefnode.changelocation(const ref: treference);
+      begin
+        { check if the temp is valid }
+        if not tempinfo^.valid then
+          internalerror(200306081);
+        if (tempinfo^.temptype = tt_persistent) then
+          tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal);
+        tg.ungettemp(exprasmlist,tempinfo^.ref);
+        tempinfo^.ref := ref;
+        tg.ChangeTempType(exprasmlist,tempinfo^.ref,tempinfo^.temptype);
+        { adapt location }
+        location.reference := ref;
+        inc(location.reference.offset,offset);
+      end;
+
+
 {*****************************************************************************
 {*****************************************************************************
                            TTEMPDELETENODE
                            TTEMPDELETENODE
 *****************************************************************************}
 *****************************************************************************}
@@ -315,7 +363,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.39  2003-09-07 22:09:35  peter
+  Revision 1.40  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.39  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 13 - 2
compiler/ncgcal.pas

@@ -1004,6 +1004,11 @@ implementation
          mangled_length  : longint;
          mangled_length  : longint;
 {$endif GDB}
 {$endif GDB}
       begin
       begin
+
+{$warning TODO Fix inlining}
+         internalerror(200309211);
+
+(*
          if not(assigned(procdefinition) and (procdefinition.deftype=procdef)) then
          if not(assigned(procdefinition) and (procdefinition.deftype=procdef)) then
            internalerror(200305262);
            internalerror(200305262);
 
 
@@ -1026,7 +1031,7 @@ implementation
              with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
              with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
                for i := 1 to maxvarregs do
                for i := 1 to maxvarregs do
                  if assigned(regvars[i]) then
                  if assigned(regvars[i]) then
-                   store_regvar(exprasmlist,regvars[i].reg);
+                   store_regvar(exprasmlist,regvars[i].localloc.register);
              rg.saveStateForInline(oldregstate);
              rg.saveStateForInline(oldregstate);
              { make sure the register allocator knows what the regvars in the }
              { make sure the register allocator knows what the regvars in the }
              { inlined code block are (JM)                                    }
              { inlined code block are (JM)                                    }
@@ -1296,6 +1301,7 @@ implementation
          { procedure (JM)                                                     }
          { procedure (JM)                                                     }
          if assigned(current_procinfo.procdef.regvarinfo) then
          if assigned(current_procinfo.procdef.regvarinfo) then
            rg.restoreStateAfterInline(oldregstate);
            rg.restoreStateAfterInline(oldregstate);
+*)
       end;
       end;
 
 
 
 
@@ -1314,7 +1320,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.115  2003-09-16 16:17:01  peter
+  Revision 1.116  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.115  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.114  2003/09/14 19:17:39  peter
   Revision 1.114  2003/09/14 19:17:39  peter

+ 27 - 7
compiler/ncgflw.pas

@@ -1135,8 +1135,8 @@ implementation
          doobjectdestroyandreraise,
          doobjectdestroyandreraise,
          doobjectdestroy,
          doobjectdestroy,
          oldaktbreaklabel : tasmlabel;
          oldaktbreaklabel : tasmlabel;
-         ref : treference;
          oldflowcontrol : tflowcontrol;
          oldflowcontrol : tflowcontrol;
+         exceptref,
          tempbuf,tempaddr : treference;
          tempbuf,tempaddr : treference;
          href : treference;
          href : treference;
          href2: treference;
          href2: treference;
@@ -1160,13 +1160,22 @@ implementation
 
 
          { is it this catch? No. go to next onlabel }
          { is it this catch? No. go to next onlabel }
          cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,NR_FUNCTION_RESULT_REG,nextonlabel);
          cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,NR_FUNCTION_RESULT_REG,nextonlabel);
-         ref.symbol:=nil;
-         tg.GetTemp(exprasmlist,pointer_size,tt_normal,ref);
 
 
          { what a hack ! }
          { what a hack ! }
          if assigned(exceptsymtable) then
          if assigned(exceptsymtable) then
-           tvarsym(exceptsymtable.symindex.first).address:=ref.offset;
-         cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,ref);
+           begin
+             tvarsym(exceptsymtable.symindex.first).localloc.loc:=LOC_REFERENCE;
+             tg.GetLocal(exprasmlist,POINTER_SIZE,tvarsym(exceptsymtable.symindex.first).localloc.reference);
+             reference_reset_base(href,tvarsym(exceptsymtable.symindex.first).localloc.reference.index,
+                tvarsym(exceptsymtable.symindex.first).localloc.reference.offset);
+             cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,href);
+           end
+         else
+           begin
+             tg.GetTemp(exprasmlist,POINTER_SIZE,tt_normal,exceptref);
+             cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptref);
+           end;
+
 
 
          { in the case that another exception is risen }
          { in the case that another exception is risen }
          { we've to destroy the old one                }
          { we've to destroy the old one                }
@@ -1214,7 +1223,13 @@ implementation
          cg.a_label(exprasmlist,doobjectdestroy);
          cg.a_label(exprasmlist,doobjectdestroy);
          cleanupobjectstack;
          cleanupobjectstack;
          { clear some stuff }
          { clear some stuff }
-         tg.ungetiftemp(exprasmlist,ref);
+         if assigned(exceptsymtable) then
+           begin
+             tg.UngetLocal(exprasmlist,tvarsym(exceptsymtable.symindex.first).localloc.reference);
+             tvarsym(exceptsymtable.symindex.first).localloc.loc:=LOC_INVALID;
+           end
+         else
+           tg.Ungettemp(exprasmlist,exceptref);
          cg.a_jmp_always(exprasmlist,endexceptlabel);
          cg.a_jmp_always(exprasmlist,endexceptlabel);
 
 
          if assigned(right) then
          if assigned(right) then
@@ -1429,7 +1444,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.80  2003-09-10 08:31:47  marco
+  Revision 1.81  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.80  2003/09/10 08:31:47  marco
    * Patch from Peter for paraloc
    * Patch from Peter for paraloc
 
 
   Revision 1.79  2003/09/07 22:09:35  peter
   Revision 1.79  2003/09/07 22:09:35  peter

+ 32 - 16
compiler/ncgld.pas

@@ -54,7 +54,7 @@ implementation
       aasmbase,aasmtai,aasmcpu,regvars,
       aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
       cpubase,cpuinfo,
-      tgobj,ncgutil,cgobj,rgobj;
+      tgobj,ncgutil,cgobj,rgobj,ncgbas;
 
 
 {*****************************************************************************
 {*****************************************************************************
                              SecondLoad
                              SecondLoad
@@ -84,7 +84,7 @@ implementation
                      if tabsolutesym(symtableentry).absseg then
                      if tabsolutesym(symtableentry).absseg then
                       location.reference.segment:=NR_FS;
                       location.reference.segment:=NR_FS;
 {$endif i386}
 {$endif i386}
-                     location.reference.offset:=tabsolutesym(symtableentry).address;
+                     location.reference.offset:=tabsolutesym(symtableentry).fieldoffset;
                    end
                    end
                   else
                   else
                    location.reference.symbol:=objectlibrary.newasmsymboldata(tabsolutesym(symtableentry).mangledname);
                    location.reference.symbol:=objectlibrary.newasmsymboldata(tabsolutesym(symtableentry).mangledname);
@@ -132,7 +132,7 @@ implementation
                        { make sure hregister can't allocate the register necessary for the parameter }
                        { make sure hregister can't allocate the register necessary for the parameter }
                        paraloc1:=paramanager.getintparaloc(pocall_default,1);
                        paraloc1:=paramanager.getintparaloc(pocall_default,1);
                        paramanager.allocparaloc(exprasmlist,paraloc1);
                        paramanager.allocparaloc(exprasmlist,paraloc1);
-                       { we've to allocate the register before we save the used registers }
+                       { we've to allocate an ABT register because it contains the procvar }
                        hregister:=rg.getaddressregister(exprasmlist);
                        hregister:=rg.getaddressregister(exprasmlist);
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata('FPC_THREADVAR_RELOCATE'),0);
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata('FPC_THREADVAR_RELOCATE'),0);
                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
                        cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
@@ -149,11 +149,16 @@ implementation
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
                        paramanager.freeparaloc(exprasmlist,paraloc1);
                        paramanager.freeparaloc(exprasmlist,paraloc1);
+                       rg.ungetregisterint(exprasmlist,hregister);
+                       r:=rg.getabtregisterint(exprasmlist,OS_ADDR);
+                       rg.ungetregisterint(exprasmlist,r);
+                       cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hregister,r);
                        rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
                        rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
-                       cg.a_call_reg(exprasmlist,hregister);
+                       cg.a_call_reg(exprasmlist,r);
                        rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
                        rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
                        r:=rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
                        r:=rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
                        rg.ungetregisterint(exprasmlist,r);
                        rg.ungetregisterint(exprasmlist,r);
+                       hregister:=rg.getaddressregister(exprasmlist);
                        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
                        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
                        cg.a_label(exprasmlist,norelocatelab);
                        cg.a_label(exprasmlist,norelocatelab);
                        location.reference.base:=hregister;
                        location.reference.base:=hregister;
@@ -162,22 +167,22 @@ implementation
                   else
                   else
                     begin
                     begin
                        { in case it is a register variable: }
                        { in case it is a register variable: }
-                       if tvarsym(symtableentry).reg<>NR_NO then
+                       if tvarsym(symtableentry).localloc.loc=LOC_REGISTER then
                          begin
                          begin
-                            case getregtype(tvarsym(symtableentry).reg) of
+                            case getregtype(tvarsym(symtableentry).localloc.register) of
                               R_FPUREGISTER :
                               R_FPUREGISTER :
                                 begin
                                 begin
                                    location_reset(location,LOC_CFPUREGISTER,def_cgsize(resulttype.def));
                                    location_reset(location,LOC_CFPUREGISTER,def_cgsize(resulttype.def));
-                                   location.register:=tvarsym(symtableentry).reg;
+                                   location.register:=tvarsym(symtableentry).localloc.register;
                                 end;
                                 end;
                               R_INTREGISTER :
                               R_INTREGISTER :
                                 begin
                                 begin
-                                  supreg:=getsupreg(Tvarsym(symtableentry).reg);
+                                  supreg:=getsupreg(Tvarsym(symtableentry).localloc.register);
                                   if (supreg in general_superregisters) and
                                   if (supreg in general_superregisters) and
                                      not (supreg in rg.regvar_loaded_int) then
                                      not (supreg in rg.regvar_loaded_int) then
                                     load_regvar(exprasmlist,tvarsym(symtableentry));
                                     load_regvar(exprasmlist,tvarsym(symtableentry));
                                   location_reset(location,LOC_CREGISTER,def_cgsize(resulttype.def));
                                   location_reset(location,LOC_CREGISTER,def_cgsize(resulttype.def));
-                                  location.register:=tvarsym(symtableentry).reg;
+                                  location.register:=tvarsym(symtableentry).localloc.register;
                                   exclude(rg.unusedregsint,supreg);
                                   exclude(rg.unusedregsint,supreg);
                                   hregister := location.register;
                                   hregister := location.register;
                                 end;
                                 end;
@@ -193,8 +198,10 @@ implementation
                               inlinelocalsymtable,
                               inlinelocalsymtable,
                               inlineparasymtable :
                               inlineparasymtable :
                                 begin
                                 begin
-                                  location.reference.base:=current_procinfo.framepointer;
-                                  location.reference.offset:=tvarsym(symtableentry).adjusted_address;
+                                  if tvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
+                                    internalerror(2003091816);
+                                  location.reference.base:=tvarsym(symtableentry).localloc.reference.index;
+                                  location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
 
 
                                   if (current_procinfo.procdef.parast.symtablelevel>symtable.symtablelevel) then
                                   if (current_procinfo.procdef.parast.symtablelevel>symtable.symtablelevel) then
                                     begin
                                     begin
@@ -210,8 +217,10 @@ implementation
                                 end;
                                 end;
                               stt_exceptsymtable:
                               stt_exceptsymtable:
                                 begin
                                 begin
-                                   location.reference.base:=current_procinfo.framepointer;
-                                   location.reference.offset:=tvarsym(symtableentry).address;
+                                  if tvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
+                                    internalerror(2003091817);
+                                  location.reference.base:=tvarsym(symtableentry).localloc.reference.index;
+                                  location.reference.offset:=tvarsym(symtableentry).localloc.reference.offset;
                                 end;
                                 end;
                               else
                               else
                                 internalerror(200305102);
                                 internalerror(200305102);
@@ -219,9 +228,11 @@ implementation
                          end;
                          end;
                     end;
                     end;
 
 
-                  { handle call by reference variables, ignore the reference
+                  { handle call by reference variables when they are not
+                    alreayd copied to local copies. Also ignore the reference
                     when we need to load the self pointer for objects }
                     when we need to load the self pointer for objects }
                   if (symtabletype in [parasymtable,inlineparasymtable]) and
                   if (symtabletype in [parasymtable,inlineparasymtable]) and
+                     not(vo_has_local_copy in tvarsym(symtableentry).varoptions) and
                      not(nf_load_self_pointer in flags) and
                      not(nf_load_self_pointer in flags) and
                      paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption) then
                      paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption) then
                     begin
                     begin
@@ -443,7 +454,7 @@ implementation
             { already more or less of the same kind (ie. we must not      }
             { already more or less of the same kind (ie. we must not      }
             { assign an ansistring to a normaltemp). In practice, the     }
             { assign an ansistring to a normaltemp). In practice, the     }
             { assignment node will have already taken care of this for us }
             { assignment node will have already taken care of this for us }
-            ttemprefnode(left).changelocation(right.location.reference);
+            tcgtemprefnode(left).changelocation(right.location.reference);
           end
           end
         { shortstring assignments are handled separately }
         { shortstring assignments are handled separately }
         else if is_shortstring(left.resulttype.def) then
         else if is_shortstring(left.resulttype.def) then
@@ -885,7 +896,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.82  2003-09-16 16:17:01  peter
+  Revision 1.83  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.82  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.81  2003/09/14 12:57:10  peter
   Revision 1.81  2003/09/14 12:57:10  peter

+ 7 - 2
compiler/ncgmem.pas

@@ -315,7 +315,7 @@ implementation
          else
          else
            location_copy(location,left.location);
            location_copy(location,left.location);
 
 
-         inc(location.reference.offset,vs.address);
+         inc(location.reference.offset,vs.fieldoffset);
          { also update the size of the location }
          { also update the size of the location }
          location.size:=def_cgsize(resulttype.def);
          location.size:=def_cgsize(resulttype.def);
       end;
       end;
@@ -811,7 +811,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.72  2003-09-10 08:31:47  marco
+  Revision 1.73  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.72  2003/09/10 08:31:47  marco
    * Patch from Peter for paraloc
    * Patch from Peter for paraloc
 
 
   Revision 1.71  2003/09/07 22:09:35  peter
   Revision 1.71  2003/09/07 22:09:35  peter

+ 432 - 147
compiler/ncgutil.pas

@@ -31,7 +31,7 @@ interface
       globtype,
       globtype,
       cpubase,
       cpubase,
       aasmbase,aasmtai,aasmcpu,
       aasmbase,aasmtai,aasmcpu,
-      cginfo,symconst,symbase,symdef,symtype,
+      cginfo,symconst,symbase,symdef,symsym,symtype,symtable,
 {$ifndef cpu64bit}
 {$ifndef cpu64bit}
       cg64f32,
       cg64f32,
 {$endif cpu64bit}
 {$endif cpu64bit}
@@ -93,6 +93,15 @@ interface
     procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
     procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
       a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
       a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
 
 
+    procedure insertconstdata(sym : ttypedconstsym);
+    procedure insertbssdata(sym : tvarsym);
+
+    procedure gen_alloc_localst(list: taasmoutput;st:tlocalsymtable);
+    procedure gen_free_localst(list: taasmoutput;st:tlocalsymtable);
+    procedure gen_alloc_parast(list: taasmoutput;st:tparasymtable);
+    procedure gen_free_parast(list: taasmoutput;st:tparasymtable);
+
+
 implementation
 implementation
 
 
   uses
   uses
@@ -103,7 +112,7 @@ implementation
 {$endif}
 {$endif}
     cutils,cclasses,
     cutils,cclasses,
     globals,systems,verbose,
     globals,systems,verbose,
-    symsym,symtable,defutil,
+    defutil,
     paramgr,fmodule,
     paramgr,fmodule,
     cgbase,regvars,
     cgbase,regvars,
 {$ifdef GDB}
 {$ifdef GDB}
@@ -857,18 +866,21 @@ implementation
         href1,href2 : treference;
         href1,href2 : treference;
         list : taasmoutput;
         list : taasmoutput;
         hsym : tvarsym;
         hsym : tvarsym;
-        loadref: boolean;
       begin
       begin
         list:=taasmoutput(arg);
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
         if (tsym(p).typ=varsym) and
            (tvarsym(p).varspez=vs_value) and
            (tvarsym(p).varspez=vs_value) and
            (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
            (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
          begin
          begin
-           loadref := (tvarsym(p).reg=NR_NO);
-           if (loadref) then
-             reference_reset_base(href1,current_procinfo.framepointer,tvarsym(p).adjusted_address)
-           else
-             reference_reset_base(href1,tvarsym(p).reg,0);
+           case tvarsym(p).paraitem.paraloc[calleeside].loc of
+             LOC_REGISTER :
+               reference_reset_base(href1,tvarsym(p).paraitem.paraloc[calleeside].register,0);
+             LOC_REFERENCE :
+               reference_reset_base(href1,tvarsym(p).paraitem.paraloc[calleeside].reference.index,
+                   tvarsym(p).paraitem.paraloc[calleeside].reference.offset);
+             else
+               internalerror(200309181);
+           end;
            if is_open_array(tvarsym(p).vartype.def) or
            if is_open_array(tvarsym(p).vartype.def) or
               is_array_of_const(tvarsym(p).vartype.def) then
               is_array_of_const(tvarsym(p).vartype.def) then
             begin
             begin
@@ -879,20 +891,26 @@ implementation
                   hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
                   hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
                   if not assigned(hsym) then
                   if not assigned(hsym) then
                     internalerror(200306061);
                     internalerror(200306061);
-                  reference_reset_base(href2,current_procinfo.framepointer,tvarsym(hsym).adjusted_address);
-                  if loadref then
-                   cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
-                  else
-                   internalerror(2003053101)
+                  case hsym.localloc.loc of
+                    LOC_REFERENCE :
+                      begin
+                        reference_reset_base(href2,hsym.localloc.reference.index,hsym.localloc.reference.offset);
+                        cg.g_copyvaluepara_openarray(list,href1,href2,tarraydef(tvarsym(p).vartype.def).elesize)
+                      end
+                    else
+                      internalerror(200309182);
+                  end;
                 end;
                 end;
             end
             end
            else
            else
             begin
             begin
-              reference_reset_base(href2,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address);
+              if tvarsym(p).localloc.loc<>LOC_REFERENCE then
+                internalerror(200309183);
+              reference_reset_base(href2,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
               if is_shortstring(tvarsym(p).vartype.def) then
               if is_shortstring(tvarsym(p).vartype.def) then
-               cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,loadref)
+                cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
               else
               else
-               cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,loadref);
+                cg.g_concatcopy(list,href1,href2,tvarsym(p).vartype.def.size,true,true);
             end;
             end;
          end;
          end;
       end;
       end;
@@ -906,17 +924,23 @@ implementation
       begin
       begin
         list:=taasmoutput(arg);
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
         if (tsym(p).typ=varsym) and
-           not(vo_is_local_copy in tvarsym(p).varoptions) and
            assigned(tvarsym(p).vartype.def) and
            assigned(tvarsym(p).vartype.def) and
            not(is_class(tvarsym(p).vartype.def)) and
            not(is_class(tvarsym(p).vartype.def)) and
            tvarsym(p).vartype.def.needs_inittable then
            tvarsym(p).vartype.def.needs_inittable then
          begin
          begin
            if (cs_implicit_exceptions in aktmoduleswitches) then
            if (cs_implicit_exceptions in aktmoduleswitches) then
             include(current_procinfo.flags,pi_needs_implicit_finally);
             include(current_procinfo.flags,pi_needs_implicit_finally);
-           if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
+           if tvarsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
+             begin
+               case tvarsym(p).localloc.loc of
+                 LOC_REFERENCE :
+                   reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
+                 else
+                   internalerror(2003091810);
+               end;
+             end
            else
            else
-            reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
+             reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
            cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
            cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
          end;
          end;
       end;
       end;
@@ -932,16 +956,22 @@ implementation
         case tsym(p).typ of
         case tsym(p).typ of
           varsym :
           varsym :
             begin
             begin
-              if not(vo_is_local_copy in tvarsym(p).varoptions) and
-                 not(vo_is_funcret in tvarsym(p).varoptions) and
+              if not(vo_is_funcret in tvarsym(p).varoptions) and
                  assigned(tvarsym(p).vartype.def) and
                  assigned(tvarsym(p).vartype.def) and
                  not(is_class(tvarsym(p).vartype.def)) and
                  not(is_class(tvarsym(p).vartype.def)) and
                  tvarsym(p).vartype.def.needs_inittable then
                  tvarsym(p).vartype.def.needs_inittable then
                begin
                begin
-                 if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-                  reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
+                 if tvarsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
+                   begin
+                     case tvarsym(p).localloc.loc of
+                       LOC_REFERENCE :
+                         reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
+                       else
+                         internalerror(2003091811);
+                     end;
+                   end
                  else
                  else
-                  reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
+                   reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
                  cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
                  cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
                end;
                end;
             end;
             end;
@@ -976,15 +1006,19 @@ implementation
                begin
                begin
                  if (cs_implicit_exceptions in aktmoduleswitches) then
                  if (cs_implicit_exceptions in aktmoduleswitches) then
                   include(current_procinfo.flags,pi_needs_implicit_finally);
                   include(current_procinfo.flags,pi_needs_implicit_finally);
-                 if assigned(tvarsym(p).localvarsym) then
-                   reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
-                 else
-                   reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
+                 if tvarsym(p).localloc.loc<>LOC_REFERENCE then
+                   internalerror(200309187);
+                 reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
                  cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
                  cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
                end;
                end;
              vs_out :
              vs_out :
                begin
                begin
-                 reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
+                 case tvarsym(p).localloc.loc of
+                   LOC_REFERENCE :
+                     reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
+                   else
+                     internalerror(2003091810);
+                 end;
                  tmpreg:=rg.getaddressregister(list);
                  tmpreg:=rg.getaddressregister(list);
                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
                  reference_reset_base(href,tmpreg,0);
                  reference_reset_base(href,tmpreg,0);
@@ -1009,10 +1043,9 @@ implementation
          begin
          begin
            if (tvarsym(p).varspez=vs_value) then
            if (tvarsym(p).varspez=vs_value) then
             begin
             begin
-              if assigned(tvarsym(p).localvarsym) then
-                reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
-              else
-                reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
+              if tvarsym(p).localloc.loc<>LOC_REFERENCE then
+                internalerror(200309188);
+              reference_reset_base(href,tvarsym(p).localloc.reference.index,tvarsym(p).localloc.reference.offset);
               cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
               cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
             end;
             end;
          end;
          end;
@@ -1115,7 +1148,12 @@ implementation
             ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
             ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
             if not assigned(ressym) then
             if not assigned(ressym) then
               internalerror(200305058);
               internalerror(200305058);
-            reference_reset_base(href,current_procinfo.framepointer,tvarsym(ressym).adjusted_address);
+            case ressym.localloc.loc of
+              LOC_REFERENCE :
+                reference_reset_base(href,ressym.localloc.reference.index,ressym.localloc.reference.offset);
+              else
+                internalerror(2003091810);
+            end;
             rg.ungetregisterint(list,r);
             rg.ungetregisterint(list,r);
             cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,r);
             cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,r);
             uses_acc:=true;
             uses_acc:=true;
@@ -1123,87 +1161,96 @@ implementation
           end;
           end;
 
 
         ressym := tvarsym(current_procinfo.procdef.funcretsym);
         ressym := tvarsym(current_procinfo.procdef.funcretsym);
-        if ressym.reg<>NR_NO then
+        if (ressym.refs>0) then
           begin
           begin
-            if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-              location_reset(resloc,LOC_CREGISTER,OS_ADDR)
-            else
-              if ressym.vartype.def.deftype = floatdef then
-                location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
-              else
-                location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
-            resloc.register := ressym.reg;
-          end
-        else
-          begin
-            location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procinfo.procdef.rettype.def));
-            reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procinfo.procdef.funcretsym).adjusted_address);
-          end;
-        { Here, we return the function result. In most architectures, the value is
-          passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
-          function returns in a register and the caller receives it in an other one }
-        case current_procinfo.procdef.rettype.def.deftype of
-          orddef,
-          enumdef :
-            begin
-              uses_acc:=true;
-{$ifndef cpu64bit}
-              if resloc.size in [OS_64,OS_S64] then
-               begin
-                 uses_acchi:=true;
-                 r:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_LOW_REG);
-                 r2:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                 rg.ungetregisterint(list,r);
-                 rg.ungetregisterint(list,r2);
-                 cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2),false);
-               end
+            case ressym.localloc.loc of
+              LOC_FPUREGISTER,
+              LOC_REGISTER :
+                begin
+                  if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+                    location_reset(resloc,LOC_CREGISTER,OS_ADDR)
+                  else
+                    if ressym.vartype.def.deftype = floatdef then
+                      location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
+                    else
+                      location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
+                  resloc.register:=ressym.localloc.register;
+                end;
+              LOC_REFERENCE :
+                begin
+                  location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procinfo.procdef.rettype.def));
+                  reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
+                end;
               else
               else
-{$endif cpu64bit}
-               begin
-                 hreg:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN_REG);
-                 hreg:=rg.makeregsize(hreg,resloc.size);
-                 rg.ungetregisterint(list,hreg);
-                 cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
-               end;
+                internalerror(200309184);
             end;
             end;
-          floatdef :
-            begin
-              uses_fpu := true;
-{$ifdef cpufpemu}
-              if cs_fp_emulation in aktmoduleswitches then
-                r:=NR_FUNCTION_RETURN_REG
+
+            { Here, we return the function result. In most architectures, the value is
+              passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
+              function returns in a register and the caller receives it in an other one }
+            case current_procinfo.procdef.rettype.def.deftype of
+              orddef,
+              enumdef :
+                begin
+                  uses_acc:=true;
+    {$ifndef cpu64bit}
+                  if resloc.size in [OS_64,OS_S64] then
+                   begin
+                     uses_acchi:=true;
+                     r:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_LOW_REG);
+                     r2:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_HIGH_REG);
+                     rg.ungetregisterint(list,r);
+                     rg.ungetregisterint(list,r2);
+                     cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2),false);
+                   end
+                  else
+    {$endif cpu64bit}
+                   begin
+                     hreg:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN_REG);
+                     hreg:=rg.makeregsize(hreg,resloc.size);
+                     rg.ungetregisterint(list,hreg);
+                     cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
+                   end;
+                end;
+              floatdef :
+                begin
+                  uses_fpu := true;
+    {$ifdef cpufpemu}
+                  if cs_fp_emulation in aktmoduleswitches then
+                    r:=NR_FUNCTION_RETURN_REG
+                  else
+    {$endif cpufpemu}
+                    r:=NR_FPU_RESULT_REG;
+                  cg.a_loadfpu_loc_reg(list,resloc,r);
+                end;
               else
               else
-{$endif cpufpemu}
-                r:=NR_FPU_RESULT_REG;
-              cg.a_loadfpu_loc_reg(list,resloc,r);
-            end;
-          else
-            begin
-              if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-               begin
-                 uses_acc:=true;
-{$ifndef cpu64bit}
-                 { Win32 can return records in EAX:EDX }
-                 if resloc.size in [OS_64,OS_S64] then
-                  begin
-                    uses_acchi:=true;
-                    r:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_LOW_REG);
-                    r2:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                    rg.ungetregisterint(list,r);
-                    rg.ungetregisterint(list,r2);
-                    cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2),false);
-                  end
-                 else
-{$endif cpu64bit}
-                  begin
-                    hreg:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN_REG);
-                    hreg:=rg.makeregsize(hreg,resloc.size);
-                    rg.ungetregisterint(list,hreg);
-                    cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
-                  end;
-                end
+                begin
+                  if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+                   begin
+                     uses_acc:=true;
+    {$ifndef cpu64bit}
+                     { Win32 can return records in EAX:EDX }
+                     if resloc.size in [OS_64,OS_S64] then
+                      begin
+                        uses_acchi:=true;
+                        r:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_LOW_REG);
+                        r2:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN64_HIGH_REG);
+                        rg.ungetregisterint(list,r);
+                        rg.ungetregisterint(list,r2);
+                        cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2),false);
+                      end
+                     else
+    {$endif cpu64bit}
+                      begin
+                        hreg:=rg.getexplicitregisterint(list,NR_FUNCTION_RETURN_REG);
+                        hreg:=rg.makeregsize(hreg,resloc.size);
+                        rg.ungetregisterint(list,hreg);
+                        cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
+                      end;
+                    end
+                end;
             end;
             end;
-        end;
+         end;
       end;
       end;
 
 
 
 
@@ -1473,21 +1520,26 @@ implementation
             gotregvarparas := false;
             gotregvarparas := false;
             while assigned(hp) do
             while assigned(hp) do
               begin
               begin
-                if (tvarsym(hp.parasym).reg<>NR_NO) then
-                  begin
-                    gotregvarparas := true;
-                    { cg.a_load_param_reg will first allocate and then deallocate paraloc }
-                    { register (if the parameter resides in a register) and then allocate }
-                    { the regvar (which is currently not allocated)                       }
-                    cg.a_load_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).reg);
-                  end
-                else if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
-                                            LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
-                        (tvarsym(hp.parasym).reg=NR_NO) then
-                  begin
-                    reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
-                    cg.a_load_param_ref(list,hp.paraloc[calleeside],href);
-                  end;
+                case tvarsym(hp.parasym).localloc.loc of
+                  LOC_REGISTER :
+                    begin
+                      gotregvarparas := true;
+                      { cg.a_load_param_reg will first allocate and then deallocate paraloc }
+                      { register (if the parameter resides in a register) and then allocate }
+                      { the regvar (which is currently not allocated)                       }
+                      cg.a_load_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register);
+                    end;
+                  LOC_REFERENCE :
+                    begin
+                      if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
+                        begin
+                          reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
+                          cg.a_load_param_ref(list,hp.paraloc[calleeside],href);
+                        end;
+                    end;
+                  else
+                    internalerror(200309185);
+                end;
                 hp:=tparaitem(hp.next);
                 hp:=tparaitem(hp.next);
               end;
               end;
             if gotregvarparas then
             if gotregvarparas then
@@ -1496,8 +1548,8 @@ implementation
                 hp:=tparaitem(current_procinfo.procdef.para.first);
                 hp:=tparaitem(current_procinfo.procdef.para.first);
                 while assigned(hp) do
                 while assigned(hp) do
                   begin
                   begin
-                    if (tvarsym(hp.parasym).reg<>NR_NO) then
-                      rg.ungetregisterint(list,tvarsym(hp.parasym).reg);
+                    if (tvarsym(hp.parasym).localloc.loc=LOC_REGISTER) then
+                      rg.ungetregisterint(list,tvarsym(hp.parasym).localloc.register);
                     hp:=tparaitem(hp.next);
                     hp:=tparaitem(hp.next);
                   end;
                   end;
               end;
               end;
@@ -1554,9 +1606,7 @@ implementation
                 end
                 end
               else
               else
                 begin
                 begin
-                  retsize:=current_procinfo.procdef.parast.datasize;
-                  if current_procinfo.procdef.parast.address_fixup>target_info.first_parm_offset then
-                    inc(retsize,current_procinfo.procdef.parast.address_fixup-target_info.first_parm_offset);
+                  retsize:=current_procinfo.para_stack_size;
                 end;
                 end;
               cg.g_return_from_proc(list,retsize);
               cg.g_return_from_proc(list,retsize);
             end;
             end;
@@ -1576,25 +1626,31 @@ implementation
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
                tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset))));
                tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset))));
 
 
-            if (not is_void(current_procinfo.procdef.rettype.def)) then
+            if (not is_void(current_procinfo.procdef.rettype.def)) and
+               (tvarsym(current_procinfo.procdef.funcretsym).refs>0) then
               begin
               begin
+                if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc<>LOC_REFERENCE then
+                  internalerror(2003091812);
                 if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
                 if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                  list.concat(Tai_stabs.Create(strpnew(
-                   '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address))))
-                else
-                  list.concat(Tai_stabs.Create(strpnew(
-                   '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                   tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address))));
-                if (m_result in aktmodeswitches) then
-                  if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+                  begin
                     list.concat(Tai_stabs.Create(strpnew(
                     list.concat(Tai_stabs.Create(strpnew(
-                     '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address))))
-                  else
+                       '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                       tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                    if (m_result in aktmodeswitches) then
+                      list.concat(Tai_stabs.Create(strpnew(
+                         '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                         tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
+                  end
+                else
+                  begin
                     list.concat(Tai_stabs.Create(strpnew(
                     list.concat(Tai_stabs.Create(strpnew(
-                     '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
-                     tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address))));
+                       '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                       tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                    if (m_result in aktmodeswitches) then
+                      list.concat(Tai_stabs.Create(strpnew(
+                         '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
+                         tostr(N_tsym)+',0,0,'+tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
+                   end;
               end;
               end;
             mangled_length:=length(current_procinfo.procdef.mangledname);
             mangled_length:=length(current_procinfo.procdef.mangledname);
             getmem(p,2*mangled_length+50);
             getmem(p,2*mangled_length+50);
@@ -1770,10 +1826,239 @@ implementation
       end;
       end;
 *)
 *)
 
 
+
+{****************************************************************************
+                               Const Data
+****************************************************************************}
+
+    procedure insertconstdata(sym : ttypedconstsym);
+    { this does not affect the local stack space, since all
+      typed constansts and initialized variables are always
+      put in the .data / .rodata section
+    }
+      var
+        storefilepos : tfileposinfo;
+        curconstsegment : taasmoutput;
+        l : longint;
+      begin
+        storefilepos:=aktfilepos;
+        aktfilepos:=sym.fileinfo;
+        if sym.is_writable then
+          curconstsegment:=datasegment
+        else
+          curconstsegment:=consts;
+        l:=sym.getsize;
+        { insert cut for smartlinking or alignment }
+        if (cs_create_smart in aktmoduleswitches) then
+          curconstSegment.concat(Tai_cut.Create);
+        curconstSegment.concat(Tai_align.create(const_align(l)));
+{$ifdef GDB}
+        if cs_debuginfo in aktmoduleswitches then
+          sym.concatstabto(curconstsegment);
+{$endif GDB}
+        if (sym.owner.symtabletype=globalsymtable) or
+           (cs_create_smart in aktmoduleswitches) or
+           DLLSource then
+          curconstSegment.concat(Tai_symbol.Createdataname_global(sym.mangledname,l))
+        else
+          curconstSegment.concat(Tai_symbol.Createdataname(sym.mangledname,l));
+        aktfilepos:=storefilepos;
+      end;
+
+
+    procedure insertbssdata(sym : tvarsym);
+      var
+        l,varalign : longint;
+        storefilepos : tfileposinfo;
+      begin
+        storefilepos:=aktfilepos;
+        aktfilepos:=sym.fileinfo;
+        l:=sym.getvaluesize;
+        if (vo_is_thread_var in sym.varoptions) then
+          inc(l,pointer_size);
+        varalign:=var_align(l);
+        {
+        sym.address:=align(datasize,varalign);
+        datasize:=tvarsym(sym).address+l;
+        }
+        { insert cut for smartlinking or alignment }
+        if (cs_create_smart in aktmoduleswitches) then
+          bssSegment.concat(Tai_cut.Create);
+        bssSegment.concat(Tai_align.create(varalign));
+{$ifdef GDB}
+        if cs_debuginfo in aktmoduleswitches then
+           sym.concatstabto(bsssegment);
+{$endif GDB}
+        if (sym.owner.symtabletype=globalsymtable) or
+           (cs_create_smart in aktmoduleswitches) or
+           DLLSource or
+           (vo_is_exported in sym.varoptions) or
+           (vo_is_C_var in sym.varoptions) then
+          bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l))
+        else
+          bssSegment.concat(Tai_datablock.Create(sym.mangledname,l));
+        aktfilepos:=storefilepos;
+      end;
+
+
+    procedure gen_alloc_localst(list: taasmoutput;st:tlocalsymtable);
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(st.symindex.first);
+        while assigned(sym) do
+          begin
+            { Only allocate space for referenced locals }
+            if (sym.typ=varsym) and
+               (tvarsym(sym).refs>0) then
+              begin
+                with tvarsym(sym) do
+                  begin
+{$warning TODO Add support for register variables}
+                    localloc.loc:=LOC_REFERENCE;
+                    tg.GetLocal(list,getvaluesize,localloc.reference);
+                  end;
+              end;
+            sym:=tsym(sym.indexnext);
+          end;
+      end;
+
+
+    procedure gen_free_localst(list: taasmoutput;st:tlocalsymtable);
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(st.symindex.first);
+        while assigned(sym) do
+          begin
+            if (sym.typ=varsym) and
+               (tvarsym(sym).refs>0) then
+              begin
+                with tvarsym(sym) do
+                  begin
+                    { Note: We need to keep the data available in memory
+                      for the sub procedures that can access local data
+                      in the parent procedures }
+                    case localloc.loc of
+                      LOC_REFERENCE :
+                        tg.Ungetlocal(list,localloc.reference);
+                      LOC_REGISTER :
+                        begin
+{$ifndef cpu64bit}
+                          if localloc.size in [OS_64,OS_S64] then
+                            begin
+                              rg.ungetregister(list,localloc.registerlow);
+                              rg.ungetregister(list,localloc.registerhigh);
+                            end
+                          else
+{$endif cpu64bit}
+                            rg.ungetregister(list,localloc.register);
+                        end;
+                    end;
+                  end;
+              end;
+            sym:=tsym(sym.indexnext);
+          end;
+      end;
+
+
+    procedure gen_alloc_parast(list: taasmoutput;st:tparasymtable);
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(st.symindex.first);
+        while assigned(sym) do
+          begin
+            if sym.typ=varsym then
+              begin
+                with tvarsym(sym) do
+                  begin
+                    { Allocate local copy? }
+                    if (vo_has_local_copy in varoptions) then
+                      begin
+                        localloc.loc:=LOC_REFERENCE;
+                        localloc.size:=int_cgsize(getvaluesize);
+                        tg.GetLocal(list,getvaluesize,localloc.reference);
+                      end
+                    else
+                      begin
+                        { Allocate imaginary register for register parameters }
+                        if paraitem.paraloc[calleeside].loc=LOC_REGISTER then
+                          begin
+{$warning TODO Allocate register paras}
+(*
+                            localloc.loc:=LOC_REGISTER;
+                            localloc.size:=paraitem.paraloc[calleeside].size;
+{$ifndef cpu64bit}
+                            if localloc.size in [OS_64,OS_S64] then
+                              begin
+                                localloc.registerlow:=rg.getregisterint(list,OS_32);
+                                localloc.registerhigh:=rg.getregisterint(list,OS_32);
+                              end
+                            else
+{$endif cpu64bit}
+                              localloc.register:=rg.getregisterint(list,localloc.size);
+*)
+                            localloc.loc:=LOC_REFERENCE;
+                            localloc.size:=int_cgsize(getvaluesize);
+                            tg.GetLocal(list,getvaluesize,localloc.reference);
+                          end
+                        else
+                          localloc:=paraitem.paraloc[calleeside];
+                      end;
+                  end;
+              end;
+            sym:=tsym(sym.indexnext);
+          end;
+      end;
+
+
+    procedure gen_free_parast(list: taasmoutput;st:tparasymtable);
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(st.symindex.first);
+        while assigned(sym) do
+          begin
+            if sym.typ=varsym then
+              begin
+                with tvarsym(sym) do
+                  begin
+                    { Note: We need to keep the data available in memory
+                      for the sub procedures that can access local data
+                      in the parent procedures }
+                    case localloc.loc of
+                      LOC_REFERENCE :
+                        tg.UngetLocal(list,localloc.reference);
+                      LOC_REGISTER :
+                        begin
+{$ifndef cpu64bit}
+                          if localloc.size in [OS_64,OS_S64] then
+                            begin
+                              rg.ungetregister(list,localloc.registerlow);
+                              rg.ungetregister(list,localloc.registerhigh);
+                            end
+                          else
+{$endif cpu64bit}
+                            rg.ungetregister(list,localloc.register);
+                        end;
+                    end;
+                  end;
+              end;
+            sym:=tsym(sym.indexnext);
+          end;
+      end;
+
+
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.145  2003-09-16 16:17:01  peter
+  Revision 1.146  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.145  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.144  2003/09/14 21:33:37  peter
   Revision 1.144  2003/09/14 21:33:37  peter

+ 7 - 2
compiler/ninl.pas

@@ -75,7 +75,7 @@ implementation
       symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
       symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
       pass_1,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
-      cpubase,tgobj,cginfo,cgbase
+      cpubase,cginfo,cgbase
       ;
       ;
 
 
    function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
    function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;
@@ -2363,7 +2363,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.116  2003-09-16 16:17:01  peter
+  Revision 1.117  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.116  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.115  2003/09/06 16:47:24  florian
   Revision 1.115  2003/09/06 16:47:24  florian

+ 6 - 8
compiler/nld.pas

@@ -192,13 +192,6 @@ implementation
       begin
       begin
         result:=nil;
         result:=nil;
         srsymtable:=vs.owner;
         srsymtable:=vs.owner;
-        if vo_is_local_copy in vs.varoptions then
-         begin
-           { next symtable is always the para symtable }
-           srsymtable:=srsymtable.next;
-           if not(srsymtable.symtabletype in [parasymtable,inlineparasymtable]) then
-             internalerror(200212171);
-         end;
         srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
         srsym:=searchsymonlyin(srsymtable,'high'+vs.name);
         if assigned(srsym) then
         if assigned(srsym) then
           begin
           begin
@@ -1282,7 +1275,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.105  2003-09-16 16:17:01  peter
+  Revision 1.106  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.105  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.104  2003/09/07 22:09:35  peter
   Revision 1.104  2003/09/07 22:09:35  peter

+ 28 - 11
compiler/nobj.pas

@@ -988,7 +988,7 @@ implementation
             if impintfindexes[i]=i then { if implement itself }
             if impintfindexes[i]=i then { if implement itself }
               begin
               begin
                 { allocate a pointer in the object memory }
                 { allocate a pointer in the object memory }
-                with tstoredsymtable(_class.symtable) do
+                with tobjectsymtable(_class.symtable) do
                   begin
                   begin
                     if (dataalignment>=pointer_size) then
                     if (dataalignment>=pointer_size) then
                       datasize:=align(datasize,dataalignment)
                       datasize:=align(datasize,dataalignment)
@@ -1235,8 +1235,8 @@ implementation
 
 
          { determine the size with symtable.datasize, because }
          { determine the size with symtable.datasize, because }
          { size gives back 4 for classes                    }
          { size gives back 4 for classes                    }
-         dataSegment.concat(Tai_const.Create_32bit(_class.symtable.datasize));
-         dataSegment.concat(Tai_const.Create_32bit(-_class.symtable.datasize));
+         dataSegment.concat(Tai_const.Create_32bit(tobjectsymtable(_class.symtable).datasize));
+         dataSegment.concat(Tai_const.Create_32bit(-tobjectsymtable(_class.symtable).datasize));
 {$ifdef WITHDMT}
 {$ifdef WITHDMT}
          if _class.classtype=ct_object then
          if _class.classtype=ct_object then
            begin
            begin
@@ -1304,20 +1304,32 @@ implementation
 
 
   procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aword);
   procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aword);
     var
     var
+      hsym : tsym;
       href : treference;
       href : treference;
-      l : tparalocation;
+      locpara : tparalocation;
     begin
     begin
-      l:=paramanager.getselflocation(procdef);
-      case l.loc of
+      { calculate the parameter info for the procdef }
+      if not procdef.has_paraloc_info then
+        begin
+          paramanager.create_paraloc_info(procdef,callerside);
+          procdef.has_paraloc_info:=true;
+        end;
+      hsym:=tsym(procdef.parast.search('self'));
+      if not(assigned(hsym) and
+             (hsym.typ=varsym) and
+             assigned(tvarsym(hsym).paraitem)) then
+        internalerror(200305251);
+      locpara:=tvarsym(hsym).paraitem.paraloc[callerside];
+      case locpara.loc of
         LOC_REGISTER:
         LOC_REGISTER:
-          cg.a_op_const_reg(exprasmlist,OP_SUB,l.size,ioffset,l.register);
+          cg.a_op_const_reg(exprasmlist,OP_SUB,locpara.size,ioffset,locpara.register);
         LOC_REFERENCE:
         LOC_REFERENCE:
           begin
           begin
-             reference_reset_base(href,l.reference.index,l.reference.offset);
-             cg.a_op_const_ref(exprasmlist,OP_SUB,OS_ADDR,ioffset,href);
+             reference_reset_base(href,locpara.reference.index,locpara.reference.offset);
+             cg.a_op_const_ref(exprasmlist,OP_SUB,locpara.size,ioffset,href);
           end
           end
         else
         else
-          internalerror(2002080801);
+          internalerror(200309189);
       end;
       end;
     end;
     end;
 
 
@@ -1327,7 +1339,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.47  2003-08-21 14:47:41  peter
+  Revision 1.48  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.47  2003/08/21 14:47:41  peter
     * remove convert_registers
     * remove convert_registers
 
 
   Revision 1.46  2003/08/20 09:07:00  daniel
   Revision 1.46  2003/08/20 09:07:00  daniel

+ 7 - 7
compiler/paramgr.pas

@@ -93,12 +93,6 @@ unit paramgr;
           }
           }
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);virtual;abstract;
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);virtual;abstract;
 
 
-          { Returns the self pointer location for the given tabstractprocdef,
-            when the stack frame is already created. This is used by the code
-            generating the wrappers for implemented interfaces.
-          }
-          function getselflocation(p : tabstractprocdef) : tparalocation;virtual;abstract;
-
           { Return the location of the low and high part of a 64bit parameter }
           { Return the location of the low and high part of a 64bit parameter }
           procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
           procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
 
 
@@ -355,6 +349,7 @@ implementation
       end;
       end;
 
 
 
 
+
 initialization
 initialization
   ;
   ;
 finalization
 finalization
@@ -363,7 +358,12 @@ end.
 
 
 {
 {
    $Log$
    $Log$
-   Revision 1.55  2003-09-16 16:17:01  peter
+   Revision 1.56  2003-09-23 17:56:05  peter
+     * locals and paras are allocated in the code generation
+     * tvarsym.localloc contains the location of para/local when
+       generating code for the current procedure
+
+   Revision 1.55  2003/09/16 16:17:01  peter
      * varspez in calls to push_addr_param
      * varspez in calls to push_addr_param
 
 
    Revision 1.54  2003/09/10 08:31:47  marco
    Revision 1.54  2003/09/10 08:31:47  marco

+ 10 - 6
compiler/pass_1.pas

@@ -44,15 +44,14 @@ implementation
     uses
     uses
       globtype,systems,cclasses,
       globtype,systems,cclasses,
       cutils,globals,
       cutils,globals,
-      cgbase,symdef,
+      cgbase,symdef
 {$ifdef extdebug}
 {$ifdef extdebug}
-      cginfo,verbose,
-      htypechk,
+      ,cginfo,verbose,
+      htypechk
 {$endif extdebug}
 {$endif extdebug}
 {$ifdef state_tracking}
 {$ifdef state_tracking}
-      nstate,
+      ,nstate
 {$endif}
 {$endif}
-      tgobj
       ;
       ;
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -216,7 +215,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  2003-04-22 23:50:23  peter
+  Revision 1.31  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.30  2003/04/22 23:50:23  peter
     * firstpass uses expectloc
     * firstpass uses expectloc
     * checks if there are differences between the expectloc and
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG
       location.loc from secondpass in EXTDEBUG

+ 6 - 4
compiler/pbase.pas

@@ -50,9 +50,6 @@ interface
        getprocvardef : tprocvardef = nil;
        getprocvardef : tprocvardef = nil;
 
 
     var
     var
-       { size of data segment, set by proc_unit or proc_program }
-       datasize : longint;
-
        { for operators }
        { for operators }
        optoken : ttoken;
        optoken : ttoken;
 
 
@@ -273,7 +270,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  2003-05-15 18:58:53  peter
+  Revision 1.25  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.24  2003/05/15 18:58:53  peter
     * removed selfpointer_offset, vmtpointer_offset
     * removed selfpointer_offset, vmtpointer_offset
     * tvarsym.adjusted_address
     * tvarsym.adjusted_address
     * address in localsymtable is now in the real direction
     * address in localsymtable is now in the real direction

+ 9 - 2
compiler/pdecl.pas

@@ -57,6 +57,8 @@ implementation
        symconst,symbase,symtype,symdef,symtable,paramgr,
        symconst,symbase,symtype,symdef,symtable,paramgr,
        { pass 1 }
        { pass 1 }
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
+       { codegen }
+       ncgutil,
        { parser }
        { parser }
        scanner,
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@@ -195,7 +197,7 @@ implementation
                    sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
                    sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
                    akttokenpos:=storetokenpos;
                    akttokenpos:=storetokenpos;
                    symtablestack.insert(sym);
                    symtablestack.insert(sym);
-                   symtablestack.insertconstdata(sym);
+                   insertconstdata(ttypedconstsym(sym));
                    { procvar can have proc directives }
                    { procvar can have proc directives }
                    if (tt.def.deftype=procvardef) then
                    if (tt.def.deftype=procvardef) then
                     begin
                     begin
@@ -631,7 +633,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.68  2003-07-02 22:18:04  peter
+  Revision 1.69  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.68  2003/07/02 22:18:04  peter
     * paraloc splitted in callerparaloc,calleeparaloc
     * paraloc splitted in callerparaloc,calleeparaloc
     * sparc calling convention updates
     * sparc calling convention updates
 
 

+ 32 - 15
compiler/pdecsub.pas

@@ -217,7 +217,6 @@ implementation
               if tstoreddef(pd.rettype.def).is_fpuregable then
               if tstoreddef(pd.rettype.def).is_fpuregable then
                 include(vs.varoptions,vo_fpuregable);
                 include(vs.varoptions,vo_fpuregable);
               pd.localst.insert(vs);
               pd.localst.insert(vs);
-              pd.localst.insertvardata(vs);
               pd.funcretsym:=vs;
               pd.funcretsym:=vs;
             end;
             end;
 
 
@@ -286,6 +285,7 @@ implementation
       end;
       end;
 
 
 
 
+      (*
     procedure rename_value_para(p:tnamedindexitem;arg:pointer);
     procedure rename_value_para(p:tnamedindexitem;arg:pointer);
       var
       var
         pd : tprocdef;
         pd : tprocdef;
@@ -302,13 +302,11 @@ implementation
              array of const and open array do not need this, the local copy routine
              array of const and open array do not need this, the local copy routine
              will patch the pushed value to point to the local copy }
              will patch the pushed value to point to the local copy }
            if (varspez=vs_value) and
            if (varspez=vs_value) and
-              paramanager.push_addr_param(varspez,vartype.def,pd.proccalloption) and
-              not(is_array_of_const(vartype.def) or
-                  is_open_array(vartype.def)) then
-            pd.parast.symsearch.rename(name,'val'+name);
+              paramanager.push_addr_param(varspez,vartype.def,pd.proccalloption) then
+             include(varoptions,vo_has_local_copy);
          end;
          end;
       end;
       end;
-
+*)
 
 
     procedure check_c_para(p:tnamedindexitem;arg:pointer);
     procedure check_c_para(p:tnamedindexitem;arg:pointer);
       begin
       begin
@@ -1667,7 +1665,7 @@ const
                  { check C cdecl para types }
                  { check C cdecl para types }
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
                end;
             end;
             end;
           pocall_cppdecl :
           pocall_cppdecl :
@@ -1680,7 +1678,7 @@ const
                  { check C cdecl para types }
                  { check C cdecl para types }
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
                end;
             end;
             end;
           pocall_stdcall :
           pocall_stdcall :
@@ -1688,7 +1686,7 @@ const
               if (pd.deftype=procdef) then
               if (pd.deftype=procdef) then
                begin
                begin
                  { Adjust alignment to match cdecl or stdcall }
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
                end;
             end;
             end;
           pocall_compilerproc :
           pocall_compilerproc :
@@ -1700,7 +1698,7 @@ const
           pocall_register :
           pocall_register :
             begin
             begin
               { Adjust alignment to match cdecl or stdcall }
               { Adjust alignment to match cdecl or stdcall }
-              pd.parast.dataalignment:=std_param_align;
+              pd.paraalign:=std_param_align;
             end;
             end;
           pocall_far16 :
           pocall_far16 :
             begin
             begin
@@ -1712,7 +1710,7 @@ const
               if (pd.deftype=procdef) then
               if (pd.deftype=procdef) then
                begin
                begin
                  { Adjust positions of args for cdecl or stdcall }
                  { Adjust positions of args for cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
                end;
             end;
             end;
           pocall_inline :
           pocall_inline :
@@ -1772,6 +1770,21 @@ const
         { insert funcret parameter if required }
         { insert funcret parameter if required }
         insert_funcret_para(pd);
         insert_funcret_para(pd);
 
 
+        currpara:=tparaitem(pd.para.first);
+        while assigned(currpara) do
+         begin
+           if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
+             internalerror(200304232);
+           { connect parasym to paraitem }
+           tvarsym(currpara.parasym).paraitem:=currpara;
+           { Need a local copy? }
+           if (currpara.paratyp=vs_value) and
+              paramanager.push_addr_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) then
+             include(tvarsym(currpara.parasym).varoptions,vo_has_local_copy);
+           currpara:=tparaitem(currpara.next);
+         end;
+
+(*
 {$ifdef i386}
 {$ifdef i386}
         { Move first 3 register parameters in localst }
         { Move first 3 register parameters in localst }
         if (pd.deftype=procdef) and
         if (pd.deftype=procdef) and
@@ -1800,7 +1813,6 @@ const
                vs.varoptions:=tvarsym(currpara.parasym).varoptions;
                vs.varoptions:=tvarsym(currpara.parasym).varoptions;
                include(vs.varoptions,vo_is_reg_para);
                include(vs.varoptions,vo_is_reg_para);
                tprocdef(pd).localst.insert(vs);
                tprocdef(pd).localst.insert(vs);
-               tprocdef(pd).localst.insertvardata(vs);
                { update currpara }
                { update currpara }
                currpara.parasym:=vs;
                currpara.parasym:=vs;
                { next }
                { next }
@@ -1808,7 +1820,6 @@ const
                inc(n);
                inc(n);
              end;
              end;
           end;
           end;
-
 {$endif i386}
 {$endif i386}
 
 
         if (pd.deftype=procdef) then
         if (pd.deftype=procdef) then
@@ -1847,6 +1858,7 @@ const
                end;
                end;
             end;
             end;
          end;
          end;
+*)
       end;
       end;
 
 
 
 
@@ -2106,7 +2118,7 @@ const
                      with the new data from the implementation }
                      with the new data from the implementation }
                    hd.forwarddef:=pd.forwarddef;
                    hd.forwarddef:=pd.forwarddef;
                    hd.hasforward:=true;
                    hd.hasforward:=true;
-                   hd.parast.address_fixup:=pd.parast.address_fixup;
+                   hd.paraalign:=pd.paraalign;
                    hd.procoptions:=hd.procoptions+pd.procoptions;
                    hd.procoptions:=hd.procoptions+pd.procoptions;
                    if hd.extnumber=65535 then
                    if hd.extnumber=65535 then
                      hd.extnumber:=pd.extnumber;
                      hd.extnumber:=pd.extnumber;
@@ -2205,7 +2217,12 @@ const
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.134  2003-09-16 16:17:01  peter
+  Revision 1.135  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.134  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.133  2003/09/09 21:03:17  peter
   Revision 1.133  2003/09/09 21:03:17  peter

+ 39 - 26
compiler/pdecvar.pas

@@ -40,10 +40,12 @@ implementation
        systems,
        systems,
        { symtable }
        { symtable }
        symconst,symbase,symtype,symdef,symsym,symtable,defutil,
        symconst,symbase,symtype,symdef,symsym,symtable,defutil,
-       fmodule,paramgr,
+       fmodule,
        { pass 1 }
        { pass 1 }
        node,
        node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
+       { codegen }
+       ncgutil,
        { parser }
        { parser }
        scanner,
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,
        pbase,pexpr,ptype,ptconst,pdecsub,
@@ -89,12 +91,19 @@ implementation
                   begin
                   begin
                      vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
                      vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
                      symtablestack.defowner.owner.insert(vs2);
                      symtablestack.defowner.owner.insert(vs2);
-                     symtablestack.defowner.owner.insertvardata(vs2);
+                     insertbssdata(vs2);
                   end
                   end
                 else
                 else
                   begin
                   begin
                     { external data is not possible here }
                     { external data is not possible here }
-                    symtablestack.insertvardata(vs);
+                    case symtablestack.symtabletype of
+                      globalsymtable,
+                      staticsymtable :
+                        insertbssdata(vs);
+                      recordsymtable,
+                      objectsymtable :
+                        tabstractrecordsymtable(symtablestack).insertfield(vs,false);
+                    end;
                   end;
                   end;
                 vs:=tvarsym(vs.listnext);
                 vs:=tvarsym(vs.listnext);
              end;
              end;
@@ -126,7 +135,7 @@ implementation
          vs,vs2    : tvarsym;
          vs,vs2    : tvarsym;
          srsym : tsym;
          srsym : tsym;
          srsymtable : tsymtable;
          srsymtable : tsymtable;
-         unionsymtable : tsymtable;
+         unionsymtable : trecordsymtable;
          offset : longint;
          offset : longint;
          uniondef : trecorddef;
          uniondef : trecorddef;
          unionsym : tvarsym;
          unionsym : tvarsym;
@@ -265,7 +274,7 @@ implementation
                    abssym.fileinfo:=vs.fileinfo;
                    abssym.fileinfo:=vs.fileinfo;
                    abssym.abstyp:=toaddr;
                    abssym.abstyp:=toaddr;
                    abssym.absseg:=false;
                    abssym.absseg:=false;
-                   abssym.address:=tordconstnode(pt).value;
+                   abssym.fieldoffset:=tordconstnode(pt).value;
                    if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
                    if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
                       try_to_consume(_COLON) then
                       try_to_consume(_COLON) then
                     begin
                     begin
@@ -273,7 +282,7 @@ implementation
                       pt:=expr;
                       pt:=expr;
                       if is_constintnode(pt) then
                       if is_constintnode(pt) then
                         begin
                         begin
-                          abssym.address:=abssym.address shl 4+tordconstnode(pt).value;
+                          abssym.fieldoffset:=abssym.fieldoffset shl 4+tordconstnode(pt).value;
                           abssym.absseg:=true;
                           abssym.absseg:=true;
                         end
                         end
                       else
                       else
@@ -316,7 +325,7 @@ implementation
                      tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
                      tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
                      vs.defaultconstsym:=tconstsym;
                      vs.defaultconstsym:=tconstsym;
                      symtablestack.insert(tconstsym);
                      symtablestack.insert(tconstsym);
-                     symtablestack.insertconstdata(tconstsym);
+                     insertconstdata(tconstsym);
                      readtypedconst(tt,tconstsym,false);
                      readtypedconst(tt,tconstsym,false);
                    end
                    end
                   else
                   else
@@ -325,7 +334,7 @@ implementation
                      tconstsym.fileinfo:=vs.fileinfo;
                      tconstsym.fileinfo:=vs.fileinfo;
                      symtablestack.replace(vs,tconstsym);
                      symtablestack.replace(vs,tconstsym);
                      vs.free;
                      vs.free;
-                     symtablestack.insertconstdata(tconstsym);
+                     insertconstdata(tconstsym);
                      consume(_EQUAL);
                      consume(_EQUAL);
                      readtypedconst(tt,tconstsym,true);
                      readtypedconst(tt,tconstsym,true);
                      symdone:=true;
                      symdone:=true;
@@ -424,8 +433,8 @@ implementation
                    if extern_var then
                    if extern_var then
                     include(vs.varoptions,vo_is_external);
                     include(vs.varoptions,vo_is_external);
                    { insert in the datasegment when it is not external }
                    { insert in the datasegment when it is not external }
-                   if not extern_var then
-                     symtablestack.insertvardata(vs);
+                   if (not extern_var) then
+                     insertbssdata(vs);
                    { now we can insert it in the import lib if its a dll, or
                    { now we can insert it in the import lib if its a dll, or
                      add it to the externals }
                      add it to the externals }
                    if extern_var then
                    if extern_var then
@@ -515,8 +524,7 @@ implementation
                   read_type(casetype,'');
                   read_type(casetype,'');
                   symtablestack:=oldsymtablestack;
                   symtablestack:=oldsymtablestack;
                   vs:=tvarsym.create(sorg,vs_value,casetype);
                   vs:=tvarsym.create(sorg,vs_value,casetype);
-                  symtablestack.insert(vs);
-                  symtablestack.insertvardata(vs);
+                  tabstractrecordsymtable(symtablestack).insertfield(vs,true);
                 end;
                 end;
               if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
               if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
                Message(type_e_ordinal_expr_expected);
                Message(type_e_ordinal_expr_expected);
@@ -529,9 +537,9 @@ implementation
               if assigned(symtablestack.defowner) then
               if assigned(symtablestack.defowner) then
                 Uniondef.owner:=symtablestack.defowner.owner;
                 Uniondef.owner:=symtablestack.defowner.owner;
               registerdef:=true;
               registerdef:=true;
+              startvarrecsize:=UnionSymtable.datasize;
+              startvarrecalign:=UnionSymtable.dataalignment;
               symtablestack:=UnionSymtable;
               symtablestack:=UnionSymtable;
-              startvarrecsize:=symtablestack.datasize;
-              startvarrecalign:=symtablestack.dataalignment;
               repeat
               repeat
                 repeat
                 repeat
                   pt:=comp_expr(true);
                   pt:=comp_expr(true);
@@ -552,19 +560,19 @@ implementation
                 dec(variantrecordlevel);
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
                 consume(_RKLAMMER);
                 { calculates maximal variant size }
                 { calculates maximal variant size }
-                maxsize:=max(maxsize,symtablestack.datasize);
-                maxalignment:=max(maxalignment,symtablestack.dataalignment);
+                maxsize:=max(maxsize,unionsymtable.datasize);
+                maxalignment:=max(maxalignment,unionsymtable.dataalignment);
                 { the items of the next variant are overlayed }
                 { the items of the next variant are overlayed }
-                symtablestack.datasize:=startvarrecsize;
-                symtablestack.dataalignment:=startvarrecalign;
+                unionsymtable.datasize:=startvarrecsize;
+                unionsymtable.dataalignment:=startvarrecalign;
                 if (token<>_END) and (token<>_RKLAMMER) then
                 if (token<>_END) and (token<>_RKLAMMER) then
                   consume(_SEMICOLON)
                   consume(_SEMICOLON)
                 else
                 else
                   break;
                   break;
               until (token=_END) or (token=_RKLAMMER);
               until (token=_END) or (token=_RKLAMMER);
               { at last set the record size to that of the biggest variant }
               { at last set the record size to that of the biggest variant }
-              symtablestack.datasize:=maxsize;
-              symtablestack.dataalignment:=maxalignment;
+              unionsymtable.datasize:=maxsize;
+              unionsymtable.dataalignment:=maxalignment;
               uniontype.def:=uniondef;
               uniontype.def:=uniondef;
               uniontype.sym:=nil;
               uniontype.sym:=nil;
               UnionSym:=tvarsym.create('$case',vs_value,uniontype);
               UnionSym:=tvarsym.create('$case',vs_value,uniontype);
@@ -590,11 +598,11 @@ implementation
               else
               else
                minalignment:=maxalignment;
                minalignment:=maxalignment;
               usedalign:=used_align(maxalignment,minalignment,maxalignment);
               usedalign:=used_align(maxalignment,minalignment,maxalignment);
-              offset:=align(symtablestack.datasize,usedalign);
-              symtablestack.datasize:=offset+unionsymtable.datasize;
-              if maxalignment>symtablestack.dataalignment then
-                symtablestack.dataalignment:=maxalignment;
-              trecordsymtable(Unionsymtable).Insert_in(symtablestack,offset);
+              offset:=align(trecordsymtable(symtablestack).datasize,usedalign);
+              trecordsymtable(symtablestack).datasize:=offset+unionsymtable.datasize;
+              if maxalignment>trecordsymtable(symtablestack).dataalignment then
+                trecordsymtable(symtablestack).dataalignment:=maxalignment;
+              Unionsymtable.Insert_in(trecordsymtable(symtablestack),offset);
               Unionsym.owner:=nil;
               Unionsym.owner:=nil;
               unionsym.free;
               unionsym.free;
               uniondef.owner:=nil;
               uniondef.owner:=nil;
@@ -609,7 +617,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.50  2003-09-07 14:14:51  florian
+  Revision 1.51  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.50  2003/09/07 14:14:51  florian
     * proper error recovering from invalid published fields
     * proper error recovering from invalid published fields
 
 
   Revision 1.49  2003/09/05 17:41:12  florian
   Revision 1.49  2003/09/05 17:41:12  florian

+ 6 - 4
compiler/pexpr.pas

@@ -734,9 +734,6 @@ implementation
                    if not currpara.is_hidden then
                    if not currpara.is_hidden then
                     begin
                     begin
                       vs:=tvarsym(currpara.parasym);
                       vs:=tvarsym(currpara.parasym);
-                      { if there is a localcopy then use that }
-                      if assigned(vs.localvarsym) then
-                        vs:=vs.localvarsym;
                       para:=ccallparanode.create(cloadnode.create(vs,vs.owner),para);
                       para:=ccallparanode.create(cloadnode.create(vs,vs.owner),para);
                     end;
                     end;
                    currpara:=tparaitem(currpara.next);
                    currpara:=tparaitem(currpara.next);
@@ -2419,7 +2416,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.128  2003-09-06 22:27:09  florian
+  Revision 1.129  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.128  2003/09/06 22:27:09  florian
     * fixed web bug 2669
     * fixed web bug 2669
     * cosmetic fix in printnode
     * cosmetic fix in printnode
     * tobjectdef.gettypename implemented
     * tobjectdef.gettypename implemented

+ 7 - 2
compiler/pinline.pas

@@ -60,7 +60,7 @@ implementation
        scanner,
        scanner,
        pbase,pexpr,
        pbase,pexpr,
        { codegen }
        { codegen }
-       tgobj,cgbase
+       cginfo,cgbase
        ;
        ;
 
 
 
 
@@ -685,7 +685,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.17  2003-08-21 15:10:51  peter
+  Revision 1.18  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.17  2003/08/21 15:10:51  peter
     * fixed copy support for array of char,pchar in $H+ mode
     * fixed copy support for array of char,pchar in $H+ mode
     * fixed copy support for pwidechar,array of widechar
     * fixed copy support for pwidechar,array of widechar
 
 

+ 22 - 8
compiler/pmodules.pas

@@ -41,7 +41,7 @@ implementation
        symconst,symbase,symtype,symdef,symsym,symtable,
        symconst,symbase,symtype,symdef,symsym,symtable,
        aasmbase,aasmtai,aasmcpu,
        aasmbase,aasmtai,aasmcpu,
        cgbase,cpuinfo,cgobj,
        cgbase,cpuinfo,cgobj,
-       ncgutil,
+       nbas,ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr,cpubase,
        cresstr,cpubase,
 {$ifdef GDB}
 {$ifdef GDB}
@@ -726,8 +726,6 @@ implementation
         current_procinfo:=cprocinfo.create(nil);
         current_procinfo:=cprocinfo.create(nil);
         current_module.procinfo:=current_procinfo;
         current_module.procinfo:=current_procinfo;
         current_procinfo.procdef:=pd;
         current_procinfo.procdef:=pd;
-        { start register allocator }
-        cg.init_register_allocators;
         { return procdef }
         { return procdef }
         create_main_proc:=pd;
         create_main_proc:=pd;
       end;
       end;
@@ -740,8 +738,6 @@ implementation
            assigned(current_procinfo.parent) or
            assigned(current_procinfo.parent) or
            not(current_procinfo.procdef=pd) then
            not(current_procinfo.procdef=pd) then
          internalerror(200304276);
          internalerror(200304276);
-        { remove register allocator }
-        cg.done_register_allocators;
         { remove procinfo }
         { remove procinfo }
         current_module.procinfo:=nil;
         current_module.procinfo:=nil;
         current_procinfo.free;
         current_procinfo.free;
@@ -778,6 +774,13 @@ implementation
           else
           else
             internalerror(200304253);
             internalerror(200304253);
         end;
         end;
+        tcgprocinfo(current_procinfo).code:=cnothingnode.create;
+        add_entry_exit_code(tcgprocinfo(current_procinfo).code,aktfilepos,aktfilepos);
+        tcgprocinfo(current_procinfo).generate_code;
+(*
+        { start register allocator and temp gen }
+        cg.init_register_allocators;
+        tg:=ttgobj.create;
         include(current_procinfo.flags,pi_do_call);
         include(current_procinfo.flags,pi_do_call);
         { generate symbol and save end of header position }
         { generate symbol and save end of header position }
         gen_proc_symbol(templist);
         gen_proc_symbol(templist);
@@ -800,8 +803,14 @@ implementation
         list.insertlistafter(headertai,templist);
         list.insertlistafter(headertai,templist);
         { Add exit code at the end }
         { Add exit code at the end }
         gen_exit_code(list,false,usesacc,usesacchi);
         gen_exit_code(list,false,usesacc,usesacchi);
+        { release }
+        cg.done_register_allocators;
+        tg.free;
+        rg:=nil;
+        tg:=nil;
         release_main_proc(pd);
         release_main_proc(pd);
         templist.free;
         templist.free;
+*)
       end;
       end;
 
 
 
 
@@ -1093,7 +1102,7 @@ implementation
            end;
            end;
 
 
          { size of the static data }
          { size of the static data }
-         datasize:=st.datasize;
+//         datasize:=st.datasize;
 
 
 {$ifdef GDB}
 {$ifdef GDB}
          { add all used definitions even for implementation}
          { add all used definitions even for implementation}
@@ -1424,7 +1433,7 @@ implementation
          insertheap;
          insertheap;
          insertstacklength;
          insertstacklength;
 
 
-         datasize:=symtablestack.datasize;
+//         datasize:=symtablestack.datasize;
 
 
          { finish asmlist by adding segment starts }
          { finish asmlist by adding segment starts }
          insertsegment;
          insertsegment;
@@ -1471,7 +1480,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.124  2003-09-09 20:59:27  daniel
+  Revision 1.125  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.124  2003/09/09 20:59:27  daniel
     * Adding register allocation order
     * Adding register allocation order
 
 
   Revision 1.123  2003/09/09 15:55:44  peter
   Revision 1.123  2003/09/09 15:55:44  peter

+ 7 - 2
compiler/ppu.pas

@@ -41,7 +41,7 @@ type
 {$endif Test_Double_checksum}
 {$endif Test_Double_checksum}
 
 
 const
 const
-  CurrentPPUVersion=36;
+  CurrentPPUVersion=37;
 
 
 { buffer sizes }
 { buffer sizes }
   maxentrysize = 1024;
   maxentrysize = 1024;
@@ -985,7 +985,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.41  2003-07-05 20:06:28  jonas
+  Revision 1.42  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.41  2003/07/05 20:06:28  jonas
     * fixed some range check errors that occurred on big endian systems
     * fixed some range check errors that occurred on big endian systems
     * slightly optimized the swap*() functions
     * slightly optimized the swap*() functions
 
 

+ 39 - 98
compiler/pstatmnt.pas

@@ -25,6 +25,7 @@ unit pstatmnt;
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
 
 
 interface
 interface
+
     uses
     uses
       tokens,node;
       tokens,node;
 
 
@@ -39,7 +40,7 @@ implementation
 
 
     uses
     uses
        { common }
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        { global }
        globtype,globals,verbose,
        globtype,globals,verbose,
        systems,cpuinfo,
        systems,cpuinfo,
@@ -1048,77 +1049,19 @@ implementation
       end;
       end;
 
 
 
 
-    function assembler_block : tnode;
-
-      {# Optimize the assembler block by removing all references
-         which are via the frame pointer by replacing them with
-         references via the stack pointer.
-
-         This is only available to certain cpu targets where
-         the frame pointer saving must be done explicitly.
-      }
-      procedure OptimizeFramePointer(p:tasmnode);
-      var
-        hp : tai;
-        parafixup,
-        i : longint;
+    procedure count_locals(p:tnamedindexitem;arg:pointer);
       begin
       begin
-        { replace framepointer with stackpointer }
-        current_procinfo.framepointer:=NR_STACK_POINTER_REG;
-        { set the right value for parameters }
-        dec(current_procinfo.procdef.parast.address_fixup,pointer_size);
-        { replace all references to parameters in the instructions,
-          the parameters can be identified by the parafixup option
-          that is set. For normal user coded [ebp+4] this field is not
-          set }
-        parafixup:=current_procinfo.procdef.parast.address_fixup;
-        hp:=tai(p.p_asm.first);
-        while assigned(hp) do
-         begin
-           if hp.typ=ait_instruction then
-            begin
-              { fixup the references }
-              for i:=1 to taicpu(hp).ops do
-               begin
-                 with taicpu(hp).oper[i-1] do
-                  if typ=top_ref then
-                   begin
-                     case ref^.options of
-                       ref_parafixup :
-                         begin
-                           ref^.offsetfixup:=parafixup;
-                           ref^.base:=NR_STACK_POINTER_REG;
-                         end;
-                     end;
-                   end;
-               end;
-            end;
-           hp:=tai(hp.next);
-         end;
+        { Count only varsyms, but ignore the funcretsym }
+        if (tsym(p).typ=varsym) and
+           (tsym(p)<>current_procinfo.procdef.funcretsym) then
+          inc(plongint(arg)^);
       end;
       end;
 
 
-{$ifdef CHECKFORPUSH}
-      function UsesPush(p:tasmnode):boolean;
-      var
-        hp : tai;
-      begin
-        hp:=tai(p.p_asm.first);
-        while assigned(hp) do
-         begin
-           if (hp.typ=ait_instruction) and
-              (taicpu(hp).opcode=A_PUSH) then
-            begin
-              UsesPush:=true;
-              exit;
-            end;
-           hp:=tai(hp.next);
-         end;
-        UsesPush:=false;
-      end;
-{$endif CHECKFORPUSH}
 
 
+    function assembler_block : tnode;
       var
       var
         p : tnode;
         p : tnode;
+        locals : longint;
       begin
       begin
          { Rename the funcret so that recursive calls are possible }
          { Rename the funcret so that recursive calls are possible }
          if not is_void(current_procinfo.procdef.rettype.def) then
          if not is_void(current_procinfo.procdef.rettype.def) then
@@ -1136,37 +1079,30 @@ implementation
            current_procinfo.procdef.proccalloption:=pocall_stdcall;
            current_procinfo.procdef.proccalloption:=pocall_stdcall;
 
 
 {$ifndef sparc}
 {$ifndef sparc}
-         { set the framepointer to esp for assembler functions when the
-           following conditions are met:
-           - if the are no local variables (except the allocated result)
-           - if the are no parameters
-           - no reference to the result variable (refcount<=1)
-           - result is not stored as parameter
-           - target processor has optional frame pointer save
-             (vm, i386, vm only currently)
-         }
-         if (po_assembler in current_procinfo.procdef.procoptions) and
-{$ifndef powerpc}
-            { is this really necessary??? }
-            (current_procinfo.procdef.parast.datasize=0) and
-{$endif powerpc}
-            (current_procinfo.procdef.localst.datasize=current_procinfo.procdef.rettype.def.size) and
-            (current_procinfo.procdef.owner.symtabletype<>objectsymtable) and
-            (not assigned(current_procinfo.procdef.funcretsym) or
-             (tvarsym(current_procinfo.procdef.funcretsym).refcount<=1)) and
-            not(paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption)) then
-            begin
-               { we don't need to allocate space for the locals }
-               current_procinfo.procdef.localst.datasize:=0;
-               current_procinfo.firsttemp_offset:=0;
-               { only for cpus with different frame- and stack pointer the code must be changed }
-               if (NR_STACK_POINTER_REG<>NR_FRAME_POINTER_REG)
-{$ifdef CHECKFORPUSH}
-                 and not(UsesPush(tasmnode(p)))
-{$endif CHECKFORPUSH}
-                 then
-                 OptimizeFramePointer(tasmnode(p));
-            end;
+         if (po_assembler in current_procinfo.procdef.procoptions) then
+           begin
+             { set the framepointer to esp for assembler functions when the
+               following conditions are met:
+               - if the are no local variables and parameters (except the allocated result)
+               - no reference to the result variable (refcount<=1)
+               - result is not stored as parameter
+               - target processor has optional frame pointer save
+                 (vm, i386, vm only currently)
+             }
+             locals:=0;
+             current_procinfo.procdef.localst.foreach_static({$ifdef FPCPROCVAR}@{$endif}count_locals,@locals);
+             current_procinfo.procdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}count_locals,@locals);
+             if (locals=0) and
+                (current_procinfo.procdef.owner.symtabletype<>objectsymtable) and
+                (not assigned(current_procinfo.procdef.funcretsym) or
+                 (tvarsym(current_procinfo.procdef.funcretsym).refcount<=1)) and
+                not(paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption)) then
+               begin
+                 { Only need to set the framepointer, the locals will
+                   be inserted with the correct reference in tcgasmnode.pass_2 }
+                 current_procinfo.framepointer:=NR_STACK_POINTER_REG;
+               end;
+           end;
 {$endif sparc}
 {$endif sparc}
 
 
         { Flag the result as assigned when it is returned in a
         { Flag the result as assigned when it is returned in a
@@ -1186,7 +1122,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.109  2003-09-16 16:17:01  peter
+  Revision 1.110  2003-09-23 17:56:05  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.109  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.108  2003/09/07 22:09:35  peter
   Revision 1.108  2003/09/07 22:09:35  peter

+ 38 - 40
compiler/psub.pas

@@ -29,7 +29,7 @@ unit psub;
 interface
 interface
 
 
     uses
     uses
-      cclasses,
+      cclasses,globals,
       node,
       node,
       symdef,cgbase;
       symdef,cgbase;
 
 
@@ -60,6 +60,8 @@ interface
     { reads declarations in the interface part of a unit }
     { reads declarations in the interface part of a unit }
     procedure read_interface_declarations;
     procedure read_interface_declarations;
 
 
+    procedure add_entry_exit_code(var code:tnode;const entrypos,exitpos:tfileposinfo);
+
 
 
 implementation
 implementation
 
 
@@ -67,7 +69,7 @@ implementation
        { common }
        { common }
        cutils,
        cutils,
        { global }
        { global }
-       globtype,globals,tokens,verbose,comphook,
+       globtype,tokens,verbose,comphook,
        systems,
        systems,
        { aasm }
        { aasm }
        cpubase,cpuinfo,aasmbase,aasmtai,
        cpubase,cpuinfo,aasmbase,aasmtai,
@@ -574,7 +576,6 @@ implementation
 
 
     procedure tcgprocinfo.generate_code;
     procedure tcgprocinfo.generate_code;
       var
       var
-        oldrg : trgobj;
         oldprocinfo : tprocinfo;
         oldprocinfo : tprocinfo;
         oldaktmaxfpuregisters : longint;
         oldaktmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
         oldfilepos : tfileposinfo;
@@ -592,8 +593,11 @@ implementation
         if not assigned(code) then
         if not assigned(code) then
           exit;
           exit;
 
 
+        { The RA and Tempgen shall not be available yet }
+        if assigned(rg) or assigned(tg) then
+          internalerror(200309201);
+
         oldprocinfo:=current_procinfo;
         oldprocinfo:=current_procinfo;
-        oldrg:=rg;
         oldfilepos:=aktfilepos;
         oldfilepos:=aktfilepos;
         oldaktmaxfpuregisters:=aktmaxfpuregisters;
         oldaktmaxfpuregisters:=aktmaxfpuregisters;
 
 
@@ -608,11 +612,20 @@ implementation
         add_to_symtablestack;
         add_to_symtablestack;
 
 
         { set the start offset to the start of the temp area in the stack }
         { set the start offset to the start of the temp area in the stack }
-        tg.setfirsttemp(firsttemp_offset);
+        tg:=ttgobj.create;
+//        tg.setfirsttemp(firsttemp_offset);
 
 
         { Create register allocator }
         { Create register allocator }
         cg.init_register_allocators;
         cg.init_register_allocators;
 
 
+        { generate callee paraloc register info }
+        paramanager.create_paraloc_info(current_procinfo.procdef,calleeside);
+
+        { Allocate space in temp/registers for parast and localst }
+        gen_alloc_parast(aktproccode,tparasymtable(current_procinfo.procdef.parast));
+        if current_procinfo.procdef.localst.symtabletype=localsymtable then
+          gen_alloc_localst(aktproccode,tlocalsymtable(current_procinfo.procdef.localst));
+
 {$warning FIXME!!}
 {$warning FIXME!!}
         { FIXME!! If a procedure contains assembler blocks (or is pure assembler), }
         { FIXME!! If a procedure contains assembler blocks (or is pure assembler), }
         { then rg.used_in_proc_int already contains info because of that. However, }
         { then rg.used_in_proc_int already contains info because of that. However, }
@@ -679,6 +692,12 @@ implementation
         { insert symbol and entry code }
         { insert symbol and entry code }
         aktproccode.insertlist(templist);
         aktproccode.insertlist(templist);
 
 
+        { Free space in temp/registers for parast and localst, must be
+          done after gen_entry_code }
+        if current_procinfo.procdef.localst.symtabletype=localsymtable then
+          gen_free_localst(aktproccode,tlocalsymtable(current_procinfo.procdef.localst));
+        gen_free_parast(aktproccode,tparasymtable(current_procinfo.procdef.parast));
+
         { The procedure body is finished, we can now
         { The procedure body is finished, we can now
           allocate the registers }
           allocate the registers }
         if not(cs_no_regalloc in aktglobalswitches) then
         if not(cs_no_regalloc in aktglobalswitches) then
@@ -748,13 +767,17 @@ implementation
         { only now we can remove the temps }
         { only now we can remove the temps }
         tg.resettempgen;
         tg.resettempgen;
 
 
+        { stop tempgen and ra }
+        tg.free;
+        cg.done_register_allocators;
+        tg:=nil;
+        rg:=nil;
+
         { restore symtablestack }
         { restore symtablestack }
         remove_from_symtablestack;
         remove_from_symtablestack;
 
 
         { restore }
         { restore }
-        cg.done_register_allocators;
         templist.free;
         templist.free;
-        rg:=oldrg;
         aktmaxfpuregisters:=oldaktmaxfpuregisters;
         aktmaxfpuregisters:=oldaktmaxfpuregisters;
         aktfilepos:=oldfilepos;
         aktfilepos:=oldfilepos;
         current_procinfo:=oldprocinfo;
         current_procinfo:=oldprocinfo;
@@ -950,38 +973,6 @@ implementation
                         PROCEDURE/FUNCTION PARSING
                         PROCEDURE/FUNCTION PARSING
 ****************************************************************************}
 ****************************************************************************}
 
 
-    procedure insert_local_value_para(p:tnamedindexitem;arg:pointer);
-      var
-        vs : tvarsym;
-        pd : tprocdef;
-      begin
-        if tsym(p).typ<>varsym then
-         exit;
-        with tvarsym(p) do
-         begin
-           if copy(name,1,3)='val' then
-            begin
-              pd:=tprocdef(owner.defowner);
-              vs:=tvarsym.create(Copy(name,4,255),varspez,vartype);
-              vs.fileinfo:=fileinfo;
-              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;
-           if is_shortstring(vartype.def) and
-              (varspez = vs_value) then
-             include(current_procinfo.flags,pi_do_call);
-         end;
-      end;
-
-
     procedure check_init_paras(p:tnamedindexitem;arg:pointer);
     procedure check_init_paras(p:tnamedindexitem;arg:pointer);
       begin
       begin
         if tsym(p).typ<>varsym then
         if tsym(p).typ<>varsym then
@@ -1117,8 +1108,10 @@ implementation
              { Insert result variables in the localst }
              { Insert result variables in the localst }
              insert_funcret_local(pd);
              insert_funcret_local(pd);
 
 
+(*
              { Insert local copies for value para }
              { Insert local copies for value para }
              pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
              pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
+*)
 
 
              { check if there are para's which require initing -> set }
              { check if there are para's which require initing -> set }
              { pi_do_call (if not yet set)                            }
              { pi_do_call (if not yet set)                            }
@@ -1302,7 +1295,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.148  2003-09-14 19:18:10  peter
+  Revision 1.149  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.148  2003/09/14 19:18:10  peter
     * remove obsolete code already in comments
     * remove obsolete code already in comments
 
 
   Revision 1.147  2003/09/14 12:58:00  peter
   Revision 1.147  2003/09/14 12:58:00  peter

+ 12 - 7
compiler/psystem.pas

@@ -198,12 +198,12 @@ implementation
         hrecst:=trecordsymtable.create;
         hrecst:=trecordsymtable.create;
         vmttype.setdef(trecorddef.create(hrecst));
         vmttype.setdef(trecorddef.create(hrecst));
         pvmttype.setdef(tpointerdef.create(vmttype));
         pvmttype.setdef(tpointerdef.create(vmttype));
-        hrecst.insertfield(tvarsym.create('$parent',vs_value,pvmttype));
-        hrecst.insertfield(tvarsym.create('$length',vs_value,s32bittype));
-        hrecst.insertfield(tvarsym.create('$mlength',vs_value,s32bittype));
+        hrecst.insertfield(tvarsym.create('$parent',vs_value,pvmttype),true);
+        hrecst.insertfield(tvarsym.create('$length',vs_value,s32bittype),true);
+        hrecst.insertfield(tvarsym.create('$mlength',vs_value,s32bittype),true);
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
         tarraydef(vmtarraytype.def).setelementtype(voidpointertype);
         tarraydef(vmtarraytype.def).setelementtype(voidpointertype);
-        hrecst.insertfield(tvarsym.create('$__pfn',vs_value,vmtarraytype));
+        hrecst.insertfield(tvarsym.create('$__pfn',vs_value,vmtarraytype),true);
         addtype('$__vtbl_ptr_type',vmttype);
         addtype('$__vtbl_ptr_type',vmttype);
         addtype('$pvmt',pvmttype);
         addtype('$pvmt',pvmttype);
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
@@ -211,8 +211,8 @@ implementation
         addtype('$vtblarray',vmtarraytype);
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
         { Add a type for methodpointers }
         hrecst:=trecordsymtable.create;
         hrecst:=trecordsymtable.create;
-        hrecst.insertfield(tvarsym.create('$proc',vs_value,voidpointertype));
-        hrecst.insertfield(tvarsym.create('$self',vs_value,voidpointertype));
+        hrecst.insertfield(tvarsym.create('$proc',vs_value,voidpointertype),true);
+        hrecst.insertfield(tvarsym.create('$self',vs_value,voidpointertype),true);
         methodpointertype.setdef(trecorddef.create(hrecst));
         methodpointertype.setdef(trecorddef.create(hrecst));
         addtype('$methodpointer',methodpointertype);
         addtype('$methodpointer',methodpointertype);
       { Add functions that require compiler magic }
       { Add functions that require compiler magic }
@@ -504,7 +504,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.54  2003-09-03 11:18:37  florian
+  Revision 1.55  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.54  2003/09/03 11:18:37  florian
     * fixed arm concatcopy
     * fixed arm concatcopy
     + arm support in the common compiler sources added
     + arm support in the common compiler sources added
     * moved some generic cg code around
     * moved some generic cg code around

+ 19 - 14
compiler/ptconst.pas

@@ -386,7 +386,7 @@ implementation
                                      Message(cg_e_illegal_expression);
                                      Message(cg_e_illegal_expression);
                                  end;
                                  end;
                                subscriptn :
                                subscriptn :
-                                 inc(offset,tsubscriptnode(hp).vs.address)
+                                 inc(offset,tsubscriptnode(hp).vs.fieldoffset)
                                else
                                else
                                  Message(cg_e_illegal_expression);
                                  Message(cg_e_illegal_expression);
                              end;
                              end;
@@ -805,7 +805,7 @@ implementation
                             { Also allow jumping from one variant part to another, }
                             { Also allow jumping from one variant part to another, }
                             { as long as the offsets match                         }
                             { as long as the offsets match                         }
                             if (assigned(srsym) and
                             if (assigned(srsym) and
-                                (tvarsym(recsym).address = tvarsym(srsym).address)) or
+                                (tvarsym(recsym).fieldoffset = tvarsym(srsym).fieldoffset)) or
                                { srsym is not assigned after parsing w2 in the      }
                                { srsym is not assigned after parsing w2 in the      }
                                { typed const in the next example:                   }
                                { typed const in the next example:                   }
                                {   type tr = record case byte of                    }
                                {   type tr = record case byte of                    }
@@ -813,10 +813,10 @@ implementation
                                {          2: (w1,w2: word);                         }
                                {          2: (w1,w2: word);                         }
                                {        end;                                        }
                                {        end;                                        }
                                {   const r: tr = (w1:1;w2:1;l2:5);                  }
                                {   const r: tr = (w1:1;w2:1;l2:5);                  }
-                               (tvarsym(recsym).address = aktpos) then
+                               (tvarsym(recsym).fieldoffset = aktpos) then
                               srsym := recsym
                               srsym := recsym
                             { going backwards isn't allowed in any mode }
                             { going backwards isn't allowed in any mode }
-                            else if (tvarsym(recsym).address<aktpos) then
+                            else if (tvarsym(recsym).fieldoffset<aktpos) then
                               begin
                               begin
                                 Message(parser_e_invalid_record_const);
                                 Message(parser_e_invalid_record_const);
                                 error := true;
                                 error := true;
@@ -840,12 +840,12 @@ implementation
                           begin
                           begin
 
 
                             { if needed fill (alignment) }
                             { if needed fill (alignment) }
-                            if tvarsym(srsym).address>aktpos then
-                               for i:=1 to tvarsym(srsym).address-aktpos do
+                            if tvarsym(srsym).fieldoffset>aktpos then
+                               for i:=1 to tvarsym(srsym).fieldoffset-aktpos do
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
 
 
                              { new position }
                              { new position }
-                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
+                             aktpos:=tvarsym(srsym).fieldoffset+tvarsym(srsym).vartype.def.size;
 
 
                              { read the data }
                              { read the data }
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
@@ -867,7 +867,7 @@ implementation
                     { don't complain if there only come other variant parts }
                     { don't complain if there only come other variant parts }
                     { after the last initialized field                      }
                     { after the last initialized field                      }
                     ((recsym=nil) or
                     ((recsym=nil) or
-                     (tvarsym(srsym).address > tvarsym(recsym).address)) then
+                     (tvarsym(srsym).fieldoffset > tvarsym(recsym).fieldoffset)) then
                    Message1(parser_w_skipped_fields_after,sorg);
                    Message1(parser_w_skipped_fields_after,sorg);
 
 
                  for i:=1 to t.def.size-aktpos do
                  for i:=1 to t.def.size-aktpos do
@@ -929,13 +929,13 @@ implementation
                         else
                         else
                           begin
                           begin
                              { check position }
                              { check position }
-                             if tvarsym(srsym).address<aktpos then
+                             if tvarsym(srsym).fieldoffset<aktpos then
                                Message(parser_e_invalid_record_const);
                                Message(parser_e_invalid_record_const);
 
 
                              { check in VMT needs to be added for TP mode }
                              { check in VMT needs to be added for TP mode }
                              if not(m_fpc in aktmodeswitches) and
                              if not(m_fpc in aktmodeswitches) and
                                 (oo_has_vmt in tobjectdef(t.def).objectoptions) and
                                 (oo_has_vmt in tobjectdef(t.def).objectoptions) and
-                                (tobjectdef(t.def).vmt_offset<tvarsym(srsym).address) then
+                                (tobjectdef(t.def).vmt_offset<tvarsym(srsym).fieldoffset) then
                                begin
                                begin
                                  for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do
                                  for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do
                                    curconstsegment.concat(tai_const.create_8bit(0));
                                    curconstsegment.concat(tai_const.create_8bit(0));
@@ -945,12 +945,12 @@ implementation
                                end;
                                end;
 
 
                              { if needed fill }
                              { if needed fill }
-                             if tvarsym(srsym).address>aktpos then
-                               for i:=1 to tvarsym(srsym).address-aktpos do
+                             if tvarsym(srsym).fieldoffset>aktpos then
+                               for i:=1 to tvarsym(srsym).fieldoffset-aktpos do
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
                                  curconstSegment.concat(Tai_const.Create_8bit(0));
 
 
                              { new position }
                              { new position }
-                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
+                             aktpos:=tvarsym(srsym).fieldoffset+tvarsym(srsym).vartype.def.size;
 
 
                              { read the data }
                              { read the data }
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
@@ -993,7 +993,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.70  2003-09-03 15:55:01  peter
+  Revision 1.71  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.70  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.69  2003/05/09 17:47:03  peter
   Revision 1.69  2003/05/09 17:47:03  peter

+ 7 - 2
compiler/ptype.pas

@@ -242,7 +242,7 @@ implementation
          typecanbeforward:=storetypecanbeforward;
          typecanbeforward:=storetypecanbeforward;
          current_object_option:=old_object_option;
          current_object_option:=old_object_option;
          { may be scale record size to a size of n*4 ? }
          { may be scale record size to a size of n*4 ? }
-         symtablestack.datasize:=align(symtablestack.datasize,symtablestack.dataalignment);
+         trecordsymtable(symtablestack).datasize:=align(trecordsymtable(symtablestack).datasize,trecordsymtable(symtablestack).dataalignment);
          { restore symtable stack }
          { restore symtable stack }
          symtablestack:=symtable.next;
          symtablestack:=symtable.next;
       end;
       end;
@@ -627,7 +627,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.55  2003-05-15 18:58:53  peter
+  Revision 1.56  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.55  2003/05/15 18:58:53  peter
     * removed selfpointer_offset, vmtpointer_offset
     * removed selfpointer_offset, vmtpointer_offset
     * tvarsym.adjusted_address
     * tvarsym.adjusted_address
     * address in localsymtable is now in the real direction
     * address in localsymtable is now in the real direction

+ 23 - 65
compiler/rautils.pas

@@ -29,7 +29,7 @@ Interface
 Uses
 Uses
   cutils,cclasses,
   cutils,cclasses,
   globtype,aasmbase,aasmtai,cpubase,cpuinfo,cginfo,
   globtype,aasmbase,aasmtai,cpubase,cpuinfo,cginfo,
-  symconst,symbase,symtype,symdef;
+  symconst,symbase,symtype,symdef,symsym;
 
 
 Const
 Const
   RPNMax = 10;             { I think you only need 4, but just to be safe }
   RPNMax = 10;             { I think you only need 4, but just to be safe }
@@ -67,7 +67,7 @@ Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
 ---------------------------------------------------------------------}
 ---------------------------------------------------------------------}
 
 
 type
 type
-  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,
+  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
             OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
             OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
 
 
   TOprRec = record
   TOprRec = record
@@ -76,6 +76,7 @@ type
       OPR_CONSTANT  : (val:longint);
       OPR_CONSTANT  : (val:longint);
       OPR_SYMBOL    : (symbol:tasmsymbol;symofs:longint);
       OPR_SYMBOL    : (symbol:tasmsymbol;symofs:longint);
       OPR_REFERENCE : (ref:treference);
       OPR_REFERENCE : (ref:treference);
+      OPR_LOCAL     : (localsym:tvarsym;localsymofs:longint);
       OPR_REGISTER  : (reg:tregister);
       OPR_REGISTER  : (reg:tregister);
 {$ifdef m68k}
 {$ifdef m68k}
       OPR_REGLIST   : (reglist:Tsupregset);
       OPR_REGLIST   : (reglist:Tsupregset);
@@ -215,7 +216,7 @@ uses
   strings,
   strings,
 {$endif}
 {$endif}
   defutil,systems,verbose,globals,
   defutil,systems,verbose,globals,
-  symsym,symtable,paramgr,
+  symtable,paramgr,
   aasmcpu,
   aasmcpu,
   cgbase,tgobj;
   cgbase,tgobj;
 
 
@@ -800,7 +801,7 @@ Begin
             begin
             begin
               { We return the address of the field, just like Delphi/TP }
               { We return the address of the field, just like Delphi/TP }
               opr.typ:=OPR_CONSTANT;
               opr.typ:=OPR_CONSTANT;
-              opr.val:=tvarsym(sym).address;
+              opr.val:=tvarsym(sym).fieldoffset;
               hasvar:=true;
               hasvar:=true;
               SetupVar:=true;
               SetupVar:=true;
               Exit;
               Exit;
@@ -808,71 +809,23 @@ Begin
           globalsymtable,
           globalsymtable,
           staticsymtable :
           staticsymtable :
             opr.ref.symbol:=objectlibrary.newasmsymboldata(tvarsym(sym).mangledname);
             opr.ref.symbol:=objectlibrary.newasmsymboldata(tvarsym(sym).mangledname);
-          parasymtable :
-            begin
-              { if we only want the offset we don't have to care
-                the base will be zeroed after ! }
-              if (tvarsym(sym).owner=current_procinfo.procdef.parast) or
-                GetOffset then
-                begin
-                  opr.ref.base:=current_procinfo.framepointer;
-                end
-              else
-                begin
-                  if (current_procinfo.procdef.localst.datasize=0) and
-                     assigned(current_procinfo.parent) and
-                     (tvarsym(sym).owner=current_procinfo.procdef.parast) and
-                     (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
-                    opr.ref.base:=current_procinfo.parent.framepointer
-                  else
-                    message1(asmr_e_local_para_unreachable,s);
-                end;
-              opr.ref.offset:=tvarsym(sym).address;
-              if (current_procinfo.procdef.parast.symtablelevel=tvarsym(sym).owner.symtablelevel) then
-                begin
-                  opr.ref.offsetfixup:=current_procinfo.procdef.parast.address_fixup;
-                  opr.ref.options:=ref_parafixup;
-                end
-              else
-                begin
-                  opr.ref.offsetfixup:=0;
-                  opr.ref.options:=ref_none;
-                end;
-              if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
-                SetSize(pointer_size,false);
-            end;
+          parasymtable,
           localsymtable :
           localsymtable :
             begin
             begin
               if (vo_is_external in tvarsym(sym).varoptions) then
               if (vo_is_external in tvarsym(sym).varoptions) then
                 opr.ref.symbol:=objectlibrary.newasmsymboldata(tvarsym(sym).mangledname)
                 opr.ref.symbol:=objectlibrary.newasmsymboldata(tvarsym(sym).mangledname)
               else
               else
                 begin
                 begin
-                  { if we only want the offset we don't have to care
-                    the base will be zeroed after ! }
-                  if (tvarsym(sym).owner=current_procinfo.procdef.localst) or
-                     GetOffset then
-                    opr.ref.base:=current_procinfo.framepointer
-                  else
-                    begin
-                      if (current_procinfo.procdef.localst.datasize=0) and
-                         assigned(current_procinfo.parent) and
-                         (tvarsym(sym).owner=current_procinfo.parent.procdef.localst) and
-                         (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
-                        opr.ref.base:=current_procinfo.parent.framepointer
-                      else
-                        message1(asmr_e_local_para_unreachable,s);
-                    end;
-                  opr.ref.offset:=tvarsym(sym).address;
-                  if (current_procinfo.procdef.localst.symtablelevel=tvarsym(sym).owner.symtablelevel) then
-                    begin
-                      opr.ref.offsetfixup:=current_procinfo.procdef.localst.address_fixup;
-                      opr.ref.options:=ref_localfixup;
-                    end
-                  else
-                    begin
-                      opr.ref.offsetfixup:=0;
-                      opr.ref.options:=ref_none;
-                    end;
+                  opr.typ:=OPR_LOCAL;
+                  if assigned(current_procinfo.parent) and
+                     (
+                      (tvarsym(sym).owner<>current_procinfo.procdef.localst) or
+                      (tvarsym(sym).owner<>current_procinfo.procdef.parast)
+                     ) and
+                     (current_procinfo.procdef.localst.symtablelevel>normal_function_level) then
+                    message1(asmr_e_local_para_unreachable,s);
+                  opr.localsym:=tvarsym(sym);
+                  opr.localsymofs:=0;
                 end;
                 end;
               if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
               if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
                 SetSize(pointer_size,false);
                 SetSize(pointer_size,false);
@@ -1333,7 +1286,7 @@ Begin
      case sym.typ of
      case sym.typ of
        varsym :
        varsym :
          begin
          begin
-           inc(Offset,tvarsym(sym).address);
+           inc(Offset,tvarsym(sym).fieldoffset);
            Size:=tvarsym(sym).getsize;
            Size:=tvarsym(sym).getsize;
            case tvarsym(sym).vartype.def.deftype of
            case tvarsym(sym).vartype.def.deftype of
              arraydef :
              arraydef :
@@ -1551,7 +1504,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.66  2003-09-16 16:17:01  peter
+  Revision 1.67  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.66  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.65  2003/09/03 15:55:01  peter
   Revision 1.65  2003/09/03 15:55:01  peter

+ 36 - 27
compiler/regvars.pas

@@ -208,9 +208,9 @@ implementation
                         siz:=OS_32;
                         siz:=OS_32;
 
 
                       { allocate a register for this regvar }
                       { allocate a register for this regvar }
-                      regvarinfo^.regvars[i].reg:=rg.getregisterint(exprasmlist,siz);
+                      regvarinfo^.regvars[i].localloc.register:=rg.getregisterint(exprasmlist,siz);
                       { and make sure it can't be freed }
                       { and make sure it can't be freed }
-                      rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].reg));
+                      rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].localloc.register));
                     end
                     end
                   else
                   else
                     begin
                     begin
@@ -262,10 +262,10 @@ implementation
                      begin
                      begin
 {$ifdef i386}
 {$ifdef i386}
                        { reserve place on the FPU stack }
                        { reserve place on the FPU stack }
-                       regvarinfo^.fpuregvars[i].reg:=trgcpu(rg).correct_fpuregister(NR_ST0,i);
+                       regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i);
 {$else i386}
 {$else i386}
-                       regvarinfo^.fpuregvars[i].reg:=fpuvarregs[i];
-                       rg.makeregvarother(regvarinfo^.fpuregvars[i].reg);
+                       regvarinfo^.fpuregvars[i].localloc.register:=fpuvarregs[i];
+                       rg.makeregvarother(regvarinfo^.fpuregvars[i].localloc.register);
 {$endif i386}
 {$endif i386}
                      end;
                      end;
                   end;
                   end;
@@ -295,7 +295,7 @@ implementation
           supreg:=getsupreg(reg);
           supreg:=getsupreg(reg);
           for i := 1 to maxvarregs do
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) and
             if assigned(regvarinfo^.regvars[i]) and
-               (getsupreg(regvarinfo^.regvars[i].reg)=supreg) then
+               (getsupreg(regvarinfo^.regvars[i].localloc.register)=supreg) then
               begin
               begin
                 if supreg in rg.regvar_loaded_int then
                 if supreg in rg.regvar_loaded_int then
                   begin
                   begin
@@ -304,11 +304,12 @@ implementation
                     { possible that it's been modified  (JM)                  }
                     { possible that it's been modified  (JM)                  }
                     if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                     if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                       begin
                       begin
-                        reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
+{$warning FIXME Check vsym.localloc for regvars}
+//                        reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
                         cgsize:=def_cgsize(vsym.vartype.def);
                         cgsize:=def_cgsize(vsym.vartype.def);
-                        cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
+                        cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr);
                       end;
                       end;
-                    asml.concat(tai_regalloc.dealloc(vsym.reg));
+                    asml.concat(tai_regalloc.dealloc(vsym.localloc.register));
                     exclude(rg.regvar_loaded_int,supreg);
                     exclude(rg.regvar_loaded_int,supreg);
                   end;
                   end;
                 break;
                 break;
@@ -319,7 +320,7 @@ implementation
           for i := 1 to maxvarregs do
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) then
             if assigned(regvarinfo^.regvars[i]) then
               begin
               begin
-                r:=rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT);
+                r:=rg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT);
                 if (r = reg) then
                 if (r = reg) then
                   begin
                   begin
                     regidx:=findreg_by_number(r);
                     regidx:=findreg_by_number(r);
@@ -330,11 +331,12 @@ implementation
                         { possible that it's been modified  (JM)                  }
                         { possible that it's been modified  (JM)                  }
                         if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                         if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                           begin
                           begin
-                            reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
+{$warning FIXME Check vsym.localloc for regvars}
+//                            reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
                             cgsize:=def_cgsize(vsym.vartype.def);
                             cgsize:=def_cgsize(vsym.vartype.def);
-                            cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
+                            cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr);
                           end;
                           end;
-                        asml.concat(tai_regalloc.dealloc(vsym.reg));
+                        asml.concat(tai_regalloc.dealloc(vsym.localloc.register));
                         rg.regvar_loaded_other[regidx] := false;
                         rg.regvar_loaded_other[regidx] := false;
                       end;
                       end;
                     break;
                     break;
@@ -355,13 +357,14 @@ implementation
 {$ifndef i386}
 {$ifndef i386}
       exit;
       exit;
 {$endif i386}
 {$endif i386}
-      reg:=vsym.reg;
+      reg:=vsym.localloc.register;
       if getregtype(reg)=R_INTREGISTER then
       if getregtype(reg)=R_INTREGISTER then
         begin
         begin
           if not(getsupreg(reg) in rg.regvar_loaded_int) then
           if not(getsupreg(reg) in rg.regvar_loaded_int) then
             begin
             begin
               asml.concat(tai_regalloc.alloc(reg));
               asml.concat(tai_regalloc.alloc(reg));
-              reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
+{$warning FIXME Check vsym.localloc for regvars}
+//              reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
               if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
               if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
                 opsize := OS_ADDR
                 opsize := OS_ADDR
               else
               else
@@ -377,7 +380,8 @@ implementation
           if not rg.regvar_loaded_other[regidx] then
           if not rg.regvar_loaded_other[regidx] then
             begin
             begin
               asml.concat(tai_regalloc.alloc(reg));
               asml.concat(tai_regalloc.alloc(reg));
-              reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
+{$warning FIXME Check vsym.localloc for regvars}
+//              reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
               if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
               if paramanager.push_addr_param(vsym.varspez,vsym.vartype.def,current_procinfo.procdef.proccalloption) then
                 opsize := OS_ADDR
                 opsize := OS_ADDR
               else
               else
@@ -403,7 +407,7 @@ implementation
           supreg:=getsupreg(reg);
           supreg:=getsupreg(reg);
           for i := 1 to maxvarregs do
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) and
             if assigned(regvarinfo^.regvars[i]) and
-               (getsupreg(regvarinfo^.regvars[i].reg) = supreg) then
+               (getsupreg(regvarinfo^.regvars[i].localloc.register) = supreg) then
               load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
               load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
         end
         end
       else
       else
@@ -411,7 +415,7 @@ implementation
           reg_spare := rg.makeregsize(reg,OS_INT);
           reg_spare := rg.makeregsize(reg,OS_INT);
           for i := 1 to maxvarregs do
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) and
             if assigned(regvarinfo^.regvars[i]) and
-               (rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT) = reg_spare) then
+               (rg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT) = reg_spare) then
               load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
               load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
         end;
         end;
     end;
     end;
@@ -449,7 +453,7 @@ implementation
                 begin
                 begin
 {$ifdef i386}
 {$ifdef i386}
                   { reserve place on the FPU stack }
                   { reserve place on the FPU stack }
-                  regvarinfo^.fpuregvars[i].reg:=trgcpu(rg).correct_fpuregister(NR_ST0,i-1);
+                  regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i-1);
                   asml.concat(Taicpu.op_none(A_FLDZ,S_NO));
                   asml.concat(Taicpu.op_none(A_FLDZ,S_NO));
 {$endif i386}
 {$endif i386}
                 end;
                 end;
@@ -467,9 +471,9 @@ implementation
                     if cs_asm_source in aktglobalswitches then
                     if cs_asm_source in aktglobalswitches then
                       asml.insert(tai_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+
                       asml.insert(tai_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+
                         ' with weight '+tostr(regvarinfo^.fpuregvars[i].refs)+' assigned to register '+
                         ' with weight '+tostr(regvarinfo^.fpuregvars[i].refs)+' assigned to register '+
-                        std_regname(regvarinfo^.fpuregvars[i].reg))));
+                        std_regname(regvarinfo^.fpuregvars[i].localloc.register))));
                     if (status.verbosity and v_debug)=v_debug then
                     if (status.verbosity and v_debug)=v_debug then
-                      Message3(cg_d_register_weight,std_regname(regvarinfo^.fpuregvars[i].reg),
+                      Message3(cg_d_register_weight,std_regname(regvarinfo^.fpuregvars[i].localloc.register),
                         tostr(regvarinfo^.fpuregvars[i].refs),regvarinfo^.fpuregvars[i].name);
                         tostr(regvarinfo^.fpuregvars[i].refs),regvarinfo^.fpuregvars[i].name);
                  end;
                  end;
             end;
             end;
@@ -542,7 +546,7 @@ implementation
              begin
              begin
                if assigned(regvars[i]) then
                if assigned(regvars[i]) then
                 begin
                 begin
-                  reg:=regvars[i].reg;
+                  reg:=regvars[i].localloc.register;
                   if getregtype(reg)=R_INTREGISTER then
                   if getregtype(reg)=R_INTREGISTER then
                     begin
                     begin
                     end
                     end
@@ -571,8 +575,8 @@ implementation
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               begin
               begin
                 { make sure the unget isn't just a nop }
                 { make sure the unget isn't just a nop }
-                exclude(rg.is_reg_var_int,getsupreg(regvars[i].reg));
-                rg.ungetregisterint(list,regvars[i].reg);
+                exclude(rg.is_reg_var_int,getsupreg(regvars[i].localloc.register));
+                rg.ungetregisterint(list,regvars[i].localloc.register);
               end;
               end;
       end;
       end;
 
 
@@ -589,8 +593,8 @@ implementation
             if assigned(regvars[i]) { and
             if assigned(regvars[i]) { and
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               begin
               begin
-                setsupreg(regvars[i].reg,getsupreg(table[getsupreg(regvars[i].reg)]));
-                r:=regvars[i].reg;
+                setsupreg(regvars[i].localloc.register,getsupreg(table[getsupreg(regvars[i].localloc.register)]));
+                r:=regvars[i].localloc.register;
                 if cs_asm_source in aktglobalswitches then
                 if cs_asm_source in aktglobalswitches then
                  list.insert(tai_comment.Create(strpnew(regvars[i].name+
                  list.insert(tai_comment.Create(strpnew(regvars[i].name+
                   ' with weight '+tostr(regvars[i].refs)+' assigned to register '+
                   ' with weight '+tostr(regvars[i].refs)+' assigned to register '+
@@ -604,7 +608,12 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.65  2003-09-16 16:17:01  peter
+  Revision 1.66  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.65  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.64  2003/09/07 22:09:35  peter
   Revision 1.64  2003/09/07 22:09:35  peter

+ 6 - 11
compiler/symbase.pas

@@ -97,21 +97,16 @@ interface
        public
        public
           name      : pstring;
           name      : pstring;
           realname  : pstring;
           realname  : pstring;
-          datasize  : longint;
           symindex,
           symindex,
           defindex  : TIndexArray;
           defindex  : TIndexArray;
           symsearch : Tdictionary;
           symsearch : Tdictionary;
           next      : tsymtable;
           next      : tsymtable;
           defowner  : tdefentry; { for records and objects }
           defowner  : tdefentry; { for records and objects }
-          { 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 }
           { each symtable gets a number }
           unitid        : word;
           unitid        : word;
           { level of symtable, used for nested procedures }
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtablelevel : byte;
-          dataalignment : byte;
           constructor Create(const s:string);
           constructor Create(const s:string);
           destructor  destroy;override;
           destructor  destroy;override;
           procedure clear;virtual;
           procedure clear;virtual;
@@ -120,8 +115,6 @@ interface
           procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
           procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
           procedure insert(sym : tsymentry);virtual;
           procedure insert(sym : tsymentry);virtual;
           procedure replace(oldsym,newsym:tsymentry);
           procedure replace(oldsym,newsym:tsymentry);
-          procedure insertvardata(sym : tsymentry);virtual;abstract;
-          procedure insertconstdata(sym : tsymentry);virtual;abstract;
           function  search(const s : stringid) : tsymentry;
           function  search(const s : stringid) : tsymentry;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
           procedure registerdef(p : tdefentry);
           procedure registerdef(p : tdefentry);
@@ -178,9 +171,6 @@ implementation
          symsearch:=tdictionary.create;
          symsearch:=tdictionary.create;
          symsearch.noclear:=true;
          symsearch.noclear:=true;
          unitid:=0;
          unitid:=0;
-         address_fixup:=0;
-         datasize:=0;
-         dataalignment:=1;
       end;
       end;
 
 
 
 
@@ -321,7 +311,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.14  2003-06-25 18:31:23  peter
+  Revision 1.15  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.14  2003/06/25 18:31:23  peter
     * sym,def resolving partly rewritten to support also parent objects
     * sym,def resolving partly rewritten to support also parent objects
       not directly available through the uses clause
       not directly available through the uses clause
 
 

+ 7 - 2
compiler/symconst.pas

@@ -249,7 +249,7 @@ type
     vo_is_dll_var,
     vo_is_dll_var,
     vo_is_thread_var,
     vo_is_thread_var,
     vo_fpuregable,
     vo_fpuregable,
-    vo_is_local_copy,
+    vo_has_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported,
     vo_is_exported,
     vo_is_high_value,
     vo_is_high_value,
@@ -374,7 +374,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.63  2003-09-09 21:03:17  peter
+  Revision 1.64  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.63  2003/09/09 21:03:17  peter
     * basics for x86 register calling
     * basics for x86 register calling
 
 
   Revision 1.62  2003/09/09 15:54:10  peter
   Revision 1.62  2003/09/09 15:54:10  peter

+ 41 - 30
compiler/symdef.pas

@@ -421,6 +421,7 @@ interface
        tabstractprocdef = class(tstoreddef)
        tabstractprocdef = class(tstoreddef)
           { saves a definition to the return type }
           { saves a definition to the return type }
           rettype         : ttype;
           rettype         : ttype;
+          paraalign       : byte;
           parast          : tsymtable;
           parast          : tsymtable;
           para            : tlinkedlist;
           para            : tlinkedlist;
           proctypeoption  : tproctypeoption;
           proctypeoption  : tproctypeoption;
@@ -2842,7 +2843,7 @@ implementation
            if varsize>$fffffff then
            if varsize>$fffffff then
              varsize:=$fffffff;
              varsize:=$fffffff;
            newrec := strpnew(p.name+':'+spec+tstoreddef(tvarsym(p).vartype.def).numberstring
            newrec := strpnew(p.name+':'+spec+tstoreddef(tvarsym(p).vartype.def).numberstring
-                         +','+tostr(tvarsym(p).address*8)+','
+                         +','+tostr(tvarsym(p).fieldoffset*8)+','
                          +tostr(varsize*8)+';');
                          +tostr(varsize*8)+';');
            if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
            if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
              begin
              begin
@@ -2886,7 +2887,7 @@ implementation
              tvarsym(sym).vartype.def.needs_inittable) then
              tvarsym(sym).vartype.def.needs_inittable) then
           begin
           begin
             rttiList.concat(Tai_const_symbol.Create(tstoreddef(tvarsym(sym).vartype.def).get_rtti_label(FRTTIType)));
             rttiList.concat(Tai_const_symbol.Create(tstoreddef(tvarsym(sym).vartype.def).get_rtti_label(FRTTIType)));
-            rttiList.concat(Tai_const.Create_32bit(tvarsym(sym).address));
+            rttiList.concat(Tai_const.Create_32bit(tvarsym(sym).fieldoffset));
           end;
           end;
       end;
       end;
 
 
@@ -2905,9 +2906,9 @@ implementation
          { recordalign -1 means C record packing, that starts
          { recordalign -1 means C record packing, that starts
            with an alignment of 1 }
            with an alignment of 1 }
          if aktalignment.recordalignmax=-1 then
          if aktalignment.recordalignmax=-1 then
-          symtable.dataalignment:=1
+           trecordsymtable(symtable).dataalignment:=1
          else
          else
-          symtable.dataalignment:=aktalignment.recordalignmax;
+           trecordsymtable(symtable).dataalignment:=aktalignment.recordalignmax;
          isunion:=false;
          isunion:=false;
       end;
       end;
 
 
@@ -2918,6 +2919,8 @@ implementation
          deftype:=recorddef;
          deftype:=recorddef;
          savesize:=ppufile.getlongint;
          savesize:=ppufile.getlongint;
          symtable:=trecordsymtable.create;
          symtable:=trecordsymtable.create;
+         trecordsymtable(symtable).datasize:=ppufile.getlongint;
+         trecordsymtable(symtable).dataalignment:=ppufile.getbyte;
          trecordsymtable(symtable).ppuload(ppufile);
          trecordsymtable(symtable).ppuload(ppufile);
          symtable.defowner:=self;
          symtable.defowner:=self;
          isunion:=false;
          isunion:=false;
@@ -2962,17 +2965,16 @@ implementation
       begin
       begin
          inherited ppuwritedef(ppufile);
          inherited ppuwritedef(ppufile);
          ppufile.putlongint(savesize);
          ppufile.putlongint(savesize);
+         ppufile.putlongint(trecordsymtable(symtable).datasize);
+         ppufile.putbyte(trecordsymtable(symtable).dataalignment);
          ppufile.writeentry(ibrecorddef);
          ppufile.writeentry(ibrecorddef);
          trecordsymtable(symtable).ppuwrite(ppufile);
          trecordsymtable(symtable).ppuwrite(ppufile);
       end;
       end;
 
 
 
 
     function trecorddef.size:longint;
     function trecorddef.size:longint;
-      var
-        _resultsize : longint;
       begin
       begin
-        _resultsize:=symtable.datasize;
-        size:=_resultsize;
+        result:=trecordsymtable(symtable).datasize;
       end;
       end;
 
 
 
 
@@ -2992,7 +2994,7 @@ implementation
             l:=hp.vartype.def.alignment
             l:=hp.vartype.def.alignment
            else
            else
             l:=hp.vartype.def.size;
             l:=hp.vartype.def.size;
-           if l>symtable.dataalignment then
+           if l>trecordsymtable(symtable).dataalignment then
             begin
             begin
               if l>=4 then
               if l>=4 then
                alignment:=4
                alignment:=4
@@ -3003,10 +3005,10 @@ implementation
                alignment:=1;
                alignment:=1;
             end
             end
            else
            else
-            alignment:=symtable.dataalignment;
+            alignment:=trecordsymtable(symtable).dataalignment;
          end
          end
         else
         else
-         alignment:=symtable.dataalignment;
+         alignment:=trecordsymtable(symtable).dataalignment;
       end;
       end;
 
 
 
 
@@ -3070,6 +3072,7 @@ implementation
          parast.defowner:=self;
          parast.defowner:=self;
          parast.next:=owner;
          parast.next:=owner;
          para:=TLinkedList.Create;
          para:=TLinkedList.Create;
+         paraalign:=aktalignment.paraalign;
          minparacount:=0;
          minparacount:=0;
          maxparacount:=0;
          maxparacount:=0;
          proctypeoption:=potype_none;
          proctypeoption:=potype_none;
@@ -3216,6 +3219,7 @@ implementation
          maxparacount:=0;
          maxparacount:=0;
          ppufile.gettype(rettype);
          ppufile.gettype(rettype);
          fpu_used:=ppufile.getbyte;
          fpu_used:=ppufile.getbyte;
+         paraalign:=ppufile.getbyte;
          proctypeoption:=tproctypeoption(ppufile.getbyte);
          proctypeoption:=tproctypeoption(ppufile.getbyte);
          proccalloption:=tproccalloption(ppufile.getbyte);
          proccalloption:=tproccalloption(ppufile.getbyte);
          ppufile.getsmallset(procoptions);
          ppufile.getsmallset(procoptions);
@@ -3258,6 +3262,7 @@ implementation
          if simplify_ppu then
          if simplify_ppu then
           fpu_used:=0;
           fpu_used:=0;
          ppufile.putbyte(fpu_used);
          ppufile.putbyte(fpu_used);
+         ppufile.putbyte(paraalign);
          ppufile.putbyte(ord(proctypeoption));
          ppufile.putbyte(ord(proctypeoption));
          ppufile.putbyte(ord(proccalloption));
          ppufile.putbyte(ord(proccalloption));
          ppufile.putsmallset(procoptions);
          ppufile.putsmallset(procoptions);
@@ -4384,14 +4389,13 @@ implementation
         symtable:=tobjectsymtable.create(n);
         symtable:=tobjectsymtable.create(n);
         { create space for vmt !! }
         { create space for vmt !! }
         vmt_offset:=0;
         vmt_offset:=0;
-        symtable.datasize:=0;
         symtable.defowner:=self;
         symtable.defowner:=self;
         { recordalign -1 means C record packing, that starts
         { recordalign -1 means C record packing, that starts
           with an alignment of 1 }
           with an alignment of 1 }
         if aktalignment.recordalignmax=-1 then
         if aktalignment.recordalignmax=-1 then
-         symtable.dataalignment:=1
+         tobjectsymtable(symtable).dataalignment:=1
         else
         else
-         symtable.dataalignment:=aktalignment.recordalignmax;
+         tobjectsymtable(symtable).dataalignment:=aktalignment.recordalignmax;
         lastvtableindex:=0;
         lastvtableindex:=0;
         set_parent(c);
         set_parent(c);
         objname:=stringdup(upper(n));
         objname:=stringdup(upper(n));
@@ -4451,6 +4455,8 @@ implementation
            implementedinterfaces:=nil;
            implementedinterfaces:=nil;
 
 
          symtable:=tobjectsymtable.create(objrealname^);
          symtable:=tobjectsymtable.create(objrealname^);
+         tobjectsymtable(symtable).datasize:=ppufile.getlongint;
+         tobjectsymtable(symtable).dataalignment:=ppufile.getbyte;
          tobjectsymtable(symtable).ppuload(ppufile);
          tobjectsymtable(symtable).ppuload(ppufile);
 
 
          symtable.defowner:=self;
          symtable.defowner:=self;
@@ -4518,6 +4524,8 @@ implementation
                 end;
                 end;
            end;
            end;
 
 
+         ppufile.putlongint(tobjectsymtable(symtable).datasize);
+         ppufile.putbyte(tobjectsymtable(symtable).dataalignment);
          ppufile.writeentry(ibobjectdef);
          ppufile.writeentry(ibobjectdef);
 
 
          tobjectsymtable(symtable).ppuwrite(ppufile);
          tobjectsymtable(symtable).ppuwrite(ppufile);
@@ -4582,10 +4590,10 @@ implementation
              if not (objecttype in [odt_interfacecom,odt_interfacecorba]) then
              if not (objecttype in [odt_interfacecom,odt_interfacecorba]) then
                begin
                begin
                   { add the data of the anchestor class }
                   { add the data of the anchestor class }
-                  inc(symtable.datasize,c.symtable.datasize);
+                  inc(tobjectsymtable(symtable).datasize,tobjectsymtable(c.symtable).datasize);
                   if (oo_has_vmt in objectoptions) and
                   if (oo_has_vmt in objectoptions) and
                      (oo_has_vmt in c.objectoptions) then
                      (oo_has_vmt in c.objectoptions) then
-                    dec(symtable.datasize,POINTER_SIZE);
+                    dec(tobjectsymtable(symtable).datasize,POINTER_SIZE);
                   { if parent has a vmt field then
                   { if parent has a vmt field then
                     the offset is the same for the child PM }
                     the offset is the same for the child PM }
                   if (oo_has_vmt in c.objectoptions) or is_class(self) then
                   if (oo_has_vmt in c.objectoptions) or is_class(self) then
@@ -4595,7 +4603,7 @@ implementation
                     end;
                     end;
                end;
                end;
           end;
           end;
-        savesize := symtable.datasize;
+        savesize := tobjectsymtable(symtable).datasize;
       end;
       end;
 
 
 
 
@@ -4607,9 +4615,10 @@ implementation
           internalerror(12345)
           internalerror(12345)
         else
         else
           begin
           begin
-             symtable.datasize:=align(symtable.datasize,symtable.dataalignment);
-             vmt_offset:=symtable.datasize;
-             inc(symtable.datasize,POINTER_SIZE);
+             tobjectsymtable(symtable).datasize:=align(tobjectsymtable(symtable).datasize,
+                 tobjectsymtable(symtable).dataalignment);
+             vmt_offset:=tobjectsymtable(symtable).datasize;
+             inc(tobjectsymtable(symtable).datasize,POINTER_SIZE);
              include(objectoptions,oo_has_vmt);
              include(objectoptions,oo_has_vmt);
           end;
           end;
      end;
      end;
@@ -4704,20 +4713,17 @@ implementation
 
 
 
 
     function tobjectdef.size : longint;
     function tobjectdef.size : longint;
-      var
-        _resultsize : longint;
       begin
       begin
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
-          _resultsize:=POINTER_SIZE
+          result:=POINTER_SIZE
         else
         else
-          _resultsize:=symtable.datasize;
-        size := _resultsize;
+          result:=tobjectsymtable(symtable).datasize;
       end;
       end;
 
 
 
 
     function tobjectdef.alignment:longint;
     function tobjectdef.alignment:longint;
       begin
       begin
-        alignment:=symtable.dataalignment;
+        alignment:=tobjectsymtable(symtable).dataalignment;
       end;
       end;
 
 
 
 
@@ -4856,7 +4862,7 @@ implementation
             oldrecsize:=stabrecsize;
             oldrecsize:=stabrecsize;
             stabrecsize:=memsizeinc;
             stabrecsize:=memsizeinc;
             GetMem(stabrecstring,stabrecsize);
             GetMem(stabrecstring,stabrecsize);
-            strpcopy(stabRecString,'s'+tostr(symtable.datasize));
+            strpcopy(stabRecString,'s'+tostr(tobjectsymtable(symtable).datasize));
             if assigned(childof) then
             if assigned(childof) then
               begin
               begin
                 {only one ancestor not virtual, public, at base offset 0 }
                 {only one ancestor not virtual, public, at base offset 0 }
@@ -5045,7 +5051,7 @@ implementation
                 hp:=proc.firstsym;
                 hp:=proc.firstsym;
                 while assigned(hp) do
                 while assigned(hp) do
                   begin
                   begin
-                     inc(address,tvarsym(hp^.sym).address);
+                     inc(address,tvarsym(hp^.sym).fieldoffset);
                      hp:=hp^.next;
                      hp:=hp^.next;
                   end;
                   end;
                 rttiList.concat(Tai_const.Create_32bit(address));
                 rttiList.concat(Tai_const.Create_32bit(address));
@@ -5215,7 +5221,7 @@ implementation
          if needs_prop_entry(tsym(sym)) and
          if needs_prop_entry(tsym(sym)) and
           (tsym(sym).typ=varsym) then
           (tsym(sym).typ=varsym) then
           begin
           begin
-             rttiList.concat(Tai_const.Create_32bit(tvarsym(sym).address));
+             rttiList.concat(Tai_const.Create_32bit(tvarsym(sym).fieldoffset));
              hp:=searchclasstablelist(tobjectdef(tvarsym(sym).vartype.def));
              hp:=searchclasstablelist(tobjectdef(tvarsym(sym).vartype.def));
              if not(assigned(hp)) then
              if not(assigned(hp)) then
                internalerror(0206002);
                internalerror(0206002);
@@ -5848,7 +5854,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.162  2003-09-07 22:09:35  peter
+  Revision 1.163  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.162  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 114 - 91
compiler/symsym.pas

@@ -174,14 +174,13 @@ interface
        end;
        end;
 
 
        tvarsym = class(tstoredsym)
        tvarsym = class(tstoredsym)
-          address       : longint;
-          localvarsym   : tvarsym;
           highvarsym    : tvarsym;
           highvarsym    : tvarsym;
           defaultconstsym : tsym;
           defaultconstsym : tsym;
           varoptions    : tvaroptions;
           varoptions    : tvaroptions;
-          reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
           varspez       : tvarspez;  { sets the type of access }
           varspez       : tvarspez;  { sets the type of access }
           varstate      : tvarstate;
           varstate      : tvarstate;
+          localloc      : tparalocation; { register/reference for local var }
+          fieldoffset   : longint; { offset in record/object }
           paraitem      : tparaitem;
           paraitem      : tparaitem;
           notifications : Tlinkedlist;
           notifications : Tlinkedlist;
           constructor create(const n : string;vsp:tvarspez;const tt : ttype);
           constructor create(const n : string;vsp:tvarspez;const tt : ttype);
@@ -195,7 +194,6 @@ interface
           procedure set_mangledname(const s:string);
           procedure set_mangledname(const s:string);
           function  getsize : longint;
           function  getsize : longint;
           function  getvaluesize : longint;
           function  getvaluesize : longint;
-          function  adjusted_address : longint;
           procedure trigger_notifications(what:Tnotification_flag);
           procedure trigger_notifications(what:Tnotification_flag);
           function register_notification(flags:Tnotification_flags;
           function register_notification(flags:Tnotification_flags;
                                          callback:Tnotification_callback):cardinal;
                                          callback:Tnotification_callback):cardinal;
@@ -563,8 +561,8 @@ implementation
          if not isstabwritten then
          if not isstabwritten then
            begin
            begin
               stab_str := stabstring;
               stab_str := stabstring;
-              { count_dbx(stab_str); moved to GDB.PAS }
-              asmList.concat(Tai_stabs.Create(stab_str));
+              if assigned(stab_str) then
+                asmList.concat(Tai_stabs.Create(stab_str));
               isstabwritten:=true;
               isstabwritten:=true;
           end;
           end;
     end;
     end;
@@ -1494,7 +1492,7 @@ implementation
     function tpropertysym.stabstring : pchar;
     function tpropertysym.stabstring : pchar;
       begin
       begin
          { !!!! don't know how to handle }
          { !!!! don't know how to handle }
-         stabstring:=strpnew('');
+         stabstring:=nil;
       end;
       end;
 
 
     procedure tpropertysym.concatstabto(asmlist : taasmoutput);
     procedure tpropertysym.concatstabto(asmlist : taasmoutput);
@@ -1530,7 +1528,7 @@ implementation
          { load absolute }
          { load absolute }
          typ:=absolutesym;
          typ:=absolutesym;
          ref:=nil;
          ref:=nil;
-         address:=0;
+         fieldoffset:=0;
          asmname:=nil;
          asmname:=nil;
          abstyp:=absolutetyp(ppufile.getbyte);
          abstyp:=absolutetyp(ppufile.getbyte);
          absseg:=false;
          absseg:=false;
@@ -1541,7 +1539,7 @@ implementation
              asmname:=stringdup(ppufile.getstring);
              asmname:=stringdup(ppufile.getstring);
            toaddr :
            toaddr :
              begin
              begin
-               address:=ppufile.getlongint;
+               fieldoffset:=ppufile.getlongint;
                absseg:=boolean(ppufile.getbyte);
                absseg:=boolean(ppufile.getbyte);
              end;
              end;
          end;
          end;
@@ -1555,7 +1553,7 @@ implementation
          { Note: This needs to write everything of tvarsym.write }
          { Note: This needs to write everything of tvarsym.write }
          inherited writesym(ppufile);
          inherited writesym(ppufile);
          ppufile.putbyte(byte(varspez));
          ppufile.putbyte(byte(varspez));
-         ppufile.putlongint(address);
+         ppufile.putlongint(fieldoffset);
          { write only definition or definitionsym }
          { write only definition or definitionsym }
          ppufile.puttype(vartype);
          ppufile.puttype(vartype);
          hvo:=varoptions-[vo_regable,vo_fpuregable];
          hvo:=varoptions-[vo_regable,vo_fpuregable];
@@ -1568,7 +1566,7 @@ implementation
              ppufile.putstring(asmname^);
              ppufile.putstring(asmname^);
            toaddr :
            toaddr :
              begin
              begin
-               ppufile.putlongint(address);
+               ppufile.putlongint(fieldoffset);
                ppufile.putbyte(byte(absseg));
                ppufile.putbyte(byte(absseg));
              end;
              end;
          end;
          end;
@@ -1613,7 +1611,7 @@ implementation
            toasm :
            toasm :
              mangledname:=asmname^;
              mangledname:=asmname^;
            toaddr :
            toaddr :
-             mangledname:='$'+tostr(address);
+             mangledname:='$'+tostr(fieldoffset);
          else
          else
            internalerror(10002);
            internalerror(10002);
          end;
          end;
@@ -1639,8 +1637,8 @@ implementation
          vartype:=tt;
          vartype:=tt;
          _mangledname:=nil;
          _mangledname:=nil;
          varspez:=vsp;
          varspez:=vsp;
-         address:=0;
-         localvarsym:=nil;
+         fieldoffset:=0;
+         fillchar(localloc,sizeof(localloc),0);
          highvarsym:=nil;
          highvarsym:=nil;
          defaultconstsym:=nil;
          defaultconstsym:=nil;
          refs:=0;
          refs:=0;
@@ -1668,12 +1666,11 @@ implementation
       begin
       begin
          inherited loadsym(ppufile);
          inherited loadsym(ppufile);
          typ:=varsym;
          typ:=varsym;
-         reg:=NR_NO;
+         fillchar(localloc,sizeof(localloc),0);
          refs := 0;
          refs := 0;
          varstate:=vs_used;
          varstate:=vs_used;
          varspez:=tvarspez(ppufile.getbyte);
          varspez:=tvarspez(ppufile.getbyte);
-         address:=ppufile.getlongint;
-         localvarsym:=nil;
+         fieldoffset:=ppufile.getlongint;
          highvarsym:=nil;
          highvarsym:=nil;
          defaultconstsym:=nil;
          defaultconstsym:=nil;
          ppufile.gettype(_vartype);
          ppufile.gettype(_vartype);
@@ -1703,7 +1700,7 @@ implementation
       begin
       begin
          inherited writesym(ppufile);
          inherited writesym(ppufile);
          ppufile.putbyte(byte(varspez));
          ppufile.putbyte(byte(varspez));
-         ppufile.putlongint(address);
+         ppufile.putlongint(fieldoffset);
          ppufile.puttype(vartype);
          ppufile.puttype(vartype);
          { symbols which are load are never candidates for a register,
          { symbols which are load are never candidates for a register,
            turn off the regable }
            turn off the regable }
@@ -1750,12 +1747,6 @@ implementation
       end;
       end;
 
 
 
 
-    function  tvarsym.adjusted_address : longint;
-      begin
-        result:=address+owner.address_fixup;
-      end;
-
-
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
 
 
     var n:Tnotification;
     var n:Tnotification;
@@ -1817,71 +1808,97 @@ implementation
        threadvaroffset : string;
        threadvaroffset : string;
        regidx : tregisterindex;
        regidx : tregisterindex;
      begin
      begin
+       { There is no space allocated for not referenced locals }
+       if refs=0 then
+         begin
+           stabstring:=nil;
+           exit;
+         end;
+
        st:=tstoreddef(vartype.def).numberstring;
        st:=tstoreddef(vartype.def).numberstring;
-      if (vo_is_thread_var in varoptions) then
-        threadvaroffset:='+'+tostr(pointer_size)
-      else
-        threadvaroffset:='';
+       if (vo_is_thread_var in varoptions) then
+         threadvaroffset:='+'+tostr(pointer_size)
+       else
+         threadvaroffset:='';
 
 
-       if (owner.symtabletype = objectsymtable) and
-          (sp_static in symoptions) then
-         begin
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
-            stabstring := strpnew('"'+owner.name^+'__'+name+':'+st+
-                     '",'+
-                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)
-                     +','+mangledname+threadvaroffset);
-         end
-       else if (owner.symtabletype = globalsymtable) then
-         begin
-            { Here we used S instead of
-              because with G GDB doesn't look at the address field
-              but searches the same name or with a leading underscore
-              but these names don't exist in pascal !}
-            if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
-            stabstring := strpnew('"'+name+':'+st+'",'+
-                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+
-                     ','+mangledname+threadvaroffset);
-         end
-       else if owner.symtabletype = staticsymtable then
-         begin
-            stabstring := strpnew('"'+name+':S'+st+'",'+
-                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+
-                  ','+mangledname+threadvaroffset);
-         end
-       else if (owner.symtabletype in [parasymtable,inlineparasymtable]) then
-         begin
-            if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) then
-              st := 'v'+st { should be 'i' but 'i' doesn't work }
-            else
-              st := 'p'+st;
-            stabstring := strpnew('"'+name+':'+st+'",'+
-                  tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
-                  tostr(adjusted_address));
-                  {offset to ebp => will not work if the framepointer is esp
-                  so some optimizing will make things harder to debug }
-         end
-       else if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) then
-         if reg<>NR_NO then
+       case owner.symtabletype of
+         objectsymtable :
            begin
            begin
-              regidx:=findreg_by_number(reg);
-              { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-              { this is the register order for GDB}
-              stabstring:=strpnew('"'+name+':r'+st+'",'+
-                        tostr(N_RSYM)+',0,'+
-                        tostr(fileinfo.line)+','+tostr(regstabs_table[regidx]));
-           end
+             if (sp_static in symoptions) then
+               begin
+                 if (cs_gdb_gsym in aktglobalswitches) then
+                   st := 'G'+st
+                 else
+                   st := 'S'+st;
+                 stabstring := strpnew('"'+owner.name^+'__'+name+':'+st+
+                      '",'+
+                      tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)
+                      +','+mangledname+threadvaroffset);
+               end;
+           end;
+         globalsymtable :
+           begin
+             { Here we used S instead of
+               because with G GDB doesn't look at the address field
+               but searches the same name or with a leading underscore
+               but these names don't exist in pascal !}
+             if (cs_gdb_gsym in aktglobalswitches) then
+               st := 'G'+st
+             else
+               st := 'S'+st;
+             stabstring := strpnew('"'+name+':'+st+'",'+
+                      tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+
+                      ','+mangledname+threadvaroffset);
+           end;
+         staticsymtable :
+           begin
+             stabstring := strpnew('"'+name+':S'+st+'",'+
+                   tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+
+                   ','+mangledname+threadvaroffset);
+           end;
+         parasymtable,
+         localsymtable,
+         inlineparasymtable,
+         inlinelocalsymtable :
+           begin
+             if (vo_is_C_var in varoptions) then
+               begin
+                 stabstring := strpnew('"'+name+':S'+st+'",'+
+                     tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
+                 exit;
+               end;
+             if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
+                paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) then
+               st := 'v'+st { should be 'i' but 'i' doesn't work }
+             else
+               st := 'p'+st;
+             case localloc.loc of
+               LOC_REGISTER :
+                 begin
+                   regidx:=findreg_by_number(localloc.register);
+                   { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+                   { this is the register order for GDB}
+                   stabstring:=strpnew('"'+name+':r'+st+'",'+
+                             tostr(N_RSYM)+',0,'+
+                             tostr(fileinfo.line)+','+tostr(regstabs_table[regidx]));
+                 end;
+               LOC_REFERENCE :
+                 begin
+                   { offset to ebp => will not work if the framepointer is esp
+                     so some optimizing will make things harder to debug }
+                   stabstring := strpnew('"'+name+':'+st+'",'+
+                         tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
+                         tostr(localloc.reference.offset));
+                 end;
+               else
+                 internalerror(2003091814);
+             end;
+           end;
          else
          else
-           { I don't know if this will work (PM) }
-           if (vo_is_C_var in varoptions) then
-            stabstring := strpnew('"'+name+':S'+st+'",'+
-                  tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
-           else
-           stabstring := strpnew('"'+name+':'+st+'",'+
-                  tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+','+tostr(adjusted_address))
-       else
-         stabstring := inherited stabstring;
-  end;
+           stabstring := inherited stabstring;
+       end;
+     end;
+
 
 
     procedure tvarsym.concatstabto(asmlist : taasmoutput);
     procedure tvarsym.concatstabto(asmlist : taasmoutput);
       var
       var
@@ -1894,12 +1911,14 @@ implementation
            exit;
            exit;
          if (vo_is_self in varoptions) then
          if (vo_is_self in varoptions) then
            begin
            begin
+             if localloc.loc<>LOC_REFERENCE then
+               internalerror(2003091815);
              if (po_classmethod in current_procinfo.procdef.procoptions) or
              if (po_classmethod in current_procinfo.procdef.procoptions) or
                 (po_staticmethod in current_procinfo.procdef.procoptions) then
                 (po_staticmethod in current_procinfo.procdef.procoptions) then
                begin
                begin
                  asmlist.concat(Tai_stabs.Create(strpnew(
                  asmlist.concat(Tai_stabs.Create(strpnew(
                     '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
                     '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
-                    tostr(N_tsym)+',0,0,'+tostr(adjusted_address))));
+                    tostr(N_tsym)+',0,0,'+tostr(localloc.reference.offset))));
                end
                end
              else
              else
                begin
                begin
@@ -1909,13 +1928,13 @@ implementation
                    c:='p';
                    c:='p';
                  asmlist.concat(Tai_stabs.Create(strpnew(
                  asmlist.concat(Tai_stabs.Create(strpnew(
                     '"$t:'+c+current_procinfo.procdef._class.numberstring+'",'+
                     '"$t:'+c+current_procinfo.procdef._class.numberstring+'",'+
-                    tostr(N_tsym)+',0,0,'+tostr(adjusted_address))));
+                    tostr(N_tsym)+',0,0,'+tostr(localloc.reference.offset))));
                end;
                end;
            end
            end
          else
          else
-           if (reg<>NR_NO) then
+           if (localloc.loc=LOC_REGISTER) then
              begin
              begin
-                regidx:=findreg_by_number(reg);
+                regidx:=findreg_by_number(localloc.register);
                 { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
                 { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
                 { this is the register order for GDB}
                 { this is the register order for GDB}
                 stab_str:=strpnew('"'+name+':r'
                 stab_str:=strpnew('"'+name+':r'
@@ -1945,7 +1964,6 @@ implementation
               include(varoptions,vo_fpuregable)
               include(varoptions,vo_fpuregable)
             else
             else
               exclude(varoptions,vo_fpuregable);
               exclude(varoptions,vo_fpuregable);
-            reg:=NR_NO;
           end;
           end;
       end;
       end;
 
 
@@ -2657,7 +2675,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.118  2003-09-16 16:17:01  peter
+  Revision 1.119  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.118  2003/09/16 16:17:01  peter
     * varspez in calls to push_addr_param
     * varspez in calls to push_addr_param
 
 
   Revision 1.117  2003/09/14 13:20:12  peter
   Revision 1.117  2003/09/14 13:20:12  peter

+ 40 - 239
compiler/symtable.pas

@@ -35,9 +35,7 @@ interface
        { ppu }
        { ppu }
        ppu,symppu,
        ppu,symppu,
        { assembler }
        { assembler }
-       aasmbase,aasmtai,aasmcpu,
-       { cg }
-       paramgr
+       aasmbase,aasmtai,aasmcpu
        ;
        ;
 
 
 
 
@@ -94,18 +92,20 @@ interface
 
 
        tabstractrecordsymtable = class(tstoredsymtable)
        tabstractrecordsymtable = class(tstoredsymtable)
        public
        public
+          datasize  : longint;
+          dataalignment : byte;
+          constructor create(const n:string);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
-          procedure insertvardata(sym : tsymentry);override;
-          procedure insertfield(sym:tvarsym);
+          procedure insertfield(sym:tvarsym;addsym:boolean);
        end;
        end;
 
 
        trecordsymtable = class(tabstractrecordsymtable)
        trecordsymtable = class(tabstractrecordsymtable)
        public
        public
           constructor create;
           constructor create;
-          procedure insert_in(tsymt : tsymtable;offset : longint);
+          procedure insert_in(tsymt : trecordsymtable;offset : longint);
        end;
        end;
 
 
        tobjectsymtable = class(tabstractrecordsymtable)
        tobjectsymtable = class(tabstractrecordsymtable)
@@ -123,15 +123,12 @@ interface
        public
        public
           constructor create(level:byte);
           constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
-          procedure insertconstdata(sym : tsymentry);override;
        end;
        end;
 
 
        tparasymtable = class(tabstractlocalsymtable)
        tparasymtable = class(tabstractlocalsymtable)
        public
        public
           constructor create(level:byte);
           constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
        end;
        end;
 
 
        tabstractunitsymtable = class(tstoredsymtable)
        tabstractunitsymtable = class(tstoredsymtable)
@@ -146,8 +143,6 @@ interface
 {$ifdef GDB}
 {$ifdef GDB}
           procedure concattypestabto(asmlist : taasmoutput);
           procedure concattypestabto(asmlist : taasmoutput);
 {$endif GDB}
 {$endif GDB}
-          procedure insertvardata(sym : tsymentry);override;
-          procedure insertconstdata(sym : tsymentry);override;
        end;
        end;
 
 
        tglobalsymtable = class(tabstractunitsymtable)
        tglobalsymtable = class(tabstractunitsymtable)
@@ -161,7 +156,6 @@ interface
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure insert(sym : tsymentry);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
 {$ifdef GDB}
 {$ifdef GDB}
           function getnewtypecount : word; override;
           function getnewtypecount : word; override;
 {$endif}
 {$endif}
@@ -175,7 +169,6 @@ interface
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure insert(sym : tsymentry);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
        end;
        end;
 
 
        twithsymtable = class(tsymtable)
        twithsymtable = class(tsymtable)
@@ -356,10 +349,7 @@ implementation
           Message(unit_f_ppu_read_error);
           Message(unit_f_ppu_read_error);
          { skip amount of symbols, not used currently }
          { skip amount of symbols, not used currently }
          ppufile.getlongint;
          ppufile.getlongint;
-         { load datasize,dataalignment of this symboltable }
-         datasize:=ppufile.getlongint;
-         dataalignment:=byte(ppufile.getlongint);
-      { now read the symbols }
+         { now read the symbols }
          repeat
          repeat
            b:=ppufile.readentry;
            b:=ppufile.readentry;
            case b of
            case b of
@@ -391,18 +381,18 @@ implementation
       var
       var
          pd : tstoreddef;
          pd : tstoreddef;
       begin
       begin
-      { each definition get a number, write then the amount of defs to the
-         ibstartdef entry }
+         { each definition get a number, write then the amount of defs to the
+           ibstartdef entry }
          ppufile.putlongint(defindex.count);
          ppufile.putlongint(defindex.count);
          ppufile.writeentry(ibstartdefs);
          ppufile.writeentry(ibstartdefs);
-      { now write the definition }
+         { now write the definition }
          pd:=tstoreddef(defindex.first);
          pd:=tstoreddef(defindex.first);
          while assigned(pd) do
          while assigned(pd) do
            begin
            begin
               pd.ppuwrite(ppufile);
               pd.ppuwrite(ppufile);
               pd:=tstoreddef(pd.indexnext);
               pd:=tstoreddef(pd.indexnext);
            end;
            end;
-      { write end of definitions }
+         { write end of definitions }
          ppufile.writeentry(ibenddefs);
          ppufile.writeentry(ibenddefs);
       end;
       end;
 
 
@@ -411,20 +401,18 @@ implementation
       var
       var
         pd : tstoredsym;
         pd : tstoredsym;
       begin
       begin
-       { each definition get a number, write then the amount of syms and the
-         datasize to the ibsymdef entry }
+         { each definition get a number, write then the amount of syms and the
+           datasize to the ibsymdef entry }
          ppufile.putlongint(symindex.count);
          ppufile.putlongint(symindex.count);
-         ppufile.putlongint(datasize);
-         ppufile.putlongint(dataalignment);
          ppufile.writeentry(ibstartsyms);
          ppufile.writeentry(ibstartsyms);
-       { foreach is used to write all symbols }
+         { foreach is used to write all symbols }
          pd:=tstoredsym(symindex.first);
          pd:=tstoredsym(symindex.first);
          while assigned(pd) do
          while assigned(pd) do
            begin
            begin
               pd.ppuwrite(ppufile);
               pd.ppuwrite(ppufile);
               pd:=tstoredsym(pd.indexnext);
               pd:=tstoredsym(pd.indexnext);
            end;
            end;
-       { end of symbols }
+         { end of symbols }
          ppufile.writeentry(ibendsyms);
          ppufile.writeentry(ibendsyms);
       end;
       end;
 
 
@@ -712,7 +700,6 @@ implementation
               (vo_is_self in tvarsym(p).varoptions) or
               (vo_is_self in tvarsym(p).varoptions) or
               (vo_is_vmt in tvarsym(p).varoptions) or
               (vo_is_vmt in tvarsym(p).varoptions) or
               (vo_is_high_value in tvarsym(p).varoptions) or
               (vo_is_high_value in tvarsym(p).varoptions) or
-              assigned(tvarsym(p).localvarsym) or
               (copy(p.name,1,6)='hidden') then
               (copy(p.name,1,6)='hidden') then
              exit;
              exit;
            if (tvarsym(p).refs=0) then
            if (tvarsym(p).refs=0) then
@@ -724,8 +711,7 @@ implementation
                        (tprocdef(tsym(p).owner.defowner).proctypeoption<>potype_constructor) then
                        (tprocdef(tsym(p).owner.defowner).proctypeoption<>potype_constructor) then
                       MessagePos(tsym(p).fileinfo,sym_w_function_result_not_set)
                       MessagePos(tsym(p).fileinfo,sym_w_function_result_not_set)
                   end
                   end
-                else if (tsym(p).owner.symtabletype=parasymtable) or
-                        (vo_is_local_copy in tvarsym(p).varoptions) then
+                else if (tsym(p).owner.symtabletype=parasymtable) then
                   MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname)
                   MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname)
                 else if (tsym(p).owner.symtabletype=objectsymtable) then
                 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)
                   MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
@@ -734,8 +720,7 @@ implementation
              end
              end
            else if tvarsym(p).varstate=vs_assigned then
            else if tvarsym(p).varstate=vs_assigned then
              begin
              begin
-                if (tsym(p).owner.symtabletype=parasymtable) or
-                   (vo_is_local_copy in tvarsym(p).varoptions) then
+                if (tsym(p).owner.symtabletype=parasymtable) then
                   begin
                   begin
                     if not(tvarsym(p).varspez in [vs_var,vs_out]) and
                     if not(tvarsym(p).varspez in [vs_var,vs_out]) and
                        not(vo_is_funcret in tvarsym(p).varoptions) then
                        not(vo_is_funcret in tvarsym(p).varoptions) then
@@ -974,6 +959,14 @@ implementation
                           TAbstractRecordSymtable
                           TAbstractRecordSymtable
 ****************************************************************************}
 ****************************************************************************}
 
 
+    constructor tabstractrecordsymtable.create(const n:string);
+      begin
+        inherited create(n);
+        datasize:=0;
+        dataalignment:=1;
+      end;
+
+
     procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
     procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
       var
       var
         storesymtable : tsymtable;
         storesymtable : tsymtable;
@@ -1030,13 +1023,14 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tabstractrecordsymtable.insertvardata(sym : tsymentry);
+    procedure tabstractrecordsymtable.insertfield(sym : tvarsym;addsym:boolean);
       var
       var
         l,varalign : longint;
         l,varalign : longint;
         vardef : tdef;
         vardef : tdef;
       begin
       begin
-        if sym.typ<>varsym then
-         internalerror(200208251);
+        if addsym then
+          insert(sym);
+        { Calculate field offset }
         l:=tvarsym(sym).getvaluesize;
         l:=tvarsym(sym).getvaluesize;
         vardef:=tvarsym(sym).vartype.def;
         vardef:=tvarsym(sym).vartype.def;
         { this symbol can't be loaded to a register }
         { this symbol can't be loaded to a register }
@@ -1075,15 +1069,8 @@ implementation
         if varalign=0 then
         if varalign=0 then
           varalign:=size_2_align(l);
           varalign:=size_2_align(l);
         varalign:=used_align(varalign,aktalignment.recordalignmin,dataalignment);
         varalign:=used_align(varalign,aktalignment.recordalignmin,dataalignment);
-        tvarsym(sym).address:=align(datasize,varalign);
-        datasize:=tvarsym(sym).address+l;
-      end;
-
-
-    procedure tabstractrecordsymtable.insertfield(sym : tvarsym);
-      begin
-        insert(sym);
-        insertvardata(sym);
+        tvarsym(sym).fieldoffset:=align(datasize,varalign);
+        datasize:=tvarsym(sym).fieldoffset+l;
       end;
       end;
 
 
 
 
@@ -1103,7 +1090,7 @@ implementation
     { the offset is the location of the start of the variant
     { the offset is the location of the start of the variant
       and datasize and dataalignment corresponds to
       and datasize and dataalignment corresponds to
       the complete size (see code in pdecl unit) PM }
       the complete size (see code in pdecl unit) PM }
-    procedure trecordsymtable.insert_in(tsymt : tsymtable;offset : longint);
+    procedure trecordsymtable.insert_in(tsymt : trecordsymtable;offset : longint);
       var
       var
         ps,nps : tvarsym;
         ps,nps : tvarsym;
         pd,npd : tdef;
         pd,npd : tdef;
@@ -1122,11 +1109,11 @@ implementation
             ps.right:=nil;
             ps.right:=nil;
             { add to symt }
             { add to symt }
             ps.owner:=tsymt;
             ps.owner:=tsymt;
-            tsymt.datasize:=ps.address+offset;
+            tsymt.datasize:=ps.fieldoffset+offset;
             tsymt.symindex.insert(ps);
             tsymt.symindex.insert(ps);
             tsymt.symsearch.insert(ps);
             tsymt.symsearch.insert(ps);
             { update address }
             { update address }
-            ps.address:=tsymt.datasize;
+            ps.fieldoffset:=tsymt.datasize;
             { next }
             { next }
             ps:=nps;
             ps:=nps;
           end;
           end;
@@ -1285,78 +1272,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tlocalsymtable.insertvardata(sym : tsymentry);
-      var
-        l,varalign : longint;
-      begin
-        if not(sym.typ in [varsym]) then
-          internalerror(200208255);
-        case sym.typ of
-          varsym :
-            begin
-              tvarsym(sym).varstate:=vs_declared;
-              l:=tvarsym(sym).getvaluesize;
-              varalign:=size_2_align(l);
-              varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
-              if (tg.direction>0) then
-                begin
-                  { on the powerpc, the local variables are accessed with a positiv offset }
-                  tvarsym(sym).address:=align(datasize,varalign);
-                  datasize:=tvarsym(sym).address+l;
-                end
-              else
-                begin
-                  datasize:=align(datasize+l,varalign);
-                  tvarsym(sym).address:=-datasize;
-                end;
-            end;
-        end;
-      end;
-
-
-    procedure tlocalsymtable.insertconstdata(sym : tsymentry);
-    { this does not affect the local stack space, since all
-      typed constansts and initialized variables are always
-      put in the .data / .rodata section
-    }
-      var
-        storefilepos : tfileposinfo;
-        curconstsegment : taasmoutput;
-        l : longint;
-      begin
-        { Note: this is the same code as tabstractunitsymtable.insertconstdata }
-        if sym.typ<>typedconstsym then
-         internalerror(200208254);
-        storefilepos:=aktfilepos;
-        aktfilepos:=tsym(sym).fileinfo;
-        if ttypedconstsym(sym).is_writable then
-          curconstsegment:=datasegment
-        else
-          curconstsegment:=consts;
-        l:=ttypedconstsym(sym).getsize;
-        { insert cut for smartlinking or alignment }
-        if (cs_create_smart in aktmoduleswitches) then
-          curconstSegment.concat(Tai_cut.Create);
-        curconstSegment.concat(Tai_align.create(const_align(l)));
-{$ifdef GDB}
-        if cs_debuginfo in aktmoduleswitches then
-          ttypedconstsym(sym).concatstabto(curconstsegment);
-{$endif GDB}
-        if (cs_create_smart in aktmoduleswitches) or
-           DLLSource then
-          begin
-            curconstSegment.concat(Tai_symbol.Createdataname_global(
-                ttypedconstsym(sym).mangledname,l));
-          end
-        else
-          begin
-            curconstSegment.concat(Tai_symbol.Createdataname(
-                ttypedconstsym(sym).mangledname,l));
-          end;
-        aktfilepos:=storefilepos;
-      end;
-
-
 {****************************************************************************
 {****************************************************************************
                               TParaSymtable
                               TParaSymtable
 ****************************************************************************}
 ****************************************************************************}
@@ -1366,8 +1281,6 @@ implementation
         inherited create('');
         inherited create('');
         symtabletype:=parasymtable;
         symtabletype:=parasymtable;
         symtablelevel:=level;
         symtablelevel:=level;
-        dataalignment:=aktalignment.paraalign;
-        address_fixup:=target_info.first_parm_offset;
       end;
       end;
 
 
 
 
@@ -1401,28 +1314,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tparasymtable.insertvardata(sym : tsymentry);
-      var
-        l,varalign : longint;
-      begin
-        if sym.typ<>varsym then
-          internalerror(200208253);
-        { retrieve cdecl status }
-        if defowner.deftype<>procdef then
-          internalerror(200208256);
-        { here we need the size of a push instead of the
-          size of the data }
-        l:=paramanager.push_size(tvarsym(sym).varspez,tvarsym(sym).vartype.def,tprocdef(defowner).proccalloption);
-        varalign:=size_2_align(l);
-        tvarsym(sym).varstate:=vs_assigned;
-        { we need the new datasize already aligned so we can't
-          use the align_address here }
-        tvarsym(sym).address:=datasize;
-        varalign:=used_align(varalign,dataalignment,dataalignment);
-        datasize:=align(tvarsym(sym).address+l,varalign);
-      end;
-
-
 {****************************************************************************
 {****************************************************************************
                          TAbstractUnitSymtable
                          TAbstractUnitSymtable
 ****************************************************************************}
 ****************************************************************************}
@@ -1441,80 +1332,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tabstractunitsymtable.insertvardata(sym : tsymentry);
-      var
-        l,varalign : longint;
-        storefilepos : tfileposinfo;
-      begin
-        if sym.typ<>varsym then
-         internalerror(200208252);
-        storefilepos:=aktfilepos;
-        aktfilepos:=tsym(sym).fileinfo;
-        l:=tvarsym(sym).getvaluesize;
-        if (vo_is_thread_var in tvarsym(sym).varoptions) then
-          inc(l,pointer_size);
-        varalign:=var_align(l);
-        tvarsym(sym).address:=align(datasize,varalign);
-        { insert cut for smartlinking or alignment }
-        if (cs_create_smart in aktmoduleswitches) then
-          bssSegment.concat(Tai_cut.Create);
-        bssSegment.concat(Tai_align.create(varalign));
-        datasize:=tvarsym(sym).address+l;
-{$ifdef GDB}
-        if cs_debuginfo in aktmoduleswitches then
-           tvarsym(sym).concatstabto(bsssegment);
-{$endif GDB}
-        if (symtabletype=globalsymtable) or
-           (cs_create_smart in aktmoduleswitches) or
-           DLLSource or
-           (vo_is_exported in tvarsym(sym).varoptions) or
-           (vo_is_C_var in tvarsym(sym).varoptions) then
-          bssSegment.concat(Tai_datablock.Create_global(tvarsym(sym).mangledname,l))
-        else
-          bssSegment.concat(Tai_datablock.Create(tvarsym(sym).mangledname,l));
-        aktfilepos:=storefilepos;
-      end;
-
-
-    procedure tabstractunitsymtable.insertconstdata(sym : tsymentry);
-      var
-        storefilepos : tfileposinfo;
-        curconstsegment : taasmoutput;
-        l : longint;
-      begin
-        if sym.typ<>typedconstsym then
-         internalerror(200208254);
-        storefilepos:=aktfilepos;
-        aktfilepos:=tsym(sym).fileinfo;
-        if ttypedconstsym(sym).is_writable then
-          curconstsegment:=datasegment
-        else
-          curconstsegment:=consts;
-        l:=ttypedconstsym(sym).getsize;
-        { insert cut for smartlinking or alignment }
-        if (cs_create_smart in aktmoduleswitches) then
-          curconstSegment.concat(Tai_cut.Create);
-        curconstSegment.concat(Tai_align.create(const_align(l)));
-{$ifdef GDB}
-        if cs_debuginfo in aktmoduleswitches then
-          ttypedconstsym(sym).concatstabto(curconstsegment);
-{$endif GDB}
-        if (symtabletype=globalsymtable) or
-           (cs_create_smart in aktmoduleswitches) or
-           DLLSource then
-          begin
-            curconstSegment.concat(Tai_symbol.Createdataname_global(
-                ttypedconstsym(sym).mangledname,l));
-          end
-        else
-          begin
-            curconstSegment.concat(Tai_symbol.Createdataname(
-                ttypedconstsym(sym).mangledname,l));
-          end;
-        aktfilepos:=storefilepos;
-      end;
-
-
 {$ifdef GDB}
 {$ifdef GDB}
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
         var prev_dbx_count : plongint;
         var prev_dbx_count : plongint;
@@ -1654,15 +1471,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tstaticsymtable.insertvardata(sym : tsymentry);
-      begin
-        inherited insertvardata(sym);
-        { enable unitialized warning for local symbols }
-        if sym.typ=varsym then
-          tvarsym(sym).varstate:=vs_declared;
-      end;
-
-
 {****************************************************************************
 {****************************************************************************
                               TGlobalSymtable
                               TGlobalSymtable
 ****************************************************************************}
 ****************************************************************************}
@@ -1846,18 +1654,6 @@ implementation
       end;
       end;
 
 
 
 
-    procedure tglobalsymtable.insertvardata(sym : tsymentry);
-      begin
-        inherited insertvardata(sym);
-        { this symbol can't be loaded to a register }
-        if sym.typ=varsym then
-         begin
-           exclude(tvarsym(sym).varoptions,vo_regable);
-           exclude(tvarsym(sym).varoptions,vo_fpuregable);
-         end;
-      end;
-
-
 {$ifdef GDB}
 {$ifdef GDB}
    function tglobalsymtable.getnewtypecount : word;
    function tglobalsymtable.getnewtypecount : word;
       begin
       begin
@@ -2431,7 +2227,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.109  2003-08-23 22:31:08  peter
+  Revision 1.110  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.109  2003/08/23 22:31:08  peter
     * unchain operators before adding to overloaded list
     * unchain operators before adding to overloaded list
 
 
   Revision 1.108  2003/06/25 18:31:23  peter
   Revision 1.108  2003/06/25 18:31:23  peter

+ 33 - 20
compiler/tgobj.pas

@@ -35,18 +35,10 @@ unit tgobj;
     uses
     uses
       globals,
       globals,
       cpubase,
       cpubase,
-      cpuinfo,
+      cpuinfo,cginfo,
       cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
       cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
 
 
     type
     type
-      ttemptype = (tt_none,
-                   tt_free,tt_normal,tt_persistent,
-                   tt_noreuse,tt_freenoreuse,
-                   tt_ansistring,tt_freeansistring,
-                   tt_widestring,tt_freewidestring,
-                   tt_interfacecom,tt_freeinterfacecom);
-      ttemptypeset = set of ttemptype;
-
       ptemprecord = ^ttemprecord;
       ptemprecord = ^ttemprecord;
       ttemprecord = record
       ttemprecord = record
          temptype   : ttemptype;
          temptype   : ttemptype;
@@ -104,6 +96,10 @@ unit tgobj;
              is not in the temporary memory, it is simply not freed.
              is not in the temporary memory, it is simply not freed.
           }
           }
           procedure ungetiftemp(list: taasmoutput; const ref : treference);
           procedure ungetiftemp(list: taasmoutput; const ref : treference);
+
+          { Allocate space for a local }
+          procedure getlocal(list: taasmoutput; size : longint;var ref : tparareference);
+          procedure UnGetLocal(list: taasmoutput; const ref : tparareference);
        end;
        end;
 
 
      var
      var
@@ -114,8 +110,8 @@ unit tgobj;
 
 
     uses
     uses
        systems,
        systems,
-       verbose,cutils,
-       cginfo,rgobj;
+       verbose,cutils
+       ;
 
 
 
 
     const
     const
@@ -423,10 +419,13 @@ unit tgobj;
 
 
 
 
     procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
     procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
-
-    begin
-      reference_reset_base(ref,current_procinfo.framepointer,alloctemp(list,size,temptype));
-    end;
+      begin
+        { can't use reference_reset_base, because that will let tgobj depend
+          on rgobj (PFV) }
+        fillchar(ref,sizeof(ref),0);
+        ref.base:=current_procinfo.framepointer;
+        ref.offset:=alloctemp(list,size,temptype);
+      end;
 
 
 
 
     function ttgobj.istemp(const ref : treference) : boolean;
     function ttgobj.istemp(const ref : treference) : boolean;
@@ -525,14 +524,28 @@ unit tgobj;
       end;
       end;
 
 
 
 
-initialization
-  tg := ttgobj.create;
-finalization
-  tg.free;
+    procedure ttgobj.getlocal(list: taasmoutput; size : longint;var ref : tparareference);
+      begin
+        ref.index:=current_procinfo.framepointer;
+        ref.offset:=alloctemp(list,size,tt_persistent);
+      end;
+
+
+    procedure ttgobj.UnGetLocal(list: taasmoutput; const ref : tparareference);
+      begin
+        FreeTemp(list,ref.offset,[tt_persistent]);
+      end;
+
+
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.38  2003-09-03 15:55:01  peter
+  Revision 1.39  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.38  2003/09/03 15:55:01  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.37.2.2  2003/08/31 15:46:26  peter
   Revision 1.37.2.2  2003/08/31 15:46:26  peter

File diff suppressed because it is too large
+ 2262 - 2236
compiler/x86/aasmcpu.pas


+ 6 - 4
compiler/x86/agx86att.pas

@@ -62,9 +62,6 @@ interface
       begin
       begin
         with ref do
         with ref do
          begin
          begin
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
-
            { have we a segment prefix ? }
            { have we a segment prefix ? }
            { These are probably not correctly handled under GAS }
            { These are probably not correctly handled under GAS }
            { should be replaced by coding the segment override  }
            { should be replaced by coding the segment override  }
@@ -311,7 +308,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2003-09-03 15:55:02  peter
+  Revision 1.6  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.5  2003/09/03 15:55:02  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.4.2.1  2003/08/31 15:46:26  peter
   Revision 1.4.2.1  2003/08/31 15:46:26  peter

+ 6 - 22
compiler/x86/cpubase.pas

@@ -225,8 +225,6 @@ uses
 *****************************************************************************}
 *****************************************************************************}
 
 
     type
     type
-      trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
-
       { reference record }
       { reference record }
       preference = ^treference;
       preference = ^treference;
       treference = packed record
       treference = packed record
@@ -236,8 +234,6 @@ uses
          scalefactor : byte;
          scalefactor : byte;
          offset      : longint;
          offset      : longint;
          symbol      : tasmsymbol;
          symbol      : tasmsymbol;
-         offsetfixup : longint;
-         options     : trefoptions;
       end;
       end;
 
 
       { reference record }
       { reference record }
@@ -247,23 +243,6 @@ uses
          offset      : longint;
          offset      : longint;
       end;
       end;
 
 
-{*****************************************************************************
-                                Operands
-*****************************************************************************}
-
-      { Types of operand }
-      toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
-
-      toper=record
-        ot  : longint;
-        case typ : toptype of
-         top_none   : ();
-         top_reg    : (reg:tregister);
-         top_ref    : (ref:preference);
-         top_const  : (val:aword);
-         top_symbol : (sym:tasmsymbol;symofs:longint);
-      end;
-
 {*****************************************************************************
 {*****************************************************************************
                                Generic Location
                                Generic Location
 *****************************************************************************}
 *****************************************************************************}
@@ -559,7 +538,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.17  2003-09-07 22:09:35  peter
+  Revision 1.18  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.17  2003/09/07 22:09:35  peter
     * preparations for different default calling conventions
     * preparations for different default calling conventions
     * various RA fixes
     * various RA fixes
 
 

+ 33 - 23
compiler/x86/radirect.pas

@@ -79,9 +79,12 @@ interface
            if s<>'' then
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
             { consider it set function set if the offset was loaded }
+{$warning TODO Fix setting of funcret vs_assigned}
+(*
            if assigned(current_procinfo.procdef.funcretsym) and
            if assigned(current_procinfo.procdef.funcretsym) and
               (pos(retstr,upper(s))>0) then
               (pos(retstr,upper(s))>0) then
              tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
              tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+*)
            s:='';
            s:='';
          end;
          end;
 
 
@@ -91,11 +94,15 @@ interface
        if assigned(current_procinfo.procdef.funcretsym) and
        if assigned(current_procinfo.procdef.funcretsym) and
           is_fpu(current_procinfo.procdef.rettype.def) then
           is_fpu(current_procinfo.procdef.rettype.def) then
          tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
          tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-       framereg:=current_procinfo.framepointer;
+(*
+       if tvarsym(current_procinfo.procdef.funcretsym).localloc.loc<>LOC_REFERENCE then
+         internalerror(2003091813);
+       framereg:=tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.index;
        if (not is_void(current_procinfo.procdef.rettype.def)) then
        if (not is_void(current_procinfo.procdef.rettype.def)) then
-         retstr:=upper(tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address)+'('+gas_regname(framereg)+')')
+         retstr:=upper(tostr(tvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)+'('+gas_regname(framereg)+')')
        else
        else
          retstr:='';
          retstr:='';
+*)
        c:=current_scanner.asmgetchar;
        c:=current_scanner.asmgetchar;
        code:=TAAsmoutput.Create;
        code:=TAAsmoutput.Create;
        while not(ende) do
        while not(ende) do
@@ -164,18 +171,17 @@ interface
                                            end
                                            end
                                          else if sym.typ=varsym then
                                          else if sym.typ=varsym then
                                            begin
                                            begin
-                                           {variables set are after a comma }
-                                           {like in movl %eax,I }
-                                           if pos(',',s) > 0 then
-                                             tvarsym(sym).varstate:=vs_used
-                                           else
-                                           if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
-                                            Message1(sym_n_uninitialized_local_variable,hs);
-                                           if (vo_is_external in tvarsym(sym).varoptions) then
-                                             hs:=tvarsym(sym).mangledname
-                                           else
-                                             hs:='-'+tostr(tvarsym(sym).address)+
-                                                 '('+gas_regname(framereg)+')';
+                                             {variables set are after a comma }
+                                             {like in movl %eax,I }
+                                             if pos(',',s) > 0 then
+                                               tvarsym(sym).varstate:=vs_used
+                                             else
+                                               if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
+                                                 Message1(sym_n_uninitialized_local_variable,hs);
+                                             if (vo_is_external in tvarsym(sym).varoptions) then
+                                               hs:=tvarsym(sym).mangledname
+                                             else
+                                               hs:='%%'+tvarsym(sym).name;
                                            end
                                            end
                                          else
                                          else
                                          { call to local function }
                                          { call to local function }
@@ -195,12 +201,9 @@ interface
                                            begin
                                            begin
                                               if sym.typ=varsym then
                                               if sym.typ=varsym then
                                                 begin
                                                 begin
-                                                   l:=tvarsym(sym).address;
-                                                   { set offset }
-                                                   inc(l,current_procinfo.procdef.parast.address_fixup);
-                                                   hs:=tostr(l)+'('+gas_regname(framereg)+')';
-                                                   if pos(',',s) > 0 then
-                                                     tvarsym(sym).varstate:=vs_used;
+                                                  hs:='%%'+tvarsym(sym).name;
+                                                  if pos(',',s) > 0 then
+                                                    tvarsym(sym).varstate:=vs_used;
                                                 end;
                                                 end;
                                            end
                                            end
                                     { I added that but it creates a problem in line.ppi
                                     { I added that but it creates a problem in line.ppi
@@ -287,8 +290,7 @@ interface
                                                   case sym.typ of
                                                   case sym.typ of
                                                     varsym :
                                                     varsym :
                                                       begin
                                                       begin
-                                                        hs:=tostr(tvarsym(sym).adjusted_address)+
-                                                            '('+gas_regname(framereg)+')';
+                                                        hs:='%%'+tvarsym(sym).name;
                                                         inc(tvarsym(sym).refs);
                                                         inc(tvarsym(sym).refs);
                                                       end;
                                                       end;
                                                     typedconstsym :
                                                     typedconstsym :
@@ -311,8 +313,11 @@ interface
                 end;
                 end;
               '{',';',#10,#13 :
               '{',';',#10,#13 :
                 begin
                 begin
+{$warning TODO Fix setting of funcret vs_assigned}
+(*
                   if pos(retstr,s) > 0 then
                   if pos(retstr,s) > 0 then
                     tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
                     tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+*)
                   writeasmline;
                   writeasmline;
                   c:=current_scanner.asmgetchar;
                   c:=current_scanner.asmgetchar;
                 end;
                 end;
@@ -360,7 +365,12 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2003-09-03 15:55:02  peter
+  Revision 1.9  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.8  2003/09/03 15:55:02  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.7.2.1  2003/08/27 21:06:34  peter
   Revision 1.7.2.1  2003/08/27 21:06:34  peter

+ 9 - 1
compiler/x86/rax86.pas

@@ -266,6 +266,7 @@ begin
    if t386operand(operands[i]).opsize=S_NO then
    if t386operand(operands[i]).opsize=S_NO then
     begin
     begin
       case operands[i].Opr.Typ of
       case operands[i].Opr.Typ of
+        OPR_LOCAL,
         OPR_REFERENCE :
         OPR_REFERENCE :
           begin
           begin
             if i=2 then
             if i=2 then
@@ -669,6 +670,8 @@ begin
          ai.loadreg(i-1,operands[i].opr.reg);
          ai.loadreg(i-1,operands[i].opr.reg);
        OPR_SYMBOL:
        OPR_SYMBOL:
          ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
          ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
+       OPR_LOCAL :
+         ai.loadlocal(i-1,operands[i].opr.localsym,operands[i].opr.localsymofs);
        OPR_REFERENCE:
        OPR_REFERENCE:
          begin
          begin
            ai.loadref(i-1,operands[i].opr.ref);
            ai.loadref(i-1,operands[i].opr.ref);
@@ -729,7 +732,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2003-09-03 15:55:02  peter
+  Revision 1.9  2003-09-23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.8  2003/09/03 15:55:02  peter
     * NEWRA branch merged
     * NEWRA branch merged
 
 
   Revision 1.7.2.4  2003/08/31 16:18:05  peter
   Revision 1.7.2.4  2003/08/31 16:18:05  peter

Some files were not shown because too many files changed in this diff