nllvmtcon.pas 33 KB

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