Merged revisions 10532,10541,10585,10600,10602-10603 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10532 | jonas | 2008-03-22 12:49:05 +0100 (Sat, 22 Mar 2008) | 3 lines

  + support for subrange types in dwarf (allows proper printing of packed
    sets of subrange types)

........
r10541 | peter | 2008-03-23 14:40:41 +0100 (Sun, 23 Mar 2008) | 3 lines

  * fix writing procedure local type defs
  * write type names once for types defined in the current compiled unit

........
r10585 | jonas | 2008-03-29 17:37:41 +0100 (Sat, 29 Mar 2008) | 2 lines

  - removed unused writing_def_dwarf field

........
r10600 | jonas | 2008-04-03 21:31:09 +0200 (Thu, 03 Apr 2008) | 3 lines

  * only write set elementdef information if there is an elementdef
    (can be absent for empty sets)

........
r10602 | jonas | 2008-04-05 14:29:07 +0200 (Sat, 05 Apr 2008) | 2 lines

  * fixed stabs debug info for webtbs/tw9766 again

........
r10603 | jonas | 2008-04-05 19:05:34 +0200 (Sat, 05 Apr 2008) | 2 lines

  * fixed "set of enumeration" for gdb 6.7/6.8

........

git-svn-id: branches/fixes_2_2@10617 -

.gitattributes

@@ -8785,6 +8785,7 @@ tests/webtbs/tw9667.pp svneol=native#text/plain
 tests/webtbs/tw9672.pp svneol=native#text/plain
 tests/webtbs/tw9695.pp svneol=native#text/plain
 tests/webtbs/tw9704.pp svneol=native#text/plain
+tests/webtbs/tw9766.pp svneol=native#text/plain
 tests/webtbs/tw9827.pp svneol=native#text/plain
 tests/webtbs/tw9897.pp svneol=native#text/plain
 tests/webtbs/tw9918.pp svneol=native#text/plain

compiler/dbgbase.pas

@@ -226,6 +226,9 @@ implementation
         { to avoid infinite loops }
         def.dbg_state := dbg_state_writing;
         beforeappenddef(list,def);
+        { queued defs have to be written later }
+        if (def.dbg_state=dbg_state_queued) then
+          exit;
         case def.typ of
           stringdef :
             appenddef_string(list,tstringdef(def));
@@ -257,6 +260,12 @@ implementation
             appenddef_object(list,tobjectdef(def));
           undefineddef :
             appenddef_undefined(list,tundefineddef(def));
+          procdef :
+            begin
+              { procdefs are already written in a separate step. procdef
+                support in appenddef is only needed for beforeappenddef to
+                write all local type defs }
+            end;
         else
           internalerror(200601281);
         end;
@@ -388,7 +397,7 @@ implementation
         for i:=0 to st.DefList.Count-1 do
           begin
             def:=tdef(st.DefList[i]);
-            if (def.dbg_state=dbg_state_used) then
+            if (def.dbg_state in [dbg_state_used,dbg_state_queued]) then
               appenddef(list,def);
           end;
         case st.symtabletype of

compiler/dbgdwarf.pas

@@ -206,8 +206,6 @@ interface
         defnumberlist,
         deftowritelist   : TFPObjectList;
 
-        writing_def_dwarf : boolean;
-
         { use this defs to create info for variants and file handles }
         { unused (MWE)
         filerecdef,
@@ -1029,7 +1027,10 @@ implementation
 
     procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef);
       var
-        sign: tdwarf_type;
+        basedef      : tdef;
+        sign         : tdwarf_type;
+        signform     : tdwarf_form;
+        fullbytesize : byte;
       begin
         case def.ordtype of
           s8bit,
@@ -1044,21 +1045,67 @@ implementation
               { because otherwise they are interpreted wrongly when used }
               { in a bitpacked record                                    }
               if (def.low<0) then
-                sign:=DW_ATE_signed
+                begin
+                  sign:=DW_ATE_signed;
+                  signform:=DW_FORM_sdata
+                end
               else
-                sign:=DW_ATE_unsigned;
-              { we should generate a subrange type here }
-              if assigned(def.typesym) then
-                append_entry(DW_TAG_base_type,false,[
-                  DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
-                  DW_AT_encoding,DW_FORM_data1,sign,
-                  DW_AT_byte_size,DW_FORM_data1,def.size
-                  ])
+                begin
+                  sign:=DW_ATE_unsigned;
+                  signform:=DW_FORM_udata
+                end;
+              fullbytesize:=def.size;
+              case fullbytesize of
+                1:
+                  if (sign=DW_ATE_signed) then
+                    basedef:=s8inttype
+                  else
+                    basedef:=u8inttype;
+                2:
+                  if (sign=DW_ATE_signed) then
+                    basedef:=s16inttype
+                  else
+                    basedef:=u16inttype;
+                4:
+                  if (sign=DW_ATE_signed) then
+                    basedef:=s32inttype
+                  else
+                    basedef:=u32inttype;
+                else
+                  internalerror(2008032201);
+              end;
+
+              if (def.low=torddef(basedef).low) and
+                 (def.high=torddef(basedef).high) then
+                { base type such as byte/shortint/word/... }
+                if assigned(def.typesym) then
+                  append_entry(DW_TAG_base_type,false,[
+                    DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                    DW_AT_encoding,DW_FORM_data1,sign,
+                    DW_AT_byte_size,DW_FORM_data1,fullbytesize])
+                else
+                  append_entry(DW_TAG_base_type,false,[
+                    DW_AT_encoding,DW_FORM_data1,sign,
+                    DW_AT_byte_size,DW_FORM_data1,fullbytesize])
               else
-                append_entry(DW_TAG_base_type,false,[
-                  DW_AT_encoding,DW_FORM_data1,sign,
-                  DW_AT_byte_size,DW_FORM_data1,def.size
-                  ]);
+                begin
+                  { subrange type }
+                  { note: don't do this 64 bit int types, they appear    }
+                  {       to be always clipped to s32bit for some reason }
+                  if assigned(def.typesym) then
+                    append_entry(DW_TAG_subrange_type,false,[
+                      DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                      DW_AT_lower_bound,signform,int64(def.low),
+                      DW_AT_upper_bound,signform,int64(def.high)
+                      ])
+                  else
+                    append_entry(DW_TAG_subrange_type,false,[
+                      DW_AT_lower_bound,signform,int64(def.low),
+                      DW_AT_upper_bound,signform,int64(def.high)
+                      ]);
+                  append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef));
+                end;
+                
               finish_entry;
             end;
           uvoid :
@@ -2271,7 +2318,6 @@ implementation
         current_filepos:=current_module.mainfilepos;
 
         currabbrevnumber:=0;
-        writing_def_dwarf:=false;
 
         defnumberlist:=TFPObjectList.create(false);
         deftowritelist:=TFPObjectList.create(false);
@@ -2701,6 +2747,8 @@ implementation
       end;
 
     procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
+      var
+        lab: tasmlabel;
       begin
         if (ds_dwarf_sets in current_settings.debugswitches) then
           begin
@@ -2715,7 +2763,22 @@ implementation
               append_entry(DW_TAG_set_type,false,[
                 DW_AT_byte_size,DW_FORM_data2,def.size
                 ]);
-            append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef));
+            if assigned(def.elementdef) then
+              begin
+                if (def.elementdef.typ=enumdef) then
+                  begin
+                    { gdb 6.7 - 6.8 is broken for regular enum sets }
+                    current_asmdata.getaddrlabel(lab);
+                    append_labelentry_ref(DW_AT_type,lab);
+                    finish_entry;
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
+                    append_entry(DW_TAG_subrange_type,false,[
+                      DW_AT_lower_bound,DW_FORM_sdata,tenumdef(def.elementdef).minval,
+                      DW_AT_upper_bound,DW_FORM_sdata,tenumdef(def.elementdef).maxval
+                      ]);
+                  end;
+                append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef))
+              end
           end
         else
           begin

compiler/dbgstabs.pas

@@ -466,31 +466,11 @@ implementation
           appenddef(TAsmList(arg),tfieldvarsym(p).vardef);
       end;
 
-{
-    procedure TDebugInfoStabs.method_write_defs(p:TObject;arg:pointer);
-      var
-        i  : longint;
-        pd : tprocdef;
-      begin
-        if tsym(p).typ<>procsym then
-          exit;
-        for i:=0 to tprocsym(p).ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(tprocsym(p).ProcdefList[i]);
-            insertdef(TAsmList(arg),pd.returndef);
-            if (po_virtualmethod in pd.procoptions) then
-              insertdef(TAsmList(arg),pd._class);
-            if assigned(pd.parast) then
-              write_symtable_defs(TAsmList(arg),pd.parast);
-            if assigned(pd.localst) then
-              write_symtable_defs(TAsmList(arg),pd.localst);
-          end;
-      end;
-}
 
     procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
       var
         stabchar : string[2];
+        symname  : string[20];
         st    : ansistring;
         p     : pchar;
       begin
@@ -499,12 +479,22 @@ implementation
           stabchar := 'Tt'
         else
           stabchar := 't';
+        { Type names for types defined in the current unit are already written in
+          the typesym }
+        if (def.owner.symtabletype=globalsymtable) and
+           not(def.owner.iscurrentunit) then
+          symname:='${sym_name}'
+        else
+          symname:='';
         { Here we maybe generate a type, so we have to use numberstring }
         if is_class(def) and
            tobjectdef(def).writing_class_record_dbginfo then
-          st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
+          { in case of writing the class record structure, we always have to
+            use the class name (so it refers both to the struct and the
+            pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) }
+          st:=def_stabstr_evaluate(def,'"{$sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
         else
-          st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_number(def)]);
+          st:=def_stabstr_evaluate(def,'"'+symname+':$1$2=',[stabchar,def_stab_number(def)]);
         st:=st+ss;
         { line info is set to 0 for all defs, because the def can be in an other
           unit and then the linenumber is invalid in the current sourcefile }
@@ -954,6 +944,9 @@ implementation
         if not assigned(def.procstarttai) then
           exit;
 
+        { mark as used so the local type defs also be written }
+        def.dbg_state:=dbg_state_used;
+
         templist:=TAsmList.create;
 
         { end of procedure }

tests/webtbs/tw9766.pp

@@ -0,0 +1,44 @@
+{ %interactive }
+
+{ instructions: set a breakpoint on PASCALMAIN, then step into }
+{ TChild.Create(nil). This shouldn't crash gdb                 }
+
+{$mode delphi}
+
+type
+  // swap the order of these declarations (TParent & TChild) and the problem is fixed.
+  TParent = class;
+  TChild = class;
+
+  TParent = class
+  private
+    FChild : TChild; // remove me and the problem is fixed.
+  public
+    constructor Create ( AOwner : pointer ); virtual;
+  end;
+
+  TChild = class(TParent)
+  private
+    FField : Integer; // remove me and the problem is fixed.
+  public
+    constructor Create ( AOwner : pointer ); override;
+  end;
+
+{ TParent }
+
+constructor TParent.Create(AOwner: pointer);
+begin
+  Inherited Create;
+end;
+
+{ TChild }
+
+constructor TChild.Create(AOwner: pointer);
+begin
+  Inherited;
+end;
+
+
+begin
+  TChild.Create(nil); // break-point here and try to step into constructor (gdb/stabs)
+end.