PageRenderTime 30ms CodeModel.GetById 12ms app.highlight 12ms RepoModel.GetById 0ms app.codeStats 1ms

/compiler/dbgstabs.pas

https://github.com/slibre/freepascal
Pascal | 1886 lines | 1494 code | 168 blank | 224 comment | 164 complexity | 4aec1f01aa61b899e8efe540facbc69a MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0

Large files files are truncated, but you can click here to view the full file

   1{
   2    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
   3
   4    This units contains support for STABS debug info generation
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 2 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program; if not, write to the Free Software
  18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20 ****************************************************************************
  21}
  22unit dbgstabs;
  23
  24{$i fpcdefs.inc}
  25
  26interface
  27
  28    uses
  29      cclasses,
  30      systems,dbgbase,cgbase,
  31      symconst,symtype,symdef,symsym,symtable,symbase,
  32      aasmtai,aasmdata;
  33
  34    const
  35      { stab types }
  36      STABS_N_GSYM = $20;
  37      STABS_N_STSYM = 38;     { initialized const }
  38      STABS_N_LCSYM = 40;     { non initialized variable}
  39      STABS_N_Function = $24; { function or const }
  40      STABS_N_TextLine = $44;
  41      STABS_N_DataLine = $46;
  42      STABS_N_BssLine = $48;
  43      STABS_N_RSYM = $40;     { register variable }
  44      STABS_N_LSYM = $80;
  45      STABS_N_DECL = $8c;
  46      STABS_N_RPSYM = $8e;
  47      STABS_N_tsym = 160;
  48      STABS_N_SourceFile = $64;
  49{ APPLE LOCAL N_OSO: This is the stab that associated the .o file with the
  50   N_SO stab, in the case where debug info is mostly stored in the .o file.  }
  51      STABS_N_OSO        = $66;
  52      STABS_N_IncludeFile = $84;
  53      STABS_N_BINCL = $82;
  54      STABS_N_EINCL = $A2;
  55      STABS_N_LBRAC = $C0;
  56      STABS_N_EXCL  = $C2;
  57      STABS_N_RBRAC = $E0;
  58
  59    type
  60      TDebugInfoStabs=class(TDebugInfo)
  61      protected
  62        dbgtype: tdbg;
  63        stabsdir: TStabType;
  64        def_stab,
  65        regvar_stab,
  66        procdef_stab,
  67        constsym_stab,
  68        typesym_stab,
  69        globalvarsym_uninited_stab,
  70        globalvarsym_inited_stab,
  71        staticvarsym_uninited_stab,
  72        staticvarsym_inited_stab,
  73        localvarsymref_stab,
  74        paravarsymref_stab: byte;
  75        writing_def_stabs  : boolean;
  76        global_stab_number : word;
  77        vardatadef: trecorddef;
  78        tagtypeprefix: ansistring;
  79        { tsym writing }
  80        function  sym_var_value(const s:string;arg:pointer):string;
  81        function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
  82        procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
  83        function  staticvarsym_mangled_name(sym: tstaticvarsym):string;virtual;
  84        procedure maybe_add_vmt_sym(list:TAsmList;def: tobjectdef);virtual;
  85        { tdef writing }
  86        function  def_stab_number(def:tdef):string;
  87        function  def_stab_classnumber(def:tabstractrecorddef):string;
  88        function  def_var_value(const s:string;arg:pointer):string;
  89        function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
  90        procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);virtual;
  91        procedure field_add_stabstr(p:TObject;arg:pointer);
  92        procedure method_add_stabstr(p:TObject;arg:pointer);
  93        procedure field_write_defs(p:TObject;arg:pointer);
  94        function  get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
  95        function  get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
  96        function  base_stabs_str(typ: longint; const other, desc, value: ansistring): ansistring;overload;
  97        function  base_stabs_str(const typ, other, desc, value: ansistring): ansistring;overload;virtual;
  98        function  gen_procdef_startsym_stabs(def: tprocdef): TAsmList;virtual;
  99        function  gen_procdef_endsym_stabs(def: tprocdef): TAsmList;virtual;
 100      protected
 101        procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
 102        procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
 103        procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
 104        procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
 105        procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
 106        procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
 107        procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
 108        procedure beforeappenddef(list:TAsmList;def:tdef);override;
 109        procedure appenddef_ord(list:TAsmList;def:torddef);override;
 110        procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
 111        procedure appenddef_file(list:TAsmList;def:tfiledef);override;
 112        procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
 113        procedure appenddef_array(list:TAsmList;def:tarraydef);override;
 114        procedure appenddef_record(list:TAsmList;def:trecorddef);override;
 115        procedure appenddef_object(list:TAsmList;def:tobjectdef);override;
 116        procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
 117        procedure appenddef_string(list:TAsmList;def:tstringdef);override;
 118        procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
 119        procedure appenddef_variant(list:TAsmList;def:tvariantdef);override;
 120        procedure appenddef_set(list:TAsmList;def:tsetdef);override;
 121        procedure appenddef_formal(list:TAsmList;def:tformaldef);override;
 122        procedure appenddef_undefined(list:TAsmList;def: tundefineddef);override;
 123        procedure appendprocdef(list:TAsmList;def:tprocdef);override;
 124      public
 125        procedure inserttypeinfo;override;
 126        procedure insertmoduleinfo;override;
 127        procedure insertlineinfo(list:TAsmList);override;
 128        procedure referencesections(list:TAsmList);override;
 129
 130        constructor Create;override;
 131      end;
 132
 133
 134    function GetSymTableName(SymTable : TSymTable) : string;
 135
 136    const
 137      tagtypes = [
 138        recorddef,
 139        variantdef,
 140        enumdef,
 141        stringdef,
 142        filedef,
 143        objectdef
 144      ];
 145
 146
 147implementation
 148
 149    uses
 150      SysUtils,cutils,cfileutl,
 151      globals,globtype,verbose,constexp,
 152      defutil, cgutils, parabase,
 153      cpuinfo,cpubase,cpupi,paramgr,
 154      aasmbase,procinfo,
 155      finput,fmodule,ppu;
 156
 157
 158    const
 159      current_procdef : tprocdef = nil;
 160
 161    function GetOffsetStr(reference : TReference) : string;
 162    begin
 163{$ifdef MIPS}
 164      if (reference.index=NR_STACK_POINTER_REG) or
 165         (reference.base=NR_STACK_POINTER_REG)  then
 166        GetOffsetStr:=tostr(reference.offset
 167          - mips_extra_offset(current_procdef))
 168      else
 169{$endif MIPS}
 170      GetOffsetStr:=tostr(reference.offset);
 171    end;
 172
 173    function GetParaOffsetStr(reference : TCGParaReference) : string;
 174    begin
 175{$ifdef MIPS}
 176      if reference.index=NR_STACK_POINTER_REG then
 177        GetParaOffsetStr:=tostr(reference.offset
 178          - mips_extra_offset(current_procdef))
 179      else
 180{$endif MIPS}
 181      GetParaOffsetStr:=tostr(reference.offset);
 182    end;
 183
 184    function GetSymName(Sym : TSymEntry) : string;
 185    begin
 186      if Not (cs_stabs_preservecase in current_settings.globalswitches) then
 187        result := Sym.Name
 188      else
 189        result := Sym.RealName;
 190      if target_asm.dollarsign<>'$' then
 191        result:=ReplaceForbiddenAsmSymbolChars(result);
 192    end;
 193
 194    function GetSymTableName(SymTable : TSymTable) : string;
 195    begin
 196      if Not (cs_stabs_preservecase in current_settings.globalswitches) then
 197        result := SymTable.Name^
 198      else
 199        result := SymTable.RealName^;
 200      if target_asm.dollarsign<>'$' then
 201        result:=ReplaceForbiddenAsmSymbolChars(result);
 202    end;
 203
 204    const
 205      memsizeinc = 512;
 206
 207    type
 208       get_var_value_proc=function(const s:string;arg:pointer):string of object;
 209
 210
 211    function string_evaluate(s:string;get_var_value:get_var_value_proc;get_var_value_arg:pointer;const vars:array of string):ansistring;
 212    (*
 213     S contains a prototype of a result. Stabstr_evaluate will expand
 214     variables and parameters.
 215
 216     Output is s in ASCIIZ format, with the following expanded:
 217
 218     ${varname}   - The variable name is expanded.
 219     $n           - The parameter n is expanded.
 220     $$           - Is expanded to $
 221    *)
 222
 223    const maxvalue=9;
 224          maxdata=1023;
 225
 226    var i,j:byte;
 227        varname:string[63];
 228        varno,varcounter:byte;
 229        varvalues:array[0..9] of pshortstring;
 230        {1 kb of parameters is the limit. 256 extra bytes are allocated to
 231         ensure buffer integrity.}
 232        varvaluedata:array[0..maxdata+256] of char;
 233        varptr:Pchar;
 234        varidx : byte;
 235        len:longint;
 236        r:Pchar;
 237
 238    begin
 239      {Two pass approach, first, calculate the length and receive variables.}
 240      i:=1;
 241      len:=0;
 242      varcounter:=0;
 243      varptr:=@varvaluedata[0];
 244      while i<=length(s) do
 245        begin
 246          if (s[i]='$') and (i<length(s)) then
 247            begin
 248             if s[i+1]='$' then
 249               begin
 250                 inc(len);
 251                 inc(i);
 252               end
 253             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
 254               begin
 255                 varname:='';
 256                 inc(i,2);
 257                 repeat
 258                   inc(varname[0]);
 259                   varname[length(varname)]:=s[i];
 260                   s[i]:=char(varcounter);
 261                   inc(i);
 262                 until s[i]='}';
 263                 varvalues[varcounter]:=pshortstring(varptr);
 264                 if varptr>@varvaluedata[maxdata] then
 265                   internalerrorproc(200411152);
 266                 pshortstring(varptr)^:=get_var_value(varname,get_var_value_arg);
 267                 inc(len,length(pshortstring(varptr)^));
 268                 inc(varptr,length(pshortstring(varptr)^)+1);
 269                 inc(varcounter);
 270               end
 271             else if s[i+1] in ['1'..'9'] then
 272               begin
 273                 varidx:=byte(s[i+1])-byte('1');
 274                 if varidx>high(vars) then
 275                   internalerror(200509263);
 276                 inc(len,length(vars[varidx]));
 277                 inc(i);
 278               end;
 279            end
 280          else
 281            inc(len);
 282          inc(i);
 283        end;
 284
 285      {Second pass, writeout result.}
 286      setlength(result,len);
 287      r:=pchar(result);
 288      i:=1;
 289      while i<=length(s) do
 290        begin
 291          if (s[i]='$') and (i<length(s)) then
 292            begin
 293             if s[i+1]='$' then
 294               begin
 295                 r^:='$';
 296                 inc(r);
 297                 inc(i);
 298               end
 299             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
 300               begin
 301                 varname:='';
 302                 inc(i,2);
 303                 varno:=byte(s[i]);
 304                 repeat
 305                   inc(i);
 306                 until s[i]='}';
 307                 for j:=1 to length(varvalues[varno]^) do
 308                   begin
 309                     r^:=varvalues[varno]^[j];
 310                     inc(r);
 311                   end;
 312               end
 313             else if s[i+1] in ['0'..'9'] then
 314               begin
 315                 for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
 316                   begin
 317                     r^:=vars[byte(s[i+1])-byte('1')][j];
 318                     inc(r);
 319                   end;
 320                 inc(i);
 321               end
 322            end
 323          else
 324            begin
 325              r^:=s[i];
 326              inc(r);
 327            end;
 328          inc(i);
 329        end;
 330      { verify that the length was correct }
 331      if r^<>#0 then
 332        internalerror(200802031);
 333    end;
 334
 335
 336{****************************************************************************
 337                               TDef support
 338****************************************************************************}
 339
 340    function TDebugInfoStabs.def_stab_number(def:tdef):string;
 341      begin
 342        { procdefs only need a number, mark them as already written
 343          so they won't be written implicitly }
 344        if (def.typ=procdef) then
 345          def.dbg_state:=dbg_state_written;
 346
 347        { Stab must already be written, or we must be busy writing it }
 348        if writing_def_stabs and
 349           not(def.dbg_state in [dbg_state_writing,dbg_state_written,dbg_state_queued]) then
 350          internalerror(200403091);
 351
 352        { Keep track of used stabs, this info is only useful for stabs
 353          referenced by the symbols. Definitions will always include all
 354          required stabs }
 355        if def.dbg_state=dbg_state_unused then
 356          begin
 357            def.dbg_state:=dbg_state_used;
 358            deftowritelist.Add(def);
 359          end;
 360        { Need a new number? }
 361        if def.stab_number=0 then
 362          begin
 363            inc(global_stab_number);
 364            { classes require 2 numbers }
 365            if is_class(def) then
 366              inc(global_stab_number);
 367            def.stab_number:=global_stab_number;
 368            if global_stab_number>=defnumberlist.count then
 369              defnumberlist.count:=global_stab_number+250;
 370            defnumberlist[global_stab_number]:=def;
 371          end;
 372        result:=tostr(def.stab_number);
 373      end;
 374
 375
 376    function TDebugInfoStabs.def_stab_classnumber(def:tabstractrecorddef):string;
 377      begin
 378        if def.stab_number=0 then
 379          def_stab_number(def);
 380        if (def.typ=objectdef) and (tobjectdef(def).objecttype=odt_class) then
 381          result:=tostr(def.stab_number-1)
 382        else
 383          result:=tostr(def.stab_number);
 384      end;
 385
 386
 387    function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
 388      var
 389        def : tdef;
 390      begin
 391        def:=tdef(arg);
 392        result:='';
 393        if s='numberstring' then
 394          result:=def_stab_number(def)
 395        else if s='sym_name' then
 396          begin
 397            if assigned(def.typesym) then
 398               result:=GetSymName(Ttypesym(def.typesym));
 399          end
 400        else if s='savesize' then
 401          result:=tostr(def.size);
 402      end;
 403
 404
 405    function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
 406      begin
 407        result:=string_evaluate(s,@def_var_value,def,vars);
 408      end;
 409
 410
 411    procedure TDebugInfoStabs.field_add_stabstr(p:TObject;arg:pointer);
 412      var
 413        spec    : string[3];
 414        varsize : asizeint;
 415        newss   : ansistring;
 416        ss      : pansistring absolute arg;
 417      begin
 418        if (tsym(p).visibility=vis_hidden) then
 419          exit;
 420        { static variables from objects are like global objects }
 421        if (Tsym(p).typ=fieldvarsym) and
 422           not(sp_static in Tsym(p).symoptions) then
 423          begin
 424           case tsym(p).visibility of
 425             vis_private,
 426             vis_strictprivate :
 427               spec:='/0';
 428             vis_protected,
 429             vis_strictprotected :
 430               spec:='/1';
 431             else
 432               spec:='';
 433           end;
 434           if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
 435              begin
 436                varsize:=tfieldvarsym(p).vardef.size;
 437                { open arrays made overflows !! }
 438                { how can a record/object/class contain an open array? (JM) }
 439{$ifdef cpu16bitaddr}
 440                if varsize>$fff then
 441                  varsize:=$fff;
 442{$else cpu16bitaddr}
 443                if varsize>$fffffff then
 444                  varsize:=$fffffff;
 445{$endif cpu16bitaddr}
 446                newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
 447                                     spec+def_stab_number(tfieldvarsym(p).vardef),
 448                                     tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)])
 449              end
 450            else
 451              newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
 452                                   spec+def_stab_number(tfieldvarsym(p).vardef),
 453                                   tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)),tostr(tfieldvarsym(p).vardef.packedbitsize)]);
 454            ss^:=ss^+newss;
 455          end;
 456      end;
 457
 458
 459    procedure TDebugInfoStabs.method_add_stabstr(p:TObject;arg:pointer);
 460      var
 461        virtualind,argnames : string;
 462        pd     : tprocdef;
 463        lindex : longint;
 464        arglength : byte;
 465        sp : char;
 466        i : integer;
 467        parasym : tparavarsym;
 468        newss   : ansistring;
 469        ss      : pansistring absolute arg;
 470      begin
 471        if tsym(p).typ = procsym then
 472         begin
 473           pd :=tprocdef(tprocsym(p).ProcdefList[0]);
 474           if (po_virtualmethod in pd.procoptions) and
 475               not is_objectpascal_helper(pd.struct) then
 476             begin
 477               lindex := pd.extnumber;
 478               {doesnt seem to be necessary
 479               lindex := lindex or $80000000;}
 480               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd.struct)+';'
 481             end
 482            else
 483             virtualind := '.';
 484
 485            { used by gdbpas to recognize constructor and destructors }
 486            if (pd.proctypeoption=potype_constructor) then
 487              argnames:='__ct__'
 488            else if (pd.proctypeoption=potype_destructor) then
 489              argnames:='__dt__'
 490            else
 491              argnames := '';
 492
 493           { arguments are not listed here }
 494           {we don't need another definition}
 495            for i:=0 to pd.paras.count-1 do
 496              begin
 497                parasym:=tparavarsym(pd.paras[i]);
 498                if Parasym.vardef.typ = formaldef then
 499                  begin
 500                    case Parasym.varspez of
 501                      vs_var :
 502                        argnames := argnames+'3var';
 503                      vs_const :
 504                        argnames:=argnames+'5const';
 505                      vs_out :
 506                        argnames:=argnames+'3out';
 507                      vs_constref :
 508                        argnames:=argnames+'8constref';
 509                    end;
 510                  end
 511                else
 512                  begin
 513                    { if the arg definition is like (v: ^byte;..
 514                    there is no sym attached to data !!! }
 515                    if assigned(Parasym.vardef.typesym) then
 516                      begin
 517                        arglength := length(GetSymName(Parasym.vardef.typesym));
 518                        argnames := argnames + tostr(arglength)+GetSymName(Parasym.vardef.typesym);
 519                      end
 520                    else
 521                      argnames:=argnames+'11unnamedtype';
 522                  end;
 523              end;
 524           { here 2A must be changed for private and protected }
 525           { 0 is private 1 protected and 2 public }
 526           case tsym(p).visibility of
 527             vis_private,
 528             vis_strictprivate :
 529               sp:='0';
 530             vis_protected,
 531             vis_strictprotected :
 532               sp:='1'
 533             else
 534               sp:='2';
 535           end;
 536           newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd),
 537                                    def_stab_number(pd.returndef),argnames,sp,
 538                                    virtualind]);
 539           ss^:=ss^+newss;
 540         end;
 541      end;
 542
 543
 544    procedure TDebugInfoStabs.field_write_defs(p:TObject;arg:pointer);
 545      begin
 546        if (Tsym(p).typ=fieldvarsym) and
 547           not(sp_static in Tsym(p).symoptions) then
 548          appenddef(TAsmList(arg),tfieldvarsym(p).vardef);
 549      end;
 550
 551
 552    procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
 553      var
 554        stabchar : string[2];
 555        symname  : string[20];
 556        st    : ansistring;
 557      begin
 558        { type prefix }
 559        if def.typ in tagtypes then
 560          stabchar := tagtypeprefix
 561        else
 562          stabchar := 't';
 563        { in case of writing the class record structure, we always have to
 564          use the class name (so it refers both to the struct and the
 565          pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) }
 566        if is_class(def) and
 567           tobjectdef(def).writing_class_record_dbginfo then
 568          st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
 569        else
 570          begin
 571            { Type names for types defined in the current unit are already written in
 572              the typesym }
 573            if (def.owner.symtabletype=globalsymtable) and
 574               not(def.owner.iscurrentunit) then
 575              symname:='${sym_name}'
 576            else
 577              symname:='';
 578            st:=def_stabstr_evaluate(def,'"'+symname+':$1$2=',[stabchar,def_stab_number(def)]);
 579          end;
 580        st:=st+ss;
 581        { line info is set to 0 for all defs, because the def can be in another
 582          unit and then the linenumber is invalid in the current sourcefile }
 583        st:=st+def_stabstr_evaluate(def,'",'+base_stabs_str(def_stab,'0','0','0'),[]);
 584        { add to list }
 585        list.concat(Tai_stab.create_ansistr(stabsdir,st));
 586      end;
 587
 588
 589    procedure TDebugInfoStabs.appenddef_string(list:TAsmList;def:tstringdef);
 590      var
 591        bytest,charst,longst : string;
 592        ss : ansistring;
 593        slen : longint;
 594      begin
 595        ss:='';
 596        case def.stringtype of
 597          st_shortstring:
 598            begin
 599              { fix length of openshortstring }
 600              slen:=def.len;
 601              if slen=0 then
 602                slen:=255;
 603              charst:=def_stab_number(cansichartype);
 604              bytest:=def_stab_number(u8inttype);
 605              ss:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
 606                          [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
 607            end;
 608          st_longstring:
 609            begin
 610              charst:=def_stab_number(cansichartype);
 611              bytest:=def_stab_number(u8inttype);
 612              longst:=def_stab_number(u32inttype);
 613              ss:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
 614                          [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
 615           end;
 616         st_ansistring:
 617           begin
 618             { looks like a pchar }
 619             ss:='*'+def_stab_number(cansichartype);
 620           end;
 621         st_unicodestring,
 622         st_widestring:
 623           begin
 624             { looks like a pwidechar }
 625             ss:='*'+def_stab_number(cwidechartype);
 626           end;
 627        end;
 628        write_def_stabstr(list,def,ss);
 629      end;
 630
 631
 632    function TDebugInfoStabs.get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
 633      var
 634        i: longint;
 635        p: tenumsym;
 636      begin
 637        { we can specify the size with @s<size>; prefix PM }
 638        if def.size <> std_param_align then
 639          result:='@s'+tostr(def.size*8)+';e'
 640        else
 641          result:='e';
 642        { the if-test is required because pred(def.minval) might overflow;
 643          the longint() typecast should be safe because stabs is not
 644          supported for 64 bit targets }
 645        if (def.minval<>lowerbound) then
 646          for i:=lowerbound to pred(longint(def.minval)) do
 647            result:=result+'<invalid>:'+tostr(i)+',';
 648
 649        for i := 0 to def.symtable.SymList.Count - 1 do
 650          begin
 651            p := tenumsym(def.symtable.SymList[i]);
 652            if p.value<def.minval then
 653              continue
 654            else
 655            if p.value>def.maxval then
 656              break;
 657            result:=result+GetSymName(p)+':'+tostr(p.value)+',';
 658          end;
 659        { the final ',' is required to have a valid stabs }
 660        result:=result+';';
 661      end;
 662
 663    procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
 664      begin
 665        write_def_stabstr(list,def,get_enum_defstr(def,def.minval));
 666      end;
 667
 668
 669    procedure TDebugInfoStabs.appenddef_ord(list:TAsmList;def:torddef);
 670      var
 671        ss : ansistring;
 672      begin
 673        ss:='';
 674        if cs_gdb_valgrind in current_settings.globalswitches then
 675          begin
 676            case def.ordtype of
 677              uvoid :
 678                ss:=def_stab_number(def);
 679              pasbool8,
 680              pasbool16,
 681              pasbool32,
 682              pasbool64,
 683              bool8bit,
 684              bool16bit,
 685              bool32bit,
 686              bool64bit :
 687                ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
 688              u32bit,
 689              s64bit,
 690              u64bit :
 691                ss:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
 692              else
 693                ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
 694            end;
 695          end
 696        else
 697          begin
 698            case def.ordtype of
 699              uvoid :
 700                ss:=def_stab_number(def);
 701              uchar :
 702                ss:='-20;';
 703              uwidechar :
 704                ss:='-30;';
 705              pasbool8,
 706              bool8bit :
 707                ss:='-21;';
 708              pasbool16,
 709              bool16bit :
 710                ss:='-22;';
 711              pasbool32,
 712              bool32bit :
 713                ss:='-23;';
 714              pasbool64,
 715              bool64bit :
 716                { no clue if this is correct (FK) }
 717                ss:='-23;';
 718              u64bit :
 719                ss:='-32;';
 720              s64bit :
 721                ss:='-31;';
 722              {u32bit : result:=def_stab_number(s32inttype)+';0;-1;'); }
 723              else
 724                begin
 725                  if def.size <> std_param_align then
 726                    ss:='@s'+tostr(def.size*8)+';'
 727                  else
 728                    ss:='';
 729                  ss:=ss+def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
 730                end;
 731            end;
 732         end;
 733        write_def_stabstr(list,def,ss);
 734      end;
 735
 736
 737    procedure TDebugInfoStabs.appenddef_float(list:TAsmList;def:tfloatdef);
 738      var
 739        ss : ansistring;
 740      begin
 741        ss:='';
 742        case def.floattype of
 743          s32real,
 744          s64real,
 745          s80real,
 746          sc80real:
 747            ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
 748          s64currency,
 749          s64comp:
 750            ss:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype)]);
 751          else
 752            internalerror(200509261);
 753        end;
 754        write_def_stabstr(list,def,ss);
 755      end;
 756
 757
 758    procedure TDebugInfoStabs.appenddef_file(list:TAsmList;def:tfiledef);
 759      var
 760        ss : ansistring;
 761      begin
 762{$ifdef cpu64bitaddr}
 763        ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
 764                                 '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;32;$3,384,256;'+
 765                                 'NAME:ar$1;0;255;$4,640,2048;;',[def_stab_number(s32inttype),
 766                                 def_stab_number(s64inttype),
 767                                 def_stab_number(u8inttype),
 768                                 def_stab_number(cansichartype)]);
 769{$else cpu64bitaddr}
 770        ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
 771                                 '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;32;$2,352,256;'+
 772                                 'NAME:ar$1;0;255;$3,608,2048;;',[def_stab_number(s32inttype),
 773                                 def_stab_number(u8inttype),
 774                                 def_stab_number(cansichartype)]);
 775{$endif cpu64bitaddr}
 776        write_def_stabstr(list,def,ss);
 777      end;
 778
 779
 780    procedure TDebugInfoStabs.appenddef_record(list:TAsmList;def:trecorddef);
 781      var
 782        ss : ansistring;
 783      begin
 784        ss:='s'+tostr(def.size);
 785        def.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
 786        ss[length(ss)]:=';';
 787        write_def_stabstr(list,def,ss);
 788      end;
 789
 790
 791    procedure TDebugInfoStabs.appenddef_object(list:TAsmList;def:tobjectdef);
 792
 793        procedure do_write_object(list:TAsmList;def:tobjectdef);
 794        var
 795          ss : ansistring;
 796          anc    : tobjectdef;
 797        begin
 798          ss:='';
 799          { Write the invisible pointer for the class? }
 800          if (def.objecttype=odt_class) and
 801             (not def.writing_class_record_dbginfo) then
 802            begin
 803              ss:='*'+def_stab_classnumber(def);
 804              write_def_stabstr(list,def,ss);
 805              exit;
 806            end;
 807
 808          ss:='s'+tostr(tobjecTSymtable(def.symtable).datasize);
 809          if assigned(def.childof) then
 810            begin
 811              {only one ancestor not virtual, public, at base offset 0 }
 812              {       !1           ,    0       2         0    ,       }
 813              ss:=ss+'!1,020,'+def_stab_classnumber(def.childof)+';';
 814            end;
 815
 816          {virtual table to implement yet}
 817          def.symtable.symList.ForEachCall(@field_add_stabstr,@ss);
 818
 819          if (oo_has_vmt in def.objectoptions) and
 820             (
 821              not assigned(def.childof) or
 822              not(oo_has_vmt in def.childof.objectoptions)
 823             ) then
 824            ss:=ss+'$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype)+','+tostr(def.vmt_offset*8)+';';
 825          def.symtable.symList.ForEachCall(@method_add_stabstr,@ss);
 826          if (oo_has_vmt in def.objectoptions) then
 827            begin
 828               anc := def;
 829               while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
 830                 anc := anc.childof;
 831               { just in case anc = self }
 832               ss:=ss+';~%'+def_stab_classnumber(anc)+';';
 833            end
 834          else
 835            ss:=ss+';';
 836          write_def_stabstr(list,def,ss);
 837        end;
 838
 839      var
 840        oldtypesym : tsym;
 841      begin
 842        tobjectdef(def).symtable.symList.ForEachCall(@field_write_defs,list);
 843        { classes require special code to write the record and the invisible pointer }
 844        if is_class(def) then
 845          begin
 846            { Write the record class itself }
 847            tobjectdef(def).writing_class_record_dbginfo:=true;
 848            do_write_object(list,def);
 849            tobjectdef(def).writing_class_record_dbginfo:=false;
 850            { Write the invisible pointer class }
 851            oldtypesym:=def.typesym;
 852            def.typesym:=nil;
 853            do_write_object(list,def);
 854            def.typesym:=oldtypesym;
 855          end
 856        else
 857          do_write_object(list,def);
 858        { VMT symbol }
 859        maybe_add_vmt_sym(list,def);
 860      end;
 861
 862
 863    procedure TDebugInfoStabs.appenddef_variant(list:TAsmList;def:tvariantdef);
 864      var
 865        ss : ansistring;
 866      begin
 867        if not assigned(vardatadef) then
 868          exit;
 869
 870        ss:='s'+tostr(vardatadef.size);
 871        vardatadef.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
 872        ss[length(ss)]:=';';
 873        write_def_stabstr(list,def,ss);
 874      end;
 875
 876
 877    procedure TDebugInfoStabs.appenddef_pointer(list:TAsmList;def:tpointerdef);
 878      var
 879        ss : ansistring;
 880      begin
 881        ss:='*'+def_stab_number(tpointerdef(def).pointeddef);
 882        write_def_stabstr(list,def,ss);
 883      end;
 884
 885
 886    procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef);
 887      var
 888        st,
 889        ss : ansistring;
 890        elementdefstabnr: string;
 891      begin
 892        { ugly hack: create a temporary subrange type if the lower bound of
 893          the set's element type is not a multiple of 8 (because we store them
 894          as if the lower bound is a multiple of 8) }
 895        if (def.setbase<>get_min_value(def.elementdef)) then
 896          begin
 897            { allocate a def number }
 898            inc(global_stab_number);
 899            elementdefstabnr:=tostr(global_stab_number);
 900            { anonymous subrange def }
 901            st:='":t'+elementdefstabnr+'=';
 902            if (def.elementdef.typ = enumdef) then
 903              st:=st+get_enum_defstr(tenumdef(def.elementdef),def.setbase)
 904            else
 905              st:=st+def_stabstr_evaluate(def.elementdef,'r'+elementdefstabnr+';$1;$2;',[tostr(longint(def.setbase)),tostr(longint(get_max_value(def.elementdef).svalue))]);
 906            st:=st+'",'+base_stabs_str(def_stab,'0','0','0');
 907            { add to list }
 908            list.concat(Tai_stab.create_ansistr(stabsdir,st));
 909          end
 910        else
 911          elementdefstabnr:=def_stab_number(def.elementdef);
 912        ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),elementdefstabnr]);
 913        write_def_stabstr(list,def,ss);
 914      end;
 915
 916
 917    procedure TDebugInfoStabs.appenddef_formal(list:TAsmList;def:tformaldef);
 918      var
 919        ss : ansistring;
 920      begin
 921        ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
 922        write_def_stabstr(list,def,ss);
 923      end;
 924
 925
 926    procedure TDebugInfoStabs.appenddef_array(list:TAsmList;def:tarraydef);
 927      var
 928        tempstr: shortstring;
 929        ss : ansistring;
 930      begin
 931        if not is_packed_array(def) then
 932          begin
 933            { Try to used P if ememlent size is smaller than
 934              usual integer }
 935            if def.elesize <> std_param_align then
 936              tempstr:='ar@s'+tostr(def.elesize*8)+';$1;$2;$3;$4'
 937            else
 938              tempstr:='ar$1;$2;$3;$4';
 939            if is_dynamic_array(def) then
 940              tempstr:='*'+tempstr;
 941            ss:=def_stabstr_evaluate(def,tempstr,[def_stab_number(tarraydef(def).rangedef),
 942                     tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)])
 943          end
 944        else
 945          begin
 946            // the @P seems to be ignored by gdb
 947            tempstr:=def_stabstr_evaluate(tarraydef(def).rangedef,'r${numberstring};$1;$2;',
 948              [tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange)]);
 949            // will only show highrange-lowrange+1 bits in gdb
 950            ss:=def_stabstr_evaluate(def,'@s$1;@S;S$2',
 951              [tostr(TConstExprInt(tarraydef(def).elepackedbitsize) * tarraydef(def).elecount),tempstr]);
 952          end;
 953        write_def_stabstr(list,def,ss);
 954      end;
 955
 956
 957    procedure TDebugInfoStabs.appenddef_procvar(list:TAsmList;def:tprocvardef);
 958      var
 959        ss : ansistring;
 960      begin
 961        ss:='*f'+def_stab_number(tprocvardef(def).returndef);
 962        write_def_stabstr(list,def,ss);
 963      end;
 964
 965
 966    procedure TDebugInfoStabs.appenddef_undefined(list:TAsmList;def:tundefineddef);
 967      var
 968        ss : ansistring;
 969      begin
 970        ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
 971        write_def_stabstr(list,def,ss);
 972      end;
 973
 974
 975    procedure TDebugInfoStabs.beforeappenddef(list:TAsmList;def:tdef);
 976      var
 977        anc : tobjectdef;
 978        i : longint;
 979      begin
 980        { write dependencies first }
 981        case def.typ of
 982          stringdef :
 983            begin
 984              if tstringdef(def).stringtype in [st_widestring,st_unicodestring] then
 985                appenddef(list,cwidechartype)
 986              else
 987                begin
 988                  appenddef(list,cansichartype);
 989                  appenddef(list,u8inttype);
 990                end;
 991            end;
 992          floatdef :
 993            appenddef(list,s32inttype);
 994          filedef :
 995            begin
 996              appenddef(list,s32inttype);
 997{$ifdef cpu64bitaddr}
 998              appenddef(list,s64inttype);
 999{$endif cpu64bitaddr}
1000              appenddef(list,u8inttype);
1001              appenddef(list,cansichartype);
1002            end;
1003          classrefdef :
1004            appenddef(list,pvmttype);
1005          pointerdef :
1006            appenddef(list,tpointerdef(def).pointeddef);
1007          setdef :
1008            appenddef(list,tsetdef(def).elementdef);
1009          procvardef :
1010            begin
1011              appenddef(list,tprocvardef(def).returndef);
1012              if assigned(tprocvardef(def).parast) then
1013                write_symtable_defs(list,tprocvardef(def).parast);
1014            end;
1015          procdef :
1016            begin
1017              appenddef(list,tprocdef(def).returndef);
1018              if assigned(tprocdef(def).parast) then
1019                write_symtable_defs(list,tprocdef(def).parast);
1020              if assigned(tprocdef(def).localst) and
1021                 (tprocdef(def).localst.symtabletype=localsymtable) then
1022                write_symtable_defs(list,tprocdef(def).localst);
1023            end;
1024          arraydef :
1025            begin
1026              appenddef(list,tarraydef(def).rangedef);
1027              appenddef(list,tarraydef(def).elementdef);
1028            end;
1029          recorddef :
1030            trecorddef(def).symtable.symList.ForEachCall(@field_write_defs,list);
1031          enumdef :
1032            if assigned(tenumdef(def).basedef) then
1033              appenddef(list,tenumdef(def).basedef);
1034          objectdef :
1035            begin
1036              { make sure we don't write child classdefs before their parent }
1037              { classdefs, because this crashes gdb                          }
1038              anc:=tobjectdef(def);
1039              while assigned(anc.childof) do
1040                begin
1041                  anc:=anc.childof;
1042                  case anc.dbg_state of
1043                    dbg_state_writing:
1044                      { happens in case a field of a parent is of the (forward
1045                        defined) child type
1046                      }
1047                      begin
1048                        { We don't explicitly requeue it, but the fact that
1049                          a child type was used in a parent before the child
1050                          type was fully defined means that it was forward
1051                          declared, and will still be encountered later.
1052                          Setting the state to queued however allows us to
1053                          get the def number already without an IE
1054                        }
1055                        def.dbg_state:=dbg_state_queued;
1056                        break;
1057                      end;
1058                  end;
1059                end;
1060              appenddef(list,vmtarraytype);
1061              if assigned(tobjectdef(def).ImplementedInterfaces) then
1062                for i:=0 to tobjectdef(def).ImplementedInterfaces.Count-1 do
1063                  appenddef(list,TImplementedInterface(tobjectdef(def).ImplementedInterfaces[i]).IntfDef);
1064              { first the parents }
1065              anc:=tobjectdef(def);
1066              while assigned(anc.childof) do
1067                begin
1068                  anc:=anc.childof;
1069                  { in case this is an object family declared in another unit
1070                    that was compiled without debug info, this ancestor may not
1071                    yet have a stabs number and not yet be added to defstowrite
1072                    -> take care of that now, while its dbg_state is still
1073                    dbg_state_unused in case the aforementioned things haven't
1074                    happened yet (afterwards it will become dbg_state_writing,
1075                    and then def_stab_number() won't do anything anymore because
1076                    it assumes it's already happened
1077                  }
1078                  def_stab_number(anc);
1079                  appenddef(list,anc);
1080                  if assigned(anc.ImplementedInterfaces) then
1081                    for i:=0 to anc.ImplementedInterfaces.Count-1 do
1082                      appenddef(list,TImplementedInterface(anc.ImplementedInterfaces[i]).IntfDef);
1083                end;
1084            end;
1085        end;
1086      end;
1087
1088
1089    procedure TDebugInfoStabs.appendprocdef(list:TAsmList;def:tprocdef);
1090      var
1091        hs : ansistring;
1092        templist : TAsmList;
1093        prev_procdef : tprocdef;
1094      begin
1095        if not(def.in_currentunit) or
1096           { happens for init procdef of units without init section }
1097           not assigned(def.procstarttai) then
1098          exit;
1099
1100        { mark as used so the local type defs also be written }
1101        def.dbg_state:=dbg_state_used;
1102        prev_procdef:=current_procdef;
1103        current_procdef:=def;
1104
1105        templist:=gen_procdef_endsym_stabs(def);
1106        current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist);
1107
1108        { FUNC stabs }
1109        templist.free;
1110        templist:=gen_procdef_startsym_stabs(def);
1111        current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
1112
1113        { para types }
1114        if assigned(def.parast) then
1115          write_symtable_syms(templist,def.parast);
1116        { local type defs and vars should not be written
1117          inside the main proc stab }
1118        if assigned(def.localst) and
1119           (def.localst.symtabletype=localsymtable) then
1120          write_symtable_syms(templist,def.localst);
1121
1122        if assigned(def.funcretsym) and
1123           (tabstractnormalvarsym(def.funcretsym).refs>0) then
1124          begin
1125            if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then
1126              begin
1127{ TODO: Need to add gdb support for ret in param register calling}
1128                if paramanager.ret_in_param(def.returndef,def) then
1129                  hs:='X*'
1130                else
1131                  hs:='X';
1132                templist.concat(Tai_stab.create(stabsdir,strpnew(
1133                   '"'+GetSymName(def.procsym)+':'+hs+def_stab_number(def.returndef)+'",'+
1134                   base_stabs_str(localvarsymref_stab,'0','0',getoffsetstr(tabstractnormalvarsym(def.funcretsym).localloc.reference)))));
1135                if (m_result in current_settings.modeswitches) then
1136                  templist.concat(Tai_stab.create(stabsdir,strpnew(
1137                     '"RESULT:'+hs+def_stab_number(def.returndef)+'",'+
1138                     base_stabs_str(localvarsymref_stab,'0','0',getoffsetstr(tabstractnormalvarsym(def.funcretsym).localloc.reference)))));
1139              end;
1140          end;
1141
1142
1143        current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
1144
1145        templist.free;
1146        current_procdef:=prev_procdef;
1147      end;
1148
1149
1150{****************************************************************************
1151                               TSym support
1152****************************************************************************}
1153
1154    function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
1155      var
1156        sym : tsym absolute arg;
1157      begin
1158        result:='';
1159        if s='name' then
1160          result:=GetSymName(sym)
1161        else if s='mangledname' then
1162          result:=ReplaceForbiddenAsmSymbolChars(sym.mangledname)
1163        else if s='ownername' then
1164          result:=GetSymTableName(sym.owner)
1165        else if s='line' then
1166          result:=tostr(sym.fileinfo.line)
1167        else
1168          internalerror(200401152);
1169      end;
1170
1171
1172    function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
1173      begin
1174        result:=string_evaluate(s,@sym_var_value,sym,vars);
1175      end;
1176
1177
1178    procedure TDebugInfoStabs.write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
1179      begin
1180        if ss='' then
1181          exit;
1182        { add to list }
1183        list.concat(Tai_stab.create_ansistr(stabsdir,ss));
1184      end;
1185
1186
1187    function TDebugInfoStabs.staticvarsym_mangled_name(sym: tstaticvarsym): string;
1188      begin
1189        result:=ReplaceForbiddenAsmSymbolChars(sym.mangledname);
1190      end;
1191
1192
1193    procedure TDebugInfoStabs.maybe_add_vmt_sym(list: TAsmList; def: tobjectdef);
1194      begin
1195        if (oo_has_vmt in def.objectoptions) and
1196           assigned(def.owner) and
1197           assigned(def.owner.name) then
1198          list.concat(Tai_stab.create_ansistr(stabsdir,ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
1199                 def_stab_number(vmttype)+'",'+
1200                 base_stabs_str(globalvarsym_inited_stab,'0','0',ReplaceForbiddenAsmSymbolChars(tobjectdef(def).vmt_mangledname))));
1201      end;
1202
1203
1204    procedure TDebugInfoStabs.appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);
1205      var
1206        ss : ansistring;
1207      begin
1208        ss:='';
1209        if (sym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
1210           (sp_static in sym.symoptions) then
1211          ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",'+base_stabs_str(globalvarsym_uninited_stab,'0','${line}','${mangledname}'),
1212              [def_stab_number(sym.vardef)]);
1213        write_sym_stabstr(list,sym,ss);
1214      end;
1215
1216
1217    procedure TDebugInfoStabs.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
1218      var
1219        ss : ansistring;
1220        st : string;
1221        threadvaroffset : string;
1222        regidx : Tregisterindex;
1223        nsym : byte;
1224      begin
1225        { external symbols can't be resolved at link time, so we
1226          can't generate stabs for them }
1227        if vo_is_external in sym.varoptions then
1228          exit;
1229        ss:='';
1230        st:=def_stab_number(sym.vardef);
1231        case sym.localloc.loc of
1232          LOC_REGISTER,
1233          LOC_CREGISTER,
1234          LOC_MMREGISTER,
1235          LOC_CMMREGISTER,
1236          LOC_FPUREGISTER,
1237          LOC_CFPUREGISTER :
1238            begin
1239              regidx:=findreg_by_number(sym.localloc.register);
1240              { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
1241              { this is the register order for GDB}
1242              if regidx<>0 then
1243                ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[st,tostr(regstabs_table[regidx])]);
1244            end;
1245          else
1246            begin
1247              if (vo_is_thread_var in sym.varoptions) then
1248                threadvaroffset:='+'+tostr(sizeof(pint))
1249              else
1250                threadvaroffset:='';
1251              if (vo_is_typed_const in sym.varoptions) then
1252                if vo_is_public in sym.varoptions then
1253                  nsym:=globalvarsym_inited_stab
1254                else
1255                  nsym:=staticvarsym_inited_stab
1256              else if vo_is_public in sym.varoptions then
1257                nsym:=globalvarsym_uninited_stab
1258              else
1259                nsym:=staticvarsym_uninited_stab;
1260              { Here we used S instead of
1261                because with G GDB doesn't look at the address field
1262                but searches the same name or with a leading underscore
1263                but these names don't exist in pascal !}
1264              st:='S'+st;
1265              ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(nsym,'0','${line}','$2$3'),[st,staticvarsym_mangled_name(sym),threadvaroffset]);
1266            end;
1267        end;
1268        write_sym_stabstr(list,sym,ss);
1269      end;
1270
1271
1272    procedure TDebugInfoStabs.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
1273      var
1274        ss : ansistring;
1275        st : string;
1276        regidx : Tregisterindex;
1277      begin
1278        { There is no space allocated for not referenced locals }
1279        if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
1280          exit;
1281
1282        ss:='';
1283        st:=def_stab_number(sym.vardef);
1284        case sym.localloc.loc of
1285          LOC_REGISTER,
1286          LOC_CREGISTER,
1287          LOC_MMREGISTER,
1288          LOC_CMMREGISTER,
1289          LOC_FPUREGISTER,
1290          LOC_CFPUREGISTER :
1291            begin
1292              regidx:=findreg_by_number(sym.localloc.register);
1293              { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
1294              { this is the register order for GDB}
1295              if regidx<>0 then
1296                ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[st,tostr(regstabs_table[regidx])]);
1297            end;
1298          LOC_REFERENCE :
1299            { offset to ebp => will not work if the framepointer is esp
1300              so some optimizing will make things harder to debug }
1301            ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(localvarsymref_stab,'0','${line}','$2'),[st,getoffsetstr(sym.localloc.reference)])
1302          else
1303            internalerror(2003091814);
1304        end;
1305        write_sym_stabstr(list,sym,ss);
1306      end;
1307
1308
1309    function TDebugInfoStabs.get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
1310      var
1311        ltyp: string[1];
1312        regidx : Tregisterindex;
1313      begin
1314        result:='';
1315        if typ='p' then
1316          ltyp:='R'
1317        else
1318          ltyp:='a';
1319        regidx:=findreg_by_number(reg);
1320        { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
1321        { this is the register order for GDB}
1322        if regidx<>0 then
1323          result:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(regvar_stab,'0','${line}','$2'),[ltyp+stabstr,tostr(longint(regstabs_table[regidx]))]);
1324      end;
1325
1326
1327    function TDebugInfoStabs.base_stabs_str(typ: longint; const other, desc, value: ansistring): ansistring;
1328      begin
1329        result:=base_stabs_str(tostr(typ),other,desc,value);
1330      end;
1331
1332
1333    function TDebugInfoStabs.base_stabs_str(const typ, other, desc, value: ansistring): ansistring;
1334      begin
1335        result:=typ+','+other+','+desc+','+value
1336      end;
1337
1338
1339    function TDebugInfoStabs.gen_procdef_startsym_stabs(def: tprocdef): TAsmList;
1340      var
1341        RType : Char;
1342        Obj,Info,
1343        mangledname: ansistring;
1344      begin
1345        result:=TAsmList.create;
1346        { "The stab representing a procedure is located immediately
1347          following the code of the procedure. This stab is in turn
1348          directly followed by a group of other stabs describing
1349

Large files files are truncated, but you can click here to view the full file