/compiler/dbgstabs.pas
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
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 elements of the procedure. These other stabs describe the
1350 procedure's parameters, its block local variables, and its
1351 block structure." (stab docs) }
1352 { this is however incorrect in case "include source" statements }
1353 { appear in the block, in that case the procedure stab must }
1354 { appear before this include stabs (and we generate such an }
1355 { stabs for all functions) (JM) }
1356
1357 obj := GetSymName(def.procsym);
1358 info := '';
1359 if (po_global in def.procoptions) then
1360 RType := 'F'
1361 else
1362 RType := 'f';
1363 if assigned(def.owner) then
1364 begin
1365 if (def.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
1366 obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
1367 if not(cs_gdb_valgrind in current_settings.globalswitches) and
1368 (def.owner.symtabletype=localsymtable) and
1369 assigned(def.owner.defowner) and
1370 assigned(tprocdef(def.owner.defowner).procsym) then
1371 info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
1372 end;
1373 mangledname:=ReplaceForbiddenAsmSymbolChars(def.mangledname);
1374 if target_info.system in systems_dotted_function_names then
1375 mangledname:='.'+mangledname;
1376 result.concat(Tai_stab.Create_ansistr(stabsdir,'"'+obj+':'+RType+def_stab_number(def.returndef)+info+'",'+
1377 base_stabs_str(procdef_stab,'0',tostr(def.fileinfo.line),mangledname)));
1378 end;
1379
1380
1381 function TDebugInfoStabs.gen_procdef_endsym_stabs(def: tprocdef): TAsmList;
1382 var
1383 ss, mangledname: ansistring;
1384 stabsendlabel: tasmlabel;
1385 begin
1386 result:=TAsmList.create;
1387
1388 { end of procedure }
1389 current_asmdata.getlabel(stabsendlabel,alt_dbgtype);
1390
1391 if dbgtype<>dbg_stabx then
1392 begin
1393 mangledname:=def.mangledname;
1394 if target_info.system in systems_dotted_function_names then
1395 mangledname:='.'+mangledname;
1396 // LBRAC
1397 ss:=tostr(STABS_N_LBRAC)+',0,0,'+mangledname;
1398 if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
1399 begin
1400 ss:=ss+'-';
1401 ss:=ss+mangledname;
1402 end;
1403 result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
1404 // RBRAC
1405 ss:=tostr(STABS_N_RBRAC)+',0,0,'+stabsendlabel.name;
1406 if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
1407 begin
1408 ss:=ss+'-';
1409 ss:=ss+mangledname;
1410 end;
1411 result.concat(Tai_stab.Create_ansistr(stab_stabn,ss));
1412
1413 { the stabsendlabel must come after all other stabs for this }
1414 { function }
1415 result.concat(tai_label.create(stabsendlabel));
1416
1417 { Add a "size" stab as described in the last paragraph of 2.5 at }
1418 { http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 }
1419 { This works at least on Darwin (and is needed on Darwin to get }
1420 { correct smartlinking of stabs), but I don't know which binutils }
1421 { version is required on other platforms }
1422 { This stab must come after all other stabs for the procedure, }
1423 { including the LBRAC/RBRAC ones }
1424 if (target_info.system in systems_darwin) then
1425 result.concat(Tai_stab.create(stabsdir,
1426 strpnew('"",'+base_stabs_str(procdef_stab,'0','0',stabsendlabel.name+'-'+mangledname))));
1427 end;
1428 end;
1429
1430
1431 procedure TDebugInfoStabs.appendsym_paravar(list:TAsmList;sym:tparavarsym);
1432 var
1433 ss : ansistring;
1434 c : string[1];
1435 st : string;
1436 regidx : Tregisterindex;
1437 begin
1438 ss:='';
1439 { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
1440 { while stabs aren't adapted for regvars yet }
1441 if (vo_is_self in sym.varoptions) then
1442 begin
1443 case sym.localloc.loc of
1444 LOC_REGISTER,
1445 LOC_CREGISTER:
1446 regidx:=findreg_by_number(sym.localloc.register);
1447 LOC_REFERENCE: ;
1448 else
1449 internalerror(2003091815);
1450 end;
1451 if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or
1452 (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
1453 begin
1454 if (sym.localloc.loc=LOC_REFERENCE) then
1455 ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",'+base_stabs_str(localvarsymref_stab,'0','0','$2'),
1456 [def_stab_number(pvmttype),getoffsetstr(sym.localloc.reference)])
1457 else
1458 begin
1459 regidx:=findreg_by_number(sym.localloc.register);
1460 ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",'+base_stabs_str(regvar_stab,'0','0','$2'),
1461 [def_stab_number(pvmttype),tostr(regstabs_table[regidx])]);
1462 end
1463 end
1464 else
1465 begin
1466 if not(is_class(tprocdef(sym.owner.defowner).struct)) then
1467 c:='v'
1468 else
1469 c:='p';
1470 if (sym.localloc.loc=LOC_REFERENCE) then
1471 ss:=sym_stabstr_evaluate(sym,'"$$t:$1",'+base_stabs_str(localvarsymref_stab,'0','0','$2'),
1472 [c+def_stab_number(tprocdef(sym.owner.defowner).struct),getoffsetstr(sym.localloc.reference)])
1473 else
1474 begin
1475 if (c='p') then
1476 c:='R'
1477 else
1478 c:='a';
1479 regidx:=findreg_by_number(sym.localloc.register);
1480 ss:=sym_stabstr_evaluate(sym,'"$$t:$1",'+base_stabs_str(regvar_stab,'0','0','$2'),
1481 [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(regstabs_table[regidx])]);
1482 end
1483 end;
1484 end
1485 else
1486 begin
1487 st:=def_stab_number(sym.vardef);
1488
1489 if paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
1490 not(vo_has_local_copy in sym.varoptions) and
1491 not is_open_string(sym.vardef) then
1492 c:='v' { should be 'i' but 'i' doesn't work }
1493 else
1494 c:='p';
1495 case sym.localloc.loc of
1496 LOC_REGISTER,
1497 LOC_CREGISTER,
1498 LOC_MMREGISTER,
1499 LOC_CMMREGISTER,
1500 LOC_FPUREGISTER,
1501 LOC_CFPUREGISTER :
1502 begin
1503 ss:=get_appendsym_paravar_reg(sym,c,st,sym.localloc.register);
1504 end;
1505 LOC_REFERENCE :
1506 begin
1507 { When the *value* of a parameter (so not its address!) is
1508 copied into a local variable, you have to generate two
1509 stabs: one for the parmeter, and one for the local copy.
1510 Not doing this breaks debugging under e.g. SPARC. Doc:
1511 http://sourceware.org/gdb/current/onlinedocs/stabs_4.html#SEC26
1512 }
1513 if (target_dbg.id<>dbg_stabx) and
1514 (c='p') and
1515 not is_open_string(sym.vardef) and
1516 ((sym.paraloc[calleeside].location^.loc<>sym.localloc.loc) or
1517 ((sym.localloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
1518 ((sym.paraloc[calleeside].location^.reference.index<>sym.localloc.reference.base) or
1519 (sym.paraloc[calleeside].location^.reference.offset<>sym.localloc.reference.offset))) or
1520 ((sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
1521 (sym.localloc.register<>sym.paraloc[calleeside].location^.register))) then
1522 begin
1523 if not(sym.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
1524 ss:=get_appendsym_paravar_reg(sym,c,st,sym.paraloc[calleeside].location^.register)
1525 else
1526 ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(localvarsymref_stab,'0','${line}','$2'),
1527 [c+st,getparaoffsetstr(sym.paraloc[calleeside].location^.reference)]);
1528 write_sym_stabstr(list,sym,ss);
1529 { second stab has no parameter specifier }
1530 c:='';
1531 end;
1532 { offset to ebp => will not work if the framepointer is esp
1533 so some optimizing will make things harder to debug }
1534 ss:=sym_stabstr_evaluate(sym,'"${name}:$1",'+base_stabs_str(paravarsymref_stab,'0','${line}','$2'),[c+st,getoffsetstr(sym.localloc.reference)])
1535 end;
1536 else
1537 internalerror(2003091814);
1538 end;
1539 end;
1540 write_sym_stabstr(list,sym,ss);
1541 end;
1542
1543
1544 function stabx_quote_const(const s: string): string;
1545 var
1546 i:byte;
1547 begin
1548 stabx_quote_const:='';
1549 for i:=1 to length(s) do
1550 begin
1551 case s[i] of
1552 #10:
1553 stabx_quote_const:=stabx_quote_const+'\n';
1554 #13:
1555 stabx_quote_const:=stabx_quote_const+'\r';
1556 { stabx strings cannot deal with embedded quotes }
1557 '"':
1558 stabx_quote_const:=stabx_quote_const+' ';
1559 else
1560 stabx_quote_const:=stabx_quote_const+s[i];
1561 end;
1562 end;
1563 end;
1564
1565
1566 procedure TDebugInfoStabs.appendsym_const(list:TAsmList;sym:tconstsym);
1567 var
1568 st : string;
1569 ss : ansistring;
1570 begin
1571 ss:='';
1572 { Don't write info for default parameter values, the N_Func breaks
1573 the N_Func for the function itself.
1574 Valgrind does not support constants }
1575 if (sym.owner.symtabletype=parasymtable) or
1576 (cs_gdb_valgrind in current_settings.globalswitches) then
1577 exit;
1578 case sym.consttyp of
1579 conststring:
1580 begin
1581 if sym.value.len<200 then
1582 if target_dbg.id=dbg_stabs then
1583 st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
1584 else
1585 st:='s'''+stabx_quote_const(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']))
1586 else
1587 st:='<constant string too long>';
1588 end;
1589 constord:
1590 st:='i'+tostr(sym.value.valueord);
1591 constpointer:
1592 st:='i'+tostr(sym.value.valueordptr);
1593 constreal:
1594 begin
1595 system.str(pbestreal(sym.value.valueptr)^,st);
1596 st := 'r'+st;
1597 end;
1598 else
1599 begin
1600 { if we don't know just put zero !! }
1601 st:='i0';
1602 end;
1603 end;
1604 ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",'+base_stabs_str(constsym_stab,'0','${line}','0'),[st]);
1605 write_sym_stabstr(list,sym,ss);
1606 end;
1607
1608
1609 procedure TDebugInfoStabs.appendsym_type(list:TAsmList;sym:ttypesym);
1610 var
1611 ss : ansistring;
1612 stabchar : string[2];
1613 begin
1614 ss:='';
1615 if not assigned(sym.typedef) then
1616 internalerror(200509262);
1617 if sym.typedef.typ in tagtypes then
1618 stabchar:=tagtypeprefix
1619 else
1620 stabchar:='t';
1621 ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",'+base_stabs_str(typesym_stab,'0','${line}','0'),[stabchar,def_stab_number(sym.typedef)]);
1622 write_sym_stabstr(list,sym,ss);
1623 end;
1624
1625
1626 procedure TDebugInfoStabs.appendsym_label(list:TAsmList;sym:tlabelsym);
1627 var
1628 ss : ansistring;
1629 begin
1630 ss:=sym_stabstr_evaluate(sym,'"${name}",'+base_stabs_str(localvarsymref_stab,'0','${line}','0'),[]);
1631 write_sym_stabstr(list,sym,ss);
1632 end;
1633
1634
1635{****************************************************************************
1636 Proc/Module support
1637****************************************************************************}
1638
1639 procedure TDebugInfoStabs.inserttypeinfo;
1640 var
1641 stabsvarlist,
1642 stabstypelist : TAsmList;
1643 storefilepos : tfileposinfo;
1644 i : longint;
1645 vardatatype : ttypesym;
1646 begin
1647 storefilepos:=current_filepos;
1648 current_filepos:=current_module.mainfilepos;
1649
1650 global_stab_number:=0;
1651 defnumberlist:=TFPObjectlist.create(false);
1652 deftowritelist:=TFPObjectlist.create(false);
1653 stabsvarlist:=TAsmList.create;
1654 stabstypelist:=TAsmList.create;
1655
1656 vardatatype:=try_search_system_type('TVARDATA');
1657 if assigned(vardatatype) then
1658 vardatadef:=trecorddef(vardatatype.typedef);
1659
1660 { include symbol that will be referenced from the main to be sure to
1661 include this debuginfo .o file }
1662 current_module.flags:=current_module.flags or uf_has_stabs_debuginfo;
1663 if not(target_info.system in systems_darwin) then
1664 begin
1665 new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),sizeof(pint));
1666 current_asmdata.asmlists[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
1667 end
1668 else
1669 new_section(current_asmdata.asmlists[al_stabs],sec_code,GetSymTableName(current_module.localsymtable),sizeof(pint));
1670
1671 { write all global/local variables. This will flag all required tdefs }
1672 if assigned(current_module.globalsymtable) then
1673 write_symtable_syms(stabsvarlist,current_module.globalsymtable);
1674 if assigned(current_module.localsymtable) then
1675 write_symtable_syms(stabsvarlist,current_module.localsymtable);
1676
1677 { write all procedures and methods. This will flag all required tdefs }
1678 if assigned(current_module.globalsymtable) then
1679 write_symtable_procdefs(stabsvarlist,current_module.globalsymtable);
1680 if assigned(current_module.localsymtable) then
1681 write_symtable_procdefs(stabsvarlist,current_module.localsymtable);
1682
1683 { reset unit type info flag }
1684 reset_unit_type_info;
1685
1686 { write used types from the used units }
1687 write_used_unit_type_info(stabstypelist,current_module);
1688 { last write the types from this unit }
1689 if assigned(current_module.globalsymtable) then
1690 write_symtable_defs(stabstypelist,current_module.globalsymtable);
1691 if assigned(current_module.localsymtable) then
1692 write_symtable_defs(stabstypelist,current_module.localsymtable);
1693
1694 write_remaining_defs_to_write(stabstypelist);
1695
1696 current_asmdata.asmlists[al_stabs].concatlist(stabstypelist);
1697 current_asmdata.asmlists[al_stabs].concatlist(stabsvarlist);
1698
1699 { reset stab numbers }
1700 for i:=0 to defnumberlist.count-1 do
1701 begin
1702 if assigned(defnumberlist[i]) then
1703 begin
1704 tdef(defnumberlist[i]).stab_number:=0;
1705 tdef(defnumberlist[i]).dbg_state:=dbg_state_unused;
1706 end;
1707 end;
1708
1709 defnumberlist.free;
1710 defnumberlist:=nil;
1711 deftowritelist.free;
1712 deftowritelist:=nil;
1713
1714 stabsvarlist.free;
1715 stabstypelist.free;
1716 current_filepos:=storefilepos;
1717 end;
1718
1719
1720 procedure TDebugInfoStabs.insertlineinfo(list: TAsmList);
1721 var
1722 currfileinfo,
1723 lastfileinfo : tfileposinfo;
1724 currfuncname : pshortstring;
1725 currsectype : TAsmSectiontype;
1726 hlabel : tasmlabel;
1727 hp : tai;
1728 infile : tinputfile;
1729 begin
1730 FillChar(lastfileinfo,sizeof(lastfileinfo),0);
1731 currfuncname:=nil;
1732 currsectype:=sec_code;
1733 hp:=Tai(list.first);
1734 while assigned(hp) do
1735 begin
1736 case hp.typ of
1737 ait_section :
1738 currsectype:=tai_section(hp).sectype;
1739 ait_function_name :
1740 currfuncname:=tai_function_name(hp).funcname;
1741 ait_force_line :
1742 lastfileinfo.line:=-1;
1743 end;
1744
1745 if (currsectype=sec_code) and
1746 (hp.typ=ait_instruction) then
1747 begin
1748 currfileinfo:=tailineinfo(hp).fileinfo;
1749 { file changed ? (must be before line info) }
1750 if (currfileinfo.fileindex<>0) and
1751 ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
1752 (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
1753 begin
1754 infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
1755 if assigned(infile) then
1756 begin
1757 current_asmdata.getlabel(hlabel,alt_dbgfile);
1758 { emit stabs }
1759 if not(ds_stabs_abs_include_files in current_settings.debugswitches) or
1760 path_absolute(infile.path) then
1761 list.insertbefore(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(infile.path,false))+FixFileName(infile.name)+'",'+tostr(stabs_n_includefile)+
1762 ',0,0,'+hlabel.name),hp)
1763 else
1764 list.insertbefore(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path,false))+FixFileName(infile.name)+'",'+tostr(stabs_n_includefile)+
1765 ',0,0,'+hlabel.name),hp);
1766 list.insertbefore(tai_label.create(hlabel),hp);
1767 { force new line info }
1768 lastfileinfo.line:=-1;
1769 end;
1770 end;
1771
1772 { line changed ? }
1773 if (currfileinfo.line>lastfileinfo.line) and (currfileinfo.line<>0) then
1774 begin
1775 if assigned(currfuncname) and
1776 not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
1777 begin
1778 current_asmdata.getlabel(hlabel,alt_dbgline);
1779 list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(stabs_n_textline)+',0,'+tostr(currfileinfo.line)+','+
1780 hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
1781 list.insertbefore(tai_label.create(hlabel),hp);
1782 end
1783 else
1784 list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(stabs_n_textline)+',0,'+tostr(currfileinfo.line)),hp);
1785 end;
1786 lastfileinfo:=currfileinfo;
1787 end;
1788
1789 hp:=tai(hp.next);
1790 end;
1791 end;
1792
1793
1794 procedure TDebugInfoStabs.insertmoduleinfo;
1795 var
1796 hlabel : tasmlabel;
1797 infile : tinputfile;
1798 begin
1799 { emit main source n_sourcefile for start of module }
1800 current_asmdata.getlabel(hlabel,alt_dbgfile);
1801 infile:=current_module.sourcefiles.get_file(1);
1802 new_section(current_asmdata.asmlists[al_start],sec_code,make_mangledname('DEBUGSTART',current_module.localsymtable,''),sizeof(pint),secorder_begin);
1803 if not(target_info.system in systems_darwin) then
1804 current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(make_mangledname('DEBUGSTART',current_module.localsymtable,''),AT_DATA,0));
1805 current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+
1806 base_stabs_str(stabs_n_sourcefile,'0','0',hlabel.name)));
1807 current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stabsdir,'"'+BsToSlash(FixPath(infile.path,false))+FixFileName(infile.name)+'",'+
1808 base_stabs_str(stabs_n_sourcefile,'0','0',hlabel.name)));
1809 current_asmdata.asmlists[al_start].concat(tai_label.create(hlabel));
1810 { for darwin, you need a "module marker" too to work around }
1811 { either some assembler or gdb bug (radar 4386531 according to a }
1812 { comment in dbxout.c of Apple's gcc) }
1813 if (target_info.system in systems_darwin) then
1814 current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stabsdir,'"",'+base_stabs_str(STABS_N_OSO,'0','0','0')));
1815 { emit empty n_sourcefile for end of module }
1816 current_asmdata.getlabel(hlabel,alt_dbgfile);
1817 new_section(current_asmdata.asmlists[al_end],sec_code,make_mangledname('DEBUGEND',current_module.localsymtable,''),sizeof(pint),secorder_end);
1818 if not(target_info.system in systems_darwin) then
1819 current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(make_mangledname('DEBUGEND',current_module.localsymtable,''),AT_DATA,0));
1820 current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stabsdir,'"",'+base_stabs_str(stabs_n_sourcefile,'0','0',hlabel.name)));
1821 current_asmdata.asmlists[al_end].concat(tai_label.create(hlabel));
1822 end;
1823
1824
1825 procedure TDebugInfoStabs.referencesections(list: TAsmList);
1826 var
1827 hp : tmodule;
1828 dbgtable : tai_symbol;
1829 begin
1830 { Reference all DEBUGINFO sections from the main .fpc section }
1831 if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then
1832 exit;
1833 new_section(list,sec_fpc,'links',0);
1834 { make sure the debuginfo doesn't get stripped out }
1835 if (target_info.system in systems_darwin) then
1836 begin
1837 dbgtable:=tai_symbol.createname('DEBUGINFOTABLE',AT_DATA,0);
1838 list.concat(tai_directive.create(asd_no_dead_strip,dbgtable.sym.name));
1839 list.concat(dbgtable);
1840 end;
1841 { include reference to all debuginfo sections of used units }
1842 hp:=tmodule(loaded_units.first);
1843 while assigned(hp) do
1844 begin
1845 If (hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo then
1846 begin
1847 list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
1848 list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
1849 list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
1850 end;
1851 hp:=tmodule(hp.next);
1852 end;
1853 end;
1854
1855 constructor TDebugInfoStabs.Create;
1856 begin
1857 inherited Create;
1858 dbgtype:=dbg_stabs;
1859 stabsdir:=stab_stabs;
1860
1861 def_stab:=STABS_N_LSYM;
1862 regvar_stab:=STABS_N_RSYM;
1863 procdef_stab:=STABS_N_Function;
1864 constsym_stab:=STABS_N_Function;
1865 typesym_stab:=STABS_N_LSYM;
1866 globalvarsym_uninited_stab:=STABS_N_STSYM;
1867 globalvarsym_inited_stab:=STABS_N_LCSYM;
1868 staticvarsym_uninited_stab:=STABS_N_STSYM;
1869 staticvarsym_inited_stab:=STABS_N_LCSYM;
1870 localvarsymref_stab:=STABS_N_TSYM;
1871 paravarsymref_stab:=STABS_N_TSYM;
1872 tagtypeprefix:='Tt';
1873
1874 vardatadef:=nil;
1875 end;
1876
1877 const
1878 dbg_stabs_info : tdbginfo =
1879 (
1880 id : dbg_stabs;
1881 idtxt : 'STABS';
1882 );
1883
1884initialization
1885 RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
1886end.