Add LLVM back-end for ortho.

1 files changed, 2768 insertions, 0 deletions

diff --git a/ortho/llvm/ortho_llvm.adb b/ortho/llvm/ortho_llvm.adb
new file mode 100644
index 0000000..b18eae3
--- /dev/null
+++ b/ortho/llvm/ortho_llvm.adb
@@ -0,0 +1,2768 @@
+--  LLVM back-end for ortho.
+--  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 GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ortho_LLVM.Main; use Ortho_LLVM.Main;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with LLVM.Target; use LLVM.Target;
+
+package body Ortho_LLVM is
+
+   --  Target_Data : TargetDataRef;
+   Cur_Func : ValueRef;
+   Cur_Func_Decl : O_Dnode;
+   Unreach : Boolean;
+
+   type Declare_Block_Type;
+   type Declare_Block_Acc is access Declare_Block_Type;
+
+   type Declare_Block_Type is record
+      Stmt_Bb : BasicBlockRef;
+
+      Dbg_Scope : ValueRef;
+      Prev : Declare_Block_Acc;
+   end record;
+
+   Cur_Declare_Block : Declare_Block_Acc;
+   Old_Declare_Block : Declare_Block_Acc;
+
+   --  For debugging
+
+   DW_Version : constant := 16#c_0000#;
+   DW_TAG_Array_Type       : constant := DW_Version + 16#01#;
+   DW_TAG_Enumeration_Type : constant := DW_Version + 16#04#;
+   DW_TAG_Lexical_Block    : constant := DW_Version + 16#0b#;
+   DW_TAG_Member           : constant := DW_Version + 16#0d#;
+   DW_TAG_Pointer_Type     : constant := DW_Version + 16#0f#;
+   DW_TAG_Compile_Unit     : constant := DW_Version + 16#11#;
+   DW_TAG_Structure_Type   : constant := DW_Version + 16#13#;
+   DW_TAG_Subroutine_Type  : constant := DW_Version + 16#15#;
+   DW_TAG_Subrange_Type    : constant := DW_Version + 16#21#;
+   DW_TAG_Base_Type        : constant := DW_Version + 16#24#;
+   DW_TAG_Enumerator       : constant := DW_Version + 16#28#;
+   DW_TAG_File_Type        : constant := DW_Version + 16#29#;
+   DW_TAG_Subprogram       : constant := DW_Version + 16#2e#;
+   DW_TAG_Variable         : constant := DW_Version + 16#34#;
+
+   DW_TAG_Auto_Variable    : constant := DW_Version + 16#100#;
+   DW_TAG_Arg_Variable     : constant := DW_Version + 16#101#;
+
+   DW_ATE_address  : constant := 16#01#;
+   DW_ATE_boolean  : constant := 16#02#;
+   DW_ATE_float    : constant := 16#04#;
+   DW_ATE_signed   : constant := 16#05#;
+   DW_ATE_unsigned : constant := 16#07#;
+   pragma Unreferenced (DW_ATE_address, DW_ATE_boolean);
+
+   --  File + Dir metadata
+   Dbg_Current_Filedir : ValueRef;
+   Dbg_Current_File : ValueRef; -- The DW_TAG_File_Type
+
+   Dbg_Current_Line : unsigned := 0;
+
+   Dbg_Current_Scope : ValueRef;
+   Scope_Uniq_Id : Unsigned_64 := 0;
+
+   --  Metadata for the instruction
+   Dbg_Insn_MD : ValueRef;
+   Dbg_Insn_MD_Line : unsigned := 0;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (ValueRefArray, ValueRefArray_Acc);
+
+   package Dbg_Utils is
+      type Dyn_MDNode is private;
+
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef);
+      function Get_Value (D : Dyn_MDNode) return ValueRef;
+
+      --  Reset D.  FIXME: should be done automatically within Get_Value.
+      procedure Clear (D : out Dyn_MDNode);
+   private
+      Chunk_Length : constant unsigned := 32;
+      type MD_Chunk;
+      type MD_Chunk_Acc is access MD_Chunk;
+
+      type MD_Chunk is record
+         Vals : ValueRefArray (1 .. Chunk_Length);
+         Next : MD_Chunk_Acc;
+      end record;
+
+      type Dyn_MDNode is record
+         First : MD_Chunk_Acc;
+         Last : MD_Chunk_Acc;
+         Nbr : unsigned := 0;
+      end record;
+   end Dbg_Utils;
+
+   package body Dbg_Utils is
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef) is
+         Chunk : MD_Chunk_Acc;
+         Pos : constant unsigned := D.Nbr rem Chunk_Length;
+      begin
+         if Pos = 0 then
+            Chunk := new MD_Chunk;
+            if D.First = null then
+               D.First := Chunk;
+            else
+               D.Last.Next := Chunk;
+            end if;
+            D.Last := Chunk;
+         else
+            Chunk := D.Last;
+         end if;
+         Chunk.Vals (Pos + 1) := Val;
+         D.Nbr := D.Nbr + 1;
+      end Append;
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (MD_Chunk, MD_Chunk_Acc);
+
+      function Get_Value (D : Dyn_MDNode) return ValueRef
+      is
+         Vals : ValueRefArray (1 .. D.Nbr);
+         Pos : unsigned;
+         Chunk : MD_Chunk_Acc := D.First;
+         Next_Chunk : MD_Chunk_Acc;
+         Nbr : constant unsigned := D.Nbr;
+      begin
+         Pos := 0;
+         --  Copy by chunks
+         while Pos + Chunk_Length < Nbr loop
+            Vals (Pos + 1 .. Pos + Chunk_Length) := Chunk.Vals;
+            Pos := Pos + Chunk_Length;
+            Next_Chunk := Chunk.Next;
+            Free (Chunk);
+            Chunk := Next_Chunk;
+         end loop;
+         --  Last chunk
+         if Pos < Nbr then
+            Vals (Pos + 1 .. Pos + Nbr - Pos) := Chunk.Vals (1 .. Nbr - Pos);
+            Free (Chunk);
+         end if;
+         return MDNode (Vals, Vals'Length);
+      end Get_Value;
+
+      procedure Clear (D : out Dyn_MDNode) is
+      begin
+         D := (null, null, 0);
+      end Clear;
+   end Dbg_Utils;
+
+   use Dbg_Utils;
+
+   --  List of debug info for subprograms.
+   Subprg_Nodes: Dyn_MDNode;
+
+   --  List of literals for enumerated type
+   Enum_Nodes : Dyn_MDNode;
+
+   --  List of global variables
+   Global_Nodes : Dyn_MDNode;
+
+   --  Create a MDString from an Ada string.
+   function MDString (Str : String) return ValueRef is
+   begin
+      return MDString (Str'Address, Str'Length);
+   end MDString;
+
+   function MDString (Id : O_Ident) return ValueRef is
+   begin
+      return MDString (Get_Cstring (Id), unsigned (Get_String_Length (Id)));
+   end MDString;
+
+   function Dbg_Size (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt (Int64Type, 8 * ABISizeOfType (Target_Data, Atype), 0);
+   end Dbg_Size;
+
+   function Dbg_Align (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt
+        (Int64Type,
+         Unsigned_64 (8 * ABIAlignmentOfType (Target_Data, Atype)), 0);
+   end Dbg_Align;
+
+   function Dbg_Line return ValueRef is
+   begin
+      return ConstInt (Int32Type, Unsigned_64 (Dbg_Current_Line), 0);
+   end Dbg_Line;
+
+   --  Set debug metadata on instruction INSN.
+   --  FIXME: check if INSN is really an instruction
+   procedure Set_Insn_Dbg (Insn : ValueRef) is
+   begin
+      if Flag_Debug then
+         if Dbg_Current_Line /= Dbg_Insn_MD_Line then
+            declare
+               Vals : ValueRefArray (0 .. 3);
+            begin
+               Vals := (Dbg_Line,
+                        ConstInt (Int32Type, 0, 0), --  col
+                        Dbg_Current_Scope,          --  context
+                        Null_ValueRef);             --  inline
+               Dbg_Insn_MD := MDNode (Vals, Vals'Length);
+               Dbg_Insn_MD_Line := Dbg_Current_Line;
+            end;
+         end if;
+         SetMetadata (Insn, Debug_ID, Dbg_Insn_MD);
+      end if;
+   end Set_Insn_Dbg;
+
+   procedure Dbg_Create_Variable (Tag : Unsigned_32;
+                                  Ident : O_Ident;
+                                  Vtype : O_Tnode;
+                                  Argno : Natural;
+                                  Addr : ValueRef)
+   is
+      Vals : ValueRefArray (0 .. 7);
+      Str : constant ValueRef := MDString (Ident);
+      Call_Vals : ValueRefArray (0 .. 1);
+      Call : ValueRef;
+   begin
+      Vals := (ConstInt (Int32Type, Unsigned_64 (Tag), 0),
+               Dbg_Current_Scope,
+               Str,
+               Dbg_Current_File,
+               ConstInt (Int32Type,
+                         Unsigned_64 (Dbg_Current_Line)
+                           + Unsigned_64 (Argno) * 2 ** 24, 0),
+               Vtype.Dbg,
+               ConstInt (Int32Type, 0, 0), --  flags
+               ConstInt (Int32Type, 0, 0));
+
+      Call_Vals := (MDNode ((0 => Addr), 1),
+                    MDNode (Vals, Vals'Length));
+      Call := BuildCall (Decl_Builder, Llvm_Dbg_Declare,
+                         Call_Vals, Call_Vals'Length, Empty_Cstring);
+      Set_Insn_Dbg (Call);
+   end Dbg_Create_Variable;
+
+   procedure Create_Declare_Block
+   is
+      Res : Declare_Block_Acc;
+   begin
+      if Old_Declare_Block /= null then
+         Res := Old_Declare_Block;
+         Old_Declare_Block := Res.Prev;
+      else
+         Res := new Declare_Block_Type;
+      end if;
+
+      Res.Prev := Cur_Declare_Block;
+      Cur_Declare_Block := Res;
+
+      if not Unreach then
+         Res.Stmt_Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      end if;
+   end Create_Declare_Block;
+
+   procedure Destroy_Declare_Block
+   is
+      Blk : constant Declare_Block_Acc := Cur_Declare_Block;
+   begin
+      Cur_Declare_Block := Blk.Prev;
+      Blk.Prev := Old_Declare_Block;
+      Old_Declare_Block := Blk;
+   end Destroy_Declare_Block;
+
+   -----------------------
+   -- Start_Record_Type --
+   -----------------------
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Record_Type;
+
+   ----------------------
+   -- New_Record_Field --
+   ----------------------
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      O_El : O_Element_Acc;
+   begin
+      El := (Kind => OF_Record,
+             Index => Elements.Nbr_Elements,
+             Ftype => Etype);
+      Elements.Nbr_Elements := Elements.Nbr_Elements + 1;
+      O_El := new O_Element'(Next => null,
+                             Etype => Etype,
+                             Ident => Ident);
+      if Elements.First_Elem = null then
+         Elements.First_Elem := O_El;
+      else
+         Elements.Last_Elem.Next := O_El;
+      end if;
+      Elements.Last_Elem := O_El;
+   end New_Record_Field;
+
+   ------------------------
+   -- Finish_Record_Type --
+   ------------------------
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (O_Element, O_Element_Acc);
+
+      Count : constant unsigned := unsigned (Elements.Nbr_Elements);
+      El : O_Element_Acc;
+      Next_El : O_Element_Acc;
+      Types : TypeRefArray (1 .. Count);
+   begin
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Types (I) := Get_LLVM_Type (El.Etype);
+         El := El.Next;
+      end loop;
+
+      if Elements.Rec_Type /= null then
+         --  Completion
+         StructSetBody (Elements.Rec_Type.LLVM, Types, Count, 0);
+         Res := Elements.Rec_Type;
+      else
+         Res := new O_Tnode_Type'(Kind => ON_Record_Type,
+                                  LLVM => StructType (Types, Count, 0),
+                                  Dbg => Null_ValueRef);
+      end if;
+
+      if Flag_Debug then
+         declare
+            Fields : ValueRefArray (1 .. Count);
+            Vals : ValueRefArray (0 .. 9);
+            Ftype : TypeRef;
+            Fields_Arr : ValueRef;
+         begin
+            El := Elements.First_Elem;
+            for I in Fields'Range loop
+               Ftype := Get_LLVM_Type (El.Etype);
+               Vals :=
+                 (ConstInt (Int32Type, DW_TAG_Member, 0),
+                  Dbg_Current_File,
+                  Null_ValueRef,
+                  MDString (El.Ident),
+                  ConstInt (Int32Type, 0, 0),    -- linenum
+                  Dbg_Size (Ftype),
+                  Dbg_Align (Ftype),
+                  ConstInt
+                    (Int32Type,
+                     8 * OffsetOfElement (Target_Data,
+                                          Res.LLVM, Unsigned_32 (I - 1)), 0),
+                  ConstInt (Int32Type, 0, 0),    --  Flags
+                  El.Etype.Dbg);
+               Fields (I) := MDNode (Vals, Vals'Length);
+               El := El.Next;
+            end loop;
+            Fields_Arr := MDNode (Fields, Fields'Length);
+            if Elements.Rec_Type /= null then
+               --  Completion
+               MDNodeReplaceOperandWith (Res.Dbg, 10, Fields_Arr);
+               MDNodeReplaceOperandWith (Res.Dbg, 5, Dbg_Size (Res.LLVM));
+               MDNodeReplaceOperandWith (Res.Dbg, 6, Dbg_Align (Res.LLVM));
+            else
+               --  Temporary borrowed.
+               Res.Dbg := Fields_Arr;
+            end if;
+         end;
+      end if;
+
+      --  Free elements
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Next_El := El.Next;
+         Free (El);
+         El := Next_El;
+      end loop;
+   end Finish_Record_Type;
+
+   --------------------------------
+   -- New_Uncomplete_Record_Type --
+   --------------------------------
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      --  LLVM type will be created when the type is declared.
+      Res := new O_Tnode_Type'(Kind => ON_Incomplete_Record_Type,
+                               LLVM => Null_TypeRef,
+                               Dbg => Null_ValueRef);
+   end New_Uncomplete_Record_Type;
+
+   ----------------------------------
+   -- Start_Uncomplete_Record_Type --
+   ----------------------------------
+
+   procedure Start_Uncomplete_Record_Type
+     (Res : O_Tnode;
+      Elements : out O_Element_List)
+   is
+   begin
+      if Res.Kind /= ON_Incomplete_Record_Type then
+         raise Program_Error;
+      end if;
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => Res,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Uncomplete_Record_Type;
+
+   ----------------------
+   -- Start_Union_Type --
+   ----------------------
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Union_Type;
+
+   ---------------------
+   -- New_Union_Field --
+   ---------------------
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      pragma Unreferenced (Ident);
+
+      El_Type : constant TypeRef := Get_LLVM_Type (Etype);
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, El_Type));
+      Align : constant Unsigned_32 :=
+        ABIAlignmentOfType (Target_Data, El_Type);
+   begin
+      El := (Kind => OF_Union, Utype => El_Type, Ftype => Etype);
+      if Size > Elements.Size then
+         Elements.Size := Size;
+      end if;
+      if Elements.Align_Type = Null_TypeRef or else Align > Elements.Align then
+         Elements.Align := Align;
+         Elements.Align_Type := El_Type;
+      end if;
+   end New_Union_Field;
+
+   -----------------------
+   -- Finish_Union_Type --
+   -----------------------
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      Count : unsigned;
+      Types : TypeRefArray (1 .. 2);
+      Pad : unsigned;
+   begin
+      if Elements.Align_Type = Null_TypeRef then
+         --  An empty union.  Is it allowed ?
+         Count := 0;
+      else
+         --  The first element is the field with the biggest alignment
+         Types (1) := Elements.Align_Type;
+         --  Possibly complete with an array of bytes.
+         Pad := Elements.Size
+           - unsigned (ABISizeOfType (Target_Data, Elements.Align_Type));
+         if Pad /= 0 then
+            Types (2) := ArrayType (Int8Type, Pad);
+            Count := 2;
+         else
+            Count := 1;
+         end if;
+      end if;
+      Res := new O_Tnode_Type'(Kind => ON_Union_Type,
+                               LLVM => StructType (Types, Count, 0),
+                               Dbg => Null_ValueRef,
+                               Un_Size => Elements.Size,
+                               Un_Main_Field => Elements.Align_Type);
+   end Finish_Union_Type;
+
+   ---------------------
+   -- New_Access_Type --
+   ---------------------
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode is
+   begin
+      if Dtype = O_Tnode_Null then
+         --  LLVM type will be built by New_Type_Decl, so that the name
+         --  can be used for the structure.
+         return new O_Tnode_Type'(Kind => ON_Incomplete_Access_Type,
+                                  LLVM => Null_TypeRef,
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => O_Tnode_Null);
+      else
+         return new O_Tnode_Type'(Kind => ON_Access_Type,
+                                  LLVM => PointerType (Get_LLVM_Type (Dtype)),
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => Dtype);
+      end if;
+   end New_Access_Type;
+
+   ------------------------
+   -- Finish_Access_Type --
+   ------------------------
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
+   is
+      Types : TypeRefArray (1 .. 1);
+   begin
+      if Atype.Kind /= ON_Incomplete_Access_Type then
+         --  Not an incomplete access type.
+         raise Program_Error;
+      end if;
+      if Atype.Acc_Type /= O_Tnode_Null then
+         --  Already completed.
+         raise Program_Error;
+      end if;
+      --  Completion
+      Types (1) := Get_LLVM_Type (Dtype);
+      StructSetBody (GetElementType (Atype.LLVM), Types, Types'Length, 0);
+      Atype.Acc_Type := Dtype;
+
+      --  Debug.
+      --  FIXME.
+   end Finish_Access_Type;
+
+   --------------------
+   -- New_Array_Type --
+   --------------------
+
+   function Dbg_Array (El_Type : O_Tnode; Len : ValueRef; Atype : O_Tnode)
+                      return ValueRef
+   is
+      Rng : ValueRefArray (0 .. 2);
+      Rng_Arr : ValueRefArray (0 .. 0);
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Rng := (ConstInt (Int32Type, DW_TAG_Subrange_Type, 0),
+              ConstInt (Int64Type, 0, 0), -- Lo
+              Len); -- Count
+      Rng_Arr := (0 => MDNode (Rng, Rng'Length));
+      Vals := (ConstInt (Int32Type, DW_TAG_Array_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,           --  context
+               Null_ValueRef,
+               ConstInt (Int32Type, 0, 0), -- line
+               Dbg_Size (Atype.LLVM),
+               Dbg_Align (Atype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               El_Type.Dbg, --  element type
+               MDNode (Rng_Arr, Rng_Arr'Length), -- subscript
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      return MDNode (Vals, Vals'Length);
+   end Dbg_Array;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode
+   is
+      pragma Unreferenced (Index_Type);
+      Res : O_Tnode;
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Type,
+         LLVM => ArrayType (Get_LLVM_Type (El_Type), 0),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (El_Type, ConstInt (Int64Type, Unsigned_64'Last, 1), Res);
+      end if;
+
+      return Res;
+   end New_Array_Type;
+
+   --------------------------------
+   -- New_Constrained_Array_Type --
+   --------------------------------
+
+   function New_Constrained_Array_Type
+     (Atype : O_Tnode; Length : O_Cnode) return O_Tnode
+   is
+      Res : O_Tnode;
+      Len : constant unsigned := unsigned (ConstIntGetZExtValue (Length.LLVM));
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Sub_Type,
+         LLVM => ArrayType (GetElementType (Get_LLVM_Type (Atype)), Len),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => Atype.Arr_El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (Atype.Arr_El_Type,
+            ConstInt (Int64Type, Unsigned_64 (Len), 0), Res);
+      end if;
+
+      return Res;
+   end New_Constrained_Array_Type;
+
+   -----------------------
+   -- New_Unsigned_Type --
+   -----------------------
+
+   function Size_To_Llvm (Size : Natural) return TypeRef is
+      Llvm : TypeRef;
+   begin
+      case Size is
+         when 8 =>
+            Llvm := Int8Type;
+         when 32 =>
+            Llvm := Int32Type;
+         when 64 =>
+            Llvm := Int64Type;
+         when others =>
+            raise Program_Error;
+      end case;
+      return Llvm;
+   end Size_To_Llvm;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Unsigned_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Unsigned_Type;
+
+   ---------------------
+   -- New_Signed_Type --
+   ---------------------
+
+   function New_Signed_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Signed_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Signed_Type;
+
+   --------------------
+   -- New_Float_Type --
+   --------------------
+
+   function New_Float_Type return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Float_Type,
+                               LLVM => DoubleType,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 64);
+   end New_Float_Type;
+
+   procedure Dbg_Add_Enumeration (Id : O_Ident; Val : Unsigned_64) is
+      Vals : ValueRefArray (0 .. 2);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumerator, 0),
+               MDString (Id),
+               ConstInt (Int64Type, Val, 0));
+      --  FIXME: make it local to List ?
+      Append (Enum_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Enumeration;
+
+
+   ----------------------
+   -- New_Boolean_Type --
+   ----------------------
+
+   procedure New_Boolean_Type
+     (Res : out O_Tnode;
+      False_Id : O_Ident; False_E : out O_Cnode;
+      True_Id : O_Ident; True_E : out O_Cnode)
+   is
+   begin
+      Res := new O_Tnode_Type'(Kind => ON_Boolean_Type,
+                               LLVM => Int1Type,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 1);
+      False_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 0, 0),
+                          Ctype => Res);
+      True_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 1, 0),
+                         Ctype => Res);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (False_Id, 0);
+         Dbg_Add_Enumeration (True_Id, 1);
+      end if;
+   end New_Boolean_Type;
+
+   ---------------------
+   -- Start_Enum_Type --
+   ---------------------
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      LLVM : constant TypeRef := Size_To_Llvm (Size);
+   begin
+      List := (LLVM => LLVM,
+               Num => 0,
+               Etype => new O_Tnode_Type'(Kind => ON_Enum_Type,
+                                          LLVM => LLVM,
+                                          Scal_Size => Size,
+                                          Dbg => Null_ValueRef));
+
+   end Start_Enum_Type;
+
+   ----------------------
+   -- New_Enum_Literal --
+   ----------------------
+
+   procedure New_Enum_Literal
+     (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode'(LLVM => ConstInt (List.LLVM, Unsigned_64 (List.Num), 0),
+                      Ctype => List.Etype);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (Ident, Unsigned_64 (List.Num));
+      end if;
+
+      List.Num := List.Num + 1;
+   end New_Enum_Literal;
+
+   ----------------------
+   -- Finish_Enum_Type --
+   ----------------------
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Etype;
+   end Finish_Enum_Type;
+
+   ------------------------
+   -- New_Signed_Literal --
+   ------------------------
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode
+   is
+      function To_Unsigned_64 is new Ada.Unchecked_Conversion
+        (Integer_64, Unsigned_64);
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype),
+                                        To_Unsigned_64 (Value), 1),
+                     Ctype => Ltype);
+   end New_Signed_Literal;
+
+   --------------------------
+   -- New_Unsigned_Literal --
+   --------------------------
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype), Value, 0),
+                      Ctype => Ltype);
+   end New_Unsigned_Literal;
+
+   -----------------------
+   -- New_Float_Literal --
+   -----------------------
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstReal (Get_LLVM_Type (Ltype),
+                                         Interfaces.C.double (Value)),
+                      Ctype => Ltype);
+   end New_Float_Literal;
+
+   ---------------------
+   -- New_Null_Access --
+   ---------------------
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstNull (Get_LLVM_Type (Ltype)),
+                      Ctype => Ltype);
+   end New_Null_Access;
+
+   -----------------------
+   -- Start_Record_Aggr --
+   -----------------------
+
+   procedure Start_Record_Aggr
+     (List : out O_Record_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List :=
+        (Len => 0,
+         Vals => new ValueRefArray (1 .. CountStructElementTypes (Llvm)),
+         Atype => Atype);
+   end Start_Record_Aggr;
+
+   ------------------------
+   -- New_Record_Aggr_El --
+   ------------------------
+
+   procedure New_Record_Aggr_El
+     (List : in out O_Record_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Record_Aggr_El;
+
+   ------------------------
+   -- Finish_Record_Aggr --
+   ------------------------
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List;
+      Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstStruct (List.Vals.all, List.Len, 0),
+              Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Record_Aggr;
+
+   ----------------------
+   -- Start_Array_Aggr --
+   ----------------------
+
+   procedure Start_Array_Aggr
+     (List : out O_Array_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List := (Len => 0,
+               Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)),
+               El_Type => GetElementType (Llvm),
+               Atype => Atype);
+   end Start_Array_Aggr;
+
+   -----------------------
+   -- New_Array_Aggr_El --
+   -----------------------
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Array_Aggr_El;
+
+   -----------------------
+   -- Finish_Array_Aggr --
+   -----------------------
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstArray (List.El_Type,
+                                  List.Vals.all, List.Len),
+             Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Array_Aggr;
+
+   --------------------
+   -- New_Union_Aggr --
+   --------------------
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      Values : ValueRefArray (1 .. 2);
+      Count : unsigned;
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, Field.Utype));
+
+   begin
+      Values (1) := Value.LLVM;
+      if Size < Atype.Un_Size then
+         Values (2) := GetUndef (ArrayType (Int8Type, Atype.Un_Size - Size));
+         Count := 2;
+      else
+         Count := 1;
+      end if;
+
+      --  If `FIELD` is the main field of the union, create a struct using
+      --  the same type as the union (and possibly pad).
+      if Field.Utype = Atype.Un_Main_Field then
+         return O_Cnode'
+           (LLVM => ConstNamedStruct (Atype.LLVM, Values, Count),
+            Ctype => Atype);
+      else
+         --  Create an on-the-fly record.
+         return O_Cnode'(LLVM => ConstStruct (Values, Count, 0),
+                         Ctype => Atype);
+      end if;
+   end New_Union_Aggr;
+
+   ----------------
+   -- New_Sizeof --
+   ----------------
+
+   --  Return VAL with type RTYPE (either unsigned or access)
+   function Const_To_Cnode (Rtype : O_Tnode; Val : Unsigned_64) return O_Cnode
+   is
+      Tmp : ValueRef;
+   begin
+      case Rtype.Kind is
+         when ON_Scalar_Types =>
+            --  Well, unsigned in fact.
+            return O_Cnode'(LLVM => ConstInt (Rtype.LLVM, Val, 0),
+                            Ctype => Rtype);
+         when ON_Access_Type =>
+            Tmp := ConstInt (Int64Type, Val, 0);
+            return O_Cnode'(LLVM => ConstIntToPtr (Tmp, Rtype.LLVM),
+                            Ctype => Rtype);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Const_To_Cnode;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype, ABISizeOfType (Target_Data, Get_LLVM_Type (Atype)));
+   end New_Sizeof;
+
+   -----------------
+   -- New_Alignof --
+   -----------------
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         Unsigned_64
+           (ABIAlignmentOfType (Target_Data, Get_LLVM_Type (Atype))));
+   end New_Alignof;
+
+   ------------------
+   -- New_Offsetof --
+   ------------------
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         OffsetOfElement (Target_Data,
+                          Get_LLVM_Type (Atype),
+                          Unsigned_32 (Field.Index)));
+   end New_Offsetof;
+
+   ----------------------------
+   -- New_Subprogram_Address --
+   ----------------------------
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode is
+   begin
+      return O_Cnode'
+        (LLVM => ConstBitCast (Subprg.LLVM, Get_LLVM_Type (Atype)),
+         Ctype => Atype);
+   end New_Subprogram_Address;
+
+   ------------------------
+   -- New_Global_Address --
+   ------------------------
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Address;
+
+   ----------------------------------
+   -- New_Global_Unchecked_Address --
+   ----------------------------------
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Unchecked_Address;
+
+   -------------
+   -- New_Lit --
+   -------------
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode'(LLVM => Lit.LLVM,
+                      Etype => Lit.Ctype);
+   end New_Lit;
+
+   -------------------
+   -- New_Dyadic_Op --
+   -------------------
+
+   function New_Smod (L, R : ValueRef; Res_Type : TypeRef)
+                     return ValueRef
+   is
+      Cond : ValueRef;
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+
+      --  The result of 'L rem R'.
+      Rm : ValueRef;
+
+      --  Rm + R
+      Rm_Plus_R : ValueRef;
+
+      --  The result of 'L xor R'.
+      R_Xor : ValueRef;
+
+      Adj : ValueRef;
+      Phi : ValueRef;
+
+      --  Basic basic for the non-overflow branch
+      Normal_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Adjust_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      --  Basic block after the result
+      Next_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Vals : ValueRefArray (1 .. 3);
+      BBs  : BasicBlockRefArray (1 .. 3);
+   begin
+      --  Avoid overflow with -1:
+      --   if R = -1 then
+      --     result := 0;
+      --   else
+      --     ...
+      Cond := BuildICmp
+        (Builder, IntEQ, R, ConstAllOnes (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Normal_Bb);
+      Vals (1) := ConstNull (Res_Type);
+      BBs (1) := GetInsertBlock (Builder);
+
+      --  Rm := Left rem Right
+      PositionBuilderAtEnd (Builder, Normal_Bb);
+      Rm := BuildSRem (Builder, L, R, Empty_Cstring);
+
+      --  if R = 0 then
+      --    result := 0
+      --  else
+      Cond := BuildICmp
+        (Builder, IntEQ, Rm, ConstNull (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Adjust_Bb);
+      Vals (2) := ConstNull (Res_Type);
+      BBs (2) := Normal_Bb;
+
+      --  if L xor R < 0 then
+      --    result := Rm + R
+      --  else
+      --    result := Rm;
+      --  end if;
+      PositionBuilderAtEnd (Builder, Adjust_Bb);
+      R_Xor := BuildXor (Builder, L, R, Empty_Cstring);
+      Cond := BuildICmp
+        (Builder, IntSLT, R_Xor, ConstNull (Res_Type), Empty_Cstring);
+      Rm_Plus_R := BuildAdd (Builder, Rm, R, Empty_Cstring);
+      Adj := BuildSelect (Builder, Cond, Rm_Plus_R, Rm, Empty_Cstring);
+      Br := BuildBr (Builder, Next_Bb);
+      Vals (3) := Adj;
+      BBs (3) := Adjust_Bb;
+
+      --  The Phi node
+      PositionBuilderAtEnd (Builder, Next_Bb);
+      Phi := BuildPhi (Builder, Res_Type, Empty_Cstring);
+      AddIncoming (Phi, Vals, BBs, Vals'Length);
+
+      return Phi;
+   end New_Smod;
+
+   type Dyadic_Builder_Acc is access
+     function (Builder : BuilderRef;
+               LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+              return ValueRef;
+   pragma Convention (C, Dyadic_Builder_Acc);
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode
+   is
+      Build : Dyadic_Builder_Acc := null;
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Unreach then
+         return O_Enode'(LLVM => Null_ValueRef, Etype => Left.Etype);
+      end if;
+
+      case Left.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_And =>
+                  Build := BuildAnd'Access;
+               when ON_Or =>
+                  Build := BuildOr'Access;
+               when ON_Xor =>
+                  Build := BuildXor'Access;
+
+               when ON_Add_Ov =>
+                  Build := BuildAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildMul'Access;
+
+               when ON_Div_Ov =>
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildUDiv'Access;
+                     when ON_Signed_Type =>
+                        Build := BuildSDiv'Access;
+                     when others =>
+                        null;
+                  end case;
+
+               when ON_Mod_Ov
+                 | ON_Rem_Ov => -- FIXME...
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildURem'Access;
+                     when ON_Signed_Type =>
+                        if Kind = ON_Rem_Ov then
+                           Build := BuildSRem'Access;
+                        else
+                           Res := New_Smod
+                             (Left.LLVM, Right.LLVM, Left.Etype.LLVM);
+                        end if;
+                     when others =>
+                        null;
+                  end case;
+
+               when others =>
+                  null;
+            end case;
+
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Add_Ov =>
+                  Build := BuildFAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildFSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildFMul'Access;
+               when ON_Div_Ov =>
+                  Build := BuildFDiv'Access;
+
+               when others =>
+                  null;
+            end case;
+
+         when others =>
+            null;
+      end case;
+
+      if Build /= null then
+         pragma Assert (Res = Null_ValueRef);
+         Res := Build.all (Builder,  Left.LLVM, Right.LLVM, Empty_Cstring);
+      end if;
+
+      if Res = Null_ValueRef then
+         raise Program_Error with "Unimplemented New_Dyadic_Op "
+           & ON_Dyadic_Op_Kind'Image (Kind)
+           & " for type "
+           & ON_Type_Kind'Image (Left.Etype.Kind);
+      end if;
+
+      Set_Insn_Dbg (Res);
+
+      return O_Enode'(LLVM => Res, Etype => Left.Etype);
+   end New_Dyadic_Op;
+
+   --------------------
+   -- New_Monadic_Op --
+   --------------------
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Operand.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_Not =>
+                  Res := BuildNot (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Neg_Ov =>
+                  Res := BuildNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  --  FIXME: float ?
+                  Res := BuildSelect
+                    (Builder,
+                     BuildICmp (Builder, IntSLT,
+                                Operand.LLVM,
+                                ConstInt (Get_LLVM_Type (Operand.Etype), 0, 0),
+                                Empty_Cstring),
+                     BuildNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Not =>
+                  raise Program_Error;
+               when ON_Neg_Ov =>
+                  Res := BuildFNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  Res := BuildSelect
+                    (Builder,
+                     BuildFCmp (Builder, RealOLT,
+                                Operand.LLVM,
+                                ConstReal (Get_LLVM_Type (Operand.Etype), 0.0),
+                                Empty_Cstring),
+                     BuildFNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      if IsAInstruction (Res) /= Null_ValueRef then
+         Set_Insn_Dbg (Res);
+      end if;
+
+      return O_Enode'(LLVM => Res, Etype => Operand.Etype);
+   end New_Monadic_Op;
+
+   --------------------
+   -- New_Compare_Op --
+   --------------------
+
+   type Compare_Op_Entry is record
+      Signed_Pred   : IntPredicate;
+      Unsigned_Pred : IntPredicate;
+      Real_Pred     : RealPredicate;
+   end record;
+
+   type Compare_Op_Table_Type is array (ON_Compare_Op_Kind) of
+     Compare_Op_Entry;
+
+   Compare_Op_Table : constant Compare_Op_Table_Type :=
+     (ON_Eq  => (IntEQ,  IntEQ,  RealOEQ),
+      ON_Neq => (IntNE,  IntNE,  RealONE),
+      ON_Le  => (IntSLE, IntULE, RealOLE),
+      ON_Lt  => (IntSLT, IntULT, RealOLT),
+      ON_Ge  => (IntSGE, IntUGE, RealOGE),
+      ON_Gt  => (IntSGT, IntUGT, RealOGT));
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind;
+      Left, Right : O_Enode;
+      Ntype : O_Tnode)
+      return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Left.Etype.Kind is
+         when ON_Unsigned_Type
+           | ON_Boolean_Type
+           | ON_Enum_Type
+           | ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Unsigned_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Signed_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Signed_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Float_Type =>
+            Res := BuildFCmp (Builder, Compare_Op_Table (Kind).Real_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type
+           | ON_Incomplete_Record_Type
+           | ON_Union_Type
+           | ON_No_Type =>
+            raise Program_Error;
+      end case;
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Ntype);
+   end New_Compare_Op;
+
+   -------------------------
+   -- New_Indexed_Element --
+   -------------------------
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+   begin
+      return O_Lnode'
+        (Direct => False,
+         LLVM => BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring),
+         Ltype => Arr.Ltype.Arr_El_Type);
+   end New_Indexed_Element;
+
+   ---------------
+   -- New_Slice --
+   ---------------
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+      return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+      Tmp : ValueRef;
+   begin
+      Tmp := BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring);
+      Tmp := BuildBitCast
+        (Builder, Tmp, PointerType (Get_LLVM_Type (Res_Type)), Empty_Cstring);
+      return O_Lnode'(Direct => False, LLVM => Tmp, Ltype => Res_Type);
+   end New_Slice;
+
+   --------------------------
+   -- New_Selected_Element --
+   --------------------------
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         declare
+            Idx : constant ValueRefArray (1 .. 2) :=
+              (ConstInt (Int32Type, 0, 0),
+               ConstInt (Int32Type, Unsigned_64 (El.Index), 0));
+         begin
+            Res := BuildGEP (Builder, Rec.LLVM, Idx, 2, Empty_Cstring);
+         end;
+      end if;
+      return O_Lnode'(Direct => False, LLVM => Res, Ltype => El.Ftype);
+   end New_Selected_Element;
+
+   ------------------------
+   -- New_Access_Element --
+   ------------------------
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      case Acc.Etype.Kind is
+         when ON_Access_Type =>
+            Res := Acc.LLVM;
+         when ON_Incomplete_Access_Type =>
+            --  Unwrap the structure
+            declare
+               Idx : constant ValueRefArray (1 .. 2) :=
+                 (ConstInt (Int32Type, 0, 0), ConstInt (Int32Type, 0, 0));
+            begin
+               Res := BuildGEP (Builder, Acc.LLVM, Idx, 2, Empty_Cstring);
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+      return O_Lnode'(Direct => False,
+                      LLVM => Res,
+                      Ltype => Acc.Etype.Acc_Type);
+   end New_Access_Element;
+
+   --------------------
+   -- New_Convert_Ov --
+   --------------------
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Rtype = Val.Etype then
+         --  Convertion to itself: nothing to do.
+         return Val;
+      end if;
+      if Rtype.LLVM = Val.Etype.LLVM then
+         --  Same underlying LLVM type: nothing to do.
+         return Val;
+      end if;
+
+      case Rtype.Kind is
+         when ON_Integer_Types =>
+            case Val.Etype.Kind is
+               when ON_Integer_Types =>
+                  --  Int to Int
+                  if Val.Etype.Scal_Size > Rtype.Scal_Size then
+                     --  Truncate
+                     Res := BuildTrunc
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  elsif Val.Etype.Scal_Size < Rtype.Scal_Size then
+                     if Val.Etype.Kind = ON_Signed_Type then
+                        Res := BuildSExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     else
+                        --  Unsigned, enum
+                        Res := BuildZExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     end if;
+                  else
+                     Res := BuildBitCast
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when ON_Float_Type =>
+                  --  Float to Int
+                  if Rtype.Kind = ON_Signed_Type then
+                     Res := BuildFPToSI
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+
+         when ON_Float_Type =>
+            if Val.Etype.Kind = ON_Signed_Type then
+               Res := BuildSIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            elsif Val.Etype.Kind = ON_Unsigned_Type then
+               Res := BuildUIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            end if;
+
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            if GetTypeKind (TypeOf (Val.LLVM)) /= PointerTypeKind then
+               raise Program_Error;
+            end if;
+            Res := BuildBitCast (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                                 Empty_Cstring);
+
+         when others =>
+            null;
+      end case;
+      if Res /= Null_ValueRef then
+         --  FIXME: only if insn was generated
+         --  Set_Insn_Dbg (Res);
+         return O_Enode'(LLVM => Res, Etype => Rtype);
+      else
+         raise Program_Error with "New_Convert_Ov: not implemented for "
+           & ON_Type_Kind'Image (Val.Etype.Kind)
+           & " -> "
+           & ON_Type_Kind'Image (Rtype.Kind);
+      end if;
+   end New_Convert_Ov;
+
+   -----------------
+   -- New_Address --
+   -----------------
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Address;
+
+   ---------------------------
+   -- New_Unchecked_Address --
+   ---------------------------
+
+   function New_Unchecked_Address  (Lvalue : O_Lnode; Atype : O_Tnode)
+                                   return O_Enode
+   is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Unchecked_Address;
+
+   ---------------
+   -- New_Value --
+   ---------------
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         Res := Lvalue.LLVM;
+         if not Lvalue.Direct then
+            Res := BuildLoad (Builder, Res, Empty_Cstring);
+            Set_Insn_Dbg (Res);
+         end if;
+      end if;
+      return O_Enode'(LLVM => Res, Etype => Lvalue.Ltype);
+   end New_Value;
+
+   -------------------
+   -- New_Obj_Value --
+   -------------------
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   -------------
+   -- New_Obj --
+   -------------
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      case Obj.Kind is
+         when ON_Const_Decl
+           | ON_Var_Decl
+           | ON_Local_Decl =>
+            return O_Lnode'(Direct => False,
+                            LLVM => Obj.LLVM,
+                            Ltype => Obj.Dtype);
+
+         when ON_Interface_Decl =>
+            if Flag_Debug then
+               --  The argument was allocated.
+               return O_Lnode'(Direct => False,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            else
+               return O_Lnode'(Direct => True,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            end if;
+
+         when ON_Type_Decl
+           | ON_Completed_Type_Decl
+           | ON_Subprg_Decl
+           | ON_No_Decl =>
+            raise Program_Error;
+      end case;
+   end New_Obj;
+
+   ----------------
+   -- New_Alloca --
+   ----------------
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      Res := BuildArrayAlloca (Builder, Int8Type, Size.LLVM, Empty_Cstring);
+      Set_Insn_Dbg (Res);
+      Res := BuildBitCast (Builder, Res, Get_LLVM_Type (Rtype), Empty_Cstring);
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Rtype);
+   end New_Alloca;
+
+   -------------------
+   -- New_Type_Decl --
+   -------------------
+
+   function Add_Dbg_Basic_Type (Id : O_Ident; Btype : O_Tnode; Enc : Natural)
+                               return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Base_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               MDString (Id),
+               ConstInt (Int32Type, 0, 0),    -- linenum
+               Dbg_Size (Btype.LLVM),
+               Dbg_Align (Btype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               ConstInt (Int32Type, Unsigned_64 (Enc), 0)); --  Encoding
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Basic_Type;
+
+   function Add_Dbg_Enum_Type (Id : O_Ident; Etype : O_Tnode) return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumeration_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Etype.LLVM),
+               Dbg_Align (Etype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               Null_ValueRef,
+               Get_Value (Enum_Nodes),
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      Clear (Enum_Nodes);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Enum_Type;
+
+   function Add_Dbg_Pointer_Type (Id : O_Ident; Ptype : O_Tnode)
+                                 return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      pragma Assert (Ptype.Acc_Type.Dbg /= Null_ValueRef);
+
+      Vals := (ConstInt (Int32Type, DW_TAG_Pointer_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Ptype.LLVM),
+               Dbg_Align (Ptype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Ptype.Acc_Type.Dbg);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Pointer_Type;
+
+   function Add_Dbg_Record_Type (Id : O_Ident; Rtype : O_Tnode)
+                                return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Structure_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Null_ValueRef,  --  5: Size
+               Null_ValueRef,  --  6: Align
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Null_ValueRef,
+               Null_ValueRef, -- 10
+               ConstInt (Int32Type, 0, 0),    --  Runtime lang
+               Null_ValueRef, -- Vtable Holder
+               Null_ValueRef, -- ?
+               Null_ValueRef); -- Uniq Id
+      if Rtype /= O_Tnode_Null then
+         Vals (5) := Dbg_Size (Rtype.LLVM);
+         Vals (6) := Dbg_Align (Rtype.LLVM);
+         Vals (10) := Rtype.Dbg;
+      end if;
+
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Record_Type;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type =>
+            Atype.LLVM :=
+              StructCreateNamed (GetGlobalContext, Get_Cstring (Ident));
+         when ON_Incomplete_Access_Type =>
+            Atype.LLVM := PointerType
+              (StructCreateNamed (GetGlobalContext, Get_Cstring (Ident)));
+         when others =>
+            null;
+      end case;
+
+      --  Emit debug info
+      if Flag_Debug then
+         case Atype.Kind is
+            when ON_Unsigned_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_unsigned);
+            when ON_Signed_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_signed);
+            when ON_Float_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_float);
+            when ON_Enum_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Boolean_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Access_Type =>
+               Atype.Dbg := Add_Dbg_Pointer_Type (Ident, Atype);
+            when ON_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, Atype);
+            when ON_Incomplete_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, O_Tnode_Null);
+            when ON_Array_Type
+              | ON_Array_Sub_Type =>
+               --  FIXME: typedef
+               null;
+            when ON_Incomplete_Access_Type =>
+               --  FIXME: todo
+               null;
+            when ON_Union_Type =>
+               --  FIXME: todo
+               null;
+            when ON_No_Type =>
+               raise Program_Error;
+         end case;
+      end if;
+   end New_Type_Decl;
+
+   -----------------------------
+   -- New_Debug_Filename_Decl --
+   -----------------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+      Vals : ValueRefArray (1 .. 2);
+   begin
+      if Flag_Debug then
+         Vals := (MDString (Filename),
+                  MDString (Current_Directory));
+         Dbg_Current_Filedir := MDNode (Vals, 2);
+
+         Vals := (ConstInt (Int32Type, DW_TAG_File_Type, 0),
+                  Dbg_Current_Filedir);
+         Dbg_Current_File := MDNode (Vals, 2);
+      end if;
+   end New_Debug_Filename_Decl;
+
+   -------------------------
+   -- New_Debug_Line_Decl --
+   -------------------------
+
+   procedure New_Debug_Line_Decl (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Decl;
+
+   ----------------------------
+   -- New_Debug_Comment_Decl --
+   ----------------------------
+
+   procedure New_Debug_Comment_Decl (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   --------------------
+   -- New_Const_Decl --
+   --------------------
+
+   procedure Dbg_Add_Global_Var (Id : O_Ident;
+                                 Atype : O_Tnode;
+                                 Storage : O_Storage;
+                                 Decl : O_Dnode)
+   is
+      pragma Assert (Atype.Dbg /= Null_ValueRef);
+      Vals : ValueRefArray (0 .. 12);
+      Name : constant ValueRef := MDString (Id);
+      Is_Local : constant Boolean := Storage = O_Storage_Private;
+      Is_Def : constant Boolean := Storage /= O_Storage_External;
+   begin
+      Vals :=
+        (ConstInt (Int32Type, DW_TAG_Variable, 0),
+         Null_ValueRef,
+         Null_ValueRef, -- context
+         Name,
+         Name,
+         Null_ValueRef, -- linkageName
+         Dbg_Current_File,
+         Dbg_Line,
+         Atype.Dbg,
+         ConstInt (Int1Type, Boolean'Pos (Is_Local), 0), -- isLocal
+         ConstInt (Int1Type, Boolean'Pos (Is_Def), 0), -- isDef
+         Decl.LLVM,
+         Null_ValueRef);
+      Append (Global_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Global_Var;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_External then
+         Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddGlobal
+           (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+      end if;
+
+      Res := (Kind => ON_Const_Decl, LLVM => Decl, Dtype => Atype);
+      SetGlobalConstant (Res.LLVM, 1);
+      if Storage = O_Storage_Private then
+         SetLinkage (Res.LLVM, InternalLinkage);
+      end if;
+      if Flag_Debug then
+         Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+      end if;
+   end New_Const_Decl;
+
+   -----------------------
+   -- Start_Const_Value --
+   -----------------------
+
+   procedure Start_Const_Value (Const : in out O_Dnode) is
+   begin
+      null;
+   end Start_Const_Value;
+
+   ------------------------
+   -- Finish_Const_Value --
+   ------------------------
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) is
+   begin
+      SetInitializer (Const.LLVM, Val.LLVM);
+   end Finish_Const_Value;
+
+   ------------------
+   -- New_Var_Decl --
+   ------------------
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_Local then
+         Res := (Kind => ON_Local_Decl,
+                 LLVM => BuildAlloca
+                   (Decl_Builder, Get_LLVM_Type (Atype), Get_Cstring (Ident)),
+                 Dtype => Atype);
+         if Flag_Debug then
+            Dbg_Create_Variable (DW_TAG_Auto_Variable,
+                                 Ident, Atype, 0, Res.LLVM);
+         end if;
+      else
+         if Storage = O_Storage_External then
+            Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+         else
+            Decl := Null_ValueRef;
+         end if;
+         if Decl = Null_ValueRef then
+            Decl := AddGlobal
+              (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+         end if;
+
+         Res := (Kind => ON_Var_Decl, LLVM => Decl, Dtype => Atype);
+
+         --  Set linkage.
+         case Storage is
+            when O_Storage_Private =>
+               SetLinkage (Res.LLVM, InternalLinkage);
+            when O_Storage_Public
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         --  Set initializer.
+         case Storage is
+            when O_Storage_Private
+              | O_Storage_Public =>
+               SetInitializer (Res.LLVM, ConstNull (Get_LLVM_Type (Atype)));
+            when O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         if Flag_Debug then
+            Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+         end if;
+      end if;
+   end New_Var_Decl;
+
+   -------------------------
+   -- Start_Function_Decl --
+   -------------------------
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => Rtype,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Function_Decl;
+
+   --------------------------
+   -- Start_Procedure_Decl --
+   --------------------------
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => O_Tnode_Null,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Procedure_Decl;
+
+   ------------------------
+   -- New_Interface_Decl --
+   ------------------------
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      Inter : constant O_Inter_Acc := new O_Inter'(Itype => Atype,
+                                                   Ival => Null_ValueRef,
+                                                   Ident => Ident,
+                                                   Next => null);
+   begin
+      Res := (Kind => ON_Interface_Decl,
+              Dtype => Atype,
+              LLVM => Null_ValueRef,
+              Inter => Inter);
+      Interfaces.Nbr_Inter := Interfaces.Nbr_Inter + 1;
+      if Interfaces.First_Inter = null then
+         Interfaces.First_Inter := Inter;
+      else
+         Interfaces.Last_Inter.Next := Inter;
+      end if;
+      Interfaces.Last_Inter := Inter;
+   end New_Interface_Decl;
+
+   ----------------------------
+   -- Finish_Subprogram_Decl --
+   ----------------------------
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode)
+   is
+      Count : constant unsigned := unsigned (Interfaces.Nbr_Inter);
+      Inter : O_Inter_Acc;
+      Types : TypeRefArray (1 .. Count);
+      Ftype : TypeRef;
+      Rtype : TypeRef;
+      Decl : ValueRef;
+      Id : constant Cstring := Get_Cstring (Interfaces.Ident);
+   begin
+      --  Fill Types (from interfaces list)
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Types (I) := Inter.Itype.LLVM;
+         Inter := Inter.Next;
+      end loop;
+
+      --  Build function type.
+      if Interfaces.Res_Type = O_Tnode_Null then
+         Rtype := VoidType;
+      else
+         Rtype := Interfaces.Res_Type.LLVM;
+      end if;
+      Ftype := FunctionType (Rtype, Types, Count, 0);
+
+      if Interfaces.Storage = O_Storage_External then
+         Decl := GetNamedFunction (Module, Id);
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddFunction (Module, Id, Ftype);
+      end if;
+
+      Res := (Kind => ON_Subprg_Decl,
+              Dtype => Interfaces.Res_Type,
+              Subprg_Id => Interfaces.Ident,
+              Nbr_Args => Count,
+              Subprg_Inters => Interfaces.First_Inter,
+              LLVM => Decl);
+      SetFunctionCallConv (Res.LLVM, CCallConv);
+
+      --  Translate interfaces.
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Inter.Ival := GetParam (Res.LLVM, I - 1);
+         SetValueName (Inter.Ival, Get_Cstring (Inter.Ident));
+         Inter := Inter.Next;
+      end loop;
+   end Finish_Subprogram_Decl;
+
+   ---------------------------
+   -- Start_Subprogram_Body --
+   ---------------------------
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      --  Basic block at function entry that contains all the declarations.
+      Decl_BB : BasicBlockRef;
+   begin
+      if Cur_Func /= Null_ValueRef then
+         --  No support for nested subprograms.
+         raise Program_Error;
+      end if;
+
+      Cur_Func := Func.LLVM;
+      Cur_Func_Decl := Func;
+      Unreach := False;
+
+      Decl_BB := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Decl_Builder, Decl_BB);
+
+      Create_Declare_Block;
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Type_Vals : ValueRefArray (0 .. Func.Nbr_Args);
+            Vals : ValueRefArray (0 .. 14);
+            Arg : O_Inter_Acc;
+            Subprg_Type : ValueRef;
+
+            Subprg_Vals : ValueRefArray (0 .. 19);
+            Name : ValueRef;
+         begin
+            Arg := Func.Subprg_Inters;
+            if Func.Dtype /= O_Tnode_Null then
+               Type_Vals (0) := Func.Dtype.Dbg;
+            else
+               --  Void
+               Type_Vals (0) := Null_ValueRef;
+            end if;
+            for I in 1 .. Type_Vals'Last loop
+               Type_Vals (I) := Arg.Itype.Dbg;
+               Arg := Arg.Next;
+            end loop;
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subroutine_Type, 0),
+               ConstInt (Int32Type, 0, 0),  --  1 ??
+               Null_ValueRef,               --  2 Context
+               MDString (Empty_Cstring, 0), --  3 name
+               ConstInt (Int32Type, 0, 0),  --  4 linenum
+               ConstInt (Int64Type, 0, 0),  --  5 size
+               ConstInt (Int64Type, 0, 0),  --  6 align
+               ConstInt (Int64Type, 0, 0),  --  7 offset
+               ConstInt (Int32Type, 0, 0),  --  8 flags
+               Null_ValueRef,               --  9 derived from
+               MDNode (Type_Vals, Type_Vals'Length), --  10 type
+               ConstInt (Int32Type, 0, 0),  --  11 runtime lang
+               Null_ValueRef,               --  12 containing type
+               Null_ValueRef,               --  13 template params
+               Null_ValueRef);              --  14 ??
+            Subprg_Type := MDNode (Vals, Vals'Length);
+
+            --  Create TAG_subprogram.
+            Name := MDString (Func.Subprg_Id);
+
+            Subprg_Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subprogram, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_File,                --  2 context
+               Name,                            --  3 name
+               Name,                            --  4 display name
+               Null_ValueRef,                   --  5 linkage name
+               Dbg_Line,                        --  6 line num
+               Subprg_Type,                     --  7 type
+               ConstInt (Int1Type, 0, 0),       --  8 islocal (FIXME)
+               ConstInt (Int1Type, 1, 0),       --  9 isdef (FIXME)
+               ConstInt (Int32Type, 0, 0),      --  10 virtuality
+               ConstInt (Int32Type, 0, 0),      --  11 virtual index
+               Null_ValueRef,                   --  12 containing type
+               ConstInt (Int32Type, 256, 0),    --  13 flags: prototyped
+               ConstInt (Int1Type, 0, 0),       --  14 isOpt (FIXME)
+               Cur_Func,                        --  15 function
+               Null_ValueRef,                   --  16 template param
+               Null_ValueRef,                   --  17 function decl
+               Null_ValueRef,                   --  18 variables ???
+               Dbg_Line);                       --  19 scope ln
+            Cur_Declare_Block.Dbg_Scope :=
+              MDNode (Subprg_Vals, Subprg_Vals'Length);
+            Append (Subprg_Nodes, Cur_Declare_Block.Dbg_Scope);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+         end;
+
+         --  Create local variables for arguments.
+         declare
+            Arg : O_Inter_Acc;
+            Tmp : ValueRef;
+            St : ValueRef;
+            pragma Unreferenced (St);
+            Argno : Natural;
+         begin
+            Arg := Func.Subprg_Inters;
+            Argno := 1;
+            while Arg /= null loop
+               Tmp := BuildAlloca (Decl_Builder, Get_LLVM_Type (Arg.Itype),
+                                   Empty_Cstring);
+               Dbg_Create_Variable (DW_TAG_Arg_Variable,
+                                    Arg.Ident, Arg.Itype, Argno, Tmp);
+               St := BuildStore (Decl_Builder, Arg.Ival, Tmp);
+               Arg.Ival := Tmp;
+
+               Arg := Arg.Next;
+               Argno := Argno + 1;
+            end loop;
+         end;
+      end if;
+   end Start_Subprogram_Body;
+
+   ----------------------------
+   -- Finish_Subprogram_Body --
+   ----------------------------
+
+   procedure Finish_Subprogram_Body is
+      Ret : ValueRef;
+      pragma Unreferenced (Ret);
+   begin
+      --  Add a jump from the declare basic block to the first statement BB.
+      Ret := BuildBr (Decl_Builder, Cur_Declare_Block.Stmt_Bb);
+
+      --  Terminate the statement BB.
+      if not Unreach then
+         if Cur_Func_Decl.Dtype = O_Tnode_Null then
+            Ret := BuildRetVoid (Builder);
+         else
+            Ret := BuildUnreachable (Builder);
+         end if;
+      end if;
+
+      Destroy_Declare_Block;
+
+      Cur_Func := Null_ValueRef;
+      Dbg_Current_Scope := Null_ValueRef;
+   end Finish_Subprogram_Body;
+
+   -------------------------
+   -- New_Debug_Line_Stmt --
+   -------------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Stmt;
+
+   ----------------------------
+   -- New_Debug_Comment_Stmt --
+   ----------------------------
+
+   procedure New_Debug_Comment_Stmt (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   ------------------------
+   -- Start_Declare_Stmt --
+   ------------------------
+
+   procedure Start_Declare_Stmt
+   is
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+   begin
+      Create_Declare_Block;
+
+      if Unreach then
+         return;
+      end if;
+
+      --  Add a jump to the new BB.
+      Br := BuildBr (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Vals : ValueRefArray (0 .. 5);
+         begin
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Lexical_Block, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_Scope,               --  2 context
+               Dbg_Line,                        --  3 line num
+               ConstInt (Int32Type, 0, 0),       --  4 col
+               ConstInt (Int32Type, Scope_Uniq_Id, 0));
+            Cur_Declare_Block.Dbg_Scope := MDNode (Vals, Vals'Length);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+            Scope_Uniq_Id := Scope_Uniq_Id + 1;
+         end;
+      end if;
+   end Start_Declare_Stmt;
+
+   -------------------------
+   -- Finish_Declare_Stmt --
+   -------------------------
+
+   procedure Finish_Declare_Stmt
+   is
+      Bb : BasicBlockRef;
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+   begin
+      if not Unreach then
+         --  Create a basic block for the statements after the declare.
+         Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+         --  Execution will continue on the next statement
+         Br := BuildBr (Builder, Bb);
+
+         PositionBuilderAtEnd (Builder, Bb);
+      end if;
+
+      --  Do not reset Unread.
+
+      Destroy_Declare_Block;
+
+      Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+   end Finish_Declare_Stmt;
+
+   -----------------------
+   -- Start_Association --
+   -----------------------
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Assocs := (Subprg => Subprg,
+                 Idx => 0,
+                 Vals => new ValueRefArray (1 .. Subprg.Nbr_Args));
+   end Start_Association;
+
+   ---------------------
+   -- New_Association --
+   ---------------------
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) is
+   begin
+      Assocs.Idx := Assocs.Idx + 1;
+      Assocs.Vals (Assocs.Idx) := Val.LLVM;
+   end New_Association;
+
+   -----------------------
+   -- New_Function_Call --
+   -----------------------
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      Res : ValueRef;
+      Old_Vals : ValueRefArray_Acc;
+   begin
+      Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                        Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+      Old_Vals := Assocs.Vals;
+      Free (Old_Vals);
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Assocs.Subprg.Dtype);
+   end New_Function_Call;
+
+   ------------------------
+   -- New_Procedure_Call --
+   ------------------------
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                           Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+         Set_Insn_Dbg (Res);
+      end if;
+      Free (Assocs.Vals);
+   end New_Procedure_Call;
+
+   ---------------------
+   -- New_Assign_Stmt --
+   ---------------------
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      Res : ValueRef;
+   begin
+      if Target.Direct then
+         raise Program_Error;
+      end if;
+      if not Unreach then
+         Res := BuildStore (Builder, Value.LLVM, Target.LLVM);
+         Set_Insn_Dbg (Res);
+      end if;
+   end New_Assign_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt (Value : O_Enode) is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRet (Builder, Value.LLVM);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRetVoid (Builder);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   -------------------
+   -- Start_If_Stmt --
+   -------------------
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) is
+      Res : ValueRef;
+      Bb_Then : BasicBlockRef;
+   begin
+      --  FIXME: check Unreach
+      Bb_Then := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Block := (Bb => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildCondBr (Builder, Cond.LLVM, Bb_Then, Block.Bb);
+      Set_Insn_Dbg (Res);
+
+      PositionBuilderAtEnd (Builder, Bb_Then);
+   end Start_If_Stmt;
+
+   -------------------
+   -- New_Else_Stmt --
+   -------------------
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         Res := BuildBr (Builder, Bb_Next);
+      else
+         Bb_Next := Null_BasicBlockRef;
+      end if;
+
+      PositionBuilderAtEnd (Builder, Block.Bb);
+
+      Block := (Bb => Bb_Next);
+      Unreach := False;
+   end New_Else_Stmt;
+
+   --------------------
+   -- Finish_If_Stmt --
+   --------------------
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         --  The branch can continue.
+         if Block.Bb = Null_BasicBlockRef then
+            Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         else
+            Bb_Next := Block.Bb;
+         end if;
+         Res := BuildBr (Builder, Bb_Next);
+         PositionBuilderAtEnd (Builder, Bb_Next);
+      else
+         --  The branch doesn't continue.
+         if Block.Bb /= Null_BasicBlockRef then
+            --  There is a fall-through (either from the then branch, or
+            --  there is no else).
+            Unreach := False;
+            PositionBuilderAtEnd (Builder, Block.Bb);
+         else
+            Unreach := True;
+         end if;
+      end if;
+   end Finish_If_Stmt;
+
+   ---------------------
+   -- Start_Loop_Stmt --
+   ---------------------
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  FIXME: check Unreach
+      Label := (Bb_Entry => AppendBasicBlock (Cur_Func, Empty_Cstring),
+                Bb_Exit => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildBr (Builder, Label.Bb_Entry);
+      PositionBuilderAtEnd (Builder, Label.Bb_Entry);
+   end Start_Loop_Stmt;
+
+   ----------------------
+   -- Finish_Loop_Stmt --
+   ----------------------
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, Label.Bb_Entry);
+      end if;
+      if Label.Bb_Exit /= Null_BasicBlockRef then
+         --  FIXME: always true...
+         PositionBuilderAtEnd (Builder, Label.Bb_Exit);
+         Unreach := False;
+      else
+         Unreach := True;
+      end if;
+   end Finish_Loop_Stmt;
+
+   -------------------
+   -- New_Exit_Stmt --
+   -------------------
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Exit);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Exit_Stmt;
+
+   -------------------
+   -- New_Next_Stmt --
+   -------------------
+
+   procedure New_Next_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Entry);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Next_Stmt;
+
+   ---------------------
+   -- Start_Case_Stmt --
+   ---------------------
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) is
+   begin
+      Block := (BB_Prev => GetInsertBlock (Builder),
+                Value => Value.LLVM,
+                Vtype => Value.Etype,
+                BB_Next => Null_BasicBlockRef,
+                BB_Others => Null_BasicBlockRef,
+                BB_Choice => Null_BasicBlockRef,
+                Nbr_Choices => 0,
+                Choices => new O_Choice_Array (1 .. 8));
+   end Start_Case_Stmt;
+
+   ------------------
+   -- Start_Choice --
+   ------------------
+
+   procedure Finish_Branch (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  Close previous branch.
+      if not Unreach then
+         if Block.BB_Next = Null_BasicBlockRef then
+            Block.BB_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         end if;
+         Res := BuildBr (Builder, Block.BB_Next);
+      end if;
+   end Finish_Branch;
+
+   procedure Start_Choice (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      Unreach := False;
+      Block.BB_Choice := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Builder, Block.BB_Choice);
+   end Start_Choice;
+
+   ---------------------
+   -- New_Expr_Choice --
+   ---------------------
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (O_Choice_Array, O_Choice_Array_Acc);
+
+   procedure New_Choice (Block : in out O_Case_Block;
+                         Low, High : ValueRef)
+   is
+      Choices : O_Choice_Array_Acc;
+   begin
+      if Block.Nbr_Choices = Block.Choices'Last then
+         Choices := new O_Choice_Array (1 .. Block.Choices'Last * 2);
+         Choices (1 .. Block.Choices'Last) := Block.Choices.all;
+         Free (Block.Choices);
+         Block.Choices := Choices;
+      end if;
+      Block.Nbr_Choices := Block.Nbr_Choices + 1;
+      Block.Choices (Block.Nbr_Choices) := (Low => Low,
+                                            High => High,
+                                            Bb => Block.BB_Choice);
+   end New_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) is
+   begin
+      New_Choice (Block, Expr.LLVM, Null_ValueRef);
+   end New_Expr_Choice;
+
+   ----------------------
+   -- New_Range_Choice --
+   ----------------------
+
+   procedure New_Range_Choice
+     (Block : in out O_Case_Block; Low, High : O_Cnode)
+   is
+   begin
+      New_Choice (Block, Low.LLVM, High.LLVM);
+   end New_Range_Choice;
+
+   ------------------------
+   -- New_Default_Choice --
+   ------------------------
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      Block.BB_Others := Block.BB_Choice;
+   end New_Default_Choice;
+
+   -------------------
+   -- Finish_Choice --
+   -------------------
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      null;
+   end Finish_Choice;
+
+   ----------------------
+   -- Finish_Case_Stmt --
+   ----------------------
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block)
+   is
+      Bb_Default : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Bb_Default_Last : BasicBlockRef;
+      Nbr_Cases : unsigned := 0;
+      GE, LE : IntPredicate;
+      Res : ValueRef;
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      --  Strategy: use a switch instruction for simple choices, put range
+      --   choices in the default using if statements.
+      case Block.Vtype.Kind is
+         when ON_Unsigned_Type
+           | ON_Enum_Type
+           | ON_Boolean_Type =>
+            GE := IntUGE;
+            LE := IntULE;
+         when ON_Signed_Type =>
+            GE := IntSGE;
+            LE := IntSLE;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  BB for the default case of the LLVM switch.
+      PositionBuilderAtEnd (Builder, Bb_Default);
+      Bb_Default_Last := Bb_Default;
+
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High /= Null_ValueRef then
+               Bb_Default_Last := AppendBasicBlock (Cur_Func, Empty_Cstring);
+               Res := BuildCondBr (Builder,
+                                   BuildAnd (Builder,
+                                             BuildICmp (Builder, GE,
+                                                        Block.Value, C.Low,
+                                                        Empty_Cstring),
+                                             BuildICmp (Builder, LE,
+                                                        Block.Value, C.High,
+                                                        Empty_Cstring),
+                                             Empty_Cstring),
+                                   C.Bb, Bb_Default_Last);
+               PositionBuilderAtEnd (Builder, Bb_Default_Last);
+            else
+               Nbr_Cases := Nbr_Cases + 1;
+            end if;
+         end;
+      end loop;
+
+      --  Insert the switch
+      PositionBuilderAtEnd (Builder, Block.BB_Prev);
+      Res := BuildSwitch (Builder, Block.Value, Bb_Default, Nbr_Cases);
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High = Null_ValueRef then
+               AddCase (Res, C.Low, C.Bb);
+            end if;
+         end;
+      end loop;
+
+      --  Insert the others.
+      PositionBuilderAtEnd (Builder, Bb_Default_Last);
+      if Block.BB_Others /= Null_BasicBlockRef then
+         Res := BuildBr (Builder, Block.BB_Others);
+      else
+         Res := BuildUnreachable (Builder);
+      end if;
+
+      if Block.BB_Next /= Null_BasicBlockRef then
+         Unreach := False;
+         PositionBuilderAtEnd (Builder, Block.BB_Next);
+      else
+         Unreach := True;
+      end if;
+
+      Free (Block.Choices);
+   end Finish_Case_Stmt;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type
+           | ON_Incomplete_Access_Type =>
+            if Atype.LLVM = Null_TypeRef then
+               raise Program_Error with "early use of incomplete type";
+            end if;
+            return Atype.LLVM;
+         when ON_Union_Type
+           | ON_Scalar_Types
+           | ON_Access_Type
+           | ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type =>
+            return Atype.LLVM;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_LLVM_Type;
+
+   procedure Finish_Debug is
+   begin
+      declare
+         Dbg_Cu : constant String := "llvm.dbg.cu" & ASCII.NUL;
+         Producer : constant String := "ortho llvm";
+         Vals : ValueRefArray (0 .. 12);
+      begin
+         Vals :=
+           (ConstInt (Int32Type, DW_TAG_Compile_Unit, 0),
+            Dbg_Current_Filedir,         --  1 file+dir
+            ConstInt (Int32Type, 1, 0),  --  2 language (C)
+            MDString (Producer),         --  3 producer
+            ConstInt (Int1Type, 0, 0),   --  4 isOpt
+            MDString (""),               --  5 flags
+            ConstInt (Int32Type, 0, 0),  --  6 runtime version
+            Null_ValueRef,               --  7 enum types
+            Null_ValueRef,               --  8 retained types
+            Get_Value (Subprg_Nodes),    --  9 subprograms
+            Get_Value (Global_Nodes),    --  10 global var
+            Null_ValueRef,               --  11 imported entities
+            Null_ValueRef);              --  12 split debug
+
+         AddNamedMetadataOperand
+           (Module, Dbg_Cu'Address, MDNode (Vals, Vals'Length));
+      end;
+
+      declare
+         Module_Flags : constant String := "llvm.module.flags" & ASCII.NUL;
+         Flags1 : ValueRefArray (0 .. 2);
+         Flags2 : ValueRefArray (0 .. 2);
+      begin
+         Flags1 := (ConstInt (Int32Type, 1, 0),
+                    MDString ("Debug Info Version"),
+                    ConstInt (Int32Type, 1, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags1, Flags1'Length));
+         Flags2 := (ConstInt (Int32Type, 2, 0),
+                    MDString ("Dwarf Version"),
+                    ConstInt (Int32Type, 2, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags2, Flags2'Length));
+      end;
+   end Finish_Debug;
+end Ortho_LLVM;