+ first implementation of dwarf line info generation using .file and .loc, little use with binary writers though ...

git-svn-id: trunk@2327 -

compiler/aasmtai.pas

@@ -51,7 +51,8 @@ interface
           ait_instruction,
           ait_datablock,
           ait_symbol,
-          ait_symbol_end, { needed to calc the size of a symbol }
+          { needed to calc the size of a symbol }
+          ait_symbol_end,
           ait_directive,
           ait_label,
           ait_const,
@@ -83,8 +84,8 @@ interface
           ait_marker,
           { new source file (dwarf) }
           ait_file,
-          { new line in source file (dwarf) }
-          ait_line
+          { new line/loc in source file (dwarf) }
+          ait_loc
           );
 
         taiconst_type = (
@@ -207,7 +208,8 @@ interface
         a new ait type!                                                              }
       SkipInstr = [ait_comment, ait_symbol,ait_section
                    ,ait_stab, ait_function_name, ait_force_line
-                   ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive];
+                   ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive
+                   ,ait_file,ait_loc];
 
       { ait_* types which do not have line information (and hence which are of type
         tai, otherwise, they are of type tailineinfo }
@@ -216,7 +218,8 @@ interface
                      ait_stab,ait_function_name,
                      ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
                      ait_const,
-                     ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit
+                     ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
+                     ait_file,ait_loc
                     ];
 
 
@@ -514,104 +517,125 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
 
-      Taasmoutput=class;
-
-      tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object;
-      Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
-      Trgungetproc=procedure(list:Taasmoutput;position:Tai;r:Tregister) of object;
-
-       { Class template for assembler instructions
-       }
-       tai_cpu_abstract = class(tailineinfo)
-       protected
-          procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
-          procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
-          procedure ppubuildderefimploper(var o:toper);virtual;abstract;
-          procedure ppuderefoper(var o:toper);virtual;abstract;
-       public
-          { Condition flags for instruction }
-          condition : TAsmCond;
-          { Number of operands to instruction }
-          ops       : byte;
-          { Number of allocate oper structures }
-          opercnt   : byte;
-          { Operands of instruction }
-          oper      : array[0..max_operands-1] of poper;
-          { Actual opcode of instruction }
-          opcode    : tasmop;
-{$ifdef x86}
-          segprefix : tregister;
-{$endif x86}
-          { true if instruction is a jmp }
-          is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-          Constructor Create(op : tasmop);virtual;
-          Destructor Destroy;override;
-          function getcopy:TLinkedListItem;override;
+       { Generates a dwarf file location }
+       tai_file = class(tai)
+          str : pchar;
+          idx : longint;
+          constructor Create(_str : string;_idx : longint);
+          destructor Destroy; override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure buildderefimpl;override;
-          procedure derefimpl;override;
-          procedure SetCondition(const c:TAsmCond);
-          procedure allocate_oper(opers:longint);
-          procedure loadconst(opidx:longint;l:aint);
-          procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-          procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean);
-          procedure loadref(opidx:longint;const r:treference);
-          procedure loadreg(opidx:longint;r:tregister);
-          procedure loadoper(opidx:longint;o:toper);
-          procedure clearop(opidx:longint);
-          { register allocator }
-          function is_same_reg_move(regtype: Tregistertype):boolean;virtual;
-          function spilling_get_operation_type(opnr: longint): topertype;virtual;
-          function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual;
-
-          function  Pass1(offset:longint):longint;virtual;abstract;
-          procedure Pass2(objdata:TAsmObjectdata);virtual;abstract;
+          function getcopy:tlinkedlistitem;override;
        end;
-       tai_cpu_class = class of tai_cpu_abstract;
-
-       { alignment for operator }
-       tai_align_abstract = class(tai)
-          aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
-          fillsize  : byte;   { real size to fill }
-          fillop    : byte;   { value to fill with - optional }
-          use_op    : boolean;
-          constructor Create(b:byte);virtual;
-          constructor Create_op(b: byte; _op: byte);virtual;
-          constructor Create_zeros(b:byte);
+
+       { Generates a dwarf line location }
+       tai_loc = class(tai)
+          fileidx,
+          line,
+          column : longint;
+          constructor Create(_fileidx,_line,_column : longint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
        end;
-       tai_align_class = class of tai_align_abstract;
 
-       taasmoutput = class(tlinkedlist)
-          constructor create;
-          function  empty : boolean;
-          function  getlasttaifilepos : pfileposinfo;
-          procedure InsertAfter(Item,Loc : TLinkedListItem);override;
-       end;
+       Taasmoutput=class;
 
-       { Type of asmlists. The order is important for the layout of the
-         information in the .o file. The stabs for the types must be defined
-         before they can be referenced and therefor they need to be written
-         first (PFV) }
-       Tasmlist=(al_stabsstart,
-                 al_stabs,
-                 al_procedures,
-                 al_globals,
-                 al_const,
-                 al_typedconsts,
-                 al_rotypedconsts,
-                 al_threadvars,
-                 al_imports,
-                 al_exports,
-                 al_resources,
-                 al_rtti,
-                 al_dwarf,
-                 al_picdata,
-                 al_resourcestrings,
-                 al_stabsend);
+       tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object;
+       Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
+       Trgungetproc=procedure(list:Taasmoutput;position:Tai;r:Tregister) of object;
+
+        { Class template for assembler instructions
+        }
+        tai_cpu_abstract = class(tailineinfo)
+        protected
+           procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
+           procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
+           procedure ppubuildderefimploper(var o:toper);virtual;abstract;
+           procedure ppuderefoper(var o:toper);virtual;abstract;
+        public
+           { Condition flags for instruction }
+           condition : TAsmCond;
+           { Number of operands to instruction }
+           ops       : byte;
+           { Number of allocate oper structures }
+           opercnt   : byte;
+           { Operands of instruction }
+           oper      : array[0..max_operands-1] of poper;
+           { Actual opcode of instruction }
+           opcode    : tasmop;
+{$ifdef x86}
+           segprefix : tregister;
+{$endif x86}
+           { true if instruction is a jmp }
+           is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
+           Constructor Create(op : tasmop);virtual;
+           Destructor Destroy;override;
+           function getcopy:TLinkedListItem;override;
+           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
+           procedure ppuwrite(ppufile:tcompilerppufile);override;
+           procedure buildderefimpl;override;
+           procedure derefimpl;override;
+           procedure SetCondition(const c:TAsmCond);
+           procedure allocate_oper(opers:longint);
+           procedure loadconst(opidx:longint;l:aint);
+           procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+           procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean);
+           procedure loadref(opidx:longint;const r:treference);
+           procedure loadreg(opidx:longint;r:tregister);
+           procedure loadoper(opidx:longint;o:toper);
+           procedure clearop(opidx:longint);
+           { register allocator }
+           function is_same_reg_move(regtype: Tregistertype):boolean;virtual;
+           function spilling_get_operation_type(opnr: longint): topertype;virtual;
+           function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual;
+
+           function  Pass1(offset:longint):longint;virtual;abstract;
+           procedure Pass2(objdata:TAsmObjectdata);virtual;abstract;
+        end;
+        tai_cpu_class = class of tai_cpu_abstract;
+
+        { alignment for operator }
+        tai_align_abstract = class(tai)
+           aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
+           fillsize  : byte;   { real size to fill }
+           fillop    : byte;   { value to fill with - optional }
+           use_op    : boolean;
+           constructor Create(b:byte);virtual;
+           constructor Create_op(b: byte; _op: byte);virtual;
+           constructor Create_zeros(b:byte);
+           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
+           procedure ppuwrite(ppufile:tcompilerppufile);override;
+           function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
+        end;
+        tai_align_class = class of tai_align_abstract;
+
+        taasmoutput = class(tlinkedlist)
+           constructor create;
+           function  empty : boolean;
+           function  getlasttaifilepos : pfileposinfo;
+           procedure InsertAfter(Item,Loc : TLinkedListItem);override;
+        end;
+
+        { Type of asmlists. The order is important for the layout of the
+          information in the .o file. The stabs for the types must be defined
+          before they can be referenced and therefor they need to be written
+          first (PFV) }
+        Tasmlist=(al_stabsstart,
+                  al_stabs,
+                  al_procedures,
+                  al_globals,
+                  al_const,
+                  al_typedconsts,
+                  al_rotypedconsts,
+                  al_threadvars,
+                  al_imports,
+                  al_exports,
+                  al_resources,
+                  al_rtti,
+                  al_dwarf,
+                  al_picdata,
+                  al_resourcestrings,
+                  al_stabsend);
     const
        TasmlistStr : array[tasmlist] of string[24] =(
            'al_stabsstart',
@@ -1900,6 +1924,93 @@ implementation
       end;
 
 
+{****************************************************************************
+                                    tai_file
+ ****************************************************************************}
+
+    constructor tai_file.Create(_str : string;_idx : longint);
+      begin
+        inherited Create;
+        typ:=ait_file;
+        str:=strpnew(_str);
+        idx:=_idx;
+      end;
+
+
+    destructor tai_file.destroy;
+      begin
+         strdispose(str);
+         inherited Destroy;
+      end;
+
+
+    constructor tai_file.ppuload(t:taitype;ppufile:tcompilerppufile);
+      var
+        len : longint;
+      begin
+        inherited ppuload(t,ppufile);
+        len:=ppufile.getlongint;
+        getmem(str,len+1);
+        ppufile.getdata(str^,len);
+        str[len]:=#0;
+        idx:=ppufile.getlongint;
+      end;
+
+
+    procedure tai_file.ppuwrite(ppufile:tcompilerppufile);
+      var
+        len : longint;
+      begin
+        inherited ppuwrite(ppufile);
+        len:=strlen(str);
+        ppufile.putlongint(len);
+        ppufile.putdata(str^,len);
+        ppufile.putlongint(idx);
+      end;
+
+
+    function tai_file.getcopy : tlinkedlistitem;
+      var
+        p : tlinkedlistitem;
+      begin
+        p:=inherited getcopy;
+        getmem(tai_comment(p).str,strlen(str)+1);
+        move(str^,tai_comment(p).str^,strlen(str)+1);
+        getcopy:=p;
+      end;
+
+
+{****************************************************************************
+                                    tai_loc
+ ****************************************************************************}
+
+    constructor tai_loc.Create(_fileidx,_line,_column : longint);
+      begin
+        inherited Create;
+        typ:=ait_loc;
+        fileidx:=_fileidx;
+        line:=_line;
+        column:=_column;
+      end;
+
+
+    constructor tai_loc.ppuload(t:taitype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        fileidx:=ppufile.getlongint;
+        line:=ppufile.getlongint;
+        column:=ppufile.getlongint;
+      end;
+
+
+    procedure tai_loc.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putlongint(fileidx);
+        ppufile.putlongint(line);
+        ppufile.putlongint(column);
+      end;
+
 {*****************************************************************************
                                TaiInstruction
 *****************************************************************************}
@@ -1994,7 +2105,6 @@ implementation
       end;
 
 
-
     procedure tai_cpu_abstract.loadref(opidx:longint;const r:treference);
       begin
         allocate_oper(opidx+1);

compiler/aggas.pas

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 1998-2004 by the Free Pascal team
+    Copyright (c) 1998-2006 by the Free Pascal team
 
     This unit implements generic GNU assembler (v2.8 or later)
 
@@ -793,6 +793,7 @@ implementation
                   AsmWriteLn(':');
                 end;
              end;
+
            ait_symbol :
              begin
                if tai_symbol(hp).is_global then
@@ -877,6 +878,21 @@ implementation
                  end;
              end;
 
+           ait_file :
+             begin
+               AsmWrite(#9'.file '+tostr(tai_file(hp).idx)+' "');
+
+               AsmWritePChar(tai_file(hp).str);
+               AsmWrite('"');
+               AsmLn;
+             end;
+
+           ait_loc :
+             begin
+               AsmWrite(#9'.loc '+tostr(tai_loc(hp).fileidx)+' '+tostr(tai_loc(hp).line)+' '+tostr(tai_loc(hp).column));
+               AsmLn;
+             end;
+
            ait_force_line,
            ait_function_name : ;
 
@@ -921,7 +937,7 @@ implementation
              end;
 
            else
-             internalerror(10000);
+             internalerror(2006012201);
          end;
          hp:=tai(hp.next);
        end;

compiler/dbgdwarf.pas

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
+    Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl
 
     This units contains support for DWARF debug info generation
 
@@ -31,13 +31,19 @@ interface
 
     type
       TDebugInfoDwarf=class(TDebugInfo)
+        currfileidx : longint;
         procedure insertlineinfo(list:taasmoutput);override;
       end;
 
 implementation
 
     uses
-      Systems;
+      cutils,
+      globals,
+      Systems,
+      aasmbase,
+      finput,
+      fmodule;
 
     const
       dbg_dwarf_info : tdbginfo =
@@ -47,9 +53,6 @@ implementation
          );
 
     procedure tdebuginfodwarf.insertlineinfo(list:taasmoutput);
-      begin
-      end;
-      {
       var
         currfileinfo,
         lastfileinfo : tfileposinfo;
@@ -85,14 +88,14 @@ implementation
                     infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
                     if assigned(infile) then
                       begin
-                        objectlibrary.getlabel(hlabel,alt_dbgfile);
-                        { emit stabs }
+                        inc(currfileidx);
                         if (infile.path^<>'') then
-                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+
-                                            ',0,0,'+hlabel.name),hp);
-                        list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
-                                          ',0,0,'+hlabel.name),hp);
-                        list.insertbefore(tai_label.create(hlabel),hp);
+                          list.insertbefore(tai_file.create(
+                            BsToSlash(FixPath(infile.path^,false)+FixFileName(infile.name^)),currfileidx
+                          ),hp)
+                        else
+                          list.insertbefore(tai_file.create(
+                            FixFileName(infile.name^),currfileidx),hp);
                         { force new line info }
                         lastfileinfo.line:=-1;
                       end;
@@ -100,26 +103,14 @@ implementation
 
                 { line changed ? }
                 if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
-                  begin
-                     if assigned(currfuncname) and
-                        (tf_use_function_relative_addresses in target_info.flags) then
-                      begin
-                        objectlibrary.getlabel(hlabel,alt_dbgline);
-                        list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
-                                          hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
-                        list.insertbefore(tai_label.create(hlabel),hp);
-                      end
-                     else
-                      list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
-                  end;
+                  list.insertbefore(tai_loc.create(
+                    currfileidx,currfileinfo.line,currfileinfo.column),hp);
                 lastfileinfo:=currfileinfo;
               end;
 
             hp:=tai(hp.next);
           end;
       end;
-    }
-
 
 initialization
   RegisterDebugInfo(dbg_dwarf_info,TDebugInfoDwarf);

compiler/psystem.pas

@@ -526,6 +526,8 @@ implementation
         aiclass[ait_regalloc]:=tai_regalloc;
         aiclass[ait_tempalloc]:=tai_tempalloc;
         aiclass[ait_marker]:=tai_marker;
+        aiclass[ait_file]:=tai_file;
+        aiclass[ait_loc]:=tai_loc;
       end;
 
 end.