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