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