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,
        globtype,globals,systems,
        cginfo,cpuinfo,cpubase,
-       symppu,
+       symppu,symtype,
        aasmbase;
 
     type
@@ -141,6 +141,23 @@ interface
           '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   }
 { 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 }
@@ -439,6 +456,7 @@ interface
           procedure SetCondition(const c:TAsmCond);
           procedure loadconst(opidx:longint;l:aword);
           procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+          procedure loadlocal(opidx:longint;s:pointer;sofs:longint);
           procedure loadref(opidx:longint;const r:treference);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
@@ -1538,6 +1556,23 @@ implementation
       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);
       begin
         if opidx>=ops then
@@ -2106,7 +2141,12 @@ implementation
 end.
 {
   $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
     * various RA fixes
 

+ 18 - 7
compiler/aggas.pas

@@ -681,16 +681,22 @@ var
 {$ifdef GDB}
            ait_stabs :
              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;
 
            ait_stabn :
              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;
 
            ait_force_line :
@@ -826,7 +832,12 @@ var
 end.
 {
   $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
 
   Revision 1.33  2003/09/04 00:15:29  florian

+ 14 - 3
compiler/assemble.pas

@@ -1120,9 +1120,15 @@ Implementation
                end;
 {$ifdef GDB}
              ait_stabn :
-               convertstabs(Tai_stabn(hp).str);
+               begin
+                 if assigned(Tai_stabn(hp).str) then
+                   convertstabs(Tai_stabn(hp).str);
+               end;
              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 :
                begin
                  if assigned(Tai_stab_function_name(hp).str) then
@@ -1640,7 +1646,12 @@ Implementation
 end.
 {
   $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
 
   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_offset : longint;
 
+          { Size of the parameters on the stack }
+          para_stack_size : longint;
+
           {# some collected informations about the procedure
              see pi_xxxx constants above
           }
@@ -308,6 +311,8 @@ implementation
       begin
         parent:=aparent;
         procdef:=nil;
+        para_stack_size:=0;
+{$warning TODO maybe remove parent_framepointer_offset for i386}
         parent_framepointer_offset:=0;
         firsttemp_offset:=0;
         flags:=[];
@@ -330,8 +335,7 @@ implementation
 
     procedure tprocinfo.allocate_parent_framepointer_parameter;
       begin
-        parent_framepointer_offset:=procdef.parast.address_fixup;
-        inc(procdef.parast.address_fixup,POINTER_SIZE);
+        parent_framepointer_offset:=target_info.first_parm_offset;
       end;
 
 
@@ -364,18 +368,14 @@ implementation
 
 
     procedure tprocinfo.handle_body_start;
-      var
-        paramloc : tparalocation;
-        regidx : tregisterindex;
       begin
-         { generate callee paraloc register info }
-         paramanager.create_paraloc_info(current_procinfo.procdef,calleeside);
-
+(*
          { temporary space is set, while the BEGIN of the procedure }
          if (symtablestack.symtabletype=localsymtable) then
            current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
          else
            current_procinfo.firsttemp_offset := 0;
+*)
       end;
 
 
@@ -546,7 +546,12 @@ implementation
 end.
 {
   $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
 
   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 }
       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
        { Invalid register number }
        RS_INVALID    = $ff;
@@ -306,7 +316,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.25  2003/09/04 21:07:03  florian

+ 6 - 3
compiler/i386/ag386int.pas

@@ -158,8 +158,6 @@ implementation
         with ref do
          begin
            first:=true;
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
            if segment<>NR_NO then
             AsmWrite(masm_regname(segment)+':[')
            else
@@ -892,7 +890,12 @@ initialization
 end.
 {
   $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
 
   Revision 1.37  2003/09/03 15:55:01  peter

+ 6 - 3
compiler/i386/ag386nsm.pas

@@ -227,8 +227,6 @@ interface
          begin
            AsmWrite('[');
            first:=true;
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
            if (segment<>NR_NO) then
              AsmWrite(nasm_regname(segment)+':');
            if assigned(symbol) then
@@ -902,7 +900,12 @@ initialization
 end.
 {
   $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
 
   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 getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
           procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
-          function getselflocation(p : tabstractprocdef) : tparalocation;override;
        private
           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;
 
   implementation
 
     uses
-       systems,verbose,
+       cutils,
+       systems,globals,verbose,
        symsym,
        cpuinfo,
        cgbase;
@@ -237,11 +237,19 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+    function ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         hp : tparaitem;
         paraloc : tparalocation;
+        l,
+        varalign,
+        parasize : longint;
       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);
         while assigned(hp) do
           begin
@@ -254,22 +262,36 @@ unit cpupara;
               paraloc.reference.index:=current_procinfo.framepointer
             else
               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;
-{$warning callerparaloc shall not be the same as calleeparaloc}
             hp:=tparaitem(hp.next);
           end;
+        { We need to return the size allocated }
+        result:=parasize;
       end;
 
 
-    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+    function ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         hp : tparaitem;
         paraloc : tparalocation;
         sr : tsuperregister;
         subreg : tsubregister;
+        is_64bit : boolean;
+        l,
+        varalign,
+        parasize : longint;
       begin
         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);
         while assigned(hp) do
           begin
@@ -277,22 +299,35 @@ unit cpupara;
               paraloc.size:=OS_ADDR
             else
               paraloc.size:=def_cgsize(hp.paratype.def);
+            is_64bit:=(paraloc.size in [OS_64,OS_S64,OS_F64]);
             {
               EAX
               EDX
               ECX
               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
                 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
-                  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
             else
               begin
@@ -301,38 +336,34 @@ unit cpupara;
                   paraloc.reference.index:=current_procinfo.framepointer
                 else
                   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;
             hp.paraloc[side]:=paraloc;
-{$warning callerparaloc shall not be the same as calleeparaloc}
             hp:=tparaitem(hp.next);
           end;
+        { We need to return the size allocated }
+        result:=parasize;
       end;
 
 
     procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
+      var
+        l : longint;
       begin
         if (p.proccalloption=pocall_register) or
            ((pocall_default=pocall_register) and
             (p.proccalloption in [pocall_compilerproc,pocall_internproc])) then
-          create_register_paraloc_info(p,side)
+          l:=create_register_paraloc_info(p,side)
         else
-          create_stdcall_paraloc_info(p,side);
+          l:=create_stdcall_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;
 
 
@@ -341,7 +372,12 @@ begin
 end.
 {
   $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
 
   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
            to cope with the IRETD
            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;
 
 
@@ -76,7 +77,12 @@ begin
 end.
 {
   $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
 
   Revision 1.10  2003/09/03 15:55:01  peter

+ 8 - 3
compiler/i386/n386cal.pas

@@ -84,7 +84,7 @@ implementation
       begin
         pop_size:=0;
         { This parasize aligned on 4 ? }
-        i:=procdefinition.parast.datasize and 3;
+        i:=pushedparasize and 3;
         if i>0 then
          inc(pop_size,4-i);
         { insert the opcode and update pushedparasize }
@@ -104,7 +104,7 @@ implementation
          if pop_allowed and (cs_align in aktglobalswitches) then
            begin
               pop_esp:=true;
-              push_size:=procdefinition.parast.datasize;
+              push_size:=pushedparasize;
               { !!!! here we have to take care of return type, self
                 and nested procedures
               }
@@ -170,7 +170,12 @@ begin
 end.
 {
   $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
 
   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;
 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
-    if tsym(procdef.parast.symindex.first).typ=varsym then
-      getselfoffsetfromsp:=tvarsym(procdef.parast.symindex.first).address+4
-    else
-      Internalerror(2000061310);
+    getselfoffsetfromsp:=4;
 end;
 
 
@@ -228,7 +226,12 @@ initialization
 end.
 {
   $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
     * various RA fixes
 

+ 34 - 13
compiler/i386/ra386att.pas

@@ -1311,14 +1311,24 @@ var
      end;
     if actasmtoken in [AS_PLUS,AS_MINUS] then
      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;
 
   function MaybeBuildReference:boolean;
@@ -1502,10 +1512,16 @@ Begin
                     if (actasmtoken=AS_PLUS) then
                      begin
                        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
                  else
@@ -2113,7 +2129,12 @@ finalization
 end.
 {
   $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
 
   Revision 1.45.2.2  2003/08/31 15:46:26  peter

+ 31 - 20
compiler/i386/ra386int.pas

@@ -1360,23 +1360,23 @@ var
      end;
     if actasmtoken in [AS_PLUS,AS_MINUS] then
      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
-          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;
-       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;
 
 Begin
@@ -1492,10 +1492,16 @@ Begin
                      if (actasmtoken=AS_PLUS) then
                       begin
                         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
                   else
@@ -1923,7 +1929,12 @@ finalization
 end.
 {
   $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
 
   Revision 1.49.2.2  2003/08/31 15:46:26  peter

+ 6 - 23
compiler/nbas.pas

@@ -30,7 +30,6 @@ interface
        cpubase,cginfo,
        aasmbase,aasmtai,aasmcpu,
        node,
-       tgobj,
        symtype,symppu;
 
     type
@@ -132,11 +131,6 @@ interface
           function det_resulttype : tnode; override;
           procedure mark_write;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
           tempinfo: ptempinfo;
           offset : longint;
@@ -751,22 +745,6 @@ implementation
     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
 *****************************************************************************}
@@ -854,7 +832,12 @@ begin
 end.
 {
   $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
     * various RA fixes
 

+ 8 - 3
compiler/ncal.pas

@@ -187,7 +187,7 @@ implementation
       htypechk,pass_1,cpubase,
       ncnv,nld,ninl,nadd,ncon,nmem,
       nutils,
-      tgobj,rgobj,cginfo,cgbase
+      rgobj,cginfo,cgbase
       ;
 
 type
@@ -1864,7 +1864,7 @@ type
               pt.used_by_callnode:=used_by_callnode;
               oldppt^:=pt;
             end;
-           { Bind paraitem to this node }
+           { Bind paraitem to this node and varsym }
            pt.paraitem:=currpara;
            { Next node and paraitem }
            oldppt:[email protected];
@@ -2514,7 +2514,12 @@ begin
 end.
 {
   $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
 
   Revision 1.179  2003/09/07 22:09:35  peter

+ 89 - 36
compiler/ncgbas.pas

@@ -27,6 +27,7 @@ unit ncgbas;
 interface
 
     uses
+       cpubase,
        node,nbas;
 
     type
@@ -52,6 +53,11 @@ interface
 
        tcgtemprefnode = class(ttemprefnode)
           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;
 
        tcgtempdeletenode = class(ttempdeletenode)
@@ -64,7 +70,6 @@ interface
       globtype,systems,
       cutils,verbose,globals,
       aasmbase,aasmtai,aasmcpu,symsym,
-      cpubase,
       nflw,pass_2,
       cgbase,cginfo,cgobj,tgobj,rgobj
       ;
@@ -124,9 +129,36 @@ interface
            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
         hp,hp2 : tai;
-        localfixup,parafixup,
         i : longint;
         skipnode : boolean;
       begin
@@ -141,11 +173,9 @@ interface
          { Allocate registers used in the assembler block }
          rg.allocexplicitregistersint(exprasmlist,used_regs_int);
 
-         if inlining_procedure then
+         if (current_procinfo.procdef.proccalloption=pocall_inline) then
            begin
              objectlibrary.CreateUsedAsmSymbolList;
-             localfixup:=current_procinfo.procdef.localst.address_fixup;
-             parafixup:=current_procinfo.procdef.parast.address_fixup;
              hp:=tai(p_asm.first);
              while assigned(hp) do
               begin
@@ -153,15 +183,10 @@ interface
                 skipnode:=false;
                 case hp2.typ of
                   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_symbol :
-                     begin
-                       ReLabel(tai_const_symbol(hp2).sym);
-                     end;
+                     ReLabel(tai_const_symbol(hp2).sym);
                   ait_instruction :
                      begin
                        { remove cached insentry, because the new code can
@@ -174,25 +199,16 @@ interface
                        { fixup the references }
                        for i:=1 to taicpu(hp2).ops do
                         begin
+                          ResolveRef(taicpu(hp2).oper[i-1]);
                           with taicpu(hp2).oper[i-1] do
                            begin
                              case typ of
                                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 :
-                                 begin
-                                   ReLabel(sym);
-                                 end;
-                              end;
+                                 ReLabel(sym);
+                             end;
                            end;
                         end;
                      end;
@@ -202,12 +218,11 @@ interface
                        if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
                         skipnode:=true;
                      end;
-                   else
                 end;
                 if not skipnode then
-                 exprasmList.concat(hp2)
+                  exprasmList.concat(hp2)
                 else
-                 hp2.free;
+                  hp2.free;
                 hp:=tai(hp.next);
               end;
              { restore used symbols }
@@ -216,12 +231,28 @@ interface
            end
          else
            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;
 
          { Release register used in the assembler block }
@@ -289,6 +320,23 @@ interface
         inc(location.reference.offset,offset);
       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
 *****************************************************************************}
@@ -315,7 +363,12 @@ begin
 end.
 {
   $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
     * various RA fixes
 

+ 13 - 2
compiler/ncgcal.pas

@@ -1004,6 +1004,11 @@ implementation
          mangled_length  : longint;
 {$endif GDB}
       begin
+
+{$warning TODO Fix inlining}
+         internalerror(200309211);
+
+(*
          if not(assigned(procdefinition) and (procdefinition.deftype=procdef)) then
            internalerror(200305262);
 
@@ -1026,7 +1031,7 @@ implementation
              with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
                for i := 1 to maxvarregs do
                  if assigned(regvars[i]) then
-                   store_regvar(exprasmlist,regvars[i].reg);
+                   store_regvar(exprasmlist,regvars[i].localloc.register);
              rg.saveStateForInline(oldregstate);
              { make sure the register allocator knows what the regvars in the }
              { inlined code block are (JM)                                    }
@@ -1296,6 +1301,7 @@ implementation
          { procedure (JM)                                                     }
          if assigned(current_procinfo.procdef.regvarinfo) then
            rg.restoreStateAfterInline(oldregstate);
+*)
       end;
 
 
@@ -1314,7 +1320,12 @@ begin
 end.
 {
   $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
 
   Revision 1.114  2003/09/14 19:17:39  peter

+ 27 - 7
compiler/ncgflw.pas

@@ -1135,8 +1135,8 @@ implementation
          doobjectdestroyandreraise,
          doobjectdestroy,
          oldaktbreaklabel : tasmlabel;
-         ref : treference;
          oldflowcontrol : tflowcontrol;
+         exceptref,
          tempbuf,tempaddr : treference;
          href : treference;
          href2: treference;
@@ -1160,13 +1160,22 @@ implementation
 
          { 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);
-         ref.symbol:=nil;
-         tg.GetTemp(exprasmlist,pointer_size,tt_normal,ref);
 
          { what a hack ! }
          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 }
          { we've to destroy the old one                }
@@ -1214,7 +1223,13 @@ implementation
          cg.a_label(exprasmlist,doobjectdestroy);
          cleanupobjectstack;
          { 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);
 
          if assigned(right) then
@@ -1429,7 +1444,12 @@ begin
 end.
 {
   $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
 
   Revision 1.79  2003/09/07 22:09:35  peter

+ 32 - 16
compiler/ncgld.pas

@@ -54,7 +54,7 @@ implementation
       aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
-      tgobj,ncgutil,cgobj,rgobj;
+      tgobj,ncgutil,cgobj,rgobj,ncgbas;
 
 {*****************************************************************************
                              SecondLoad
@@ -84,7 +84,7 @@ implementation
                      if tabsolutesym(symtableentry).absseg then
                       location.reference.segment:=NR_FS;
 {$endif i386}
-                     location.reference.offset:=tabsolutesym(symtableentry).address;
+                     location.reference.offset:=tabsolutesym(symtableentry).fieldoffset;
                    end
                   else
                    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 }
                        paraloc1:=paramanager.getintparaloc(pocall_default,1);
                        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);
                        reference_reset_symbol(href,objectlibrary.newasmsymboldata('FPC_THREADVAR_RELOCATE'),0);
                        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);
                        cg.a_param_ref(exprasmlist,OS_ADDR,href,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));
-                       cg.a_call_reg(exprasmlist,hregister);
+                       cg.a_call_reg(exprasmlist,r);
                        rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
                        r:=rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
                        rg.ungetregisterint(exprasmlist,r);
+                       hregister:=rg.getaddressregister(exprasmlist);
                        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
                        cg.a_label(exprasmlist,norelocatelab);
                        location.reference.base:=hregister;
@@ -162,22 +167,22 @@ implementation
                   else
                     begin
                        { in case it is a register variable: }
-                       if tvarsym(symtableentry).reg<>NR_NO then
+                       if tvarsym(symtableentry).localloc.loc=LOC_REGISTER then
                          begin
-                            case getregtype(tvarsym(symtableentry).reg) of
+                            case getregtype(tvarsym(symtableentry).localloc.register) of
                               R_FPUREGISTER :
                                 begin
                                    location_reset(location,LOC_CFPUREGISTER,def_cgsize(resulttype.def));
-                                   location.register:=tvarsym(symtableentry).reg;
+                                   location.register:=tvarsym(symtableentry).localloc.register;
                                 end;
                               R_INTREGISTER :
                                 begin
-                                  supreg:=getsupreg(Tvarsym(symtableentry).reg);
+                                  supreg:=getsupreg(Tvarsym(symtableentry).localloc.register);
                                   if (supreg in general_superregisters) and
                                      not (supreg in rg.regvar_loaded_int) then
                                     load_regvar(exprasmlist,tvarsym(symtableentry));
                                   location_reset(location,LOC_CREGISTER,def_cgsize(resulttype.def));
-                                  location.register:=tvarsym(symtableentry).reg;
+                                  location.register:=tvarsym(symtableentry).localloc.register;
                                   exclude(rg.unusedregsint,supreg);
                                   hregister := location.register;
                                 end;
@@ -193,8 +198,10 @@ implementation
                               inlinelocalsymtable,
                               inlineparasymtable :
                                 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
                                     begin
@@ -210,8 +217,10 @@ implementation
                                 end;
                               stt_exceptsymtable:
                                 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;
                               else
                                 internalerror(200305102);
@@ -219,9 +228,11 @@ implementation
                          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 }
                   if (symtabletype in [parasymtable,inlineparasymtable]) and
+                     not(vo_has_local_copy in tvarsym(symtableentry).varoptions) 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
                     begin
@@ -443,7 +454,7 @@ implementation
             { already more or less of the same kind (ie. we must not      }
             { assign an ansistring to a normaltemp). In practice, the     }
             { assignment node will have already taken care of this for us }
-            ttemprefnode(left).changelocation(right.location.reference);
+            tcgtemprefnode(left).changelocation(right.location.reference);
           end
         { shortstring assignments are handled separately }
         else if is_shortstring(left.resulttype.def) then
@@ -885,7 +896,12 @@ begin
 end.
 {
   $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
 
   Revision 1.81  2003/09/14 12:57:10  peter

+ 7 - 2
compiler/ncgmem.pas

@@ -315,7 +315,7 @@ implementation
          else
            location_copy(location,left.location);
 
-         inc(location.reference.offset,vs.address);
+         inc(location.reference.offset,vs.fieldoffset);
          { also update the size of the location }
          location.size:=def_cgsize(resulttype.def);
       end;
@@ -811,7 +811,12 @@ begin
 end.
 {
   $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
 
   Revision 1.71  2003/09/07 22:09:35  peter

+ 432 - 147
compiler/ncgutil.pas

@@ -31,7 +31,7 @@ interface
       globtype,
       cpubase,
       aasmbase,aasmtai,aasmcpu,
-      cginfo,symconst,symbase,symdef,symtype,
+      cginfo,symconst,symbase,symdef,symsym,symtype,symtable,
 {$ifndef cpu64bit}
       cg64f32,
 {$endif cpu64bit}
@@ -93,6 +93,15 @@ interface
     procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
       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
 
   uses
@@ -103,7 +112,7 @@ implementation
 {$endif}
     cutils,cclasses,
     globals,systems,verbose,
-    symsym,symtable,defutil,
+    defutil,
     paramgr,fmodule,
     cgbase,regvars,
 {$ifdef GDB}
@@ -857,18 +866,21 @@ implementation
         href1,href2 : treference;
         list : taasmoutput;
         hsym : tvarsym;
-        loadref: boolean;
       begin
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
            (tvarsym(p).varspez=vs_value) and
            (paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
          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
               is_array_of_const(tvarsym(p).vartype.def) then
             begin
@@ -879,20 +891,26 @@ implementation
                   hsym:=tvarsym(tsym(p).owner.search('high'+p.name));
                   if not assigned(hsym) then
                     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
            else
             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
-               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
-               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;
@@ -906,17 +924,23 @@ implementation
       begin
         list:=taasmoutput(arg);
         if (tsym(p).typ=varsym) and
-           not(vo_is_local_copy in tvarsym(p).varoptions) and
            assigned(tvarsym(p).vartype.def) and
            not(is_class(tvarsym(p).vartype.def)) and
            tvarsym(p).vartype.def.needs_inittable then
          begin
            if (cs_implicit_exceptions in aktmoduleswitches) then
             include(current_procinfo.flags,pi_needs_implicit_finally);
-           if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,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
-            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);
          end;
       end;
@@ -932,16 +956,22 @@ implementation
         case tsym(p).typ of
           varsym :
             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
                  not(is_class(tvarsym(p).vartype.def)) and
                  tvarsym(p).vartype.def.needs_inittable then
                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
-                  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);
                end;
             end;
@@ -976,15 +1006,19 @@ implementation
                begin
                  if (cs_implicit_exceptions in aktmoduleswitches) then
                   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));
                end;
              vs_out :
                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);
                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,tmpreg);
                  reference_reset_base(href,tmpreg,0);
@@ -1009,10 +1043,9 @@ implementation
          begin
            if (tvarsym(p).varspez=vs_value) then
             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));
             end;
          end;
@@ -1115,7 +1148,12 @@ implementation
             ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
             if not assigned(ressym) then
               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);
             cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,r);
             uses_acc:=true;
@@ -1123,87 +1161,96 @@ implementation
           end;
 
         ressym := tvarsym(current_procinfo.procdef.funcretsym);
-        if ressym.reg<>NR_NO then
+        if (ressym.refs>0) then
           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
-{$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;
-          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
-{$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;
 
 
@@ -1473,21 +1520,26 @@ implementation
             gotregvarparas := false;
             while assigned(hp) do
               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);
               end;
             if gotregvarparas then
@@ -1496,8 +1548,8 @@ implementation
                 hp:=tparaitem(current_procinfo.procdef.para.first);
                 while assigned(hp) do
                   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);
                   end;
               end;
@@ -1554,9 +1606,7 @@ implementation
                 end
               else
                 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;
               cg.g_return_from_proc(list,retsize);
             end;
@@ -1576,25 +1626,31 @@ implementation
                '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
                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
+                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
-                  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(
-                     '"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(
-                     '"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;
             mangled_length:=length(current_procinfo.procdef.mangledname);
             getmem(p,2*mangled_length+50);
@@ -1770,10 +1826,239 @@ implementation
       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.
 {
   $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
 
   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,
       pass_1,
       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;
@@ -2363,7 +2363,12 @@ begin
 end.
 {
   $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
 
   Revision 1.115  2003/09/06 16:47:24  florian

+ 6 - 8
compiler/nld.pas

@@ -192,13 +192,6 @@ implementation
       begin
         result:=nil;
         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);
         if assigned(srsym) then
           begin
@@ -1282,7 +1275,12 @@ begin
 end.
 {
   $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
 
   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 }
               begin
                 { allocate a pointer in the object memory }
-                with tstoredsymtable(_class.symtable) do
+                with tobjectsymtable(_class.symtable) do
                   begin
                     if (dataalignment>=pointer_size) then
                       datasize:=align(datasize,dataalignment)
@@ -1235,8 +1235,8 @@ implementation
 
          { determine the size with symtable.datasize, because }
          { 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}
          if _class.classtype=ct_object then
            begin
@@ -1304,20 +1304,32 @@ implementation
 
   procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aword);
     var
+      hsym : tsym;
       href : treference;
-      l : tparalocation;
+      locpara : tparalocation;
     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:
-          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:
           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
         else
-          internalerror(2002080801);
+          internalerror(200309189);
       end;
     end;
 
@@ -1327,7 +1339,12 @@ initialization
 end.
 {
   $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
 
   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;
 
-          { 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 }
           procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
 
@@ -355,6 +349,7 @@ implementation
       end;
 
 
+
 initialization
   ;
 finalization
@@ -363,7 +358,12 @@ end.
 
 {
    $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
 
    Revision 1.54  2003/09/10 08:31:47  marco

+ 10 - 6
compiler/pass_1.pas

@@ -44,15 +44,14 @@ implementation
     uses
       globtype,systems,cclasses,
       cutils,globals,
-      cgbase,symdef,
+      cgbase,symdef
 {$ifdef extdebug}
-      cginfo,verbose,
-      htypechk,
+      ,cginfo,verbose,
+      htypechk
 {$endif extdebug}
 {$ifdef state_tracking}
-      nstate,
+      ,nstate
 {$endif}
-      tgobj
       ;
 
 {*****************************************************************************
@@ -216,7 +215,12 @@ implementation
 end.
 {
   $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
     * checks if there are differences between the expectloc and
       location.loc from secondpass in EXTDEBUG

+ 6 - 4
compiler/pbase.pas

@@ -50,9 +50,6 @@ interface
        getprocvardef : tprocvardef = nil;
 
     var
-       { size of data segment, set by proc_unit or proc_program }
-       datasize : longint;
-
        { for operators }
        optoken : ttoken;
 
@@ -273,7 +270,12 @@ implementation
 end.
 {
   $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
     * tvarsym.adjusted_address
     * 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,
        { pass 1 }
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
+       { codegen }
+       ncgutil,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@@ -195,7 +197,7 @@ implementation
                    sym:=ttypedconstsym.createtype(orgname,tt,(cs_typed_const_writable in aktlocalswitches));
                    akttokenpos:=storetokenpos;
                    symtablestack.insert(sym);
-                   symtablestack.insertconstdata(sym);
+                   insertconstdata(ttypedconstsym(sym));
                    { procvar can have proc directives }
                    if (tt.def.deftype=procvardef) then
                     begin
@@ -631,7 +633,12 @@ implementation
 end.
 {
   $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
     * sparc calling convention updates
 

+ 32 - 15
compiler/pdecsub.pas

@@ -217,7 +217,6 @@ implementation
               if tstoreddef(pd.rettype.def).is_fpuregable then
                 include(vs.varoptions,vo_fpuregable);
               pd.localst.insert(vs);
-              pd.localst.insertvardata(vs);
               pd.funcretsym:=vs;
             end;
 
@@ -286,6 +285,7 @@ implementation
       end;
 
 
+      (*
     procedure rename_value_para(p:tnamedindexitem;arg:pointer);
       var
         pd : tprocdef;
@@ -302,13 +302,11 @@ implementation
              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 }
            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;
-
+*)
 
     procedure check_c_para(p:tnamedindexitem;arg:pointer);
       begin
@@ -1667,7 +1665,7 @@ const
                  { check C cdecl para types }
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
             end;
           pocall_cppdecl :
@@ -1680,7 +1678,7 @@ const
                  { check C cdecl para types }
                  pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
             end;
           pocall_stdcall :
@@ -1688,7 +1686,7 @@ const
               if (pd.deftype=procdef) then
                begin
                  { Adjust alignment to match cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
             end;
           pocall_compilerproc :
@@ -1700,7 +1698,7 @@ const
           pocall_register :
             begin
               { Adjust alignment to match cdecl or stdcall }
-              pd.parast.dataalignment:=std_param_align;
+              pd.paraalign:=std_param_align;
             end;
           pocall_far16 :
             begin
@@ -1712,7 +1710,7 @@ const
               if (pd.deftype=procdef) then
                begin
                  { Adjust positions of args for cdecl or stdcall }
-                 pd.parast.dataalignment:=std_param_align;
+                 pd.paraalign:=std_param_align;
                end;
             end;
           pocall_inline :
@@ -1772,6 +1770,21 @@ const
         { insert funcret parameter if required }
         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}
         { Move first 3 register parameters in localst }
         if (pd.deftype=procdef) and
@@ -1800,7 +1813,6 @@ const
                vs.varoptions:=tvarsym(currpara.parasym).varoptions;
                include(vs.varoptions,vo_is_reg_para);
                tprocdef(pd).localst.insert(vs);
-               tprocdef(pd).localst.insertvardata(vs);
                { update currpara }
                currpara.parasym:=vs;
                { next }
@@ -1808,7 +1820,6 @@ const
                inc(n);
              end;
           end;
-
 {$endif i386}
 
         if (pd.deftype=procdef) then
@@ -1847,6 +1858,7 @@ const
                end;
             end;
          end;
+*)
       end;
 
 
@@ -2106,7 +2118,7 @@ const
                      with the new data from the implementation }
                    hd.forwarddef:=pd.forwarddef;
                    hd.hasforward:=true;
-                   hd.parast.address_fixup:=pd.parast.address_fixup;
+                   hd.paraalign:=pd.paraalign;
                    hd.procoptions:=hd.procoptions+pd.procoptions;
                    if hd.extnumber=65535 then
                      hd.extnumber:=pd.extnumber;
@@ -2205,7 +2217,12 @@ const
 end.
 {
   $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
 
   Revision 1.133  2003/09/09 21:03:17  peter

+ 39 - 26
compiler/pdecvar.pas

@@ -40,10 +40,12 @@ implementation
        systems,
        { symtable }
        symconst,symbase,symtype,symdef,symsym,symtable,defutil,
-       fmodule,paramgr,
+       fmodule,
        { pass 1 }
        node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
+       { codegen }
+       ncgutil,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,
@@ -89,12 +91,19 @@ implementation
                   begin
                      vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
                      symtablestack.defowner.owner.insert(vs2);
-                     symtablestack.defowner.owner.insertvardata(vs2);
+                     insertbssdata(vs2);
                   end
                 else
                   begin
                     { 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;
                 vs:=tvarsym(vs.listnext);
              end;
@@ -126,7 +135,7 @@ implementation
          vs,vs2    : tvarsym;
          srsym : tsym;
          srsymtable : tsymtable;
-         unionsymtable : tsymtable;
+         unionsymtable : trecordsymtable;
          offset : longint;
          uniondef : trecorddef;
          unionsym : tvarsym;
@@ -265,7 +274,7 @@ implementation
                    abssym.fileinfo:=vs.fileinfo;
                    abssym.abstyp:=toaddr;
                    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
                       try_to_consume(_COLON) then
                     begin
@@ -273,7 +282,7 @@ implementation
                       pt:=expr;
                       if is_constintnode(pt) then
                         begin
-                          abssym.address:=abssym.address shl 4+tordconstnode(pt).value;
+                          abssym.fieldoffset:=abssym.fieldoffset shl 4+tordconstnode(pt).value;
                           abssym.absseg:=true;
                         end
                       else
@@ -316,7 +325,7 @@ implementation
                      tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
                      vs.defaultconstsym:=tconstsym;
                      symtablestack.insert(tconstsym);
-                     symtablestack.insertconstdata(tconstsym);
+                     insertconstdata(tconstsym);
                      readtypedconst(tt,tconstsym,false);
                    end
                   else
@@ -325,7 +334,7 @@ implementation
                      tconstsym.fileinfo:=vs.fileinfo;
                      symtablestack.replace(vs,tconstsym);
                      vs.free;
-                     symtablestack.insertconstdata(tconstsym);
+                     insertconstdata(tconstsym);
                      consume(_EQUAL);
                      readtypedconst(tt,tconstsym,true);
                      symdone:=true;
@@ -424,8 +433,8 @@ implementation
                    if extern_var then
                     include(vs.varoptions,vo_is_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
                      add it to the externals }
                    if extern_var then
@@ -515,8 +524,7 @@ implementation
                   read_type(casetype,'');
                   symtablestack:=oldsymtablestack;
                   vs:=tvarsym.create(sorg,vs_value,casetype);
-                  symtablestack.insert(vs);
-                  symtablestack.insertvardata(vs);
+                  tabstractrecordsymtable(symtablestack).insertfield(vs,true);
                 end;
               if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
                Message(type_e_ordinal_expr_expected);
@@ -529,9 +537,9 @@ implementation
               if assigned(symtablestack.defowner) then
                 Uniondef.owner:=symtablestack.defowner.owner;
               registerdef:=true;
+              startvarrecsize:=UnionSymtable.datasize;
+              startvarrecalign:=UnionSymtable.dataalignment;
               symtablestack:=UnionSymtable;
-              startvarrecsize:=symtablestack.datasize;
-              startvarrecalign:=symtablestack.dataalignment;
               repeat
                 repeat
                   pt:=comp_expr(true);
@@ -552,19 +560,19 @@ implementation
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
                 { 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 }
-                symtablestack.datasize:=startvarrecsize;
-                symtablestack.dataalignment:=startvarrecalign;
+                unionsymtable.datasize:=startvarrecsize;
+                unionsymtable.dataalignment:=startvarrecalign;
                 if (token<>_END) and (token<>_RKLAMMER) then
                   consume(_SEMICOLON)
                 else
                   break;
               until (token=_END) or (token=_RKLAMMER);
               { 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.sym:=nil;
               UnionSym:=tvarsym.create('$case',vs_value,uniontype);
@@ -590,11 +598,11 @@ implementation
               else
                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.free;
               uniondef.owner:=nil;
@@ -609,7 +617,12 @@ implementation
 end.
 {
   $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
 
   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
                     begin
                       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);
                     end;
                    currpara:=tparaitem(currpara.next);
@@ -2419,7 +2416,12 @@ implementation
 end.
 {
   $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
     * cosmetic fix in printnode
     * tobjectdef.gettypename implemented

+ 7 - 2
compiler/pinline.pas

@@ -60,7 +60,7 @@ implementation
        scanner,
        pbase,pexpr,
        { codegen }
-       tgobj,cgbase
+       cginfo,cgbase
        ;
 
 
@@ -685,7 +685,12 @@ implementation
 end.
 {
   $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 pwidechar,array of widechar
 

+ 22 - 8
compiler/pmodules.pas

@@ -41,7 +41,7 @@ implementation
        symconst,symbase,symtype,symdef,symsym,symtable,
        aasmbase,aasmtai,aasmcpu,
        cgbase,cpuinfo,cgobj,
-       ncgutil,
+       nbas,ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr,cpubase,
 {$ifdef GDB}
@@ -726,8 +726,6 @@ implementation
         current_procinfo:=cprocinfo.create(nil);
         current_module.procinfo:=current_procinfo;
         current_procinfo.procdef:=pd;
-        { start register allocator }
-        cg.init_register_allocators;
         { return procdef }
         create_main_proc:=pd;
       end;
@@ -740,8 +738,6 @@ implementation
            assigned(current_procinfo.parent) or
            not(current_procinfo.procdef=pd) then
          internalerror(200304276);
-        { remove register allocator }
-        cg.done_register_allocators;
         { remove procinfo }
         current_module.procinfo:=nil;
         current_procinfo.free;
@@ -778,6 +774,13 @@ implementation
           else
             internalerror(200304253);
         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);
         { generate symbol and save end of header position }
         gen_proc_symbol(templist);
@@ -800,8 +803,14 @@ implementation
         list.insertlistafter(headertai,templist);
         { Add exit code at the end }
         gen_exit_code(list,false,usesacc,usesacchi);
+        { release }
+        cg.done_register_allocators;
+        tg.free;
+        rg:=nil;
+        tg:=nil;
         release_main_proc(pd);
         templist.free;
+*)
       end;
 
 
@@ -1093,7 +1102,7 @@ implementation
            end;
 
          { size of the static data }
-         datasize:=st.datasize;
+//         datasize:=st.datasize;
 
 {$ifdef GDB}
          { add all used definitions even for implementation}
@@ -1424,7 +1433,7 @@ implementation
          insertheap;
          insertstacklength;
 
-         datasize:=symtablestack.datasize;
+//         datasize:=symtablestack.datasize;
 
          { finish asmlist by adding segment starts }
          insertsegment;
@@ -1471,7 +1480,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.123  2003/09/09 15:55:44  peter

+ 7 - 2
compiler/ppu.pas

@@ -41,7 +41,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=36;
+  CurrentPPUVersion=37;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -985,7 +985,12 @@ end;
 end.
 {
   $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
     * slightly optimized the swap*() functions
 

+ 39 - 98
compiler/pstatmnt.pas

@@ -25,6 +25,7 @@ unit pstatmnt;
 {$i fpcdefs.inc}
 
 interface
+
     uses
       tokens,node;
 
@@ -39,7 +40,7 @@ implementation
 
     uses
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        globtype,globals,verbose,
        systems,cpuinfo,
@@ -1048,77 +1049,19 @@ implementation
       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
-        { 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;
 
-{$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
         p : tnode;
+        locals : longint;
       begin
          { Rename the funcret so that recursive calls are possible }
          if not is_void(current_procinfo.procdef.rettype.def) then
@@ -1136,37 +1079,30 @@ implementation
            current_procinfo.procdef.proccalloption:=pocall_stdcall;
 
 {$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}
 
         { Flag the result as assigned when it is returned in a
@@ -1186,7 +1122,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.108  2003/09/07 22:09:35  peter

+ 38 - 40
compiler/psub.pas

@@ -29,7 +29,7 @@ unit psub;
 interface
 
     uses
-      cclasses,
+      cclasses,globals,
       node,
       symdef,cgbase;
 
@@ -60,6 +60,8 @@ interface
     { reads declarations in the interface part of a unit }
     procedure read_interface_declarations;
 
+    procedure add_entry_exit_code(var code:tnode;const entrypos,exitpos:tfileposinfo);
+
 
 implementation
 
@@ -67,7 +69,7 @@ implementation
        { common }
        cutils,
        { global }
-       globtype,globals,tokens,verbose,comphook,
+       globtype,tokens,verbose,comphook,
        systems,
        { aasm }
        cpubase,cpuinfo,aasmbase,aasmtai,
@@ -574,7 +576,6 @@ implementation
 
     procedure tcgprocinfo.generate_code;
       var
-        oldrg : trgobj;
         oldprocinfo : tprocinfo;
         oldaktmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
@@ -592,8 +593,11 @@ implementation
         if not assigned(code) then
           exit;
 
+        { The RA and Tempgen shall not be available yet }
+        if assigned(rg) or assigned(tg) then
+          internalerror(200309201);
+
         oldprocinfo:=current_procinfo;
-        oldrg:=rg;
         oldfilepos:=aktfilepos;
         oldaktmaxfpuregisters:=aktmaxfpuregisters;
 
@@ -608,11 +612,20 @@ implementation
         add_to_symtablestack;
 
         { 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 }
         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!!}
         { FIXME!! If a procedure contains assembler blocks (or is pure assembler), }
         { then rg.used_in_proc_int already contains info because of that. However, }
@@ -679,6 +692,12 @@ implementation
         { insert symbol and entry code }
         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
           allocate the registers }
         if not(cs_no_regalloc in aktglobalswitches) then
@@ -748,13 +767,17 @@ implementation
         { only now we can remove the temps }
         tg.resettempgen;
 
+        { stop tempgen and ra }
+        tg.free;
+        cg.done_register_allocators;
+        tg:=nil;
+        rg:=nil;
+
         { restore symtablestack }
         remove_from_symtablestack;
 
         { restore }
-        cg.done_register_allocators;
         templist.free;
-        rg:=oldrg;
         aktmaxfpuregisters:=oldaktmaxfpuregisters;
         aktfilepos:=oldfilepos;
         current_procinfo:=oldprocinfo;
@@ -950,38 +973,6 @@ implementation
                         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);
       begin
         if tsym(p).typ<>varsym then
@@ -1117,8 +1108,10 @@ implementation
              { Insert result variables in the localst }
              insert_funcret_local(pd);
 
+(*
              { Insert local copies for value para }
              pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}insert_local_value_para,nil);
+*)
 
              { check if there are para's which require initing -> set }
              { pi_do_call (if not yet set)                            }
@@ -1302,7 +1295,12 @@ begin
 end.
 {
   $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
 
   Revision 1.147  2003/09/14 12:58:00  peter

+ 12 - 7
compiler/psystem.pas

@@ -198,12 +198,12 @@ implementation
         hrecst:=trecordsymtable.create;
         vmttype.setdef(trecorddef.create(hrecst));
         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));
         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('$pvmt',pvmttype);
         vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
@@ -211,8 +211,8 @@ implementation
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
         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));
         addtype('$methodpointer',methodpointertype);
       { Add functions that require compiler magic }
@@ -504,7 +504,12 @@ implementation
 end.
 {
   $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
     + arm support in the common compiler sources added
     * moved some generic cg code around

+ 19 - 14
compiler/ptconst.pas

@@ -386,7 +386,7 @@ implementation
                                      Message(cg_e_illegal_expression);
                                  end;
                                subscriptn :
-                                 inc(offset,tsubscriptnode(hp).vs.address)
+                                 inc(offset,tsubscriptnode(hp).vs.fieldoffset)
                                else
                                  Message(cg_e_illegal_expression);
                              end;
@@ -805,7 +805,7 @@ implementation
                             { Also allow jumping from one variant part to another, }
                             { as long as the offsets match                         }
                             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      }
                                { typed const in the next example:                   }
                                {   type tr = record case byte of                    }
@@ -813,10 +813,10 @@ implementation
                                {          2: (w1,w2: word);                         }
                                {        end;                                        }
                                {   const r: tr = (w1:1;w2:1;l2:5);                  }
-                               (tvarsym(recsym).address = aktpos) then
+                               (tvarsym(recsym).fieldoffset = aktpos) then
                               srsym := recsym
                             { going backwards isn't allowed in any mode }
-                            else if (tvarsym(recsym).address<aktpos) then
+                            else if (tvarsym(recsym).fieldoffset<aktpos) then
                               begin
                                 Message(parser_e_invalid_record_const);
                                 error := true;
@@ -840,12 +840,12 @@ implementation
                           begin
 
                             { 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));
 
                              { new position }
-                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
+                             aktpos:=tvarsym(srsym).fieldoffset+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
@@ -867,7 +867,7 @@ implementation
                     { don't complain if there only come other variant parts }
                     { after the last initialized field                      }
                     ((recsym=nil) or
-                     (tvarsym(srsym).address > tvarsym(recsym).address)) then
+                     (tvarsym(srsym).fieldoffset > tvarsym(recsym).fieldoffset)) then
                    Message1(parser_w_skipped_fields_after,sorg);
 
                  for i:=1 to t.def.size-aktpos do
@@ -929,13 +929,13 @@ implementation
                         else
                           begin
                              { check position }
-                             if tvarsym(srsym).address<aktpos then
+                             if tvarsym(srsym).fieldoffset<aktpos then
                                Message(parser_e_invalid_record_const);
 
                              { check in VMT needs to be added for TP mode }
                              if not(m_fpc in aktmodeswitches) 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
                                  for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do
                                    curconstsegment.concat(tai_const.create_8bit(0));
@@ -945,12 +945,12 @@ implementation
                                end;
 
                              { 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));
 
                              { new position }
-                             aktpos:=tvarsym(srsym).address+tvarsym(srsym).vartype.def.size;
+                             aktpos:=tvarsym(srsym).fieldoffset+tvarsym(srsym).vartype.def.size;
 
                              { read the data }
                              readtypedconst(tvarsym(srsym).vartype,nil,writable);
@@ -993,7 +993,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.69  2003/05/09 17:47:03  peter

+ 7 - 2
compiler/ptype.pas

@@ -242,7 +242,7 @@ implementation
          typecanbeforward:=storetypecanbeforward;
          current_object_option:=old_object_option;
          { 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 }
          symtablestack:=symtable.next;
       end;
@@ -627,7 +627,12 @@ implementation
 end.
 {
   $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
     * tvarsym.adjusted_address
     * address in localsymtable is now in the real direction

+ 23 - 65
compiler/rautils.pas

@@ -29,7 +29,7 @@ Interface
 Uses
   cutils,cclasses,
   globtype,aasmbase,aasmtai,cpubase,cpuinfo,cginfo,
-  symconst,symbase,symtype,symdef;
+  symconst,symbase,symtype,symdef,symsym;
 
 Const
   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
-  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,
+  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
             OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
 
   TOprRec = record
@@ -76,6 +76,7 @@ type
       OPR_CONSTANT  : (val:longint);
       OPR_SYMBOL    : (symbol:tasmsymbol;symofs:longint);
       OPR_REFERENCE : (ref:treference);
+      OPR_LOCAL     : (localsym:tvarsym;localsymofs:longint);
       OPR_REGISTER  : (reg:tregister);
 {$ifdef m68k}
       OPR_REGLIST   : (reglist:Tsupregset);
@@ -215,7 +216,7 @@ uses
   strings,
 {$endif}
   defutil,systems,verbose,globals,
-  symsym,symtable,paramgr,
+  symtable,paramgr,
   aasmcpu,
   cgbase,tgobj;
 
@@ -800,7 +801,7 @@ Begin
             begin
               { We return the address of the field, just like Delphi/TP }
               opr.typ:=OPR_CONSTANT;
-              opr.val:=tvarsym(sym).address;
+              opr.val:=tvarsym(sym).fieldoffset;
               hasvar:=true;
               SetupVar:=true;
               Exit;
@@ -808,71 +809,23 @@ Begin
           globalsymtable,
           staticsymtable :
             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 :
             begin
               if (vo_is_external in tvarsym(sym).varoptions) then
                 opr.ref.symbol:=objectlibrary.newasmsymboldata(tvarsym(sym).mangledname)
               else
                 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;
               if paramanager.push_addr_param(tvarsym(sym).varspez,tvarsym(sym).vartype.def,current_procinfo.procdef.proccalloption) then
                 SetSize(pointer_size,false);
@@ -1333,7 +1286,7 @@ Begin
      case sym.typ of
        varsym :
          begin
-           inc(Offset,tvarsym(sym).address);
+           inc(Offset,tvarsym(sym).fieldoffset);
            Size:=tvarsym(sym).getsize;
            case tvarsym(sym).vartype.def.deftype of
              arraydef :
@@ -1551,7 +1504,12 @@ end;
 end.
 {
   $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
 
   Revision 1.65  2003/09/03 15:55:01  peter

+ 36 - 27
compiler/regvars.pas

@@ -208,9 +208,9 @@ implementation
                         siz:=OS_32;
 
                       { 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 }
-                      rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].reg));
+                      rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].localloc.register));
                     end
                   else
                     begin
@@ -262,10 +262,10 @@ implementation
                      begin
 {$ifdef i386}
                        { 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}
-                       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}
                      end;
                   end;
@@ -295,7 +295,7 @@ implementation
           supreg:=getsupreg(reg);
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) and
-               (getsupreg(regvarinfo^.regvars[i].reg)=supreg) then
+               (getsupreg(regvarinfo^.regvars[i].localloc.register)=supreg) then
               begin
                 if supreg in rg.regvar_loaded_int then
                   begin
@@ -304,11 +304,12 @@ implementation
                     { possible that it's been modified  (JM)                  }
                     if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                       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);
-                        cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
+                        cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr);
                       end;
-                    asml.concat(tai_regalloc.dealloc(vsym.reg));
+                    asml.concat(tai_regalloc.dealloc(vsym.localloc.register));
                     exclude(rg.regvar_loaded_int,supreg);
                   end;
                 break;
@@ -319,7 +320,7 @@ implementation
           for i := 1 to maxvarregs do
             if assigned(regvarinfo^.regvars[i]) then
               begin
-                r:=rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT);
+                r:=rg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT);
                 if (r = reg) then
                   begin
                     regidx:=findreg_by_number(r);
@@ -330,11 +331,12 @@ implementation
                         { possible that it's been modified  (JM)                  }
                         if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
                           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);
-                            cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
+                            cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr);
                           end;
-                        asml.concat(tai_regalloc.dealloc(vsym.reg));
+                        asml.concat(tai_regalloc.dealloc(vsym.localloc.register));
                         rg.regvar_loaded_other[regidx] := false;
                       end;
                     break;
@@ -355,13 +357,14 @@ implementation
 {$ifndef i386}
       exit;
 {$endif i386}
-      reg:=vsym.reg;
+      reg:=vsym.localloc.register;
       if getregtype(reg)=R_INTREGISTER then
         begin
           if not(getsupreg(reg) in rg.regvar_loaded_int) then
             begin
               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
                 opsize := OS_ADDR
               else
@@ -377,7 +380,8 @@ implementation
           if not rg.regvar_loaded_other[regidx] then
             begin
               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
                 opsize := OS_ADDR
               else
@@ -403,7 +407,7 @@ implementation
           supreg:=getsupreg(reg);
           for i := 1 to maxvarregs do
             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]))
         end
       else
@@ -411,7 +415,7 @@ implementation
           reg_spare := rg.makeregsize(reg,OS_INT);
           for i := 1 to maxvarregs do
             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]))
         end;
     end;
@@ -449,7 +453,7 @@ implementation
                 begin
 {$ifdef i386}
                   { 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));
 {$endif i386}
                 end;
@@ -467,9 +471,9 @@ implementation
                     if cs_asm_source in aktglobalswitches then
                       asml.insert(tai_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+
                         ' 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
-                      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);
                  end;
             end;
@@ -542,7 +546,7 @@ implementation
              begin
                if assigned(regvars[i]) then
                 begin
-                  reg:=regvars[i].reg;
+                  reg:=regvars[i].localloc.register;
                   if getregtype(reg)=R_INTREGISTER then
                     begin
                     end
@@ -571,8 +575,8 @@ implementation
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               begin
                 { 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;
 
@@ -589,8 +593,8 @@ implementation
             if assigned(regvars[i]) { and
               (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
               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
                  list.insert(tai_comment.Create(strpnew(regvars[i].name+
                   ' with weight '+tostr(regvars[i].refs)+' assigned to register '+
@@ -604,7 +608,12 @@ end.
 
 {
   $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
 
   Revision 1.64  2003/09/07 22:09:35  peter

+ 6 - 11
compiler/symbase.pas

@@ -97,21 +97,16 @@ interface
        public
           name      : pstring;
           realname  : pstring;
-          datasize  : longint;
           symindex,
           defindex  : TIndexArray;
           symsearch : Tdictionary;
           next      : tsymtable;
           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;
           { each symtable gets a number }
           unitid        : word;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
-          dataalignment : byte;
           constructor Create(const s:string);
           destructor  destroy;override;
           procedure clear;virtual;
@@ -120,8 +115,6 @@ interface
           procedure foreach_static(proc2call : tnamedindexstaticcallback;arg:pointer);
           procedure insert(sym : tsymentry);virtual;
           procedure replace(oldsym,newsym:tsymentry);
-          procedure insertvardata(sym : tsymentry);virtual;abstract;
-          procedure insertconstdata(sym : tsymentry);virtual;abstract;
           function  search(const s : stringid) : tsymentry;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;virtual;
           procedure registerdef(p : tdefentry);
@@ -178,9 +171,6 @@ implementation
          symsearch:=tdictionary.create;
          symsearch.noclear:=true;
          unitid:=0;
-         address_fixup:=0;
-         datasize:=0;
-         dataalignment:=1;
       end;
 
 
@@ -321,7 +311,12 @@ implementation
 end.
 {
   $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
       not directly available through the uses clause
 

+ 7 - 2
compiler/symconst.pas

@@ -249,7 +249,7 @@ type
     vo_is_dll_var,
     vo_is_thread_var,
     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_exported,
     vo_is_high_value,
@@ -374,7 +374,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.62  2003/09/09 15:54:10  peter

+ 41 - 30
compiler/symdef.pas

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

+ 114 - 91
compiler/symsym.pas

@@ -174,14 +174,13 @@ interface
        end;
 
        tvarsym = class(tstoredsym)
-          address       : longint;
-          localvarsym   : tvarsym;
           highvarsym    : tvarsym;
           defaultconstsym : tsym;
           varoptions    : tvaroptions;
-          reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
           varspez       : tvarspez;  { sets the type of access }
           varstate      : tvarstate;
+          localloc      : tparalocation; { register/reference for local var }
+          fieldoffset   : longint; { offset in record/object }
           paraitem      : tparaitem;
           notifications : Tlinkedlist;
           constructor create(const n : string;vsp:tvarspez;const tt : ttype);
@@ -195,7 +194,6 @@ interface
           procedure set_mangledname(const s:string);
           function  getsize : longint;
           function  getvaluesize : longint;
-          function  adjusted_address : longint;
           procedure trigger_notifications(what:Tnotification_flag);
           function register_notification(flags:Tnotification_flags;
                                          callback:Tnotification_callback):cardinal;
@@ -563,8 +561,8 @@ implementation
          if not isstabwritten then
            begin
               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;
           end;
     end;
@@ -1494,7 +1492,7 @@ implementation
     function tpropertysym.stabstring : pchar;
       begin
          { !!!! don't know how to handle }
-         stabstring:=strpnew('');
+         stabstring:=nil;
       end;
 
     procedure tpropertysym.concatstabto(asmlist : taasmoutput);
@@ -1530,7 +1528,7 @@ implementation
          { load absolute }
          typ:=absolutesym;
          ref:=nil;
-         address:=0;
+         fieldoffset:=0;
          asmname:=nil;
          abstyp:=absolutetyp(ppufile.getbyte);
          absseg:=false;
@@ -1541,7 +1539,7 @@ implementation
              asmname:=stringdup(ppufile.getstring);
            toaddr :
              begin
-               address:=ppufile.getlongint;
+               fieldoffset:=ppufile.getlongint;
                absseg:=boolean(ppufile.getbyte);
              end;
          end;
@@ -1555,7 +1553,7 @@ implementation
          { Note: This needs to write everything of tvarsym.write }
          inherited writesym(ppufile);
          ppufile.putbyte(byte(varspez));
-         ppufile.putlongint(address);
+         ppufile.putlongint(fieldoffset);
          { write only definition or definitionsym }
          ppufile.puttype(vartype);
          hvo:=varoptions-[vo_regable,vo_fpuregable];
@@ -1568,7 +1566,7 @@ implementation
              ppufile.putstring(asmname^);
            toaddr :
              begin
-               ppufile.putlongint(address);
+               ppufile.putlongint(fieldoffset);
                ppufile.putbyte(byte(absseg));
              end;
          end;
@@ -1613,7 +1611,7 @@ implementation
            toasm :
              mangledname:=asmname^;
            toaddr :
-             mangledname:='$'+tostr(address);
+             mangledname:='$'+tostr(fieldoffset);
          else
            internalerror(10002);
          end;
@@ -1639,8 +1637,8 @@ implementation
          vartype:=tt;
          _mangledname:=nil;
          varspez:=vsp;
-         address:=0;
-         localvarsym:=nil;
+         fieldoffset:=0;
+         fillchar(localloc,sizeof(localloc),0);
          highvarsym:=nil;
          defaultconstsym:=nil;
          refs:=0;
@@ -1668,12 +1666,11 @@ implementation
       begin
          inherited loadsym(ppufile);
          typ:=varsym;
-         reg:=NR_NO;
+         fillchar(localloc,sizeof(localloc),0);
          refs := 0;
          varstate:=vs_used;
          varspez:=tvarspez(ppufile.getbyte);
-         address:=ppufile.getlongint;
-         localvarsym:=nil;
+         fieldoffset:=ppufile.getlongint;
          highvarsym:=nil;
          defaultconstsym:=nil;
          ppufile.gettype(_vartype);
@@ -1703,7 +1700,7 @@ implementation
       begin
          inherited writesym(ppufile);
          ppufile.putbyte(byte(varspez));
-         ppufile.putlongint(address);
+         ppufile.putlongint(fieldoffset);
          ppufile.puttype(vartype);
          { symbols which are load are never candidates for a register,
            turn off the regable }
@@ -1750,12 +1747,6 @@ implementation
       end;
 
 
-    function  tvarsym.adjusted_address : longint;
-      begin
-        result:=address+owner.address_fixup;
-      end;
-
-
     procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
 
     var n:Tnotification;
@@ -1817,71 +1808,97 @@ implementation
        threadvaroffset : string;
        regidx : tregisterindex;
      begin
+       { There is no space allocated for not referenced locals }
+       if refs=0 then
+         begin
+           stabstring:=nil;
+           exit;
+         end;
+
        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
-              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
-           { 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);
       var
@@ -1894,12 +1911,14 @@ implementation
            exit;
          if (vo_is_self in varoptions) then
            begin
+             if localloc.loc<>LOC_REFERENCE then
+               internalerror(2003091815);
              if (po_classmethod in current_procinfo.procdef.procoptions) or
                 (po_staticmethod in current_procinfo.procdef.procoptions) then
                begin
                  asmlist.concat(Tai_stabs.Create(strpnew(
                     '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
-                    tostr(N_tsym)+',0,0,'+tostr(adjusted_address))));
+                    tostr(N_tsym)+',0,0,'+tostr(localloc.reference.offset))));
                end
              else
                begin
@@ -1909,13 +1928,13 @@ implementation
                    c:='p';
                  asmlist.concat(Tai_stabs.Create(strpnew(
                     '"$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
          else
-           if (reg<>NR_NO) then
+           if (localloc.loc=LOC_REGISTER) then
              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", }
                 { this is the register order for GDB}
                 stab_str:=strpnew('"'+name+':r'
@@ -1945,7 +1964,6 @@ implementation
               include(varoptions,vo_fpuregable)
             else
               exclude(varoptions,vo_fpuregable);
-            reg:=NR_NO;
           end;
       end;
 
@@ -2657,7 +2675,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.117  2003/09/14 13:20:12  peter

+ 40 - 239
compiler/symtable.pas

@@ -35,9 +35,7 @@ interface
        { ppu }
        ppu,symppu,
        { assembler }
-       aasmbase,aasmtai,aasmcpu,
-       { cg }
-       paramgr
+       aasmbase,aasmtai,aasmcpu
        ;
 
 
@@ -94,18 +92,20 @@ interface
 
        tabstractrecordsymtable = class(tstoredsymtable)
        public
+          datasize  : longint;
+          dataalignment : byte;
+          constructor create(const n:string);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure load_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;
 
        trecordsymtable = class(tabstractrecordsymtable)
        public
           constructor create;
-          procedure insert_in(tsymt : tsymtable;offset : longint);
+          procedure insert_in(tsymt : trecordsymtable;offset : longint);
        end;
 
        tobjectsymtable = class(tabstractrecordsymtable)
@@ -123,15 +123,12 @@ interface
        public
           constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
-          procedure insertconstdata(sym : tsymentry);override;
        end;
 
        tparasymtable = class(tabstractlocalsymtable)
        public
           constructor create(level:byte);
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
        end;
 
        tabstractunitsymtable = class(tstoredsymtable)
@@ -146,8 +143,6 @@ interface
 {$ifdef GDB}
           procedure concattypestabto(asmlist : taasmoutput);
 {$endif GDB}
-          procedure insertvardata(sym : tsymentry);override;
-          procedure insertconstdata(sym : tsymentry);override;
        end;
 
        tglobalsymtable = class(tabstractunitsymtable)
@@ -161,7 +156,6 @@ interface
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
 {$ifdef GDB}
           function getnewtypecount : word; override;
 {$endif}
@@ -175,7 +169,6 @@ interface
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
           procedure insert(sym : tsymentry);override;
-          procedure insertvardata(sym : tsymentry);override;
        end;
 
        twithsymtable = class(tsymtable)
@@ -356,10 +349,7 @@ implementation
           Message(unit_f_ppu_read_error);
          { skip amount of symbols, not used currently }
          ppufile.getlongint;
-         { load datasize,dataalignment of this symboltable }
-         datasize:=ppufile.getlongint;
-         dataalignment:=byte(ppufile.getlongint);
-      { now read the symbols }
+         { now read the symbols }
          repeat
            b:=ppufile.readentry;
            case b of
@@ -391,18 +381,18 @@ implementation
       var
          pd : tstoreddef;
       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.writeentry(ibstartdefs);
-      { now write the definition }
+         { now write the definition }
          pd:=tstoreddef(defindex.first);
          while assigned(pd) do
            begin
               pd.ppuwrite(ppufile);
               pd:=tstoreddef(pd.indexnext);
            end;
-      { write end of definitions }
+         { write end of definitions }
          ppufile.writeentry(ibenddefs);
       end;
 
@@ -411,20 +401,18 @@ implementation
       var
         pd : tstoredsym;
       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(datasize);
-         ppufile.putlongint(dataalignment);
          ppufile.writeentry(ibstartsyms);
-       { foreach is used to write all symbols }
+         { foreach is used to write all symbols }
          pd:=tstoredsym(symindex.first);
          while assigned(pd) do
            begin
               pd.ppuwrite(ppufile);
               pd:=tstoredsym(pd.indexnext);
            end;
-       { end of symbols }
+         { end of symbols }
          ppufile.writeentry(ibendsyms);
       end;
 
@@ -712,7 +700,6 @@ implementation
               (vo_is_self in tvarsym(p).varoptions) or
               (vo_is_vmt 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
              exit;
            if (tvarsym(p).refs=0) then
@@ -724,8 +711,7 @@ implementation
                        (tprocdef(tsym(p).owner.defowner).proctypeoption<>potype_constructor) then
                       MessagePos(tsym(p).fileinfo,sym_w_function_result_not_set)
                   end
-                else if (tsym(p).owner.symtabletype=parasymtable) or
-                        (vo_is_local_copy in tvarsym(p).varoptions) then
+                else if (tsym(p).owner.symtabletype=parasymtable) then
                   MessagePos1(tsym(p).fileinfo,sym_h_para_identifier_not_used,tsym(p).realname)
                 else if (tsym(p).owner.symtabletype=objectsymtable) then
                   MessagePos2(tsym(p).fileinfo,sym_n_private_identifier_not_used,tsym(p).owner.realname^,tsym(p).realname)
@@ -734,8 +720,7 @@ implementation
              end
            else if tvarsym(p).varstate=vs_assigned then
              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
                     if not(tvarsym(p).varspez in [vs_var,vs_out]) and
                        not(vo_is_funcret in tvarsym(p).varoptions) then
@@ -974,6 +959,14 @@ implementation
                           TAbstractRecordSymtable
 ****************************************************************************}
 
+    constructor tabstractrecordsymtable.create(const n:string);
+      begin
+        inherited create(n);
+        datasize:=0;
+        dataalignment:=1;
+      end;
+
+
     procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
       var
         storesymtable : tsymtable;
@@ -1030,13 +1023,14 @@ implementation
       end;
 
 
-    procedure tabstractrecordsymtable.insertvardata(sym : tsymentry);
+    procedure tabstractrecordsymtable.insertfield(sym : tvarsym;addsym:boolean);
       var
         l,varalign : longint;
         vardef : tdef;
       begin
-        if sym.typ<>varsym then
-         internalerror(200208251);
+        if addsym then
+          insert(sym);
+        { Calculate field offset }
         l:=tvarsym(sym).getvaluesize;
         vardef:=tvarsym(sym).vartype.def;
         { this symbol can't be loaded to a register }
@@ -1075,15 +1069,8 @@ implementation
         if varalign=0 then
           varalign:=size_2_align(l);
         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;
 
 
@@ -1103,7 +1090,7 @@ implementation
     { the offset is the location of the start of the variant
       and datasize and dataalignment corresponds to
       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
         ps,nps : tvarsym;
         pd,npd : tdef;
@@ -1122,11 +1109,11 @@ implementation
             ps.right:=nil;
             { add to symt }
             ps.owner:=tsymt;
-            tsymt.datasize:=ps.address+offset;
+            tsymt.datasize:=ps.fieldoffset+offset;
             tsymt.symindex.insert(ps);
             tsymt.symsearch.insert(ps);
             { update address }
-            ps.address:=tsymt.datasize;
+            ps.fieldoffset:=tsymt.datasize;
             { next }
             ps:=nps;
           end;
@@ -1285,78 +1272,6 @@ implementation
       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
 ****************************************************************************}
@@ -1366,8 +1281,6 @@ implementation
         inherited create('');
         symtabletype:=parasymtable;
         symtablelevel:=level;
-        dataalignment:=aktalignment.paraalign;
-        address_fixup:=target_info.first_parm_offset;
       end;
 
 
@@ -1401,28 +1314,6 @@ implementation
       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
 ****************************************************************************}
@@ -1441,80 +1332,6 @@ implementation
       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}
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
         var prev_dbx_count : plongint;
@@ -1654,15 +1471,6 @@ implementation
       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
 ****************************************************************************}
@@ -1846,18 +1654,6 @@ implementation
       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}
    function tglobalsymtable.getnewtypecount : word;
       begin
@@ -2431,7 +2227,12 @@ implementation
 end.
 {
   $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
 
   Revision 1.108  2003/06/25 18:31:23  peter

+ 33 - 20
compiler/tgobj.pas

@@ -35,18 +35,10 @@ unit tgobj;
     uses
       globals,
       cpubase,
-      cpuinfo,
+      cpuinfo,cginfo,
       cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
 
     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;
       ttemprecord = record
          temptype   : ttemptype;
@@ -104,6 +96,10 @@ unit tgobj;
              is not in the temporary memory, it is simply not freed.
           }
           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;
 
      var
@@ -114,8 +110,8 @@ unit tgobj;
 
     uses
        systems,
-       verbose,cutils,
-       cginfo,rgobj;
+       verbose,cutils
+       ;
 
 
     const
@@ -423,10 +419,13 @@ unit tgobj;
 
 
     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;
@@ -525,14 +524,28 @@ unit tgobj;
       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.
 {
   $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
 
   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
         with ref do
          begin
-           inc(offset,offsetfixup);
-           offsetfixup:=0;
-
            { have we a segment prefix ? }
            { These are probably not correctly handled under GAS }
            { should be replaced by coding the segment override  }
@@ -311,7 +308,12 @@ initialization
 end.
 {
   $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
 
   Revision 1.4.2.1  2003/08/31 15:46:26  peter

+ 6 - 22
compiler/x86/cpubase.pas

@@ -225,8 +225,6 @@ uses
 *****************************************************************************}
 
     type
-      trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
-
       { reference record }
       preference = ^treference;
       treference = packed record
@@ -236,8 +234,6 @@ uses
          scalefactor : byte;
          offset      : longint;
          symbol      : tasmsymbol;
-         offsetfixup : longint;
-         options     : trefoptions;
       end;
 
       { reference record }
@@ -247,23 +243,6 @@ uses
          offset      : longint;
       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
 *****************************************************************************}
@@ -559,7 +538,12 @@ implementation
 end.
 {
   $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
     * various RA fixes
 

+ 33 - 23
compiler/x86/radirect.pas

@@ -79,9 +79,12 @@ interface
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { 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
               (pos(retstr,upper(s))>0) then
              tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+*)
            s:='';
          end;
 
@@ -91,11 +94,15 @@ interface
        if assigned(current_procinfo.procdef.funcretsym) and
           is_fpu(current_procinfo.procdef.rettype.def) then
          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
-         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
          retstr:='';
+*)
        c:=current_scanner.asmgetchar;
        code:=TAAsmoutput.Create;
        while not(ende) do
@@ -164,18 +171,17 @@ interface
                                            end
                                          else if sym.typ=varsym then
                                            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
                                          else
                                          { call to local function }
@@ -195,12 +201,9 @@ interface
                                            begin
                                               if sym.typ=varsym then
                                                 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
                                     { I added that but it creates a problem in line.ppi
@@ -287,8 +290,7 @@ interface
                                                   case sym.typ of
                                                     varsym :
                                                       begin
-                                                        hs:=tostr(tvarsym(sym).adjusted_address)+
-                                                            '('+gas_regname(framereg)+')';
+                                                        hs:='%%'+tvarsym(sym).name;
                                                         inc(tvarsym(sym).refs);
                                                       end;
                                                     typedconstsym :
@@ -311,8 +313,11 @@ interface
                 end;
               '{',';',#10,#13 :
                 begin
+{$warning TODO Fix setting of funcret vs_assigned}
+(*
                   if pos(retstr,s) > 0 then
                     tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
+*)
                   writeasmline;
                   c:=current_scanner.asmgetchar;
                 end;
@@ -360,7 +365,12 @@ initialization
 end.
 {
   $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
 
   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
     begin
       case operands[i].Opr.Typ of
+        OPR_LOCAL,
         OPR_REFERENCE :
           begin
             if i=2 then
@@ -669,6 +670,8 @@ begin
          ai.loadreg(i-1,operands[i].opr.reg);
        OPR_SYMBOL:
          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:
          begin
            ai.loadref(i-1,operands[i].opr.ref);
@@ -729,7 +732,12 @@ end;
 end.
 {
   $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
 
   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