llvmdef.pas 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086
  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. for i:=0 to pred(symdeflist.count) do
  260. defstr:=defstr+def_llvm_name(tllvmshadowsymtableentry(symdeflist[i]).def).name+', ';
  261. { remove last ', ' }
  262. setlength(defstr,length(defstr)-2);
  263. defstr:=defstr+' }';
  264. if (def.typ <> objectdef) or
  265. not(tobjectdef(def).objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_class]) then
  266. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr))
  267. else
  268. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_class_struct_name(tobjectdef(def)),defstr))
  269. end;
  270. procedure TLLVMDefInfo.appenddef_record(list:TAsmList;def:trecorddef);
  271. begin
  272. appenddef_abstractrecord(list,def);
  273. end;
  274. procedure TLLVMDefInfo.appenddef_pointer(list:TAsmList;def:tpointerdef);
  275. begin
  276. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_name(def.pointeddef).name+'*'));
  277. end;
  278. procedure TLLVMDefInfo.appenddef_classref(list:TAsmList;def: tclassrefdef);
  279. var
  280. defstr: ansistring;
  281. vmtbuilder: tvmtbuilder;
  282. i: longint;
  283. begin
  284. { a pointer to the VMT. Structure of the VMT: }
  285. { InstanceSize : ptrint }
  286. { -InstanceSize : ptrint }
  287. { Parent : ^parent }
  288. { ClassName : pointer }
  289. { DynamicTable : pointer }
  290. { MethodTable : pointer }
  291. { FieldTable : pointer }
  292. { TypeInfo : pointer }
  293. { InitTable : pointer }
  294. { AutoTable : pointer }
  295. { IntfTable : pointer }
  296. { MsgStrTable : pointer }
  297. { Methods : X times procvar }
  298. defstr:=def_llvm_name(ptrsinttype).name+',';
  299. defstr:='< '+defstr+defstr;
  300. { needs to be pointer to the parent class' vmt!
  301. if assigned(tobjectdef(def.pointeddef).childof) then
  302. defstr:=defstr+def_llvm_name(tobjectdef(def.pointeddef).childof).name+'*,'
  303. else
  304. }
  305. defstr:=defstr+'void*,';
  306. { class name (length+string) }
  307. defstr:=defstr+'['+tostr(length(tobjectdef(def.pointeddef).objrealname^)+1)+' x i8]*,';
  308. { the other fields }
  309. for i:=1 to 8 do
  310. defstr:=defstr+'void*,';
  311. if not assigned(tobjectdef(def.pointeddef).VMTEntries) then
  312. with TVMTBuilder.Create(tobjectdef(def.pointeddef)) do
  313. begin
  314. generate_vmt;
  315. free;
  316. end;
  317. for i:= 0 to tobjectdef(def.pointeddef).VMTEntries.Count-1 do
  318. defstr:=defstr+def_llvm_name(tprocdef(tobjectdef(def.pointeddef).VMTEntries[i])).name+'*,';
  319. setlength(defstr,length(defstr)-1);
  320. defstr:=defstr+' >*';
  321. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr));
  322. end;
  323. procedure TLLVMDefInfo.appenddef_string(list:TAsmList;def:tstringdef);
  324. procedure addnormalstringdef(lendef: tdef);
  325. var
  326. defstr: ansistring;
  327. begin
  328. { record with length and array [maxlen x i8 ] }
  329. { (also ok for openstrings, as [0 x i8] means }
  330. { "array of unspecified size" in llvm) }
  331. defstr:='< '+def_llvm_name(lendef).name+', ['+tostr(def.len)+' x i8] >';
  332. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),defstr));
  333. end;
  334. begin
  335. case def.stringtype of
  336. st_shortstring:
  337. begin
  338. addnormalstringdef(u8inttype);
  339. end;
  340. st_longstring:
  341. begin
  342. {$ifdef cpu64bitaddr}
  343. addnormalstringdef(u64inttype);
  344. {$else cpu64bitaddr}
  345. addnormalstringdef(u32inttype);
  346. {$endif cpu64bitaddr}
  347. end;
  348. st_ansistring:
  349. begin
  350. { looks like a pchar }
  351. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i8*'));
  352. end;
  353. st_unicodestring,
  354. st_widestring:
  355. begin
  356. { looks like a pwidechar }
  357. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'i16*'));
  358. end;
  359. end;
  360. end;
  361. procedure TLLVMDefInfo.appenddef_procvar(list:TAsmList;def:tprocvardef);
  362. procedure doappend;
  363. var
  364. i : longint;
  365. begin
  366. (*
  367. if assigned(def.typesym) then
  368. append_entry(DW_TAG_subroutine_type,true,[
  369. DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
  370. DW_AT_prototyped,DW_FORM_flag,true
  371. ])
  372. else
  373. append_entry(DW_TAG_subroutine_type,true,[
  374. DW_AT_prototyped,DW_FORM_flag,true
  375. ]);
  376. if not(is_void(tprocvardef(def).returndef)) then
  377. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef));
  378. finish_entry;
  379. { write parameters }
  380. for i:=0 to def.paras.count-1 do
  381. begin
  382. append_entry(DW_TAG_formal_parameter,false,[
  383. DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]))+#0
  384. ]);
  385. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef));
  386. finish_entry;
  387. end;
  388. finish_children;
  389. *)
  390. end;
  391. var
  392. proc : tasmlabel;
  393. begin
  394. if def.is_methodpointer then
  395. begin
  396. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'methodpointer*'));
  397. end
  398. else
  399. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'procvar*'));
  400. end;
  401. procedure TLLVMDefInfo.beforeappenddef(list:TAsmList;def:tdef);
  402. var
  403. labsym : tasmsymbol;
  404. begin
  405. list.concat(tai_comment.Create(strpnew('LLVM definition '+def.typename)));
  406. (*
  407. labsym:=def_dwarf_lab(def);
  408. if ds_dwarf_dbg_info_written in def.defstates then
  409. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0))
  410. else
  411. current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0));
  412. *)
  413. end;
  414. procedure TLLVMDefInfo.afterappenddef(list:TAsmList;def:tdef);
  415. begin
  416. end;
  417. procedure TLLVMDefInfo.appendprocdef(list:TAsmList;def:tprocdef);
  418. var
  419. procendlabel : tasmlabel;
  420. funcrettype : tasmsymbol;
  421. procentry : string;
  422. dreg : byte;
  423. begin
  424. if not assigned(def.procstarttai) then
  425. exit;
  426. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'procedure/function'));
  427. (*
  428. current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
  429. append_entry(DW_TAG_subprogram,true,
  430. [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0,
  431. DW_AT_external,DW_FORM_flag,po_global in def.procoptions
  432. { data continues below }
  433. { problem: base reg isn't known here
  434. DW_AT_frame_base,DW_FORM_block1,1
  435. }
  436. ]);
  437. { append block data }
  438. { current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(dwarf_reg(def.))); }
  439. if not(is_void(tprocdef(def).returndef)) then
  440. append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
  441. { mark end of procedure }
  442. current_asmdata.getlabel(procendlabel,alt_dbgtype);
  443. current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
  444. if (target_info.system = system_powerpc64_linux) then
  445. procentry := '.' + def.mangledname
  446. else
  447. procentry := def.mangledname;
  448. append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
  449. append_labelentry(DW_AT_high_pc,procendlabel);
  450. if assigned(def.funcretsym) and
  451. (tabstractnormalvarsym(def.funcretsym).refs>0) then
  452. begin
  453. if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then
  454. begin
  455. finish_entry;
  456. if paramanager.ret_in_param(def.returndef,def.proccalloption) then
  457. funcrettype:=def_dwarf_ref_lab(def.returndef)
  458. else
  459. funcrettype:=def_dwarf_lab(def.returndef);
  460. append_entry(DW_TAG_formal_parameter,false,[
  461. DW_AT_name,DW_FORM_string,def.procsym.name+#0,
  462. {
  463. DW_AT_decl_file,DW_FORM_data1,0,
  464. DW_AT_decl_line,DW_FORM_data1,
  465. }
  466. { data continues below }
  467. DW_AT_location,DW_FORM_block1,1+Lengthsleb128(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)
  468. ]);
  469. { append block data }
  470. dreg:=dwarf_reg(tabstractnormalvarsym(def.funcretsym).localloc.reference.base);
  471. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  472. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset));
  473. append_labelentry_ref(DW_AT_type,funcrettype);
  474. end;
  475. end;
  476. finish_entry;
  477. if assigned(def.parast) then
  478. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.parast);
  479. { local type defs and vars should not be written
  480. inside the main proc }
  481. if assigned(def.localst) and
  482. (def.localst.symtabletype=localsymtable) then
  483. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
  484. { last write the types from this procdef }
  485. if assigned(def.parast) then
  486. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
  487. if assigned(def.localst) and
  488. (def.localst.symtabletype=localsymtable) then
  489. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
  490. finish_children;
  491. *)
  492. end;
  493. procedure TLLVMDefInfo.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  494. var
  495. templist : TAsmList;
  496. blocksize : longint;
  497. dreg : byte;
  498. begin
  499. { external symbols can't be resolved at link time, so we
  500. can't generate stabs for them
  501. not sure if this applies to dwarf as well (FK)
  502. }
  503. if vo_is_external in sym.varoptions then
  504. exit;
  505. def_llvm_name(sym.vardef);
  506. { There is no space allocated for not referenced locals }
  507. if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
  508. exit;
  509. (*
  510. templist:=TAsmList.create;
  511. case sym.localloc.loc of
  512. LOC_REGISTER,
  513. LOC_CREGISTER,
  514. LOC_MMREGISTER,
  515. LOC_CMMREGISTER,
  516. LOC_FPUREGISTER,
  517. LOC_CFPUREGISTER :
  518. begin
  519. templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
  520. dreg:=dwarf_reg(sym.localloc.register);
  521. templist.concat(tai_const.create_uleb128bit(dreg));
  522. blocksize:=1+Lengthuleb128(dreg);
  523. end;
  524. else
  525. begin
  526. case sym.typ of
  527. staticvarsym:
  528. begin
  529. if (vo_is_thread_var in sym.varoptions) then
  530. begin
  531. {$warning !!! FIXME: dwarf for thread vars !!!
  532. }
  533. blocksize:=0;
  534. end
  535. else
  536. begin
  537. templist.concat(tai_const.create_8bit(3));
  538. templist.concat(tai_const.createname(sym.mangledname,0));
  539. blocksize:=1+sizeof(puint);
  540. end;
  541. end;
  542. paravarsym,
  543. localvarsym:
  544. begin
  545. dreg:=dwarf_reg(sym.localloc.reference.base);
  546. templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
  547. templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset));
  548. blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
  549. end
  550. else
  551. internalerror(200601288);
  552. end;
  553. end;
  554. end;
  555. if sym.typ=paravarsym then
  556. tag:=DW_TAG_formal_parameter
  557. else
  558. tag:=DW_TAG_variable;
  559. if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
  560. LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
  561. ((sym.owner.symtabletype = globalsymtable) or
  562. (sp_static in sym.symoptions) or
  563. (vo_is_public in sym.varoptions)) then
  564. append_entry(tag,false,[
  565. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  566. {
  567. DW_AT_decl_file,DW_FORM_data1,0,
  568. DW_AT_decl_line,DW_FORM_data1,
  569. }
  570. DW_AT_external,DW_FORM_flag,true,
  571. { data continues below }
  572. DW_AT_location,DW_FORM_block1,blocksize
  573. ])
  574. {$ifdef gdb_supports_DW_AT_variable_parameter}
  575. else if (sym.typ=paravarsym) and
  576. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  577. not(vo_has_local_copy in sym.varoptions) and
  578. not is_open_string(sym.vardef) then
  579. append_entry(tag,false,[
  580. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  581. DW_AT_variable_parameter,DW_FORM_flag,true,
  582. {
  583. DW_AT_decl_file,DW_FORM_data1,0,
  584. DW_AT_decl_line,DW_FORM_data1,
  585. }
  586. { data continues below }
  587. DW_AT_location,DW_FORM_block1,blocksize
  588. ])
  589. {$endif gdb_supports_DW_AT_variable_parameter}
  590. else
  591. append_entry(tag,false,[
  592. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  593. {
  594. DW_AT_decl_file,DW_FORM_data1,0,
  595. DW_AT_decl_line,DW_FORM_data1,
  596. }
  597. { data continues below }
  598. DW_AT_location,DW_FORM_block1,blocksize
  599. ]);
  600. { append block data }
  601. current_asmdata.asmlists[al_dwarf_info].concatlist(templist);
  602. {$ifndef gdb_supports_DW_AT_variable_parameter}
  603. if (sym.typ=paravarsym) and
  604. paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
  605. not(vo_has_local_copy in sym.varoptions) and
  606. not is_open_string(sym.vardef) then
  607. append_labelentry_ref(DW_AT_type,def_dwarf_ref_lab(sym.vardef))
  608. else
  609. {$endif not gdb_supports_DW_AT_variable_parameter}
  610. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  611. templist.free;
  612. finish_entry;
  613. *)
  614. end;
  615. procedure TLLVMDefInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  616. begin
  617. appendsym_var(list,sym);
  618. end;
  619. procedure TLLVMDefInfo.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  620. begin
  621. appendsym_var(list,sym);
  622. end;
  623. procedure TLLVMDefInfo.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  624. begin
  625. appendsym_var(list,sym);
  626. end;
  627. procedure TLLVMDefInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  628. var
  629. bitoffset,
  630. fieldoffset,
  631. fieldnatsize: aint;
  632. begin
  633. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'fieldvasym');
  634. (*
  635. if sp_static in sym.symoptions then
  636. exit;
  637. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or
  638. { only ordinals are bitpacked }
  639. not is_ordinal(sym.vardef) then
  640. begin
  641. { other kinds of fields can however also appear in a bitpacked }
  642. { record, and then their offset is also specified in bits rather }
  643. { than in bytes }
  644. if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then
  645. fieldoffset:=sym.fieldoffset
  646. else
  647. fieldoffset:=sym.fieldoffset div 8;
  648. append_entry(DW_TAG_member,false,[
  649. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  650. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  651. ]);
  652. end
  653. else
  654. begin
  655. if (sym.vardef.packedbitsize > 255) then
  656. internalerror(2007061201);
  657. { we don't bitpack according to the ABI, but as close as }
  658. { possible, i.e., equivalent to gcc's }
  659. { __attribute__((__packed__)), which is also what gpc }
  660. { does. }
  661. fieldnatsize:=max(sizeof(pint),sym.vardef.size);
  662. fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
  663. bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
  664. if (target_info.endian=endian_little) then
  665. bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
  666. append_entry(DW_TAG_member,false,[
  667. DW_AT_name,DW_FORM_string,symname(sym)+#0,
  668. { gcc also generates both a bit and byte size attribute }
  669. { we don't support ordinals >= 256 bits }
  670. DW_AT_byte_size,DW_FORM_data1,fieldnatsize,
  671. { nor >= 256 bits (not yet, anyway, see IE above) }
  672. DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize,
  673. { data1 and data2 are unsigned, bitoffset can also be negative }
  674. DW_AT_bit_offset,DW_FORM_data4,bitoffset,
  675. DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
  676. ]);
  677. end;
  678. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
  679. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
  680. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
  681. finish_entry;
  682. *)
  683. end;
  684. procedure TLLVMDefInfo.appendsym_const(list:TAsmList;sym:tconstsym);
  685. begin
  686. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'constsym');
  687. (*
  688. append_entry(DW_TAG_constant,false,[
  689. DW_AT_name,DW_FORM_string,symname(sym)+#0
  690. ]);
  691. { for string constants, constdef isn't set because they have no real type }
  692. if not(sym.consttyp in [conststring,constresourcestring,constwstring]) then
  693. append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.constdef));
  694. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_AT_const_value)));
  695. case sym.consttyp of
  696. conststring:
  697. begin
  698. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  699. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(strpas(pchar(sym.value.valueptr))));
  700. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  701. end;
  702. constset,
  703. constwstring,
  704. constguid,
  705. constresourcestring:
  706. begin
  707. { write dummy for now }
  708. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_string)));
  709. current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(''));
  710. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0));
  711. end;
  712. constord:
  713. begin
  714. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_sdata)));
  715. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue));
  716. end;
  717. constnil:
  718. begin
  719. {$ifdef cpu64bitaddr}
  720. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  721. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(0));
  722. {$else cpu64bitaddr}
  723. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  724. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(0));
  725. {$endif cpu64bitaddr}
  726. end;
  727. constpointer:
  728. begin
  729. {$ifdef cpu64bitaddr}
  730. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data8)));
  731. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(int64(sym.value.valueordptr)));
  732. {$else cpu64bitaddr}
  733. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
  734. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(sym.value.valueordptr));
  735. {$endif cpu64bitaddr}
  736. end;
  737. constreal:
  738. begin
  739. current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_block1)));
  740. case tfloatdef(sym.constdef).floattype of
  741. s32real:
  742. begin
  743. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
  744. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(psingle(sym.value.valueptr)^));
  745. end;
  746. s64comp,
  747. s64currency,
  748. s64real:
  749. begin
  750. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
  751. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
  752. end;
  753. s80real:
  754. begin
  755. current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
  756. current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
  757. end;
  758. else
  759. internalerror(200601291);
  760. end;
  761. end;
  762. else
  763. internalerror(200601292);
  764. end;
  765. finish_entry;
  766. *)
  767. end;
  768. procedure TLLVMDefInfo.appendsym_label(list:TAsmList;sym: tlabelsym);
  769. begin
  770. { ignore label syms for now, the problem is that a label sym
  771. can have more than one label associated e.g. in case of
  772. an inline procedure expansion }
  773. end;
  774. procedure TLLVMDefInfo.appendsym_property(list:TAsmList;sym: tpropertysym);
  775. begin
  776. { ignored for now }
  777. end;
  778. procedure TLLVMDefInfo.appendsym_type(list:TAsmList;sym: ttypesym);
  779. begin
  780. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,'typesym');
  781. record_def(sym.typedef);
  782. end;
  783. procedure TLLVMDefInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  784. var
  785. templist : TAsmList;
  786. blocksize : longint;
  787. symlist : ppropaccesslistitem;
  788. begin
  789. // list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE),'absolutesym'));
  790. end;
  791. procedure TLLVMDefInfo.beforeappendsym(list:TAsmList;sym:tsym);
  792. begin
  793. end;
  794. procedure TLLVMDefInfo.insertmoduleinfo;
  795. begin
  796. end;
  797. procedure TLLVMDefInfo.inserttypeinfo;
  798. procedure write_defs_to_write;
  799. var
  800. n : integer;
  801. looplist,
  802. templist: TFPObjectList;
  803. def : tdef;
  804. begin
  805. templist := TFPObjectList.Create(False);
  806. looplist := deftowritelist;
  807. while looplist.count > 0 do
  808. begin
  809. deftowritelist := templist;
  810. for n := 0 to looplist.count - 1 do
  811. begin
  812. def := tdef(looplist[n]);
  813. case def.dbg_state of
  814. dbg_state_written:
  815. continue;
  816. dbg_state_writing:
  817. internalerror(200610052);
  818. dbg_state_unused:
  819. internalerror(200610053);
  820. dbg_state_used:
  821. appenddef(current_asmdata.asmlists[al_dwarf_info],def)
  822. else
  823. internalerror(200610054);
  824. end;
  825. end;
  826. looplist.clear;
  827. templist := looplist;
  828. looplist := deftowritelist;
  829. end;
  830. templist.free;
  831. end;
  832. var
  833. storefilepos : tfileposinfo;
  834. lenstartlabel : tasmlabel;
  835. i : longint;
  836. def: tdef;
  837. begin
  838. storefilepos:=current_filepos;
  839. current_filepos:=current_module.mainfilepos;
  840. defnumberlist:=TFPObjectList.create(false);
  841. deftowritelist:=TFPObjectList.create(false);
  842. { not exported (FK)
  843. FILEREC
  844. TEXTREC
  845. }
  846. vardatadef:=trecorddef(search_system_type('TVARDATA').typedef);
  847. { write all global/local variables. This will flag all required tdefs }
  848. if assigned(current_module.globalsymtable) then
  849. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  850. if assigned(current_module.localsymtable) then
  851. write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  852. { write all procedures and methods. This will flag all required tdefs }
  853. if assigned(current_module.globalsymtable) then
  854. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  855. if assigned(current_module.localsymtable) then
  856. write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  857. { reset unit type info flag }
  858. reset_unit_type_info;
  859. { write used types from the used units }
  860. write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module);
  861. { last write the types from this unit }
  862. if assigned(current_module.globalsymtable) then
  863. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable);
  864. if assigned(current_module.localsymtable) then
  865. write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable);
  866. { write defs not written yet }
  867. write_defs_to_write;
  868. { reset all def labels }
  869. for i:=0 to defnumberlist.count-1 do
  870. begin
  871. def := tdef(defnumberlist[i]);
  872. if assigned(def) then
  873. begin
  874. def.dwarf_lab:=nil;
  875. def.dbg_state:=dbg_state_unused;
  876. end;
  877. end;
  878. defnumberlist.free;
  879. defnumberlist:=nil;
  880. deftowritelist.free;
  881. deftowritelist:=nil;
  882. current_filepos:=storefilepos;
  883. end;
  884. procedure TLLVMDefInfo.referencesections(list:TAsmList);
  885. begin
  886. end;
  887. function TLLVMDefInfo.symname(sym: tsym): String;
  888. begin
  889. if (sym.typ=paravarsym) and
  890. (vo_is_self in tparavarsym(sym).varoptions) then
  891. result:='this'
  892. else
  893. result := sym.Name;
  894. end;
  895. procedure TLLVMDefInfo.appenddef_formal(list:TAsmList;def: tformaldef);
  896. begin
  897. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  898. replace it with a unsigned type with size 0 (FK)
  899. }
  900. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'undef*'));
  901. end;
  902. procedure TLLVMDefInfo.appenddef_object(list:TAsmList;def: tobjectdef);
  903. procedure doappend;
  904. begin
  905. appenddef_abstractrecord(list,def);
  906. end;
  907. begin
  908. case def.objecttype of
  909. odt_cppclass,
  910. odt_object:
  911. doappend;
  912. odt_interfacecom,
  913. odt_interfacecorba,
  914. odt_dispinterface,
  915. odt_class:
  916. begin
  917. { implicit pointer }
  918. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),def_llvm_class_struct_name(def).name+'*'));
  919. doappend;
  920. end;
  921. else
  922. internalerror(200602041);
  923. end;
  924. end;
  925. procedure TLLVMDefInfo.appenddef_set(list:TAsmList;def: tsetdef);
  926. begin
  927. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'[ '+tostr(def.size)+ 'x i8 ]'));
  928. end;
  929. procedure TLLVMDefInfo.appenddef_undefined(list:TAsmList;def: tundefineddef);
  930. begin
  931. { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
  932. replace it with a unsigned type with size 0 (FK)
  933. }
  934. list.concat(tai_llvmcpu.op_ressym_string(LA_TYPE,def_llvm_name(def),'undef'));
  935. end;
  936. procedure TLLVMDefInfo.appenddef_variant(list:TAsmList;def: tvariantdef);
  937. begin
  938. { variants aren't known to dwarf2 but writting tvardata should be enough }
  939. appenddef_record(list,trecorddef(vardatadef));
  940. end;
  941. end.