dbgstabs.pas 65 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713
  1. {
  2. Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
  3. This units contains support for STABS debug info generation
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit dbgstabs;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,
  22. dbgbase,cgbase,
  23. symtype,symdef,symsym,symtable,symbase,
  24. aasmtai,aasmdata;
  25. const
  26. { stab types }
  27. N_GSYM = $20;
  28. N_STSYM = 38; { initialized const }
  29. N_LCSYM = 40; { non initialized variable}
  30. N_Function = $24; { function or const }
  31. N_TextLine = $44;
  32. N_DataLine = $46;
  33. N_BssLine = $48;
  34. N_RSYM = $40; { register variable }
  35. N_LSYM = $80;
  36. N_tsym = 160;
  37. N_SourceFile = $64;
  38. { APPLE LOCAL N_OSO: This is the stab that associated the .o file with the
  39. N_SO stab, in the case where debug info is mostly stored in the .o file. }
  40. N_OSO = $66;
  41. N_IncludeFile = $84;
  42. N_BINCL = $82;
  43. N_EINCL = $A2;
  44. N_LBRAC = $C0;
  45. N_EXCL = $C2;
  46. N_RBRAC = $E0;
  47. type
  48. TDebugInfoStabs=class(TDebugInfo)
  49. private
  50. writing_def_stabs : boolean;
  51. global_stab_number : word;
  52. vardatadef: trecorddef;
  53. { tsym writing }
  54. function sym_var_value(const s:string;arg:pointer):string;
  55. function sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
  56. procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
  57. { tdef writing }
  58. function def_stab_number(def:tdef):string;
  59. function def_stab_classnumber(def:tobjectdef):string;
  60. function def_var_value(const s:string;arg:pointer):string;
  61. function def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
  62. procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
  63. procedure field_add_stabstr(p:TObject;arg:pointer);
  64. procedure method_add_stabstr(p:TObject;arg:pointer);
  65. procedure field_write_defs(p:TObject;arg:pointer);
  66. function get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
  67. function get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
  68. protected
  69. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  70. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  71. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  72. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  73. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  74. procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
  75. procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
  76. procedure beforeappenddef(list:TAsmList;def:tdef);override;
  77. procedure appenddef_ord(list:TAsmList;def:torddef);override;
  78. procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
  79. procedure appenddef_file(list:TAsmList;def:tfiledef);override;
  80. procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
  81. procedure appenddef_array(list:TAsmList;def:tarraydef);override;
  82. procedure appenddef_record(list:TAsmList;def:trecorddef);override;
  83. procedure appenddef_object(list:TAsmList;def:tobjectdef);override;
  84. procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
  85. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  86. procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
  87. procedure appenddef_variant(list:TAsmList;def:tvariantdef);override;
  88. procedure appenddef_set(list:TAsmList;def:tsetdef);override;
  89. procedure appenddef_formal(list:TAsmList;def:tformaldef);override;
  90. procedure appenddef_undefined(list:TAsmList;def: tundefineddef);override;
  91. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  92. public
  93. procedure inserttypeinfo;override;
  94. procedure insertmoduleinfo;override;
  95. procedure insertlineinfo(list:TAsmList);override;
  96. procedure referencesections(list:TAsmList);override;
  97. end;
  98. implementation
  99. uses
  100. SysUtils,cutils,cfileutl,
  101. systems,globals,globtype,verbose,constexp,
  102. symconst,defutil,
  103. cpuinfo,cpubase,paramgr,
  104. aasmbase,procinfo,
  105. finput,fmodule,ppu;
  106. function GetSymName(Sym : TSymEntry) : string;
  107. begin
  108. if Not (cs_stabs_preservecase in current_settings.globalswitches) then
  109. result := Sym.Name
  110. else
  111. result := Sym.RealName;
  112. end;
  113. function GetSymTableName(SymTable : TSymTable) : string;
  114. begin
  115. if Not (cs_stabs_preservecase in current_settings.globalswitches) then
  116. result := SymTable.Name^
  117. else
  118. result := SymTable.RealName^;
  119. end;
  120. const
  121. memsizeinc = 512;
  122. tagtypes = [
  123. recorddef,
  124. variantdef,
  125. enumdef,
  126. stringdef,
  127. filedef,
  128. objectdef
  129. ];
  130. type
  131. get_var_value_proc=function(const s:string;arg:pointer):string of object;
  132. function string_evaluate(s:string;get_var_value:get_var_value_proc;get_var_value_arg:pointer;const vars:array of string):ansistring;
  133. (*
  134. S contains a prototype of a result. Stabstr_evaluate will expand
  135. variables and parameters.
  136. Output is s in ASCIIZ format, with the following expanded:
  137. ${varname} - The variable name is expanded.
  138. $n - The parameter n is expanded.
  139. $$ - Is expanded to $
  140. *)
  141. const maxvalue=9;
  142. maxdata=1023;
  143. var i,j:byte;
  144. varname:string[63];
  145. varno,varcounter:byte;
  146. varvalues:array[0..9] of pshortstring;
  147. {1 kb of parameters is the limit. 256 extra bytes are allocated to
  148. ensure buffer integrity.}
  149. varvaluedata:array[0..maxdata+256] of char;
  150. varptr:Pchar;
  151. varidx : byte;
  152. len:longint;
  153. r:Pchar;
  154. begin
  155. {Two pass approach, first, calculate the length and receive variables.}
  156. i:=1;
  157. len:=0;
  158. varcounter:=0;
  159. varptr:=@varvaluedata[0];
  160. while i<=length(s) do
  161. begin
  162. if (s[i]='$') and (i<length(s)) then
  163. begin
  164. if s[i+1]='$' then
  165. begin
  166. inc(len);
  167. inc(i);
  168. end
  169. else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
  170. begin
  171. varname:='';
  172. inc(i,2);
  173. repeat
  174. inc(varname[0]);
  175. varname[length(varname)]:=s[i];
  176. s[i]:=char(varcounter);
  177. inc(i);
  178. until s[i]='}';
  179. varvalues[varcounter]:=pshortstring(varptr);
  180. if varptr>@varvaluedata[maxdata] then
  181. internalerrorproc(200411152);
  182. pshortstring(varptr)^:=get_var_value(varname,get_var_value_arg);
  183. inc(len,length(pshortstring(varptr)^));
  184. inc(varptr,length(pshortstring(varptr)^)+1);
  185. inc(varcounter);
  186. end
  187. else if s[i+1] in ['1'..'9'] then
  188. begin
  189. varidx:=byte(s[i+1])-byte('1');
  190. if varidx>high(vars) then
  191. internalerror(200509263);
  192. inc(len,length(vars[varidx]));
  193. inc(i);
  194. end;
  195. end
  196. else
  197. inc(len);
  198. inc(i);
  199. end;
  200. {Second pass, writeout result.}
  201. setlength(result,len);
  202. r:=pchar(result);
  203. i:=1;
  204. while i<=length(s) do
  205. begin
  206. if (s[i]='$') and (i<length(s)) then
  207. begin
  208. if s[i+1]='$' then
  209. begin
  210. r^:='$';
  211. inc(r);
  212. inc(i);
  213. end
  214. else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
  215. begin
  216. varname:='';
  217. inc(i,2);
  218. varno:=byte(s[i]);
  219. repeat
  220. inc(i);
  221. until s[i]='}';
  222. for j:=1 to length(varvalues[varno]^) do
  223. begin
  224. r^:=varvalues[varno]^[j];
  225. inc(r);
  226. end;
  227. end
  228. else if s[i+1] in ['0'..'9'] then
  229. begin
  230. for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
  231. begin
  232. r^:=vars[byte(s[i+1])-byte('1')][j];
  233. inc(r);
  234. end;
  235. inc(i);
  236. end
  237. end
  238. else
  239. begin
  240. r^:=s[i];
  241. inc(r);
  242. end;
  243. inc(i);
  244. end;
  245. { verify that the length was correct }
  246. if r^<>#0 then
  247. internalerror(200802031);
  248. end;
  249. {****************************************************************************
  250. TDef support
  251. ****************************************************************************}
  252. function TDebugInfoStabs.def_stab_number(def:tdef):string;
  253. begin
  254. { procdefs only need a number, mark them as already written
  255. so they won't be written implicitly }
  256. if (def.typ=procdef) then
  257. def.dbg_state:=dbg_state_written;
  258. { Stab must already be written, or we must be busy writing it }
  259. if writing_def_stabs and
  260. not(def.dbg_state in [dbg_state_writing,dbg_state_written,dbg_state_queued]) then
  261. internalerror(200403091);
  262. { Keep track of used stabs, this info is only usefull for stabs
  263. referenced by the symbols. Definitions will always include all
  264. required stabs }
  265. if def.dbg_state=dbg_state_unused then
  266. begin
  267. def.dbg_state:=dbg_state_used;
  268. deftowritelist.Add(def);
  269. end;
  270. { Need a new number? }
  271. if def.stab_number=0 then
  272. begin
  273. inc(global_stab_number);
  274. { classes require 2 numbers }
  275. if is_class(def) then
  276. inc(global_stab_number);
  277. def.stab_number:=global_stab_number;
  278. if global_stab_number>=defnumberlist.count then
  279. defnumberlist.count:=global_stab_number+250;
  280. defnumberlist[global_stab_number]:=def;
  281. end;
  282. result:=tostr(def.stab_number);
  283. end;
  284. function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
  285. begin
  286. if def.stab_number=0 then
  287. def_stab_number(def);
  288. if (def.objecttype=odt_class) then
  289. result:=tostr(def.stab_number-1)
  290. else
  291. result:=tostr(def.stab_number);
  292. end;
  293. function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
  294. var
  295. def : tdef;
  296. begin
  297. def:=tdef(arg);
  298. result:='';
  299. if s='numberstring' then
  300. result:=def_stab_number(def)
  301. else if s='sym_name' then
  302. begin
  303. if assigned(def.typesym) then
  304. result:=GetSymName(Ttypesym(def.typesym));
  305. end
  306. else if s='N_LSYM' then
  307. result:=tostr(N_LSYM)
  308. else if s='savesize' then
  309. result:=tostr(def.size);
  310. end;
  311. function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
  312. begin
  313. result:=string_evaluate(s,@def_var_value,def,vars);
  314. end;
  315. procedure TDebugInfoStabs.field_add_stabstr(p:TObject;arg:pointer);
  316. var
  317. spec : string[3];
  318. varsize : aint;
  319. newss : ansistring;
  320. ss : pansistring absolute arg;
  321. begin
  322. if (tsym(p).visibility=vis_hidden) then
  323. exit;
  324. { static variables from objects are like global objects }
  325. if (Tsym(p).typ=fieldvarsym) and
  326. not(sp_static in Tsym(p).symoptions) then
  327. begin
  328. case tsym(p).visibility of
  329. vis_private,
  330. vis_strictprivate :
  331. spec:='/0';
  332. vis_protected,
  333. vis_strictprotected :
  334. spec:='/1';
  335. else
  336. spec:='';
  337. end;
  338. if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
  339. begin
  340. varsize:=tfieldvarsym(p).vardef.size;
  341. { open arrays made overflows !! }
  342. { how can a record/object/class contain an open array? (JM) }
  343. if varsize>$fffffff then
  344. varsize:=$fffffff;
  345. newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
  346. spec+def_stab_number(tfieldvarsym(p).vardef),
  347. tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)])
  348. end
  349. else
  350. newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
  351. spec+def_stab_number(tfieldvarsym(p).vardef),
  352. tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)),tostr(tfieldvarsym(p).vardef.packedbitsize)]);
  353. ss^:=ss^+newss;
  354. end;
  355. end;
  356. procedure TDebugInfoStabs.method_add_stabstr(p:TObject;arg:pointer);
  357. var
  358. virtualind,argnames : string;
  359. pd : tprocdef;
  360. lindex : longint;
  361. arglength : byte;
  362. sp : char;
  363. i : integer;
  364. parasym : tparavarsym;
  365. newss : ansistring;
  366. ss : pansistring absolute arg;
  367. begin
  368. if tsym(p).typ = procsym then
  369. begin
  370. pd :=tprocdef(tprocsym(p).ProcdefList[0]);
  371. if (po_virtualmethod in pd.procoptions) then
  372. begin
  373. lindex := pd.extnumber;
  374. {doesnt seem to be necessary
  375. lindex := lindex or $80000000;}
  376. virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
  377. end
  378. else
  379. virtualind := '.';
  380. { used by gdbpas to recognize constructor and destructors }
  381. if (pd.proctypeoption=potype_constructor) then
  382. argnames:='__ct__'
  383. else if (pd.proctypeoption=potype_destructor) then
  384. argnames:='__dt__'
  385. else
  386. argnames := '';
  387. { arguments are not listed here }
  388. {we don't need another definition}
  389. for i:=0 to pd.paras.count-1 do
  390. begin
  391. parasym:=tparavarsym(pd.paras[i]);
  392. if Parasym.vardef.typ = formaldef then
  393. begin
  394. case Parasym.varspez of
  395. vs_var :
  396. argnames := argnames+'3var';
  397. vs_const :
  398. argnames:=argnames+'5const';
  399. vs_out :
  400. argnames:=argnames+'3out';
  401. end;
  402. end
  403. else
  404. begin
  405. { if the arg definition is like (v: ^byte;..
  406. there is no sym attached to data !!! }
  407. if assigned(Parasym.vardef.typesym) then
  408. begin
  409. arglength := length(GetSymName(Parasym.vardef.typesym));
  410. argnames := argnames + tostr(arglength)+GetSymName(Parasym.vardef.typesym);
  411. end
  412. else
  413. argnames:=argnames+'11unnamedtype';
  414. end;
  415. end;
  416. { here 2A must be changed for private and protected }
  417. { 0 is private 1 protected and 2 public }
  418. case tsym(p).visibility of
  419. vis_private,
  420. vis_strictprivate :
  421. sp:='0';
  422. vis_protected,
  423. vis_strictprotected :
  424. sp:='1'
  425. else
  426. sp:='2';
  427. end;
  428. newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd),
  429. def_stab_number(pd.returndef),argnames,sp,
  430. virtualind]);
  431. ss^:=ss^+newss;
  432. end;
  433. end;
  434. procedure TDebugInfoStabs.field_write_defs(p:TObject;arg:pointer);
  435. begin
  436. if (Tsym(p).typ=fieldvarsym) and
  437. not(sp_static in Tsym(p).symoptions) then
  438. appenddef(TAsmList(arg),tfieldvarsym(p).vardef);
  439. end;
  440. procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
  441. var
  442. stabchar : string[2];
  443. symname : string[20];
  444. st : ansistring;
  445. p : pchar;
  446. begin
  447. { type prefix }
  448. if def.typ in tagtypes then
  449. stabchar := 'Tt'
  450. else
  451. stabchar := 't';
  452. { in case of writing the class record structure, we always have to
  453. use the class name (so it refers both to the struct and the
  454. pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) }
  455. if is_class(def) and
  456. tobjectdef(def).writing_class_record_dbginfo then
  457. st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
  458. else
  459. begin
  460. { Type names for types defined in the current unit are already written in
  461. the typesym }
  462. if (def.owner.symtabletype=globalsymtable) and
  463. not(def.owner.iscurrentunit) then
  464. symname:='${sym_name}'
  465. else
  466. symname:='';
  467. st:=def_stabstr_evaluate(def,'"'+symname+':$1$2=',[stabchar,def_stab_number(def)]);
  468. end;
  469. st:=st+ss;
  470. { line info is set to 0 for all defs, because the def can be in an other
  471. unit and then the linenumber is invalid in the current sourcefile }
  472. st:=st+def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
  473. { add to list }
  474. getmem(p,length(st)+1);
  475. move(pchar(st)^,p^,length(st)+1);
  476. list.concat(Tai_stab.create(stab_stabs,p));
  477. end;
  478. procedure TDebugInfoStabs.appenddef_string(list:TAsmList;def:tstringdef);
  479. var
  480. bytest,charst,longst : string;
  481. ss : ansistring;
  482. slen : longint;
  483. begin
  484. ss:='';
  485. case def.stringtype of
  486. st_shortstring:
  487. begin
  488. { fix length of openshortstring }
  489. slen:=def.len;
  490. if slen=0 then
  491. slen:=255;
  492. charst:=def_stab_number(cchartype);
  493. bytest:=def_stab_number(u8inttype);
  494. ss:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
  495. [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
  496. end;
  497. st_longstring:
  498. begin
  499. charst:=def_stab_number(cchartype);
  500. bytest:=def_stab_number(u8inttype);
  501. longst:=def_stab_number(u32inttype);
  502. ss:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
  503. [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
  504. end;
  505. st_ansistring:
  506. begin
  507. { looks like a pchar }
  508. ss:='*'+def_stab_number(cchartype);
  509. end;
  510. st_unicodestring,
  511. st_widestring:
  512. begin
  513. { looks like a pwidechar }
  514. ss:='*'+def_stab_number(cwidechartype);
  515. end;
  516. end;
  517. write_def_stabstr(list,def,ss);
  518. end;
  519. function TDebugInfoStabs.get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
  520. var
  521. i: longint;
  522. p: tenumsym;
  523. begin
  524. { we can specify the size with @s<size>; prefix PM }
  525. if def.size <> std_param_align then
  526. result:='@s'+tostr(def.size*8)+';e'
  527. else
  528. result:='e';
  529. { the if-test is required because pred(def.minval) might overflow;
  530. the longint() typecast should be safe because stabs is not
  531. supported for 64 bit targets }
  532. if (def.minval<>lowerbound) then
  533. for i:=lowerbound to pred(longint(def.minval)) do
  534. result:=result+'<invalid>:'+tostr(i)+',';
  535. for i := 0 to def.symtable.SymList.Count - 1 do
  536. begin
  537. p := tenumsym(def.symtable.SymList[i]);
  538. if p.value<def.minval then
  539. continue
  540. else
  541. if p.value>def.maxval then
  542. break;
  543. result:=result+GetSymName(p)+':'+tostr(p.value)+',';
  544. end;
  545. { the final ',' is required to have a valid stabs }
  546. result:=result+';';
  547. end;
  548. procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
  549. begin
  550. write_def_stabstr(list,def,get_enum_defstr(def,def.minval));
  551. end;
  552. procedure TDebugInfoStabs.appenddef_ord(list:TAsmList;def:torddef);
  553. var
  554. ss : ansistring;
  555. begin
  556. ss:='';
  557. if cs_gdb_valgrind in current_settings.globalswitches then
  558. begin
  559. case def.ordtype of
  560. uvoid :
  561. ss:=def_stab_number(def);
  562. pasbool,
  563. bool8bit,
  564. bool16bit,
  565. bool32bit,
  566. bool64bit :
  567. ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
  568. u32bit,
  569. s64bit,
  570. u64bit :
  571. ss:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
  572. else
  573. ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
  574. end;
  575. end
  576. else
  577. begin
  578. case def.ordtype of
  579. uvoid :
  580. ss:=def_stab_number(def);
  581. uchar :
  582. ss:='-20;';
  583. uwidechar :
  584. ss:='-30;';
  585. pasbool,
  586. bool8bit :
  587. ss:='-21;';
  588. bool16bit :
  589. ss:='-22;';
  590. bool32bit :
  591. ss:='-23;';
  592. bool64bit :
  593. { no clue if this is correct (FK) }
  594. ss:='-23;';
  595. u64bit :
  596. ss:='-32;';
  597. s64bit :
  598. ss:='-31;';
  599. {u32bit : result:=def_stab_number(s32inttype)+';0;-1;'); }
  600. else
  601. ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]);
  602. end;
  603. end;
  604. write_def_stabstr(list,def,ss);
  605. end;
  606. procedure TDebugInfoStabs.appenddef_float(list:TAsmList;def:tfloatdef);
  607. var
  608. ss : ansistring;
  609. begin
  610. ss:='';
  611. case def.floattype of
  612. s32real,
  613. s64real,
  614. s80real,
  615. sc80real:
  616. ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
  617. s64currency,
  618. s64comp:
  619. ss:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype)]);
  620. else
  621. internalerror(200509261);
  622. end;
  623. write_def_stabstr(list,def,ss);
  624. end;
  625. procedure TDebugInfoStabs.appenddef_file(list:TAsmList;def:tfiledef);
  626. var
  627. ss : ansistring;
  628. begin
  629. {$ifdef cpu64bitaddr}
  630. ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
  631. '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+
  632. 'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype),
  633. def_stab_number(s64inttype),
  634. def_stab_number(u8inttype),
  635. def_stab_number(cchartype)]);
  636. {$else cpu64bitaddr}
  637. ss:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
  638. '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+
  639. 'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype),
  640. def_stab_number(u8inttype),
  641. def_stab_number(cchartype)]);
  642. {$endif cpu64bitaddr}
  643. write_def_stabstr(list,def,ss);
  644. end;
  645. procedure TDebugInfoStabs.appenddef_record(list:TAsmList;def:trecorddef);
  646. var
  647. ss : ansistring;
  648. begin
  649. ss:='s'+tostr(def.size);
  650. def.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
  651. ss[length(ss)]:=';';
  652. write_def_stabstr(list,def,ss);
  653. end;
  654. procedure TDebugInfoStabs.appenddef_object(list:TAsmList;def:tobjectdef);
  655. procedure do_write_object(list:TAsmList;def:tobjectdef);
  656. var
  657. ss : ansistring;
  658. anc : tobjectdef;
  659. begin
  660. ss:='';
  661. { Write the invisible pointer for the class? }
  662. if (def.objecttype=odt_class) and
  663. (not def.writing_class_record_dbginfo) then
  664. begin
  665. ss:='*'+def_stab_classnumber(def);
  666. write_def_stabstr(list,def,ss);
  667. exit;
  668. end;
  669. ss:='s'+tostr(tobjecTSymtable(def.symtable).datasize);
  670. if assigned(def.childof) then
  671. begin
  672. {only one ancestor not virtual, public, at base offset 0 }
  673. { !1 , 0 2 0 , }
  674. ss:=ss+'!1,020,'+def_stab_classnumber(def.childof)+';';
  675. end;
  676. {virtual table to implement yet}
  677. def.symtable.symList.ForEachCall(@field_add_stabstr,@ss);
  678. if (oo_has_vmt in def.objectoptions) and
  679. (
  680. not assigned(def.childof) or
  681. not(oo_has_vmt in def.childof.objectoptions)
  682. ) then
  683. ss:=ss+'$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype)+','+tostr(def.vmt_offset*8)+';';
  684. def.symtable.symList.ForEachCall(@method_add_stabstr,@ss);
  685. if (oo_has_vmt in def.objectoptions) then
  686. begin
  687. anc := def;
  688. while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
  689. anc := anc.childof;
  690. { just in case anc = self }
  691. ss:=ss+';~%'+def_stab_classnumber(anc)+';';
  692. end
  693. else
  694. ss:=ss+';';
  695. write_def_stabstr(list,def,ss);
  696. end;
  697. var
  698. oldtypesym : tsym;
  699. begin
  700. { classes require special code to write the record and the invisible pointer }
  701. if is_class(def) then
  702. begin
  703. { Write the record class itself }
  704. tobjectdef(def).writing_class_record_dbginfo:=true;
  705. do_write_object(list,def);
  706. tobjectdef(def).writing_class_record_dbginfo:=false;
  707. { Write the invisible pointer class }
  708. oldtypesym:=def.typesym;
  709. def.typesym:=nil;
  710. do_write_object(list,def);
  711. def.typesym:=oldtypesym;
  712. end
  713. else
  714. do_write_object(list,def);
  715. { VMT symbol }
  716. if (oo_has_vmt in tobjectdef(def).objectoptions) and
  717. assigned(def.owner) and
  718. assigned(def.owner.name) then
  719. list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
  720. def_stab_number(vmttype)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname)));
  721. end;
  722. procedure TDebugInfoStabs.appenddef_variant(list:TAsmList;def:tvariantdef);
  723. var
  724. ss : ansistring;
  725. begin
  726. ss:='s'+tostr(vardatadef.size);
  727. vardatadef.symtable.SymList.ForEachCall(@field_add_stabstr,@ss);
  728. ss[length(ss)]:=';';
  729. write_def_stabstr(list,def,ss);
  730. end;
  731. procedure TDebugInfoStabs.appenddef_pointer(list:TAsmList;def:tpointerdef);
  732. var
  733. ss : ansistring;
  734. begin
  735. ss:='*'+def_stab_number(tpointerdef(def).pointeddef);
  736. write_def_stabstr(list,def,ss);
  737. end;
  738. procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef);
  739. var
  740. st,
  741. ss : ansistring;
  742. p: pchar;
  743. elementdefstabnr: string;
  744. begin
  745. { ugly hack: create a temporary subrange type if the lower bound of
  746. the set's element type is not a multiple of 8 (because we store them
  747. as if the lower bound is a multiple of 8) }
  748. if (def.setbase<>get_min_value(def.elementdef)) then
  749. begin
  750. { allocate a def number }
  751. inc(global_stab_number);
  752. elementdefstabnr:=tostr(global_stab_number);
  753. { anonymous subrange def }
  754. st:='":t'+elementdefstabnr+'=';
  755. if (def.elementdef.typ = enumdef) then
  756. st:=st+get_enum_defstr(tenumdef(def.elementdef),def.setbase)
  757. else
  758. st:=st+def_stabstr_evaluate(def.elementdef,'r'+elementdefstabnr+';$1;$2;',[tostr(longint(def.setbase)),tostr(longint(get_max_value(def.elementdef).svalue))]);
  759. st:=st+'",'+tostr(N_LSYM)+',0,0,0';
  760. { add to list }
  761. getmem(p,length(st)+1);
  762. move(pchar(st)^,p^,length(st)+1);
  763. list.concat(Tai_stab.create(stab_stabs,p));
  764. end
  765. else
  766. elementdefstabnr:=def_stab_number(def.elementdef);
  767. ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),elementdefstabnr]);
  768. write_def_stabstr(list,def,ss);
  769. end;
  770. procedure TDebugInfoStabs.appenddef_formal(list:TAsmList;def:tformaldef);
  771. var
  772. ss : ansistring;
  773. begin
  774. ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
  775. write_def_stabstr(list,def,ss);
  776. end;
  777. procedure TDebugInfoStabs.appenddef_array(list:TAsmList;def:tarraydef);
  778. var
  779. tempstr: shortstring;
  780. ss : ansistring;
  781. begin
  782. if not is_packed_array(def) then
  783. begin
  784. tempstr:='ar$1;$2;$3;$4';
  785. if is_dynamic_array(def) then
  786. tempstr:='*'+tempstr;
  787. ss:=def_stabstr_evaluate(def,tempstr,[def_stab_number(tarraydef(def).rangedef),
  788. tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)])
  789. end
  790. else
  791. begin
  792. // the @P seems to be ignored by gdb
  793. tempstr:=def_stabstr_evaluate(tarraydef(def).rangedef,'r${numberstring};$1;$2;',
  794. [tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange)]);
  795. // will only show highrange-lowrange+1 bits in gdb
  796. ss:=def_stabstr_evaluate(def,'@s$1;@S;S$2',
  797. [tostr(TConstExprInt(tarraydef(def).elepackedbitsize) * tarraydef(def).elecount),tempstr]);
  798. end;
  799. write_def_stabstr(list,def,ss);
  800. end;
  801. procedure TDebugInfoStabs.appenddef_procvar(list:TAsmList;def:tprocvardef);
  802. var
  803. ss : ansistring;
  804. begin
  805. ss:='*f'+def_stab_number(tprocvardef(def).returndef);
  806. write_def_stabstr(list,def,ss);
  807. end;
  808. procedure TDebugInfoStabs.appenddef_undefined(list:TAsmList;def:tundefineddef);
  809. var
  810. ss : ansistring;
  811. begin
  812. ss:=def_stabstr_evaluate(def,'${numberstring};',[]);
  813. write_def_stabstr(list,def,ss);
  814. end;
  815. procedure TDebugInfoStabs.beforeappenddef(list:TAsmList;def:tdef);
  816. var
  817. anc : tobjectdef;
  818. i : longint;
  819. begin
  820. { write dependencies first }
  821. case def.typ of
  822. stringdef :
  823. begin
  824. if tstringdef(def).stringtype in [st_widestring,st_unicodestring] then
  825. appenddef(list,cwidechartype)
  826. else
  827. begin
  828. appenddef(list,cchartype);
  829. appenddef(list,u8inttype);
  830. end;
  831. end;
  832. floatdef :
  833. appenddef(list,s32inttype);
  834. filedef :
  835. begin
  836. appenddef(list,s32inttype);
  837. {$ifdef cpu64bitaddr}
  838. appenddef(list,s64inttype);
  839. {$endif cpu64bitaddr}
  840. appenddef(list,u8inttype);
  841. appenddef(list,cchartype);
  842. end;
  843. classrefdef :
  844. appenddef(list,pvmttype);
  845. pointerdef :
  846. appenddef(list,tpointerdef(def).pointeddef);
  847. setdef :
  848. appenddef(list,tsetdef(def).elementdef);
  849. procvardef :
  850. begin
  851. appenddef(list,tprocvardef(def).returndef);
  852. if assigned(tprocvardef(def).parast) then
  853. write_symtable_defs(list,tprocvardef(def).parast);
  854. end;
  855. procdef :
  856. begin
  857. appenddef(list,tprocdef(def).returndef);
  858. if assigned(tprocdef(def).parast) then
  859. write_symtable_defs(list,tprocdef(def).parast);
  860. if assigned(tprocdef(def).localst) and
  861. (tprocdef(def).localst.symtabletype=localsymtable) then
  862. write_symtable_defs(list,tprocdef(def).localst);
  863. end;
  864. arraydef :
  865. begin
  866. appenddef(list,tarraydef(def).rangedef);
  867. appenddef(list,tarraydef(def).elementdef);
  868. end;
  869. recorddef :
  870. trecorddef(def).symtable.symList.ForEachCall(@field_write_defs,list);
  871. enumdef :
  872. if assigned(tenumdef(def).basedef) then
  873. appenddef(list,tenumdef(def).basedef);
  874. objectdef :
  875. begin
  876. { make sure we don't write child classdefs before their parent }
  877. { classdefs, because this crashes gdb }
  878. anc:=tobjectdef(def);
  879. while assigned(anc.childof) do
  880. begin
  881. anc:=anc.childof;
  882. if (anc.dbg_state=dbg_state_writing) then
  883. { happens in case a field of a parent is of the (forward }
  884. { defined) child type }
  885. begin
  886. { We don't explicitly requeue it, but the fact that }
  887. { a child type was used in a parent before the child }
  888. { type was fully defined means that it was forward }
  889. { declared, and will still be encountered later (it }
  890. { cannot have been declared in another unit, because }
  891. { then this and that other unit would depend on }
  892. { eachother's interface) }
  893. { Setting the state to queued however allows us to }
  894. { get the def number already without an IE }
  895. def.dbg_state:=dbg_state_queued;
  896. exit;
  897. end;
  898. end;
  899. appenddef(list,vmtarraytype);
  900. if assigned(tobjectdef(def).ImplementedInterfaces) then
  901. for i:=0 to tobjectdef(def).ImplementedInterfaces.Count-1 do
  902. appenddef(list,TImplementedInterface(tobjectdef(def).ImplementedInterfaces[i]).IntfDef);
  903. { first the parents }
  904. anc:=tobjectdef(def);
  905. while assigned(anc.childof) do
  906. begin
  907. anc:=anc.childof;
  908. appenddef(list,anc);
  909. if assigned(anc.ImplementedInterfaces) then
  910. for i:=0 to anc.ImplementedInterfaces.Count-1 do
  911. appenddef(list,TImplementedInterface(anc.ImplementedInterfaces[i]).IntfDef);
  912. end;
  913. tobjectdef(def).symtable.symList.ForEachCall(@field_write_defs,list);
  914. end;
  915. end;
  916. end;
  917. procedure TDebugInfoStabs.appendprocdef(list:TAsmList;def:tprocdef);
  918. var
  919. templist : TAsmList;
  920. stabsendlabel : tasmlabel;
  921. p : pchar;
  922. RType : Char;
  923. Obj,Info : String;
  924. hs : string;
  925. ss : ansistring;
  926. begin
  927. if not assigned(def.procstarttai) then
  928. exit;
  929. { mark as used so the local type defs also be written }
  930. def.dbg_state:=dbg_state_used;
  931. templist:=TAsmList.create;
  932. { end of procedure }
  933. current_asmdata.getlabel(stabsendlabel,alt_dbgtype);
  934. if assigned(def.funcretsym) and
  935. (tabstractnormalvarsym(def.funcretsym).refs>0) then
  936. begin
  937. if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then
  938. begin
  939. { TODO: Need to add gdb support for ret in param register calling}
  940. if paramanager.ret_in_param(def.returndef,def.proccalloption) then
  941. hs:='X*'
  942. else
  943. hs:='X';
  944. templist.concat(Tai_stab.create(stab_stabs,strpnew(
  945. '"'+GetSymName(def.procsym)+':'+hs+def_stab_number(def.returndef)+'",'+
  946. tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
  947. if (m_result in current_settings.modeswitches) then
  948. templist.concat(Tai_stab.create(stab_stabs,strpnew(
  949. '"RESULT:'+hs+def_stab_number(def.returndef)+'",'+
  950. tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset))));
  951. end;
  952. end;
  953. // LBRAC
  954. ss:=tostr(N_LBRAC)+',0,0,';
  955. if target_info.cpu=cpu_powerpc64 then
  956. ss:=ss+'.';
  957. ss:=ss+def.mangledname;
  958. if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  959. begin
  960. ss:=ss+'-';
  961. if target_info.cpu=cpu_powerpc64 then
  962. ss:=ss+'.';
  963. ss:=ss+def.mangledname;
  964. end;
  965. getmem(p,length(ss)+1);
  966. move(pchar(ss)^,p^,length(ss)+1);
  967. templist.concat(Tai_stab.Create(stab_stabn,p));
  968. // RBRAC
  969. ss:=tostr(N_RBRAC)+',0,0,'+stabsendlabel.name;
  970. if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  971. begin
  972. ss:=ss+'-';
  973. if target_info.cpu=cpu_powerpc64 then
  974. ss:=ss+'.';
  975. ss:=ss+def.mangledname;
  976. end;
  977. getmem(p,length(ss)+1);
  978. move(pchar(ss)^,p^,length(ss)+1);
  979. templist.concat(Tai_stab.Create(stab_stabn,p));
  980. { the stabsendlabel must come after all other stabs for this }
  981. { function }
  982. templist.concat(tai_label.create(stabsendlabel));
  983. { Add a "size" stab as described in the last paragraph of 2.5 at }
  984. { http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 }
  985. { This works at least on Darwin (and is needed on Darwin to get }
  986. { correct smartlinking of stabs), but I don't know which binutils }
  987. { version is required on other platforms }
  988. { This stab must come after all other stabs for the procedure, }
  989. { including the LBRAC/RBRAC ones }
  990. if (target_info.system in systems_darwin) then
  991. templist.concat(Tai_stab.create(stab_stabs,
  992. strpnew('"",'+tostr(N_FUNCTION)+',0,0,'+stabsendlabel.name+'-'+def.mangledname)));
  993. current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist);
  994. { "The stab representing a procedure is located immediately
  995. following the code of the procedure. This stab is in turn
  996. directly followed by a group of other stabs describing
  997. elements of the procedure. These other stabs describe the
  998. procedure's parameters, its block local variables, and its
  999. block structure." (stab docs) }
  1000. { this is however incorrect in case "include source" statements }
  1001. { appear in the block, in that case the procedure stab must }
  1002. { appear before this include stabs (and we generate such an }
  1003. { stabs for all functions) (JM) }
  1004. { FUNC stabs }
  1005. obj := GetSymName(def.procsym);
  1006. info := '';
  1007. if (po_global in def.procoptions) then
  1008. RType := 'F'
  1009. else
  1010. RType := 'f';
  1011. if assigned(def.owner) then
  1012. begin
  1013. if (def.owner.symtabletype = objecTSymtable) then
  1014. obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
  1015. if not(cs_gdb_valgrind in current_settings.globalswitches) and
  1016. (def.owner.symtabletype=localsymtable) and
  1017. assigned(def.owner.defowner) and
  1018. assigned(tprocdef(def.owner.defowner).procsym) then
  1019. info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
  1020. end;
  1021. ss:='"'+ansistring(obj)+':'+RType+def_stab_number(def.returndef)+info+'",'+tostr(n_function)+',0,'+tostr(def.fileinfo.line)+','+ansistring(def.mangledname);
  1022. getmem(p,length(ss)+1);
  1023. move(pchar(ss)^,p^,length(ss)+1);
  1024. templist.concat(Tai_stab.Create(stab_stabs,p));
  1025. current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
  1026. { para types }
  1027. if assigned(def.parast) then
  1028. write_symtable_syms(templist,def.parast);
  1029. { local type defs and vars should not be written
  1030. inside the main proc stab }
  1031. if assigned(def.localst) and
  1032. (def.localst.symtabletype=localsymtable) then
  1033. write_symtable_syms(templist,def.localst);
  1034. current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist);
  1035. templist.free;
  1036. end;
  1037. {****************************************************************************
  1038. TSym support
  1039. ****************************************************************************}
  1040. function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
  1041. var
  1042. sym : tsym absolute arg;
  1043. begin
  1044. result:='';
  1045. if s='name' then
  1046. result:=GetSymName(sym)
  1047. else if s='mangledname' then
  1048. result:=sym.mangledname
  1049. else if s='ownername' then
  1050. result:=GetSymTableName(sym.owner)
  1051. else if s='line' then
  1052. result:=tostr(sym.fileinfo.line)
  1053. else if s='N_LSYM' then
  1054. result:=tostr(N_LSYM)
  1055. else if s='N_LCSYM' then
  1056. result:=tostr(N_LCSYM)
  1057. else if s='N_RSYM' then
  1058. result:=tostr(N_RSYM)
  1059. else if s='N_TSYM' then
  1060. result:=tostr(N_TSYM)
  1061. else if s='N_STSYM' then
  1062. result:=tostr(N_STSYM)
  1063. else if s='N_FUNCTION' then
  1064. result:=tostr(N_FUNCTION)
  1065. else
  1066. internalerror(200401152);
  1067. end;
  1068. function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):ansistring;
  1069. begin
  1070. result:=string_evaluate(s,@sym_var_value,sym,vars);
  1071. end;
  1072. procedure TDebugInfoStabs.write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
  1073. var
  1074. p : pchar;
  1075. begin
  1076. if ss='' then
  1077. exit;
  1078. { add to list }
  1079. getmem(p,length(ss)+1);
  1080. move(pchar(ss)^,p^,length(ss)+1);
  1081. list.concat(Tai_stab.create(stab_stabs,p));
  1082. end;
  1083. procedure TDebugInfoStabs.appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);
  1084. var
  1085. ss : ansistring;
  1086. begin
  1087. ss:='';
  1088. if (sym.owner.symtabletype=objecTSymtable) and
  1089. (sp_static in sym.symoptions) then
  1090. ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
  1091. [def_stab_number(sym.vardef)]);
  1092. write_sym_stabstr(list,sym,ss);
  1093. end;
  1094. procedure TDebugInfoStabs.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  1095. var
  1096. ss : ansistring;
  1097. st : string;
  1098. threadvaroffset : string;
  1099. regidx : Tregisterindex;
  1100. nsym : string[7];
  1101. begin
  1102. { external symbols can't be resolved at link time, so we
  1103. can't generate stabs for them }
  1104. if vo_is_external in sym.varoptions then
  1105. exit;
  1106. ss:='';
  1107. st:=def_stab_number(sym.vardef);
  1108. case sym.localloc.loc of
  1109. LOC_REGISTER,
  1110. LOC_CREGISTER,
  1111. LOC_MMREGISTER,
  1112. LOC_CMMREGISTER,
  1113. LOC_FPUREGISTER,
  1114. LOC_CFPUREGISTER :
  1115. begin
  1116. regidx:=findreg_by_number(sym.localloc.register);
  1117. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1118. { this is the register order for GDB}
  1119. if regidx<>0 then
  1120. ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
  1121. end;
  1122. else
  1123. begin
  1124. if (vo_is_thread_var in sym.varoptions) then
  1125. threadvaroffset:='+'+tostr(sizeof(pint))
  1126. else
  1127. threadvaroffset:='';
  1128. if (vo_is_typed_const in sym.varoptions) then
  1129. nsym:='N_STSYM'
  1130. else
  1131. nsym:='N_LCSYM';
  1132. { Here we used S instead of
  1133. because with G GDB doesn't look at the address field
  1134. but searches the same name or with a leading underscore
  1135. but these names don't exist in pascal !}
  1136. st:='S'+st;
  1137. ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${'+nsym+'},0,${line},${mangledname}$2',[st,threadvaroffset]);
  1138. end;
  1139. end;
  1140. write_sym_stabstr(list,sym,ss);
  1141. end;
  1142. procedure TDebugInfoStabs.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  1143. var
  1144. ss : ansistring;
  1145. st : string;
  1146. regidx : Tregisterindex;
  1147. begin
  1148. { There is no space allocated for not referenced locals }
  1149. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  1150. exit;
  1151. ss:='';
  1152. st:=def_stab_number(sym.vardef);
  1153. case sym.localloc.loc of
  1154. LOC_REGISTER,
  1155. LOC_CREGISTER,
  1156. LOC_MMREGISTER,
  1157. LOC_CMMREGISTER,
  1158. LOC_FPUREGISTER,
  1159. LOC_CFPUREGISTER :
  1160. begin
  1161. regidx:=findreg_by_number(sym.localloc.register);
  1162. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1163. { this is the register order for GDB}
  1164. if regidx<>0 then
  1165. ss:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
  1166. end;
  1167. LOC_REFERENCE :
  1168. { offset to ebp => will not work if the framepointer is esp
  1169. so some optimizing will make things harder to debug }
  1170. ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
  1171. else
  1172. internalerror(2003091814);
  1173. end;
  1174. write_sym_stabstr(list,sym,ss);
  1175. end;
  1176. function TDebugInfoStabs.get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring;
  1177. var
  1178. ltyp: string[1];
  1179. regidx : Tregisterindex;
  1180. begin
  1181. result:='';
  1182. if typ='p' then
  1183. ltyp:='R'
  1184. else
  1185. ltyp:='a';
  1186. regidx:=findreg_by_number(reg);
  1187. { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  1188. { this is the register order for GDB}
  1189. if regidx<>0 then
  1190. result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_RSYM},0,${line},$2',[ltyp+stabstr,tostr(longint(regstabs_table[regidx]))]);
  1191. end;
  1192. procedure TDebugInfoStabs.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  1193. var
  1194. ss : ansistring;
  1195. c : string[1];
  1196. st : string;
  1197. regidx : Tregisterindex;
  1198. begin
  1199. ss:='';
  1200. { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
  1201. { while stabs aren't adapted for regvars yet }
  1202. if (vo_is_self in sym.varoptions) then
  1203. begin
  1204. case sym.localloc.loc of
  1205. LOC_REGISTER,
  1206. LOC_CREGISTER:
  1207. regidx:=findreg_by_number(sym.localloc.register);
  1208. LOC_REFERENCE: ;
  1209. else
  1210. internalerror(2003091815);
  1211. end;
  1212. if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or
  1213. (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
  1214. begin
  1215. if (sym.localloc.loc=LOC_REFERENCE) then
  1216. ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
  1217. [def_stab_number(pvmttype),tostr(sym.localloc.reference.offset)])
  1218. else
  1219. begin
  1220. regidx:=findreg_by_number(sym.localloc.register);
  1221. ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
  1222. [def_stab_number(pvmttype),tostr(regstabs_table[regidx])]);
  1223. end
  1224. end
  1225. else
  1226. begin
  1227. if not(is_class(tprocdef(sym.owner.defowner)._class)) then
  1228. c:='v'
  1229. else
  1230. c:='p';
  1231. if (sym.localloc.loc=LOC_REFERENCE) then
  1232. ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
  1233. [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)])
  1234. else
  1235. begin
  1236. if (c='p') then
  1237. c:='R'
  1238. else
  1239. c:='a';
  1240. regidx:=findreg_by_number(sym.localloc.register);
  1241. ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_RSYM},0,0,$2',
  1242. [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]);
  1243. end
  1244. end;
  1245. end
  1246. else
  1247. begin
  1248. st:=def_stab_number(sym.vardef);
  1249. if paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  1250. not(vo_has_local_copy in sym.varoptions) and
  1251. not is_open_string(sym.vardef) then
  1252. c:='v' { should be 'i' but 'i' doesn't work }
  1253. else
  1254. c:='p';
  1255. case sym.localloc.loc of
  1256. LOC_REGISTER,
  1257. LOC_CREGISTER,
  1258. LOC_MMREGISTER,
  1259. LOC_CMMREGISTER,
  1260. LOC_FPUREGISTER,
  1261. LOC_CFPUREGISTER :
  1262. begin
  1263. ss:=get_appendsym_paravar_reg(sym,c,st,sym.localloc.register);
  1264. end;
  1265. LOC_REFERENCE :
  1266. begin
  1267. { When the *value* of a parameter (so not its address!) is
  1268. copied into a local variable, you have to generate two
  1269. stabs: one for the parmeter, and one for the local copy.
  1270. Not doing this breaks debugging under e.g. SPARC. Doc:
  1271. http://sourceware.org/gdb/current/onlinedocs/stabs_4.html#SEC26
  1272. }
  1273. if (c='p') and
  1274. not is_open_string(sym.vardef) and
  1275. ((sym.paraloc[calleeside].location^.loc<>sym.localloc.loc) or
  1276. ((sym.localloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  1277. ((sym.paraloc[calleeside].location^.reference.index<>sym.localloc.reference.base) or
  1278. (sym.paraloc[calleeside].location^.reference.offset<>sym.localloc.reference.offset))) or
  1279. ((sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  1280. (sym.localloc.register<>sym.paraloc[calleeside].location^.register))) then
  1281. begin
  1282. if not(sym.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1283. ss:=get_appendsym_paravar_reg(sym,c,st,sym.paraloc[calleeside].location^.register)
  1284. else
  1285. ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.paraloc[calleeside].location^.reference.offset)]);
  1286. write_sym_stabstr(list,sym,ss);
  1287. { second stab has no parameter specifier }
  1288. c:='';
  1289. end;
  1290. { offset to ebp => will not work if the framepointer is esp
  1291. so some optimizing will make things harder to debug }
  1292. ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.localloc.reference.offset)])
  1293. end;
  1294. else
  1295. internalerror(2003091814);
  1296. end;
  1297. end;
  1298. write_sym_stabstr(list,sym,ss);
  1299. end;
  1300. procedure TDebugInfoStabs.appendsym_const(list:TAsmList;sym:tconstsym);
  1301. var
  1302. st : string;
  1303. ss : ansistring;
  1304. begin
  1305. ss:='';
  1306. { Don't write info for default parameter values, the N_Func breaks
  1307. the N_Func for the function itself.
  1308. Valgrind does not support constants }
  1309. if (sym.owner.symtabletype=parasymtable) or
  1310. (cs_gdb_valgrind in current_settings.globalswitches) then
  1311. exit;
  1312. case sym.consttyp of
  1313. conststring:
  1314. begin
  1315. if sym.value.len<200 then
  1316. st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
  1317. else
  1318. st:='<constant string too long>';
  1319. end;
  1320. constord:
  1321. st:='i'+tostr(sym.value.valueord);
  1322. constpointer:
  1323. st:='i'+tostr(sym.value.valueordptr);
  1324. constreal:
  1325. begin
  1326. system.str(pbestreal(sym.value.valueptr)^,st);
  1327. st := 'r'+st;
  1328. end;
  1329. else
  1330. begin
  1331. { if we don't know just put zero !! }
  1332. st:='i0';
  1333. end;
  1334. end;
  1335. ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
  1336. write_sym_stabstr(list,sym,ss);
  1337. end;
  1338. procedure TDebugInfoStabs.appendsym_type(list:TAsmList;sym:ttypesym);
  1339. var
  1340. ss : ansistring;
  1341. stabchar : string[2];
  1342. begin
  1343. ss:='';
  1344. if not assigned(sym.typedef) then
  1345. internalerror(200509262);
  1346. if sym.typedef.typ in tagtypes then
  1347. stabchar:='Tt'
  1348. else
  1349. stabchar:='t';
  1350. ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.typedef)]);
  1351. write_sym_stabstr(list,sym,ss);
  1352. end;
  1353. procedure TDebugInfoStabs.appendsym_label(list:TAsmList;sym:tlabelsym);
  1354. var
  1355. ss : ansistring;
  1356. begin
  1357. ss:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
  1358. write_sym_stabstr(list,sym,ss);
  1359. end;
  1360. {****************************************************************************
  1361. Proc/Module support
  1362. ****************************************************************************}
  1363. procedure tdebuginfostabs.inserttypeinfo;
  1364. var
  1365. stabsvarlist,
  1366. stabstypelist : TAsmList;
  1367. storefilepos : tfileposinfo;
  1368. i : longint;
  1369. begin
  1370. storefilepos:=current_filepos;
  1371. current_filepos:=current_module.mainfilepos;
  1372. global_stab_number:=0;
  1373. defnumberlist:=TFPObjectlist.create(false);
  1374. deftowritelist:=TFPObjectlist.create(false);
  1375. stabsvarlist:=TAsmList.create;
  1376. stabstypelist:=TAsmList.create;
  1377. vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
  1378. { include symbol that will be referenced from the main to be sure to
  1379. include this debuginfo .o file }
  1380. current_module.flags:=current_module.flags or uf_has_stabs_debuginfo;
  1381. if not(target_info.system in systems_darwin) then
  1382. begin
  1383. new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),0);
  1384. current_asmdata.asmlists[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
  1385. end
  1386. else
  1387. new_section(current_asmdata.asmlists[al_stabs],sec_code,GetSymTableName(current_module.localsymtable),0);
  1388. { write all global/local variables. This will flag all required tdefs }
  1389. if assigned(current_module.globalsymtable) then
  1390. write_symtable_syms(stabsvarlist,current_module.globalsymtable);
  1391. if assigned(current_module.localsymtable) then
  1392. write_symtable_syms(stabsvarlist,current_module.localsymtable);
  1393. { write all procedures and methods. This will flag all required tdefs }
  1394. if assigned(current_module.globalsymtable) then
  1395. write_symtable_procdefs(stabsvarlist,current_module.globalsymtable);
  1396. if assigned(current_module.localsymtable) then
  1397. write_symtable_procdefs(stabsvarlist,current_module.localsymtable);
  1398. { reset unit type info flag }
  1399. reset_unit_type_info;
  1400. { write used types from the used units }
  1401. write_used_unit_type_info(stabstypelist,current_module);
  1402. { last write the types from this unit }
  1403. if assigned(current_module.globalsymtable) then
  1404. write_symtable_defs(stabstypelist,current_module.globalsymtable);
  1405. if assigned(current_module.localsymtable) then
  1406. write_symtable_defs(stabstypelist,current_module.localsymtable);
  1407. write_remaining_defs_to_write(stabstypelist);
  1408. current_asmdata.asmlists[al_stabs].concatlist(stabstypelist);
  1409. current_asmdata.asmlists[al_stabs].concatlist(stabsvarlist);
  1410. { reset stab numbers }
  1411. for i:=0 to defnumberlist.count-1 do
  1412. begin
  1413. if assigned(defnumberlist[i]) then
  1414. begin
  1415. tdef(defnumberlist[i]).stab_number:=0;
  1416. tdef(defnumberlist[i]).dbg_state:=dbg_state_unused;
  1417. end;
  1418. end;
  1419. defnumberlist.free;
  1420. defnumberlist:=nil;
  1421. deftowritelist.free;
  1422. deftowritelist:=nil;
  1423. stabsvarlist.free;
  1424. stabstypelist.free;
  1425. current_filepos:=storefilepos;
  1426. end;
  1427. procedure tdebuginfostabs.insertlineinfo(list:TAsmList);
  1428. var
  1429. currfileinfo,
  1430. lastfileinfo : tfileposinfo;
  1431. currfuncname : pshortstring;
  1432. currsectype : TAsmSectiontype;
  1433. hlabel : tasmlabel;
  1434. hp : tai;
  1435. infile : tinputfile;
  1436. begin
  1437. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  1438. currfuncname:=nil;
  1439. currsectype:=sec_code;
  1440. hp:=Tai(list.first);
  1441. while assigned(hp) do
  1442. begin
  1443. case hp.typ of
  1444. ait_section :
  1445. currsectype:=tai_section(hp).sectype;
  1446. ait_function_name :
  1447. currfuncname:=tai_function_name(hp).funcname;
  1448. ait_force_line :
  1449. lastfileinfo.line:=-1;
  1450. end;
  1451. if (currsectype=sec_code) and
  1452. (hp.typ=ait_instruction) then
  1453. begin
  1454. currfileinfo:=tailineinfo(hp).fileinfo;
  1455. { file changed ? (must be before line info) }
  1456. if (currfileinfo.fileindex<>0) and
  1457. ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
  1458. (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
  1459. begin
  1460. infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
  1461. if assigned(infile) then
  1462. begin
  1463. current_asmdata.getlabel(hlabel,alt_dbgfile);
  1464. { emit stabs }
  1465. if not(ds_stabs_abs_include_files in current_settings.debugswitches) or
  1466. path_absolute(infile.path^) then
  1467. list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
  1468. ',0,0,'+hlabel.name),hp)
  1469. else
  1470. list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
  1471. ',0,0,'+hlabel.name),hp);
  1472. list.insertbefore(tai_label.create(hlabel),hp);
  1473. { force new line info }
  1474. lastfileinfo.line:=-1;
  1475. end;
  1476. end;
  1477. { line changed ? }
  1478. if (currfileinfo.line>lastfileinfo.line) and (currfileinfo.line<>0) then
  1479. begin
  1480. if assigned(currfuncname) and
  1481. not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
  1482. begin
  1483. current_asmdata.getlabel(hlabel,alt_dbgline);
  1484. list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
  1485. hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
  1486. list.insertbefore(tai_label.create(hlabel),hp);
  1487. end
  1488. else
  1489. list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
  1490. end;
  1491. lastfileinfo:=currfileinfo;
  1492. end;
  1493. hp:=tai(hp.next);
  1494. end;
  1495. end;
  1496. procedure tdebuginfostabs.insertmoduleinfo;
  1497. var
  1498. hlabel : tasmlabel;
  1499. infile : tinputfile;
  1500. begin
  1501. { emit main source n_sourcefile for start of module }
  1502. current_asmdata.getlabel(hlabel,alt_dbgfile);
  1503. infile:=current_module.sourcefiles.get_file(1);
  1504. new_section(current_asmdata.asmlists[al_start],sec_code,make_mangledname('DEBUGSTART',current_module.localsymtable,''),0,secorder_begin);
  1505. if not(target_info.system in systems_darwin) then
  1506. current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(make_mangledname('DEBUGSTART',current_module.localsymtable,''),AT_DATA,0));
  1507. current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+tostr(n_sourcefile)+
  1508. ',0,0,'+hlabel.name));
  1509. current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
  1510. ',0,0,'+hlabel.name));
  1511. current_asmdata.asmlists[al_start].concat(tai_label.create(hlabel));
  1512. { for darwin, you need a "module marker" too to work around }
  1513. { either some assembler or gdb bug (radar 4386531 according to a }
  1514. { comment in dbxout.c of Apple's gcc) }
  1515. if (target_info.system in systems_darwin) then
  1516. current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(N_OSO)+',0,0,0'));
  1517. { emit empty n_sourcefile for end of module }
  1518. current_asmdata.getlabel(hlabel,alt_dbgfile);
  1519. new_section(current_asmdata.asmlists[al_end],sec_code,make_mangledname('DEBUGEND',current_module.localsymtable,''),0,secorder_end);
  1520. if not(target_info.system in systems_darwin) then
  1521. current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(make_mangledname('DEBUGEND',current_module.localsymtable,''),AT_DATA,0));
  1522. current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
  1523. current_asmdata.asmlists[al_end].concat(tai_label.create(hlabel));
  1524. end;
  1525. procedure tdebuginfostabs.referencesections(list:TAsmList);
  1526. var
  1527. hp : tmodule;
  1528. dbgtable : tai_symbol;
  1529. begin
  1530. { Reference all DEBUGINFO sections from the main .fpc section }
  1531. if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then
  1532. exit;
  1533. list.concat(Tai_section.create(sec_fpc,'links',0));
  1534. { make sure the debuginfo doesn't get stripped out }
  1535. if (target_info.system in systems_darwin) then
  1536. begin
  1537. dbgtable:=tai_symbol.createname('DEBUGINFOTABLE',AT_DATA,0);
  1538. list.concat(tai_directive.create(asd_no_dead_strip,dbgtable.sym.name));
  1539. list.concat(dbgtable);
  1540. end;
  1541. { include reference to all debuginfo sections of used units }
  1542. hp:=tmodule(loaded_units.first);
  1543. while assigned(hp) do
  1544. begin
  1545. If (hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo then
  1546. begin
  1547. list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0));
  1548. list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0));
  1549. list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0));
  1550. end;
  1551. hp:=tmodule(hp.next);
  1552. end;
  1553. end;
  1554. const
  1555. dbg_stabs_info : tdbginfo =
  1556. (
  1557. id : dbg_stabs;
  1558. idtxt : 'STABS';
  1559. );
  1560. initialization
  1561. RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
  1562. end.