llvmdef.pas 38 KB

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