llvmdef.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101
  1. {
  2. Copyright (c) 2008 by Peter Vreman, Florian Klaempfl and Jonas Maebe
  3. This units contains support for generating LLVM type info
  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. {
  18. This units contains support for LLVM type info generation.
  19. It's based on the debug info system, since it's quite similar
  20. }
  21. unit llvmdef;
  22. {$i fpcdefs.inc}
  23. {$h+}
  24. interface
  25. uses
  26. cclasses,globtype,
  27. aasmbase,aasmtai,aasmdata,
  28. symbase,symtype,symdef,symsym,
  29. finput,
  30. dbgbase;
  31. { TLLVMDefInfo }
  32. type
  33. TLLVMDefInfo = class(TDebugInfo)
  34. { collect all defs in one list so we can reset them easily }
  35. defnumberlist,
  36. deftowritelist : TFPObjectList;
  37. function def_llvm_name(def:tdef) : tasmsymbol;
  38. function def_llvm_class_struct_name(def:tobjectdef) : tasmsymbol;
  39. // function def_llvm_class_meta_name(def:tobjectdef) : tasmsymbol;
  40. protected
  41. vardatadef: trecorddef;
  42. procedure record_def(def:tdef);
  43. procedure beforeappenddef(list:TAsmList;def:tdef);override;
  44. procedure afterappenddef(list:TAsmList;def:tdef);override;
  45. procedure appenddef_ord(list:TAsmList;def:torddef);override;
  46. procedure appenddef_float(list:TAsmList;def:tfloatdef);override;
  47. procedure appenddef_enum(list:TAsmList;def:tenumdef);override;
  48. procedure appenddef_array(list:TAsmList;def:tarraydef);override;
  49. procedure appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
  50. procedure appenddef_record(list:TAsmList;def:trecorddef);override;
  51. procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
  52. procedure appenddef_classref(list:TAsmList;def: tclassrefdef);override;
  53. procedure appenddef_string(list:TAsmList;def:tstringdef);override;
  54. procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
  55. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  56. procedure appenddef_formal(list:TAsmList;def: tformaldef);override;
  57. procedure appenddef_object(list:TAsmList;def: tobjectdef);override;
  58. procedure appenddef_set(list:TAsmList;def: tsetdef);override;
  59. procedure appenddef_undefined(list:TAsmList;def: tundefineddef);override;
  60. procedure appenddef_variant(list:TAsmList;def: tvariantdef);override;
  61. procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  62. procedure beforeappendsym(list:TAsmList;sym:tsym);override;
  63. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  64. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  65. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  66. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  67. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  68. procedure appendsym_type(list:TAsmList;sym:ttypesym);override;
  69. procedure appendsym_label(list:TAsmList;sym:tlabelsym);override;
  70. procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
  71. procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
  72. function symname(sym:tsym): String;
  73. procedure enum_membersyms_callback(p:TObject;arg:pointer);
  74. public
  75. constructor Create;override;
  76. destructor Destroy;override;
  77. procedure insertmoduleinfo;override;
  78. procedure inserttypeinfo;override;
  79. procedure referencesections(list:TAsmList);override;
  80. end;
  81. implementation
  82. uses
  83. sysutils,cutils,cfileutl,constexp,
  84. version,globals,verbose,systems,
  85. cpubase,cgbase,paramgr,
  86. fmodule,nobj,
  87. defutil,symconst,symtable,
  88. llvmbase, aasmllvm;
  89. {****************************************************************************
  90. TDebugInfoDwarf
  91. ****************************************************************************}
  92. procedure TLLVMDefInfo.record_def(def:tdef);
  93. begin
  94. if (def.dbg_state <> dbg_state_unused) then
  95. exit;
  96. { the name syms are set automatically when requested }
  97. def.dbg_state:=dbg_state_used;
  98. deftowritelist.Add(def);
  99. defnumberlist.Add(def);
  100. end;
  101. function TLLVMDefInfo.def_llvm_name(def: tdef): tasmsymbol;
  102. begin
  103. record_def(def);
  104. result:=def.llvm_name_sym;
  105. end;
  106. function TLLVMDefInfo.def_llvm_class_struct_name(def: tobjectdef): tasmsymbol;
  107. begin
  108. record_def(def);
  109. result:=def.llvm_class_struct_name_sym;
  110. end;
  111. constructor TLLVMDefInfo.Create;
  112. begin
  113. inherited Create;
  114. end;
  115. destructor TLLVMDefInfo.Destroy;
  116. begin
  117. inherited destroy;
  118. end;
  119. procedure TLLVMDefInfo.enum_membersyms_callback(p:TObject; arg: pointer);
  120. begin
  121. case tsym(p).typ of
  122. fieldvarsym:
  123. appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
  124. end;
  125. end;
  126. procedure TLLVMDefInfo.appenddef_ord(list:TAsmList;def:torddef);
  127. var
  128. basedef : tdef;
  129. fullbytesize : byte;
  130. begin
  131. case def.ordtype of
  132. s8bit,
  133. s16bit,
  134. s32bit,
  135. s64bit,
  136. u8bit,
  137. u16bit,
  138. u32bit,
  139. u64bit,
  140. uchar,
  141. uwidechar,
  142. pasbool,
  143. bool8bit,
  144. bool16bit,
  145. bool32bit,
  146. bool64bit,
  147. scurrency:
  148. begin
  149. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i'+tostr(def.size*8)));
  150. end;
  151. uvoid :
  152. begin
  153. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'void'));
  154. end
  155. else
  156. internalerror(2008032901);
  157. end;
  158. end;
  159. procedure TLLVMDefInfo.appenddef_float(list:TAsmList;def:tfloatdef);
  160. begin
  161. case def.floattype of
  162. s32real:
  163. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'float'));
  164. s64real:
  165. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'double'));
  166. s80real:
  167. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'x86_fp80'));
  168. s64currency,
  169. s64comp:
  170. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i64'));
  171. else
  172. internalerror(200601289);
  173. end;
  174. end;
  175. procedure TLLVMDefInfo.appenddef_enum(list:TAsmList;def:tenumdef);
  176. var
  177. hp : tenumsym;
  178. begin
  179. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i'+tostr(def.size*8)));
  180. end;
  181. procedure TLLVMDefInfo.appenddef_array(list:TAsmList;def:tarraydef);
  182. var
  183. typename: ansistring;
  184. endstr: ansistring;
  185. indexrange: aint;
  186. {$ifndef llvm_has_packed_arrays}
  187. begin
  188. if is_packed_array(def) then
  189. begin
  190. { have to use an array of byte of the appropriate size, }
  191. { since llvm doesn't support packed arrays yet natively }
  192. typename:=def_llvm_name(s8inttype).name;
  193. indexrange:=def.size;
  194. end
  195. else
  196. begin
  197. typename:=def_llvm_name(def.elementdef).name;
  198. if not is_open_array(def) and
  199. not is_dynamic_array(def) then
  200. indexrange:=def.highrange-def.lowrange+1
  201. else
  202. indexrange:=0;
  203. end;
  204. if not is_dynamic_array(def) then
  205. endstr:=']'
  206. else
  207. endstr:=']*';
  208. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'['+tostr(indexrange)+' x '+typename+endstr))
  209. {$else not llvm_has_packed_arrays}
  210. var
  211. arrstart, arrend, typename: ansistring;
  212. begin
  213. typename:='';
  214. if not is_packed_array(def) then
  215. begin
  216. { regular array: '[' nritems 'x' type ']' }
  217. arrstart:='[';
  218. arrend:=']'
  219. end
  220. else
  221. begin
  222. { packed array: '<' nritems 'x' type '>' }
  223. arrstart:='< [';
  224. arrend:='] >';
  225. if is_ordinal(def.elementdef) then
  226. typename:='i'+tostr(def.elepackedbitsize);
  227. end;
  228. if (typename='') then
  229. typename:=def_llvm_name(def.elementdef).name
  230. if is_open_array(def) then
  231. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),arrstart+'0 x '+typename+arrend))
  232. else if is_dynamic_array(def) then
  233. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'[0 x '+typename+']'+'*'))
  234. else
  235. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),arrstart+tostr(def.highrange-def.lowrange+1)+' x '+typename+arrend))
  236. {$endif not llvm_has_packed_arrays}
  237. end;
  238. procedure TLLVMDefInfo.appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
  239. var
  240. defstr, endstr: ansistring;
  241. symdeflist: tfpobjectlist;
  242. i: longint;
  243. begin
  244. if (tabstractrecordsymtable(def.symtable).usefieldalignment<>C_alignment) then
  245. begin
  246. { we handle the alignment/padding ourselves }
  247. defstr:='< ';
  248. endstr:=' >'
  249. end
  250. else
  251. begin
  252. { let llvm do everything }
  253. defstr:= '{ ';
  254. endstr:= ' }'
  255. end;
  256. if not assigned(tabstractrecordsymtable(def.symtable).llvmst) then
  257. tabstractrecordsymtable(def.symtable).llvmst:=tllvmshadowsymtable.create(trecordsymtable(def.symtable));
  258. symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
  259. i:=0;
  260. if (def.typ=objectdef) and
  261. assigned(tobjectdef(def).childof) and
  262. is_class(tllvmshadowsymtableentry(symdeflist[0]).def) then
  263. begin
  264. { insert the struct for the class rather than a pointer to the struct }
  265. if (tllvmshadowsymtableentry(symdeflist[0]).def.typ<>objectdef) then
  266. internalerror(2008070601);
  267. defstr:=defstr+def_llvm_class_struct_name(tobjectdef(tllvmshadowsymtableentry(symdeflist[0]).def)).name+', ';
  268. inc(i);
  269. end;
  270. while i< symdeflist.count do
  271. begin
  272. defstr:=defstr+def_llvm_name(tllvmshadowsymtableentry(symdeflist[i]).def).name+', ';
  273. inc(i);
  274. end;
  275. { remove last ', ' }
  276. setlength(defstr,length(defstr)-2);
  277. defstr:=defstr+endstr;
  278. if (def.typ <> objectdef) or
  279. not(tobjectdef(def).objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_class]) then
  280. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr))
  281. else
  282. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_class_struct_name(tobjectdef(def)),defstr))
  283. end;
  284. procedure TLLVMDefInfo.appenddef_record(list:TAsmList;def:trecorddef);
  285. begin
  286. appenddef_abstractrecord(list,def);
  287. end;
  288. procedure TLLVMDefInfo.appenddef_pointer(list:TAsmList;def:tpointerdef);
  289. begin
  290. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_name(def.pointeddef).name+'*'));
  291. end;
  292. procedure TLLVMDefInfo.appenddef_classref(list:TAsmList;def: tclassrefdef);
  293. var
  294. defstr: ansistring;
  295. vmtbuilder: tvmtbuilder;
  296. i: longint;
  297. begin
  298. { a pointer to the VMT. Structure of the VMT: }
  299. { InstanceSize : ptrint }
  300. { -InstanceSize : ptrint }
  301. { Parent : ^parent }
  302. { ClassName : pointer }
  303. { DynamicTable : pointer }
  304. { MethodTable : pointer }
  305. { FieldTable : pointer }
  306. { TypeInfo : pointer }
  307. { InitTable : pointer }
  308. { AutoTable : pointer }
  309. { IntfTable : pointer }
  310. { MsgStrTable : pointer }
  311. { Methods : X times procvar }
  312. defstr:=def_llvm_name(ptrsinttype).name+',';
  313. defstr:='< '+defstr+defstr;
  314. { needs to be pointer to the parent class' vmt!
  315. if assigned(tobjectdef(def.pointeddef).childof) then
  316. defstr:=defstr+def_llvm_name(tobjectdef(def.pointeddef).childof).name+'*,'
  317. else
  318. }
  319. defstr:=defstr+'void*,';
  320. { class name (length+string) }
  321. defstr:=defstr+'['+tostr(length(tobjectdef(def.pointeddef).objrealname^)+1)+' x i8]*,';
  322. { the other fields }
  323. for i:=1 to 8 do
  324. defstr:=defstr+'void*,';
  325. if not assigned(tobjectdef(def.pointeddef).VMTEntries) then
  326. with TVMTBuilder.Create(tobjectdef(def.pointeddef)) do
  327. begin
  328. generate_vmt;
  329. free;
  330. end;
  331. for i:= 0 to tobjectdef(def.pointeddef).VMTEntries.Count-1 do
  332. defstr:=defstr+def_llvm_name(tprocdef(tobjectdef(def.pointeddef).VMTEntries[i])).name+'*,';
  333. setlength(defstr,length(defstr)-1);
  334. defstr:=defstr+' >*';
  335. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr));
  336. end;
  337. procedure TLLVMDefInfo.appenddef_string(list:TAsmList;def:tstringdef);
  338. procedure addnormalstringdef(lendef: tdef);
  339. var
  340. defstr: ansistring;
  341. begin
  342. { record with length and array [maxlen x i8 ] }
  343. { (also ok for openstrings, as [0 x i8] means }
  344. { "array of unspecified size" in llvm) }
  345. defstr:='< '+def_llvm_name(lendef).name+', ['+tostr(def.len)+' x i8] >';
  346. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr));
  347. end;
  348. begin
  349. case def.stringtype of
  350. st_shortstring:
  351. begin
  352. addnormalstringdef(u8inttype);
  353. end;
  354. st_longstring:
  355. begin
  356. {$ifdef cpu64bitaddr}
  357. addnormalstringdef(u64inttype);
  358. {$else cpu64bitaddr}
  359. addnormalstringdef(u32inttype);
  360. {$endif cpu64bitaddr}
  361. end;
  362. st_ansistring:
  363. begin
  364. { looks like a pchar }
  365. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i8*'));
  366. end;
  367. st_unicodestring,
  368. st_widestring:
  369. begin
  370. { looks like a pwidechar }
  371. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i16*'));
  372. end;
  373. end;
  374. end;
  375. procedure TLLVMDefInfo.appenddef_procvar(list:TAsmList;def:tprocvardef);
  376. procedure doappend;
  377. var
  378. i : longint;
  379. begin
  380. (*
  381. if assigned(def.typesym) then
  382. append_entry(DW_TAG_subroutine_type,true,[
  383. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  384. DW_AT_prototyped,DW_FORM_flag,true
  385. ])
  386. else
  387. append_entry(DW_TAG_subroutine_type,true,[
  388. DW_AT_prototyped,DW_FORM_flag,true
  389. ]);
  390. if not(is_void(tprocvardef(def).returndef)) then
  391. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef));
  392. finish_entry;
  393. { write parameters }
  394. for i:=0 to def.paras.count-1 do
  395. begin
  396. append_entry(DW_TAG_formal_parameter,false,[
  397. DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]))+#0
  398. ]);
  399. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
  400. finish_entry;
  401. end;
  402. finish_children;
  403. *)
  404. end;
  405. var
  406. proc : tasmlabel;
  407. begin
  408. if def.is_methodpointer then
  409. begin
  410. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'methodpointer*'));
  411. end
  412. else
  413. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'procvar*'));
  414. end;
  415. procedure TLLVMDefInfo.beforeappenddef(list:TAsmList;def:tdef);
  416. var
  417. labsym : tasmsymbol;
  418. begin
  419. list.concat(tai_comment.Create(strpnew('LLVM definition '+def.typename)));
  420. (*
  421. labsym:=def_dwarf_lab(def);
  422. if ds_dwarf_dbg_info_written in def.defstates then
  423. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
  424. else
  425. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  426. *)
  427. end;
  428. procedure TLLVMDefInfo.afterappenddef(list:TAsmList;def:tdef);
  429. begin
  430. end;
  431. procedure TLLVMDefInfo.appendprocdef(list:TAsmList;def:tprocdef);
  432. var
  433. procendlabel : tasmlabel;
  434. funcrettype : tasmsymbol;
  435. procentry : string;
  436. dreg : byte;
  437. begin
  438. if not assigned(def.procstarttai) then
  439. exit;
  440. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'procedure/function'));
  441. (*
  442. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
  443. append_entry(DW_TAG_subprogram,true,
  444. [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0,
  445. DW_AT_external,DW_FORM_flag,po_global in def.procoptions
  446. { data continues below }
  447. { problem: base reg isn't known here
  448. DW_AT_frame_base,DW_FORM_block1,1
  449. }
  450. ]);
  451. { append block data }
  452. { current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(dwarf_reg(def.))); }
  453. if not(is_void(tprocdef(def).returndef)) then
  454. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
  455. { mark end of procedure }
  456. current_asmdata.getlabel(procendlabel,alt_dbgtype);
  457. current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
  458. if (target_info.system = system_powerpc64_linux) then
  459. procentry := '.' + def.mangledname
  460. else
  461. procentry := def.mangledname;
  462. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
  463. append_labelentry(DW_AT_high_pc,procendlabel);
  464. if assigned(def.funcretsym) and
  465. (tabstractnormalvarsym(def.funcretsym).refs>0) then
  466. begin
  467. if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then
  468. begin
  469. finish_entry;
  470. if paramanager.ret_in_param(def.returndef,def.proccalloption) then
  471. funcrettype:=def_dwarf_ref_lab(def.returndef)
  472. else
  473. funcrettype:=def_dwarf_lab(def.returndef);
  474. append_entry(DW_TAG_formal_parameter,false,[
  475. DW_AT_name,DW_FORM_string,def.procsym.name+#0,
  476. {
  477. DW_AT_decl_file,DW_FORM_data1,0,
  478. DW_AT_decl_line,DW_FORM_data1,
  479. }
  480. { data continues below }
  481. DW_AT_location,DW_FORM_block1,1+Lengthsleb128(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)
  482. ]);
  483. { append block data }
  484. dreg:=dwarf_reg(tabstractnormalvarsym(def.funcretsym).localloc.reference.base);
  485. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  486. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset));
  487. append_labelentry_ref(DW_AT_type,funcrettype);
  488. end;
  489. end;
  490. finish_entry;
  491. if assigned(def.parast) then
  492. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.parast);
  493. { local type defs and vars should not be written
  494. inside the main proc }
  495. if assigned(def.localst) and
  496. (def.localst.symtabletype=localsymtable) then
  497. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
  498. { last write the types from this procdef }
  499. if assigned(def.parast) then
  500. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
  501. if assigned(def.localst) and
  502. (def.localst.symtabletype=localsymtable) then
  503. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  504. finish_children;
  505. *)
  506. end;
  507. procedure TLLVMDefInfo.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  508. var
  509. templist : TAsmList;
  510. blocksize : longint;
  511. dreg : byte;
  512. begin
  513. { external symbols can't be resolved at link time, so we
  514. can't generate stabs for them
  515. not sure if this applies to dwarf as well (FK)
  516. }
  517. if vo_is_external in sym.varoptions then
  518. exit;
  519. def_llvm_name(sym.vardef);
  520. { There is no space allocated for not referenced locals }
  521. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  522. exit;
  523. (*
  524. templist:=TAsmList.create;
  525. case sym.localloc.loc of
  526. LOC_REGISTER,
  527. LOC_CREGISTER,
  528. LOC_MMREGISTER,
  529. LOC_CMMREGISTER,
  530. LOC_FPUREGISTER,
  531. LOC_CFPUREGISTER :
  532. begin
  533. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  534. dreg:=dwarf_reg(sym.localloc.register);
  535. templist.concat(tai_const.create_uleb128bit(dreg));
  536. blocksize:=1+Lengthuleb128(dreg);
  537. end;
  538. else
  539. begin
  540. case sym.typ of
  541. staticvarsym:
  542. begin
  543. if (vo_is_thread_var in sym.varoptions) then
  544. begin
  545. {$warning !!! FIXME: dwarf for thread vars !!!
  546. }
  547. blocksize:=0;
  548. end
  549. else
  550. begin
  551. templist.concat(tai_const.create_8bit(3));
  552. templist.concat(tai_const.createname(sym.mangledname,0));
  553. blocksize:=1+sizeof(puint);
  554. end;
  555. end;
  556. paravarsym,
  557. localvarsym:
  558. begin
  559. dreg:=dwarf_reg(sym.localloc.reference.base);
  560. templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  561. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset));
  562. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
  563. end
  564. else
  565. internalerror(200601288);
  566. end;
  567. end;
  568. end;
  569. if sym.typ=paravarsym then
  570. tag:=DW_TAG_formal_parameter
  571. else
  572. tag:=DW_TAG_variable;
  573. if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
  574. LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  575. ((sym.owner.symtabletype = globalsymtable) or
  576. (sp_static in sym.symoptions) or
  577. (vo_is_public in sym.varoptions)) then
  578. append_entry(tag,false,[
  579. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  580. {
  581. DW_AT_decl_file,DW_FORM_data1,0,
  582. DW_AT_decl_line,DW_FORM_data1,
  583. }
  584. DW_AT_external,DW_FORM_flag,true,
  585. { data continues below }
  586. DW_AT_location,DW_FORM_block1,blocksize
  587. ])
  588. {$ifdef gdb_supports_DW_AT_variable_parameter}
  589. else if (sym.typ=paravarsym) and
  590. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  591. not(vo_has_local_copy in sym.varoptions) and
  592. not is_open_string(sym.vardef) then
  593. append_entry(tag,false,[
  594. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  595. DW_AT_variable_parameter,DW_FORM_flag,true,
  596. {
  597. DW_AT_decl_file,DW_FORM_data1,0,
  598. DW_AT_decl_line,DW_FORM_data1,
  599. }
  600. { data continues below }
  601. DW_AT_location,DW_FORM_block1,blocksize
  602. ])
  603. {$endif gdb_supports_DW_AT_variable_parameter}
  604. else
  605. append_entry(tag,false,[
  606. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  607. {
  608. DW_AT_decl_file,DW_FORM_data1,0,
  609. DW_AT_decl_line,DW_FORM_data1,
  610. }
  611. { data continues below }
  612. DW_AT_location,DW_FORM_block1,blocksize
  613. ]);
  614. { append block data }
  615. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  616. {$ifndef gdb_supports_DW_AT_variable_parameter}
  617. if (sym.typ=paravarsym) and
  618. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  619. not(vo_has_local_copy in sym.varoptions) and
  620. not is_open_string(sym.vardef) then
  621. append_labelentry_ref(DW_AT_type,def_dwarf_ref_lab(sym.vardef))
  622. else
  623. {$endif not gdb_supports_DW_AT_variable_parameter}
  624. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  625. templist.free;
  626. finish_entry;
  627. *)
  628. end;
  629. procedure TLLVMDefInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  630. begin
  631. appendsym_var(list,sym);
  632. end;
  633. procedure TLLVMDefInfo.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  634. begin
  635. appendsym_var(list,sym);
  636. end;
  637. procedure TLLVMDefInfo.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  638. begin
  639. appendsym_var(list,sym);
  640. end;
  641. procedure TLLVMDefInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  642. var
  643. bitoffset,
  644. fieldoffset,
  645. fieldnatsize: aint;
  646. begin
  647. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'fieldvasym');
  648. (*
  649. if sp_static in sym.symoptions then
  650. exit;
  651. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
  652. { only ordinals are bitpacked }
  653. not is_ordinal(sym.vardef) then
  654. begin
  655. { other kinds of fields can however also appear in a bitpacked }
  656. { record, and then their offset is also specified in bits rather }
  657. { than in bytes }
  658. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
  659. fieldoffset:=sym.fieldoffset
  660. else
  661. fieldoffset:=sym.fieldoffset div 8;
  662. append_entry(DW_TAG_member,false,[
  663. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  664. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  665. ]);
  666. end
  667. else
  668. begin
  669. if (sym.vardef.packedbitsize > 255) then
  670. internalerror(2007061201);
  671. { we don't bitpack according to the ABI, but as close as }
  672. { possible, i.e., equivalent to gcc's }
  673. { __attribute__((__packed__)), which is also what gpc }
  674. { does. }
  675. fieldnatsize:=max(sizeof(pint),sym.vardef.size);
  676. fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
  677. bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
  678. if (target_info.endian=endian_little) then
  679. bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
  680. append_entry(DW_TAG_member,false,[
  681. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  682. { gcc also generates both a bit and byte size attribute }
  683. { we don't support ordinals >= 256 bits }
  684. DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
  685. { nor >= 256 bits (not yet, anyway, see IE above) }
  686. DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
  687. { data1 and data2 are unsigned, bitoffset can also be negative }
  688. DW_AT_bit_offset,DW_FORM_data4,bitoffset,
  689. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  690. ]);
  691. end;
  692. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  693. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
  694. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  695. finish_entry;
  696. *)
  697. end;
  698. procedure TLLVMDefInfo.appendsym_const(list:TAsmList;sym:tconstsym);
  699. begin
  700. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'constsym');
  701. (*
  702. append_entry(DW_TAG_constant,false,[
  703. DW_AT_name,DW_FORM_string,symname(sym)+#0
  704. ]);
  705. { for string constants, constdef isn't set because they have no real type }
  706. if not(sym.consttyp in [conststring,constresourcestring,constwstring]) then
  707. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.constdef));
  708. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_AT_const_value)));
  709. case sym.consttyp of
  710. conststring:
  711. begin
  712. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  713. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(strpas(pchar(sym.value.valueptr))));
  714. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  715. end;
  716. constset,
  717. constwstring,
  718. constguid,
  719. constresourcestring:
  720. begin
  721. { write dummy for now }
  722. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  723. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
  724. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  725. end;
  726. constord:
  727. begin
  728. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_sdata)));
  729. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
  730. end;
  731. constnil:
  732. begin
  733. {$ifdef cpu64bitaddr}
  734. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  735. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(0));
  736. {$else cpu64bitaddr}
  737. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  738. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(0));
  739. {$endif cpu64bitaddr}
  740. end;
  741. constpointer:
  742. begin
  743. {$ifdef cpu64bitaddr}
  744. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  745. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(int64(sym.value.valueordptr)));
  746. {$else cpu64bitaddr}
  747. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  748. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(sym.value.valueordptr));
  749. {$endif cpu64bitaddr}
  750. end;
  751. constreal:
  752. begin
  753. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_block1)));
  754. case tfloatdef(sym.constdef).floattype of
  755. s32real:
  756. begin
  757. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
  758. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(psingle(sym.value.valueptr)^));
  759. end;
  760. s64comp,
  761. s64currency,
  762. s64real:
  763. begin
  764. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  765. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
  766. end;
  767. s80real:
  768. begin
  769. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
  770. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
  771. end;
  772. else
  773. internalerror(200601291);
  774. end;
  775. end;
  776. else
  777. internalerror(200601292);
  778. end;
  779. finish_entry;
  780. *)
  781. end;
  782. procedure TLLVMDefInfo.appendsym_label(list:TAsmList;sym: tlabelsym);
  783. begin
  784. { ignore label syms for now, the problem is that a label sym
  785. can have more than one label associated e.g. in case of
  786. an inline procedure expansion }
  787. end;
  788. procedure TLLVMDefInfo.appendsym_property(list:TAsmList;sym: tpropertysym);
  789. begin
  790. { ignored for now }
  791. end;
  792. procedure TLLVMDefInfo.appendsym_type(list:TAsmList;sym: ttypesym);
  793. begin
  794. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,'typesym');
  795. record_def(sym.typedef);
  796. end;
  797. procedure TLLVMDefInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  798. var
  799. templist : TAsmList;
  800. blocksize : longint;
  801. symlist : ppropaccesslistitem;
  802. begin
  803. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'absolutesym'));
  804. end;
  805. procedure TLLVMDefInfo.beforeappendsym(list:TAsmList;sym:tsym);
  806. begin
  807. end;
  808. procedure TLLVMDefInfo.insertmoduleinfo;
  809. begin
  810. end;
  811. procedure TLLVMDefInfo.inserttypeinfo;
  812. procedure write_defs_to_write;
  813. var
  814. n : integer;
  815. looplist,
  816. templist: TFPObjectList;
  817. def : tdef;
  818. begin
  819. templist := TFPObjectList.Create(False);
  820. looplist := deftowritelist;
  821. while looplist.count > 0 do
  822. begin
  823. deftowritelist := templist;
  824. for n := 0 to looplist.count - 1 do
  825. begin
  826. def := tdef(looplist[n]);
  827. case def.dbg_state of
  828. dbg_state_written:
  829. continue;
  830. dbg_state_writing:
  831. internalerror(200610052);
  832. dbg_state_unused:
  833. internalerror(200610053);
  834. dbg_state_used:
  835. appenddef(current_asmdata.asmlists[al_dwarf_info],def)
  836. else
  837. internalerror(200610054);
  838. end;
  839. end;
  840. looplist.clear;
  841. templist := looplist;
  842. looplist := deftowritelist;
  843. end;
  844. templist.free;
  845. end;
  846. var
  847. storefilepos : tfileposinfo;
  848. lenstartlabel : tasmlabel;
  849. i : longint;
  850. def: tdef;
  851. begin
  852. storefilepos:=current_filepos;
  853. current_filepos:=current_module.mainfilepos;
  854. defnumberlist:=TFPObjectList.create(false);
  855. deftowritelist:=TFPObjectList.create(false);
  856. { not exported (FK)
  857. FILEREC
  858. TEXTREC
  859. }
  860. vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
  861. { write all global/local variables. This will flag all required tdefs }
  862. if assigned(current_module.globalsymtable) then
  863. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  864. if assigned(current_module.localsymtable) then
  865. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  866. { write all procedures and methods. This will flag all required tdefs }
  867. if assigned(current_module.globalsymtable) then
  868. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  869. if assigned(current_module.localsymtable) then
  870. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  871. { reset unit type info flag }
  872. reset_unit_type_info;
  873. { write used types from the used units }
  874. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  875. { last write the types from this unit }
  876. if assigned(current_module.globalsymtable) then
  877. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  878. if assigned(current_module.localsymtable) then
  879. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  880. { write defs not written yet }
  881. write_defs_to_write;
  882. { reset all def labels }
  883. for i:=0 to defnumberlist.count-1 do
  884. begin
  885. def := tdef(defnumberlist[i]);
  886. if assigned(def) then
  887. begin
  888. def.dwarf_lab:=nil;
  889. def.dbg_state:=dbg_state_unused;
  890. end;
  891. end;
  892. defnumberlist.free;
  893. defnumberlist:=nil;
  894. deftowritelist.free;
  895. deftowritelist:=nil;
  896. current_filepos:=storefilepos;
  897. end;
  898. procedure TLLVMDefInfo.referencesections(list:TAsmList);
  899. begin
  900. end;
  901. function TLLVMDefInfo.symname(sym: tsym): String;
  902. begin
  903. if (sym.typ=paravarsym) and
  904. (vo_is_self in tparavarsym(sym).varoptions) then
  905. result:='this'
  906. else
  907. result := sym.Name;
  908. end;
  909. procedure TLLVMDefInfo.appenddef_formal(list:TAsmList;def: tformaldef);
  910. begin
  911. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  912. replace it with a unsigned type with size 0 (FK)
  913. }
  914. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'undef*'));
  915. end;
  916. procedure TLLVMDefInfo.appenddef_object(list:TAsmList;def: tobjectdef);
  917. procedure doappend;
  918. begin
  919. appenddef_abstractrecord(list,def);
  920. end;
  921. begin
  922. case def.objecttype of
  923. odt_cppclass,
  924. odt_object:
  925. doappend;
  926. odt_interfacecom,
  927. odt_interfacecorba,
  928. odt_dispinterface,
  929. odt_class:
  930. begin
  931. { implicit pointer }
  932. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_class_struct_name(def).name+'*'));
  933. doappend;
  934. end;
  935. else
  936. internalerror(200602041);
  937. end;
  938. end;
  939. procedure TLLVMDefInfo.appenddef_set(list:TAsmList;def: tsetdef);
  940. begin
  941. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'[ '+tostr(def.size)+ 'x i8 ]'));
  942. end;
  943. procedure TLLVMDefInfo.appenddef_undefined(list:TAsmList;def: tundefineddef);
  944. begin
  945. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  946. replace it with a unsigned type with size 0 (FK)
  947. }
  948. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'undef'));
  949. end;
  950. procedure TLLVMDefInfo.appenddef_variant(list:TAsmList;def: tvariantdef);
  951. begin
  952. { variants aren't known to dwarf2 but writting tvardata should be enough }
  953. appenddef_record(list,trecorddef(vardatadef));
  954. end;
  955. end.