nllvmtcon.pas 32 KB

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