llvmdef.pas 36 KB

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