llvmtype.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740
  1. {
  2. Copyright (c) 2008,2015 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 llvmtype;
  22. {$i fpcdefs.inc}
  23. {$h+}
  24. interface
  25. uses
  26. cclasses,globtype,
  27. aasmbase,aasmtai,aasmdata,
  28. symbase,symtype,symdef,symsym,
  29. aasmllvm,aasmcnst,
  30. finput,
  31. dbgbase;
  32. { TLLVMTypeInfo }
  33. type
  34. TLLVMTypeInfo = class(TDebugInfo)
  35. protected
  36. { using alias/external declarations it's possible to refer to the same
  37. assembler symbol using multiple types:
  38. function f(p: pointer): pointer; [public, alias: 'FPC_FUNC'];
  39. procedure test(p: pointer); external name 'FPC_FUNC';
  40. We have to insert the appropriate typecasts (per module) for LLVM in
  41. this case. That can only be done after all code for a module has been
  42. generated, as these alias declarations can appear anywhere }
  43. asmsymtypes: THashSet;
  44. procedure record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
  45. function get_asmsym_def(sym: TAsmSymbol): tdef;
  46. function record_def(def:tdef): tdef;
  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_procvar(list:TAsmList;def:tprocvardef);override;
  52. procedure appendprocdef(list:TAsmList;def:tprocdef);override;
  53. procedure appenddef_object(list:TAsmList;def: tobjectdef);override;
  54. procedure appenddef_classref(list: TAsmList; def: tclassrefdef);override;
  55. procedure appenddef_variant(list:TAsmList;def: tvariantdef);override;
  56. procedure appenddef_file(list:TasmList;def:tfiledef);override;
  57. procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  58. procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
  59. procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
  60. procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
  61. procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
  62. procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
  63. procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
  64. procedure enum_membersyms_callback(p:TObject;arg:pointer);
  65. procedure collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
  66. procedure collect_tai_info(deftypelist: tasmlist; p: tai);
  67. procedure collect_asmlist_info(deftypelist, asmlist: tasmlist);
  68. procedure insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
  69. procedure insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
  70. procedure insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
  71. procedure insert_asmlist_typeconversions(toplevellist, list: tasmlist);
  72. procedure maybe_insert_extern_sym_decl(toplevellist: tasmlist; sym: tasmsymbol; def: tdef);
  73. procedure update_asmlist_alias_types(list: tasmlist);
  74. public
  75. constructor Create;override;
  76. destructor Destroy;override;
  77. procedure inserttypeinfo;override;
  78. end;
  79. implementation
  80. uses
  81. sysutils,cutils,cfileutl,constexp,
  82. version,globals,verbose,systems,
  83. cpubase,cgbase,paramgr,
  84. fmodule,nobj,
  85. defutil,defcmp,symconst,symtable,
  86. llvmbase,llvmdef
  87. ;
  88. {****************************************************************************
  89. TDebugInfoDwarf
  90. ****************************************************************************}
  91. procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
  92. var
  93. res: PHashSetItem;
  94. begin
  95. record_def(def);
  96. res:=asmsymtypes.FindOrAdd(@sym,sizeof(sym));
  97. { due to internal aliases with different signatures, we may end up with
  98. multiple defs for the same symbol -> use the one from the declaration,
  99. and insert typecasts as necessary elsewhere }
  100. if redefine or
  101. not assigned(res^.Data) then
  102. res^.Data:=def;
  103. end;
  104. function TLLVMTypeInfo.get_asmsym_def(sym: TAsmSymbol): tdef;
  105. var
  106. res: PHashSetItem;
  107. begin
  108. res:=asmsymtypes.Find(@sym,sizeof(sym));
  109. { we must have a def for every used asmsym }
  110. if not assigned(res) or
  111. not assigned(res^.data) then
  112. internalerror(2015042701);
  113. result:=tdef(res^.Data);
  114. end;
  115. function TLLVMTypeInfo.record_def(def:tdef): tdef;
  116. begin
  117. result:=def;
  118. if def.stab_number<>0 then
  119. exit;
  120. def.stab_number:=1;
  121. if def.dbg_state=dbg_state_unused then
  122. begin
  123. def.dbg_state:=dbg_state_used;
  124. deftowritelist.Add(def);
  125. end;
  126. defnumberlist.Add(def);
  127. end;
  128. constructor TLLVMTypeInfo.Create;
  129. begin
  130. inherited Create;
  131. asmsymtypes:=THashSet.Create(current_asmdata.AsmSymbolDict.Count,true,false);
  132. end;
  133. destructor TLLVMTypeInfo.Destroy;
  134. begin
  135. asmsymtypes.free;
  136. inherited destroy;
  137. end;
  138. procedure TLLVMTypeInfo.enum_membersyms_callback(p:TObject; arg: pointer);
  139. begin
  140. case tsym(p).typ of
  141. fieldvarsym:
  142. appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
  143. end;
  144. end;
  145. procedure TLLVMTypeInfo.collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
  146. var
  147. opidx, paraidx: longint;
  148. callpara: pllvmcallpara;
  149. begin
  150. for opidx:=0 to p.ops-1 do
  151. case p.oper[opidx]^.typ of
  152. top_def:
  153. record_def(p.oper[opidx]^.def);
  154. top_tai:
  155. collect_tai_info(deftypelist,p.oper[opidx]^.ai);
  156. top_ref:
  157. begin
  158. if (p.llvmopcode<>la_br) and
  159. assigned(p.oper[opidx]^.ref^.symbol) and
  160. (p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
  161. begin
  162. if (opidx=3) and
  163. (p.llvmopcode in [la_call,la_invoke]) then
  164. record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef,false)
  165. { not a named register }
  166. else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
  167. record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
  168. end;
  169. end;
  170. top_para:
  171. for paraidx:=0 to p.oper[opidx]^.paras.count-1 do
  172. begin
  173. callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
  174. record_def(callpara^.def);
  175. end;
  176. end;
  177. end;
  178. procedure TLLVMTypeInfo.collect_tai_info(deftypelist: tasmlist; p: tai);
  179. var
  180. value: tai_abstracttypedconst;
  181. begin
  182. if not assigned(p) then
  183. exit;
  184. case p.typ of
  185. ait_llvmalias:
  186. begin
  187. record_asmsym_def(taillvmalias(p).newsym,taillvmalias(p).def,true);
  188. end;
  189. ait_llvmdecl:
  190. begin
  191. record_asmsym_def(taillvmdecl(p).namesym,taillvmdecl(p).def,true);
  192. collect_asmlist_info(deftypelist,taillvmdecl(p).initdata);
  193. end;
  194. ait_llvmins:
  195. collect_llvmins_info(deftypelist,taillvm(p));
  196. ait_typedconst:
  197. begin
  198. record_def(tai_abstracttypedconst(p).def);
  199. case tai_abstracttypedconst(p).adetyp of
  200. tck_simple:
  201. collect_tai_info(deftypelist,tai_simpletypedconst(p).val);
  202. tck_array,tck_record:
  203. for value in tai_aggregatetypedconst(p) do
  204. collect_tai_info(deftypelist,value);
  205. end;
  206. end;
  207. end;
  208. end;
  209. procedure TLLVMTypeInfo.collect_asmlist_info(deftypelist, asmlist: tasmlist);
  210. var
  211. hp: tai;
  212. begin
  213. if not assigned(asmlist) then
  214. exit;
  215. hp:=tai(asmlist.first);
  216. while assigned(hp) do
  217. begin
  218. collect_tai_info(deftypelist,hp);
  219. hp:=tai(hp.next);
  220. end;
  221. end;
  222. function equal_llvm_defs(def1, def2: tdef): boolean;
  223. var
  224. def1str, def2str: TSymStr;
  225. begin
  226. if def1=def2 then
  227. exit(true);
  228. def1str:=llvmencodetypename(def1);
  229. def2str:=llvmencodetypename(def2);
  230. { normalise both type representations in case one is a procdef
  231. and the other is a procvardef}
  232. if def1.typ=procdef then
  233. def1str:=def1str+'*';
  234. if def2.typ=procdef then
  235. def2str:=def2str+'*';
  236. result:=def1str=def2str;
  237. end;
  238. procedure TLLVMTypeInfo.insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
  239. var
  240. symdef,
  241. opdef,
  242. opcmpdef: tdef;
  243. cnv: taillvm;
  244. i: longint;
  245. begin
  246. case p.llvmopcode of
  247. la_call,
  248. la_invoke:
  249. if p.oper[3]^.typ=top_ref then
  250. begin
  251. maybe_insert_extern_sym_decl(toplevellist,p.oper[3]^.ref^.symbol,tpointerdef(p.oper[2]^.def).pointeddef);
  252. symdef:=get_asmsym_def(p.oper[3]^.ref^.symbol);
  253. { the type used in the call is different from the type used to
  254. declare the symbol -> insert a typecast }
  255. if not equal_llvm_defs(symdef,p.oper[2]^.def) then
  256. begin
  257. if symdef.typ=procdef then
  258. { ugly, but can't use getcopyas(procvardef) due to the
  259. symtablestack not being available here (cpointerdef.getreusable
  260. is hardcoded to put things in the current module's
  261. symtable) and "pointer to procedure" results in the
  262. correct llvm type }
  263. symdef:=cpointerdef.getreusable(tprocdef(symdef));
  264. cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[2]^.def);
  265. p.loadtai(3,cnv);
  266. end;
  267. end;
  268. else if p.llvmopcode<>la_br then
  269. begin
  270. { check the types of all symbolic operands }
  271. for i:=0 to p.ops-1 do
  272. case p.oper[i]^.typ of
  273. top_ref:
  274. if (p.oper[i]^.ref^.refaddr<>addr_full) and
  275. assigned(p.oper[i]^.ref^.symbol) and
  276. (p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
  277. begin
  278. opdef:=p.spilling_get_reg_type(i);
  279. case opdef.typ of
  280. pointerdef:
  281. opcmpdef:=tpointerdef(opdef).pointeddef;
  282. procvardef,
  283. procdef:
  284. opcmpdef:=opdef;
  285. else
  286. internalerror(2015073101);
  287. end;
  288. maybe_insert_extern_sym_decl(toplevellist,p.oper[i]^.ref^.symbol,opcmpdef);
  289. symdef:=get_asmsym_def(p.oper[i]^.ref^.symbol);
  290. if not equal_llvm_defs(symdef,opcmpdef) then
  291. begin
  292. if symdef.typ=procdef then
  293. symdef:=cpointerdef.getreusable(symdef);
  294. cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,cpointerdef.getreusable(symdef),p.oper[i]^.ref^.symbol,opdef);
  295. p.loadtai(i,cnv);
  296. end;
  297. end;
  298. top_tai:
  299. insert_tai_typeconversions(toplevellist,p.oper[i]^.ai);
  300. end;
  301. end;
  302. end;
  303. end;
  304. procedure TLLVMTypeInfo.insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
  305. var
  306. symdef: tdef;
  307. cnv: taillvm;
  308. elementp: tai_abstracttypedconst;
  309. begin
  310. case p.adetyp of
  311. tck_simple:
  312. begin
  313. case tai_simpletypedconst(p).val.typ of
  314. ait_const:
  315. if assigned(tai_const(tai_simpletypedconst(p).val).sym) and
  316. not assigned(tai_const(tai_simpletypedconst(p).val).endsym) then
  317. begin
  318. maybe_insert_extern_sym_decl(toplevellist,tai_const(tai_simpletypedconst(p).val).sym,p.def);
  319. symdef:=get_asmsym_def(tai_const(tai_simpletypedconst(p).val).sym);
  320. { all references to symbols in typed constants are
  321. references to the address of a global symbol (you can't
  322. refer to the data itself, just like you can't initialise
  323. a Pascal (typed) constant with the contents of another
  324. typed constant) }
  325. symdef:=cpointerdef.getreusable(symdef);
  326. if not equal_llvm_defs(symdef,p.def) then
  327. begin
  328. cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(tck_simple,symdef,tai_simpletypedconst(p).val),p.def);
  329. tai_simpletypedconst(p).val:=cnv;
  330. end;
  331. end;
  332. else
  333. insert_tai_typeconversions(toplevellist,tai_simpletypedconst(p).val);
  334. end;
  335. end;
  336. tck_array,
  337. tck_record:
  338. begin
  339. for elementp in tai_aggregatetypedconst(p) do
  340. insert_typedconst_typeconversion(toplevellist,elementp);
  341. end;
  342. end;
  343. end;
  344. procedure TLLVMTypeInfo.insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
  345. begin
  346. if not assigned(p) then
  347. exit;
  348. case p.typ of
  349. ait_llvmins:
  350. insert_llvmins_typeconversions(toplevellist,taillvm(p));
  351. { can also be necessary in case someone initialises a typed const with
  352. the address of an external symbol aliasing one declared with a
  353. different type in the same mmodule. }
  354. ait_typedconst:
  355. insert_typedconst_typeconversion(toplevellist,tai_abstracttypedconst(p));
  356. ait_llvmdecl:
  357. begin
  358. if (ldf_definition in taillvmdecl(p).flags) and
  359. (taillvmdecl(p).def.typ=procdef) and
  360. assigned(tprocdef(taillvmdecl(p).def).personality) then
  361. maybe_insert_extern_sym_decl(toplevellist,
  362. current_asmdata.RefAsmSymbol(tprocdef(taillvmdecl(p).def).personality.mangledname,AT_FUNCTION,false),
  363. tprocdef(taillvmdecl(p).def).personality);
  364. insert_asmlist_typeconversions(toplevellist,taillvmdecl(p).initdata);
  365. end;
  366. end;
  367. end;
  368. procedure TLLVMTypeInfo.insert_asmlist_typeconversions(toplevellist, list: tasmlist);
  369. var
  370. hp: tai;
  371. begin
  372. if not assigned(list) then
  373. exit;
  374. hp:=tai(list.first);
  375. while assigned(hp) do
  376. begin
  377. insert_tai_typeconversions(toplevellist,hp);
  378. hp:=tai(hp.next);
  379. end;
  380. end;
  381. procedure TLLVMTypeInfo.maybe_insert_extern_sym_decl(toplevellist: tasmlist; sym: tasmsymbol; def: tdef);
  382. var
  383. sec: tasmsectiontype;
  384. begin
  385. { Necessery for "external" declarations for symbols not declared in the
  386. current unit. We can't create these declarations when the alias is
  387. initially generated, because the symbol may still be defined later at
  388. that point.
  389. We also do it for all other external symbol references (e.g.
  390. references to symbols declared in other units), because then this
  391. handling is centralised in one place. }
  392. if not(sym.declared) then
  393. begin
  394. if def.typ=procdef then
  395. sec:=sec_code
  396. else
  397. sec:=sec_data;
  398. toplevellist.Concat(taillvmdecl.createdecl(sym,def,nil,sec,def.alignment));
  399. record_asmsym_def(sym,def,true);
  400. end;
  401. end;
  402. procedure TLLVMTypeInfo.update_asmlist_alias_types(list: tasmlist);
  403. var
  404. hp: tai;
  405. def: tdef;
  406. begin
  407. if not assigned(list) then
  408. exit;
  409. hp:=tai(list.first);
  410. while assigned(hp) do
  411. begin
  412. case hp.typ of
  413. ait_llvmalias:
  414. begin
  415. { replace the def of the alias declaration with the def of
  416. the aliased symbol -> we'll insert the appropriate type
  417. conversions for all uses of this symbol in the code (since
  418. every use also specifies the used type) }
  419. record_asmsym_def(taillvmalias(hp).oldsym,taillvmalias(hp).def,false);
  420. def:=get_asmsym_def(taillvmalias(hp).oldsym);
  421. if taillvmalias(hp).def<>def then
  422. begin
  423. taillvmalias(hp).def:=def;
  424. record_asmsym_def(taillvmalias(hp).newsym,def,true);
  425. end;
  426. end;
  427. ait_llvmdecl:
  428. update_asmlist_alias_types(taillvmdecl(hp).initdata);
  429. end;
  430. hp:=tai(hp.next);
  431. end;
  432. end;
  433. procedure TLLVMTypeInfo.appenddef_array(list:TAsmList;def:tarraydef);
  434. begin
  435. record_def(def);
  436. appenddef(list,def.elementdef);
  437. end;
  438. procedure TLLVMTypeInfo.appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
  439. var
  440. symdeflist: tfpobjectlist;
  441. i: longint;
  442. begin
  443. record_def(def);
  444. symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
  445. for i:=0 to symdeflist.Count-1 do
  446. record_def(tllvmshadowsymtableentry(symdeflist[i]).def);
  447. if assigned(def.typesym) then
  448. list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
  449. end;
  450. procedure TLLVMTypeInfo.appenddef_record(list:TAsmList;def:trecorddef);
  451. begin
  452. appenddef_abstractrecord(list,def);
  453. end;
  454. procedure TLLVMTypeInfo.appenddef_pointer(list:TAsmList;def:tpointerdef);
  455. begin
  456. record_def(def);
  457. appenddef(list,def.pointeddef);
  458. end;
  459. procedure TLLVMTypeInfo.appenddef_procvar(list:TAsmList;def:tprocvardef);
  460. var
  461. i: longint;
  462. begin
  463. record_def(def);
  464. { todo: handle mantis #25551; there is no way to create a symbolic
  465. la_type for a procvardef (unless it's a procedure of object/record),
  466. which means that recursive references should become plain "procedure"
  467. types that are then casted to the real type when they are used }
  468. def.init_paraloc_info(callerside);
  469. for i:=0 to def.paras.count-1 do
  470. appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true));
  471. appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true));
  472. if assigned(def.typesym) and
  473. not def.is_addressonly then
  474. list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
  475. end;
  476. procedure TLLVMTypeInfo.appendprocdef(list:TAsmList;def:tprocdef);
  477. begin
  478. { the procdef itself is already written by appendprocdef_implicit }
  479. { last write the types from this procdef }
  480. if assigned(def.parast) then
  481. write_symtable_defs(current_asmdata.asmlists[al_start],def.parast);
  482. if assigned(def.localst) and
  483. (def.localst.symtabletype=localsymtable) then
  484. write_symtable_defs(current_asmdata.asmlists[al_start],def.localst);
  485. end;
  486. procedure TLLVMTypeInfo.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
  487. begin
  488. appenddef(list,sym.vardef);
  489. end;
  490. procedure TLLVMTypeInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
  491. begin
  492. appendsym_var(list,sym);
  493. end;
  494. procedure TLLVMTypeInfo.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
  495. begin
  496. appendsym_var(list,sym);
  497. end;
  498. procedure TLLVMTypeInfo.appendsym_paravar(list:TAsmList;sym:tparavarsym);
  499. begin
  500. appendsym_var(list,sym);
  501. end;
  502. procedure TLLVMTypeInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
  503. begin
  504. appenddef(list,sym.vardef);
  505. end;
  506. procedure TLLVMTypeInfo.appendsym_const(list:TAsmList;sym:tconstsym);
  507. begin
  508. appenddef(list,sym.constdef);
  509. end;
  510. procedure TLLVMTypeInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
  511. begin
  512. appenddef(list,sym.vardef);
  513. end;
  514. procedure TLLVMTypeInfo.inserttypeinfo;
  515. procedure write_defs_to_write;
  516. var
  517. n : integer;
  518. looplist,
  519. templist: TFPObjectList;
  520. def : tdef;
  521. begin
  522. templist := TFPObjectList.Create(False);
  523. looplist := deftowritelist;
  524. while looplist.count > 0 do
  525. begin
  526. deftowritelist := templist;
  527. for n := 0 to looplist.count - 1 do
  528. begin
  529. def := tdef(looplist[n]);
  530. case def.dbg_state of
  531. dbg_state_written:
  532. continue;
  533. dbg_state_writing:
  534. internalerror(200610052);
  535. dbg_state_unused:
  536. internalerror(200610053);
  537. dbg_state_used:
  538. appenddef(current_asmdata.asmlists[al_start],def)
  539. else
  540. internalerror(200610054);
  541. end;
  542. end;
  543. looplist.clear;
  544. templist := looplist;
  545. looplist := deftowritelist;
  546. end;
  547. templist.free;
  548. end;
  549. var
  550. storefilepos: tfileposinfo;
  551. def: tdef;
  552. i: longint;
  553. hal: tasmlisttype;
  554. begin
  555. if cs_no_regalloc in current_settings.globalswitches then
  556. exit;
  557. storefilepos:=current_filepos;
  558. current_filepos:=current_module.mainfilepos;
  559. defnumberlist:=TFPObjectList.create(false);
  560. deftowritelist:=TFPObjectList.create(false);
  561. { write all global/static variables, part of flaggin all required tdefs }
  562. if assigned(current_module.globalsymtable) then
  563. write_symtable_syms(current_asmdata.asmlists[al_start],current_module.globalsymtable);
  564. if assigned(current_module.localsymtable) then
  565. write_symtable_syms(current_asmdata.asmlists[al_start],current_module.localsymtable);
  566. { write all procedures and methods, part of flagging all required tdefs }
  567. if assigned(current_module.globalsymtable) then
  568. write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.globalsymtable);
  569. if assigned(current_module.localsymtable) then
  570. write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.localsymtable);
  571. { process all llvm instructions, part of flagging all required tdefs }
  572. for hal:=low(TasmlistType) to high(TasmlistType) do
  573. if hal<>al_start then
  574. collect_asmlist_info(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
  575. { update the defs of all alias declarations so they match those of the
  576. declarations of the symbols they alias }
  577. for hal:=low(TasmlistType) to high(TasmlistType) do
  578. if hal<>al_start then
  579. update_asmlist_alias_types(current_asmdata.asmlists[hal]);
  580. { and insert the necessary type conversions }
  581. for hal:=low(TasmlistType) to high(TasmlistType) do
  582. if hal<>al_start then
  583. insert_asmlist_typeconversions(
  584. current_asmdata.asmlists[hal],
  585. current_asmdata.asmlists[hal]);
  586. { write all used defs }
  587. write_defs_to_write;
  588. { reset all def labels }
  589. for i:=0 to defnumberlist.count-1 do
  590. begin
  591. def:=tdef(defnumberlist[i]);
  592. def.dbg_state:=dbg_state_unused;
  593. def.stab_number:=0;
  594. end;
  595. defnumberlist.free;
  596. defnumberlist:=nil;
  597. deftowritelist.free;
  598. deftowritelist:=nil;
  599. current_filepos:=storefilepos;
  600. end;
  601. procedure TLLVMTypeInfo.appenddef_object(list:TAsmList;def: tobjectdef);
  602. begin
  603. if is_interface(def) then
  604. begin
  605. record_def(def);
  606. record_def(def.vmt_def);
  607. end
  608. else
  609. appenddef_abstractrecord(list,def);
  610. end;
  611. procedure TLLVMTypeInfo.appenddef_classref(list: TAsmList; def: tclassrefdef);
  612. begin
  613. record_def(def);
  614. { can also be an objcclass, which doesn't have a vmt }
  615. if is_class(tclassrefdef(def).pointeddef) then
  616. record_def(tobjectdef(tclassrefdef(def).pointeddef).vmt_def);
  617. end;
  618. procedure TLLVMTypeInfo.appenddef_variant(list:TAsmList;def: tvariantdef);
  619. begin
  620. record_def(def);
  621. appenddef(list,tabstractrecorddef(search_system_type('TVARDATA').typedef));
  622. end;
  623. procedure TLLVMTypeInfo.appenddef_file(list:TAsmList;def:tfiledef);
  624. begin
  625. record_def(def);
  626. case tfiledef(def).filetyp of
  627. ft_text :
  628. appenddef(list,tabstractrecorddef(search_system_type('TEXTREC').typedef));
  629. ft_typed,
  630. ft_untyped :
  631. appenddef(list,tabstractrecorddef(search_system_type('FILEREC').typedef));
  632. end;
  633. end;
  634. end.