nllvmtcon.pas 29 KB

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