LLVM backend with debug info (in C/C++)

1 files changed, 2264 insertions, 0 deletions

diff --git a/src/ortho/llvm6/llvm-cbindings.cpp b/src/ortho/llvm6/llvm-cbindings.cpp
new file mode 100644
index 000000000..6002fd05f
--- /dev/null
+++ b/src/ortho/llvm6/llvm-cbindings.cpp
@@ -0,0 +1,2264 @@
+/*  LLVM binding
+  Copyright (C) 2014 Tristan Gingold
+
+  GHDL is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free
+  Software Foundation; either version 2, or (at your option) any later
+  version.
+
+  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+  for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with GHDL; see the file COPYING.  If not, write to the Free
+  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+  02111-1307, USA.  */
+#include "llvm-c/Target.h"
+#include "llvm/IR/Type.h"
+#include "llvm/IR/Value.h"
+#include "llvm/IR/LLVMContext.h"
+#include "llvm/Config/llvm-config.h"
+#include "llvm-c/TargetMachine.h"
+#include "llvm-c/Core.h"
+#include "llvm-c/BitWriter.h"
+#include "llvm-c/Analysis.h"
+#include "llvm-c/Transforms/Scalar.h"
+
+#include "llvm/IR/IRBuilder.h"
+#include "llvm/IR/DIBuilder.h"
+#include "llvm/Support/FileSystem.h"
+#include <vector>
+
+using namespace llvm;
+
+//  True if the LLVM output must be displayed (set by '--dump-llvm')
+static bool FlagDumpLLVM = false;
+
+//  Verify generated LLVM code.
+static bool FlagVerifyLLVM = false;
+
+static bool FlagDebugLines = true;
+
+static LLVMModuleRef TheModule;
+static LLVMTargetRef TheTarget;
+static LLVMTargetMachineRef TheTargetMachine;
+static LLVMTargetDataRef TheTargetData;
+static LLVMRelocMode TheReloc = LLVMRelocDefault;
+static LLVMCodeGenOptLevel Optimization = LLVMCodeGenLevelDefault;
+
+static LLVMBuilderRef Builder;
+static LLVMBuilderRef DeclBuilder;
+static LLVMBuilderRef ExtraBuilder;
+
+static LLVMValueRef StackSaveFun;
+static LLVMValueRef StackRestoreFun;
+static LLVMValueRef CopySignFun;
+
+static LLVMValueRef Fp0_5;
+static LLVMAttributeRef NounwindAttr;
+static LLVMAttributeRef UwtableAttr;
+
+static bool Unreach;
+
+static unsigned DebugCurrentLine;
+static std::string *DebugCurrentFilename;
+static std::string *DebugCurrentDirectory;
+static DIFile *DebugCurrentFile;
+
+static DIBuilder *DBuilder;
+
+extern "C" void
+set_optimization_level (unsigned level)
+{
+  switch(level) {
+  case 0:
+    Optimization = LLVMCodeGenLevelNone;
+    break;
+  case 1:
+    Optimization = LLVMCodeGenLevelLess;
+    break;
+  case 2:
+    Optimization = LLVMCodeGenLevelDefault;
+    break;
+  default:
+    Optimization = LLVMCodeGenLevelAggressive;
+    break;
+  }
+}
+
+extern "C" void
+set_dump_llvm (unsigned Flag)
+{
+  FlagDumpLLVM = Flag != 0;
+}
+
+extern "C" void
+set_verify_llvm (unsigned Flag)
+{
+  FlagVerifyLLVM = Flag != 0;
+}
+
+extern "C" void
+set_pic_flag (unsigned Flag)
+{
+  TheReloc = Flag ? LLVMRelocPIC : LLVMRelocStatic;
+}
+
+static void
+generateError(const char *Filename, char *Msg)
+{
+  fprintf(stderr, "error while writing to %s\n", Filename);
+  if (Msg) {
+    fprintf(stderr, "message: %s\n", Msg);
+    LLVMDisposeMessage(Msg);
+  }
+  exit(2);
+}
+
+static void
+generateCommon()
+{
+  char *Msg;
+
+  if (FlagDumpLLVM)
+    LLVMDumpModule(TheModule);
+
+  if (FlagVerifyLLVM) {
+    if (LLVMVerifyModule(TheModule, LLVMPrintMessageAction, &Msg)) {
+      LLVMDisposeMessage (Msg);
+      abort();
+    }
+  }
+
+  if (Optimization > LLVMCodeGenLevelNone) {
+    LLVMPassManagerRef PassManager;
+    PassManager = LLVMCreateFunctionPassManagerForModule (TheModule);
+
+    LLVMAddPromoteMemoryToRegisterPass (PassManager);
+    LLVMAddCFGSimplificationPass (PassManager);
+
+    for (LLVMValueRef Func = LLVMGetFirstFunction (TheModule);
+	 Func != nullptr;
+	 Func = LLVMGetNextFunction(Func)) {
+      LLVMRunFunctionPassManager (PassManager, Func);
+    }
+  }
+}
+extern "C" void
+generate_object(char *Filename)
+{
+  char *Msg;
+  
+  generateCommon();
+
+  if (LLVMTargetMachineEmitToFile (TheTargetMachine, TheModule, Filename,
+				   LLVMObjectFile, &Msg))
+    generateError(Filename, Msg);
+}
+
+extern "C" void
+generate_assembly(char *Filename)
+{
+  char *Msg;
+
+  generateCommon();
+
+  if (LLVMTargetMachineEmitToFile (TheTargetMachine, TheModule, Filename,
+				   LLVMAssemblyFile, &Msg))
+    generateError(Filename, Msg);
+}
+
+extern "C" void
+generate_bitcode(const char *Filename)
+{
+  generateCommon();
+
+  if (LLVMWriteBitcodeToFile(TheModule, Filename)) {
+    generateError(Filename, nullptr);
+  }
+}
+
+extern "C" void
+generate_llvm(char *Filename)
+{
+  char *Msg;
+
+  generateCommon();
+
+  if (LLVMPrintModuleToFile(TheModule, Filename, &Msg)) {
+    generateError(Filename, Msg);
+  }
+}
+
+extern "C" void
+ortho_llvm_init(const char *Filename, unsigned FilenameLength)
+{
+  char *Msg;
+
+  LLVMInitializeNativeTarget();
+  LLVMInitializeNativeAsmPrinter();
+
+  TheModule = LLVMModuleCreateWithName ("ortho");
+
+  //  Get target triple (from how llvm was configured).
+  char *Triple = LLVMGetDefaultTargetTriple();
+
+#if LLVM_VERSION_MAJOR >= 7
+  {
+    char *RawTriple = Triple;
+    Triple = LLVMNormalizeTargetTriple(Triple);
+    LLVMDisposeMessage(RawTriple);
+  }
+#endif
+  LLVMSetTarget(TheModule, Triple);
+
+  //  Get target - this is a struct that corresponds to the triple.
+  if (LLVMGetTargetFromTriple(Triple, &TheTarget, &Msg) != 0) {
+    fprintf(stderr, "llvm: cannot find target %s: %s\n", Triple, Msg);
+    LLVMDisposeMessage(Msg);
+    exit (1);
+  }
+
+  //  Create a target machine
+  TheTargetMachine = LLVMCreateTargetMachine
+    (TheTarget, Triple, NULL, NULL, Optimization, TheReloc,
+     LLVMCodeModelDefault);
+
+  TheTargetData = LLVMCreateTargetDataLayout(TheTargetMachine);
+  LLVMSetModuleDataLayout(TheModule, TheTargetData);
+
+  Builder = LLVMCreateBuilder();
+  DeclBuilder = LLVMCreateBuilder();
+  ExtraBuilder = LLVMCreateBuilder();
+
+  LLVMTypeRef I8Ptr = LLVMPointerType(LLVMInt8Type(), 0);
+
+  StackSaveFun = LLVMAddFunction
+    (TheModule, "llvm.stacksave", LLVMFunctionType (I8Ptr, NULL, 0, false));
+
+  LLVMTypeRef ParamTypes[2];
+
+  ParamTypes[0] = I8Ptr;
+  StackRestoreFun = LLVMAddFunction
+    (TheModule, "llvm.stackrestore",
+     LLVMFunctionType(LLVMVoidType(), ParamTypes, 1, false));
+
+  ParamTypes[0] = LLVMDoubleType();
+  ParamTypes[1] = LLVMDoubleType();
+  CopySignFun = LLVMAddFunction
+    (TheModule, "llvm.copysign.f64",
+     LLVMFunctionType(LLVMDoubleType(), ParamTypes, 2, false));
+
+  Fp0_5 = LLVMConstReal(LLVMDoubleType(), 0.5);
+
+  unsigned AttrId;
+
+  AttrId = LLVMGetEnumAttributeKindForName("nounwind", 8);
+  assert (AttrId != 0);
+  NounwindAttr = LLVMCreateEnumAttribute(LLVMGetGlobalContext(), AttrId, 0);
+
+  AttrId = LLVMGetEnumAttributeKindForName("uwtable", 7);
+  assert (AttrId != 0);
+  UwtableAttr = LLVMCreateEnumAttribute(LLVMGetGlobalContext(), AttrId, 0);
+
+  if (FlagDebugLines) {
+    DBuilder = new DIBuilder(*unwrap(TheModule));
+    
+    DebugCurrentFilename = new std::string(Filename, FilenameLength);
+    SmallString<128> CurrentDir;
+    llvm::sys::fs::current_path(CurrentDir);
+    DebugCurrentDirectory = new std::string(CurrentDir.data(),
+					    CurrentDir.size());
+
+    DebugCurrentFile = DBuilder->createFile(StringRef(*DebugCurrentFilename),
+					    StringRef(*DebugCurrentDirectory));
+  }
+}
+
+enum OTKind : unsigned char {
+  OTKUnsigned, OTKSigned, OTKFloat,
+  OTKEnum, OTKBool,
+  OTKAccess, OTKIncompleteAccess,
+  OTKRecord, OTKIncompleteRecord,
+  OTKUnion,
+  OTKArray
+};
+
+struct OTnodeBase {
+  LLVMTypeRef Ref;
+  LLVMValueRef Dbg;
+
+  OTKind Kind;
+  bool Bounded;
+  OTnodeBase (LLVMTypeRef R, OTKind K, bool Bounded) :
+    Ref(R), Dbg(nullptr), Kind(K), Bounded(Bounded) {}
+};
+
+typedef OTnodeBase *OTnode;
+
+struct OTnodeScal : OTnodeBase {
+  //  For scalar: the size
+  unsigned ScalSize;
+
+  OTnodeScal (LLVMTypeRef R, OTKind K, unsigned Sz) :
+    OTnodeBase(R, K, true), ScalSize(Sz) {}
+};
+
+struct OTnodeUnsigned : OTnodeScal {
+  OTnodeUnsigned (LLVMTypeRef R, unsigned Sz) :
+    OTnodeScal(R, OTKUnsigned, Sz) {}
+};
+
+struct OTnodeSigned : OTnodeScal {
+  OTnodeSigned (LLVMTypeRef R, unsigned Sz) :
+    OTnodeScal(R, OTKSigned, Sz) {}
+};
+
+struct OTnodeFloat : OTnodeScal {
+  OTnodeFloat (LLVMTypeRef R, unsigned Sz) :
+    OTnodeScal(R, OTKFloat, Sz) {}
+};
+
+struct OTnodeEnum : OTnodeScal {
+  OTnodeEnum (LLVMTypeRef R, unsigned Sz) :
+    OTnodeScal(R, OTKEnum, Sz) {}
+};
+
+struct OTnodeBool : OTnodeScal {
+  OTnodeBool (LLVMTypeRef R) : OTnodeScal(R, OTKBool, 1) {}
+};
+
+static LLVMTypeRef
+SizeToLLVM (unsigned Sz)
+{
+  switch (Sz) {
+  case 8:
+    return LLVMInt8Type();
+  case 32:
+    return LLVMInt32Type();
+  case 64:
+    return LLVMInt64Type();
+  default:
+    abort();
+  }
+}
+
+extern "C" OTnode
+new_unsigned_type(unsigned Sz)
+{
+  return new OTnodeUnsigned(SizeToLLVM(Sz), Sz);
+}
+
+extern "C" OTnode
+new_signed_type(unsigned Sz)
+{
+  return new OTnodeSigned(SizeToLLVM(Sz), Sz);
+}
+
+extern "C" OTnode
+new_float_type()
+{
+  return new OTnodeFloat(LLVMDoubleType(), 64);
+}
+
+struct OEnumList {
+  LLVMTypeRef Ref;
+  unsigned Pos;
+  OTnodeEnum *Etype;
+};
+
+extern "C" void
+start_enum_type (OEnumList *List, unsigned Sz)
+{
+  LLVMTypeRef T = SizeToLLVM(Sz);
+
+  *List = {T, 0, new OTnodeEnum(T, Sz)};
+}
+
+struct OCnode {
+  LLVMValueRef Ref;
+  OTnode Ctype;
+};
+
+struct OIdent {
+  const char *cstr;
+};
+
+extern "C" void
+new_enum_literal (OEnumList *List, OIdent Ident, OCnode *Res)
+{
+  *Res = {LLVMConstInt(List->Ref, List->Pos++, 0),
+	  List->Etype};
+}
+
+extern "C" void
+finish_enum_type (OEnumList *List, OTnode *Res)
+{
+  *Res = List->Etype;
+}
+
+extern "C" void
+new_boolean_type(OTnode *Res,
+		 OIdent False_Id, OCnode *False_E,
+		 OIdent True_Id, OCnode *True_E)
+{
+  OTnodeBool *T = new OTnodeBool(LLVMInt1Type());
+  *Res = T;
+
+  *False_E = {LLVMConstInt(T->Ref, 0, 0), T};
+  *True_E = {LLVMConstInt(T->Ref, 1, 0), T};
+}
+
+extern "C" OCnode
+new_signed_literal (OTnode LType, int64_t Value)
+{
+  return {LLVMConstInt(LType->Ref, Value, 1), LType};
+}
+
+extern "C" OCnode
+new_unsigned_literal (OTnode LType, uint64_t Value)
+{
+  return {LLVMConstInt(LType->Ref, Value, 0), LType};
+}
+
+extern "C" OCnode
+new_float_literal (OTnode LType, double Value)
+{
+  return {LLVMConstReal(LType->Ref, Value), LType};
+}
+
+struct OTnodeAccBase : OTnodeBase {
+  //  For accesses
+  OTnode Acc;
+
+  OTnodeAccBase (LLVMTypeRef R, OTKind Kind, OTnode Acc) :
+    OTnodeBase(R, Kind, true), Acc(Acc) {}
+};
+
+struct OTnodeAcc : OTnodeAccBase {
+  OTnodeAcc (LLVMTypeRef R, OTnode Acc) :
+    OTnodeAccBase(R, OTKAccess, Acc) {}
+};
+
+struct OTnodeIncompleteAcc : OTnodeAccBase {
+  OTnodeIncompleteAcc () :
+    OTnodeAccBase(nullptr, OTKIncompleteAccess, nullptr) {}
+};
+
+extern "C" OTnode
+new_access_type(OTnode DType)
+{
+  if (DType == nullptr) {
+    return new OTnodeIncompleteAcc();
+  } else {
+    return new OTnodeAcc(LLVMPointerType(DType->Ref, 0), DType);
+  }
+}
+
+extern "C" void
+finish_access_type(OTnodeAcc *AccType, OTnode DType)
+{
+  //  Must be incomplete.
+  assert (AccType->Acc -= nullptr);
+
+  LLVMTypeRef Types[1] = { DType->Ref };
+  LLVMStructSetBody(LLVMGetElementType(AccType->Ref), Types, 1, 0);
+  AccType->Acc = DType;
+}
+
+extern "C" OCnode
+new_null_access (OTnode LType)
+{
+  return {LLVMConstNull(LType->Ref), LType};
+}
+
+enum OFKind { OF_Record, OF_Union};
+
+struct OElement {
+  //  Identifier for the element
+  OIdent Ident;
+
+  // Type of the element
+  OTnode Etype;
+
+  //  Next element (in the linked list)
+  OElement *Next;
+};
+
+struct OElementList {
+  OFKind Kind;
+
+  //  Number of fields.
+  unsigned Count;
+
+  //  For record: the access to the incomplete (but named) type.
+  OTnode RecType;
+
+  //  For unions: biggest for size and alignment
+  unsigned Size;
+  unsigned Align;
+  //  For unions: type with the biggest alignment.
+  LLVMTypeRef AlignType;
+
+  struct OElement *FirstElem;
+  struct OElement *LastElem;
+};
+
+extern "C" void
+start_record_type (OElementList *Elements)
+{
+  *Elements = {OF_Record,
+	       0,
+	       nullptr,
+	       0, 0, nullptr,
+	       nullptr,
+	       nullptr};
+}
+
+static void
+addField(OElementList *Elements, OIdent Ident, OTnode Etype)
+{
+  Elements->Count++;
+
+  OElement *El = new OElement{Ident, Etype, nullptr};
+  if (Elements->FirstElem == nullptr)
+    Elements->FirstElem = El;
+  else
+    Elements->LastElem->Next = El;
+  Elements->LastElem = El;
+}
+
+struct OFnodeBase {
+  OFKind Kind;
+  OTnode FType;
+  OFnodeBase(OFKind Kind, OTnode FType) : Kind(Kind), FType(FType) {}
+};
+
+struct OFnodeRec : OFnodeBase {
+  unsigned Index;
+  OFnodeRec(OTnode Etype, unsigned Index) :
+    OFnodeBase(OF_Record, Etype), Index(Index) {}
+};
+
+struct OFnodeUnion : OFnodeBase {
+  LLVMTypeRef Utype;
+  //  Pointer type - used to do conversion between the union and the field.
+  LLVMTypeRef PtrType;
+  OFnodeUnion(OTnode Etype, LLVMTypeRef PtrType) :
+    OFnodeBase(OF_Union, Etype), Utype(Etype->Ref), PtrType(PtrType) {}
+};
+
+extern "C" void
+new_record_field(OElementList *Elements,
+		 OFnodeRec **El, OIdent Ident, OTnode Etype)
+{
+  *El = new OFnodeRec(Etype, Elements->Count);
+  addField(Elements, Ident, Etype);
+}
+
+static void
+freeElements(OElementList *Els)
+{
+  OElement *El, *NEl;
+
+  for (El = Els->FirstElem; El != nullptr; El = NEl) {
+    NEl = El->Next;
+    delete El;
+  }
+  Els->FirstElem = nullptr;
+  Els->LastElem = nullptr;
+}
+
+struct OTnodeRecBase : OTnodeBase {
+  OTnodeRecBase (LLVMTypeRef R, OTKind Kind, bool Bounded) :
+    OTnodeBase(R, Kind, Bounded) {}
+};
+
+struct OTnodeRec : OTnodeRecBase {
+  OTnodeRec (LLVMTypeRef R, bool Bounded) :
+    OTnodeRecBase(R, OTKRecord, Bounded) {}
+};
+
+struct OTnodeIncompleteRec : OTnodeRecBase {
+  OTnodeIncompleteRec () :
+    OTnodeRecBase(nullptr, OTKIncompleteRecord, false) {}
+};
+
+extern "C" void
+finish_record_type(OElementList *Els, OTnode *Res)
+{
+  LLVMTypeRef *Types = new LLVMTypeRef[Els->Count];
+
+  OElement *El;
+  int i;
+  bool Bounded = true;
+  for (i = 0, El = Els->FirstElem; El != nullptr; El = El->Next, i++) {
+    Bounded &= El->Etype->Bounded;
+    Types[i] = El->Etype->Ref;
+  }
+
+  if (Els->RecType != nullptr) {
+    //  Completion
+    LLVMStructSetBody (Els->RecType->Ref, Types, Els->Count, 0);
+    Els->RecType->Bounded = Bounded;
+    *Res = Els->RecType;
+  } else {
+    *Res = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), Bounded);
+  }
+  freeElements(Els);
+}
+
+extern "C" void
+new_uncomplete_record_type(OTnode *Res)
+{
+  *Res = new OTnodeIncompleteRec();
+}
+
+extern "C" void
+start_uncomplete_record_type(OTnodeRec *Res, OElementList *Els)
+{
+  //  Must be incomplete.
+  assert (Res->Ref == nullptr);
+
+  *Els = {OF_Record,
+	  0,
+	  Res,
+	  0, 0, nullptr,
+	  nullptr,
+	  nullptr};
+}
+
+extern "C" void
+start_union_type(OElementList *Els)
+{
+  *Els = {OF_Union,
+	  0,
+	  nullptr,
+	  0, 0, nullptr,
+	  nullptr,
+	  nullptr};
+}
+
+extern "C" void
+new_union_field(OElementList *Els, OFnodeUnion **El,
+		OIdent Ident, OTnode Etype)
+{
+  unsigned Size = LLVMABISizeOfType(TheTargetData, Etype->Ref);
+  unsigned Align = LLVMABIAlignmentOfType(TheTargetData, Etype->Ref);
+
+  *El = new OFnodeUnion(Etype, LLVMPointerType(Etype->Ref, 0));
+
+  if (Size > Els->Size)
+    Els->Size = Size;
+  if (Els->AlignType == nullptr || Align > Els->Align) {
+    Els->Align = Align;
+    Els->AlignType = Etype->Ref;
+  }
+  addField(Els, Ident, Etype);
+}
+
+struct OTnodeUnion : OTnodeBase {
+  //  For unions
+  unsigned Size;
+  LLVMTypeRef MainField;
+
+  OTnodeUnion(LLVMTypeRef R, unsigned Sz, LLVMTypeRef Main) :
+    OTnodeBase(R, OTKUnion, true), Size(Sz), MainField(Main) {}
+};
+
+
+extern "C" void
+finish_union_type(OElementList *Els, OTnode *Res)
+{
+  unsigned Count;
+  LLVMTypeRef Types[2];
+
+  if (Els->AlignType == nullptr) {
+    //  An empty union
+    Count = 0;
+  } else {
+    unsigned Pad;
+
+    Types[0] = Els->AlignType;
+    Pad = Els->Size - LLVMABISizeOfType(TheTargetData, Els->AlignType);
+    if (Pad != 0) {
+      Types[1] = LLVMArrayType(LLVMInt8Type(), Pad);
+      Count = 2;
+    } else {
+      Count = 1;
+    }
+  }
+
+  *Res = new OTnodeUnion(LLVMStructType(Types, Count, 0),
+			 Els->Size, Els->AlignType);
+  freeElements(Els);
+}
+
+struct OTnodeArr : OTnodeBase {
+  //  For arrays: type of the element
+  OTnode ElType;
+
+  OTnodeArr(LLVMTypeRef R, bool Complete, OTnode E) :
+    OTnodeBase(R, OTKArray, Complete), ElType(E) {}
+};
+
+extern "C" OTnode
+new_array_type(OTnode ElType, OTnode IndexType)
+{
+  return new OTnodeArr(LLVMArrayType(ElType->Ref, 0), false, ElType);
+}
+
+extern "C" OTnode
+new_constrained_array_type(OTnodeArr *ArrType, OCnode *Length)
+{
+  unsigned Len = LLVMConstIntGetZExtValue(Length->Ref);
+
+  return new OTnodeArr(LLVMArrayType(ArrType->ElType->Ref, Len),
+		       ArrType->ElType->Bounded,
+		       ArrType->ElType);
+}
+
+extern "C" void
+new_type_decl(OIdent Ident, OTnode Atype)
+{
+  switch(Atype->Kind) {
+  case OTKIncompleteAccess:
+    Atype->Ref = LLVMPointerType
+      (LLVMStructCreateNamed(LLVMGetGlobalContext(), Ident.cstr), 0);
+    break;
+  case OTKIncompleteRecord:
+    Atype->Ref = LLVMStructCreateNamed(LLVMGetGlobalContext(), Ident.cstr);
+    break;
+  default:
+    break;
+  }
+}
+
+struct ORecordAggrList {
+  unsigned Len;
+  LLVMValueRef *Els;
+  OTnode Atype;
+};
+
+extern "C" void
+start_record_aggr(ORecordAggrList *List, OTnode Atype)
+{
+  unsigned Count = LLVMCountStructElementTypes(Atype->Ref);
+  *List = {0, new LLVMValueRef[Count], Atype};
+}
+
+extern "C" void
+new_record_aggr_el(ORecordAggrList *List, OCnode *Val)
+{
+  List->Els[List->Len++] = Val->Ref;
+}
+
+extern "C" void
+finish_record_aggr(ORecordAggrList *List, OCnode *Res)
+{
+  *Res = {LLVMConstStruct(List->Els, List->Len, 0), List->Atype};
+  delete List->Els;
+}
+
+struct OArrayAggrList {
+  unsigned Len;
+  LLVMValueRef *Els;
+  LLVMTypeRef ElType;
+  OTnode Atype;
+};
+
+extern "C" void
+start_array_aggr(OArrayAggrList *List, OTnodeArr *Atype, unsigned len)
+{
+  *List = {0, new LLVMValueRef[len], Atype->ElType->Ref, Atype};
+}
+
+extern "C" void
+new_array_aggr_el(OArrayAggrList *List, OCnode *Value)
+{
+  List->Els[List->Len++] = Value->Ref;
+}
+
+extern "C" void
+finish_array_aggr(OArrayAggrList *List, OCnode *Res)
+{
+  *Res = {LLVMConstArray(List->ElType, List->Els, List->Len), List->Atype};
+  delete List->Els;
+}
+
+extern "C" OCnode
+new_union_aggr(OTnodeUnion *Atype, OFnodeUnion *Field, OCnode *Value)
+{
+  unsigned Size = LLVMABISizeOfType(TheTargetData, Field->Utype);
+  LLVMValueRef Vals[2];
+  unsigned Count;
+
+  Vals[0] = Value->Ref;
+  if (Size < Atype->Size) {
+    //  Add padding.
+    Vals[1] = LLVMGetUndef(LLVMArrayType(LLVMInt8Type(), Atype->Size - Size));
+    Count = 2;
+  } else {
+    Count = 1;
+  }
+
+  return {LLVMConstStruct(Vals, Count, false), Atype};
+}
+
+extern "C" OCnode
+new_default_value(OTnode Ltype)
+{
+  return {LLVMConstNull(Ltype->Ref), Ltype};
+}
+
+static OCnode
+constToConst(OTnode Rtype, uint64_t Val)
+{
+  LLVMValueRef Ref;
+
+  switch (Rtype->Kind) {
+  case OTKUnsigned:
+  case OTKSigned:
+    Ref = LLVMConstInt(Rtype->Ref, Val, 0);
+    break;
+  case OTKAccess:
+    //  It is possible to use an access type for offsetof.
+    Ref = LLVMConstInt(LLVMInt64Type(), Val, 0);
+    Ref = LLVMConstIntToPtr(Ref, Rtype->Ref);
+    break;
+  default:
+    abort();
+  }
+  return {Ref, Rtype};
+}
+
+extern "C" OCnode
+new_sizeof(OTnode Atype, OTnode Rtype)
+{
+  return constToConst(Rtype, LLVMABISizeOfType(TheTargetData, Atype->Ref));
+}
+
+extern "C" OCnode
+new_alignof(OTnode Atype, OTnode Rtype)
+{
+  return constToConst
+    (Rtype, LLVMABIAlignmentOfType(TheTargetData, Atype->Ref));
+}
+
+extern "C" OCnode
+new_offsetof(OTnode Atype, OFnodeRec *Field, OTnode Rtype)
+{
+  return constToConst
+    (Rtype, LLVMOffsetOfElement(TheTargetData, Atype->Ref, Field->Index));
+}
+
+struct OEnode {
+  LLVMValueRef Ref;
+  OTnode Etype;
+};
+
+extern "C" OEnode
+new_lit(OCnode *Lit)
+{
+  return {Lit->Ref, Lit->Ctype};
+}
+
+enum ODKind : unsigned char {
+  ODKConst,
+  ODKVar,
+  ODKLocal,
+  ODKInterface,
+  ODKType,
+  ODKSubprg
+};
+
+struct ODnodeBase {
+  LLVMValueRef Ref;
+  OTnode Dtype;
+  virtual ODKind getKind() const = 0;
+  ODnodeBase(LLVMValueRef R, OTnode T) : Ref(R), Dtype(T) {}
+  virtual ~ODnodeBase() {}
+};
+
+typedef ODnodeBase *ODnode;
+
+struct ODnodeVar : ODnodeBase {
+  ODKind getKind() const override { return ODKVar; }
+  ODnodeVar(LLVMValueRef R, OTnode T) : ODnodeBase(R, T) {}
+};
+
+struct ODnodeLocalVar : ODnodeBase {
+  ODKind getKind() const override { return ODKLocal; }
+  ODnodeLocalVar(LLVMValueRef R, OTnode T) : ODnodeBase(R, T) {}
+};
+
+enum OStorage {
+  O_Storage_External,
+  O_Storage_Public,
+  O_Storage_Private,
+  O_Storage_Local
+};
+
+extern "C" void
+new_var_decl(ODnode *Res, OIdent Ident, OStorage Storage, OTnode Atype)
+{
+  LLVMValueRef Decl;
+
+  if (Storage == O_Storage_Local) {
+    if (Unreach)
+      Decl = nullptr;
+    else
+      Decl = LLVMBuildAlloca (DeclBuilder, Atype->Ref, Ident.cstr);
+    *Res = new ODnodeLocalVar(Decl, Atype);
+  } else {
+    if (Storage == O_Storage_External) {
+      Decl = LLVMGetNamedGlobal(TheModule, Ident.cstr);
+    } else {
+      Decl = nullptr;
+    }
+    if (Decl == nullptr)
+      Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
+
+    *Res = new ODnodeVar(Decl, Atype);
+    if (Storage == O_Storage_Private)
+      LLVMSetLinkage(Decl, LLVMInternalLinkage);
+
+    switch(Storage) {
+    case O_Storage_Public:
+    case O_Storage_Private:
+      LLVMSetInitializer(Decl, LLVMConstNull(Atype->Ref));
+      break;
+    default:
+      break;
+    }
+  }
+}
+
+struct ODnodeConst : ODnodeBase {
+  OStorage Storage;
+  OIdent Ident;
+  ODKind getKind() const override { return ODKConst; }
+  ODnodeConst(LLVMValueRef R, OTnode T, OStorage S, OIdent I) :
+    ODnodeBase(R, T), Storage(S), Ident(I) {}
+};
+
+static void
+setConstAttributes(LLVMValueRef Ref, OStorage Storage)
+{
+  LLVMSetGlobalConstant(Ref, true);
+  if (Storage == O_Storage_Private)
+    LLVMSetLinkage(Ref, LLVMInternalLinkage);
+}
+
+extern "C" void
+new_const_decl(ODnode *Res, OIdent Ident, OStorage Storage, OTnode Atype)
+{
+  LLVMValueRef Decl;
+
+  if (Storage == O_Storage_External) {
+    //  It is possible to re-declare an external const.
+    Decl = LLVMGetNamedGlobal(TheModule, Ident.cstr);
+    if (Decl == nullptr)
+      Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
+    setConstAttributes(Decl, Storage);
+  } else {
+    //  If the type of the constant is not yet bounded, delay the creation
+    //  of the constant until its initialization.
+    if (Atype->Bounded) {
+      Decl = LLVMAddGlobal(TheModule, Atype->Ref, Ident.cstr);
+      setConstAttributes(Decl, Storage);
+    } else {
+      Decl = nullptr;
+    }
+  }
+
+  *Res = new ODnodeConst(Decl, Atype, Storage, Ident);
+}
+
+extern "C" void
+start_init_value(ODnodeConst **Decl)
+{
+}
+
+extern "C" void
+finish_init_value(ODnodeConst **Decl, OCnode *Val)
+{
+  LLVMValueRef Ref = (*Decl)->Ref;
+
+  if (Ref == nullptr) {
+    Ref = LLVMAddGlobal(TheModule, LLVMTypeOf(Val->Ref), (*Decl)->Ident.cstr);
+    setConstAttributes(Ref, (*Decl)->Storage);
+    (*Decl)->Ref = Ref;
+  }
+
+  LLVMSetInitializer(Ref, Val->Ref);
+}
+
+struct ODnodeInter : ODnodeBase {
+  ODKind getKind() const override { return ODKInterface; }
+  ODnodeInter(LLVMValueRef R, OTnode T) : ODnodeBase(R, T) {}
+};
+
+struct OInter {
+  ODnodeInter *Decl;
+  OIdent Ident;
+  OInter *Next;
+};
+
+struct OInterList {
+  OIdent Ident;
+  OStorage Storage;
+  OTnode Rtype;
+
+  //  Number of interfaces.
+  unsigned Count;
+  OInter *FirstInter;
+  OInter *LastInter;
+};
+
+extern "C" void
+start_function_decl(OInterList *Inters, OIdent Ident, OStorage Storage,
+		    OTnode Rtype)
+{
+  *Inters = { Ident, Storage, Rtype, 0, nullptr, nullptr };
+}
+
+extern "C" void
+start_procedure_decl(OInterList *Inters, OIdent Ident, OStorage Storage)
+{
+  *Inters = { Ident, Storage, nullptr, 0, nullptr, nullptr };
+}
+
+extern "C" void
+new_interface_decl(OInterList *Inters,
+		   ODnode *Res, OIdent Ident, OTnode Itype)
+{
+  ODnodeInter *Decl = new ODnodeInter(nullptr, Itype);
+  OInter *Inter = new OInter{Decl, Ident, nullptr};
+
+  *Res = Decl;
+  Inters->Count++;
+  if (Inters->FirstInter == nullptr)
+    Inters->FirstInter = Inter;
+  else
+    Inters->LastInter->Next = Inter;
+  Inters->LastInter = Inter;
+}
+
+struct ODnodeSubprg : ODnodeBase {
+  //  Number of interfaces.
+  unsigned Count;
+  ODKind getKind() const override { return ODKSubprg; }
+  ODnodeSubprg(LLVMValueRef R, OTnode T, unsigned Count) :
+    ODnodeBase(R, T), Count(Count) {}
+};
+
+extern "C" void
+finish_subprogram_decl(OInterList *Inters, ODnode *Res)
+{
+  LLVMTypeRef *Types = new LLVMTypeRef[Inters->Count];
+
+  //  Build array of interface types.
+  int i = 0;
+  for (OInter *Inter = Inters->FirstInter; Inter; Inter = Inter->Next, i++)
+    Types[i] = Inter->Decl->Dtype->Ref;
+
+  LLVMTypeRef Rtype;
+  if (Inters->Rtype == nullptr)
+    Rtype = LLVMVoidType();
+  else
+    Rtype = Inters->Rtype->Ref;
+
+  LLVMTypeRef Ftype = LLVMFunctionType(Rtype, Types, Inters->Count, 0);
+
+  LLVMValueRef Decl;
+  if (Inters->Storage == O_Storage_External)
+    Decl = LLVMGetNamedFunction(TheModule, Inters->Ident.cstr);
+  else
+    Decl = nullptr;
+  if (Decl == nullptr) {
+    Decl = LLVMAddFunction(TheModule, Inters->Ident.cstr, Ftype);
+    LLVMAddAttributeAtIndex(Decl, LLVMAttributeFunctionIndex, NounwindAttr);
+    LLVMAddAttributeAtIndex(Decl, LLVMAttributeFunctionIndex, UwtableAttr);
+    LLVMSetFunctionCallConv(Decl, LLVMCCallConv);
+  }
+
+  *Res = new ODnodeSubprg(Decl, Inters->Rtype, Inters->Count);
+
+  //  Translate interfaces
+  i = 0;
+  for (OInter *Inter = Inters->FirstInter, *Next; Inter; Inter = Next, i++) {
+    Inter->Decl->Ref = LLVMGetParam(Decl, i);
+    LLVMSetValueName(Inter->Decl->Ref, Inter->Ident.cstr);
+    Next = Inter->Next;
+    delete Inter;
+  }
+}
+
+//  Data for a declare block.
+struct DeclareBlock {
+  //  First basic block of the declare.
+  LLVMBasicBlockRef StmtBB;
+
+  //  To handle allocb: stack pointer at the entry of the block, that needs
+  //  to be restored when leaving the block (either by falling through or
+  //  via exit/next).  Set only of New_Alloca is used.
+  LLVMValueRef StackValue;
+
+  //  Previous value block.
+  DeclareBlock *Prev;
+};
+
+static DeclareBlock *CurrentDeclareBlock;
+static DeclareBlock *OldDeclareBlock;
+
+static LLVMValueRef CurrentFunc;
+static ODnodeSubprg *CurrentFuncDecl;
+
+static void
+CreateDeclareBlock()
+{
+  DeclareBlock *Res;
+
+  //  Allocate a declare block
+  if (OldDeclareBlock != nullptr) {
+    Res = OldDeclareBlock;
+    OldDeclareBlock = Res->Prev;
+  } else {
+    Res = new DeclareBlock;
+  }
+  *Res = { nullptr, nullptr, CurrentDeclareBlock };
+  CurrentDeclareBlock = Res;
+
+  if (!Unreach) {
+    Res->StmtBB = LLVMAppendBasicBlock(CurrentFunc, "");
+  }
+}
+
+static void
+DestroyDeclareBlock()
+{
+  DeclareBlock *Blk = CurrentDeclareBlock;
+
+  CurrentDeclareBlock = Blk->Prev;
+
+  Blk->Prev = OldDeclareBlock;
+  OldDeclareBlock = Blk;
+}
+
+extern "C" void
+start_subprogram_body(ODnodeSubprg *Func)
+{
+  LLVMBasicBlockRef DeclBB;
+
+  //  Nested subprograms are not supported.
+  assert (CurrentFunc == nullptr);
+
+  CurrentFunc = Func->Ref;
+  CurrentFuncDecl = Func;
+
+  assert(!Unreach);
+
+  DeclBB = LLVMAppendBasicBlock(CurrentFunc, "");
+  LLVMPositionBuilderAtEnd(DeclBuilder, DeclBB);
+
+  CreateDeclareBlock();
+  LLVMPositionBuilderAtEnd(Builder, CurrentDeclareBlock->StmtBB);
+}
+
+extern "C" void
+finish_subprogram_body()
+{
+  //  Add a jump from the declare basic block to the first statement BB.
+  LLVMBuildBr(DeclBuilder, CurrentDeclareBlock->StmtBB);
+
+  //  Terminate the statement BB
+  if (!Unreach) {
+    if (CurrentFuncDecl->Dtype == nullptr)
+      LLVMBuildRetVoid (Builder);
+    else
+      LLVMBuildUnreachable (Builder);
+  }
+
+  DestroyDeclareBlock();
+
+  CurrentFunc = nullptr;
+  Unreach = false;
+}
+
+extern "C" void
+start_declare_stmt ()
+{
+  CreateDeclareBlock();
+
+  if (Unreach)
+    return;
+
+  //  Add a jump to the new BB.
+  LLVMBuildBr(Builder, CurrentDeclareBlock->StmtBB);
+
+  LLVMPositionBuilderAtEnd(Builder, CurrentDeclareBlock->StmtBB);
+}
+
+extern "C" void
+finish_declare_stmt ()
+{
+  if (!Unreach) {
+    LLVMBasicBlockRef Bb;
+
+    //  Create a basic block for the statements after the dclare
+    Bb = LLVMAppendBasicBlock(CurrentFunc, "");
+
+    if (CurrentDeclareBlock->StackValue != nullptr) {
+      //  Restore stack pointer
+      LLVMBuildCall(Builder, StackRestoreFun,
+		    &CurrentDeclareBlock->StackValue, 1, "");
+    }
+    //  Execution will continue on the next statement
+    LLVMBuildBr(Builder, Bb);
+
+    LLVMPositionBuilderAtEnd(Builder, Bb);
+  }
+
+  //  Do not reset Unreach.
+  DestroyDeclareBlock();
+}
+
+struct OSNode {
+  //  BB at the entry of the loop.  Will branch to it on next statement and
+  //  at the end of the loop.
+  LLVMBasicBlockRef BBEntry;
+  //  BB after the loop.  Exit statement branches to it.
+  LLVMBasicBlockRef BBExit;
+};
+
+extern "C" void
+start_loop_stmt (OSNode *Label)
+{
+  if (Unreach) {
+    *Label = { nullptr, nullptr };
+    return;
+  }
+
+  *Label = { LLVMAppendBasicBlock(CurrentFunc, ""), nullptr };
+#if 1
+  Label->BBExit = LLVMAppendBasicBlock(CurrentFunc, "");
+#endif
+  LLVMBuildBr(Builder, Label->BBEntry);
+  LLVMPositionBuilderAtEnd(Builder, Label->BBEntry);
+}
+
+extern "C" void
+finish_loop_stmt (OSNode *Label)
+{
+  if (!Unreach)
+    LLVMBuildBr(Builder, Label->BBEntry);
+
+  if (Label->BBExit != nullptr) {
+    //  Continue only if the exit was reachable.
+    LLVMPositionBuilderAtEnd(Builder, Label->BBExit);
+    Unreach = false;
+  } else {
+    Unreach = true;
+  }
+}
+
+extern "C" void
+new_exit_stmt (OSNode *Label)
+{
+  if (Unreach)
+    return;
+
+#if 0
+  //  Currently LABEL is an input (so cannot be modified)
+  if (Label->BBExit == nullptr) {
+    //  We know the end of the loop is reachable
+    Label->BBExit = LLVMAppendBasicBlock(CurrentFunc, "");
+  }
+#endif
+
+  LLVMBuildBr(Builder, Label->BBExit);
+  Unreach = true;
+}
+
+extern "C" void
+new_next_stmt (OSNode *Label)
+{
+  if (Unreach)
+    return;
+
+  LLVMBuildBr(Builder, Label->BBEntry);
+  Unreach = true;
+}
+
+struct OIFBlock {
+  LLVMBasicBlockRef Bb;
+};
+
+extern "C" void
+start_if_stmt (OIFBlock *Blk, OEnode Cond)
+{
+  if (Unreach) {
+    *Blk = { nullptr};
+    return;
+  }
+
+  LLVMBasicBlockRef BBThen;
+
+  //  Create BB for Then and Else.
+  BBThen = LLVMAppendBasicBlock(CurrentFunc, "");
+  *Blk = { LLVMAppendBasicBlock(CurrentFunc, "") };
+
+  LLVMBuildCondBr(Builder, Cond.Ref, BBThen, Blk->Bb);
+  LLVMPositionBuilderAtEnd(Builder, BBThen);
+}
+
+extern "C" void
+new_else_stmt (OIFBlock *Blk)
+{
+  LLVMBasicBlockRef BBNext;
+
+  if (!Unreach) {
+    //  Create a BB for after the If statement
+    BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
+    //  And jump to it.
+    LLVMBuildBr(Builder, BBNext);
+  } else {
+    if (Blk->Bb == nullptr) {
+      //  The IF statement was unreachable, so is the Else part.
+      return;
+    }
+    //  Do not yet create the BB for after the If statement, as we don't
+    //  know if it is reachable.
+    BBNext = nullptr;
+  }
+
+  //  Use the BB for the Else part.
+  LLVMPositionBuilderAtEnd(Builder, Blk->Bb);
+
+  Blk->Bb = BBNext;
+  //  The Else part is reachable.
+  Unreach = false;
+}
+
+extern "C" void
+finish_if_stmt (OIFBlock *Blk)
+{
+  LLVMBasicBlockRef BBNext;
+
+  if (!Unreach) {
+    if (Blk->Bb == nullptr)
+      BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
+    else
+      BBNext = Blk->Bb;
+    LLVMBuildBr(Builder, BBNext);
+    LLVMPositionBuilderAtEnd(Builder, BBNext);
+  } else {
+    //  The branch doesn't continue.
+    if (Blk->Bb != nullptr) {
+      //  There is at least one fall-through (either from the Then or from
+      //  the Else.
+      Unreach = false;
+      LLVMPositionBuilderAtEnd(Builder, Blk->Bb);
+    }
+  }
+}
+
+struct OChoice {
+  LLVMValueRef Low, High;
+  LLVMBasicBlockRef BB;
+};
+
+struct OCaseBlock {
+  //  BB before the case.
+  LLVMBasicBlockRef BBPrev;
+
+  //  Select expression
+  LLVMValueRef Value;
+  OTnode Vtype;
+
+  //  BB after the case statement
+  LLVMBasicBlockRef BBNext;
+
+  //  BB for others
+  LLVMBasicBlockRef BBOthers;
+
+  //  BB for the current choice
+  LLVMBasicBlockRef BBChoice;
+
+  std::vector<OChoice> *Choices;
+};
+
+extern "C" void
+start_case_stmt (OCaseBlock *Blk, OEnode Value)
+{
+  LLVMBasicBlockRef BB;
+  std::vector<OChoice> *Choices;
+
+  if (Unreach) {
+    //  The case statement is unreachable, discard it completly.
+    BB = nullptr;
+    Choices = nullptr;
+  } else {
+    BB = LLVMGetInsertBlock(Builder);
+    Choices = new std::vector<OChoice>;
+  }
+
+  *Blk = { BB,
+	   Value.Ref,
+	   Value.Etype,
+	   nullptr,
+	   nullptr,
+	   nullptr,
+	   Choices };
+}
+
+//  Close previous branch
+static void
+finishBranch (OCaseBlock *Blk)
+{
+  if (Unreach) {
+    //  No need to close it as this point is not reachable.
+    return;
+  }
+
+  if (Blk->BBNext == nullptr) {
+    //  Create the BB for after the case statement.
+    //  It also means the end is reachable.
+    Blk->BBNext = LLVMAppendBasicBlock(CurrentFunc, "");
+  }
+  LLVMBuildBr(Builder, Blk->BBNext);
+}
+
+extern "C" void
+start_choice (OCaseBlock *Blk)
+{
+  if (Blk->BBPrev == nullptr) {
+    //  The wholse case statement was unreachable
+    assert(Unreach);
+    return;
+  }
+
+  if (Blk->BBChoice != nullptr) {
+    //  Close previous branch
+    finishBranch(Blk);
+  }
+
+  //  This new choice is reachable from the start of the case statement.
+  Unreach = false;
+
+  //  Create a new BB.
+  Blk->BBChoice = LLVMAppendBasicBlock(CurrentFunc, "");
+  LLVMPositionBuilderAtEnd(Builder, Blk->BBChoice);
+}
+
+//  Add a choice that will branch to Blk->BBChoice.
+static void
+newChoice(OCaseBlock *Blk, LLVMValueRef Low, LLVMValueRef High)
+{
+  if (Unreach)
+    return;
+
+  Blk->Choices->push_back({Low, High, Blk->BBChoice});
+}
+
+extern "C" void
+new_expr_choice (OCaseBlock *Blk, OCnode *Expr)
+{
+  newChoice(Blk, Expr->Ref, nullptr);
+}
+
+extern "C" void
+new_range_choice (OCaseBlock *Blk, OCnode *Low, OCnode *High)
+{
+  newChoice(Blk, Low->Ref, High->Ref);
+}
+
+extern "C" void
+new_default_choice (OCaseBlock *Blk)
+{
+  if (Unreach)
+    return;
+
+  Blk->BBOthers = Blk->BBChoice;
+}
+
+extern "C" void
+finish_choice (OCaseBlock *Blk)
+{
+}
+
+extern "C" void
+finish_case_stmt (OCaseBlock *Blk)
+{
+  LLVMIntPredicate GE, LE;
+
+  if (Blk->BBPrev == nullptr) {
+    //  The whole case statement is not reachable.
+    return;
+  }
+
+  if (Blk->BBChoice != nullptr) {
+    //  Close previous branch
+    finishBranch(Blk);
+  }
+
+  //  Strategy: use a switch instruction for simple choices, put range choices
+  //  in the default branch, using if statements.
+  //  TODO: could improve the handling of ranges (dichotomy, decision tree...)
+  switch (Blk->Vtype->Kind) {
+  case OTKUnsigned:
+  case OTKEnum:
+  case OTKBool:
+    GE = LLVMIntUGE;
+    LE = LLVMIntULE;
+    break;
+  case OTKSigned:
+    GE = LLVMIntSGE;
+    LE = LLVMIntSLE;
+    break;
+  default:
+    llvm_unreachable();
+  }
+
+  //  BB for the default case.
+  LLVMBasicBlockRef BBDefault = LLVMAppendBasicBlock(CurrentFunc, "");
+  LLVMPositionBuilderAtEnd(Builder, BBDefault);
+
+  //  Put range choices in the default case.
+  unsigned int Count = 0;
+  LLVMBasicBlockRef BBLast = BBDefault;
+  for(auto &c: *Blk->Choices) {
+    if (c.High != nullptr) {
+      BBLast = LLVMAppendBasicBlock(CurrentFunc, "");
+      LLVMBuildCondBr(Builder,
+		      LLVMBuildAnd(Builder,
+				   LLVMBuildICmp(Builder, GE,
+						 Blk->Value, c.Low, ""),
+				   LLVMBuildICmp(Builder, LE,
+						 Blk->Value, c.High, ""),
+				   ""),
+		      c.BB, BBLast);
+      LLVMPositionBuilderAtEnd(Builder, BBLast);
+    } else {
+      Count++;
+    }
+  }
+
+  //  Insert the switch
+  LLVMPositionBuilderAtEnd(Builder, Blk->BBPrev);
+  LLVMValueRef Sw = LLVMBuildSwitch(Builder, Blk->Value, BBDefault, Count);
+  for(auto &c: *Blk->Choices) {
+    if (c.High == nullptr) {
+      LLVMAddCase(Sw, c.Low, c.BB);
+    }
+  }
+
+  //  Insert the others (if there is one).
+  LLVMPositionBuilderAtEnd(Builder, BBLast);
+  if (Blk->BBOthers != nullptr)
+    LLVMBuildBr(Builder, Blk->BBOthers);
+  else
+    LLVMBuildUnreachable(Builder);
+
+  //  Next BB.
+  if (Blk->BBNext != nullptr) {
+    Unreach = false;
+    LLVMPositionBuilderAtEnd(Builder, Blk->BBNext);
+  } else {
+    //  No branch falls through
+    Unreach = true;
+  }
+  delete Blk->Choices;
+}
+
+struct OAssocList {
+  ODnodeSubprg *Subprg;
+  unsigned Idx;
+  LLVMValueRef *Vals;
+};
+
+extern "C" void
+start_association (OAssocList *Assocs, ODnodeSubprg *Subprg)
+{
+  *Assocs = { Subprg, 0, new LLVMValueRef[Subprg->Count] };
+}
+
+extern "C" void
+new_association (OAssocList *Assocs, OEnode Val)
+{
+  Assocs->Vals[Assocs->Idx++] = Val.Ref;
+}
+
+extern "C" OEnode
+new_function_call (OAssocList *Assocs)
+{
+  LLVMValueRef Res;
+
+  if (!Unreach) {
+    Res = LLVMBuildCall(Builder, Assocs->Subprg->Ref,
+			Assocs->Vals, Assocs->Subprg->Count, "");
+  } else {
+    Res = nullptr;
+  }
+  delete Assocs->Vals;
+  return { Res, Assocs->Subprg->Dtype };
+}
+
+extern "C" void
+new_procedure_call (OAssocList *Assocs)
+{
+  if (!Unreach) {
+    LLVMBuildCall(Builder, Assocs->Subprg->Ref,
+		  Assocs->Vals, Assocs->Subprg->Count, "");
+  }
+  delete Assocs->Vals;
+}
+
+extern "C" void
+new_func_return_stmt (OEnode Value)
+{
+  if (Unreach)
+    return;
+  LLVMBuildRet(Builder, Value.Ref);
+  Unreach = true;
+}
+
+extern "C" void
+new_proc_return_stmt ()
+{
+  if (Unreach)
+    return;
+  LLVMBuildRetVoid(Builder);
+  Unreach = true;
+}
+
+enum ONOpKind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or,
+  ON_Xor,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+struct ComparePred {
+  LLVMIntPredicate SignedPred;
+  LLVMIntPredicate UnsignedPred;
+  LLVMRealPredicate RealPred;
+};
+
+static const ComparePred CompareTable[] = {
+  {LLVMIntEQ,  LLVMIntEQ,  LLVMRealOEQ }, // Eq
+  {LLVMIntNE,  LLVMIntNE,  LLVMRealONE }, // Ne
+  {LLVMIntSLE, LLVMIntULE, LLVMRealOLE }, // Le
+  {LLVMIntSLT, LLVMIntULT, LLVMRealOLT }, // Lt
+  {LLVMIntSGE, LLVMIntUGE, LLVMRealOGE }, // Ge
+  {LLVMIntSGT, LLVMIntUGT, LLVMRealOGT }  // Gt
+};
+
+extern "C" OEnode
+new_compare_op (ONOpKind Kind, OEnode Left, OEnode Right, OTnode Rtype)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    return {nullptr, Rtype};
+
+  //  Cannot apply C convention to ON_Op_Kind, so we need to truncate it
+  //  (as it is represented by a byte from Ada and by int from C)
+  Kind = static_cast<ONOpKind>(Kind & 0xff);
+
+  switch(Left.Etype->Kind) {
+  case OTKUnsigned:
+  case OTKEnum:
+  case OTKBool:
+  case OTKAccess:
+  case OTKIncompleteAccess:
+    Res = LLVMBuildICmp(Builder, CompareTable[Kind - ON_Eq].UnsignedPred,
+			Left.Ref, Right.Ref, "");
+    break;
+  case OTKSigned:
+    Res = LLVMBuildICmp(Builder, CompareTable[Kind - ON_Eq].SignedPred,
+			Left.Ref, Right.Ref, "");
+    break;
+  case OTKFloat:
+    Res = LLVMBuildFCmp(Builder, CompareTable[Kind - ON_Eq].RealPred,
+			Left.Ref, Right.Ref, "");
+    break;
+  default:
+    abort();
+  }
+  return {Res, Rtype};
+}
+
+extern "C" OEnode
+new_monadic_op (ONOpKind Kind, OEnode Operand)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    return { nullptr, Operand.Etype};
+
+  //  Cannot apply C convention to ON_Op_Kind, so we need to truncate it
+  //  (as it is represented by a byte from Ada and by int from C)
+  Kind = static_cast<ONOpKind>(Kind & 0xff);
+
+  switch (Operand.Etype->Kind) {
+  case OTKUnsigned:
+  case OTKSigned:
+  case OTKBool:
+    switch (Kind) {
+    case ON_Not:
+      Res = LLVMBuildNot(Builder, Operand.Ref, "");
+      break;
+    case ON_Neg_Ov:
+      Res = LLVMBuildNeg(Builder, Operand.Ref, "");
+      break;
+    case ON_Abs_Ov:
+      Res = LLVMBuildSelect
+	(Builder,
+	 LLVMBuildICmp (Builder, LLVMIntSLT,
+			Operand.Ref,
+			LLVMConstInt(Operand.Etype->Ref, 0, 0),
+			""),
+	 LLVMBuildNeg(Builder, Operand.Ref, ""),
+	 Operand.Ref,
+	 "");
+      break;
+    default:
+      llvm_unreachable();
+    }
+    break;
+  case OTKFloat:
+    switch (Kind) {
+    case ON_Neg_Ov:
+      Res = LLVMBuildFNeg(Builder, Operand.Ref, "");
+      break;
+    case ON_Abs_Ov:
+      Res = LLVMBuildSelect
+	(Builder,
+	 LLVMBuildFCmp (Builder, LLVMRealOLT,
+			Operand.Ref,
+			LLVMConstReal(Operand.Etype->Ref, 0.0),
+			""),
+	 LLVMBuildFNeg(Builder, Operand.Ref, ""),
+	 Operand.Ref,
+	 "");
+      break;
+    default:
+      abort();
+    }
+    break;
+  default:
+    abort();
+  }
+  return {Res, Operand.Etype};
+}
+
+static LLVMValueRef
+BuildSMod(LLVMBuilderRef Build, LLVMValueRef L, LLVMValueRef R, const char *s)
+{
+  LLVMTypeRef T = LLVMTypeOf(L);
+  LLVMBasicBlockRef NormalBB;
+  LLVMBasicBlockRef AdjustBB;
+  LLVMBasicBlockRef NextBB;
+  LLVMValueRef PhiVals[3];
+  LLVMBasicBlockRef PhiBB[3];
+
+  NextBB = LLVMAppendBasicBlock(CurrentFunc, "");
+  NormalBB = LLVMAppendBasicBlock(CurrentFunc, "");
+
+  //  Avoid overflow with -1
+  //  if R = -1 then
+  //    result := 0;
+  //  else
+  //    ...
+  LLVMValueRef Cond;
+  Cond = LLVMBuildICmp(Builder, LLVMIntEQ, R, LLVMConstAllOnes(T), "");
+  LLVMBuildCondBr(Builder, Cond, NextBB, NormalBB);
+  PhiBB[0] = LLVMGetInsertBlock(Builder);
+  PhiVals[0] = LLVMConstNull(T);
+
+  //  Rm := Left rem Right
+  LLVMPositionBuilderAtEnd(Builder, NormalBB);
+  LLVMValueRef Rm = LLVMBuildSRem(Builder, L, R, s);
+
+  //  if Rm = 0 then
+  //    result := 0
+  //  else
+  AdjustBB = LLVMAppendBasicBlock(CurrentFunc, "");
+  Cond = LLVMBuildICmp(Builder, LLVMIntEQ, Rm, LLVMConstNull(T), "");
+  LLVMBuildCondBr(Builder, Cond, NextBB, AdjustBB);
+  PhiBB[1] = NormalBB;
+  PhiVals[1] = LLVMConstNull(T);
+
+  //    if (L xor R) < 0 then
+  //      result := Rm + R
+  //    else
+  //      result := Rm
+  LLVMPositionBuilderAtEnd(Builder, AdjustBB);
+  LLVMValueRef RXor = LLVMBuildXor(Builder, L, R, "");
+  Cond = LLVMBuildICmp(Builder, LLVMIntSLT, RXor, LLVMConstNull(T), "");
+  LLVMValueRef RmPlusR = LLVMBuildAdd(Builder, Rm, R, "");
+  LLVMValueRef Adj = LLVMBuildSelect(Builder, Cond, RmPlusR, Rm, "");
+  LLVMBuildBr(Builder, NextBB);
+  PhiBB[2] = AdjustBB;
+  PhiVals[2] = Adj;
+
+  //  The Phi node
+  LLVMPositionBuilderAtEnd(Builder, NextBB);
+  LLVMValueRef Phi = LLVMBuildPhi(Builder, T, "");
+  LLVMAddIncoming(Phi, PhiVals, PhiBB, 3);
+
+  return Phi;
+}
+
+extern "C" OEnode
+new_dyadic_op (ONOpKind Kind, OEnode Left, OEnode Right)
+{
+  LLVMValueRef Res;
+  LLVMValueRef (*Build)(LLVMBuilderRef, LLVMValueRef, LLVMValueRef, const char *);
+  OTKind ArgKind = Left.Etype->Kind;
+
+  if (Unreach)
+    return { nullptr, Left.Etype};
+
+  //  Cannot apply C convention to ON_Op_Kind, so we need to truncate it
+  //  (as it is represented by a byte from Ada and by int from C)
+  Kind = static_cast<ONOpKind>(Kind & 0xff);
+
+  switch (ArgKind) {
+  case OTKUnsigned:
+  case OTKSigned:
+  case OTKBool:
+  case OTKEnum:
+    switch (Kind) {
+    case ON_And:
+      Build = &LLVMBuildAnd;
+      break;
+    case ON_Or:
+      Build = &LLVMBuildOr;
+      break;
+    case ON_Xor:
+      Build = &LLVMBuildXor;
+      break;
+
+    case ON_Add_Ov:
+      Build = &LLVMBuildAdd;
+      break;
+    case ON_Sub_Ov:
+      Build = &LLVMBuildSub;
+      break;
+    case ON_Mul_Ov:
+      Build = &LLVMBuildMul;
+      break;
+    case ON_Div_Ov:
+      if (ArgKind == OTKUnsigned)
+	Build = &LLVMBuildUDiv;
+      else
+	Build = &LLVMBuildSDiv;
+      break;
+    case ON_Mod_Ov:
+      if (ArgKind == OTKUnsigned)
+	Build = &LLVMBuildURem;
+      else
+	Build = &BuildSMod;
+      break;
+    case ON_Rem_Ov:
+      if (ArgKind == OTKUnsigned)
+	Build = &LLVMBuildURem;
+      else
+	Build = &LLVMBuildSRem;
+      break;
+    default:
+      abort();
+    }
+    break;
+
+  case OTKFloat:
+    switch (Kind) {
+    case ON_Add_Ov:
+      Build = &LLVMBuildFAdd;
+      break;
+    case ON_Sub_Ov:
+      Build = &LLVMBuildFSub;
+      break;
+    case ON_Mul_Ov:
+      Build = &LLVMBuildFMul;
+      break;
+    case ON_Div_Ov:
+      Build = &LLVMBuildFDiv;
+      break;
+    default:
+      llvm_unreachable();
+    }
+    break;
+
+  default:
+    abort();
+  }
+
+  Res = Build(Builder, Left.Ref, Right.Ref, "");
+  return {Res, Left.Etype};
+}
+
+extern "C" OEnode
+new_convert_ov (OEnode Val, OTnode Rtype)
+{
+  if (Unreach) {
+    return {nullptr, Rtype};
+  }
+
+  if (Rtype == Val.Etype) {
+    //  Same type, nothing to do
+    return Val;
+  }
+
+  if (Rtype->Ref == Val.Etype->Ref) {
+    //  Same undelaying LLVM type.  No conversion.
+    return {Val.Ref, Rtype};
+  }
+
+  LLVMValueRef Res;
+
+  switch(Rtype->Kind) {
+  case OTKUnsigned:
+  case OTKSigned:
+  case OTKEnum:
+  case OTKBool:
+    switch(Val.Etype->Kind) {
+    case OTKUnsigned:
+    case OTKSigned:
+    case OTKEnum:
+    case OTKBool:
+      //  Int to Int
+      if (static_cast<OTnodeScal*>(Val.Etype)->ScalSize
+	  > static_cast<OTnodeScal*>(Rtype)->ScalSize)
+	Res = LLVMBuildTrunc(Builder, Val.Ref, Rtype->Ref, "");
+      else if (static_cast<OTnodeScal*>(Val.Etype)->ScalSize
+	       < static_cast<OTnodeScal*>(Rtype)->ScalSize) {
+	if (Val.Etype->Kind == OTKSigned)
+	  Res = LLVMBuildSExt(Builder, Val.Ref, Rtype->Ref, "");
+	else
+	  Res = LLVMBuildZExt(Builder, Val.Ref, Rtype->Ref, "");
+      } else {
+	Res = LLVMBuildBitCast(Builder, Val.Ref, Rtype->Ref, "");
+      }
+      break;
+    case OTKFloat:
+      //  Float to Int
+      {
+	LLVMValueRef V;
+	LLVMValueRef Args[2];
+	Args[0] = Fp0_5;
+	Args[1] = Val.Ref;
+	V = LLVMBuildCall(Builder, CopySignFun, Args, 2, "");
+	V = LLVMBuildFAdd(Builder, V, Val.Ref, "");
+	Res = LLVMBuildFPToSI(Builder, V, Rtype->Ref, "");
+      }
+      break;
+    default:
+      llvm_unreachable();
+    }
+    break;
+  case OTKFloat:
+    // x to Float
+    switch (Val.Etype->Kind) {
+    case OTKSigned:
+      Res = LLVMBuildSIToFP(Builder, Val.Ref, Rtype->Ref, "");
+      break;
+    case OTKUnsigned:
+      Res = LLVMBuildUIToFP(Builder, Val.Ref, Rtype->Ref, "");
+      break;
+    default:
+      abort();
+    }
+    break;
+  case OTKAccess:
+  case OTKIncompleteAccess:
+    assert(LLVMGetTypeKind(LLVMTypeOf(Val.Ref)) == LLVMPointerTypeKind);
+    Res = LLVMBuildBitCast(Builder, Val.Ref, Rtype->Ref, "");
+    break;
+  default:
+    abort();
+  }
+  return {Res, Rtype};
+}
+
+extern "C" OEnode
+new_alloca (OTnode Rtype, OEnode Size)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else {
+    if (CurrentDeclareBlock->StackValue != nullptr
+	&& CurrentDeclareBlock->Prev != nullptr) {
+      // Save the stack pointer at the entry of the block.
+      LLVMValueRef FirstInsn =
+	LLVMGetFirstInstruction(CurrentDeclareBlock->StmtBB);
+      LLVMBuilderRef Bld;
+      if (FirstInsn == nullptr) {
+	//  Alloca is the first instruction
+	Bld = Builder;
+      } else {
+	LLVMPositionBuilderBefore(ExtraBuilder, FirstInsn);
+	Bld = ExtraBuilder;
+      }
+      CurrentDeclareBlock->StackValue =
+	LLVMBuildCall(Bld, StackSaveFun, nullptr, 0, "");
+    }
+    Res = LLVMBuildArrayAlloca(Builder, LLVMInt8Type(), Size.Ref, "");
+    //  Convert
+    Res = LLVMBuildBitCast(Builder, Res, Rtype->Ref, "");
+  }
+  return {Res, Rtype};
+}
+
+extern "C" OCnode
+new_subprogram_address (ODnodeSubprg *Subprg, OTnode Atype)
+{
+  return { LLVMConstBitCast(Subprg->Ref, Atype->Ref), Atype };
+}
+
+struct OGnode {
+  LLVMValueRef Ref;
+  OTnode Gtype;
+};
+
+extern "C" OGnode
+new_global (ODnode Decl)
+{
+  return {Decl->Ref, Decl->Dtype };
+}
+
+extern "C" OGnode
+new_global_selected_element (OGnode Rec, OFnodeBase *El)
+{
+  LLVMValueRef Res;
+
+  switch(El->Kind) {
+  case OF_Record:
+    {
+      LLVMValueRef Idx[2];
+      Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+      Idx[1] = LLVMConstInt(LLVMInt32Type(),
+			    static_cast<OFnodeRec *>(El)->Index, 0);
+      Res = LLVMConstGEP(Rec.Ref, Idx, 2);
+    }
+    break;
+  case OF_Union:
+    Res = LLVMConstBitCast(Rec.Ref, static_cast<OFnodeUnion *>(El)->PtrType);
+    break;
+  }
+  return {Res, El->FType};
+}
+
+extern "C" OCnode
+new_global_unchecked_address (OGnode Lvalue, OTnode Atype)
+{
+  return {LLVMConstBitCast(Lvalue.Ref, Atype->Ref), Atype};
+}
+
+extern "C" OCnode
+new_global_address (OGnode Lvalue, OTnode Atype)
+{
+  return new_global_unchecked_address(Lvalue, Atype);
+}
+
+struct OLnode {
+  bool Direct;
+  LLVMValueRef Ref;
+  OTnode Ltype;
+};
+
+extern "C" OLnode
+new_obj (ODnode Obj)
+{
+  switch(Obj->getKind()) {
+  case ODKConst:
+  case ODKVar:
+  case ODKLocal:
+    return { false, Obj->Ref, Obj->Dtype };
+  case ODKInterface:
+    return { true, Obj->Ref, Obj->Dtype };
+  case ODKType:
+  case ODKSubprg:
+    llvm_unreachable();
+  }
+}
+
+extern "C" OEnode
+new_value (OLnode *Lvalue)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else {
+    if (Lvalue->Direct)
+      Res = Lvalue->Ref;
+    else
+      Res = LLVMBuildLoad(Builder, Lvalue->Ref, "");
+  }
+  return {Res, Lvalue->Ltype };
+}
+
+extern "C" OEnode
+new_obj_value (ODnode Obj)
+{
+  OLnode t = new_obj(Obj);
+  return new_value (&t);
+}
+
+extern "C" OLnode
+new_indexed_element (OLnode *Arr, OEnode Index)
+{
+  LLVMValueRef Idx[2];
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else {
+    Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+    Idx[1] = Index.Ref;
+    Res = LLVMBuildGEP(Builder, Arr->Ref, Idx, 2, "");
+  }
+  return { false, Res, static_cast<OTnodeArr *>(Arr->Ltype)->ElType };
+}
+
+extern "C" OLnode
+new_slice (OLnode *Arr, OTnode Rtype, OEnode Index)
+{
+  LLVMValueRef Idx[2];
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else {
+    Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+    Idx[1] = Index.Ref;
+    Res = LLVMBuildGEP(Builder, Arr->Ref, Idx, 2, "");
+    Res = LLVMBuildBitCast(Builder, Res, LLVMPointerType(Rtype->Ref, 0), "");
+  }
+  return { false, Res, Rtype};
+}
+
+extern "C" OLnode
+new_selected_element (OLnode *Rec, OFnodeBase *El)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else {
+    switch(El->Kind) {
+    case OF_Record:
+      {
+	LLVMValueRef Idx[2];
+	Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+	Idx[1] = LLVMConstInt(LLVMInt32Type(),
+			      static_cast<OFnodeRec *>(El)->Index, 0);
+	Res = LLVMBuildGEP(Builder, Rec->Ref, Idx, 2, "");
+      }
+      break;
+    case OF_Union:
+      Res = LLVMBuildBitCast(Builder, Rec->Ref,
+			     static_cast<OFnodeUnion *>(El)->PtrType, "");
+      break;
+    }
+  }
+  return { false, Res, El->FType };
+}
+
+extern "C" OLnode
+new_access_element (OEnode Acc)
+{
+  LLVMValueRef Res;
+
+  switch(Acc.Etype->Kind) {
+  case OTKAccess:
+    Res = Acc.Ref;
+    break;
+  case OTKIncompleteAccess:
+    //  Unwrap the structure
+    {
+      LLVMValueRef Idx[2];
+
+      Idx[0] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+      Idx[1] = LLVMConstInt(LLVMInt32Type(), 0, 0);
+      Res = LLVMBuildGEP(Builder, Acc.Ref, Idx, 2, "");
+    }
+    break;
+  default:
+    llvm_unreachable();
+  }
+  return {false, Res, static_cast<OTnodeAccBase *>(Acc.Etype)->Acc };
+}
+
+extern "C" OEnode
+new_unchecked_address (OLnode *Lvalue, OTnode Atype)
+{
+  LLVMValueRef Res;
+
+  if (Unreach)
+    Res = nullptr;
+  else
+    Res = LLVMBuildBitCast(Builder, Lvalue->Ref, Atype->Ref, "");
+  return {Res, Atype};
+}
+
+extern "C" OEnode
+new_address (OLnode *Lvalue, OTnode Atype)
+{
+  return new_unchecked_address(Lvalue, Atype);
+}
+
+extern "C" void
+new_assign_stmt (OLnode *Target, OEnode Value)
+{
+  assert (!Targ->Direct);
+  if (!Unreach) {
+    LLVMBuildStore(Builder, Value.Ref, Target->Ref);
+  }
+}
+
+extern "C" void
+new_debug_line_decl (unsigned Line)
+{
+  DebugCurrentLine = Line;
+}
+
+extern "C" void
+new_debug_line_stmt (unsigned Line)
+{
+  DebugCurrentLine = Line;
+}