1 /* LLVM binding
2 Copyright (C) 2014 Tristan Gingold
3
4 GHDL is free software; you can redistribute it and/or modify it under
5 the terms of the GNU General Public License as published by the Free
6 Software Foundation; either version 2, or (at your option) any later
7 version.
8
9 GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
10 WARRANTY; without even the implied warranty of MERCHANTABILITY or
11 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with GHDL; see the file COPYING. If not, write to the Free
16 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
17 02111-1307, USA. */
18
19 // Style:
20 // C bindings for types, instructions
21 // C++ API for debug
22 //
23 // Later move to C++ only.
24
25 #include "llvm-c/Target.h"
26 #include "llvm/IR/Type.h"
27 #include "llvm/IR/Value.h"
28 #include "llvm/IR/LLVMContext.h"
29 #include "llvm/Config/llvm-config.h"
30 #include "llvm-c/TargetMachine.h"
31 #include "llvm-c/Core.h"
32 #include "llvm-c/BitWriter.h"
33
34 #include "llvm-c/Analysis.h"
35 #include "llvm-c/Transforms/Scalar.h"
36 #if LLVM_VERSION_MAJOR >= 7
37 // Not present in llvm-6, present in llvm-7
38 #include "llvm-c/Transforms/Utils.h"
39 #endif
40
41 #if LLVM_VERSION_MAJOR >= 6
42 #define USE_DEBUG
43 #endif
44
45 #ifdef USE_DEBUG
46 #include "llvm/IR/IRBuilder.h"
47 #include "llvm/IR/DIBuilder.h"
48 #include "llvm/Support/FileSystem.h"
49 #include <vector>
50 #endif
51
52 #if LLVM_VERSION_MAJOR >= 4
53 #define USE_ATTRIBUTES
54 #endif
55
56 using namespace llvm;
57
58 // True if the LLVM output must be displayed (set by '--dump-llvm')
59 static bool FlagDumpLLVM = false;
60
61 // Verify generated LLVM code.
62 static bool FlagVerifyLLVM = false;
63
64 static bool FlagDebugLines = true;
65 static bool FlagDebug = false;
66
67 static LLVMModuleRef TheModule;
68 static LLVMTargetRef TheTarget;
69 static LLVMTargetMachineRef TheTargetMachine;
70 static LLVMTargetDataRef TheTargetData;
71 static LLVMRelocMode TheReloc = LLVMRelocDefault;
72 static LLVMCodeGenOptLevel Optimization = LLVMCodeGenLevelDefault;
73
74 static LLVMBuilderRef Builder;
75 static LLVMBuilderRef DeclBuilder;
76 static LLVMBuilderRef ExtraBuilder;
77
78 static LLVMValueRef StackSaveFun;
79 static LLVMValueRef StackRestoreFun;
80 static LLVMValueRef CopySignFun;
81
82 static LLVMValueRef Fp0_5;
83
84 #ifdef USE_ATTRIBUTES
85 static LLVMAttributeRef NounwindAttr;
86 static LLVMAttributeRef UwtableAttr;
87 #endif
88
89 static bool Unreach;
90
91 #ifdef USE_DEBUG
92 static unsigned DebugCurrentLine;
93 static std::string *DebugCurrentFilename;
94 static std::string *DebugCurrentDirectory;
95 static DIFile *DebugCurrentFile;
96 static DICompileUnit *DebugCurrentCU;
97
98 // Current subprogram. Used by types, parameters and static consts.
99 static DISubprogram *DebugCurrentSubprg;
100
101 // Current scope. Used by automatic variables and line locations.
102 static DIScope *DebugCurrentScope;
103
104 static DIBuilder *DBuilder;
105 #endif
106
107 extern "C" void
set_optimization_level(unsigned level)108 set_optimization_level (unsigned level)
109 {
110 switch(level) {
111 case 0:
112 Optimization = LLVMCodeGenLevelNone;
113 break;
114 case 1:
115 Optimization = LLVMCodeGenLevelLess;
116 break;
117 case 2:
118 Optimization = LLVMCodeGenLevelDefault;
119 break;
120 default:
121 Optimization = LLVMCodeGenLevelAggressive;
122 break;
123 }
124 }
125
126 extern "C" void
set_debug_level(unsigned level)127 set_debug_level (unsigned level)
128 {
129 switch(level) {
130 case 0:
131 FlagDebug = false;
132 FlagDebugLines = false;
133 break;
134 case 1:
135 FlagDebug = false;
136 FlagDebugLines = true;
137 break;
138 default:
139 FlagDebug = true;
140 FlagDebugLines = true;
141 break;
142 }
143 }
144
145 extern "C" void
set_dump_llvm(unsigned Flag)146 set_dump_llvm (unsigned Flag)
147 {
148 FlagDumpLLVM = Flag != 0;
149 }
150
151 extern "C" void
set_verify_llvm(unsigned Flag)152 set_verify_llvm (unsigned Flag)
153 {
154 FlagVerifyLLVM = Flag != 0;
155 }
156
157 extern "C" void
set_pic_flag(unsigned Flag)158 set_pic_flag (unsigned Flag)
159 {
160 TheReloc = Flag ? LLVMRelocPIC : LLVMRelocStatic;
161 }
162
163 static void
generateError(const char * Filename,char * Msg)164 generateError(const char *Filename, char *Msg)
165 {
166 fprintf(stderr, "error while writing to %s\n", Filename);
167 if (Msg) {
168 fprintf(stderr, "message: %s\n", Msg);
169 LLVMDisposeMessage(Msg);
170 }
171 exit(2);
172 }
173
174 static void
generateCommon()175 generateCommon()
176 {
177 char *Msg;
178
179 #ifdef USE_DEBUG
180 if (FlagDebugLines) {
181 DBuilder->finalize();
182 }
183 #endif
184
185 if (FlagDumpLLVM)
186 LLVMDumpModule(TheModule);
187
188 if (FlagVerifyLLVM) {
189 if (LLVMVerifyModule(TheModule, LLVMPrintMessageAction, &Msg)) {
190 LLVMDisposeMessage (Msg);
191 abort();
192 }
193 }
194
195 if (Optimization > LLVMCodeGenLevelNone) {
196 LLVMPassManagerRef PassManager;
197 PassManager = LLVMCreateFunctionPassManagerForModule (TheModule);
198
199 LLVMAddCFGSimplificationPass (PassManager);
200 LLVMAddPromoteMemoryToRegisterPass (PassManager);
201
202 for (LLVMValueRef Func = LLVMGetFirstFunction (TheModule);
203 Func != nullptr;
204 Func = LLVMGetNextFunction(Func)) {
205 LLVMRunFunctionPassManager (PassManager, Func);
206 }
207 }
208 }
209 extern "C" void
generate_object(char * Filename)210 generate_object(char *Filename)
211 {
212 char *Msg;
213
214 generateCommon();
215
216 if (LLVMTargetMachineEmitToFile (TheTargetMachine, TheModule, Filename,
217 LLVMObjectFile, &Msg))
218 generateError(Filename, Msg);
219 }
220
221 extern "C" void
generate_assembly(char * Filename)222 generate_assembly(char *Filename)
223 {
224 char *Msg;
225
226 generateCommon();
227
228 if (LLVMTargetMachineEmitToFile (TheTargetMachine, TheModule, Filename,
229 LLVMAssemblyFile, &Msg))
230 generateError(Filename, Msg);
231 }
232
233 extern "C" void
generate_bitcode(const char * Filename)234 generate_bitcode(const char *Filename)
235 {
236 generateCommon();
237
238 if (LLVMWriteBitcodeToFile(TheModule, Filename)) {
239 generateError(Filename, nullptr);
240 }
241 }
242
243 extern "C" void
generate_llvm(char * Filename)244 generate_llvm(char *Filename)
245 {
246 char *Msg;
247
248 generateCommon();
249
250 if (LLVMPrintModuleToFile(TheModule, Filename, &Msg)) {
251 generateError(Filename, Msg);
252 }
253 }
254
255 extern "C" void
ortho_llvm_init(const char * Filename,unsigned FilenameLength)256 ortho_llvm_init(const char *Filename, unsigned FilenameLength)
257 {
258 char *Msg;
259
260 LLVMInitializeNativeTarget();
261 LLVMInitializeNativeAsmPrinter();
262
263 TheModule = LLVMModuleCreateWithName ("ortho");
264
265 // Get target triple (from how llvm was configured).
266 char *Triple = LLVMGetDefaultTargetTriple();
267
268 #if LLVM_VERSION_MAJOR >= 7
269 {
270 char *RawTriple = Triple;
271 Triple = LLVMNormalizeTargetTriple(Triple);
272 LLVMDisposeMessage(RawTriple);
273 }
274 #endif
275 LLVMSetTarget(TheModule, Triple);
276
277 // Get target - this is a struct that corresponds to the triple.
278 if (LLVMGetTargetFromTriple(Triple, &TheTarget, &Msg) != 0) {
279 fprintf(stderr, "llvm: cannot find target %s: %s\n", Triple, Msg);
280 LLVMDisposeMessage(Msg);
281 exit (1);
282 }
283
284 // Create a target machine
285 TheTargetMachine = LLVMCreateTargetMachine
286 (TheTarget, Triple, "", "", Optimization, TheReloc,
287 LLVMCodeModelDefault);
288
289 #if LLVM_VERSION_MAJOR < 4
290 TheTargetData = LLVMGetTargetMachineData (TheTargetMachine);
291 LLVMSetDataLayout (TheModule, LLVMCopyStringRepOfTargetData (TheTargetData));
292 #else
293 TheTargetData = LLVMCreateTargetDataLayout(TheTargetMachine);
294 LLVMSetModuleDataLayout(TheModule, TheTargetData);
295 #endif
296
297 Builder = LLVMCreateBuilder();
298 DeclBuilder = LLVMCreateBuilder();
299 ExtraBuilder = LLVMCreateBuilder();
300
301 LLVMTypeRef I8Ptr = LLVMPointerType(LLVMInt8Type(), 0);
302
303 StackSaveFun = LLVMAddFunction
304 (TheModule, "llvm.stacksave", LLVMFunctionType (I8Ptr, NULL, 0, false));
305
306 LLVMTypeRef ParamTypes[2];
307
308 ParamTypes[0] = I8Ptr;
309 StackRestoreFun = LLVMAddFunction
310 (TheModule, "llvm.stackrestore",
311 LLVMFunctionType(LLVMVoidType(), ParamTypes, 1, false));
312
313 ParamTypes[0] = LLVMDoubleType();
314 ParamTypes[1] = LLVMDoubleType();
315 CopySignFun = LLVMAddFunction
316 (TheModule, "llvm.copysign.f64",
317 LLVMFunctionType(LLVMDoubleType(), ParamTypes, 2, false));
318
319 Fp0_5 = LLVMConstReal(LLVMDoubleType(), 0.5);
320
321 #ifdef USE_ATTRIBUTES
322 unsigned AttrId;
323
324 AttrId = LLVMGetEnumAttributeKindForName("nounwind", 8);
325 assert (AttrId != 0);
326 NounwindAttr = LLVMCreateEnumAttribute(LLVMGetGlobalContext(), AttrId, 0);
327
328 AttrId = LLVMGetEnumAttributeKindForName("uwtable", 7);
329 assert (AttrId != 0);
330 UwtableAttr = LLVMCreateEnumAttribute(LLVMGetGlobalContext(), AttrId, 0);
331 #endif
332
333 #ifdef USE_DEBUG
334 if (FlagDebugLines) {
335 DBuilder = new DIBuilder(*unwrap(TheModule));
336
337 DebugCurrentFilename = new std::string(Filename, FilenameLength);
338 SmallString<128> CurrentDir;
339 llvm::sys::fs::current_path(CurrentDir);
340 DebugCurrentDirectory = new std::string(CurrentDir.data(),
341 CurrentDir.size());
342
343 DebugCurrentFile = DBuilder->createFile(StringRef(*DebugCurrentFilename),
344 StringRef(*DebugCurrentDirectory));
345 DebugCurrentCU = DBuilder->createCompileUnit
346 (llvm::dwarf::DW_LANG_C, DebugCurrentFile, StringRef("ortho-llvm"),
347 Optimization > LLVMCodeGenLevelNone, StringRef(), 0);
348
349 DebugCurrentScope = DebugCurrentCU;
350 }
351 #endif
352 }
353
354 // Set debug location on instruction RES
355 static void
setDebugLocation(LLVMValueRef Res)356 setDebugLocation(LLVMValueRef Res)
357 {
358 #ifdef USE_DEBUG
359 if (FlagDebugLines) {
360 unwrap(Builder)->SetInstDebugLocation(static_cast<Instruction*>(unwrap(Res)));
361 }
362 #endif
363 }
364
365 enum OTKind : unsigned char {
366 OTKUnsigned, OTKSigned, OTKFloat,
367 OTKEnum, OTKBool,
368 OTKAccess, OTKIncompleteAccess,
369 OTKRecord, OTKIncompleteRecord,
370 OTKUnion,
371 OTKArray
372 };
373
374 struct OTnodeBase {
375 LLVMTypeRef Ref;
376 #ifdef USE_DEBUG
377 DIType *Dbg;
378 #endif
379
380 OTKind Kind;
381 bool Bounded;
OTnodeBaseOTnodeBase382 OTnodeBase (LLVMTypeRef R, OTKind K, bool Bounded) :
383 Ref(R),
384 #ifdef USE_DEBUG
385 Dbg(nullptr),
386 #endif
387 Kind(K), Bounded(Bounded) {}
388
getAlignmentOTnodeBase389 unsigned getAlignment() const {
390 return LLVMABIAlignmentOfType(TheTargetData, Ref);
391 }
getSizeOTnodeBase392 unsigned long long getSize() const {
393 return LLVMABISizeOfType(TheTargetData, Ref);
394 }
getBitSizeOTnodeBase395 unsigned long long getBitSize() const {
396 return 8 * getSize();
397 }
398 };
399
400 typedef OTnodeBase *OTnode;
401
402 struct OTnodeScal : OTnodeBase {
403 // For scalar: the size in bits
404 unsigned ScalSize;
405
OTnodeScalOTnodeScal406 OTnodeScal (LLVMTypeRef R, OTKind K, unsigned Sz) :
407 OTnodeBase(R, K, true), ScalSize(Sz) {}
408 };
409
410 struct OTnodeUnsigned : OTnodeScal {
OTnodeUnsignedOTnodeUnsigned411 OTnodeUnsigned (LLVMTypeRef R, unsigned Sz) :
412 OTnodeScal(R, OTKUnsigned, Sz) {}
413 };
414
415 struct OTnodeSigned : OTnodeScal {
OTnodeSignedOTnodeSigned416 OTnodeSigned (LLVMTypeRef R, unsigned Sz) :
417 OTnodeScal(R, OTKSigned, Sz) {}
418 };
419
420 struct OTnodeFloat : OTnodeScal {
OTnodeFloatOTnodeFloat421 OTnodeFloat (LLVMTypeRef R, unsigned Sz) :
422 OTnodeScal(R, OTKFloat, Sz) {}
423 };
424
425 static LLVMTypeRef
SizeToLLVM(unsigned Sz)426 SizeToLLVM (unsigned Sz)
427 {
428 switch (Sz) {
429 case 8:
430 return LLVMInt8Type();
431 case 32:
432 return LLVMInt32Type();
433 case 64:
434 return LLVMInt64Type();
435 default:
436 abort();
437 }
438 }
439
440 extern "C" OTnode
new_unsigned_type(unsigned Sz)441 new_unsigned_type(unsigned Sz)
442 {
443 return new OTnodeUnsigned(SizeToLLVM(Sz), Sz);
444 }
445
446 extern "C" OTnode
new_signed_type(unsigned Sz)447 new_signed_type(unsigned Sz)
448 {
449 return new OTnodeSigned(SizeToLLVM(Sz), Sz);
450 }
451
452 extern "C" OTnode
new_float_type()453 new_float_type()
454 {
455 return new OTnodeFloat(LLVMDoubleType(), 64);
456 }
457
458 struct OTnodeEnumBase : OTnodeScal {
459 #ifdef USE_DEBUG
460 DINodeArray *DbgEls;
461 #endif
OTnodeEnumBaseOTnodeEnumBase462 OTnodeEnumBase (LLVMTypeRef R, OTKind K, unsigned Sz) :
463 OTnodeScal(R, K, Sz) {}
464 };
465
466 struct OTnodeEnum : OTnodeEnumBase {
OTnodeEnumOTnodeEnum467 OTnodeEnum (LLVMTypeRef R, unsigned Sz) :
468 OTnodeEnumBase(R, OTKEnum, Sz) {}
469 };
470
471 struct OEnumList {
472 LLVMTypeRef Ref;
473 unsigned Pos;
474 OTnodeEnum *Etype;
475 #ifdef USE_DEBUG
476 SmallVector<Metadata *, 8> *Dbg;
477 #endif
478 };
479
480 extern "C" void
start_enum_type(OEnumList * List,unsigned Sz)481 start_enum_type (OEnumList *List, unsigned Sz)
482 {
483 LLVMTypeRef T = SizeToLLVM(Sz);
484
485 *List = {T, 0, new OTnodeEnum(T, Sz)
486 #ifdef USE_DEBUG
487 , nullptr
488 #endif
489 };
490
491 #ifdef USE_DEBUG
492 if (FlagDebug)
493 List->Dbg = new SmallVector<Metadata *, 8>();
494 #endif
495 }
496
497 struct OCnode {
498 LLVMValueRef Ref;
499 OTnode Ctype;
500 };
501
502 struct OIdent {
503 const char *cstr;
504 };
505
506 extern "C" void
new_enum_literal(OEnumList * List,OIdent Ident,OCnode * Res)507 new_enum_literal (OEnumList *List, OIdent Ident, OCnode *Res)
508 {
509 *Res = {LLVMConstInt(List->Ref, List->Pos, 0), List->Etype};
510
511 #ifdef USE_DEBUG
512 if (FlagDebug) {
513 DIEnumerator *D;
514
515 // Note: IsUnsigned argument is not available in LLVM 6.0
516 D = DBuilder->createEnumerator (StringRef(Ident.cstr), List->Pos);
517
518 List->Dbg->push_back(D);
519 }
520 #endif
521
522 List->Pos++;
523 }
524
525 extern "C" void
finish_enum_type(OEnumList * List,OTnodeEnum ** Res)526 finish_enum_type (OEnumList *List, OTnodeEnum **Res)
527 {
528 *Res = List->Etype;
529 #ifdef USE_DEBUG
530 if (FlagDebug) {
531 List->Etype->DbgEls =
532 new DINodeArray(DBuilder->getOrCreateArray(*List->Dbg));
533 delete List->Dbg;
534 }
535 #endif
536 }
537
538 struct OTnodeBool : OTnodeEnumBase {
OTnodeBoolOTnodeBool539 OTnodeBool (LLVMTypeRef R) : OTnodeEnumBase(R, OTKBool, 1) {}
540 };
541
542 extern "C" void
new_boolean_type(OTnode * Res,OIdent FalseId,OCnode * False_E,OIdent TrueId,OCnode * True_E)543 new_boolean_type(OTnode *Res,
544 OIdent FalseId, OCnode *False_E,
545 OIdent TrueId, OCnode *True_E)
546 {
547 OTnodeBool *T = new OTnodeBool(LLVMInt1Type());
548 *Res = T;
549
550 *False_E = {LLVMConstInt(T->Ref, 0, 0), T};
551 *True_E = {LLVMConstInt(T->Ref, 1, 0), T};
552
553 #ifdef USE_DEBUG
554 if (FlagDebug) {
555 SmallVector<Metadata *, 2> DbgEls;
556 DbgEls.push_back(DBuilder->createEnumerator (StringRef(FalseId.cstr), 0));
557 DbgEls.push_back(DBuilder->createEnumerator (StringRef(TrueId.cstr), 1));
558 T->DbgEls = new DINodeArray(DBuilder->getOrCreateArray(DbgEls));
559 }
560 #endif
561 }
562
563 extern "C" OCnode
new_signed_literal(OTnode LType,int64_t Value)564 new_signed_literal (OTnode LType, int64_t Value)
565 {
566 return {LLVMConstInt(LType->Ref, Value, 1), LType};
567 }
568
569 extern "C" OCnode
new_unsigned_literal(OTnode LType,uint64_t Value)570 new_unsigned_literal (OTnode LType, uint64_t Value)
571 {
572 return {LLVMConstInt(LType->Ref, Value, 0), LType};
573 }
574
575 extern "C" OCnode
new_float_literal(OTnode LType,double Value)576 new_float_literal (OTnode LType, double Value)
577 {
578 return {LLVMConstReal(LType->Ref, Value), LType};
579 }
580
581 struct OTnodeAccBase : OTnodeBase {
582 // For accesses
583 OTnode Acc;
584
OTnodeAccBaseOTnodeAccBase585 OTnodeAccBase (LLVMTypeRef R, OTKind Kind, OTnode Acc) :
586 OTnodeBase(R, Kind, true), Acc(Acc) {}
587 };
588
589 struct OTnodeAcc : OTnodeAccBase {
OTnodeAccOTnodeAcc590 OTnodeAcc (LLVMTypeRef R, OTnode Acc) :
591 OTnodeAccBase(R, OTKAccess, Acc) {}
592 };
593
594 struct OTnodeIncompleteAcc : OTnodeAccBase {
OTnodeIncompleteAccOTnodeIncompleteAcc595 OTnodeIncompleteAcc () :
596 OTnodeAccBase(nullptr, OTKIncompleteAccess, nullptr) {}
597 };
598
599 extern "C" OTnode
new_access_type(OTnode DType)600 new_access_type(OTnode DType)
601 {
602 if (DType == nullptr) {
603 return new OTnodeIncompleteAcc();
604 } else {
605 return new OTnodeAcc(LLVMPointerType(DType->Ref, 0), DType);
606 }
607 }
608
609 extern "C" void
finish_access_type(OTnodeAcc * AccType,OTnode DType)610 finish_access_type(OTnodeAcc *AccType, OTnode DType)
611 {
612 // Must be incomplete.
613 assert (AccType->Acc == nullptr);
614
615 LLVMTypeRef Types[1] = { DType->Ref };
616 LLVMStructSetBody(LLVMGetElementType(AccType->Ref), Types, 1, 0);
617 AccType->Acc = DType;
618 #ifdef USE_DEBUG
619 if (FlagDebug) {
620 // The '3' is a little bit magic, but correspond to the base type as
621 // defined (e.g.) in DebugInfoMetadata.h for DIDerivedType::getBaseType()
622 AccType->Dbg->replaceOperandWith(3, DType->Dbg);
623 }
624 #endif
625 }
626
627 extern "C" OCnode
new_null_access(OTnode LType)628 new_null_access (OTnode LType)
629 {
630 return {LLVMConstNull(LType->Ref), LType};
631 }
632
633 enum OFKind { OF_Record, OF_Union};
634
635 struct OFnodeBase {
636 OFKind Kind;
637 OTnode FType;
638 OIdent Ident;
OFnodeBaseOFnodeBase639 OFnodeBase(OFKind Kind, OTnode FType, OIdent Ident) :
640 Kind(Kind), FType(FType), Ident(Ident) {}
641 };
642
643 struct OElementList {
644 OFKind Kind;
645
646 // Number of fields.
647 unsigned Count;
648
649 // For record: the access to the incomplete (but named) type.
650 OTnode RecType;
651
652 // For unions: biggest for size and alignment
653 unsigned Size;
654 unsigned Align;
655 // For unions: type with the biggest alignment.
656 LLVMTypeRef AlignType;
657
658 std::vector<OFnodeBase *> *Els;
659 };
660
661 extern "C" void
start_record_type(OElementList * Elements)662 start_record_type (OElementList *Elements)
663 {
664 *Elements = {OF_Record,
665 0,
666 nullptr,
667 0, 0, nullptr,
668 new std::vector<OFnodeBase *>()};
669 }
670
671 struct OFnodeRec : OFnodeBase {
672 unsigned Index;
OFnodeRecOFnodeRec673 OFnodeRec(OTnode Etype, OIdent Ident, unsigned Index) :
674 OFnodeBase(OF_Record, Etype, Ident), Index(Index) {}
675 };
676
677 struct OFnodeUnion : OFnodeBase {
678 LLVMTypeRef Utype;
679 // Pointer type - used to do conversion between the union and the field.
680 LLVMTypeRef PtrType;
OFnodeUnionOFnodeUnion681 OFnodeUnion(OTnode Etype, OIdent Ident, LLVMTypeRef PtrType) :
682 OFnodeBase(OF_Union, Etype, Ident), Utype(Etype->Ref), PtrType(PtrType) {}
683 };
684
685 extern "C" void
new_record_field(OElementList * Elements,OFnodeRec ** El,OIdent Ident,OTnode Etype)686 new_record_field(OElementList *Elements,
687 OFnodeRec **El, OIdent Ident, OTnode Etype)
688 {
689 *El = new OFnodeRec(Etype, Ident, Elements->Count);
690 Elements->Els->push_back(*El);
691 Elements->Count++;
692 }
693
694 struct OTnodeRecBase : OTnodeBase {
695 std::vector<OFnodeBase *> Els;
OTnodeRecBaseOTnodeRecBase696 OTnodeRecBase (LLVMTypeRef R, OTKind Kind, bool Bounded) :
697 OTnodeBase(R, Kind, Bounded) {}
698 };
699
700 struct OTnodeRec : OTnodeRecBase {
OTnodeRecOTnodeRec701 OTnodeRec (LLVMTypeRef R, bool Bounded) :
702 OTnodeRecBase(R, OTKRecord, Bounded) {}
703 };
704
705 struct OTnodeIncompleteRec : OTnodeRecBase {
OTnodeIncompleteRecOTnodeIncompleteRec706 OTnodeIncompleteRec () :
707 OTnodeRecBase(nullptr, OTKIncompleteRecord, false) {}
708 };
709
710 #ifdef USE_DEBUG
711 static DINodeArray
buildDebugRecordElements(OTnodeRecBase * Atype)712 buildDebugRecordElements(OTnodeRecBase *Atype)
713 {
714 unsigned Count = Atype->Els.size();
715 std::vector<Metadata *> els(Count);
716
717 unsigned i = 0;
718 for (OFnodeBase *e : Atype->Els) {
719 unsigned bitoff = 8 * LLVMOffsetOfElement(TheTargetData, Atype->Ref, i);
720 els[i++] = DBuilder->createMemberType
721 (DebugCurrentSubprg, StringRef(e->Ident.cstr), NULL, 0,
722 e->FType->getBitSize(), /* align */ 0,
723 bitoff, DINode::DIFlags::FlagZero, e->FType->Dbg);
724 }
725
726 return DBuilder->getOrCreateArray(els);
727 }
728 #endif
729
730 extern "C" void
finish_record_type(OElementList * Els,OTnode * Res)731 finish_record_type(OElementList *Els, OTnode *Res)
732 {
733 LLVMTypeRef *Types = new LLVMTypeRef[Els->Count];
734
735 // Create types array for elements.
736 int i = 0;
737 bool Bounded = true;
738 for (OFnodeBase *Field : *Els->Els) {
739 Bounded &= Field->FType->Bounded;
740 Types[i++] = Field->FType->Ref;
741 }
742
743 OTnodeRecBase *T;
744
745 if (Els->RecType != nullptr) {
746 // Completion
747 LLVMStructSetBody (Els->RecType->Ref, Types, Els->Count, 0);
748 Els->RecType->Bounded = Bounded;
749 T = static_cast<OTnodeRecBase *>(Els->RecType);
750 T->Els = std::move(*Els->Els);
751 #ifdef USE_DEBUG
752 if (FlagDebug) {
753 DICompositeType *Dbg;
754 Dbg = DBuilder->createStructType
755 (DebugCurrentSubprg, T->Dbg->getName(), DebugCurrentFile,
756 DebugCurrentLine, T->getBitSize(), /* Align */ 0,
757 DINode::DIFlags::FlagZero, nullptr,
758 buildDebugRecordElements(T));
759 llvm::TempMDNode fwd_decl(T->Dbg);
760 T->Dbg = DBuilder->replaceTemporary(std::move(fwd_decl), Dbg);
761 }
762 #endif
763 } else {
764 // Non-completion.
765 // Debug info are created when the type is declared.
766 T = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), Bounded);
767 T->Els = std::move(*Els->Els);
768 }
769 *Res = T;
770 }
771
772 struct OElementSublist {
773 // Number of fields.
774 unsigned Count;
775 std::vector<OFnodeBase *> *Base_Els;
776 std::vector<OFnodeBase *> *Els;
777 };
778
779 extern "C" void
start_record_subtype(OTnodeRec * Rtype,OElementSublist * Elements)780 start_record_subtype (OTnodeRec *Rtype, OElementSublist *Elements)
781 {
782 *Elements = {0,
783 &Rtype->Els,
784 new std::vector<OFnodeBase *>()};
785 }
786
787 extern "C" void
new_subrecord_field(OElementSublist * Elements,OFnodeRec ** El,OTnode Etype)788 new_subrecord_field(OElementSublist *Elements,
789 OFnodeRec **El, OTnode Etype)
790 {
791 OFnodeBase *Bel = (*Elements->Base_Els)[Elements->Count];
792 *El = new OFnodeRec(Etype, Bel->Ident, Elements->Count);
793 Elements->Els->push_back(*El);
794 Elements->Count++;
795 }
796
797 extern "C" void
finish_record_subtype(OElementSublist * Els,OTnode * Res)798 finish_record_subtype(OElementSublist *Els, OTnode *Res)
799 {
800 LLVMTypeRef *Types = new LLVMTypeRef[Els->Count];
801
802 // Create types array for elements.
803 int i = 0;
804 for (OFnodeBase *Field : *Els->Els) {
805 Types[i++] = Field->FType->Ref;
806 }
807
808 OTnodeRecBase *T;
809 T = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), true);
810 T->Els = std::move(*Els->Els);
811 *Res = T;
812 }
813
814 extern "C" void
new_uncomplete_record_type(OTnode * Res)815 new_uncomplete_record_type(OTnode *Res)
816 {
817 *Res = new OTnodeIncompleteRec();
818 }
819
820 extern "C" void
start_uncomplete_record_type(OTnodeRec * Res,OElementList * Els)821 start_uncomplete_record_type(OTnodeRec *Res, OElementList *Els)
822 {
823 // Must be incomplete.
824 assert (Res->Kind == OTKIncompleteRecord);
825
826 *Els = {OF_Record,
827 0,
828 Res,
829 0, 0, nullptr,
830 new std::vector<OFnodeBase *>()};
831 }
832
833 extern "C" void
start_union_type(OElementList * Els)834 start_union_type(OElementList *Els)
835 {
836 *Els = {OF_Union,
837 0,
838 nullptr,
839 0, 0, nullptr,
840 new std::vector<OFnodeBase *>()};
841 }
842
843 extern "C" void
new_union_field(OElementList * Els,OFnodeUnion ** El,OIdent Ident,OTnode Etype)844 new_union_field(OElementList *Els, OFnodeUnion **El,
845 OIdent Ident, OTnode Etype)
846 {
847 unsigned Size = Etype->getSize();
848 unsigned Align = Etype->getAlignment();
849
850 *El = new OFnodeUnion(Etype, Ident, LLVMPointerType(Etype->Ref, 0));
851
852 if (Size > Els->Size)
853 Els->Size = Size;
854 if (Els->AlignType == nullptr || Align > Els->Align) {
855 Els->Align = Align;
856 Els->AlignType = Etype->Ref;
857 }
858 Els->Els->push_back(*El);
859 }
860
861 struct OTnodeUnion : OTnodeBase {
862 // For unions
863 std::vector<OFnodeBase *> Els;
864 unsigned Size;
865 LLVMTypeRef MainField;
866
OTnodeUnionOTnodeUnion867 OTnodeUnion(LLVMTypeRef R, unsigned Sz, LLVMTypeRef Main) :
868 OTnodeBase(R, OTKUnion, true), Size(Sz), MainField(Main) {}
869 };
870
871
872 extern "C" void
finish_union_type(OElementList * Els,OTnode * Res)873 finish_union_type(OElementList *Els, OTnode *Res)
874 {
875 unsigned Count;
876 LLVMTypeRef Types[2];
877
878 if (Els->AlignType == nullptr) {
879 // An empty union
880 Count = 0;
881 } else {
882 unsigned Pad;
883
884 Types[0] = Els->AlignType;
885 Pad = Els->Size - LLVMABISizeOfType(TheTargetData, Els->AlignType);
886 if (Pad != 0) {
887 Types[1] = LLVMArrayType(LLVMInt8Type(), Pad);
888 Count = 2;
889 } else {
890 Count = 1;
891 }
892 }
893
894 OTnodeUnion *T;
895 T = new OTnodeUnion(LLVMStructType(Types, Count, 0),
896 Els->Size, Els->AlignType);
897 T->Els = std::move(*Els->Els);
898 *Res = T;
899 delete Els->Els;
900 }
901
902 struct OTnodeArr : OTnodeBase {
903 // For arrays: type of the element
904 OTnode ElType;
905
OTnodeArrOTnodeArr906 OTnodeArr(LLVMTypeRef R, bool Bounded, OTnode E) :
907 OTnodeBase(R, OTKArray, Bounded), ElType(E) {}
908 };
909
910 #ifdef USE_DEBUG
911 static void
addArrayDebug(OTnodeArr * Atype,unsigned Len)912 addArrayDebug(OTnodeArr *Atype, unsigned Len)
913 {
914 DISubrange *Rng;
915
916 Rng = DBuilder->getOrCreateSubrange(0, Len);
917 SmallVector<Metadata *, 1> Subscripts;
918 Subscripts.push_back(Rng);
919
920 OTnode ElType = static_cast<OTnodeArr *>(Atype)->ElType;
921
922 Atype->Dbg = DBuilder->createArrayType
923 (Atype->getBitSize(), /* align */ 0,
924 ElType->Dbg, DBuilder->getOrCreateArray(Subscripts));
925 }
926 #endif
927
928 extern "C" OTnode
new_array_type(OTnode ElType,OTnode IndexType)929 new_array_type(OTnode ElType, OTnode IndexType)
930 {
931 OTnodeArr *Res;
932 unsigned Len = 0;
933
934 Res = new OTnodeArr(LLVMArrayType(ElType->Ref, Len), false, ElType);
935
936 #ifdef USE_DEBUG
937 if (FlagDebug)
938 addArrayDebug(Res, Len);
939 #endif
940
941 return Res;
942 }
943
944 extern "C" OTnode
new_array_subtype(OTnodeArr * ArrType,OTnode ElType,OCnode * Length)945 new_array_subtype(OTnodeArr *ArrType, OTnode ElType, OCnode *Length)
946 {
947 OTnodeArr *Res;
948 unsigned Len = LLVMConstIntGetZExtValue(Length->Ref);
949
950 Res = new OTnodeArr(LLVMArrayType(ElType->Ref, Len),
951 ElType->Bounded,
952 ElType);
953
954 #ifdef USE_DEBUG
955 if (FlagDebug)
956 addArrayDebug(Res, Len);
957 #endif
958
959 return Res;
960 }
961
962 extern "C" void
new_type_decl(OIdent Ident,OTnode Atype)963 new_type_decl(OIdent Ident, OTnode Atype)
964 {
965 switch(Atype->Kind) {
966 case OTKIncompleteAccess:
967 Atype->Ref = LLVMPointerType
968 (LLVMStructCreateNamed(LLVMGetGlobalContext(), Ident.cstr), 0);
969 break;
970 case OTKIncompleteRecord:
971 Atype->Ref = LLVMStructCreateNamed(LLVMGetGlobalContext(), Ident.cstr);
972 break;
973 default:
974 break;
975 }
976
977 #ifdef USE_DEBUG
978 // Add dwarf type.
979 if (FlagDebug) {
980 switch(Atype->Kind) {
981 case OTKUnsigned:
982 Atype->Dbg = DBuilder->createBasicType
983 (StringRef(Ident.cstr), static_cast<OTnodeScal*>(Atype)->ScalSize,
984 dwarf::DW_ATE_unsigned);
985 break;
986 case OTKSigned:
987 Atype->Dbg = DBuilder->createBasicType
988 (StringRef(Ident.cstr), static_cast<OTnodeScal*>(Atype)->ScalSize,
989 dwarf::DW_ATE_signed);
990 break;
991 case OTKFloat:
992 Atype->Dbg = DBuilder->createBasicType
993 (StringRef(Ident.cstr), static_cast<OTnodeScal*>(Atype)->ScalSize,
994 dwarf::DW_ATE_float);
995 break;
996 case OTKEnum:
997 case OTKBool:
998 Atype->Dbg = DBuilder->createEnumerationType
999 (DebugCurrentSubprg, StringRef(Ident.cstr), DebugCurrentFile,
1000 DebugCurrentLine, static_cast<OTnodeEnumBase*>(Atype)->ScalSize,
1001 Atype->getAlignment(),
1002 *static_cast<OTnodeEnumBase*>(Atype)->DbgEls, nullptr);
1003 delete static_cast<OTnodeEnumBase*>(Atype)->DbgEls;
1004 break;
1005
1006 case OTKIncompleteAccess:
1007 if (static_cast<OTnodeAccBase*>(Atype)->Acc == nullptr) {
1008 // Still incomplete
1009 Atype->Dbg = DBuilder->createPointerType
1010 (nullptr, Atype->getBitSize(), 0, None, StringRef(Ident.cstr));
1011 break;
1012 }
1013 // Fallthrough
1014 case OTKAccess:
1015 Atype->Dbg = DBuilder->createPointerType
1016 (static_cast<OTnodeAcc*>(Atype)->Acc->Dbg,
1017 Atype->getBitSize(), 0, None, StringRef(Ident.cstr));
1018 break;
1019
1020 case OTKArray:
1021 // The debug info has already been created for arrays, as they can be
1022 // anonymous
1023 Atype->Dbg = DBuilder->createTypedef
1024 (Atype->Dbg, StringRef(Ident.cstr), DebugCurrentFile,
1025 DebugCurrentLine, DebugCurrentSubprg);
1026 break;
1027
1028 case OTKRecord:
1029 Atype->Dbg = DBuilder->createStructType
1030 (DebugCurrentSubprg, StringRef(Ident.cstr), DebugCurrentFile,
1031 DebugCurrentLine, Atype->getBitSize(), /* align */ 0,
1032 DINode::DIFlags::FlagPublic, nullptr,
1033 buildDebugRecordElements(static_cast<OTnodeRecBase *>(Atype)));
1034 break;
1035
1036 case OTKUnion:
1037 {
1038 unsigned Count = static_cast<OTnodeUnion *>(Atype)->Els.size();
1039 std::vector<Metadata *> els(Count);
1040
1041 unsigned i = 0;
1042 for (OFnodeBase *e : static_cast<OTnodeUnion *>(Atype)->Els) {
1043 els[i++] = DBuilder->createMemberType
1044 (DebugCurrentSubprg, StringRef(e->Ident.cstr), DebugCurrentFile,
1045 DebugCurrentLine, e->FType->getBitSize(),
1046 e->FType->getAlignment(), 0, DINode::DIFlags::FlagPublic,
1047 e->FType->Dbg);
1048 }
1049
1050 Atype->Dbg = DBuilder->createUnionType
1051 (DebugCurrentSubprg, StringRef(Ident.cstr), DebugCurrentFile,
1052 DebugCurrentLine, Atype->getBitSize(), Atype->getAlignment(),
1053 DINode::DIFlags::FlagPublic, DBuilder->getOrCreateArray(els));
1054 }
1055 break;
1056
1057 case OTKIncompleteRecord:
1058 Atype->Dbg = DBuilder->createReplaceableCompositeType
1059 (dwarf::DW_TAG_structure_type, StringRef(Ident.cstr),
1060 DebugCurrentSubprg, DebugCurrentFile, DebugCurrentLine);
1061 break;
1062 }
1063 }
1064 #endif
1065 }
1066
1067 struct ORecordAggrList {
1068 unsigned Len;
1069 LLVMValueRef *Els;
1070 OTnode Atype;
1071 };
1072
1073 extern "C" void
start_record_aggr(ORecordAggrList * List,OTnode Atype)1074 start_record_aggr(ORecordAggrList *List, OTnode Atype)
1075 {
1076 unsigned Count = LLVMCountStructElementTypes(Atype->Ref);
1077 *List = {0, new LLVMValueRef[Count], Atype};
1078 }
1079
1080 extern "C" void
new_record_aggr_el(ORecordAggrList * List,OCnode * Val)1081 new_record_aggr_el(ORecordAggrList *List, OCnode *Val)
1082 {
1083 List->Els[List->Len++] = Val->Ref;
1084 }
1085
1086 extern "C" void
finish_record_aggr(ORecordAggrList * List,OCnode * Res)1087 finish_record_aggr(ORecordAggrList *List, OCnode *Res)
1088 {
1089 *Res = {LLVMConstStruct(List->Els, List->Len, 0), List->Atype};
1090 delete List->Els;
1091 }
1092
1093 struct OArrayAggrList {
1094 unsigned Len;
1095 LLVMValueRef *Els;
1096 LLVMTypeRef ElType;
1097 OTnode Atype;
1098 };
1099
1100 extern "C" void
start_array_aggr(OArrayAggrList * List,OTnodeArr * Atype,unsigned len)1101 start_array_aggr(OArrayAggrList *List, OTnodeArr *Atype, unsigned len)
1102 {
1103 *List = {0, new LLVMValueRef[len], Atype->ElType->Ref, Atype};
1104 }
1105
1106 extern "C" void
new_array_aggr_el(OArrayAggrList * List,OCnode * Value)1107 new_array_aggr_el(OArrayAggrList *List, OCnode *Value)
1108 {
1109 List->Els[List->Len++] = Value->Ref;
1110 }
1111
1112 extern "C" void
finish_array_aggr(OArrayAggrList * List,OCnode * Res)1113 finish_array_aggr(OArrayAggrList *List, OCnode *Res)
1114 {
1115 *Res = {LLVMConstArray(List->ElType, List->Els, List->Len), List->Atype};
1116 delete List->Els;
1117 }
1118
1119 extern "C" OCnode
new_union_aggr(OTnodeUnion * Atype,OFnodeUnion * Field,OCnode * Value)1120 new_union_aggr(OTnodeUnion *Atype, OFnodeUnion *Field, OCnode *Value)
1121 {
1122 unsigned Size = LLVMABISizeOfType(TheTargetData, Field->Utype);
1123 LLVMValueRef Vals[2];
1124 unsigned Count;
1125
1126 Vals[0] = Value->Ref;
1127 if (Size < Atype->Size) {
1128 // Add padding.
1129 Vals[1] = LLVMGetUndef(LLVMArrayType(LLVMInt8Type(), Atype->Size - Size));
1130 Count = 2;
1131 } else {
1132 Count = 1;
1133 }
1134
1135 return {LLVMConstStruct(Vals, Count, false), Atype};
1136 }
1137
1138 extern "C" OCnode
new_default_value(OTnode Ltype)1139 new_default_value(OTnode Ltype)
1140 {
1141 return {LLVMConstNull(Ltype->Ref), Ltype};
1142 }
1143
1144 static OCnode
constToConst(OTnode Rtype,uint64_t Val)1145 constToConst(OTnode Rtype, uint64_t Val)
1146 {
1147 LLVMValueRef Ref;
1148
1149 switch (Rtype->Kind) {
1150 case OTKUnsigned:
1151 case OTKSigned:
1152 Ref = LLVMConstInt(Rtype->Ref, Val, 0);
1153 break;
1154 case OTKAccess:
1155 // It is possible to use an access type for offsetof.
1156 Ref = LLVMConstInt(LLVMInt64Type(), Val, 0);
1157 Ref = LLVMConstIntToPtr(Ref, Rtype->Ref);
1158 break;
1159 default:
1160 abort();
1161 }
1162 return {Ref, Rtype};
1163 }
1164
1165 extern "C" OCnode
new_sizeof(OTnode Atype,OTnode Rtype)1166 new_sizeof(OTnode Atype, OTnode Rtype)
1167 {
1168 return constToConst(Rtype, LLVMABISizeOfType(TheTargetData, Atype->Ref));
1169 }
1170
1171 extern "C" OCnode
new_record_sizeof(OTnode Atype,OTnode Rtype)1172 new_record_sizeof(OTnode Atype, OTnode Rtype)
1173 {
1174 return new_sizeof(Atype, Rtype);
1175 }
1176
1177 extern "C" OCnode
new_alignof(OTnode Atype,OTnode Rtype)1178 new_alignof(OTnode Atype, OTnode Rtype)
1179 {
1180 return constToConst
1181 (Rtype, LLVMABIAlignmentOfType(TheTargetData, Atype->Ref));
1182 }
1183
1184 extern "C" OCnode
new_offsetof(OTnode Atype,OFnodeRec * Field,OTnode Rtype)1185 new_offsetof(OTnode Atype, OFnodeRec *Field, OTnode Rtype)
1186 {
1187 return constToConst
1188 (Rtype, LLVMOffsetOfElement(TheTargetData, Atype->Ref, Field->Index));
1189 }
1190
1191 struct OEnode {
1192 LLVMValueRef Ref;
1193 OTnode Etype;
1194 };
1195
1196 extern "C" OEnode
new_lit(OCnode * Lit)1197 new_lit(OCnode *Lit)
1198 {
1199 return {Lit->Ref, Lit->Ctype};
1200 }
1201
1202 enum ODKind : unsigned char {
1203 ODKConst,
1204 ODKVar,
1205 ODKLocal,
1206 ODKInterface,
1207 ODKType,
1208 ODKSubprg
1209 };
1210
1211 struct ODnodeBase {
1212 LLVMValueRef Ref;
1213 OTnode Dtype;
1214 virtual ODKind getKind() const = 0;
ODnodeBaseODnodeBase1215 ODnodeBase(LLVMValueRef R, OTnode T) : Ref(R), Dtype(T) {}
~ODnodeBaseODnodeBase1216 virtual ~ODnodeBase() {}
1217 };
1218
1219 typedef ODnodeBase *ODnode;
1220
1221 struct ODnodeVar : ODnodeBase {
getKindODnodeVar1222 ODKind getKind() const override { return ODKVar; }
ODnodeVarODnodeVar1223 ODnodeVar(LLVMValueRef R, OTnode T) : ODnodeBase(R, T) {}
1224 };
1225
1226 struct ODnodeLocalVar : ODnodeBase {
getKindODnodeLocalVar1227 ODKind getKind() const override { return ODKLocal; }
ODnodeLocalVarODnodeLocalVar1228 ODnodeLocalVar(LLVMValueRef R, OTnode T) : ODnodeBase(R, T) {}
1229 };
1230
1231 enum OStorage {
1232 O_Storage_External,
1233 O_Storage_Public,
1234 O_Storage_Private,
1235 O_Storage_Local
1236 };
1237
1238 extern "C" void
new_var_decl(ODnode * Res,OIdent Ident,OStorage Storage,OTnode Atype)1239 new_var_decl(ODnode *Res, OIdent Ident, OStorage Storage, OTnode Atype)
1240 {
1241 LLVMValueRef Decl;
1242
1243 if (Storage == O_Storage_Local) {
1244 if (Unreach)
1245 Decl = nullptr;
1246 else
1247 Decl = LLVMBuildAlloca (DeclBuilder, Atype->Ref, Ident.cstr);
1248 *Res = new ODnodeLocalVar(Decl, Atype);
1249 #ifdef USE_DEBUG
1250 if (FlagDebug && !Unreach) {
1251 DILocalVariable *D;
1252
1253 D = DBuilder->createAutoVariable
1254 (DebugCurrentScope, StringRef(Ident.cstr), DebugCurrentFile,
1255 DebugCurrentLine, Atype->Dbg, true);
1256 DBuilder->insertDeclare
1257 (unwrap(Decl), D, DBuilder->createExpression(),
1258 DebugLoc::get(DebugCurrentLine, 0, DebugCurrentScope),
1259 unwrap(LLVMGetInsertBlock(DeclBuilder)));
1260 }
1261 #endif
1262 } else {
1263 if (Storage == O_Storage_External) {
1264 Decl = LLVMGetNamedGlobal(TheModule, Ident.cstr);
1265 } else {
1266 Decl = nullptr;
1267 }
1268 if (Decl == nullptr)
1269 Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
1270
1271 *Res = new ODnodeVar(Decl, Atype);
1272 if (Storage == O_Storage_Private)
1273 LLVMSetLinkage(Decl, LLVMInternalLinkage);
1274
1275 switch(Storage) {
1276 case O_Storage_Public:
1277 case O_Storage_Private:
1278 LLVMSetInitializer(Decl, LLVMConstNull(Atype->Ref));
1279 break;
1280 case O_Storage_External:
1281 case O_Storage_Local:
1282 break;
1283 }
1284
1285 #ifdef USE_DEBUG
1286 if (FlagDebug) {
1287 DIGlobalVariableExpression *GVE;
1288
1289 GVE = DBuilder->createGlobalVariableExpression
1290 (DebugCurrentSubprg, StringRef(Ident.cstr), StringRef(),
1291 DebugCurrentFile, DebugCurrentLine, Atype->Dbg,
1292 Storage == O_Storage_Private);
1293 static_cast<GlobalVariable*>(unwrap(Decl))->addDebugInfo(GVE);
1294 }
1295 #endif
1296 }
1297 }
1298
1299 struct ODnodeConst : ODnodeBase {
1300 OStorage Storage;
1301 OIdent Ident;
getKindODnodeConst1302 ODKind getKind() const override { return ODKConst; }
ODnodeConstODnodeConst1303 ODnodeConst(LLVMValueRef R, OTnode T, OStorage S, OIdent I) :
1304 ODnodeBase(R, T), Storage(S), Ident(I) {}
1305 };
1306
1307 static void
setConstAttributes(LLVMValueRef Ref,OStorage Storage)1308 setConstAttributes(LLVMValueRef Ref, OStorage Storage)
1309 {
1310 LLVMSetGlobalConstant(Ref, true);
1311 if (Storage == O_Storage_Private)
1312 LLVMSetLinkage(Ref, LLVMInternalLinkage);
1313 }
1314
1315 extern "C" void
new_const_decl(ODnode * Res,OIdent Ident,OStorage Storage,OTnode Atype)1316 new_const_decl(ODnode *Res, OIdent Ident, OStorage Storage, OTnode Atype)
1317 {
1318 LLVMValueRef Decl;
1319
1320 if (Storage == O_Storage_Local)
1321 abort();
1322
1323 if (Storage == O_Storage_External) {
1324 // It is possible to re-declare an external const.
1325 Decl = LLVMGetNamedGlobal(TheModule, Ident.cstr);
1326 if (Decl == nullptr)
1327 Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
1328 setConstAttributes(Decl, Storage);
1329 } else {
1330 // If the type of the constant is not yet bounded, delay the creation
1331 // of the constant until its initialization.
1332 if (Atype->Bounded) {
1333 Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
1334 setConstAttributes(Decl, Storage);
1335 } else {
1336 Decl = nullptr;
1337 }
1338 }
1339
1340 *Res = new ODnodeConst(Decl, Atype, Storage, Ident);
1341 }
1342
1343 extern "C" void
start_init_value(ODnodeConst ** Decl)1344 start_init_value(ODnodeConst **Decl)
1345 {
1346 }
1347
1348 extern "C" void
finish_init_value(ODnodeConst ** Decl,OCnode * Val)1349 finish_init_value(ODnodeConst **Decl, OCnode *Val)
1350 {
1351 ODnodeConst *Cst = *Decl;
1352
1353 LLVMValueRef Ref = Cst->Ref;
1354
1355 if (Ref == nullptr) {
1356 Ref = LLVMAddGlobal(TheModule, LLVMTypeOf(Val->Ref), Cst->Ident.cstr);
1357 setConstAttributes(Ref, Cst->Storage);
1358 Cst->Ref = Ref;
1359 }
1360
1361 LLVMSetInitializer(Ref, Val->Ref);
1362
1363 #ifdef USE_DEBUG
1364 if (FlagDebug && Cst->Dtype->Dbg != nullptr) {
1365 DIGlobalVariableExpression *GVE;
1366
1367 // Note: the scope of a global expression cannot be a lexical scope.
1368 GVE = DBuilder->createGlobalVariableExpression
1369 (DebugCurrentSubprg,
1370 StringRef(Cst->Ident.cstr), StringRef(),
1371 DebugCurrentFile, DebugCurrentLine,
1372 DBuilder->createQualifiedType(dwarf::DW_TAG_const_type, Cst->Dtype->Dbg),
1373 Cst->Storage == O_Storage_Private);
1374 static_cast<GlobalVariable*>(unwrap(Ref))->addDebugInfo(GVE);
1375 }
1376 #endif
1377 }
1378
1379 struct ODnodeInter : ODnodeBase {
1380 OIdent Ident;
getKindODnodeInter1381 ODKind getKind() const override { return ODKInterface; }
ODnodeInterODnodeInter1382 ODnodeInter(LLVMValueRef R, OTnode T, OIdent Id) :
1383 ODnodeBase(R, T), Ident(Id) {}
1384 };
1385
1386 struct OInterList {
1387 // Subprogram
1388 OIdent Ident;
1389 OStorage Storage;
1390 OTnode Rtype;
1391
1392 // Number of interfaces.
1393 std::vector<ODnodeInter *> *Inters;
1394 };
1395
1396 extern "C" void
start_function_decl(OInterList * Inters,OIdent Ident,OStorage Storage,OTnode Rtype)1397 start_function_decl(OInterList *Inters, OIdent Ident, OStorage Storage,
1398 OTnode Rtype)
1399 {
1400 *Inters = { Ident, Storage, Rtype,
1401 new std::vector<ODnodeInter *>() };
1402 }
1403
1404 extern "C" void
start_procedure_decl(OInterList * Inters,OIdent Ident,OStorage Storage)1405 start_procedure_decl(OInterList *Inters, OIdent Ident, OStorage Storage)
1406 {
1407 *Inters = { Ident, Storage, nullptr,
1408 new std::vector<ODnodeInter *>() };
1409 }
1410
1411 extern "C" void
new_interface_decl(OInterList * Inters,ODnode * Res,OIdent Ident,OTnode Itype)1412 new_interface_decl(OInterList *Inters,
1413 ODnode *Res, OIdent Ident, OTnode Itype)
1414 {
1415 ODnodeInter *Decl = new ODnodeInter(nullptr, Itype, Ident);
1416
1417 *Res = Decl;
1418
1419 Inters->Inters->push_back(Decl);
1420 }
1421
1422 struct ODnodeSubprg : ODnodeBase {
1423 // Interfaces
1424 std::vector<ODnodeInter *> Inters;
1425 // Storage
1426 OStorage Storage;
1427 OIdent Ident;
getKindODnodeSubprg1428 ODKind getKind() const override { return ODKSubprg; }
ODnodeSubprgODnodeSubprg1429 ODnodeSubprg(LLVMValueRef R, OTnode T, OStorage S, OIdent Id,
1430 std::vector<ODnodeInter *> Inters) :
1431 ODnodeBase(R, T), Inters(Inters), Storage(S), Ident(Id) {}
1432 };
1433
1434 extern "C" void
finish_subprogram_decl(OInterList * Inters,ODnodeSubprg ** Res)1435 finish_subprogram_decl(OInterList *Inters, ODnodeSubprg **Res)
1436 {
1437 unsigned ArgsCount = Inters->Inters->size();
1438 LLVMTypeRef *Types = new LLVMTypeRef[ArgsCount];
1439
1440 // Build array of interface types.
1441 int i = 0;
1442 for (ODnodeInter *Inter: *Inters->Inters)
1443 Types[i++] = Inter->Dtype->Ref;
1444
1445 // Return type.
1446 LLVMTypeRef Rtype;
1447 if (Inters->Rtype == nullptr)
1448 Rtype = LLVMVoidType();
1449 else
1450 Rtype = Inters->Rtype->Ref;
1451
1452 LLVMTypeRef Ftype = LLVMFunctionType(Rtype, Types, ArgsCount, 0);
1453
1454 LLVMValueRef Decl;
1455 if (Inters->Storage == O_Storage_External)
1456 Decl = LLVMGetNamedFunction(TheModule, Inters->Ident.cstr);
1457 else
1458 Decl = nullptr;
1459 if (Decl == nullptr) {
1460 Decl = LLVMAddFunction(TheModule, Inters->Ident.cstr, Ftype);
1461 #ifdef USE_ATTRIBUTES
1462 LLVMAddAttributeAtIndex(Decl, LLVMAttributeFunctionIndex, NounwindAttr);
1463 LLVMAddAttributeAtIndex(Decl, LLVMAttributeFunctionIndex, UwtableAttr);
1464 #else
1465 LLVMAddFunctionAttr (Decl, LLVMNoUnwindAttribute);
1466 LLVMAddFunctionAttr (Decl, LLVMUWTable);
1467 #endif
1468 LLVMSetFunctionCallConv(Decl, LLVMCCallConv);
1469 }
1470
1471 // Translate interfaces
1472 i = 0;
1473 for (ODnodeInter *Inter: *Inters->Inters) {
1474 Inter->Ref = LLVMGetParam(Decl, i);
1475 LLVMSetValueName(Inter->Ref, Inter->Ident.cstr);
1476 i++;
1477 }
1478
1479 // Create the result.
1480 ODnodeSubprg *R;
1481 R = new ODnodeSubprg(Decl, Inters->Rtype, Inters->Storage, Inters->Ident,
1482 std::move(*Inters->Inters));
1483 *Res = R;
1484 }
1485
1486 // Data for a declare block.
1487 struct DeclareBlock {
1488 // First basic block of the declare.
1489 LLVMBasicBlockRef StmtBB;
1490
1491 // To handle allocb: stack pointer at the entry of the block, that needs
1492 // to be restored when leaving the block (either by falling through or
1493 // via exit/next). Set only of New_Alloca is used.
1494 LLVMValueRef StackValue;
1495
1496 // Previous value block.
1497 DeclareBlock *Prev;
1498
1499 #ifdef USE_DEBUG
1500 DIScope *DebugPrevScope;
1501 #endif
1502 };
1503
1504 static DeclareBlock *CurrentDeclareBlock;
1505 static DeclareBlock *OldDeclareBlock;
1506
1507 static LLVMValueRef CurrentFunc;
1508 static ODnodeSubprg *CurrentFuncDecl;
1509
1510 static void
CreateDeclareBlock()1511 CreateDeclareBlock()
1512 {
1513 DeclareBlock *Res;
1514
1515 // Allocate a declare block
1516 if (OldDeclareBlock != nullptr) {
1517 Res = OldDeclareBlock;
1518 OldDeclareBlock = Res->Prev;
1519 } else {
1520 Res = new DeclareBlock;
1521 }
1522 *Res = { nullptr, nullptr, CurrentDeclareBlock
1523 #ifdef USE_DEBUG
1524 , nullptr
1525 #endif
1526 };
1527 CurrentDeclareBlock = Res;
1528
1529 if (!Unreach) {
1530 Res->StmtBB = LLVMAppendBasicBlock(CurrentFunc, "");
1531 }
1532 }
1533
1534 static void
DestroyDeclareBlock()1535 DestroyDeclareBlock()
1536 {
1537 DeclareBlock *Blk = CurrentDeclareBlock;
1538
1539 CurrentDeclareBlock = Blk->Prev;
1540
1541 Blk->Prev = OldDeclareBlock;
1542 OldDeclareBlock = Blk;
1543 }
1544
1545 extern "C" void
start_subprogram_body(ODnodeSubprg * Func)1546 start_subprogram_body(ODnodeSubprg *Func)
1547 {
1548 LLVMBasicBlockRef DeclBB;
1549
1550 // Nested subprograms are not supported.
1551 assert (CurrentFunc == nullptr);
1552
1553 CurrentFunc = Func->Ref;
1554 CurrentFuncDecl = Func;
1555
1556 assert(!Unreach);
1557
1558 DeclBB = LLVMAppendBasicBlock(CurrentFunc, "");
1559 LLVMPositionBuilderAtEnd(DeclBuilder, DeclBB);
1560
1561 CreateDeclareBlock();
1562 LLVMPositionBuilderAtEnd(Builder, CurrentDeclareBlock->StmtBB);
1563 #ifdef USE_DEBUG
1564 if (FlagDebugLines) {
1565 DISubroutineType *Ty;
1566
1567 std::vector<Metadata *> ParamsArr;
1568
1569 if (FlagDebug) {
1570 // First, the return type.
1571 if (Func->Dtype != nullptr)
1572 ParamsArr.push_back(Func->Dtype->Dbg);
1573 else
1574 ParamsArr.push_back(nullptr);
1575
1576 // Then the arguments type.
1577 for (ODnodeInter *Inter: Func->Inters)
1578 ParamsArr.push_back(Inter->Dtype->Dbg);
1579 }
1580
1581 DITypeRefArray Params = DBuilder->getOrCreateTypeArray(ParamsArr);
1582 Ty = DBuilder->createSubroutineType(Params);
1583
1584 #if LLVM_VERSION_MAJOR >= 8
1585 // For LLVM 8.0
1586 DebugCurrentSubprg = DBuilder->createFunction
1587 (DebugCurrentScope, StringRef(Func->Ident.cstr), StringRef(),
1588 DebugCurrentFile, DebugCurrentLine, Ty, DebugCurrentLine,
1589 Func->Storage == O_Storage_Private ? DINode::FlagPrivate : DINode::FlagPublic,
1590 DISubprogram::SPFlagDefinition);
1591 #else
1592 DebugCurrentSubprg = DBuilder->createFunction
1593 (DebugCurrentScope, StringRef(Func->Ident.cstr), StringRef(),
1594 DebugCurrentFile, DebugCurrentLine, Ty,
1595 Func->Storage == O_Storage_Private, true, DebugCurrentLine);
1596 #endif
1597 static_cast<Function*>(unwrap(CurrentFunc))->setSubprogram(DebugCurrentSubprg);
1598 DebugCurrentScope = DebugCurrentSubprg;
1599
1600 unwrap(Builder)->SetCurrentDebugLocation
1601 (DebugLoc::get(DebugCurrentLine, 0, DebugCurrentScope));
1602 }
1603
1604 if (FlagDebug) {
1605 // Crate local variables for arguments
1606 unsigned ArgNo = 1;
1607 for (ODnodeInter *Inter: Func->Inters) {
1608 LLVMValueRef Var;
1609
1610 Var = LLVMBuildAlloca(DeclBuilder, Inter->Dtype->Ref, "");
1611 DILocalVariable *D = DBuilder->createParameterVariable
1612 (DebugCurrentSubprg, StringRef(Inter->Ident.cstr), ArgNo++,
1613 DebugCurrentFile, DebugCurrentLine, Inter->Dtype->Dbg, true);
1614 DBuilder->insertDeclare
1615 (unwrap(Var), D, DBuilder->createExpression(),
1616 DebugLoc::get(DebugCurrentLine, 0, DebugCurrentSubprg),
1617 unwrap(LLVMGetInsertBlock(DeclBuilder)));
1618 LLVMBuildStore(DeclBuilder, Inter->Ref, Var);
1619 Inter->Ref = Var;
1620 }
1621 }
1622 #endif
1623 }
1624
1625 extern "C" void
finish_subprogram_body()1626 finish_subprogram_body()
1627 {
1628 // Add a jump from the declare basic block to the first statement BB.
1629 LLVMBuildBr(DeclBuilder, CurrentDeclareBlock->StmtBB);
1630
1631 // Terminate the statement BB
1632 if (!Unreach) {
1633 if (CurrentFuncDecl->Dtype == nullptr)
1634 LLVMBuildRetVoid (Builder);
1635 else
1636 LLVMBuildUnreachable (Builder);
1637 }
1638
1639 DestroyDeclareBlock();
1640
1641 CurrentFunc = nullptr;
1642 Unreach = false;
1643
1644 #ifdef USE_DEBUG
1645 if (FlagDebugLines) {
1646 DBuilder->finalizeSubprogram(DebugCurrentSubprg);
1647 DebugCurrentSubprg = nullptr;
1648 DebugCurrentScope = DebugCurrentCU;
1649 }
1650 #endif
1651 }
1652
1653 extern "C" void
start_declare_stmt()1654 start_declare_stmt ()
1655 {
1656 CreateDeclareBlock();
1657
1658 if (Unreach)
1659 return;
1660
1661 // Add a jump to the new BB.
1662 LLVMBuildBr(Builder, CurrentDeclareBlock->StmtBB);
1663
1664 LLVMPositionBuilderAtEnd(Builder, CurrentDeclareBlock->StmtBB);
1665
1666 #ifdef USE_DEBUG
1667 if (FlagDebug) {
1668 CurrentDeclareBlock->DebugPrevScope = DebugCurrentScope;
1669 DebugCurrentScope = DBuilder->createLexicalBlock
1670 (DebugCurrentScope, DebugCurrentFile, DebugCurrentLine, 0);
1671 }
1672 #endif
1673 }
1674
1675 extern "C" void
finish_declare_stmt()1676 finish_declare_stmt ()
1677 {
1678 if (!Unreach) {
1679 LLVMBasicBlockRef Bb;
1680
1681 // Create a basic block for the statements after the dclare
1682 Bb = LLVMAppendBasicBlock(CurrentFunc, "");
1683
1684 if (CurrentDeclareBlock->StackValue != nullptr) {
1685 // Restore stack pointer
1686 LLVMBuildCall(Builder, StackRestoreFun,
1687 &CurrentDeclareBlock->StackValue, 1, "");
1688 }
1689 // Execution will continue on the next statement
1690 LLVMBuildBr(Builder, Bb);
1691
1692 LLVMPositionBuilderAtEnd(Builder, Bb);
1693
1694 #ifdef USE_DEBUG
1695 if (FlagDebug) {
1696 DebugCurrentScope = CurrentDeclareBlock->DebugPrevScope;
1697 }
1698 #endif
1699 }
1700
1701 // Do not reset Unreach.
1702 DestroyDeclareBlock();
1703 }
1704
1705 struct OSNode {
1706 // BB at the entry of the loop. Will branch to it on next statement and
1707 // at the end of the loop.
1708 LLVMBasicBlockRef BBEntry;
1709 // BB after the loop. Exit statement branches to it.
1710 LLVMBasicBlockRef BBExit;
1711 };
1712
1713 extern "C" void
start_loop_stmt(OSNode * Label)1714 start_loop_stmt (OSNode *Label)
1715 {
1716 if (Unreach) {
1717 *Label = { nullptr, nullptr };
1718 return;
1719 }
1720
1721 *Label = { LLVMAppendBasicBlock(CurrentFunc, ""), nullptr };
1722 #if 1
1723 Label->BBExit = LLVMAppendBasicBlock(CurrentFunc, "");
1724 #endif
1725 LLVMBuildBr(Builder, Label->BBEntry);
1726 LLVMPositionBuilderAtEnd(Builder, Label->BBEntry);
1727 }
1728
1729 extern "C" void
finish_loop_stmt(OSNode * Label)1730 finish_loop_stmt (OSNode *Label)
1731 {
1732 if (!Unreach)
1733 LLVMBuildBr(Builder, Label->BBEntry);
1734
1735 if (Label->BBExit != nullptr) {
1736 // Continue only if the exit was reachable.
1737 LLVMPositionBuilderAtEnd(Builder, Label->BBExit);
1738 Unreach = false;
1739 } else {
1740 Unreach = true;
1741 }
1742 }
1743
1744 extern "C" void
new_exit_stmt(OSNode * Label)1745 new_exit_stmt (OSNode *Label)
1746 {
1747 if (Unreach)
1748 return;
1749
1750 #if 0
1751 // Currently LABEL is an input (so cannot be modified)
1752 if (Label->BBExit == nullptr) {
1753 // We know the end of the loop is reachable
1754 Label->BBExit = LLVMAppendBasicBlock(CurrentFunc, "");
1755 }
1756 #endif
1757
1758 LLVMBuildBr(Builder, Label->BBExit);
1759 Unreach = true;
1760 }
1761
1762 extern "C" void
new_next_stmt(OSNode * Label)1763 new_next_stmt (OSNode *Label)
1764 {
1765 if (Unreach)
1766 return;
1767
1768 LLVMBuildBr(Builder, Label->BBEntry);
1769 Unreach = true;
1770 }
1771
1772 struct OIFBlock {
1773 LLVMBasicBlockRef Bb;
1774 };
1775
1776 extern "C" void
start_if_stmt(OIFBlock * Blk,OEnode Cond)1777 start_if_stmt (OIFBlock *Blk, OEnode Cond)
1778 {
1779 if (Unreach) {
1780 *Blk = { nullptr};
1781 return;
1782 }
1783
1784 LLVMBasicBlockRef BBThen;
1785
1786 // Create BB for Then and Else.
1787 BBThen = LLVMAppendBasicBlock(CurrentFunc, "");
1788 *Blk = { LLVMAppendBasicBlock(CurrentFunc, "") };
1789
1790 LLVMBuildCondBr(Builder, Cond.Ref, BBThen, Blk->Bb);
1791 LLVMPositionBuilderAtEnd(Builder, BBThen);
1792 }
1793
1794 extern "C" void
new_else_stmt(OIFBlock * Blk)1795 new_else_stmt (OIFBlock *Blk)
1796 {
1797 LLVMBasicBlockRef BBNext;
1798
1799 if (!Unreach) {
1800 // Create a BB for after the If statement
1801 BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
1802 // And jump to it.
1803 LLVMBuildBr(Builder, BBNext);
1804 } else {
1805 if (Blk->Bb == nullptr) {
1806 // The IF statement was unreachable, so is the Else part.
1807 return;
1808 }
1809 // Do not yet create the BB for after the If statement, as we don't
1810 // know if it is reachable.
1811 BBNext = nullptr;
1812 }
1813
1814 // Use the BB for the Else part.
1815 LLVMPositionBuilderAtEnd(Builder, Blk->Bb);
1816
1817 Blk->Bb = BBNext;
1818 // The Else part is reachable.
1819 Unreach = false;
1820 }
1821
1822 extern "C" void
finish_if_stmt(OIFBlock * Blk)1823 finish_if_stmt (OIFBlock *Blk)
1824 {
1825 LLVMBasicBlockRef BBNext;
1826
1827 if (!Unreach) {
1828 if (Blk->Bb == nullptr)
1829 BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
1830 else
1831 BBNext = Blk->Bb;
1832 LLVMBuildBr(Builder, BBNext);
1833 LLVMPositionBuilderAtEnd(Builder, BBNext);
1834 } else {
1835 // The branch doesn't continue.
1836 if (Blk->Bb != nullptr) {
1837 // There is at least one fall-through (either from the Then or from
1838 // the Else.
1839 Unreach = false;
1840 LLVMPositionBuilderAtEnd(Builder, Blk->Bb);
1841 }
1842 }
1843 }
1844
1845 struct OChoice {
1846 LLVMValueRef Low, High;
1847 LLVMBasicBlockRef BB;
1848 };
1849
1850 struct OCaseBlock {
1851 // BB before the case.
1852 LLVMBasicBlockRef BBPrev;
1853
1854 // Select expression
1855 LLVMValueRef Value;
1856 OTnode Vtype;
1857
1858 // BB after the case statement
1859 LLVMBasicBlockRef BBNext;
1860
1861 // BB for others
1862 LLVMBasicBlockRef BBOthers;
1863
1864 // BB for the current choice
1865 LLVMBasicBlockRef BBChoice;
1866
1867 std::vector<OChoice> *Choices;
1868 };
1869
1870 extern "C" void
start_case_stmt(OCaseBlock * Blk,OEnode Value)1871 start_case_stmt (OCaseBlock *Blk, OEnode Value)
1872 {
1873 LLVMBasicBlockRef BB;
1874 std::vector<OChoice> *Choices;
1875
1876 if (Unreach) {
1877 // The case statement is unreachable, discard it completly.
1878 BB = nullptr;
1879 Choices = nullptr;
1880 } else {
1881 BB = LLVMGetInsertBlock(Builder);
1882 Choices = new std::vector<OChoice>;
1883 }
1884
1885 *Blk = { BB,
1886 Value.Ref,
1887 Value.Etype,
1888 nullptr,
1889 nullptr,
1890 nullptr,
1891 Choices };
1892 }
1893
1894 // Close previous branch
1895 static void
finishBranch(OCaseBlock * Blk)1896 finishBranch (OCaseBlock *Blk)
1897 {
1898 if (Unreach) {
1899 // No need to close it as this point is not reachable.
1900 return;
1901 }
1902
1903 if (Blk->BBNext == nullptr) {
1904 // Create the BB for after the case statement.
1905 // It also means the end is reachable.
1906 Blk->BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
1907 }
1908 LLVMBuildBr(Builder, Blk->BBNext);
1909 }
1910
1911 extern "C" void
start_choice(OCaseBlock * Blk)1912 start_choice (OCaseBlock *Blk)
1913 {
1914 if (Blk->BBPrev == nullptr) {
1915 // The wholse case statement was unreachable
1916 assert(Unreach);
1917 return;
1918 }
1919
1920 if (Blk->BBChoice != nullptr) {
1921 // Close previous branch
1922 finishBranch(Blk);
1923 }
1924
1925 // This new choice is reachable from the start of the case statement.
1926 Unreach = false;
1927
1928 // Create a new BB.
1929 Blk->BBChoice = LLVMAppendBasicBlock(CurrentFunc, "");
1930 LLVMPositionBuilderAtEnd(Builder, Blk->BBChoice);
1931 }
1932
1933 // Add a choice that will branch to Blk->BBChoice.
1934 static void
newChoice(OCaseBlock * Blk,LLVMValueRef Low,LLVMValueRef High)1935 newChoice(OCaseBlock *Blk, LLVMValueRef Low, LLVMValueRef High)
1936 {
1937 if (Unreach)
1938 return;
1939
1940 Blk->Choices->push_back({Low, High, Blk->BBChoice});
1941 }
1942
1943 extern "C" void
new_expr_choice(OCaseBlock * Blk,OCnode * Expr)1944 new_expr_choice (OCaseBlock *Blk, OCnode *Expr)
1945 {
1946 newChoice(Blk, Expr->Ref, nullptr);
1947 }
1948
1949 extern "C" void
new_range_choice(OCaseBlock * Blk,OCnode * Low,OCnode * High)1950 new_range_choice (OCaseBlock *Blk, OCnode *Low, OCnode *High)
1951 {
1952 newChoice(Blk, Low->Ref, High->Ref);
1953 }
1954
1955 extern "C" void
new_default_choice(OCaseBlock * Blk)1956 new_default_choice (OCaseBlock *Blk)
1957 {
1958 if (Unreach)
1959 return;
1960
1961 Blk->BBOthers = Blk->BBChoice;
1962 }
1963
1964 extern "C" void
finish_choice(OCaseBlock * Blk)1965 finish_choice (OCaseBlock *Blk)
1966 {
1967 }
1968
1969 extern "C" void
finish_case_stmt(OCaseBlock * Blk)1970 finish_case_stmt (OCaseBlock *Blk)
1971 {
1972 LLVMIntPredicate GE, LE;
1973
1974 if (Blk->BBPrev == nullptr) {
1975 // The whole case statement is not reachable.
1976 return;
1977 }
1978
1979 if (Blk->BBChoice != nullptr) {
1980 // Close previous branch
1981 finishBranch(Blk);
1982 }
1983
1984 // Strategy: use a switch instruction for simple choices, put range choices
1985 // in the default branch, using if statements.
1986 // TODO: could improve the handling of ranges (dichotomy, decision tree...)
1987 switch (Blk->Vtype->Kind) {
1988 case OTKUnsigned:
1989 case OTKEnum:
1990 case OTKBool:
1991 GE = LLVMIntUGE;
1992 LE = LLVMIntULE;
1993 break;
1994 case OTKSigned:
1995 GE = LLVMIntSGE;
1996 LE = LLVMIntSLE;
1997 break;
1998 default:
1999 llvm_unreachable("bad expr type for case");
2000 }
2001
2002 // BB for the default case.
2003 LLVMBasicBlockRef BBDefault = LLVMAppendBasicBlock(CurrentFunc, "");
2004 LLVMPositionBuilderAtEnd(Builder, BBDefault);
2005
2006 // Put range choices in the default case.
2007 unsigned int Count = 0;
2008 LLVMBasicBlockRef BBLast = BBDefault;
2009 for(auto &c: *Blk->Choices) {
2010 if (c.High != nullptr) {
2011 BBLast = LLVMAppendBasicBlock(CurrentFunc, "");
2012 LLVMBuildCondBr(Builder,
2013 LLVMBuildAnd(Builder,
2014 LLVMBuildICmp(Builder, GE,
2015 Blk->Value, c.Low, ""),
2016 LLVMBuildICmp(Builder, LE,
2017 Blk->Value, c.High, ""),
2018 ""),
2019 c.BB, BBLast);
2020 LLVMPositionBuilderAtEnd(Builder, BBLast);
2021 } else {
2022 Count++;
2023 }
2024 }
2025
2026 // Insert the switch
2027 LLVMPositionBuilderAtEnd(Builder, Blk->BBPrev);
2028 LLVMValueRef Sw = LLVMBuildSwitch(Builder, Blk->Value, BBDefault, Count);
2029 for(auto &c: *Blk->Choices) {
2030 if (c.High == nullptr) {
2031 LLVMAddCase(Sw, c.Low, c.BB);
2032 }
2033 }
2034
2035 // Insert the others (if there is one).
2036 LLVMPositionBuilderAtEnd(Builder, BBLast);
2037 if (Blk->BBOthers != nullptr)
2038 LLVMBuildBr(Builder, Blk->BBOthers);
2039 else
2040 LLVMBuildUnreachable(Builder);
2041
2042 // Next BB.
2043 if (Blk->BBNext != nullptr) {
2044 Unreach = false;
2045 LLVMPositionBuilderAtEnd(Builder, Blk->BBNext);
2046 } else {
2047 // No branch falls through
2048 Unreach = true;
2049 }
2050 delete Blk->Choices;
2051 }
2052
2053 struct OAssocList {
2054 ODnodeSubprg *Subprg;
2055 unsigned Idx;
2056 LLVMValueRef *Vals;
2057 };
2058
2059 extern "C" void
start_association(OAssocList * Assocs,ODnodeSubprg * Subprg)2060 start_association (OAssocList *Assocs, ODnodeSubprg *Subprg)
2061 {
2062 *Assocs = { Subprg, 0, new LLVMValueRef[Subprg->Inters.size()] };
2063 }
2064
2065 extern "C" void
new_association(OAssocList * Assocs,OEnode Val)2066 new_association (OAssocList *Assocs, OEnode Val)
2067 {
2068 Assocs->Vals[Assocs->Idx++] = Val.Ref;
2069 }
2070
2071 extern "C" OEnode
new_function_call(OAssocList * Assocs)2072 new_function_call (OAssocList *Assocs)
2073 {
2074 LLVMValueRef Res;
2075
2076 if (!Unreach) {
2077 Res = LLVMBuildCall(Builder, Assocs->Subprg->Ref,
2078 Assocs->Vals, Assocs->Subprg->Inters.size(), "");
2079 } else {
2080 Res = nullptr;
2081 }
2082 delete Assocs->Vals;
2083 return { Res, Assocs->Subprg->Dtype };
2084 }
2085
2086 extern "C" void
new_procedure_call(OAssocList * Assocs)2087 new_procedure_call (OAssocList *Assocs)
2088 {
2089 if (!Unreach) {
2090 LLVMBuildCall(Builder, Assocs->Subprg->Ref,
2091 Assocs->Vals, Assocs->Subprg->Inters.size(), "");
2092 }
2093 delete Assocs->Vals;
2094 }
2095
2096 extern "C" void
new_func_return_stmt(OEnode Value)2097 new_func_return_stmt (OEnode Value)
2098 {
2099 if (Unreach)
2100 return;
2101 LLVMValueRef Res = LLVMBuildRet(Builder, Value.Ref);
2102 setDebugLocation(Res);
2103
2104 Unreach = true;
2105 }
2106
2107 extern "C" void
new_proc_return_stmt()2108 new_proc_return_stmt ()
2109 {
2110 if (Unreach)
2111 return;
2112 LLVMValueRef Res = LLVMBuildRetVoid(Builder);
2113 setDebugLocation(Res);
2114 Unreach = true;
2115 }
2116
2117 enum ONOpKind {
2118 /* Not an operation; invalid. */
2119 ON_Nil,
2120
2121 /* Dyadic operations. */
2122 ON_Add_Ov,
2123 ON_Sub_Ov,
2124 ON_Mul_Ov,
2125 ON_Div_Ov,
2126 ON_Rem_Ov,
2127 ON_Mod_Ov,
2128
2129 /* Binary operations. */
2130 ON_And,
2131 ON_Or,
2132 ON_Xor,
2133
2134 /* Monadic operations. */
2135 ON_Not,
2136 ON_Neg_Ov,
2137 ON_Abs_Ov,
2138
2139 /* Comparaisons */
2140 ON_Eq,
2141 ON_Neq,
2142 ON_Le,
2143 ON_Lt,
2144 ON_Ge,
2145 ON_Gt,
2146
2147 ON_LAST
2148 };
2149
2150 struct ComparePred {
2151 LLVMIntPredicate SignedPred;
2152 LLVMIntPredicate UnsignedPred;
2153 LLVMRealPredicate RealPred;
2154 };
2155
2156 static const ComparePred CompareTable[] = {
2157 {LLVMIntEQ, LLVMIntEQ, LLVMRealOEQ }, // Eq
2158 {LLVMIntNE, LLVMIntNE, LLVMRealONE }, // Ne
2159 {LLVMIntSLE, LLVMIntULE, LLVMRealOLE }, // Le
2160 {LLVMIntSLT, LLVMIntULT, LLVMRealOLT }, // Lt
2161 {LLVMIntSGE, LLVMIntUGE, LLVMRealOGE }, // Ge
2162 {LLVMIntSGT, LLVMIntUGT, LLVMRealOGT } // Gt
2163 };
2164
2165 extern "C" OEnode
new_compare_op(ONOpKind Kind,OEnode Left,OEnode Right,OTnode Rtype)2166 new_compare_op (ONOpKind Kind, OEnode Left, OEnode Right, OTnode Rtype)
2167 {
2168 LLVMValueRef Res;
2169
2170 if (Unreach)
2171 return {nullptr, Rtype};
2172
2173 // Cannot apply C convention to ON_Op_Kind, so we need to truncate it
2174 // (as it is represented by a byte from Ada and by int from C)
2175 Kind = static_cast<ONOpKind>(Kind & 0xff);
2176
2177 switch(Left.Etype->Kind) {
2178 case OTKUnsigned:
2179 case OTKEnum:
2180 case OTKBool:
2181 case OTKAccess:
2182 case OTKIncompleteAccess:
2183 Res = LLVMBuildICmp(Builder, CompareTable[Kind - ON_Eq].UnsignedPred,
2184 Left.Ref, Right.Ref, "");
2185 break;
2186 case OTKSigned:
2187 Res = LLVMBuildICmp(Builder, CompareTable[Kind - ON_Eq].SignedPred,
2188 Left.Ref, Right.Ref, "");
2189 break;
2190 case OTKFloat:
2191 Res = LLVMBuildFCmp(Builder, CompareTable[Kind - ON_Eq].RealPred,
2192 Left.Ref, Right.Ref, "");
2193 break;
2194 default:
2195 abort();
2196 }
2197 return {Res, Rtype};
2198 }
2199
2200 extern "C" OEnode
new_monadic_op(ONOpKind Kind,OEnode Operand)2201 new_monadic_op (ONOpKind Kind, OEnode Operand)
2202 {
2203 LLVMValueRef Res;
2204
2205 if (Unreach)
2206 return { nullptr, Operand.Etype};
2207
2208 // Cannot apply C convention to ON_Op_Kind, so we need to truncate it
2209 // (as it is represented by a byte from Ada and by int from C)
2210 Kind = static_cast<ONOpKind>(Kind & 0xff);
2211
2212 switch (Operand.Etype->Kind) {
2213 case OTKUnsigned:
2214 case OTKSigned:
2215 case OTKBool:
2216 switch (Kind) {
2217 case ON_Not:
2218 Res = LLVMBuildNot(Builder, Operand.Ref, "");
2219 break;
2220 case ON_Neg_Ov:
2221 Res = LLVMBuildNeg(Builder, Operand.Ref, "");
2222 break;
2223 case ON_Abs_Ov:
2224 Res = LLVMBuildSelect
2225 (Builder,
2226 LLVMBuildICmp (Builder, LLVMIntSLT,
2227 Operand.Ref,
2228 LLVMConstInt(Operand.Etype->Ref, 0, 0),
2229 ""),
2230 LLVMBuildNeg(Builder, Operand.Ref, ""),
2231 Operand.Ref,
2232 "");
2233 break;
2234 default:
2235 llvm_unreachable("bad scalar monadic op");
2236 }
2237 break;
2238 case OTKFloat:
2239 switch (Kind) {
2240 case ON_Neg_Ov:
2241 Res = LLVMBuildFNeg(Builder, Operand.Ref, "");
2242 break;
2243 case ON_Abs_Ov:
2244 Res = LLVMBuildSelect
2245 (Builder,
2246 LLVMBuildFCmp (Builder, LLVMRealOLT,
2247 Operand.Ref,
2248 LLVMConstReal(Operand.Etype->Ref, 0.0),
2249 ""),
2250 LLVMBuildFNeg(Builder, Operand.Ref, ""),
2251 Operand.Ref,
2252 "");
2253 break;
2254 default:
2255 abort();
2256 }
2257 break;
2258 default:
2259 abort();
2260 }
2261 return {Res, Operand.Etype};
2262 }
2263
2264 static LLVMValueRef
BuildSMod(LLVMBuilderRef Build,LLVMValueRef L,LLVMValueRef R,const char * s)2265 BuildSMod(LLVMBuilderRef Build, LLVMValueRef L, LLVMValueRef R, const char *s)
2266 {
2267 LLVMTypeRef T = LLVMTypeOf(L);
2268 LLVMBasicBlockRef NormalBB;
2269 LLVMBasicBlockRef AdjustBB;
2270 LLVMBasicBlockRef NextBB;
2271 LLVMValueRef PhiVals[3];
2272 LLVMBasicBlockRef PhiBB[3];
2273
2274 NextBB = LLVMAppendBasicBlock(CurrentFunc, "");
2275 NormalBB = LLVMAppendBasicBlock(CurrentFunc, "");
2276
2277 // Avoid overflow with -1
2278 // if R = -1 then
2279 // result := 0;
2280 // else
2281 // ...
2282 LLVMValueRef Cond;
2283 Cond = LLVMBuildICmp(Builder, LLVMIntEQ, R, LLVMConstAllOnes(T), "");
2284 LLVMBuildCondBr(Builder, Cond, NextBB, NormalBB);
2285 PhiBB[0] = LLVMGetInsertBlock(Builder);
2286 PhiVals[0] = LLVMConstNull(T);
2287
2288 // Rm := Left rem Right
2289 LLVMPositionBuilderAtEnd(Builder, NormalBB);
2290 LLVMValueRef Rm = LLVMBuildSRem(Builder, L, R, s);
2291
2292 // if Rm = 0 then
2293 // result := 0
2294 // else
2295 AdjustBB = LLVMAppendBasicBlock(CurrentFunc, "");
2296 Cond = LLVMBuildICmp(Builder, LLVMIntEQ, Rm, LLVMConstNull(T), "");
2297 LLVMBuildCondBr(Builder, Cond, NextBB, AdjustBB);
2298 PhiBB[1] = NormalBB;
2299 PhiVals[1] = LLVMConstNull(T);
2300
2301 // if (L xor R) < 0 then
2302 // result := Rm + R
2303 // else
2304 // result := Rm
2305 LLVMPositionBuilderAtEnd(Builder, AdjustBB);
2306 LLVMValueRef RXor = LLVMBuildXor(Builder, L, R, "");
2307 Cond = LLVMBuildICmp(Builder, LLVMIntSLT, RXor, LLVMConstNull(T), "");
2308 LLVMValueRef RmPlusR = LLVMBuildAdd(Builder, Rm, R, "");
2309 LLVMValueRef Adj = LLVMBuildSelect(Builder, Cond, RmPlusR, Rm, "");
2310 LLVMBuildBr(Builder, NextBB);
2311 PhiBB[2] = AdjustBB;
2312 PhiVals[2] = Adj;
2313
2314 // The Phi node
2315 LLVMPositionBuilderAtEnd(Builder, NextBB);
2316 LLVMValueRef Phi = LLVMBuildPhi(Builder, T, "");
2317 LLVMAddIncoming(Phi, PhiVals, PhiBB, 3);
2318
2319 return Phi;
2320 }
2321
2322 extern "C" OEnode
new_dyadic_op(ONOpKind Kind,OEnode Left,OEnode Right)2323 new_dyadic_op (ONOpKind Kind, OEnode Left, OEnode Right)
2324 {
2325 LLVMValueRef Res;
2326 LLVMValueRef (*Build)(LLVMBuilderRef, LLVMValueRef, LLVMValueRef, const char *);
2327 OTKind ArgKind = Left.Etype->Kind;
2328
2329 if (Unreach)
2330 return { nullptr, Left.Etype};
2331
2332 // Cannot apply C convention to ON_Op_Kind, so we need to truncate it
2333 // (as it is represented by a byte from Ada and by int from C)
2334 Kind = static_cast<ONOpKind>(Kind & 0xff);
2335
2336 switch (ArgKind) {
2337 case OTKUnsigned:
2338 case OTKSigned:
2339 case OTKBool:
2340 case OTKEnum:
2341 switch (Kind) {
2342 case ON_And:
2343 Build = &LLVMBuildAnd;
2344 break;
2345 case ON_Or:
2346 Build = &LLVMBuildOr;
2347 break;
2348 case ON_Xor:
2349 Build = &LLVMBuildXor;
2350 break;
2351
2352 case ON_Add_Ov:
2353 Build = &LLVMBuildAdd;
2354 break;
2355 case ON_Sub_Ov:
2356 Build = &LLVMBuildSub;
2357 break;
2358 case ON_Mul_Ov:
2359 Build = &LLVMBuildMul;
2360 break;
2361 case ON_Div_Ov:
2362 if (ArgKind == OTKUnsigned)
2363 Build = &LLVMBuildUDiv;
2364 else
2365 Build = &LLVMBuildSDiv;
2366 break;
2367 case ON_Mod_Ov:
2368 if (ArgKind == OTKUnsigned)
2369 Build = &LLVMBuildURem;
2370 else
2371 Build = &BuildSMod;
2372 break;
2373 case ON_Rem_Ov:
2374 if (ArgKind == OTKUnsigned)
2375 Build = &LLVMBuildURem;
2376 else
2377 Build = &LLVMBuildSRem;
2378 break;
2379 default:
2380 abort();
2381 }
2382 break;
2383
2384 case OTKFloat:
2385 switch (Kind) {
2386 case ON_Add_Ov:
2387 Build = &LLVMBuildFAdd;
2388 break;
2389 case ON_Sub_Ov:
2390 Build = &LLVMBuildFSub;
2391 break;
2392 case ON_Mul_Ov:
2393 Build = &LLVMBuildFMul;
2394 break;
2395 case ON_Div_Ov:
2396 Build = &LLVMBuildFDiv;
2397 break;
2398 default:
2399 llvm_unreachable("bad float dyadic op");
2400 }
2401 break;
2402
2403 default:
2404 abort();
2405 }
2406
2407 Res = Build(Builder, Left.Ref, Right.Ref, "");
2408 return {Res, Left.Etype};
2409 }
2410
2411 extern "C" OEnode
new_convert(OEnode Val,OTnode Rtype)2412 new_convert (OEnode Val, OTnode Rtype)
2413 {
2414 if (Unreach) {
2415 return {nullptr, Rtype};
2416 }
2417
2418 if (Rtype == Val.Etype) {
2419 // Same type, nothing to do
2420 return Val;
2421 }
2422
2423 if (Rtype->Ref == Val.Etype->Ref) {
2424 // Same undelaying LLVM type. No conversion.
2425 return {Val.Ref, Rtype};
2426 }
2427
2428 LLVMValueRef Res;
2429
2430 switch(Rtype->Kind) {
2431 case OTKUnsigned:
2432 case OTKSigned:
2433 case OTKEnum:
2434 case OTKBool:
2435 switch(Val.Etype->Kind) {
2436 case OTKUnsigned:
2437 case OTKSigned:
2438 case OTKEnum:
2439 case OTKBool:
2440 // Int to Int
2441 if (static_cast<OTnodeScal*>(Val.Etype)->ScalSize
2442 > static_cast<OTnodeScal*>(Rtype)->ScalSize)
2443 Res = LLVMBuildTrunc(Builder, Val.Ref, Rtype->Ref, "");
2444 else if (static_cast<OTnodeScal*>(Val.Etype)->ScalSize
2445 < static_cast<OTnodeScal*>(Rtype)->ScalSize) {
2446 if (Val.Etype->Kind == OTKSigned)
2447 Res = LLVMBuildSExt(Builder, Val.Ref, Rtype->Ref, "");
2448 else
2449 Res = LLVMBuildZExt(Builder, Val.Ref, Rtype->Ref, "");
2450 } else {
2451 Res = LLVMBuildBitCast(Builder, Val.Ref, Rtype->Ref, "");
2452 }
2453 break;
2454 case OTKFloat:
2455 // Float to Int
2456 {
2457 LLVMValueRef V;
2458 LLVMValueRef Args[2];
2459 Args[0] = Fp0_5;
2460 Args[1] = Val.Ref;
2461 V = LLVMBuildCall(Builder, CopySignFun, Args, 2, "");
2462 V = LLVMBuildFAdd(Builder, V, Val.Ref, "");
2463 Res = LLVMBuildFPToSI(Builder, V, Rtype->Ref, "");
2464 }
2465 break;
2466 default:
2467 llvm_unreachable("bad convert type");
2468 }
2469 break;
2470 case OTKFloat:
2471 // x to Float
2472 switch (Val.Etype->Kind) {
2473 case OTKSigned:
2474 Res = LLVMBuildSIToFP(Builder, Val.Ref, Rtype->Ref, "");
2475 break;
2476 case OTKUnsigned:
2477 Res = LLVMBuildUIToFP(Builder, Val.Ref, Rtype->Ref, "");
2478 break;
2479 default:
2480 abort();
2481 }
2482 break;
2483 case OTKAccess:
2484 case OTKIncompleteAccess:
2485 assert(LLVMGetTypeKind(LLVMTypeOf(Val.Ref)) == LLVMPointerTypeKind);
2486 Res = LLVMBuildBitCast(Builder, Val.Ref, Rtype->Ref, "");
2487 break;
2488 default:
2489 abort();
2490 }
2491 return {Res, Rtype};
2492 }
2493
2494 extern "C" OEnode
new_convert_ov(OEnode Val,OTnode Rtype)2495 new_convert_ov (OEnode Val, OTnode Rtype)
2496 {
2497 return new_convert(Val, Rtype);
2498 }
2499
2500 extern "C" OEnode
new_alloca(OTnode Rtype,OEnode Size)2501 new_alloca (OTnode Rtype, OEnode Size)
2502 {
2503 LLVMValueRef Res;
2504
2505 if (Unreach)
2506 Res = nullptr;
2507 else {
2508 if (CurrentDeclareBlock->StackValue != nullptr
2509 && CurrentDeclareBlock->Prev != nullptr) {
2510 // Save the stack pointer at the entry of the block.
2511 LLVMValueRef FirstInsn =
2512 LLVMGetFirstInstruction(CurrentDeclareBlock->StmtBB);
2513 LLVMBuilderRef Bld;
2514 if (FirstInsn == nullptr) {
2515 // Alloca is the first instruction
2516 Bld = Builder;
2517 } else {
2518 LLVMPositionBuilderBefore(ExtraBuilder, FirstInsn);
2519 Bld = ExtraBuilder;
2520 }
2521 CurrentDeclareBlock->StackValue =
2522 LLVMBuildCall(Bld, StackSaveFun, nullptr, 0, "");
2523 }
2524 Res = LLVMBuildArrayAlloca(Builder, LLVMInt8Type(), Size.Ref, "");
2525 // Convert
2526 Res = LLVMBuildBitCast(Builder, Res, Rtype->Ref, "");
2527 }
2528 return {Res, Rtype};
2529 }
2530
2531 extern "C" OCnode
new_subprogram_address(ODnodeSubprg * Subprg,OTnode Atype)2532 new_subprogram_address (ODnodeSubprg *Subprg, OTnode Atype)
2533 {
2534 return { LLVMConstBitCast(Subprg->Ref, Atype->Ref), Atype };
2535 }
2536
2537 struct OGnode {
2538 LLVMValueRef Ref;
2539 OTnode Gtype;
2540 };
2541
2542 extern "C" OGnode
new_global(ODnode Decl)2543 new_global (ODnode Decl)
2544 {
2545 return {Decl->Ref, Decl->Dtype };
2546 }
2547
2548 extern "C" OGnode
new_global_selected_element(OGnode Rec,OFnodeBase * El)2549 new_global_selected_element (OGnode Rec, OFnodeBase *El)
2550 {
2551 LLVMValueRef Res;
2552
2553 switch(El->Kind) {
2554 case OF_Record:
2555 {
2556 LLVMValueRef Idx[2];
2557 Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2558 Idx[1] = LLVMConstInt(LLVMInt32Type(),
2559 static_cast<OFnodeRec *>(El)->Index, 0);
2560 Res = LLVMConstGEP(Rec.Ref, Idx, 2);
2561 }
2562 break;
2563 case OF_Union:
2564 Res = LLVMConstBitCast(Rec.Ref, static_cast<OFnodeUnion *>(El)->PtrType);
2565 break;
2566 }
2567 return {Res, El->FType};
2568 }
2569
2570 extern "C" OCnode
new_global_unchecked_address(OGnode Lvalue,OTnode Atype)2571 new_global_unchecked_address (OGnode Lvalue, OTnode Atype)
2572 {
2573 return {LLVMConstBitCast(Lvalue.Ref, Atype->Ref), Atype};
2574 }
2575
2576 extern "C" OCnode
new_global_address(OGnode Lvalue,OTnode Atype)2577 new_global_address (OGnode Lvalue, OTnode Atype)
2578 {
2579 return new_global_unchecked_address(Lvalue, Atype);
2580 }
2581
2582 struct OLnode {
2583 bool Direct;
2584 LLVMValueRef Ref;
2585 OTnode Ltype;
2586 };
2587
2588 extern "C" OLnode
new_obj(ODnode Obj)2589 new_obj (ODnode Obj)
2590 {
2591 switch(Obj->getKind()) {
2592 case ODKConst:
2593 case ODKVar:
2594 case ODKLocal:
2595 return { false, Obj->Ref, Obj->Dtype };
2596 case ODKInterface:
2597 #ifdef USE_DEBUG
2598 if (FlagDebug) {
2599 // The argument was allocated on the stack
2600 return { false, Obj->Ref, Obj->Dtype };
2601 }
2602 #endif
2603 return { true, Obj->Ref, Obj->Dtype };
2604 case ODKType:
2605 case ODKSubprg:
2606 default:
2607 llvm_unreachable("bad new_obj obj");
2608 }
2609 }
2610
2611 extern "C" OEnode
new_value(OLnode * Lvalue)2612 new_value (OLnode *Lvalue)
2613 {
2614 LLVMValueRef Res;
2615
2616 if (Unreach)
2617 Res = nullptr;
2618 else {
2619 if (Lvalue->Direct)
2620 Res = Lvalue->Ref;
2621 else
2622 Res = LLVMBuildLoad(Builder, Lvalue->Ref, "");
2623 }
2624 return {Res, Lvalue->Ltype };
2625 }
2626
2627 extern "C" OEnode
new_obj_value(ODnode Obj)2628 new_obj_value (ODnode Obj)
2629 {
2630 OLnode t = new_obj(Obj);
2631 return new_value (&t);
2632 }
2633
2634 extern "C" OLnode
new_indexed_element(OLnode * Arr,OEnode Index)2635 new_indexed_element (OLnode *Arr, OEnode Index)
2636 {
2637 LLVMValueRef Idx[2];
2638 LLVMValueRef Res;
2639
2640 if (Unreach)
2641 Res = nullptr;
2642 else {
2643 Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2644 Idx[1] = Index.Ref;
2645 Res = LLVMBuildGEP(Builder, Arr->Ref, Idx, 2, "");
2646 }
2647 return { false, Res, static_cast<OTnodeArr *>(Arr->Ltype)->ElType };
2648 }
2649
2650 extern "C" OLnode
new_slice(OLnode * Arr,OTnode Rtype,OEnode Index)2651 new_slice (OLnode *Arr, OTnode Rtype, OEnode Index)
2652 {
2653 LLVMValueRef Idx[2];
2654 LLVMValueRef Res;
2655
2656 if (Unreach)
2657 Res = nullptr;
2658 else {
2659 Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2660 Idx[1] = Index.Ref;
2661 Res = LLVMBuildGEP(Builder, Arr->Ref, Idx, 2, "");
2662 Res = LLVMBuildBitCast(Builder, Res, LLVMPointerType(Rtype->Ref, 0), "");
2663 }
2664 return { false, Res, Rtype};
2665 }
2666
2667 extern "C" OLnode
new_selected_element(OLnode * Rec,OFnodeBase * El)2668 new_selected_element (OLnode *Rec, OFnodeBase *El)
2669 {
2670 LLVMValueRef Res;
2671
2672 if (Unreach)
2673 Res = nullptr;
2674 else {
2675 switch(El->Kind) {
2676 case OF_Record:
2677 {
2678 LLVMValueRef Idx[2];
2679 Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2680 Idx[1] = LLVMConstInt(LLVMInt32Type(),
2681 static_cast<OFnodeRec *>(El)->Index, 0);
2682 Res = LLVMBuildGEP(Builder, Rec->Ref, Idx, 2, "");
2683 }
2684 break;
2685 case OF_Union:
2686 Res = LLVMBuildBitCast(Builder, Rec->Ref,
2687 static_cast<OFnodeUnion *>(El)->PtrType, "");
2688 break;
2689 }
2690 }
2691 return { false, Res, El->FType };
2692 }
2693
2694 extern "C" OLnode
new_access_element(OEnode Acc)2695 new_access_element (OEnode Acc)
2696 {
2697 LLVMValueRef Res;
2698
2699 switch(Acc.Etype->Kind) {
2700 case OTKAccess:
2701 Res = Acc.Ref;
2702 break;
2703 case OTKIncompleteAccess:
2704 // Unwrap the structure
2705 {
2706 LLVMValueRef Idx[2];
2707
2708 Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2709 Idx[1] = LLVMConstInt(LLVMInt32Type(), 0, 0);
2710 Res = LLVMBuildGEP(Builder, Acc.Ref, Idx, 2, "");
2711 }
2712 break;
2713 default:
2714 llvm_unreachable("bad new_access_element");
2715 }
2716 return {false, Res, static_cast<OTnodeAccBase *>(Acc.Etype)->Acc };
2717 }
2718
2719 extern "C" OEnode
new_unchecked_address(OLnode * Lvalue,OTnode Atype)2720 new_unchecked_address (OLnode *Lvalue, OTnode Atype)
2721 {
2722 LLVMValueRef Res;
2723
2724 if (Unreach)
2725 Res = nullptr;
2726 else
2727 Res = LLVMBuildBitCast(Builder, Lvalue->Ref, Atype->Ref, "");
2728 return {Res, Atype};
2729 }
2730
2731 extern "C" OEnode
new_address(OLnode * Lvalue,OTnode Atype)2732 new_address (OLnode *Lvalue, OTnode Atype)
2733 {
2734 return new_unchecked_address(Lvalue, Atype);
2735 }
2736
2737 extern "C" void
new_assign_stmt(OLnode * Target,OEnode Value)2738 new_assign_stmt (OLnode *Target, OEnode Value)
2739 {
2740 assert (!Target->Direct);
2741 if (Unreach)
2742 return;
2743
2744 LLVMValueRef Res = LLVMBuildStore(Builder, Value.Ref, Target->Ref);
2745 setDebugLocation(Res);
2746 }
2747
2748 extern "C" void
new_debug_line_decl(unsigned Line)2749 new_debug_line_decl (unsigned Line)
2750 {
2751 #ifdef USE_DEBUG
2752 DebugCurrentLine = Line;
2753 #endif
2754 }
2755
2756 extern "C" void
new_debug_line_stmt(unsigned Line)2757 new_debug_line_stmt (unsigned Line)
2758 {
2759 #ifdef USE_DEBUG
2760 if (FlagDebugLines && Line != DebugCurrentLine) {
2761 DebugCurrentLine = Line;
2762 unwrap(Builder)->SetCurrentDebugLocation
2763 (DebugLoc::get(DebugCurrentLine, 0, DebugCurrentScope));
2764 }
2765 #endif
2766 }
2767