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 năm trước cách đây
mục cha
commit
8af51ea6d3
52 tập tin đã thay đổi với 3807 bổ sung3371 xóa
  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

Những thai đổi đã bị hủy bỏ vì nó quá lớn
+ 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

Một số tệp đã không được hiển thị bởi vì quá nhiều tập tin thay đổi trong này khác