Просмотр исходного кода

* patch by Jeppe Johansen to be able to generate debug info if an rtl without variant support is used, resolves #18483

git-svn-id: trunk@17300 -
florian 14 лет назад
Родитель
Сommit
4d19f6c532
3 измененных файлов с 39 добавлено и 3 удалено
  1. 8 2
      compiler/dbgdwarf.pas
  2. 14 1
      compiler/dbgstabs.pas
  3. 17 0
      compiler/symtable.pas

+ 8 - 2
compiler/dbgdwarf.pas

@@ -1000,6 +1000,8 @@ implementation
         loclist := tdynamicarray.Create(4096);
 
         AbbrevSearchTree:=AllocateNewAiSearchItem;
+
+        vardatadef := nil;
       end;
 
 
@@ -2992,6 +2994,7 @@ implementation
         i : longint;
         def: tdef;
         dbgname: string;
+        vardatatype: ttypesym;
       begin
         current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
         storefilepos:=current_filepos;
@@ -3006,7 +3009,9 @@ implementation
             FILEREC
             TEXTREC
         }
-        vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
+        vardatatype:=try_search_system_type('TVARDATA');
+        if assigned(vardatatype) then
+          vardatadef:=trecorddef(vardatatype.typedef);
 
         { write start labels }
         new_section(current_asmdata.asmlists[al_dwarf_info],sec_debug_info,'',0);
@@ -3604,7 +3609,8 @@ implementation
     procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef);
       begin
         { variants aren't known to dwarf2 but writting tvardata should be enough }
-        appenddef_record_named(list,trecorddef(vardatadef),'Variant');
+        if assigned(vardatadef) then
+          appenddef_record_named(list,trecorddef(vardatadef),'Variant');
       end;
 
     function TDebugInfoDwarf2.dwarf_version: Word;

+ 14 - 1
compiler/dbgstabs.pas

@@ -104,6 +104,8 @@ interface
         procedure insertmoduleinfo;override;
         procedure insertlineinfo(list:TAsmList);override;
         procedure referencesections(list:TAsmList);override;
+
+        constructor Create;override;
       end;
 
 
@@ -800,6 +802,9 @@ implementation
       var
         ss : ansistring;
       begin
+        if not assigned(vardatadef) then
+          exit;
+
         ss:='s'+tostr(vardatadef.size);
         vardatadef.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
         ss[length(ss)]:=';';
@@ -1502,6 +1507,7 @@ implementation
         stabstypelist : TAsmList;
         storefilepos  : tfileposinfo;
         i  : longint;
+        vardatatype : ttypesym;
       begin
         storefilepos:=current_filepos;
         current_filepos:=current_module.mainfilepos;
@@ -1512,7 +1518,9 @@ implementation
         stabsvarlist:=TAsmList.create;
         stabstypelist:=TAsmList.create;
 
-        vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
+        vardatatype:=try_search_system_type('TVARDATA');
+        if assigned(vardatatype) then
+          vardatadef:=trecorddef(vardatatype.typedef);
 
         { include symbol that will be referenced from the main to be sure to
           include this debuginfo .o file }
@@ -1709,6 +1717,11 @@ implementation
           end;
       end;
 
+    constructor TDebugInfoStabs.Create;
+      begin
+        inherited Create;
+        vardatadef:=nil;
+      end;
 
     const
       dbg_stabs_info : tdbginfo =

+ 17 - 0
compiler/symtable.pas

@@ -225,6 +225,7 @@ interface
     function  searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  search_system_type(const s: TIDString): ttypesym;
+    function  try_search_system_type(const s: TIDString): ttypesym;
     function  search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
     function  search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
@@ -2400,6 +2401,22 @@ implementation
       end;
 
 
+    function try_search_system_type(const s: TIDString): ttypesym;
+      var
+        sym : tsym;
+      begin
+        sym:=tsym(systemunit.Find(s));
+        if not assigned(sym) then
+          result:=nil
+        else
+          begin
+            if sym.typ<>typesym then
+              cgmessage1(cg_f_unknown_system_type,s);
+            result:=ttypesym(sym);
+          end;
+      end;
+
+
     function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
       var
         srsymtable: tsymtable;