nllvmtcon.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799
  1. {
  2. Copyright (c) 2014 by Jonas Maebe
  3. Generates code for typed constant declarations for the LLVM target
  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. unit nllvmtcon;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,constexp,globtype,
  22. aasmbase,aasmtai,aasmcnst,aasmllvm,
  23. symconst,symbase,symtype,symdef,symsym,
  24. ngtcon;
  25. type
  26. tllvmaggregateinformation = class(taggregateinformation)
  27. private
  28. faggai: tai_aggregatetypedconst;
  29. fanonrecalignpos: longint;
  30. { if this is a non-anonymous record, keep track of the current field at
  31. the llvm level that gets emitted, so we know when the data types of the
  32. Pascal and llvm representation don't match up (because of variant
  33. records, or because not all fields are defined at the Pascal level and
  34. the rest is zeroed) }
  35. fllvmnextfieldindex: longint;
  36. fdoesnotmatchllvmdef: boolean;
  37. public
  38. constructor create(_def: tdef; _typ: ttypedconstkind); override;
  39. function prepare_next_field(nextfielddef: tdef): asizeint; override;
  40. property aggai: tai_aggregatetypedconst read faggai write faggai;
  41. property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
  42. property llvmnextfieldindex: longint read fllvmnextfieldindex write fllvmnextfieldindex;
  43. property doesnotmatchllvmdef: boolean read fdoesnotmatchllvmdef write fdoesnotmatchllvmdef;
  44. end;
  45. tllvmtypedconstplaceholder = class(ttypedconstplaceholder)
  46. agginfo: tllvmaggregateinformation;
  47. pos: longint;
  48. constructor create(info: tllvmaggregateinformation; p: longint; d: tdef);
  49. procedure replace(ai: tai; d: tdef); override;
  50. end;
  51. tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
  52. public
  53. { set the default value for caggregateinformation (= tllvmaggregateinformation) }
  54. class constructor classcreate;
  55. protected
  56. foverriding_def: tdef;
  57. fappendingdef: boolean;
  58. fqueued_tai,
  59. flast_added_tai: tai;
  60. fqueued_tai_opidx: longint;
  61. procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); override;
  62. { outerai: the ai that should become fqueued_tai in case it's still nil,
  63. or that should be filled in the fqueued_tai_opidx of the current
  64. fqueued_tai if it's not nil
  65. innerai: the innermost ai (possibly an operand of outerai) in which
  66. newindex indicates which operand is empty and can be filled with the
  67. next queued tai }
  68. procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
  69. function wrap_with_type(p: tai; def: tdef): tai;
  70. procedure do_emit_tai(p: tai; def: tdef); override;
  71. procedure mark_anon_aggregate_alignment; override;
  72. procedure insert_marked_aggregate_alignment(def: tdef); override;
  73. procedure maybe_emit_tail_padding(def: tdef); override;
  74. procedure begin_aggregate_internal(def: tdef; anonymous: boolean); override;
  75. procedure end_aggregate_internal(def: tdef; anonymous: boolean); override;
  76. function get_internal_data_section_start_label: tasmlabel; override;
  77. function get_internal_data_section_internal_label: tasmlabel; override;
  78. procedure do_emit_extended_in_aggregate(p: tai);
  79. { mark the current agginfo, and hence also all the ones higher up in ther
  80. aggregate hierarchy, as not matching our canonical llvm definition for
  81. their def }
  82. procedure mark_aggregate_hierarchy_llvmdef_mismatch(new_current_level_def: trecorddef);
  83. public
  84. destructor destroy; override;
  85. procedure emit_tai(p: tai; def: tdef); override;
  86. procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
  87. procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
  88. procedure queue_init(todef: tdef); override;
  89. procedure queue_vecn(def: tdef; const index: tconstexprint); override;
  90. procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
  91. procedure queue_typeconvn(fromdef, todef: tdef); override;
  92. procedure queue_emit_staticvar(vs: tstaticvarsym); override;
  93. procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
  94. procedure queue_emit_ordconst(value: int64; def: tdef); override;
  95. class function get_vectorized_dead_strip_custom_section_name(const basename: TSymStr; st: tsymtable; out secname: TSymStr): boolean; override;
  96. function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
  97. class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
  98. property appendingdef: boolean write fappendingdef;
  99. end;
  100. implementation
  101. uses
  102. verbose,systems,
  103. aasmdata,
  104. cpubase,cpuinfo,llvmbase,
  105. symtable,llvmdef,defutil,defcmp;
  106. { tllvmaggregateinformation }
  107. constructor tllvmaggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
  108. begin
  109. inherited;
  110. fanonrecalignpos:=-1;
  111. fllvmnextfieldindex:=0;
  112. end;
  113. function tllvmaggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
  114. begin
  115. result:=inherited;
  116. { in case we let LLVM align, don't add padding ourselves }
  117. if df_llvm_no_struct_packing in def.defoptions then
  118. result:=0;
  119. end;
  120. { tllvmtypedconstplaceholder }
  121. constructor tllvmtypedconstplaceholder.create(info: tllvmaggregateinformation; p: longint; d: tdef);
  122. begin
  123. inherited create(d);
  124. agginfo:=info;
  125. pos:=p;
  126. end;
  127. procedure tllvmtypedconstplaceholder.replace(ai: tai; d: tdef);
  128. var
  129. oldconst: tai_abstracttypedconst;
  130. begin
  131. if d<>def then
  132. internalerror(2015091002);
  133. oldconst:=agginfo.aggai.replacevalueatpos(
  134. tai_simpletypedconst.create(tck_simple,d,ai),pos
  135. );
  136. oldconst.free;
  137. end;
  138. { tllvmtai_typedconstbuilder }
  139. class constructor tllvmtai_typedconstbuilder.classcreate;
  140. begin
  141. caggregateinformation:=tllvmaggregateinformation;
  142. end;
  143. procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
  144. var
  145. newasmlist: tasmlist;
  146. decl: taillvmdecl;
  147. begin
  148. newasmlist:=tasmlist.create;
  149. if assigned(foverriding_def) then
  150. def:=foverriding_def;
  151. { llvm declaration with as initialisation data all the elements from the
  152. original asmlist }
  153. decl:=taillvmdecl.createdef(sym,def,fasmlist,section,alignment);
  154. if fappendingdef then
  155. include(decl.flags,ldf_appending);
  156. if section=sec_user then
  157. decl.setsecname(secname);
  158. if tcalo_is_lab in options then
  159. include(decl.flags,ldf_unnamed_addr);
  160. if ([tcalo_vectorized_dead_strip_start,
  161. tcalo_vectorized_dead_strip_item,
  162. tcalo_vectorized_dead_strip_end]*options)<>[] then
  163. include(decl.flags,ldf_vectorized);
  164. if tcalo_weak in options then
  165. include(decl.flags,ldf_weak);
  166. { TODO: tcalo_no_dead_strip: add to @llvm.user meta-variable }
  167. newasmlist.concat(decl);
  168. fasmlist:=newasmlist;
  169. end;
  170. procedure tllvmtai_typedconstbuilder.update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
  171. begin
  172. { the outer tai must always be a typed constant (possibly a wrapper
  173. around a taillvm or so), in order for result type information to be
  174. available }
  175. if outerai.typ<>ait_typedconst then
  176. internalerror(2014060401);
  177. { is the result of the outermost expression different from the type of
  178. this typed const? -> insert type conversion }
  179. if not assigned(fqueued_tai) and
  180. (resdef<>fqueued_def) and
  181. (llvmencodetypename(resdef)<>llvmencodetypename(fqueued_def)) then
  182. queue_typeconvn(resdef,fqueued_def);
  183. if assigned(fqueued_tai) then
  184. begin
  185. taillvm(flast_added_tai).loadtai(fqueued_tai_opidx,outerai);
  186. { already flushed? }
  187. if fqueued_tai_opidx=-1 then
  188. internalerror(2014062201);
  189. end
  190. else
  191. begin
  192. fqueued_tai:=outerai;
  193. fqueued_def:=resdef;
  194. end;
  195. fqueued_tai_opidx:=newindex;
  196. flast_added_tai:=innerai;
  197. end;
  198. function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
  199. begin
  200. result:=tai_simpletypedconst.create(tck_simple,def,p);
  201. end;
  202. destructor tllvmtai_typedconstbuilder.destroy;
  203. begin
  204. inherited destroy;
  205. end;
  206. procedure tllvmtai_typedconstbuilder.emit_tai(p: tai; def: tdef);
  207. var
  208. arrdef: tdef;
  209. begin
  210. { inside an aggregate, an 80 bit floating point number must be
  211. emitted as an array of 10 bytes to prevent ABI alignment and
  212. padding to 16 bytes }
  213. if (def.typ=floatdef) and
  214. (tfloatdef(def).floattype=s80real) and
  215. assigned(curagginfo) then
  216. do_emit_extended_in_aggregate(p)
  217. else
  218. inherited;
  219. end;
  220. procedure tllvmtai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
  221. var
  222. ai: tai;
  223. stc: tai_abstracttypedconst;
  224. kind: ttypedconstkind;
  225. info: tllvmaggregateinformation;
  226. begin
  227. if queue_is_active then
  228. begin
  229. kind:=tck_simple;
  230. { finalise the queued expression }
  231. ai:=tai_simpletypedconst.create(kind,def,p);
  232. { set the new index to -1, so we internalerror should we try to
  233. add anything further }
  234. update_queued_tai(def,ai,ai,-1);
  235. { and emit it }
  236. stc:=tai_abstracttypedconst(fqueued_tai);
  237. def:=fqueued_def;
  238. { ensure we don't try to emit this one again }
  239. fqueued_tai:=nil;
  240. end
  241. else
  242. stc:=tai_simpletypedconst.create(tck_simple,def,p);
  243. info:=tllvmaggregateinformation(curagginfo);
  244. { these elements can be aggregates themselves, e.g. a shortstring can
  245. be emitted as a series of bytes and string data arrays }
  246. kind:=aggregate_kind(def);
  247. if (kind<>tck_simple) then
  248. begin
  249. if not assigned(info) or
  250. (info.aggai.adetyp<>kind) then
  251. internalerror(2014052906);
  252. end;
  253. if assigned(info) then
  254. begin
  255. { are we emitting data that does not match the equivalent data in
  256. the llvm structure? If so, record this so that we know we have to
  257. use a custom recorddef to emit this data }
  258. if not(info.anonrecord) and
  259. (info.def.typ<>procvardef) and
  260. (aggregate_kind(info.def)=tck_record) and
  261. not info.doesnotmatchllvmdef then
  262. begin
  263. if (info.llvmnextfieldindex>=tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.symdeflist.count) or
  264. not equal_defs(def,tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.entries_by_llvm_index[info.llvmnextfieldindex].def) then
  265. info.doesnotmatchllvmdef:=true
  266. else
  267. info.llvmnextfieldindex:=info.llvmnextfieldindex+1;
  268. end;
  269. info.aggai.addvalue(stc);
  270. end
  271. else
  272. inherited do_emit_tai(stc,def);
  273. end;
  274. procedure tllvmtai_typedconstbuilder.mark_anon_aggregate_alignment;
  275. var
  276. info: tllvmaggregateinformation;
  277. begin
  278. info:=tllvmaggregateinformation(curagginfo);
  279. info.anonrecalignpos:=info.aggai.valuecount;
  280. end;
  281. procedure tllvmtai_typedconstbuilder.insert_marked_aggregate_alignment(def: tdef);
  282. var
  283. info: tllvmaggregateinformation;
  284. fillbytes: asizeint;
  285. begin
  286. info:=tllvmaggregateinformation(curagginfo);
  287. if info.anonrecalignpos=-1 then
  288. internalerror(2014091501);
  289. fillbytes:=info.prepare_next_field(def);
  290. while fillbytes>0 do
  291. begin
  292. info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(tck_simple,u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
  293. dec(fillbytes);
  294. end;
  295. end;
  296. procedure tllvmtai_typedconstbuilder.maybe_emit_tail_padding(def: tdef);
  297. var
  298. info: tllvmaggregateinformation;
  299. constdata: tai_abstracttypedconst;
  300. newdef: trecorddef;
  301. begin
  302. { in case we let LLVM align, don't add padding ourselves }
  303. if df_llvm_no_struct_packing in def.defoptions then
  304. exit;
  305. inherited;
  306. { we can only check here whether the aggregate does not match our
  307. cononical llvm definition, as the tail padding may cause a mismatch
  308. (in case not all fields have been defined), and we can't do it inside
  309. end_aggregate_internal as its inherited method (which calls this
  310. method) frees curagginfo before it returns }
  311. info:=tllvmaggregateinformation(curagginfo);
  312. if info.doesnotmatchllvmdef then
  313. begin
  314. { create a new recorddef representing this mismatched def; this can
  315. even replace an array in case it contains e.g. variant records }
  316. case info.def.typ of
  317. arraydef:
  318. { in an array, all elements come right after each other ->
  319. replace with a packed record }
  320. newdef:=crecorddef.create_global_internal('',1,1,1);
  321. recorddef,
  322. objectdef:
  323. newdef:=crecorddef.create_global_internal('',
  324. tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignment,
  325. tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignmin,
  326. tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).maxCrecordalign);
  327. else
  328. internalerror(2015122401);
  329. end;
  330. for constdata in tai_aggregatetypedconst(info.aggai) do
  331. newdef.add_field_by_def('',constdata.def);
  332. tai_aggregatetypedconst(info.aggai).changetorecord(newdef);
  333. mark_aggregate_hierarchy_llvmdef_mismatch(newdef);
  334. end;
  335. end;
  336. procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
  337. begin
  338. if not pvdef.is_addressonly then
  339. pvdef:=cprocvardef.getreusableprocaddr(pvdef);
  340. emit_tai(p,pvdef);
  341. end;
  342. procedure tllvmtai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
  343. var
  344. srsym : tsym;
  345. srsymtable: tsymtable;
  346. strrecdef : trecorddef;
  347. strdef: tdef;
  348. offset: pint;
  349. field: tfieldvarsym;
  350. dataptrdef: tdef;
  351. begin
  352. { nil pointer? }
  353. if not assigned(ll.lab) then
  354. begin
  355. if ll.ofs<>0 then
  356. internalerror(2015030701);
  357. inherited;
  358. exit;
  359. end;
  360. { if the returned offset is <> 0, then the string data
  361. starts at that offset -> translate to a field for the
  362. high level code generator }
  363. if ll.ofs<>0 then
  364. begin
  365. { get the recorddef for this string constant }
  366. if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
  367. internalerror(2014080406);
  368. strrecdef:=trecorddef(ttypesym(srsym).typedef);
  369. { offset in the record of the the string data }
  370. offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
  371. { field corresponding to this offset }
  372. field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
  373. { pointerdef to the string data array }
  374. dataptrdef:=cpointerdef.getreusable(field.vardef);
  375. { the fields of the resourcestring record are declared as ansistring }
  376. strdef:=get_dynstring_def_for_type(st,winlikewidestring);
  377. queue_init(strdef);
  378. queue_typeconvn(charptrdef,strdef);
  379. queue_subscriptn(strrecdef,field);
  380. queue_emit_asmsym(ll.lab,strrecdef);
  381. end
  382. else
  383. { since llvm doesn't support labels in the middle of structs, this
  384. offset should never be 0 }
  385. internalerror(2014080506);
  386. end;
  387. procedure tllvmtai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
  388. var
  389. agg: tai_aggregatetypedconst;
  390. tck: ttypedconstkind;
  391. curagg: tllvmaggregateinformation;
  392. begin
  393. tck:=aggregate_kind(def);
  394. if tck<>tck_simple then
  395. begin
  396. { create new typed const aggregate }
  397. agg:=tai_aggregatetypedconst.create(tck,def);
  398. { either add to the current typed const aggregate (if nested), or
  399. emit to the asmlist (if top level) }
  400. curagg:=tllvmaggregateinformation(curagginfo);
  401. { create aggregate information for this new aggregate }
  402. inherited;
  403. { only add the new aggregate to the previous aggregate now, because
  404. the inherited call may have had to add padding bytes first }
  405. if assigned(curagg) then
  406. curagg.aggai.addvalue(agg)
  407. else
  408. fasmlist.concat(agg);
  409. { set new current typed const aggregate }
  410. tllvmaggregateinformation(curagginfo).aggai:=agg
  411. end
  412. else
  413. inherited;
  414. end;
  415. procedure tllvmtai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
  416. var
  417. info: tllvmaggregateinformation;
  418. was_aggregate: boolean;
  419. begin
  420. was_aggregate:=false;
  421. if aggregate_kind(def)<>tck_simple then
  422. begin
  423. was_aggregate:=true;
  424. info:=tllvmaggregateinformation(curagginfo);
  425. if not assigned(info) then
  426. internalerror(2014060101);
  427. info.aggai.finish;
  428. end;
  429. inherited;
  430. info:=tllvmaggregateinformation(curagginfo);
  431. if assigned(info) and
  432. was_aggregate and
  433. not info.doesnotmatchllvmdef then
  434. begin
  435. { are we emitting data that does not match the equivalent data in
  436. the llvm structure? If so, record this so that we know we have to
  437. use a custom recorddef to emit this data }
  438. if not info.anonrecord and
  439. (aggregate_kind(info.def)=tck_record) and
  440. ((info.llvmnextfieldindex>=tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.symdeflist.count) or
  441. not equal_defs(def,tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.entries_by_llvm_index[info.llvmnextfieldindex].def)) then
  442. info.doesnotmatchllvmdef:=true
  443. else
  444. info.llvmnextfieldindex:=info.llvmnextfieldindex+1;
  445. end;
  446. end;
  447. function tllvmtai_typedconstbuilder.get_internal_data_section_start_label: tasmlabel;
  448. begin
  449. { let llvm take care of everything by creating internal nameless
  450. constants }
  451. current_asmdata.getlocaldatalabel(result);
  452. end;
  453. function tllvmtai_typedconstbuilder.get_internal_data_section_internal_label: tasmlabel;
  454. begin
  455. current_asmdata.getlocaldatalabel(result);
  456. end;
  457. procedure tllvmtai_typedconstbuilder.do_emit_extended_in_aggregate(p: tai);
  458. type
  459. p80realval =^t80realval;
  460. t80realval = packed record
  461. case byte of
  462. 0: (v: ts80real);
  463. 1: (a: array[0..9] of byte);
  464. end;
  465. var
  466. arrdef: tdef;
  467. i: longint;
  468. realval: p80realval;
  469. begin
  470. { emit as an array of 10 bytes }
  471. arrdef:=carraydef.getreusable(u8inttype,10);
  472. maybe_begin_aggregate(arrdef);
  473. if (p.typ<>ait_realconst) then
  474. internalerror(2015062401);
  475. realval:=p80realval(@tai_realconst(p).value.s80val);
  476. if target_info.endian=source_info.endian then
  477. for i:=0 to 9 do
  478. emit_tai(tai_const.Create_8bit(realval^.a[i]),u8inttype)
  479. else
  480. for i:=9 downto 0 do
  481. emit_tai(tai_const.Create_8bit(realval^.a[i]),u8inttype);
  482. maybe_end_aggregate(arrdef);
  483. { free the original constant, since we didn't emit it }
  484. p.free;
  485. end;
  486. procedure tllvmtai_typedconstbuilder.mark_aggregate_hierarchy_llvmdef_mismatch(new_current_level_def: trecorddef);
  487. var
  488. aggregate_level,
  489. i: longint;
  490. info: tllvmaggregateinformation;
  491. begin
  492. if assigned(faggregateinformation) then
  493. begin
  494. aggregate_level:=faggregateinformation.count;
  495. { the top element, at aggregate_level-1, is already marked, since
  496. that's why we are marking the rest }
  497. for i:=aggregate_level-2 downto 0 do
  498. begin
  499. info:=tllvmaggregateinformation(faggregateinformation[i]);
  500. if info.doesnotmatchllvmdef then
  501. break;
  502. info.doesnotmatchllvmdef:=true;
  503. end;
  504. if aggregate_level=1 then
  505. foverriding_def:=new_current_level_def;
  506. end;
  507. end;
  508. procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
  509. begin
  510. inherited;
  511. fqueued_tai:=nil;
  512. flast_added_tai:=nil;
  513. fqueued_tai_opidx:=-1;
  514. end;
  515. procedure tllvmtai_typedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint);
  516. var
  517. ai: taillvm;
  518. aityped: tai;
  519. eledef: tdef;
  520. vecindex: asizeint;
  521. begin
  522. { update range checking info }
  523. inherited;
  524. vecindex:=index.svalue;
  525. if def.typ=arraydef then
  526. dec(vecindex,tarraydef(def).lowrange);
  527. ai:=taillvm.getelementptr_reg_tai_size_const(NR_NO,nil,ptrsinttype,vecindex,true);
  528. case def.typ of
  529. arraydef:
  530. eledef:=tarraydef(def).elementdef;
  531. stringdef:
  532. case tstringdef(def).stringtype of
  533. st_shortstring,
  534. st_longstring,
  535. st_ansistring:
  536. eledef:=cansichartype;
  537. st_widestring,
  538. st_unicodestring:
  539. eledef:=cwidechartype;
  540. else
  541. internalerror(2014062202);
  542. end;
  543. else
  544. internalerror(2014062203);
  545. end;
  546. aityped:=wrap_with_type(ai,cpointerdef.getreusable(eledef));
  547. update_queued_tai(cpointerdef.getreusable(eledef),aityped,ai,1);
  548. end;
  549. procedure tllvmtai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
  550. var
  551. getllvmfieldaddr,
  552. getpascalfieldaddr,
  553. getllvmfieldaddrtyped: tai;
  554. llvmfielddef: tdef;
  555. begin
  556. { update range checking info }
  557. inherited;
  558. llvmfielddef:=tabstractrecordsymtable(def.symtable).llvmst[vs].def;
  559. { get the address of the llvm-struct field that corresponds to this
  560. Pascal field }
  561. getllvmfieldaddr:=taillvm.getelementptr_reg_tai_size_const(NR_NO,nil,s32inttype,vs.llvmfieldnr,true);
  562. { getelementptr doesn't contain its own resultdef, so encode it via a
  563. tai_simpletypedconst tai }
  564. getllvmfieldaddrtyped:=wrap_with_type(getllvmfieldaddr,cpointerdef.getreusable(llvmfielddef));
  565. { if it doesn't match the requested field exactly (variant record),
  566. fixup the result }
  567. getpascalfieldaddr:=getllvmfieldaddrtyped;
  568. if (vs.offsetfromllvmfield<>0) or
  569. (llvmfielddef<>vs.vardef) then
  570. begin
  571. { offset of real field relative to llvm-struct field <> 0? }
  572. if vs.offsetfromllvmfield<>0 then
  573. begin
  574. { convert to a pointer to a 1-sized element }
  575. if llvmfielddef.size<>1 then
  576. begin
  577. getpascalfieldaddr:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,getpascalfieldaddr,u8inttype);
  578. { update the current fielddef of the expression }
  579. llvmfielddef:=u8inttype;
  580. end;
  581. { add the offset }
  582. getpascalfieldaddr:=taillvm.getelementptr_reg_tai_size_const(NR_NO,getpascalfieldaddr,ptrsinttype,vs.offsetfromllvmfield,true);
  583. { ... and set the result type of the getelementptr }
  584. getpascalfieldaddr:=wrap_with_type(getpascalfieldaddr,cpointerdef.getreusable(u8inttype));
  585. llvmfielddef:=u8inttype;
  586. end;
  587. { bitcast the data at the final offset to the right type }
  588. if llvmfielddef<>vs.vardef then
  589. getpascalfieldaddr:=wrap_with_type(taillvm.op_reg_tai_size(la_bitcast,NR_NO,getpascalfieldaddr,cpointerdef.getreusable(vs.vardef)),cpointerdef.getreusable(vs.vardef));
  590. end;
  591. update_queued_tai(cpointerdef.getreusable(vs.vardef),getpascalfieldaddr,getllvmfieldaddr,1);
  592. end;
  593. procedure tllvmtai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
  594. var
  595. ai: taillvm;
  596. typedai: tai;
  597. tmpintdef: tdef;
  598. op,
  599. firstop,
  600. secondop: tllvmop;
  601. begin
  602. inherited;
  603. { special case: procdef -> procvardef/pointerdef: must take address of
  604. the procdef }
  605. if (fromdef.typ=procdef) and
  606. (todef.typ<>procdef) then
  607. fromdef:=cprocvardef.getreusableprocaddr(tprocdef(fromdef));
  608. { typecasting a pointer-sized entity to a complex procvardef -> convert
  609. to the pointer-component of the complex procvardef (not always, because
  610. e.g. a tmethod to complex procvar initialises the entire complex
  611. procvar) }
  612. if (todef.typ=procvardef) and
  613. not tprocvardef(todef).is_addressonly and
  614. (fromdef.size<todef.size) then
  615. todef:=cprocvardef.getreusableprocaddr(tprocvardef(todef));
  616. op:=llvmconvop(fromdef,todef,false);
  617. case op of
  618. la_ptrtoint_to_x,
  619. la_x_to_inttoptr:
  620. begin
  621. { convert via an integer with the same size as "x" }
  622. if op=la_ptrtoint_to_x then
  623. begin
  624. tmpintdef:=cgsize_orddef(def_cgsize(todef));
  625. firstop:=la_ptrtoint;
  626. secondop:=la_bitcast
  627. end
  628. else
  629. begin
  630. tmpintdef:=cgsize_orddef(def_cgsize(fromdef));
  631. firstop:=la_bitcast;
  632. secondop:=la_inttoptr;
  633. end;
  634. { since we have to queue operations from outer to inner, first queue
  635. the conversion from the tempintdef to the todef }
  636. ai:=taillvm.op_reg_tai_size(secondop,NR_NO,nil,todef);
  637. typedai:=wrap_with_type(ai,todef);
  638. update_queued_tai(todef,typedai,ai,1);
  639. todef:=tmpintdef;
  640. op:=firstop
  641. end;
  642. end;
  643. ai:=taillvm.op_reg_tai_size(op,NR_NO,nil,todef);
  644. typedai:=wrap_with_type(ai,todef);
  645. update_queued_tai(todef,typedai,ai,1);
  646. end;
  647. procedure tllvmtai_typedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
  648. begin
  649. { we've already incorporated the offset via the inserted operations above,
  650. make sure it doesn't get emitted again as part of the tai_const for
  651. the tasmsymbol }
  652. fqueue_offset:=0;
  653. inherited;
  654. end;
  655. procedure tllvmtai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
  656. begin
  657. { we've already incorporated the offset via the inserted operations above,
  658. make sure it doesn't get emitted again as part of the tai_const for
  659. the tasmsymbol }
  660. fqueue_offset:=0;
  661. inherited;
  662. end;
  663. procedure tllvmtai_typedconstbuilder.queue_emit_ordconst(value: int64; def: tdef);
  664. begin
  665. { no offset into an ordinal constant }
  666. if fqueue_offset<>0 then
  667. internalerror(2015030702);
  668. inherited;
  669. end;
  670. class function tllvmtai_typedconstbuilder.get_vectorized_dead_strip_custom_section_name(const basename: TSymStr; st: tsymtable; out secname: TSymStr): boolean;
  671. begin
  672. result:=inherited;
  673. if result then
  674. exit;
  675. { put all of the resource strings in a single section: it doesn't hurt,
  676. and this avoids problems with Darwin/mach-o's limitation of 255
  677. sections }
  678. secname:=basename;
  679. { Darwin requires specifying a segment name too }
  680. if target_info.system in systems_darwin then
  681. secname:='__DATA,'+secname;
  682. result:=true;
  683. end;
  684. function tllvmtai_typedconstbuilder.emit_placeholder(def: tdef): ttypedconstplaceholder;
  685. var
  686. pos: longint;
  687. begin
  688. check_add_placeholder(def);
  689. { we can't support extended constants, because those are transformed into
  690. an array of bytes, so we can't easily replace them afterwards }
  691. if (def.typ=floatdef) and
  692. (tfloatdef(def).floattype=s80real) then
  693. internalerror(2015091003);
  694. pos:=tllvmaggregateinformation(curagginfo).aggai.valuecount;
  695. emit_tai(tai_marker.Create(mark_position),def);
  696. result:=tllvmtypedconstplaceholder.create(tllvmaggregateinformation(curagginfo),pos,def);
  697. end;
  698. class function tllvmtai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
  699. begin
  700. { LLVM does not support labels in the middle of a declaration }
  701. result:=get_string_header_size(typ,winlikewidestring);
  702. end;
  703. begin
  704. ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
  705. end.