nllvmtcon.pas 28 KB

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