freepascal.compiler/compiler/dbgstabs.pas

{
    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl

    This units contains support for STABS debug info generation

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit dbgstabs;

{$i fpcdefs.inc}

interface

    uses
      cclasses,
      dbgbase,
      symtype,symdef,symsym,symtable,symbase,
      aasmtai;

    type
      TDebugInfoStabs=class(TDebugInfo)
      private
        writing_def_stabs  : boolean;
        global_stab_number : word;
        defnumberlist      : tlist;
        { tsym writing }
        function  sym_var_value(const s:string;arg:pointer):string;
        function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
        procedure write_symtable_syms(list:taasmoutput;st:tsymtable);
        { tdef writing }
        function  def_stab_number(def:tdef):string;
        function  def_stab_classnumber(def:tobjectdef):string;
        function  def_var_value(const s:string;arg:pointer):string;
        function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
        procedure field_add_stabstr(p:Tnamedindexitem;arg:pointer);
        procedure method_add_stabstr(p:Tnamedindexitem;arg:pointer);
        function  def_stabstr(def:tdef):pchar;
        procedure write_def_stabstr(list:taasmoutput;def:tdef);
        procedure field_write_defs(p:Tnamedindexitem;arg:pointer);
        procedure method_write_defs(p :tnamedindexitem;arg:pointer);
        procedure write_symtable_defs(list:taasmoutput;st:tsymtable);
        procedure write_procdef(list:taasmoutput;pd:tprocdef);
        procedure insertsym(list:taasmoutput;sym:tsym);
        procedure insertdef(list:taasmoutput;def:tdef);
      public
        procedure inserttypeinfo;override;
        procedure insertmoduleinfo;override;
        procedure insertlineinfo(list:taasmoutput);override;
        procedure referencesections(list:taasmoutput);override;
      end;


implementation

    uses
      strings,cutils,
      systems,globals,globtype,verbose,
      symconst,defutil,
      cpuinfo,cpubase,cgbase,paramgr,
      aasmbase,procinfo,
      finput,fmodule,ppu;

    const
      memsizeinc = 512;

      N_GSYM = $20;
      N_STSYM = 38;     { initialized const }
      N_LCSYM = 40;     { non initialized variable}
      N_Function = $24; { function or const }
      N_TextLine = $44;
      N_DataLine = $46;
      N_BssLine = $48;
      N_RSYM = $40;     { register variable }
      N_LSYM = $80;
      N_tsym = 160;
      N_SourceFile = $64;
      N_IncludeFile = $84;
      N_BINCL = $82;
      N_EINCL = $A2;
      N_EXCL  = $C2;

      tagtypes = [
        recorddef,
        enumdef,
        stringdef,
        filedef,
        objectdef
      ];

    type
       get_var_value_proc=function(const s:string;arg:pointer):string of object;

       Trecord_stabgen_state=record
          stabstring:Pchar;
          stabsize,staballoc,recoffset:integer;
       end;
       Precord_stabgen_state=^Trecord_stabgen_state;


    function string_evaluate(s:string;get_var_value:get_var_value_proc;
                             get_var_value_arg:pointer;
                             const vars:array of string):Pchar;

    (*
     S contains a prototype of a result. Stabstr_evaluate will expand
     variables and parameters.

     Output is s in ASCIIZ format, with the following expanded:

     ${varname}   - The variable name is expanded.
     $n           - The parameter n is expanded.
     $$           - Is expanded to $
    *)

    const maxvalue=9;
          maxdata=1023;

    var i,j:byte;
        varname:string[63];
        varno,varcounter:byte;
        varvalues:array[0..9] of Pstring;
        {1 kb of parameters is the limit. 256 extra bytes are allocated to
         ensure buffer integrity.}
        varvaluedata:array[0..maxdata+256] of char;
        varptr:Pchar;
        varidx : byte;
        len:cardinal;
        r:Pchar;

    begin
      {Two pass approach, first, calculate the length and receive variables.}
      i:=1;
      len:=0;
      varcounter:=0;
      varptr:=@varvaluedata;
      while i<=length(s) do
        begin
          if (s[i]='$') and (i<length(s)) then
            begin
             if s[i+1]='$' then
               begin
                 inc(len);
                 inc(i);
               end
             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
               begin
                 varname:='';
                 inc(i,2);
                 repeat
                   inc(varname[0]);
                   varname[length(varname)]:=s[i];
                   s[i]:=char(varcounter);
                   inc(i);
                 until s[i]='}';
                 varvalues[varcounter]:=Pstring(varptr);
                 if varptr>@varvaluedata+maxdata then
                   internalerrorproc(200411152);
                 Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
                 inc(len,length(Pstring(varptr)^));
                 inc(varptr,length(Pstring(varptr)^)+1);
                 inc(varcounter);
               end
             else if s[i+1] in ['1'..'9'] then
               begin
                 varidx:=byte(s[i+1])-byte('1');
                 if varidx>high(vars) then
                   internalerror(200509263);
                 inc(len,length(vars[varidx]));
                 inc(i);
               end;
            end
          else
            inc(len);
          inc(i);
        end;

      {Second pass, writeout result.}
      getmem(r,len+1);
      string_evaluate:=r;
      i:=1;
      while i<=length(s) do
        begin
          if (s[i]='$') and (i<length(s)) then
            begin
             if s[i+1]='$' then
               begin
                 r^:='$';
                 inc(r);
                 inc(i);
               end
             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
               begin
                 varname:='';
                 inc(i,2);
                 varno:=byte(s[i]);
                 repeat
                   inc(i);
                 until s[i]='}';
                 for j:=1 to length(varvalues[varno]^) do
                   begin
                     r^:=varvalues[varno]^[j];
                     inc(r);
                   end;
               end
             else if s[i+1] in ['0'..'9'] then
               begin
                 for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
                   begin
                     r^:=vars[byte(s[i+1])-byte('1')][j];
                     inc(r);
                   end;
                 inc(i);
               end
            end
          else
            begin
              r^:=s[i];
              inc(r);
            end;
          inc(i);
        end;
      r^:=#0;
    end;


{****************************************************************************
                               TDef support
****************************************************************************}

    function TDebugInfoStabs.def_stab_number(def:tdef):string;
      begin
        { procdefs only need a number, mark them as already written
          so they won't be written implicitly }
        if (def.deftype=procdef) then
          def.stab_state:=stab_state_written;
        { Stab must already be written, or we must be busy writing it }
        if writing_def_stabs and
           not(def.stab_state in [stab_state_writing,stab_state_written]) then
          internalerror(200403091);
        { Keep track of used stabs, this info is only usefull for stabs
          referenced by the symbols. Definitions will always include all
          required stabs }
        if def.stab_state=stab_state_unused then
          def.stab_state:=stab_state_used;
        { Need a new number? }
        if def.stab_number=0 then
          begin
            inc(global_stab_number);
            { classes require 2 numbers }
            if is_class(def) then
              inc(global_stab_number);
            def.stab_number:=global_stab_number;
            if global_stab_number>=defnumberlist.count then
              defnumberlist.count:=global_stab_number+250;
            defnumberlist[global_stab_number]:=def;
          end;
        result:=tostr(def.stab_number);
      end;


    function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
      begin
        if def.stab_number=0 then
          def_stab_number(def);
        result:=tostr(def.stab_number-1);
      end;


    function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
      var
        def : tdef;
      begin
        def:=tdef(arg);
        result:='';
        if s='numberstring' then
          result:=def_stab_number(def)
        else if s='sym_name' then
          begin
            if assigned(def.typesym) then
               result:=Ttypesym(def.typesym).name;
          end
        else if s='N_LSYM' then
          result:=tostr(N_LSYM)
        else if s='savesize' then
          result:=tostr(def.size);
      end;


    function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
      begin
        result:=string_evaluate(s,@def_var_value,def,vars);
      end;


    procedure TDebugInfoStabs.field_add_stabstr(p:Tnamedindexitem;arg:pointer);
      var
        newrec  : Pchar;
        spec    : string[3];
        varsize : aint;
        state   : Precord_stabgen_state;
      begin
        state:=arg;
        { static variables from objects are like global objects }
        if (Tsym(p).typ=fieldvarsym) and
           not(sp_static in Tsym(p).symoptions) then
          begin
            if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
              spec:='/1'
            else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
              spec:='/0'
            else
              spec:='';
            varsize:=tfieldvarsym(p).vartype.def.size;
            { open arrays made overflows !! }
            if varsize>$fffffff then
              varsize:=$fffffff;
            newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[p.name,
                                     spec+def_stab_number(tfieldvarsym(p).vartype.def),
                                     tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]);
            if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then
              begin
                inc(state^.staballoc,strlen(newrec)+64);
                reallocmem(state^.stabstring,state^.staballoc);
              end;
            strcopy(state^.stabstring+state^.stabsize,newrec);
            inc(state^.stabsize,strlen(newrec));
            strdispose(newrec);
            {This should be used for case !!}
            inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size);
          end;
      end;


    procedure TDebugInfoStabs.method_add_stabstr(p:Tnamedindexitem;arg:pointer);
      var virtualind,argnames : string;
          newrec : pchar;
          pd     : tprocdef;
          lindex : longint;
          arglength : byte;
          sp : char;
          state:^Trecord_stabgen_state;
          olds:integer;
          i : integer;
          parasym : tparavarsym;
      begin
        state:=arg;
        if tsym(p).typ = procsym then
         begin
           pd := tprocsym(p).first_procdef;
           if (po_virtualmethod in pd.procoptions) then
             begin
               lindex := pd.extnumber;
               {doesnt seem to be necessary
               lindex := lindex or $80000000;}
               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
             end
            else
             virtualind := '.';

            { used by gdbpas to recognize constructor and destructors }
            if (pd.proctypeoption=potype_constructor) then
              argnames:='__ct__'
            else if (pd.proctypeoption=potype_destructor) then
              argnames:='__dt__'
            else
              argnames := '';

           { arguments are not listed here }
           {we don't need another definition}
            for i:=0 to pd.paras.count-1 do
              begin
                parasym:=tparavarsym(pd.paras[i]);
                if Parasym.vartype.def.deftype = formaldef then
                  begin
                    case Parasym.varspez of
                      vs_var :
                        argnames := argnames+'3var';
                      vs_const :
                        argnames:=argnames+'5const';
                      vs_out :
                        argnames:=argnames+'3out';
                    end;
                  end
                else
                  begin
                    { if the arg definition is like (v: ^byte;..
                    there is no sym attached to data !!! }
                    if assigned(Parasym.vartype.def.typesym) then
                      begin
                        arglength := length(Parasym.vartype.def.typesym.name);
                        argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name;
                      end
                    else
                      argnames:=argnames+'11unnamedtype';
                  end;
              end;
           { here 2A must be changed for private and protected }
           { 0 is private 1 protected and 2 public }
           if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
             sp:='0'
           else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
             sp:='1'
           else
             sp:='2';
           newrec:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[p.name,def_stab_number(pd),
                                    def_stab_number(pd.rettype.def),argnames,sp,
                                    virtualind]);
           { get spare place for a string at the end }
           olds:=state^.stabsize;
           inc(state^.stabsize,strlen(newrec));
           if state^.stabsize>=state^.staballoc-256 then
             begin
                inc(state^.staballoc,strlen(newrec)+64);
                reallocmem(state^.stabstring,state^.staballoc);
             end;
           strcopy(state^.stabstring+olds,newrec);
           strdispose(newrec);
           {This should be used for case !!
           RecOffset := RecOffset + pd.size;}
         end;
      end;


    function TDebugInfoStabs.def_stabstr(def:tdef):pchar;

        function stringdef_stabstr(def:tstringdef):pchar;
          var
            slen : aint;
            bytest,charst,longst : string;
          begin
            case def.string_typ of
              st_shortstring:
                begin
                  { fix length of openshortstring }
                  slen:=def.len;
                  if slen=0 then
                    slen:=255;
                  charst:=def_stab_number(cchartype.def);
                  bytest:=def_stab_number(u8inttype.def);
                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
                              [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
                end;
              st_longstring:
                begin
                  charst:=def_stab_number(cchartype.def);
                  bytest:=def_stab_number(u8inttype.def);
                  longst:=def_stab_number(u32inttype.def);
                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
                              [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
               end;
             st_ansistring:
               begin
                 { looks like a pchar }
                 charst:=def_stab_number(cchartype.def);
                 result:=strpnew('*'+charst);
               end;
             st_widestring:
               begin
                 { looks like a pwidechar }
                 charst:=def_stab_number(cwidechartype.def);
                 result:=strpnew('*'+charst);
               end;
            end;
          end;

        function enumdef_stabstr(def:tenumdef):pchar;
          var
            st : Pchar;
            p : Tenumsym;
            s : string;
            memsize,
            stl : aint;
          begin
            memsize:=memsizeinc;
            getmem(st,memsize);
            { we can specify the size with @s<size>; prefix PM }
            if def.size <> std_param_align then
              strpcopy(st,'@s'+tostr(def.size*8)+';e')
            else
              strpcopy(st,'e');
            p := tenumsym(def.firstenum);
            stl:=strlen(st);
            while assigned(p) do
              begin
                s :=p.name+':'+tostr(p.value)+',';
                { place for the ending ';' also }
                if (stl+length(s)+1>=memsize) then
                  begin
                    inc(memsize,memsizeinc);
                    reallocmem(st,memsize);
                  end;
                strpcopy(st+stl,s);
                inc(stl,length(s));
                p:=p.nextenum;
              end;
            st[stl]:=';';
            st[stl+1]:=#0;
            reallocmem(st,stl+2);
            result:=st;
          end;

        function orddef_stabstr(def:torddef):pchar;
          begin
            if cs_gdb_valgrind in aktglobalswitches then
              begin
                case def.typ of
                  uvoid :
                    result:=strpnew(def_stab_number(def));
                  bool8bit,
                  bool16bit,
                  bool32bit :
                    result:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
                  u32bit,
                  s64bit,
                  u64bit :
                    result:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
                  else
                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
                end;
              end
            else
              begin
                case def.typ of
                  uvoid :
                    result:=strpnew(def_stab_number(def));
                  uchar :
                    result:=strpnew('-20;');
                  uwidechar :
                    result:=strpnew('-30;');
                  bool8bit :
                    result:=strpnew('-21;');
                  bool16bit :
                    result:=strpnew('-22;');
                  bool32bit :
                    result:=strpnew('-23;');
                  u64bit :
                    result:=strpnew('-32;');
                  s64bit :
                    result:=strpnew('-31;');
                  {u32bit : result:=def_stab_number(s32inttype.def)+';0;-1;'); }
                  else
                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
                end;
             end;
          end;

        function floatdef_stabstr(def:tfloatdef):Pchar;
          begin
            case def.typ of
              s32real,
              s64real,
              s80real:
                result:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype.def)]);
              s64currency,
              s64comp:
                result:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype.def)]);
              else
                internalerror(200509261);
            end;
          end;

        function filedef_stabstr(def:tfiledef):pchar;
          begin
{$ifdef cpu64bit}
            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
                                     '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+
                                     'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype.def),
                                     def_stab_number(s64inttype.def),
                                     def_stab_number(u8inttype.def),
                                     def_stab_number(cchartype.def)]);
{$else cpu64bit}
            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
                                     '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+
                                     'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype.def),
                                     def_stab_number(u8inttype.def),
                                     def_stab_number(cchartype.def)]);
{$endif cpu64bit}
          end;

        function procdef_stabstr(def:tprocdef):pchar;
          Var
            RType : Char;
            Obj,Info : String;
            stabsstr : string;
            p : pchar;
          begin
            obj := def.procsym.name;
            info := '';
            if (po_global in def.procoptions) then
              RType := 'F'
            else
              RType := 'f';
            if assigned(def.owner) then
             begin
               if (def.owner.symtabletype = objectsymtable) then
                 obj := def.owner.name^+'__'+def.procsym.name;
               if not(cs_gdb_valgrind in aktglobalswitches) and
                  (def.owner.symtabletype=localsymtable) and
                  assigned(def.owner.defowner) and
                  assigned(tprocdef(def.owner.defowner).procsym) then
                 info := ','+def.procsym.name+','+tprocdef(def.owner.defowner).procsym.name;
             end;
            stabsstr:=def.mangledname;
            getmem(p,length(stabsstr)+255);
            strpcopy(p,'"'+obj+':'+RType
                  +def_stab_number(def.rettype.def)+info+'",'+tostr(n_function)
                  +',0,'+
                  tostr(def.fileinfo.line)
                  +',');
            strpcopy(strend(p),stabsstr);
            result:=strnew(p);
            freemem(p,length(stabsstr)+255);
          end;

        function recorddef_stabstr(def:trecorddef):pchar;
          var
            state : Trecord_stabgen_state;
          begin
            getmem(state.stabstring,memsizeinc);
            state.staballoc:=memsizeinc;
            strpcopy(state.stabstring,'s'+tostr(def.size));
            state.recoffset:=0;
            state.stabsize:=strlen(state.stabstring);
            def.symtable.foreach(@field_add_stabstr,@state);
            state.stabstring[state.stabsize]:=';';
            state.stabstring[state.stabsize+1]:=#0;
            reallocmem(state.stabstring,state.stabsize+2);
            result:=state.stabstring;
          end;

        function objectdef_stabstr(def:tobjectdef):pchar;
          var
            anc    : tobjectdef;
            state  :Trecord_stabgen_state;
            ts     : string;
          begin
            { Write the invisible pointer for the class? }
            if (def.objecttype=odt_class) and
               (not def.writing_class_record_stab) then
              begin
                result:=strpnew('*'+def_stab_classnumber(def));
                exit;
              end;

            state.staballoc:=memsizeinc;
            getmem(state.stabstring,state.staballoc);
            strpcopy(state.stabstring,'s'+tostr(tobjectsymtable(def.symtable).datasize));
            if assigned(def.childof) then
              begin
                {only one ancestor not virtual, public, at base offset 0 }
                {       !1           ,    0       2         0    ,       }
                strpcopy(strend(state.stabstring),'!1,020,'+def_stab_classnumber(def.childof)+';');
              end;
            {virtual table to implement yet}
            state.recoffset:=0;
            state.stabsize:=strlen(state.stabstring);
            def.symtable.foreach(@field_add_stabstr,@state);
            if (oo_has_vmt in def.objectoptions) then
              if not assigned(def.childof) or not(oo_has_vmt in def.childof.objectoptions) then
                 begin
                    ts:='$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype.def)+','+tostr(def.vmt_offset*8)+';';
                    strpcopy(state.stabstring+state.stabsize,ts);
                    inc(state.stabsize,length(ts));
                 end;
            def.symtable.foreach(@method_add_stabstr,@state);
            if (oo_has_vmt in def.objectoptions) then
              begin
                 anc := def;
                 while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
                   anc := anc.childof;
                 { just in case anc = self }
                 ts:=';~%'+def_stab_classnumber(anc)+';';
              end
            else
              ts:=';';
            strpcopy(state.stabstring+state.stabsize,ts);
            inc(state.stabsize,length(ts));
            reallocmem(state.stabstring,state.stabsize+1);
            result:=state.stabstring;
          end;

      begin
        result:=nil;
        case def.deftype of
          stringdef :
            result:=stringdef_stabstr(tstringdef(def));
          enumdef :
            result:=enumdef_stabstr(tenumdef(def));
          orddef :
            result:=orddef_stabstr(torddef(def));
          floatdef :
            result:=floatdef_stabstr(tfloatdef(def));
          filedef :
            result:=filedef_stabstr(tfiledef(def));
          recorddef :
            result:=recorddef_stabstr(trecorddef(def));
          variantdef :
            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
          pointerdef :
            result:=strpnew('*'+def_stab_number(tpointerdef(def).pointertype.def));
          classrefdef :
            result:=strpnew(def_stab_number(pvmttype.def));
          setdef :
            result:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementtype.def)]);
          formaldef :
            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
          arraydef :
            result:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangetype.def),
               tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementtype.def)]);
          procdef :
            result:=procdef_stabstr(tprocdef(def));
          procvardef :
            result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def));
          objectdef :
            begin
              if tobjectdef(def).writing_class_record_stab then
                result:=objectdef_stabstr(tobjectdef(def))
              else
                result:=strpnew('*'+def_stab_classnumber(tobjectdef(def)));
            end;
        end;
      end;


    procedure TDebugInfoStabs.write_def_stabstr(list:taasmoutput;def:tdef);
      var
        stabchar : string[2];
        ss,st,su : pchar;
      begin
        { procdefs require a different stabs style without type prefix }
        if def.deftype=procdef then
          begin
            st:=def_stabstr(def);
            { add to list }
            list.concat(Tai_stab.create(stab_stabs,st));
          end
        else
          begin
            { type prefix }
            if def.deftype in tagtypes then
              stabchar := 'Tt'
            else
              stabchar := 't';
            { Here we maybe generate a type, so we have to use numberstring }
            if is_class(def) and
               tobjectdef(def).writing_class_record_stab then
              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)]);
            ss:=def_stabstr(def);
            reallocmem(st,strlen(ss)+512);
            { 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 }
            su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
            strcopy(strecopy(strend(st),ss),su);
            reallocmem(st,strlen(st)+1);
            strdispose(ss);
            strdispose(su);
            { add to list }
            list.concat(Tai_stab.create(stab_stabs,st));
          end;
      end;


    procedure TDebugInfoStabs.field_write_defs(p:Tnamedindexitem;arg:pointer);
      begin
        if (Tsym(p).typ=fieldvarsym) and
           not(sp_static in Tsym(p).symoptions) then
          insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def);
      end;


    procedure TDebugInfoStabs.method_write_defs(p :tnamedindexitem;arg:pointer);
      var
        pd : tprocdef;
      begin
        if tsym(p).typ = procsym then
          begin
            pd:=tprocsym(p).first_procdef;
            insertdef(taasmoutput(arg),pd.rettype.def);
          end;
      end;


    procedure TDebugInfoStabs.insertdef(list:taasmoutput;def:tdef);
      var
        anc : tobjectdef;
        oldtypesym : tsym;
//        nb  : string[12];
      begin
        if (def.stab_state in [stab_state_writing,stab_state_written]) then
          exit;
        { to avoid infinite loops }
        def.stab_state := stab_state_writing;
        { write dependencies first }
        case def.deftype of
          stringdef :
            begin
              if tstringdef(def).string_typ=st_widestring then
                insertdef(list,cwidechartype.def)
              else
                begin
                  insertdef(list,cchartype.def);
                  insertdef(list,u8inttype.def);
                end;
            end;
          floatdef :
            insertdef(list,s32inttype.def);
          filedef :
            begin
              insertdef(list,s32inttype.def);
{$ifdef cpu64bit}
              insertdef(list,s64inttype.def);
{$endif cpu64bit}
              insertdef(list,u8inttype.def);
              insertdef(list,cchartype.def);
            end;
          classrefdef :
            insertdef(list,pvmttype.def);
          pointerdef :
            insertdef(list,tpointerdef(def).pointertype.def);
          setdef :
            insertdef(list,tsetdef(def).elementtype.def);
          procvardef,
          procdef :
            insertdef(list,tprocdef(def).rettype.def);
          arraydef :
            begin
              insertdef(list,tarraydef(def).rangetype.def);
              insertdef(list,tarraydef(def).elementtype.def);
            end;
          recorddef :
            trecorddef(def).symtable.foreach(@field_write_defs,list);
          objectdef :
            begin
              insertdef(list,vmtarraytype.def);
              { first the parents }
              anc:=tobjectdef(def);
              while assigned(anc.childof) do
                begin
                  anc:=anc.childof;
                  insertdef(list,anc);
                end;
              tobjectdef(def).symtable.foreach(@field_write_defs,list);
              tobjectdef(def).symtable.foreach(@method_write_defs,list);
            end;
        end;
(*
        { Handle pointerdefs to records and objects to avoid recursion }
        if (def.deftype=pointerdef) and
           (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then
          begin
            def.stab_state:=stab_state_used;
            write_def_stabstr(list,def);
            {to avoid infinite recursion in record with next-like fields }
            if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then
              begin
                if assigned(tpointerdef(def).pointertype.def.typesym) then
                  begin
                    if is_class(tpointerdef(def).pointertype.def) then
                      nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def))
                    else
                      nb:=def_stab_number(tpointerdef(def).pointertype.def);
                    list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate(
                            def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0',
                            [nb,tpointerdef(def).pointertype.def.typesym.name])));
                  end;
                def.stab_state:=stab_state_written;
              end
          end
        else
*)
        case def.deftype of
          objectdef :
            begin
              { classes require special code to write the record and the invisible pointer }
              if is_class(def) then
                begin
                  { Write the record class itself }
                  tobjectdef(def).writing_class_record_stab:=true;
                  write_def_stabstr(list,def);
                  tobjectdef(def).writing_class_record_stab:=false;
                  { Write the invisible pointer class }
                  oldtypesym:=def.typesym;
                  def.typesym:=nil;
                  write_def_stabstr(list,def);
                  def.typesym:=oldtypesym;
                end
              else
                write_def_stabstr(list,def);
              { VMT symbol }
              if (oo_has_vmt in tobjectdef(def).objectoptions) and
                 assigned(def.owner) and
                 assigned(def.owner.name) then
                list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+def.owner.name^+tobjectdef(def).name+':S'+
                       def_stab_number(vmttype.def)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname)));
            end;
          procdef :
            begin
              { procdefs are handled separatly }
            end;
          else
            write_def_stabstr(list,def);
        end;

        def.stab_state := stab_state_written;
      end;


    procedure TDebugInfoStabs.write_symtable_defs(list:taasmoutput;st:tsymtable);

       procedure dowritestabs(list:taasmoutput;st:tsymtable);
         var
           p : tdef;
         begin
           p:=tdef(st.defindex.first);
           while assigned(p) do
             begin
               if (p.stab_state=stab_state_used) then
                 insertdef(list,p);
               p:=tdef(p.indexnext);
             end;
         end;

      var
        old_writing_def_stabs : boolean;
      begin
        case st.symtabletype of
          staticsymtable :
            list.concat(tai_comment.Create(strpnew('Defs - Begin Staticsymtable')));
          globalsymtable :
            list.concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
        end;
        old_writing_def_stabs:=writing_def_stabs;
        writing_def_stabs:=true;
        dowritestabs(list,st);
        writing_def_stabs:=old_writing_def_stabs;
        case st.symtabletype of
          staticsymtable :
            list.concat(tai_comment.Create(strpnew('Defs - End Staticsymtable')));
          globalsymtable :
            list.concat(tai_comment.Create(strpnew('Defs - End unit '+st.name^+' has index '+tostr(st.moduleid))));
        end;
      end;


    procedure TDebugInfoStabs.write_procdef(list:taasmoutput;pd:tprocdef);
      var
        templist : taasmoutput;
        stabsendlabel : tasmlabel;
        mangled_length : longint;
        p : pchar;
        hs : string;
      begin
        if assigned(pd.procstarttai) then
          begin
            templist:=taasmoutput.create;
            { para types }
            write_def_stabstr(templist,pd);
            if assigned(pd.parast) then
              write_symtable_syms(templist,pd.parast);
            { local type defs and vars should not be written
              inside the main proc stab }
            if assigned(pd.localst) and
               (pd.localst.symtabletype=localsymtable) then
              write_symtable_syms(templist,pd.localst);
            asmlist[al_procedures].insertlistbefore(pd.procstarttai,templist);
            { end of procedure }
            objectlibrary.getlabel(stabsendlabel,alt_dbgtype);
            templist.concat(tai_label.create(stabsendlabel));
            if assigned(pd.funcretsym) and
               (tabstractnormalvarsym(pd.funcretsym).refs>0) then
              begin
                if tabstractnormalvarsym(pd.funcretsym).localloc.loc=LOC_REFERENCE then
                  begin
    {$warning Need to add gdb support for ret in param register calling}
                    if paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
                      hs:='X*'
                    else
                      hs:='X';
                    templist.concat(Tai_stab.create(stab_stabs,strpnew(
                       '"'+pd.procsym.name+':'+hs+def_stab_number(pd.rettype.def)+'",'+
                       tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
                    if (m_result in aktmodeswitches) then
                      templist.concat(Tai_stab.create(stab_stabs,strpnew(
                         '"RESULT:'+hs+def_stab_number(pd.rettype.def)+'",'+
                         tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
                  end;
              end;
            mangled_length:=length(pd.mangledname);
            getmem(p,2*mangled_length+50);
            strpcopy(p,'192,0,0,');
            {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
            strpcopy(strend(p),pd.mangledname);
            if (target_info.use_function_relative_addresses) then
              begin
                strpcopy(strend(p),'-');
                {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
                strpcopy(strend(p),pd.mangledname);
              end;
            templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
            strpcopy(p,'224,0,0,'+stabsendlabel.name);
            if (target_info.use_function_relative_addresses) then
              begin
                strpcopy(strend(p),'-');
                {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
                strpcopy(strend(p),pd.mangledname);
              end;
            templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
            freemem(p,2*mangled_length+50);
            asmlist[al_procedures].insertlistbefore(pd.procendtai,templist);
            templist.free;
          end;
      end;


{****************************************************************************
                               TSym support
****************************************************************************}

    function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
      var
        sym : tsym;
      begin
        sym:=tsym(arg);
        result:='';
        if s='name' then
          result:=sym.name
        else if s='mangledname' then
          result:=sym.mangledname
        else if s='ownername' then
          result:=sym.owner.name^
        else if s='line' then
          result:=tostr(sym.fileinfo.line)
        else if s='N_LSYM' then
          result:=tostr(N_LSYM)
        else if s='N_LCSYM' then
          result:=tostr(N_LCSYM)
        else if s='N_RSYM' then
          result:=tostr(N_RSYM)
        else if s='N_TSYM' then
          result:=tostr(N_TSYM)
        else if s='N_STSYM' then
          result:=tostr(N_STSYM)
        else if s='N_FUNCTION' then
          result:=tostr(N_FUNCTION)
        else
          internalerror(200401152);
      end;


    function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
      begin
        result:=string_evaluate(s,@sym_var_value,sym,vars);
      end;


    procedure TDebugInfoStabs.insertsym(list:taasmoutput;sym:tsym);

        function fieldvarsym_stabstr(sym:tfieldvarsym):Pchar;
          begin
            result:=nil;
            if (sym.owner.symtabletype=objectsymtable) and
               (sp_static in sym.symoptions) then
              result:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
                  [def_stab_number(sym.vartype.def)]);
          end;

        function globalvarsym_stabstr(sym:tglobalvarsym):Pchar;
          var
            st : string;
            threadvaroffset : string;
            regidx : Tregisterindex;
          begin
            result:=nil;
            { external symbols can't be resolved at link time, so we
              can't generate stabs for them }
            if vo_is_external in sym.varoptions then
              exit;
            st:=def_stab_number(sym.vartype.def);
            case sym.localloc.loc of
              LOC_REGISTER,
              LOC_CREGISTER,
              LOC_MMREGISTER,
              LOC_CMMREGISTER,
              LOC_FPUREGISTER,
              LOC_CFPUREGISTER :
                begin
                  regidx:=findreg_by_number(sym.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}
                  if regidx<>0 then
                    result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
                end;
              else
                begin
                  if (vo_is_thread_var in sym.varoptions) then
                    threadvaroffset:='+'+tostr(sizeof(aint))
                  else
                    threadvaroffset:='';
                  { 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 !}
                  st:='S'+st;
                  result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
                end;
            end;
          end;

        function localvarsym_stabstr(sym:tlocalvarsym):Pchar;
          var
            st : string;
            regidx : Tregisterindex;
          begin
            result:=nil;
            { There is no space allocated for not referenced locals }
            if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
              exit;

            st:=def_stab_number(sym.vartype.def);
            case sym.localloc.loc of
              LOC_REGISTER,
              LOC_CREGISTER,
              LOC_MMREGISTER,
              LOC_CMMREGISTER,
              LOC_FPUREGISTER,
              LOC_CFPUREGISTER :
                begin
                  regidx:=findreg_by_number(sym.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}
                  if regidx<>0 then
                    result:=sym_stabstr_evaluate(sym,'"${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 }
                result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
              else
                internalerror(2003091814);
            end;
          end;

        function paravarsym_stabstr(sym:tparavarsym):Pchar;
          var
            st : string;
            regidx : Tregisterindex;
            c : char;
          begin
            result:=nil;
            { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
            { while stabs aren't adapted for regvars yet                             }
            if (vo_is_self in sym.varoptions) then
              begin
                case sym.localloc.loc of
                  LOC_REGISTER,
                  LOC_CREGISTER:
                    regidx:=findreg_by_number(sym.localloc.register);
                  LOC_REFERENCE: ;
                  else
                    internalerror(2003091815);
                end;
                if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or
                   (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
                  begin
                    if (sym.localloc.loc=LOC_REFERENCE) then
                      result:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
                        [def_stab_number(pvmttype.def),tostr(sym.localloc.reference.offset)]);
      (*            else
                      result:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
                        [def_stab_number(pvmttype.def),tostr(regstabs_table[regidx])]) *)
                    end
                else
                  begin
                    if not(is_class(tprocdef(sym.owner.defowner)._class)) then
                      c:='v'
                    else
                      c:='p';
                    if (sym.localloc.loc=LOC_REFERENCE) then
                      result:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
                            [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)]);
      (*            else
                      result:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2',
                            [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]); *)
                  end;
              end
            else
              begin
                st:=def_stab_number(sym.vartype.def);

                if paramanager.push_addr_param(sym.varspez,sym.vartype.def,tprocdef(sym.owner.defowner).proccalloption) and
                   not(vo_has_local_copy in sym.varoptions) and
                   not is_open_string(sym.vartype.def) then
                  st := 'v'+st { should be 'i' but 'i' doesn't work }
                else
                  st := 'p'+st;
                case sym.localloc.loc of
                  LOC_REGISTER,
                  LOC_CREGISTER,
                  LOC_MMREGISTER,
                  LOC_CMMREGISTER,
                  LOC_FPUREGISTER,
                  LOC_CFPUREGISTER :
                    begin
                      regidx:=findreg_by_number(sym.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}
                      if regidx<>0 then
                        result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(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 }
                    result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
                  else
                    internalerror(2003091814);
                end;
              end;
          end;

        function constsym_stabstr(sym:tconstsym):Pchar;
          var
            st : string;
          begin
            case sym.consttyp of
              conststring:
                begin
                  if sym.value.len<200 then
                    st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
                  else
                    st:='<constant string too long>';
                end;
              constord:
                st:='i'+tostr(sym.value.valueord);
              constpointer:
                st:='i'+tostr(sym.value.valueordptr);
              constreal:
                begin
                  system.str(pbestreal(sym.value.valueptr)^,st);
                  st := 'r'+st;
                end;
              else
                begin
                  { if we don't know just put zero !! }
                  st:='i0';
                end;
            end;
            { valgrind does not support constants }
            if cs_gdb_valgrind in aktglobalswitches then
              result:=nil
            else
              result:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
          end;

        function typesym_stabstr(sym:ttypesym) : pchar;
          var
            stabchar : string[2];
          begin
            result:=nil;
            if not assigned(sym.restype.def) then
              internalerror(200509262);
            if sym.restype.def.deftype in tagtypes then
              stabchar:='Tt'
            else
              stabchar:='t';
            result:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.restype.def)]);
          end;

        function procsym_stabstr(sym:tprocsym) : pchar;
          var
            i : longint;
          begin
            result:=nil;
            for i:=1 to sym.procdef_count do
              write_procdef(list,sym.procdef[i]);
          end;

      var
        stabstr : Pchar;
      begin
        stabstr:=nil;
        case sym.typ of
          labelsym :
            stabstr:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
          fieldvarsym :
            stabstr:=fieldvarsym_stabstr(tfieldvarsym(sym));
          globalvarsym :
            stabstr:=globalvarsym_stabstr(tglobalvarsym(sym));
          localvarsym :
            stabstr:=localvarsym_stabstr(tlocalvarsym(sym));
          paravarsym :
            stabstr:=paravarsym_stabstr(tparavarsym(sym));
          typedconstsym :
            stabstr:=sym_stabstr_evaluate(sym,'"${name}:S$1",${N_STSYM},0,${line},${mangledname}',
                [def_stab_number(ttypedconstsym(sym).typedconsttype.def)]);
          constsym :
            stabstr:=constsym_stabstr(tconstsym(sym));
          typesym :
            stabstr:=typesym_stabstr(ttypesym(sym));
          procsym :
            stabstr:=procsym_stabstr(tprocsym(sym));
        end;
        if stabstr<>nil then
          list.concat(Tai_stab.create(stab_stabs,stabstr));
        { For object types write also the symtable entries }
        if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then
          write_symtable_syms(list,tobjectdef(ttypesym(sym).restype.def).symtable);
        sym.isstabwritten:=true;
      end;


    procedure TDebugInfoStabs.write_symtable_syms(list:taasmoutput;st:tsymtable);
      var
        p : tsym;
      begin
        case st.symtabletype of
          staticsymtable :
            list.concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable')));
          globalsymtable :
            list.concat(tai_comment.Create(strpnew('Syms - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
        end;
        p:=tsym(st.symindex.first);
        while assigned(p) do
          begin
            if (not p.isstabwritten) then
              insertsym(list,p);
            p:=tsym(p.indexnext);
          end;
        case st.symtabletype of
          staticsymtable :
            list.concat(tai_comment.Create(strpnew('Syms - End Staticsymtable')));
          globalsymtable :
            list.concat(tai_comment.Create(strpnew('Syms - End unit '+st.name^+' has index '+tostr(st.moduleid))));
        end;
      end;

{****************************************************************************
                             Proc/Module support
****************************************************************************}

    procedure tdebuginfostabs.inserttypeinfo;

       procedure reset_unit_type_info;
       var
         hp : tmodule;
       begin
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
             hp.is_stab_written:=false;
             hp:=tmodule(hp.next);
           end;
       end;

       procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule);
       var
         pu : tused_unit;
       begin
         pu:=tused_unit(hp.used_units.first);
         while assigned(pu) do
           begin
             if not pu.u.is_stab_written then
               begin
                 { prevent infinte loop for circular dependencies }
                 pu.u.is_stab_written:=true;
                 { write type info from used units, use a depth first
                   strategy to reduce the recursion in writing all
                   dependent stabs }
                 write_used_unit_type_info(list,pu.u);
                 if assigned(pu.u.globalsymtable) then
                   write_symtable_defs(list,pu.u.globalsymtable);
               end;
             pu:=tused_unit(pu.next);
           end;
       end;

      var
        stabsvarlist,
        stabstypelist : taasmoutput;
        storefilepos  : tfileposinfo;
        st : tsymtable;
        i  : longint;
      begin
        storefilepos:=aktfilepos;
        aktfilepos:=current_module.mainfilepos;

        global_stab_number:=0;
        defnumberlist:=tlist.create;
        stabsvarlist:=taasmoutput.create;
        stabstypelist:=taasmoutput.create;

        { include symbol that will be referenced from the main to be sure to
          include this debuginfo .o file }
        if current_module.is_unit then
          begin
            current_module.flags:=current_module.flags or uf_has_debuginfo;
            st:=current_module.globalsymtable;
          end
        else
          st:=current_module.localsymtable;
        new_section(asmlist[al_stabs],sec_data,st.name^,0);
        asmlist[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0));

        { first write all global/local symbols. This will flag all required tdefs  }
        if assigned(current_module.globalsymtable) then
          write_symtable_syms(stabsvarlist,current_module.globalsymtable);
        if assigned(current_module.localsymtable) then
          write_symtable_syms(stabsvarlist,current_module.localsymtable);

        { reset unit type info flag }
        reset_unit_type_info;

        { write used types from the used units }
        write_used_unit_type_info(stabstypelist,current_module);
        { last write the types from this unit }
        if assigned(current_module.globalsymtable) then
          write_symtable_defs(stabstypelist,current_module.globalsymtable);
        if assigned(current_module.localsymtable) then
          write_symtable_defs(stabstypelist,current_module.localsymtable);

        asmlist[al_stabs].concatlist(stabstypelist);
        asmlist[al_stabs].concatlist(stabsvarlist);

        { reset stab numbers }
        for i:=0 to defnumberlist.count-1 do
          begin
            if assigned(defnumberlist[i]) then
              begin
                tdef(defnumberlist[i]).stab_number:=0;
                tdef(defnumberlist[i]).stab_state:=stab_state_unused;
              end;
          end;

        defnumberlist.free;
        defnumberlist:=nil;

        stabsvarlist.free;
        stabstypelist.free;
        aktfilepos:=storefilepos;
      end;


    procedure tdebuginfostabs.insertlineinfo(list:taasmoutput);
      var
        currfileinfo,
        lastfileinfo : tfileposinfo;
        currfuncname : pstring;
        currsectype  : tasmsectiontype;
        hlabel       : tasmlabel;
        hp : tai;
        infile : tinputfile;
      begin
        FillChar(lastfileinfo,sizeof(lastfileinfo),0);
        currfuncname:=nil;
        currsectype:=sec_code;
        hp:=Tai(list.first);
        while assigned(hp) do
          begin
            case hp.typ of
              ait_section :
                currsectype:=tai_section(hp).sectype;
              ait_function_name :
                currfuncname:=tai_function_name(hp).funcname;
              ait_force_line :
                lastfileinfo.line:=-1;
            end;

            if (currsectype=sec_code) and
               (hp.typ=ait_instruction) then
              begin
                currfileinfo:=tailineinfo(hp).fileinfo;
                { file changed ? (must be before line info) }
                if (currfileinfo.fileindex<>0) and
                   (lastfileinfo.fileindex<>currfileinfo.fileindex) then
                  begin
                    infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
                    if assigned(infile) then
                      begin
                        objectlibrary.getlabel(hlabel,alt_dbgfile);
                        { emit stabs }
                        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);
                        { force new line info }
                        lastfileinfo.line:=-1;
                      end;
                  end;

                { line changed ? }
                if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
                  begin
                     if assigned(currfuncname) and
                        (target_info.use_function_relative_addresses) 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;
                lastfileinfo:=currfileinfo;
              end;

            hp:=tai(hp.next);
          end;
      end;


    procedure tdebuginfostabs.insertmoduleinfo;
      var
        hlabel : tasmlabel;
        infile : tinputfile;
        templist : taasmoutput;
      begin
        { emit main source n_sourcefile for start of module }
        objectlibrary.getlabel(hlabel,alt_dbgfile);
        infile:=current_module.sourcefiles.get_file(1);
        templist:=taasmoutput.create;
        new_section(templist,sec_code,'',0);
        if (infile.path^<>'') then
          templist.concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+
                      ',0,0,'+hlabel.name));
        templist.concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
                    ',0,0,'+hlabel.name));
        templist.concat(tai_label.create(hlabel));
        asmlist[al_stabsstart].insertlist(templist);
        templist.free;
        { emit empty n_sourcefile for end of module }
        objectlibrary.getlabel(hlabel,alt_dbgfile);
        templist:=taasmoutput.create;
        new_section(templist,sec_code,'',0);
        templist.concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
        templist.concat(tai_label.create(hlabel));
        asmlist[al_stabsend].insertlist(templist);
        templist.free;
      end;


    procedure tdebuginfostabs.referencesections(list:taasmoutput);
      var
        hp   : tused_unit;
      begin
        { Reference all DEBUGINFO sections from the main .text section }
        if (target_info.system <> system_powerpc_macos) then
          begin
            { include reference to all debuginfo sections of used units }
            hp:=tused_unit(usedunits.first);
            while assigned(hp) do
              begin
                If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
                  list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
                hp:=tused_unit(hp.next);
              end;
            { include reference to debuginfo for this program }
            list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
          end;
      end;


    const
      dbg_stabs_info : tdbginfo =
         (
           id     : dbg_stabs;
           idtxt  : 'STABS';
         );

initialization
  RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
end.