nllvmtcon.pas 32 KB

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