Share spec of ortho_nodes, adjust code.

5 files changed, 416 insertions, 122 deletions

diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile
index 01a33d0..36ff842 100644
--- a/ortho/gcc/Makefile
+++ b/ortho/gcc/Makefile
@@ -3,6 +3,7 @@ orthobe_srcdir=$(ortho_srcdir)/gcc
 agcc_objdir=.
 agcc_srcdir=$(ortho_srcdir)/gcc
 SED=sed
+BE=gcc
 GNATMAKE=gnatmake
 CC=gcc
 CXX=g++
@@ -28,10 +29,9 @@ ZLIB=-lz
 
 all: $(ortho_exec)
 
+ORTHO_BASENAME=ortho_gcc
 include $(orthobe_srcdir)/Makefile.inc
-
-ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc
-ORTHO_PACKAGE=Ortho_Gcc
+include $(ortho_srcdir)/Makefile.inc
 
 LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a
 LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a
@@ -47,10 +47,10 @@ LIBS =  $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \
         $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \
 	$(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS)
 
-$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force
+$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force
 	$(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \
 	 -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
-	 -bargs -E -largs --GCC=$(LINKER) $(AGCC_OBJS) \
+	 -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \
         $(BACKEND) $(LIBS) $(BACKENDLIBS)
 
 clean: agcc-clean
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index fe02dbc..6b4b8a5 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -268,7 +268,6 @@ append_stmt (tree stmt)
 static GTY(()) tree top;
 
 static GTY(()) tree stack_alloc_function_ptr;
-extern "C" void ortho_fe_init (void);
 
 static bool
 global_bindings_p (void)
@@ -367,8 +366,6 @@ ortho_init (void)
     REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
   }
 
-  ortho_fe_init ();
-
   build_common_builtin_nodes ();
   // FIXME: this MAY remove the need for creating the builtins above...
   // Evaluate tree.c / build_common_builtin_nodes (); for each in turn.
@@ -849,8 +846,6 @@ enum ON_op_kind {
   ON_And,
   ON_Or,
   ON_Xor,
-  ON_And_Then,
-  ON_Or_Else,
 
   /*  Monadic operations.  */
   ON_Not,
@@ -882,8 +877,6 @@ static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
   BIT_AND_EXPR,
   BIT_IOR_EXPR,
   BIT_XOR_EXPR,
-  TRUTH_ANDIF_EXPR,
-  TRUTH_ORIF_EXPR,
 
   BIT_NOT_EXPR,
   NEGATE_EXPR,
@@ -902,6 +895,9 @@ new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
 {
   tree left_type;
   enum tree_code code;
+  
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
 
   left_type = TREE_TYPE (left);
   gcc_assert (left_type == TREE_TYPE (right));
@@ -924,6 +920,9 @@ new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
 tree
 new_monadic_op (enum ON_op_kind kind, tree operand)
 {
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
   return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand);
 }
 
@@ -932,6 +931,10 @@ new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype)
 {
   gcc_assert (TREE_CODE (ntype) == BOOLEAN_TYPE);
   gcc_assert (TREE_TYPE (left) == TREE_TYPE (right));
+
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
   return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right);
 }
 
@@ -2025,20 +2028,6 @@ start_if_stmt (struct o_if_block *block, tree cond)
 }
 
 void
-new_elsif_stmt (struct o_if_block *block, tree cond)
-{
-  tree stmts;
-  tree stmt;
-
-  pop_stmts ();
-  stmts = alloc_stmt_list ();
-  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
-  COND_EXPR_ELSE (block->stmt) = stmt;
-  block->stmt = stmt;
-  push_stmts (stmts);
-}
-
-void
 new_else_stmt (struct o_if_block *block)
 {
   tree stmts;
diff --git a/ortho/gcc/ortho_gcc.adb b/ortho/gcc/ortho_gcc.adb
index c5234fc..ae7b4f5 100644
--- a/ortho/gcc/ortho_gcc.adb
+++ b/ortho/gcc/ortho_gcc.adb
@@ -1,3 +1,20 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 Ada.Unchecked_Deallocation;
 with Ortho_Gcc_Front; use Ortho_Gcc_Front;
 
@@ -8,9 +25,9 @@ package body Ortho_Gcc is
       return O_Enode (Lit);
    end New_Lit;
 
-   function New_Obj (Decl : O_Dnode) return O_Lnode is
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
    begin
-      return O_Lnode (Decl);
+      return O_Lnode (Obj);
    end New_Obj;
 
    function New_Obj_Value (Obj : O_Dnode) return O_Enode is
@@ -18,12 +35,6 @@ package body Ortho_Gcc is
       return O_Enode (Obj);
    end New_Obj_Value;
 
-   procedure Init
-   is
-   begin
-      null;
-   end Init;
-
    procedure New_Debug_Filename_Decl (Filename : String) is
    begin
       null;
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
index d01caee..f0a4724 100644
--- a/ortho/gcc/ortho_gcc.ads
+++ b/ortho/gcc/ortho_gcc.ads
@@ -1,3 +1,23 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_gcc.private.ads
+--
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 System;
 with Interfaces; use Interfaces;
 with Ortho_Ident;
@@ -5,26 +25,25 @@ use Ortho_Ident;
 
 --  Interface to create nodes.
 package Ortho_Gcc is
-   --- PUBLIC DECLARATIONS
-   --  PUBLIC PART is defined in ortho_nodes.common.ads
-   type O_Cnode is private;
+
+--  Start of common part
+
    type O_Enode is private;
+   type O_Cnode is private;
    type O_Lnode is private;
    type O_Tnode is private;
-   type O_Fnode is private;
-   type O_Dnode is private;
    type O_Snode is private;
-
-   --  Must be called during initialization, before use of any subprograms.
-   procedure Init;
+   type O_Dnode is private;
+   type O_Fnode is private;
 
    O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
    O_Enode_Null : constant O_Enode;
-   O_Lnode_Null : constant O_Lnode;
-   O_Tnode_Null : constant O_Tnode;
    O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
    O_Snode_Null : constant O_Snode;
-   O_Dnode_Null : constant O_Dnode;
+   O_Tnode_Null : constant O_Tnode;
+
 
    ------------------------
    --  Type definitions  --
@@ -101,6 +120,75 @@ package Ortho_Gcc is
                                Ident : O_Ident; Res : out O_Cnode);
    procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
 
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
    -------------------
    --  Expressions  --
    -------------------
@@ -122,8 +210,6 @@ package Ortho_Gcc is
       ON_And,                   --  ON_Dyadic_Op_Kind
       ON_Or,                    --  ON_Dyadic_Op_Kind
       ON_Xor,                   --  ON_Dyadic_Op_Kind
-      ON_And_Then,              --  ON_Dyadic_Op_Kind
-      ON_Or_Else,               --  ON_Dyadic_Op_Kind
 
       --  Monadic operations.
       ON_Not,                   --  ON_Monadic_Op_Kind
@@ -139,9 +225,7 @@ package Ortho_Gcc is
       ON_Gt                     --  ON_Compare_Op_Kind
       );
 
-   pragma Convention (C, ON_Op_Kind);
-
-   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Or_Else;
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
    subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
    subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
 
@@ -149,7 +233,6 @@ package Ortho_Gcc is
                       O_Storage_Public,
                       O_Storage_Private,
                       O_Storage_Local);
-   pragma Convention (C, O_Storage);
    --  Specifies the storage kind of a declaration.
    --  O_STORAGE_EXTERNAL:
    --    The declaration do not either reserve memory nor generate code, and
@@ -164,8 +247,8 @@ package Ortho_Gcc is
    Type_Error : exception;
    Syntax_Error : exception;
 
+   --  Create a value from a literal.
    function New_Lit (Lit : O_Cnode) return O_Enode;
-   pragma Inline (New_Lit);
 
    --  Create a dyadic operation.
    --  Left and right nodes must have the same type.
@@ -185,63 +268,13 @@ package Ortho_Gcc is
      (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
      return O_Enode;
 
-   --  Create a literal from an integer.
-   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
-     return O_Cnode;
-   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
-     return O_Cnode;
-
-   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
-     return O_Cnode;
-
-   --  Create a null access literal.
-   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
 
    type O_Inter_List is limited private;
-   type O_Record_Aggr_List is limited private;
-   type O_Array_Aggr_List is limited private;
    type O_Assoc_List is limited private;
-   type O_Loop_Block is limited private;
    type O_If_Block is limited private;
    type O_Case_Block is limited private;
 
 
-   --  Build a record/array aggregate.
-   --  The aggregate is constant, and therefore can be only used to initialize
-   --  constant declaration.
-   --  ATYPE must be either a record type or an array subtype.
-   --  Elements must be added in the order, and must be literals or aggregates.
-   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
-                                Atype : O_Tnode);
-   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
-                                 Value : O_Cnode);
-   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
-                                 Res : out O_Cnode);
-
-   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
-   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
-                                Value : O_Cnode);
-   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
-                                Res : out O_Cnode);
-
-   --  Build an union aggregate.
-   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
-                           return O_Cnode;
-
-   --  Returns the size in bytes of ATYPE.  The result is a literal of
-   --  unsigned type RTYPE
-   --  ATYPE cannot be an unconstrained array type.
-   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
-
-   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
-   --  unsgined type RTYPE.
-   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
-
-   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
-   --  literal of unsigned type or access type RTYPE.
-   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
-                         return O_Cnode;
-
    --  Get an element of an array.
    --  INDEX must be of the type of the array index.
    function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
@@ -273,24 +306,17 @@ package Ortho_Gcc is
    --  ATYPE must be a type access whose designated type is the type of LVALUE.
    --  FIXME: what about arrays.
    function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
-   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
-                               return O_Cnode;
 
    --  Same as New_Address but without any restriction.
    function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
      return O_Enode;
-   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
-                                         return O_Cnode;
-
-   --  Get the address of a subprogram.
-   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
-     return O_Cnode;
 
    --  Get the value of an Lvalue.
    function New_Value (Lvalue : O_Lnode) return O_Enode;
-   --  Get the value of an object.
    function New_Obj_Value (Obj : O_Dnode) return O_Enode;
-   pragma Inline (New_Obj_Value);
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
 
    --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
    function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
@@ -303,7 +329,7 @@ package Ortho_Gcc is
    --  Declarations.  --
    ---------------------
 
-   --  Filename.
+   --  Filename of the next declaration.
    procedure New_Debug_Filename_Decl (Filename : String);
 
    --  Line number of the next declaration.
@@ -335,9 +361,6 @@ package Ortho_Gcc is
       Storage : O_Storage;
       Atype : O_Tnode);
 
-   function New_Obj (Decl : O_Dnode) return O_Lnode;
-   pragma Inline (New_Obj);
-
    --  Start a subprogram declaration.
    --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
    --   be declared inside a subprograms.  It is not allowed to declare
@@ -402,14 +425,12 @@ package Ortho_Gcc is
 
    --  Build an IF statement.
    procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
-   --  COND is NULL for the final else statement.
-   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode);
    procedure New_Else_Stmt (Block : in out O_If_Block);
    procedure Finish_If_Stmt (Block : in out O_If_Block);
 
    --  Create a infinite loop statement.
    procedure Start_Loop_Stmt (Label : out O_Snode);
-   procedure Finish_Loop_Stmt (Block : in out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
 
    --  Exit from a loop stmt or from a for stmt.
    procedure New_Exit_Stmt (L : O_Snode);
@@ -420,6 +441,9 @@ package Ortho_Gcc is
    --  Case statement.
    --  VALUE is the selector and must be a discrete type.
    procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
    procedure Start_Choice (Block : in out O_Case_Block);
    procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
    procedure New_Range_Choice (Block : in out O_Case_Block;
@@ -428,7 +452,11 @@ package Ortho_Gcc is
    procedure Finish_Choice (Block : in out O_Case_Block);
    procedure Finish_Case_Stmt (Block : in out O_Case_Block);
 
+--  End of common part
 private
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
    subtype Tree is System.Address;
    NULL_TREE : constant Tree := System.Null_Address;
 
@@ -446,8 +474,6 @@ private
    end record;
    pragma Convention (C, O_Snode);
 
-   pragma Export (C, Init, "ortho_fe_init");
-
    O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
    O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
    O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
@@ -456,6 +482,10 @@ private
    O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
    O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
 
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
    --  Efficiently append element EL to a chain.
    --  FIRST is the first element of the chain (must NULL_TREE if the chain
    --   is empty),
@@ -641,7 +671,6 @@ private
    pragma Import (C, New_Assign_Stmt);
 
    pragma Import (C, Start_If_Stmt);
-   pragma Import (C, New_Elsif_Stmt);
    pragma Import (C, New_Else_Stmt);
    pragma Import (C, Finish_If_Stmt);
 
diff --git a/ortho/gcc/ortho_gcc.private.ads b/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 0000000..c113f2f
--- /dev/null
+++ b/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,265 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+
+private
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+
+   subtype Vec_Ptr is System.Address;
+
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Atype : Tree;
+      Afield : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Record_Aggr_List);
+
+   type O_Array_Aggr_List is record
+      Atype : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;