* reginfo now also only allocated during register allocation

  * third round of gdb cleanups: kick out most of concatstabto

compiler/aasmtai.pas

@@ -37,7 +37,7 @@ interface
        globtype,globals,systems,
        cpuinfo,cpubase,
        cgbase,
-       symppu,symtype,
+       symtype,
        aasmbase;
 
     type
@@ -1971,7 +1971,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.66  2004-01-24 18:12:40  florian
+  Revision 1.67  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.66  2004/01/24 18:12:40  florian
     * fixed several arm floating point issues
 
   Revision 1.65  2004/01/23 15:12:49  florian

compiler/fppu.pas

@@ -38,7 +38,7 @@ interface
     uses
        cutils,cclasses,
        globtype,globals,finput,fmodule,
-       symbase,symppu,ppu;
+       symbase,ppu,symtype;
 
     type
        tppumodule = class(tmodule)
@@ -1514,7 +1514,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.50  2004-01-22 17:23:56  peter
+  Revision 1.51  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.50  2004/01/22 17:23:56  peter
     * also check in the same dir as the unit we are loading from, this
       makes UNITPATH working better
 

compiler/nbas.pas

@@ -30,7 +30,7 @@ interface
        cpubase,cgbase,
        aasmbase,aasmtai,aasmcpu,
        node,tgobj,
-       symtype,symppu;
+       symtype;
 
     type
        tnothingnode = class(tnode)
@@ -983,7 +983,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.74  2003-12-10 20:31:40  jonas
+  Revision 1.75  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.74  2003/12/10 20:31:40  jonas
     * override tblocknode.destroy so all statements are freed sequentially
       instead of recusively.
 

compiler/ncal.pas

@@ -34,7 +34,7 @@ interface
        {$ifdef state_tracking}
        nstate,
        {$endif state_tracking}
-       symbase,symtype,symppu,symsym,symdef,symtable;
+       symbase,symtype,symsym,symdef,symtable;
 
     type
        pcandidate = ^tcandidate;
@@ -2711,7 +2711,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.220  2004-01-15 15:16:18  daniel
+  Revision 1.221  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.220  2004/01/15 15:16:18  daniel
     * Some minor stuff
     * Managed to eliminate speed effects of string compression
 

compiler/ncnv.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        node,
-       symtype,symppu,
+       symtype,
        defutil,defcmp,
        nld
 {$ifdef Delphi}
@@ -2405,7 +2405,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.134  2003-12-26 00:32:21  florian
+  Revision 1.135  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.134  2003/12/26 00:32:21  florian
     + fpu<->mm register conversion
 
   Revision 1.133  2003/12/22 23:11:15  peter

compiler/ncon.pas

@@ -30,7 +30,7 @@ interface
       globtype,widestr,
       node,
       aasmbase,aasmtai,cpuinfo,globals,
-      symconst,symppu,symtype,symdef,symsym;
+      symconst,symtype,symdef,symsym;
 
     type
        trealconstnode = class(tnode)
@@ -950,7 +950,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  2004-01-12 16:35:40  peter
+  Revision 1.58  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.57  2004/01/12 16:35:40  peter
     * range check error
 
   Revision 1.56  2003/10/23 14:44:07  peter

compiler/nflw.pas

@@ -30,7 +30,7 @@ interface
     uses
        node,cpubase,
        aasmbase,aasmtai,aasmcpu,symnot,
-       symppu,symtype,symbase,symdef,symsym;
+       symtype,symbase,symdef,symsym;
 
     type
        { flags used by loop nodes }
@@ -1475,7 +1475,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.91  2003-12-28 22:51:18  florian
+  Revision 1.92  2004-01-26 16:12:27  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.91  2003/12/28 22:51:18  florian
     + except handling related nodes now include pi_do_call if necessary
 
   Revision 1.90  2003/12/08 19:29:21  peter

compiler/ninl.pas

@@ -27,7 +27,7 @@ unit ninl;
 interface
 
     uses
-       node,htypechk,cpuinfo,symppu;
+       node,htypechk,cpuinfo,symtype;
 
     {$i compinnr.inc}
 
@@ -72,7 +72,7 @@ implementation
     uses
       verbose,globals,systems,
       globtype, cutils,
-      symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
+      symbase,symconst,symdef,symsym,symtable,paramgr,defutil,defcmp,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
       cgbase,procinfo
@@ -2366,7 +2366,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.126  2003-12-31 20:47:02  jonas
+  Revision 1.127  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.126  2003/12/31 20:47:02  jonas
     * properly fixed assigned() mess (by handling it separately in ncginl)
       -> all assigned()-related tests in the test suite work again
 

compiler/nld.pas

@@ -31,7 +31,7 @@ interface
        {$ifdef state_tracking}
        nstate,
        {$endif}
-       symconst,symppu,symbase,symtype,symsym,symdef;
+       symconst,symbase,symtype,symsym,symdef;
 
     type
        tloadnode = class(tunarynode)
@@ -1246,7 +1246,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.119  2003-12-01 18:44:15  peter
+  Revision 1.120  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.119  2003/12/01 18:44:15  peter
     * fixed some crashes
     * fixed varargs and register calling probs
 

compiler/nmem.pas

@@ -28,7 +28,7 @@ interface
 
     uses
        node,
-       symtype,symppu,symdef,symsym,symtable,
+       symdef,symsym,symtable,symtype,
        cpubase;
 
     type
@@ -967,7 +967,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.76  2003-12-12 15:42:53  peter
+  Revision 1.77  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.76  2003/12/12 15:42:53  peter
     * don't give warnings for shortstring vecnodes
 
   Revision 1.75  2003/12/08 22:35:06  peter

compiler/node.pas

@@ -31,7 +31,7 @@ interface
        globtype,globals,
        cpubase,cgbase,
        aasmbase,
-       symtype,symppu;
+       symtype;
 
     type
        pconstset = ^tconstset;
@@ -1087,7 +1087,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.79  2003-12-26 00:32:22  florian
+  Revision 1.80  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.79  2003/12/26 00:32:22  florian
     + fpu<->mm register conversion
 
   Revision 1.78  2003/12/01 18:44:15  peter

compiler/nset.pas

@@ -28,8 +28,7 @@ interface
 
     uses
        node,globals,
-       aasmbase,aasmtai,
-       symppu;
+       aasmbase,aasmtai,symtype;
 
     type
       pcaserecord = ^tcaserecord;
@@ -695,7 +694,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2003-11-10 19:10:57  peter
+  Revision 1.51  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.50  2003/11/10 19:10:57  peter
     * check for enumdef.maxval<255 instead of enumdef.savesize
 
   Revision 1.49  2003/10/23 14:44:07  peter

compiler/rgobj.pas

@@ -240,6 +240,8 @@ unit rgobj;
 {$ifdef EXTDEBUG}
         procedure writegraph(loopidx:longint);
 {$endif EXTDEBUG}
+        {# Disposes of the reginfo array.}
+        procedure dispose_reginfo;
         {# Prepare the register colouring.}
         procedure prepare_colouring;
         {# Clean up after register colouring.}
@@ -374,15 +376,15 @@ implementation
          used_in_proc:=[];
          live_registers.init;
          { Get reginfo for CPU registers }
-         reginfo:=allocmem(first_imaginary*sizeof(treginfo));
          maxreginfo:=first_imaginary;
          maxreginfoinc:=16;
+         worklist_moves:=Tlinkedlist.create;
+         reginfo:=allocmem(first_imaginary*sizeof(treginfo));
          for i:=0 to first_imaginary-1 do
            begin
              reginfo[i].degree:=high(tsuperregister);
              reginfo[i].alias:=RS_INVALID;
            end;
-         worklist_moves:=Tlinkedlist.create;
          { Usable registers }
          fillchar(usable_registers,sizeof(usable_registers),0);
          for i:=low(Ausable) to high(Ausable) do
@@ -399,8 +401,6 @@ implementation
 
     destructor trgobj.destroy;
 
-    var i:Tsuperregister;
-
     begin
       spillednodes.done;
       simplifyworklist.done;
@@ -408,17 +408,28 @@ implementation
       spillworklist.done;
       coalescednodes.done;
       selectstack.done;
-      for i:=0 to maxreg-1 do
-        begin
-          if reginfo[i].adjlist<>nil then
-            dispose(reginfo[i].adjlist,done);
-          if reginfo[i].movelist<>nil then
-            dispose(reginfo[i].movelist);
-        end;
-      freemem(reginfo);
       worklist_moves.free;
+      dispose_reginfo;
     end;
 
+    procedure Trgobj.dispose_reginfo;
+
+    var i:Tsuperregister;
+
+    begin
+      if reginfo<>nil then
+        begin
+          for i:=0 to maxreg-1 do
+            begin
+              if reginfo[i].adjlist<>nil then
+                dispose(reginfo[i].adjlist,done);
+              if reginfo[i].movelist<>nil then
+                dispose(reginfo[i].movelist);
+            end;
+          freemem(reginfo);
+          reginfo:=nil;
+        end;
+    end;
 
     function trgobj.getnewreg(subreg:tsubregister):tsuperregister;
       var
@@ -503,6 +514,7 @@ implementation
       var
         spillingcounter:byte;
         endspill:boolean;
+        i:Tsuperregister;
       begin
         { Insert regalloc info for imaginary registers }
         insert_regalloc_info(list,headertai);
@@ -528,6 +540,7 @@ implementation
         until endspill;
         ibitmap.free;
         translate_registers(list);
+        dispose_reginfo;
       end;
 
 
@@ -1817,9 +1830,9 @@ implementation
 end.
 {
   $Log$
-  Revision 1.113  2004-01-25 23:21:02  daniel
-    * Keep interference bitmap only allocated during register allocation.
-      Saves 2 mb of memory.
+  Revision 1.114  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
 
   Revision 1.112  2004/01/12 16:37:59  peter
     * moved spilling code from taicpu to rg

compiler/symdef.pas

@@ -33,7 +33,7 @@ interface
        { symtable }
        symconst,symbase,symtype,
        { ppu }
-       symppu,ppu,
+       ppu,
        { node }
        node,
        { aasm }
@@ -6191,7 +6191,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.206  2004-01-25 20:23:28  daniel
+  Revision 1.207  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.206  2004/01/25 20:23:28  daniel
     * More gdb cleanup: make record & object stab generation linear instead
       of quadratic.
 

compiler/symsym.pas

@@ -33,7 +33,7 @@ interface
        { symtable }
        symconst,symbase,symtype,symdef,defcmp,
        { ppu }
-       ppu,symppu,
+       ppu,
        cclasses,symnot,
        { aasm }
        aasmbase,aasmtai,
@@ -50,30 +50,20 @@ interface
        protected
           _mangledname : pstring;
        public
-          refs          : longint;
-          lastref,
-          defref,
-          lastwritten : tref;
-          refcount    : longint;
 {$ifdef GDB}
           isstabwritten : boolean;
 {$endif GDB}
           constructor create(const n : string);
           constructor loadsym(ppufile:tcompilerppufile);
           destructor destroy;override;
-          procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
-          procedure writesym(ppufile:tcompilerppufile);
           procedure buildderef;override;
           procedure deref;override;
 {$ifdef GDB}
           function  get_var_value(const s:string):string;
           function  stabstr_evaluate(const s:string;vars:array of string):Pchar;
           function  stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : taasmoutput);virtual;
+          procedure concatstabto(asmlist : taasmoutput);
 {$endif GDB}
-          procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
-          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
-          function  is_visible_for_object(currobjdef:tobjectdef):boolean;
           function  mangledname : string;
           procedure generate_mangledname;virtual;abstract;
        end;
@@ -97,11 +87,11 @@ interface
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : taasmoutput);override;
+          function  stabstring:Pchar;override;
 {$endif GDB}
        end;
 
-       terrorsym = class(tstoredsym)
+       terrorsym = class(Tsym)
           constructor create;
        end;
 
@@ -151,7 +141,6 @@ interface
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
-          procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
        end;
 
@@ -170,7 +159,6 @@ interface
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
-          procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
        end;
 
@@ -202,7 +190,6 @@ interface
           procedure unregister_notification(id:cardinal);
 {$ifdef GDB}
           function  stabstring : pchar;override;
-          procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
          private
           procedure setvartype(const newtype: ttype);
@@ -233,7 +220,6 @@ interface
           procedure dooverride(overriden:tpropertysym);
 {$ifdef GDB}
           function  stabstring : pchar;override;
-          procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
        end;
 
@@ -251,7 +237,7 @@ interface
           function  mangledname : string;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : taasmoutput);override;
+          function  stabstring : pchar;override;
 {$endif GDB}
        end;
 
@@ -298,7 +284,6 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
           function  stabstring : pchar;override;
-          procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
        end;
 
@@ -314,7 +299,7 @@ interface
           procedure deref;override;
           procedure order;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : taasmoutput);override;
+          function stabstring:Pchar;
 {$endif GDB}
        end;
 
@@ -325,7 +310,7 @@ interface
           destructor  destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
-          procedure concatstabto(asmlist : taasmoutput);override;
+          function stabstring:Pchar;
 {$endif GDB}
        end;
 
@@ -408,15 +393,6 @@ implementation
          isstabwritten := false;
 {$endif GDB}
          fileinfo:=akttokenpos;
-         defref:=nil;
-         refs:=0;
-         lastwritten:=nil;
-         refcount:=0;
-         if (cs_browser in aktmoduleswitches) and make_ref then
-          begin
-            defref:=tref.create(defref,@akttokenpos);
-            inc(refcount);
-          end;
          lastref:=defref;
          _mangledname:=nil;
       end;
@@ -427,25 +403,13 @@ implementation
         s  : string;
         nr : word;
       begin
-         nr:=ppufile.getword;
-         s:=ppufile.getstring;
-         inherited create(s);
-         { force the correct indexnr. must be after create! }
-         indexnr:=nr;
-         ppufile.getposinfo(fileinfo);
-         ppufile.getsmallset(symoptions);
-         lastref:=nil;
-         defref:=nil;
-         refs:=0;
-         lastwritten:=nil;
-         refcount:=0;
+         inherited loadsym(ppufile);
          _mangledname:=nil;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
       end;
 
-
     procedure tstoredsym.buildderef;
       begin
       end;
@@ -456,76 +420,6 @@ implementation
       end;
 
 
-    procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
-      var
-        pos : tfileposinfo;
-        move_last : boolean;
-      begin
-        move_last:=lastwritten=lastref;
-        while (not ppufile.endofentry) do
-         begin
-           ppufile.getposinfo(pos);
-           inc(refcount);
-           lastref:=tref.create(lastref,@pos);
-           lastref.is_written:=true;
-           if refcount=1 then
-            defref:=lastref;
-         end;
-        if move_last then
-          lastwritten:=lastref;
-      end;
-
-    { big problem here :
-      wrong refs were written because of
-      interface parsing of other units PM
-      moduleindex must be checked !! }
-
-    function tstoredsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
-      var
-        d : tderef;
-        ref   : tref;
-        symref_written,move_last : boolean;
-      begin
-        write_references:=false;
-        if lastwritten=lastref then
-          exit;
-      { should we update lastref }
-        move_last:=true;
-        symref_written:=false;
-      { write symbol refs }
-        d.reset;
-        if assigned(lastwritten) then
-          ref:=lastwritten
-        else
-          ref:=defref;
-        while assigned(ref) do
-         begin
-           if ref.moduleindex=current_module.unit_index then
-             begin
-              { write address to this symbol }
-                if not symref_written then
-                  begin
-                     d.build(self);
-                     ppufile.putderef(d);
-                     symref_written:=true;
-                  end;
-                ppufile.putposinfo(ref.posinfo);
-                ref.is_written:=true;
-                if move_last then
-                  lastwritten:=ref;
-             end
-           else if not ref.is_written then
-             move_last:=false
-           else if move_last then
-             lastwritten:=ref;
-           ref:=ref.nextref;
-         end;
-        if symref_written then
-          ppufile.writeentry(ibsymref);
-        write_references:=symref_written;
-      end;
-
-
     destructor tstoredsym.destroy;
       begin
         if assigned(_mangledname) then
@@ -552,15 +446,6 @@ implementation
         inherited destroy;
       end;
 
-
-    procedure tstoredsym.writesym(ppufile:tcompilerppufile);
-      begin
-         ppufile.putword(indexnr);
-         ppufile.putstring(_realname^);
-         ppufile.putposinfo(fileinfo);
-         ppufile.putsmallset(symoptions);
-      end;
-
 {$ifdef GDB}
     function Tstoredsym.get_var_value(const s:string):string;
 
@@ -609,45 +494,12 @@ implementation
            begin
               stab_str := stabstring;
               if assigned(stab_str) then
-                asmList.concat(Tai_stabs.Create(stab_str));
+                asmlist.concat(Tai_stabs.create(stab_str));
               isstabwritten:=true;
           end;
     end;
 {$endif GDB}
 
-
-    function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
-      begin
-        is_visible_for_object:=false;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (sp_private in symoptions) and
-           assigned(owner.defowner) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (owner.defowner.owner.unitid<>0) then
-          exit;
-
-        { protected symbols are vissible in the module that defines them and
-          also visible to related objects }
-        if (sp_protected in symoptions) and
-           (
-            (
-             assigned(owner.defowner) and
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (owner.defowner.owner.unitid<>0)
-            ) and
-            not(
-                assigned(currobjdef) and
-                currobjdef.is_related(tobjectdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        is_visible_for_object:=true;
-      end;
-
-
     function tstoredsym.mangledname : string;
       begin
         if not assigned(_mangledname) then
@@ -759,10 +611,11 @@ implementation
       end;
 
 {$ifdef GDB}
-    procedure tunitsym.concatstabto(asmlist : taasmoutput);
-      begin
-      {Nothing to write to stabs !}
-      end;
+    function Tunitsym.stabstring:Pchar;
+
+    begin
+      stabstring:=nil;
+    end;
 {$endif GDB}
 
 {****************************************************************************
@@ -1362,13 +1215,7 @@ implementation
     function tprocsym.stabstring : pchar;
       begin
         internalerror(200111171);
-        stabstring:=nil;
       end;
-
-    procedure tprocsym.concatstabto(asmlist : taasmoutput);
-    begin
-      internalerror(200111172);
-    end;
 {$endif GDB}
 
 
@@ -1526,11 +1373,6 @@ implementation
          { !!!! don't know how to handle }
          stabstring:=nil;
       end;
-
-    procedure tpropertysym.concatstabto(asmlist : taasmoutput);
-      begin
-         { !!!! don't know how to handle }
-      end;
 {$endif GDB}
 
 
@@ -1648,10 +1490,11 @@ implementation
 
 
 {$ifdef GDB}
-    procedure tabsolutesym.concatstabto(asmlist : taasmoutput);
-      begin
-      { I don't know how to handle this !! }
-      end;
+    function Tabsolutesym.stabstring:Pchar;
+
+    begin
+      stabstring:=nil;
+    end;
 {$endif GDB}
 
 
@@ -1849,124 +1692,117 @@ implementation
     end;
 
 {$ifdef GDB}
-    function tvarsym.stabstring : pchar;
-     var
-       st : string;
-       threadvaroffset : string;
-       regidx : tregisterindex;
-     begin
-       stabstring:=nil;
-       st:=tstoreddef(vartype.def).numberstring;
-       if (vo_is_thread_var in varoptions) then
-         threadvaroffset:='+'+tostr(pointer_size)
-       else
-         threadvaroffset:='';
-
-       case owner.symtabletype of
-         objectsymtable :
-           if (sp_static in symoptions) then
-             begin
-               if (cs_gdb_gsym in aktglobalswitches) then
-                 st:='G'+st
-               else
-                 st:='S'+st;
-               stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
-             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:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
-           end;
-         staticsymtable :
-           stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
-         parasymtable,
-         localsymtable :
-           begin
-             { There is no space allocated for not referenced locals }
-             if (owner.symtabletype=localsymtable) and (refs=0) then
-               exit;
+    function Tvarsym.stabstring:Pchar;
 
-             if (vo_is_C_var in varoptions) then
-               begin
-                 stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]);
-                 exit;
-               end;
-             if (owner.symtabletype=parasymtable) then
-               begin
-                 if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
-                    not(vo_has_local_copy in varoptions) then
-                   st := 'v'+st { should be 'i' but 'i' doesn't work }
-                 else
-                   st := 'p'+st;
-               end;
-             case localloc.loc of
-               LOC_REGISTER, LOC_FPUREGISTER :
-                 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:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
-                 end;
-               LOC_REFERENCE :
-                 { offset to ebp => will not work if the framepointer is esp
-                   so some optimizing will make things harder to debug }
-                 stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
-               else
-                 internalerror(2003091814);
-             end;
-           end;
-         else
-           stabstring := inherited stabstring;
-       end;
-     end;
+    var st:string;
+        threadvaroffset:string;
+        regidx:Tregisterindex;
+        c:char;
 
+    begin
+      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
+            stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
+                  [Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)])
+          else
+            begin
+              if not(is_class(current_procinfo.procdef._class)) then
+                c:='v'
+              else
+                c:='p';
+              stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
+                    [c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]);
+            end;
+        end
+      else
+      (*
+        if (localloc.loc=LOC_REGISTER) then
+          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:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',
+                  [Tstoreddef(vartype.def).numberstring,tostr(regstabs_table[regidx])]);
+          end
+        else
+       *)
+          begin
+            stabstring:=nil;
+            st:=tstoreddef(vartype.def).numberstring;
+            if (vo_is_thread_var in varoptions) then
+              threadvaroffset:='+'+tostr(pointer_size)
+            else
+              threadvaroffset:='';
 
-    procedure tvarsym.concatstabto(asmlist : taasmoutput);
-      var
-        regidx : tregisterindex;
-        stab_str : pchar;
-        c : char;
-      begin
-         if (owner.symtabletype=parasymtable) and
-            (copy(name,1,6)='hidden') then
-           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
-               asmlist.concat(Tai_stabs.create(stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
-                  [Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)])))
-             else
-               begin
-                 if not(is_class(current_procinfo.procdef._class)) then
-                   c:='v'
-                 else
-                   c:='p';
-                 asmlist.concat(Tai_stabs.create(stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
-                    [c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)])));
-               end;
-           end
-         else
-           if (localloc.loc=LOC_REGISTER) then
-             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}
-                asmlist.concat(Tai_stabs.create(stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',
-                  [Tstoreddef(vartype.def).numberstring,tostr(regstabs_table[regidx])])));
-             end
-         else
-           inherited concatstabto(asmlist);
-      end;
+            case owner.symtabletype of
+              objectsymtable:
+                if (sp_static in symoptions) then
+                  begin
+                    if (cs_gdb_gsym in aktglobalswitches) then
+                      st:='G'+st
+                    else
+                      st:='S'+st;
+                    stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',
+                                                 [st,threadvaroffset]);
+                  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:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
+                end;
+              staticsymtable :
+                stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
+              parasymtable,localsymtable:
+                begin
+                  { There is no space allocated for not referenced locals }
+                  if (owner.symtabletype=localsymtable) and (refs=0) then
+                    exit;
+
+                  if (vo_is_C_var in varoptions) then
+                    begin
+                      stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]);
+                      exit;
+                    end;
+                  if (owner.symtabletype=parasymtable) then
+                    begin
+                      if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
+                         not(vo_has_local_copy in varoptions) then
+                        st := 'v'+st { should be 'i' but 'i' doesn't work }
+                      else
+                        st := 'p'+st;
+                    end;
+                  case localloc.loc of
+                    LOC_REGISTER, LOC_FPUREGISTER :
+                      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:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
+                      end;
+                    LOC_REFERENCE :
+                      { offset to ebp => will not work if the framepointer is esp
+                        so some optimizing will make things harder to debug }
+                      stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
+                    else
+                      internalerror(2003091814);
+                  end;
+                end;
+              else
+                stabstring := inherited stabstring;
+            end;
+          end;
+    end;
 {$endif GDB}
 
     procedure tvarsym.setvartype(const newtype: ttype);
@@ -2337,12 +2173,6 @@ implementation
       end;
       stabstring:=stabstr_evaluate('"${name}:c=$1",${N_FUNCTION},0,${line},0',[st]);
     end;
-
-    procedure tconstsym.concatstabto(asmlist : taasmoutput);
-      begin
-        if consttyp <> conststring then
-          inherited concatstabto(asmlist);
-      end;
 {$endif GDB}
 
 
@@ -2428,9 +2258,10 @@ implementation
 
 
 {$ifdef GDB}
-    procedure tenumsym.concatstabto(asmlist : taasmoutput);
+    function Tenumsym.stabstring:Pchar;
+
     begin
-    {enum elements have no stab !}
+      {enum elements have no stab !}
     end;
 {$EndIf GDB}
 
@@ -2534,22 +2365,17 @@ implementation
     var stabchar:string[2];
 
     begin
-      if restype.def.deftype in tagtypes then
-        stabchar:='Tt'
+      if restype.def=nil then
+        stabstring:=nil
       else
-        stabchar:='t';
-      stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
+        begin
+          if restype.def.deftype in tagtypes then
+            stabchar:='Tt'
+          else
+            stabchar:='t';
+          stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
+        end;
     end;
-
-    procedure ttypesym.concatstabto(asmlist : taasmoutput);
-      begin
-      {not stabs for forward defs }
-      if assigned(restype.def) then
-        if (restype.def.typesym = self) then
-          tstoreddef(restype.def).concatstabto(asmlist)
-        else
-          inherited concatstabto(asmlist);
-      end;
 {$endif GDB}
 
 
@@ -2584,9 +2410,11 @@ implementation
       end;
 
 {$ifdef GDB}
-    procedure tsyssym.concatstabto(asmlist : taasmoutput);
-      begin
-      end;
+    function Tsyssym.stabstring:Pchar;
+
+    begin
+      stabstring:=nil
+    end;
 {$endif GDB}
 
 
@@ -2719,7 +2547,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.144  2004-01-25 11:33:48  daniel
+  Revision 1.145  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.144  2004/01/25 11:33:48  daniel
     * 2nd round of gdb cleanup
 
   Revision 1.143  2004/01/16 18:08:39  daniel

compiler/symtable.pas

@@ -33,7 +33,7 @@ interface
        { symtable }
        symconst,symbase,symtype,symdef,symsym,
        { ppu }
-       ppu,symppu,
+       ppu,
        { assembler }
        aasmtai
        ;
@@ -399,18 +399,18 @@ implementation
 
     procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile);
       var
-        pd : tstoredsym;
+        pd : Tsym;
       begin
          { each definition get a number, write then the amount of syms and the
            datasize to the ibsymdef entry }
          ppufile.putlongint(symindex.count);
          ppufile.writeentry(ibstartsyms);
          { foreach is used to write all symbols }
-         pd:=tstoredsym(symindex.first);
+         pd:=Tsym(symindex.first);
          while assigned(pd) do
            begin
               pd.ppuwrite(ppufile);
-              pd:=tstoredsym(pd.indexnext);
+              pd:=Tsym(pd.indexnext);
            end;
          { end of symbols }
          ppufile.writeentry(ibendsyms);
@@ -421,7 +421,7 @@ implementation
       var
         b     : byte;
         d     : tderef;
-        sym   : tstoredsym;
+        sym   : Tsym;
         prdef : tstoreddef;
       begin
          b:=ppufile.readentry;
@@ -433,7 +433,7 @@ implementation
              ibsymref :
                begin
                  ppufile.getderef(d);
-                 sym:=tstoredsym(d.resolve);
+                 sym:=Tsym(d.resolve);
                  if assigned(sym) then
                    sym.load_references(ppufile,locals);
                end;
@@ -459,15 +459,15 @@ implementation
 
     procedure tstoredsymtable.write_references(ppufile:tcompilerppufile;locals:boolean);
       var
-        pd : tstoredsym;
+        pd : Tsym;
       begin
          ppufile.writeentry(ibbeginsymtablebrowser);
          { write all symbols }
-         pd:=tstoredsym(symindex.first);
+         pd:=Tsym(symindex.first);
          while assigned(pd) do
            begin
               pd.write_references(ppufile,locals);
-              pd:=tstoredsym(pd.indexnext);
+              pd:=Tsym(pd.indexnext);
            end;
          ppufile.writeentry(ibendsymtablebrowser);
       end;
@@ -610,10 +610,10 @@ implementation
 
     function tstoredsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
       var
-        hp : tstoredsym;
+        hp : Tsym;
         newref : tref;
       begin
-        hp:=tstoredsym(inherited speedsearch(s,speedvalue));
+        hp:=Tsym(inherited speedsearch(s,speedvalue));
         if assigned(hp) then
          begin
            { reject non static members in static procedures }
@@ -636,8 +636,7 @@ implementation
              as TCHILDCLASS.Create did not generate appropriate
              stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
            if (cs_debuginfo in aktmoduleswitches) and
-              (hp.typ=typesym) and
-              make_ref then
+              (hp.typ=typesym) and make_ref then
              begin
                if assigned(ttypesym(hp).restype.def) then
                  tstoreddef(ttypesym(hp).restype.def).numberstring
@@ -765,12 +764,12 @@ implementation
               (copy(p.name,1,3)='def') then
              exit;
            { do not claim for inherited private fields !! }
-           if (tstoredsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
+           if (Tsym(p).refs=0) and (tsym(p).owner.symtabletype=objectsymtable) then
              MessagePos2(tsym(p).fileinfo,sym_n_private_method_not_used,tsym(p).owner.realname^,tsym(p).realname)
            { units references are problematic }
            else
             begin
-              if (tstoredsym(p).refs=0) and
+              if (Tsym(p).refs=0) and
                  not(tsym(p).typ in [enumsym,unitsym]) and
                  not(is_funcret_sym(tsym(p))) and
                  (
@@ -1174,7 +1173,7 @@ implementation
               { but private ids can be reused }
               hsym:=search_class_member(tobjectdef(defowner),sym.name);
               if assigned(hsym) and
-                 tstoredsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
+                 Tsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
                begin
                  DuplicateSym(hsym);
                  exit;
@@ -1313,7 +1312,7 @@ implementation
               hsym:=search_class_member(tobjectdef(next.defowner),sym.name);
               { private ids can be reused }
               if assigned(hsym) and
-                 tstoredsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
+                 Tsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
                begin
                  { delphi allows to reuse the names in a class, but not
                    in object (tp7 compatible) }
@@ -1801,7 +1800,7 @@ implementation
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
               if assigned(srsym) and
                  (not assigned(current_procinfo) or
-                  tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
+                  Tsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
                begin
                  searchsym:=true;
                  exit;
@@ -1832,7 +1831,7 @@ implementation
                   srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
                   if assigned(srsym) and
                      (not assigned(current_procinfo) or
-                      tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
+                      Tsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
                     begin
                       result:=true;
                       exit;
@@ -1899,7 +1898,7 @@ implementation
           begin
             sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
             if assigned(sym) and
-               tstoredsym(sym).is_visible_for_object(topclassh) then
+               Tsym(sym).is_visible_for_object(topclassh) then
               break;
             classh:=classh.childof;
           end;
@@ -2298,7 +2297,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.125  2004-01-15 15:16:18  daniel
+  Revision 1.126  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.125  2004/01/15 15:16:18  daniel
     * Some minor stuff
     * Managed to eliminate speed effects of string compression
 

compiler/symtype.pas

@@ -36,7 +36,7 @@ interface
       { symtable }
       symconst,symbase,
       { aasm }
-      aasmbase
+      aasmbase,ppu,cpuinfo
       ;
 
     type
@@ -45,6 +45,8 @@ interface
 ************************************************}
 
       tsym = class;
+      Tcompilerppufile=class;
+
 
 {************************************************
                      TRef
@@ -92,17 +94,39 @@ interface
 
       { this object is the base for all symbol objects }
       tsym = class(tsymentry)
+      protected
+{$ifdef GDB}
+{         isstabwritten : boolean;}
+{$endif GDB}
+      public
          _realname  : pstring;
          fileinfo   : tfileposinfo;
          symoptions : tsymoptions;
+         refs          : longint;
+         lastref,
+         defref,
+         lastwritten : tref;
+         refcount    : longint;
+{$ifdef GDB}
+{         function  get_var_value(const s:string):string;
+         function  stabstr_evaluate(const s:string;vars:array of string):Pchar;
+         function  stabstring : pchar;virtual;
+         procedure concatstabto(asmlist : taasmoutput);virtual;}
+{$endif GDB}
          constructor create(const n : string);
+         constructor loadsym(ppufile:tcompilerppufile);
          destructor destroy;override;
+         procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract;
+         procedure writesym(ppufile:tcompilerppufile);
          function  realname:string;
          procedure buildderef;virtual;abstract;
          procedure buildderefimpl;virtual;abstract;
          procedure deref;virtual;abstract;
          procedure derefimpl;virtual;abstract;
          function  gettypedef:tdef;virtual;
+         procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
+         function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
+         function is_visible_for_object(currobjdef:Tdef):boolean;
       end;
 
 {************************************************
@@ -163,6 +187,29 @@ interface
         procedure buildderef;
       end;
 
+{************************************************
+                Tcompilerppufile
+************************************************}
+       tcompilerppufile=class(tppufile)
+       public
+         procedure checkerror;
+         procedure getguid(var g: tguid);
+         function  getexprint:tconstexprint;
+         function  getptruint:TConstPtrUInt;
+         procedure getposinfo(var p:tfileposinfo);
+         procedure getderef(var d:tderef);
+         function  getsymlist:tsymlist;
+         procedure gettype(var t:ttype);
+         function  getasmsymbol:tasmsymbol;
+         procedure putguid(const g: tguid);
+         procedure putexprint(v:tconstexprint);
+         procedure PutPtrUInt(v:TConstPtrUInt);
+         procedure putposinfo(const p:tfileposinfo);
+         procedure putderef(const d:tderef);
+         procedure putsymlist(p:tsymlist);
+         procedure puttype(const t:ttype);
+         procedure putasmsymbol(s:tasmsymbol);
+       end;
 
 {$ifdef MEMDEBUG}
     var
@@ -180,7 +227,8 @@ implementation
 
     uses
        verbose,
-       fmodule;
+       fmodule,
+       symdef;
 
 {****************************************************************************
                                 Tdef
@@ -248,8 +296,40 @@ implementation
          _realname:=stringdup(n);
          typ:=abstractsym;
          symoptions:=[];
+         defref:=nil;
+         refs:=0;
+         lastwritten:=nil;
+         refcount:=0;
+         if (cs_browser in aktmoduleswitches) and make_ref then
+          begin
+            defref:=tref.create(defref,@akttokenpos);
+            inc(refcount);
+          end;
       end;
 
+    constructor tsym.loadsym(ppufile:tcompilerppufile);
+      var
+        s  : string;
+        nr : word;
+      begin
+         nr:=ppufile.getword;
+         s:=ppufile.getstring;
+         if s[1]='$' then
+          inherited createname(copy(s,2,255))
+         else
+          inherited createname(upper(s));
+         _realname:=stringdup(s);
+         typ:=abstractsym;
+         { force the correct indexnr. must be after create! }
+         indexnr:=nr;
+         ppufile.getposinfo(fileinfo);
+         ppufile.getsmallset(symoptions);
+         lastref:=nil;
+         defref:=nil;
+         refs:=0;
+         lastwritten:=nil;
+         refcount:=0;
+      end;
 
     destructor tsym.destroy;
       begin
@@ -263,6 +343,68 @@ implementation
         inherited destroy;
       end;
 
+    procedure Tsym.writesym(ppufile:tcompilerppufile);
+      begin
+         ppufile.putword(indexnr);
+         ppufile.putstring(_realname^);
+         ppufile.putposinfo(fileinfo);
+         ppufile.putsmallset(symoptions);
+      end;
+
+{$ifdef xGDB}
+    function Tsym.get_var_value(const s:string):string;
+
+    begin
+      if s='name' then
+        get_var_value:=name
+      else if s='ownername' then
+        get_var_value:=owner.name^
+      else if s='mangledname' then
+        get_var_value:=mangledname
+      else if s='line' then
+        get_var_value:=tostr(fileinfo.line)
+      else if s='N_LSYM' then
+        get_var_value:=tostr(N_LSYM)
+      else if s='N_LCSYM' then
+        get_var_value:=tostr(N_LCSYM)
+      else if s='N_RSYM' then
+        get_var_value:=tostr(N_RSYM)
+      else if s='N_TSYM' then
+        get_var_value:=tostr(N_TSYM)
+      else if s='N_STSYM' then
+        get_var_value:=tostr(N_STSYM)
+      else if s='N_FUNCTION' then
+        get_var_value:=tostr(N_FUNCTION)
+      else
+        internalerror(200401152);
+    end;
+
+    function Tsym.stabstr_evaluate(const s:string;vars:array of string):Pchar;
+
+    begin
+      stabstr_evaluate:=string_evaluate(s,@get_var_value,vars);
+    end;
+
+    function Tsym.stabstring : pchar;
+
+    begin
+      stabstring:=stabstr_evaluate('"${name}",${N_LSYM},0,${line},0',[]);
+    end;
+
+    procedure Tsym.concatstabto(asmlist : taasmoutput);
+      var
+        stab_str : pchar;
+      begin
+         if not isstabwritten then
+           begin
+              stab_str := stabstring;
+              if assigned(stab_str) then
+                asmList.concat(Tai_stabs.Create(stab_str));
+              isstabwritten:=true;
+          end;
+    end;
+{$endif xGDB}
+
 
     function tsym.realname : string;
       begin
@@ -279,6 +421,107 @@ implementation
       end;
 
 
+    procedure Tsym.load_references(ppufile:tcompilerppufile;locals:boolean);
+      var
+        pos : tfileposinfo;
+        move_last : boolean;
+      begin
+        move_last:=lastwritten=lastref;
+        while (not ppufile.endofentry) do
+         begin
+           ppufile.getposinfo(pos);
+           inc(refcount);
+           lastref:=tref.create(lastref,@pos);
+           lastref.is_written:=true;
+           if refcount=1 then
+            defref:=lastref;
+         end;
+        if move_last then
+          lastwritten:=lastref;
+      end;
+
+    { big problem here :
+      wrong refs were written because of
+      interface parsing of other units PM
+      moduleindex must be checked !! }
+
+    function Tsym.write_references(ppufile:tcompilerppufile;locals:boolean):boolean;
+      var
+        d : tderef;
+        ref   : tref;
+        symref_written,move_last : boolean;
+      begin
+        write_references:=false;
+        if lastwritten=lastref then
+          exit;
+      { should we update lastref }
+        move_last:=true;
+        symref_written:=false;
+      { write symbol refs }
+        d.reset;
+        if assigned(lastwritten) then
+          ref:=lastwritten
+        else
+          ref:=defref;
+        while assigned(ref) do
+         begin
+           if ref.moduleindex=current_module.unit_index then
+             begin
+              { write address to this symbol }
+                if not symref_written then
+                  begin
+                     d.build(self);
+                     ppufile.putderef(d);
+                     symref_written:=true;
+                  end;
+                ppufile.putposinfo(ref.posinfo);
+                ref.is_written:=true;
+                if move_last then
+                  lastwritten:=ref;
+             end
+           else if not ref.is_written then
+             move_last:=false
+           else if move_last then
+             lastwritten:=ref;
+           ref:=ref.nextref;
+         end;
+        if symref_written then
+          ppufile.writeentry(ibsymref);
+        write_references:=symref_written;
+      end;
+
+
+    function Tsym.is_visible_for_object(currobjdef:Tdef):boolean;
+      begin
+        is_visible_for_object:=false;
+
+        { private symbols are allowed when we are in the same
+          module as they are defined }
+        if (sp_private in symoptions) and
+           assigned(owner.defowner) and
+           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+           (owner.defowner.owner.unitid<>0) then
+          exit;
+
+        { protected symbols are vissible in the module that defines them and
+          also visible to related objects }
+        if (sp_protected in symoptions) and
+           (
+            (
+             assigned(owner.defowner) and
+             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+             (owner.defowner.owner.unitid<>0)
+            ) and
+            not(
+                assigned(currobjdef) and
+                Tobjectdef(currobjdef).is_related(tobjectdef(owner.defowner))
+               )
+           ) then
+          exit;
+
+        is_visible_for_object:=true;
+      end;
+
 {****************************************************************************
                                TRef
 ****************************************************************************}
@@ -912,6 +1155,340 @@ implementation
           end;
       end;
 
+{*****************************************************************************
+                            TCompilerPPUFile
+*****************************************************************************}
+
+    procedure tcompilerppufile.checkerror;
+      begin
+        if error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
+    procedure tcompilerppufile.getguid(var g: tguid);
+      begin
+        getdata(g,sizeof(g));
+      end;
+
+
+    function tcompilerppufile.getexprint:tconstexprint;
+      var
+        l1,l2 : longint;
+      begin
+        if sizeof(tconstexprint)=8 then
+          begin
+            l1:=getlongint;
+            l2:=getlongint;
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+{$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
+            result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+          end
+        else
+          result:=tconstexprint(getlongint);
+      end;
+
+
+    function tcompilerppufile.getPtrUInt:TConstPtrUInt;
+      var
+        l1,l2 : longint;
+      begin
+        if sizeof(TConstPtrUInt)=8 then
+          begin
+            l1:=getlongint;
+            l2:=getlongint;
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+{$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
+            result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+          end
+        else
+          result:=TConstPtrUInt(getlongint);
+      end;
+
+
+    procedure tcompilerppufile.getposinfo(var p:tfileposinfo);
+      var
+        info : byte;
+      begin
+        {
+          info byte layout in bits:
+          0-1 - amount of bytes for fileindex
+          2-3 - amount of bytes for line
+          4-5 - amount of bytes for column
+        }
+        info:=getbyte;
+        case (info and $03) of
+         0 : p.fileindex:=getbyte;
+         1 : p.fileindex:=getword;
+         2 : p.fileindex:=(getbyte shl 16) or getword;
+         3 : p.fileindex:=getlongint;
+        end;
+        case ((info shr 2) and $03) of
+         0 : p.line:=getbyte;
+         1 : p.line:=getword;
+         2 : p.line:=(getbyte shl 16) or getword;
+         3 : p.line:=getlongint;
+        end;
+        case ((info shr 4) and $03) of
+         0 : p.column:=getbyte;
+         1 : p.column:=getword;
+         2 : p.column:=(getbyte shl 16) or getword;
+         3 : p.column:=getlongint;
+        end;
+      end;
+
+
+    procedure tcompilerppufile.getderef(var d:tderef);
+      begin
+        d.dataidx:=getlongint;
+      end;
+
+
+    function tcompilerppufile.getsymlist:tsymlist;
+      var
+        symderef : tderef;
+        tt  : ttype;
+        slt : tsltype;
+        idx : longint;
+        p   : tsymlist;
+      begin
+        p:=tsymlist.create;
+        getderef(p.procdefderef);
+        repeat
+          slt:=tsltype(getbyte);
+          case slt of
+            sl_none :
+              break;
+            sl_call,
+            sl_load,
+            sl_subscript :
+              begin
+                getderef(symderef);
+                p.addsymderef(slt,symderef);
+              end;
+            sl_typeconv :
+              begin
+                gettype(tt);
+                p.addtype(slt,tt);
+              end;
+            sl_vec :
+              begin
+                idx:=getlongint;
+                p.addconst(slt,idx);
+              end;
+            else
+              internalerror(200110204);
+          end;
+        until false;
+        getsymlist:=tsymlist(p);
+      end;
+
+
+    procedure tcompilerppufile.gettype(var t:ttype);
+      begin
+        getderef(t.deref);
+        t.def:=nil;
+        t.sym:=nil;
+      end;
+
+
+    function  tcompilerppufile.getasmsymbol:tasmsymbol;
+      begin
+        getasmsymbol:=tasmsymbol(pointer(getlongint));
+      end;
+
+
+    procedure tcompilerppufile.putposinfo(const p:tfileposinfo);
+      var
+        oldcrc : boolean;
+        info   : byte;
+      begin
+        { posinfo is not relevant for changes in PPU }
+        oldcrc:=do_crc;
+        do_crc:=false;
+        {
+          info byte layout in bits:
+          0-1 - amount of bytes for fileindex
+          2-3 - amount of bytes for line
+          4-5 - amount of bytes for column
+        }
+        info:=0;
+        { calculate info byte }
+        if (p.fileindex>$ff) then
+         begin
+           if (p.fileindex<=$ffff) then
+            info:=info or $1
+           else
+            if (p.fileindex<=$ffffff) then
+             info:=info or $2
+           else
+            info:=info or $3;
+          end;
+        if (p.line>$ff) then
+         begin
+           if (p.line<=$ffff) then
+            info:=info or $4
+           else
+            if (p.line<=$ffffff) then
+             info:=info or $8
+           else
+            info:=info or $c;
+          end;
+        if (p.column>$ff) then
+         begin
+           if (p.column<=$ffff) then
+            info:=info or $10
+           else
+            if (p.column<=$ffffff) then
+             info:=info or $20
+           else
+            info:=info or $30;
+          end;
+        { write data }
+        putbyte(info);
+        case (info and $03) of
+         0 : putbyte(p.fileindex);
+         1 : putword(p.fileindex);
+         2 : begin
+               putbyte(p.fileindex shr 16);
+               putword(p.fileindex and $ffff);
+             end;
+         3 : putlongint(p.fileindex);
+        end;
+        case ((info shr 2) and $03) of
+         0 : putbyte(p.line);
+         1 : putword(p.line);
+         2 : begin
+               putbyte(p.line shr 16);
+               putword(p.line and $ffff);
+             end;
+         3 : putlongint(p.line);
+        end;
+        case ((info shr 4) and $03) of
+         0 : putbyte(p.column);
+         1 : putword(p.column);
+         2 : begin
+               putbyte(p.column shr 16);
+               putword(p.column and $ffff);
+             end;
+         3 : putlongint(p.column);
+        end;
+        do_crc:=oldcrc;
+      end;
+
+
+    procedure tcompilerppufile.putguid(const g: tguid);
+      begin
+        putdata(g,sizeof(g));
+      end;
+
+
+    procedure tcompilerppufile.putexprint(v:tconstexprint);
+      begin
+        if sizeof(TConstExprInt)=8 then
+          begin
+             putlongint(longint(lo(v)));
+             putlongint(longint(hi(v)));
+          end
+        else if sizeof(TConstExprInt)=4 then
+          putlongint(longint(v))
+        else
+          internalerror(2002082601);
+      end;
+
+
+    procedure tcompilerppufile.PutPtrUInt(v:TConstPtrUInt);
+      begin
+        if sizeof(TConstPtrUInt)=8 then
+          begin
+             putlongint(longint(lo(v)));
+             putlongint(longint(hi(v)));
+          end
+        else if sizeof(TConstPtrUInt)=4 then
+          putlongint(longint(v))
+        else
+          internalerror(2002082601);
+      end;
+
+
+    procedure tcompilerppufile.putderef(const d:tderef);
+      var
+        oldcrc : boolean;
+      begin
+        oldcrc:=do_crc;
+        do_crc:=false;
+        putlongint(d.dataidx);
+        do_crc:=oldcrc;
+      end;
+
+
+    procedure tcompilerppufile.putsymlist(p:tsymlist);
+      var
+        hp : psymlistitem;
+      begin
+        putderef(p.procdefderef);
+        hp:=p.firstsym;
+        while assigned(hp) do
+         begin
+           putbyte(byte(hp^.sltype));
+           case hp^.sltype of
+             sl_call,
+             sl_load,
+             sl_subscript :
+               putderef(hp^.symderef);
+             sl_typeconv :
+               puttype(hp^.tt);
+             sl_vec :
+               putlongint(hp^.value);
+             else
+              internalerror(200110205);
+           end;
+           hp:=hp^.next;
+         end;
+        putbyte(byte(sl_none));
+      end;
+
+
+    procedure tcompilerppufile.puttype(const t:ttype);
+      begin
+        putderef(t.deref);
+      end;
+
+
+    procedure tcompilerppufile.putasmsymbol(s:tasmsymbol);
+      begin
+        if assigned(s) then
+         begin
+           if s.ppuidx=-1 then
+            begin
+              inc(objectlibrary.asmsymbolppuidx);
+              s.ppuidx:=objectlibrary.asmsymbolppuidx;
+            end;
+           putlongint(s.ppuidx);
+         end
+        else
+         putlongint(0);
+      end;
 
 {$ifdef MEMDEBUG}
 initialization
@@ -943,7 +1520,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.34  2003-11-10 22:02:52  peter
+  Revision 1.35  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.34  2003/11/10 22:02:52  peter
     * cross unit inlining fixed
 
   Revision 1.33  2003/10/28 15:36:01  peter
@@ -1044,3 +1625,7 @@ end.
       on demand from tprocdef.mangledname
 
 }
+
+
+
+end.

compiler/x86/aasmcpu.pas

@@ -34,7 +34,7 @@ interface
       cclasses,globals,verbose,
       cpuinfo,cpubase,
       cgbase,
-      symppu,symtype,symsym,
+      symtype,symsym,
       aasmbase,aasmtai;
 
     const
@@ -1971,7 +1971,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.45  2004-01-15 14:01:32  florian
+  Revision 1.46  2004-01-26 16:12:28  daniel
+    * reginfo now also only allocated during register allocation
+    * third round of gdb cleanups: kick out most of concatstabto
+
+  Revision 1.45  2004/01/15 14:01:32  florian
     + x86 instruction tables for x86-64 extended
 
   Revision 1.44  2004/01/12 16:37:59  peter