Explorar el Código

* stabs updates to write stabs for def for all implictly used
units

peter hace 21 años
padre
commit
abbd54f334
Se han modificado 10 ficheros con 602 adiciones y 622 borrados
  1. 12 6
      compiler/fmodule.pas
  2. 11 1
      compiler/gdb.pas
  3. 6 2
      compiler/nobj.pas
  4. 9 5
      compiler/pdecl.pas
  5. 94 81
      compiler/pmodules.pas
  6. 7 4
      compiler/psystem.pas
  7. 10 4
      compiler/symconst.pas
  8. 384 391
      compiler/symdef.pas
  9. 5 10
      compiler/symsym.pas
  10. 64 118
      compiler/symtable.pas

+ 12 - 6
compiler/fmodule.pas

@@ -87,6 +87,8 @@ interface
         do_compile,               { need to compile the sources }
         do_compile,               { need to compile the sources }
         sources_avail,            { if all sources are reachable }
         sources_avail,            { if all sources are reachable }
         interface_compiled,       { if the interface section has been parsed/compiled/loaded }
         interface_compiled,       { if the interface section has been parsed/compiled/loaded }
+        is_stab_written,
+        is_reset,
         is_unit,
         is_unit,
         in_interface,             { processing the implementation part? }
         in_interface,             { processing the implementation part? }
         in_global     : boolean;  { allow global settings }
         in_global     : boolean;  { allow global settings }
@@ -142,12 +144,10 @@ interface
       end;
       end;
 
 
        tused_unit = class(tlinkedlistitem)
        tused_unit = class(tlinkedlistitem)
-          unitid          : longint;
           checksum,
           checksum,
           interface_checksum : cardinal;
           interface_checksum : cardinal;
           in_uses,
           in_uses,
-          in_interface,
-          is_stab_written : boolean;
+          in_interface    : boolean;
           u               : tmodule;
           u               : tmodule;
           unitsym         : tunitsym;
           unitsym         : tunitsym;
           constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
           constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
@@ -314,8 +314,6 @@ implementation
         u:=_u;
         u:=_u;
         in_interface:=intface;
         in_interface:=intface;
         in_uses:=inuses;
         in_uses:=inuses;
-        is_stab_written:=false;
-        unitid:=0;
         unitsym:=usym;
         unitsym:=usym;
         if _u.state=ms_compiled then
         if _u.state=ms_compiled then
          begin
          begin
@@ -396,6 +394,8 @@ implementation
         in_global:=true;
         in_global:=true;
         is_unit:=_is_unit;
         is_unit:=_is_unit;
         islibrary:=false;
         islibrary:=false;
+        is_stab_written:=false;
+        is_reset:=false;
         uses_imports:=false;
         uses_imports:=false;
         imports:=TLinkedList.Create;
         imports:=TLinkedList.Create;
         _exports:=TLinkedList.Create;
         _exports:=TLinkedList.Create;
@@ -563,6 +563,8 @@ implementation
         interface_compiled:=false;
         interface_compiled:=false;
         in_interface:=true;
         in_interface:=true;
         in_global:=true;
         in_global:=true;
+        is_stab_written:=false;
+        is_reset:=false;
         crc:=0;
         crc:=0;
         interface_crc:=0;
         interface_crc:=0;
         flags:=0;
         flags:=0;
@@ -692,7 +694,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.43  2003-12-08 22:33:43  peter
+  Revision 1.44  2004-03-08 22:07:46  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.43  2003/12/08 22:33:43  peter
     * don't allow duplicate uses
     * don't allow duplicate uses
     * fix wrong circular dependency
     * fix wrong circular dependency
 
 

+ 11 - 1
compiler/gdb.pas

@@ -84,6 +84,8 @@ Const
 
 
   implementation
   implementation
 
 
+uses fmodule;
+
 { to use N_EXCL we have to count the character in the stabs for
 { to use N_EXCL we have to count the character in the stabs for
 N_BINCL to N_EINCL
 N_BINCL to N_EINCL
   Code comes from stabs.c for ld
   Code comes from stabs.c for ld
@@ -179,6 +181,10 @@ N_BINCL to N_EINCL
       begin
       begin
          inherited create;
          inherited create;
          typ:=ait_stabs;
          typ:=ait_stabs;
+
+if current_module.modulename^='NCNV' then
+  current_module:=current_module;
+
          str:=_str;
          str:=_str;
          if do_count_dbx then
          if do_count_dbx then
            begin
            begin
@@ -233,7 +239,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.17  2003-10-22 15:22:33  peter
+  Revision 1.18  2004-03-08 22:07:46  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.17  2003/10/22 15:22:33  peter
     * fixed unitsym-globalsymtable relation so the uses of a unit
     * fixed unitsym-globalsymtable relation so the uses of a unit
       is counted correctly
       is counted correctly
 
 

+ 6 - 2
compiler/nobj.pas

@@ -1265,7 +1265,7 @@ implementation
            do_count_dbx:=true;
            do_count_dbx:=true;
            if assigned(_class.owner) and assigned(_class.owner.name) then
            if assigned(_class.owner) and assigned(_class.owner.name) then
              dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+
              dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+
-               typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname)));
+               tstoreddef(vmttype.def).numberstring+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname)));
          end;
          end;
 {$endif GDB}
 {$endif GDB}
          dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
          dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
@@ -1380,7 +1380,11 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.66  2004-03-04 17:23:50  peter
+  Revision 1.67  2004-03-08 22:07:46  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.66  2004/03/04 17:23:50  peter
     * fix compare of parameters, they need to match exact
     * fix compare of parameters, they need to match exact
 
 
   Revision 1.65  2004/03/02 00:36:33  olle
   Revision 1.65  2004/03/02 00:36:33  olle

+ 9 - 5
compiler/pdecl.pas

@@ -286,9 +286,9 @@ implementation
         again  : boolean;
         again  : boolean;
         srsym  : tsym;
         srsym  : tsym;
         srsymtable : tsymtable;
         srsymtable : tsymtable;
-      {$ifdef gdb}
+      {$ifdef gdb_notused}
         stab_str:Pchar;
         stab_str:Pchar;
-      {$endif}
+      {$endif gdb_notused}
 
 
       begin
       begin
          { Check only typesyms or record/object fields }
          { Check only typesyms or record/object fields }
@@ -342,7 +342,7 @@ implementation
                        tpointerdef(pd).pointertype.setsym(srsym);
                        tpointerdef(pd).pointertype.setsym(srsym);
                        { avoid wrong unused warnings web bug 801 PM }
                        { avoid wrong unused warnings web bug 801 PM }
                        inc(ttypesym(srsym).refs);
                        inc(ttypesym(srsym).refs);
-{$ifdef GDB}
+{$ifdef GDB_UNUSED}
                        if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
                        if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
                           (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
                           (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
                         begin
                         begin
@@ -362,7 +362,7 @@ implementation
                                 end;
                                 end;
                             end;
                             end;
                         end;
                         end;
-{$endif GDB}
+{$endif GDB_UNUSED}
                        { we need a class type for classrefdef }
                        { we need a class type for classrefdef }
                        if (pd.deftype=classrefdef) and
                        if (pd.deftype=classrefdef) and
                           not(is_class(ttypesym(srsym).restype.def)) then
                           not(is_class(ttypesym(srsym).restype.def)) then
@@ -675,7 +675,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.82  2004-02-20 19:49:21  daniel
+  Revision 1.83  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.82  2004/02/20 19:49:21  daniel
     * Message system uses open arrays internally
     * Message system uses open arrays internally
     * Bugfix for string handling in array constructor node
     * Bugfix for string handling in array constructor node
     * Micro code reductions in pdecl.pas
     * Micro code reductions in pdecl.pas

+ 94 - 81
compiler/pmodules.pas

@@ -24,8 +24,6 @@ unit pmodules;
 
 
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
 
 
-{$define New_GDB}
-
 interface
 interface
 
 
     procedure proc_unit;
     procedure proc_unit;
@@ -571,16 +569,6 @@ implementation
          symtablestack:=defaultsymtablestack;
          symtablestack:=defaultsymtablestack;
          while assigned(pu) do
          while assigned(pu) do
            begin
            begin
-{$IfDef GDB}
-              if (cs_debuginfo in aktmoduleswitches) and
-                 (cs_gdb_dbx in aktglobalswitches) and
-                not pu.is_stab_written then
-                begin
-                   tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
-                   pu.is_stab_written:=true;
-                   pu.unitid:=tsymtable(pu.u.globalsymtable).unitid;
-                end;
-{$EndIf GDB}
               if pu.in_uses then
               if pu.in_uses then
                 begin
                 begin
                    { Reinsert in symtablestack }
                    { Reinsert in symtablestack }
@@ -607,41 +595,68 @@ implementation
       end;
       end;
 
 
 
 
-     procedure write_gdb_info;
 {$IfDef GDB}
 {$IfDef GDB}
+     procedure write_gdb_info;
+
+       procedure reset_unit_type_info;
        var
        var
-         hp : tused_unit;
+         hp : tmodule;
        begin
        begin
-         if not (cs_debuginfo in aktmoduleswitches) then
-          exit;
-         { now insert the units in the symtablestack }
-         hp:=tused_unit(current_module.used_units.first);
+         hp:=tmodule(loaded_units.first);
          while assigned(hp) do
          while assigned(hp) do
            begin
            begin
-              if (cs_debuginfo in aktmoduleswitches) and
-                not hp.is_stab_written then
-                begin
-                   tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
-                   hp.is_stab_written:=true;
-                   hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
-                end;
-              hp:=tused_unit(hp.next);
+             hp.is_stab_written:=false;
+             hp:=tmodule(hp.next);
            end;
            end;
-         if (not current_module.in_interface) and
-            assigned(current_module.localsymtable) then
+       end;
+
+       procedure write_used_unit_type_info(hp:tmodule);
+       var
+         pu : tused_unit;
+       begin
+         pu:=tused_unit(hp.used_units.first);
+         while assigned(pu) do
            begin
            begin
-              { all types }
-              tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
-              { and all local symbols}
-              tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
-           end
-         else if assigned(current_module.globalsymtable) then
+             if not pu.u.is_stab_written then
+               begin
+                 { prevent infinte loop for circular dependencies }
+                 pu.u.is_stab_written:=true;
+                 if assigned(pu.u.globalsymtable) then
+                   begin
+                     { first write the info for this unit, that will flag also all
+                       needed typesyms from used units }
+                     tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
+                     { write type info from used units }
+                     write_used_unit_type_info(pu.u);
+                   end;
+               end;
+             pu:=tused_unit(pu.next);
+           end;
+       end;
+
+       begin
+         if not (cs_debuginfo in aktmoduleswitches) then
+          exit;
+         { write type info for dependent units }
+         reset_unit_type_info;
+         { first write the types from this unit }
+         if assigned(current_module.globalsymtable) then
            begin
            begin
               { all types }
               { all types }
               tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
               tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
               { and all local symbols}
               { and all local symbols}
               tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
               tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
            end;
            end;
+         if assigned(current_module.localsymtable) then
+           begin
+              { all types }
+              tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
+              { and all local symbols}
+              tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
+           end;
+         { The debuginfo for this unit has flagged the required types, now we
+           write used types from the used units }
+         write_used_unit_type_info(current_module);
          if (cs_gdb_dbx in aktglobalswitches) then
          if (cs_gdb_dbx in aktglobalswitches) then
            begin
            begin
              debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
              debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
@@ -654,12 +669,45 @@ implementation
              dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
              dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
              do_count_dbx:=false;
              do_count_dbx:=false;
            end;
            end;
-
        end;
        end;
-{$Else GDB}
+{$EndIf GDB}
+
+
+     procedure reset_all_defs;
+
+       procedure reset_used_unit_defs(hp:tmodule);
+         var
+           hp2 : tmodule;
+           pu : tused_unit;
+         begin
+           pu:=tused_unit(hp.used_units.first);
+           while assigned(pu) do
+             begin
+               if not pu.u.is_reset then
+                 begin
+                   { prevent infinte loop for circular dependencies }
+                   pu.u.is_reset:=true;
+                   if assigned(pu.u.globalsymtable) then
+                     begin
+                       tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
+                       reset_used_unit_defs(pu.u);
+                     end;
+                 end;
+               pu:=tused_unit(pu.next);
+             end;
+         end;
+
+       var
+         hp2 : tmodule;
        begin
        begin
+         hp2:=tmodule(loaded_units.first);
+         while assigned(hp2) do
+           begin
+             hp2.is_reset:=false;
+             hp2:=tmodule(hp2.next);
+           end;
+         reset_used_unit_defs(current_module);
        end;
        end;
-{$EndIf GDB}
 
 
 
 
     procedure parse_implementation_uses;
     procedure parse_implementation_uses;
@@ -806,9 +854,6 @@ implementation
          main_file: tinputfile;
          main_file: tinputfile;
          st     : tsymtable;
          st     : tsymtable;
          unitst : tglobalsymtable;
          unitst : tglobalsymtable;
-{$ifdef GDB}
-         pu     : tused_unit;
-{$endif GDB}
          store_crc,store_interface_crc : cardinal;
          store_crc,store_interface_crc : cardinal;
          s1,s2  : ^string; {Saves stack space}
          s1,s2  : ^string; {Saves stack space}
          force_init_final : boolean;
          force_init_final : boolean;
@@ -943,10 +988,6 @@ implementation
             exit;
             exit;
           end;
           end;
 
 
-{$ifdef New_GDB}
-         write_gdb_info;
-{$endIf Def New_GDB}
-
          { Our interface is compiled, generate CRC and switch to implementation }
          { Our interface is compiled, generate CRC and switch to implementation }
          if not(cs_compilesystem in aktmoduleswitches) and
          if not(cs_compilesystem in aktmoduleswitches) and
             (Errorcount=0) then
             (Errorcount=0) then
@@ -1074,29 +1115,9 @@ implementation
            end;
            end;
 
 
 {$ifdef GDB}
 {$ifdef GDB}
-         { add all used definitions even for implementation}
-         if (cs_debuginfo in aktmoduleswitches) then
-          begin
-{$IfnDef New_GDB}
-            if assigned(current_module.globalsymtable) then
-              begin
-                 { all types }
-                 tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
-                 { and all local symbols}
-                 tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
-              end;
-            { all local types }
-            tglobalsymtable(st)^.concattypestabto(debuglist);
-            { and all local symbols}
-            st^.concatstabto(debuglist);
-{$else New_GDB}
-            write_gdb_info;
-{$endIf Def New_GDB}
-          end;
+         write_gdb_info;
 {$endif GDB}
 {$endif GDB}
 
 
-         reset_all_defs;
-
          if (Errorcount=0) then
          if (Errorcount=0) then
            begin
            begin
              { tests, if all (interface) forwards are resolved }
              { tests, if all (interface) forwards are resolved }
@@ -1107,10 +1128,6 @@ implementation
              tstoredsymtable(symtablestack).unchain_overloaded;
              tstoredsymtable(symtablestack).unchain_overloaded;
            end;
            end;
 
 
-{$ifdef GDB}
-         tglobalsymtable(symtablestack).is_stab_written:=false;
-{$endif GDB}
-
          { leave when we got an error }
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
          if (Errorcount>0) and not status.skip_error then
           begin
           begin
@@ -1132,15 +1149,6 @@ implementation
 
 
          if cs_local_browser in aktmoduleswitches then
          if cs_local_browser in aktmoduleswitches then
            current_module.localsymtable:=refsymtable;
            current_module.localsymtable:=refsymtable;
-{$ifdef GDB}
-         pu:=tused_unit(usedunits.first);
-         while assigned(pu) do
-           begin
-              if assigned(pu.u.globalsymtable) then
-                tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
-              pu:=tused_unit(pu.next);
-           end;
-{$endif GDB}
 
 
          if is_assembler_generated then
          if is_assembler_generated then
           begin
           begin
@@ -1355,9 +1363,10 @@ implementation
          { consume the last point }
          { consume the last point }
          consume(_POINT);
          consume(_POINT);
 
 
-{$ifdef New_GDB}
+{$ifdef GDB}
          write_gdb_info;
          write_gdb_info;
-{$endIf Def New_GDB}
+{$endif GDB}
+
          { leave when we got an error }
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
          if (Errorcount>0) and not status.skip_error then
           begin
           begin
@@ -1439,7 +1448,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.142  2004-03-02 17:32:12  florian
+  Revision 1.143  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.142  2004/03/02 17:32:12  florian
     * make cycle fixed
     * make cycle fixed
     + pic support for darwin
     + pic support for darwin
     + support of importing vars from shared libs on darwin implemented
     + support of importing vars from shared libs on darwin implemented

+ 7 - 4
compiler/psystem.pas

@@ -121,9 +121,6 @@ implementation
         end;
         end;
 
 
       var
       var
-        { several defs to simulate more or less C++ objects for GDB }
-        vmttype,
-        vmtarraytype : ttype;
         hrecst : trecordsymtable;
         hrecst : trecordsymtable;
       begin
       begin
 {$ifdef cpufpemu}
 {$ifdef cpufpemu}
@@ -254,6 +251,8 @@ implementation
         globaldef('void_farpointer',voidfarpointertype);
         globaldef('void_farpointer',voidfarpointertype);
         globaldef('file',cfiletype);
         globaldef('file',cfiletype);
         globaldef('pvmt',pvmttype);
         globaldef('pvmt',pvmttype);
+        globaldef('vtblarray',vmtarraytype);
+        globaldef('__vtbl_ptr_type',vmttype);
         globaldef('variant',cvarianttype);
         globaldef('variant',cvarianttype);
         globaldef('olevariant',colevarianttype);
         globaldef('olevariant',colevarianttype);
         globaldef('methodpointer',methodpointertype);
         globaldef('methodpointer',methodpointertype);
@@ -489,7 +488,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.65  2004-03-02 01:13:01  olle
+  Revision 1.66  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.65  2004/03/02 01:13:01  olle
     * undone last commit
     * undone last commit
 
 
   Revision 1.63  2004/02/26 16:16:38  peter
   Revision 1.63  2004/02/26 16:16:38  peter

+ 10 - 4
compiler/symconst.pas

@@ -345,9 +345,11 @@ type
 {$ifdef GDB}
 {$ifdef GDB}
 type
 type
   tdefstabstatus = (
   tdefstabstatus = (
-    not_written,
-    being_written,
-    written);
+    stab_state_unused,
+    stab_state_used,
+    stab_state_writing,
+    stab_state_written
+  );
 
 
 const
 const
   tagtypes : Set of tdeftype =
   tagtypes : Set of tdeftype =
@@ -402,7 +404,11 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.76  2004-02-27 10:21:05  florian
+  Revision 1.77  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.76  2004/02/27 10:21:05  florian
     * top_symbol killed
     * top_symbol killed
     + refaddr to treference added
     + refaddr to treference added
     + refsymbol to treference added
     + refsymbol to treference added

La diferencia del archivo ha sido suprimido porque es demasiado grande
+ 384 - 391
compiler/symdef.pas


+ 5 - 10
compiler/symsym.pas

@@ -132,9 +132,6 @@ interface
 
 
        ttypesym = class(Tsym)
        ttypesym = class(Tsym)
           restype    : ttype;
           restype    : ttype;
-{$ifdef GDB}
-          isusedinstab : boolean;
-{$endif GDB}
           constructor create(const n : string;const tt : ttype);
           constructor create(const n : string;const tt : ttype);
           constructor ppuload(ppufile:tcompilerppufile);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -2064,9 +2061,6 @@ implementation
          inherited create(n);
          inherited create(n);
          typ:=typesym;
          typ:=typesym;
          restype:=tt;
          restype:=tt;
-{$ifdef GDB}
-         isusedinstab := false;
-{$endif GDB}
         { register the typesym for the definition }
         { register the typesym for the definition }
         if assigned(restype.def) and
         if assigned(restype.def) and
            (restype.def.deftype<>errordef) and
            (restype.def.deftype<>errordef) and
@@ -2079,9 +2073,6 @@ implementation
       begin
       begin
          inherited loadsym(ppufile);
          inherited loadsym(ppufile);
          typ:=typesym;
          typ:=typesym;
-{$ifdef GDB}
-         isusedinstab := false;
-{$endif GDB}
          ppufile.gettype(restype);
          ppufile.gettype(restype);
       end;
       end;
 
 
@@ -2250,7 +2241,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.164  2004-03-02 18:12:31  florian
+  Revision 1.165  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.164  2004/03/02 18:12:31  florian
     * for vars with is_dll_var the mangledname is written to the ppu as well
     * for vars with is_dll_var the mangledname is written to the ppu as well
 
 
   Revision 1.163  2004/03/02 17:32:12  florian
   Revision 1.163  2004/03/02 17:32:12  florian

+ 64 - 118
compiler/symtable.pas

@@ -53,12 +53,6 @@ interface
           procedure varsymbolused(p : TNamedIndexItem;arg:pointer);
           procedure varsymbolused(p : TNamedIndexItem;arg:pointer);
           procedure TestPrivate(p : TNamedIndexItem;arg:pointer);
           procedure TestPrivate(p : TNamedIndexItem;arg:pointer);
           procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
           procedure objectprivatesymbolused(p : TNamedIndexItem;arg:pointer);
-{$ifdef GDB}
-       private
-          procedure concatstab(p : TNamedIndexItem;arg:pointer);
-          procedure resetstab(p : TNamedIndexItem;arg:pointer);
-          procedure concattypestab(p : TNamedIndexItem;arg:pointer);
-{$endif}
           procedure unchain_overloads(p : TNamedIndexItem;arg:pointer);
           procedure unchain_overloads(p : TNamedIndexItem;arg:pointer);
           procedure loaddefs(ppufile:tcompilerppufile);
           procedure loaddefs(ppufile:tcompilerppufile);
           procedure loadsyms(ppufile:tcompilerppufile);
           procedure loadsyms(ppufile:tcompilerppufile);
@@ -85,6 +79,7 @@ interface
           function  needs_init_final : boolean;
           function  needs_init_final : boolean;
           procedure unchain_overloaded;
           procedure unchain_overloaded;
 {$ifdef GDB}
 {$ifdef GDB}
+          procedure numberstring;
           procedure concatstabto(asmlist : taasmoutput);virtual;
           procedure concatstabto(asmlist : taasmoutput);virtual;
           function  getnewtypecount : word; override;
           function  getnewtypecount : word; override;
 {$endif GDB}
 {$endif GDB}
@@ -141,7 +136,6 @@ interface
           dbx_count : longint;
           dbx_count : longint;
           prev_dbx_counter : plongint;
           prev_dbx_counter : plongint;
           dbx_count_ok : boolean;
           dbx_count_ok : boolean;
-          is_stab_written : boolean;
 {$endif GDB}
 {$endif GDB}
           constructor create(const n : string);
           constructor create(const n : string);
 {$ifdef GDB}
 {$ifdef GDB}
@@ -216,8 +210,6 @@ interface
     procedure search_class_overloads(aprocsym : tprocsym);
     procedure search_class_overloads(aprocsym : tprocsym);
     function search_default_property(pd : tobjectdef) : tpropertysym;
     function search_default_property(pd : tobjectdef) : tpropertysym;
 
 
-    procedure reset_all_defs;
-
 {*** symtable stack ***}
 {*** symtable stack ***}
 {$ifdef DEBUG}
 {$ifdef DEBUG}
     procedure test_symtablestack;
     procedure test_symtablestack;
@@ -594,14 +586,6 @@ implementation
             if not(assigned(ttypesym(sym).restype.def.owner)) and
             if not(assigned(ttypesym(sym).restype.def.owner)) and
                (ttypesym(sym).restype.def.deftype<>errordef) then
                (ttypesym(sym).restype.def.deftype<>errordef) then
               registerdef(ttypesym(sym).restype.def);
               registerdef(ttypesym(sym).restype.def);
-{$ifdef GDB}
-            if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
-               (symtabletype in [globalsymtable,staticsymtable]) then
-              begin
-                ttypesym(sym).isusedinstab := true;
-                {sym.concatstabto(debuglist);}
-              end;
-{$endif GDB}
           end;
           end;
 
 
          { insert in index and search hash }
          { insert in index and search hash }
@@ -632,21 +616,6 @@ implementation
               assigned(current_module.map[unitid].unitsym) then
               assigned(current_module.map[unitid].unitsym) then
              inc(current_module.map[unitid].unitsym.refs);
              inc(current_module.map[unitid].unitsym.refs);
 
 
-{$ifdef GDB}
-           { if it is a type, we need the stabs of this type
-             this might be the cause of the class debug problems
-             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
-             begin
-               if assigned(ttypesym(hp).restype.def) then
-                 tstoreddef(ttypesym(hp).restype.def).numberstring
-               else
-                 ttypesym(hp).isusedinstab:=true;
-             end;
-{$endif GDB}
-
            { unitsym are only loaded for browsing PM    }
            { unitsym are only loaded for browsing PM    }
            { this was buggy anyway because we could use }
            { this was buggy anyway because we could use }
            { unitsyms from other units in _USES !!      }
            { unitsyms from other units in _USES !!      }
@@ -776,11 +745,6 @@ implementation
                  not(is_funcret_sym(tsym(p))) and
                  not(is_funcret_sym(tsym(p))) and
                  (
                  (
                   (tsym(p).typ<>procsym) or
                   (tsym(p).typ<>procsym) or
-{$ifdef GDB}
-                  not (tprocsym(p).is_global) or
-{$endif GDB}
-                  { all program functions are declared global
-                    but unused should still be signaled PM }
                   ((tsym(p).owner.symtabletype=staticsymtable) and
                   ((tsym(p).owner.symtabletype=staticsymtable) and
                    not current_module.is_unit)
                    not current_module.is_unit)
                  ) then
                  ) then
@@ -823,57 +787,6 @@ implementation
 
 
 
 
 {$ifdef GDB}
 {$ifdef GDB}
-
-    procedure TStoredSymtable.concatstab(p : TNamedIndexItem;arg:pointer);
-
-    var stabstr:Pchar;
-        ao:Taasmoutput;
-
-    begin
-      if Tsym(p).typ<>procsym then
-        begin
-          ao:=Taasmoutput(arg);
-          if not Tsym(p).isstabwritten then
-            begin
-              stabstr:=Tsym(p).stabstring;
-              if stabstr<>nil then
-                ao.concat(Tai_stabs.create(stabstr));
-              Tsym(p).isstabwritten:=true;
-            end;
-        end;
-    end;
-
-
-    procedure TStoredSymtable.resetstab(p : TNamedIndexItem;arg:pointer);
-      begin
-        if tsym(p).typ <> procsym then
-          Tstoredsym(p).isstabwritten:=false;
-      end;
-
-
-    procedure TStoredSymtable.concattypestab(p : TNamedIndexItem;arg:pointer);
-
-    var stabstr:Pchar;
-        ao:Taasmoutput;
-
-    begin
-      if Tsym(p).typ=typesym then
-        begin
-          ao:=Taasmoutput(arg);
-          if Ttypesym(p).restype.def.typesym=p then
-            Tstoreddef(Ttypesym(p).restype.def).concatstabto(ao)
-          else
-            begin
-              Tsym(p).isstabwritten:=false;
-              stabstr:=Tsym(p).stabstring;
-              if stabstr<>nil then
-                ao.concat(Tai_stabs.create(stabstr));
-              Tsym(p).isstabwritten:=true;
-            end;
-        end;
-    end;
-
-
    function tstoredsymtable.getnewtypecount : word;
    function tstoredsymtable.getnewtypecount : word;
       begin
       begin
          getnewtypecount:=pglobaltypecount^;
          getnewtypecount:=pglobaltypecount^;
@@ -924,9 +837,45 @@ implementation
 
 
 
 
 {$ifdef GDB}
 {$ifdef GDB}
+    procedure tstoredsymtable.numberstring;
+      var
+        p : tsym;
+      begin
+        p:=tsym(symindex.first);
+        while assigned(p) do
+          begin
+            case tsym(p).typ of
+              varsym :
+                tstoreddef(tvarsym(p).vartype.def).numberstring;
+              procsym :
+                tprocsym(p).first_procdef.numberstring;
+            end;
+            p:=tsym(p.indexnext);
+          end;
+      end;
+
+
     procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
     procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
+      var
+        stabstr : Pchar;
+        p : tsym;
       begin
       begin
-        foreach({$ifdef FPCPROCVAR}@{$endif}concatstab,asmlist);
+        p:=tsym(symindex.first);
+        while assigned(p) do
+          begin
+            { Procsym and typesym are already written }
+            if not(Tsym(p).typ in [procsym,typesym]) then
+              begin
+                if not Tsym(p).isstabwritten then
+                  begin
+                    stabstr:=Tsym(p).stabstring;
+                    if stabstr<>nil then
+                      asmlist.concat(Tai_stabs.create(stabstr));
+                    Tsym(p).isstabwritten:=true;
+                  end;
+              end;
+            p:=tsym(p.indexnext);
+          end;
       end;
       end;
 {$endif}
 {$endif}
 
 
@@ -1373,7 +1322,6 @@ implementation
          { reset GDB things }
          { reset GDB things }
          prev_dbx_counter := dbx_counter;
          prev_dbx_counter := dbx_counter;
          dbx_counter := nil;
          dbx_counter := nil;
-         is_stab_written:=false;
          dbx_count := -1;
          dbx_count := -1;
 {$endif GDB}
 {$endif GDB}
       end;
       end;
@@ -1381,18 +1329,12 @@ implementation
 
 
 {$ifdef GDB}
 {$ifdef GDB}
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
       procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
-        var prev_dbx_count : plongint;
+        var
+          prev_dbx_count : plongint;
+          p : tstoreddef;
         begin
         begin
-           if is_stab_written then
-             exit;
            if not assigned(name) then
            if not assigned(name) then
              name := stringdup('Main_program');
              name := stringdup('Main_program');
-           {if (symtabletype = globalsymtable) and
-              (current_module.globalsymtable<>self) then
-             begin
-                unitid:=current_module.unitcount;
-                inc(current_module.unitcount);
-             end;}
            asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
            asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(unitid))));
            if cs_gdb_dbx in aktglobalswitches then
            if cs_gdb_dbx in aktglobalswitches then
              begin
              begin
@@ -1416,22 +1358,34 @@ implementation
                     do_count_dbx:=assigned(dbx_counter);
                     do_count_dbx:=assigned(dbx_counter);
                   end;
                   end;
              end;
              end;
-           foreach({$ifdef FPCPROCVAR}@{$endif}concattypestab,asmlist);
+
+{$ifdef EXTDEBUG}
+           writing_def_stabs:=true;
+{$endif EXTDEBUG}
+           p:=tstoreddef(defindex.first);
+           while assigned(p) do
+             begin
+               if (p.stab_state=stab_state_used) then
+                 p.concatstabto(asmlist);
+               p:=tstoreddef(p.indexnext);
+             end;
+{$ifdef EXTDEBUG}
+           writing_def_stabs:=false;
+{$endif EXTDEBUG}
+
            if cs_gdb_dbx in aktglobalswitches then
            if cs_gdb_dbx in aktglobalswitches then
              begin
              begin
                 if (current_module.globalsymtable<>self) then
                 if (current_module.globalsymtable<>self) then
                   begin
                   begin
                     dbx_counter := prev_dbx_count;
                     dbx_counter := prev_dbx_count;
                     do_count_dbx:=false;
                     do_count_dbx:=false;
-                    asmList.concat(tai_comment.Create(strpnew('End unit '+name^
-                      +' has index '+tostr(unitid))));
                     asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
                     asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'
                       +tostr(N_EINCL)+',0,0,0')));
                       +tostr(N_EINCL)+',0,0,0')));
                     do_count_dbx:=assigned(dbx_counter);
                     do_count_dbx:=assigned(dbx_counter);
                     dbx_count_ok := {true}false;
                     dbx_count_ok := {true}false;
                   end;
                   end;
              end;
              end;
-           is_stab_written:=true;
+           asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(unitid))));
         end;
         end;
 {$endif GDB}
 {$endif GDB}
 
 
@@ -1535,8 +1489,8 @@ implementation
              unittypecount:=1;
              unittypecount:=1;
              pglobaltypecount := @unittypecount;
              pglobaltypecount := @unittypecount;
              {unitid:=current_module.unitcount;}
              {unitid:=current_module.unitcount;}
-             debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
-             debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));
+             {debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid))));
+             debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));}
              {inc(current_module.unitcount);}
              {inc(current_module.unitcount);}
              { we can't use dbx_vcount, because we don't know
              { we can't use dbx_vcount, because we don't know
                if the object file will be loaded before or afeter PM }
                if the object file will be loaded before or afeter PM }
@@ -2129,18 +2083,6 @@ implementation
         search_class_member:=nil;
         search_class_member:=nil;
       end;
       end;
 
 
-    procedure reset_all_defs;
-
-    var st:Tsymtable;
-
-    begin
-      st:=symtablestack;
-      while st<>nil do
-        begin
-          Tstoredsymtable(st).reset_all_defs;
-          st:=st.next;
-        end;
-    end;
 
 
 {*****************************************************************************
 {*****************************************************************************
                             Definition Helpers
                             Definition Helpers
@@ -2375,7 +2317,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.141  2004-02-26 16:16:19  peter
+  Revision 1.142  2004-03-08 22:07:47  peter
+    * stabs updates to write stabs for def for all implictly used
+      units
+
+  Revision 1.141  2004/02/26 16:16:19  peter
     * check if withsymtable.defowner is in the current unit
     * check if withsymtable.defowner is in the current unit
 
 
   Revision 1.140  2004/02/24 16:12:39  peter
   Revision 1.140  2004/02/24 16:12:39  peter

Algunos archivos no se mostraron porque demasiados archivos cambiaron en este cambio