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