llvmtype.pas 29 KB

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