llvmtype.pas 29 KB

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