nllvmtcon.pas 34 KB

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