Add support for gcc-5 and gcc-6

2 files changed, 4306 insertions, 0 deletions

diff --git a/src/ortho/gcc/ortho-lang-5.c b/src/ortho/gcc/ortho-lang-5.c
new file mode 100644
index 000000000..927b9594a
--- /dev/null
+++ b/src/ortho/gcc/ortho-lang-5.c
@@ -0,0 +1,2153 @@
+/* GCC back-end for ortho
+  Copyright (C) 2002-1014 Tristan Gingold and al.
+
+  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.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "hash-set.h"
+#include "machmode.h"
+#include "vec.h"
+#include "double-int.h"
+#include "input.h"
+#include "alias.h"
+#include "symtab.h"
+#include "wide-int.h"
+#include "inchash.h"
+#include "real.h"
+#include "tree.h"
+
+#include "bitmap.h"
+#include "hash-map.h"
+#include "is-a.h"
+#include "plugin-api.h"
+#include "hard-reg-set.h"
+#include "input.h"
+#include "function.h"
+#include "ipa-ref.h"
+#include "cgraph.h"
+
+#include "fold-const.h"
+
+#include <stddef.h>
+#include <math.h>
+
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "toplev.h"
+#include "opts.h"
+#include "options.h"
+#include "tree-iterator.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
+
+#include "print-tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
+#include "varasm.h"
+
+/* Returns the number of FIELD_DECLs in TYPE.
+   Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h.  */
+
+static int
+fields_length (const_tree type)
+{
+  tree t = TYPE_FIELDS (type);
+  int count = 0;
+
+  for (; t; t = DECL_CHAIN (t))
+    if (TREE_CODE (t) == FIELD_DECL)
+      ++count;
+
+  return count;
+}
+
+/* TODO:
+ * remove stmt_list_stack, save in if/case/loop block
+ * Re-add -v (if necessary)
+ */
+
+static tree type_for_size (unsigned int precision, int unsignedp);
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+struct GTY(()) binding_level
+{
+  /*  The BIND_EXPR node for this binding.  */
+  tree bind;
+
+  /*  The BLOCK node for this binding.  */
+  tree block;
+
+  /*  If true, stack must be saved (alloca is used).  */
+  int save_stack;
+
+  /*  Parent binding level.  */
+  struct binding_level *prev;
+
+  /*  Decls in this binding.  */
+  tree first_decl;
+  tree last_decl;
+
+  /*  Blocks in this binding.  */
+  tree first_block;
+  tree last_block;
+
+  /* Statements list containing the binding. */
+  tree prev_stmts;
+};
+
+/*  The current binding level.  */
+static GTY(()) struct binding_level *cur_binding_level = NULL;
+
+/*  Chain of unused binding levels.  */
+static GTY(()) struct binding_level *old_binding_levels = NULL;
+
+/*  Chain of statements currently generated.  */
+static GTY(()) tree cur_stmts = NULL_TREE;
+
+enum binding_kind { GLOBAL_BINDING, FUNCTION_BINDING, LOCAL_BINDING };
+
+static void
+push_binding (enum binding_kind kind)
+{
+  struct binding_level *res;
+
+  /* Get a binding level (old ones are recycled).  */
+  if (old_binding_levels == NULL)
+    res = ggc_alloc<binding_level> ();
+  else
+    {
+      res = old_binding_levels;
+      old_binding_levels = res->prev;
+    }
+
+  /* Init.  */
+  res->first_decl = NULL_TREE;
+  res->last_decl = NULL_TREE;
+
+  res->first_block = NULL_TREE;
+  res->last_block = NULL_TREE;
+
+  res->save_stack = 0;
+
+  switch (kind)
+    {
+    case GLOBAL_BINDING:
+      res->bind = NULL_TREE;
+      res->block = NULL_TREE;
+      res->prev = NULL;
+      res->prev_stmts = NULL;
+      break;
+    case FUNCTION_BINDING:
+    case LOCAL_BINDING:
+      res->block = make_node (BLOCK);
+      TREE_USED (res->block) = true;
+      res->bind = build3 (BIND_EXPR, void_type_node,
+			  NULL_TREE, NULL_TREE, res->block);
+      TREE_SIDE_EFFECTS (res->bind) = true;
+      res->prev_stmts = cur_stmts;
+      cur_stmts = alloc_stmt_list ();
+      break;
+    }
+
+  switch (kind)
+    {
+    case GLOBAL_BINDING:
+      /* No supercontext for the global binding.  */
+      break;
+    case FUNCTION_BINDING:
+      /* No containing block.  */
+      BLOCK_SUPERCONTEXT (res->block) = current_function_decl;
+      break;
+    case LOCAL_BINDING:
+      /* Append the block created.  */
+      if (cur_binding_level->first_block == NULL)
+	cur_binding_level->first_block = res->block;
+      else
+	BLOCK_CHAIN (cur_binding_level->last_block) = res->block;
+      cur_binding_level->last_block = res->block;
+
+      BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
+      break;
+    }
+
+  /* Chain previous binding, set current binding.  */
+  res->prev = cur_binding_level;
+  cur_binding_level = res;
+}
+
+static tree
+pushdecl (tree decl)
+{
+  /* Set context (always a function or NULL if top-level).  */
+  DECL_CONTEXT (decl) = current_function_decl;
+
+  /* Chain the declaration.  */
+  if (cur_binding_level->first_decl == NULL)
+    cur_binding_level->first_decl = decl;
+  else
+    TREE_CHAIN (cur_binding_level->last_decl) = decl;
+  cur_binding_level->last_decl = decl;
+
+  return decl;
+}
+
+static tree
+pop_binding (void)
+{
+  tree res;
+  struct binding_level *cur;
+
+  cur = cur_binding_level;
+  res = cur->bind;
+
+  if (cur->save_stack)
+    {
+      tree tmp_var;
+      tree save;
+      tree save_call;
+      tree restore;
+      tree t;
+
+      /* Create an artificial var to save the stack pointer.  */
+      tmp_var = build_decl (input_location, VAR_DECL, NULL, ptr_type_node);
+      DECL_ARTIFICIAL (tmp_var) = true;
+      DECL_IGNORED_P (tmp_var) = true;
+      TREE_USED (tmp_var) = true;
+      pushdecl (tmp_var);
+
+      /* Create the save stmt.  */
+      save_call = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_SAVE), 0);
+      save = build2 (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
+      TREE_SIDE_EFFECTS (save) = true;
+
+      /* Create the restore stmt.  */
+      restore = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_RESTORE), 1, tmp_var);
+
+      /* Build a try-finally block.
+	 The statement list is the block of current statements.  */
+      t = build2 (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
+      TREE_SIDE_EFFECTS (t) = true;
+
+      /* The finally block is the restore stmt.  */
+      append_to_statement_list (restore, &TREE_OPERAND (t, 1));
+
+      /* The body of the BIND_BLOCK is the save stmt, followed by the
+	 try block.  */
+      BIND_EXPR_BODY (res) = NULL_TREE;
+      append_to_statement_list (save, &BIND_EXPR_BODY (res));
+      append_to_statement_list (t, &BIND_EXPR_BODY (res));
+    }
+  else
+    {
+      /* The body of the BIND_BLOCK is the statement block.  */
+      BIND_EXPR_BODY (res) = cur_stmts;
+    }
+  BIND_EXPR_VARS (res) = cur->first_decl;
+
+  BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
+  BLOCK_VARS (cur->block) = cur->first_decl;
+
+  /* Set current statements list and current binding.  */
+  cur_stmts = cur->prev_stmts;
+  cur_binding_level = cur->prev;
+
+  /* Put removed binding to the recycle list.  */
+  cur->prev = old_binding_levels;
+  old_binding_levels = cur;
+
+  return res;
+}
+
+static void
+append_stmt (tree stmt)
+{
+  /* Set location (if not done).  */
+  if (!EXPR_HAS_LOCATION (stmt))
+    SET_EXPR_LOCATION (stmt, input_location);
+
+  TREE_SIDE_EFFECTS (stmt) = true;
+  append_to_statement_list (stmt, &cur_stmts);
+}
+
+static GTY(()) tree stack_alloc_function_ptr;
+
+static bool
+global_bindings_p (void)
+{
+  return cur_binding_level->prev == NULL;
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.  */
+static void
+define_builtin (const char *name,
+		tree type,
+		enum built_in_function code,
+		const char *library_name,
+		int attr)
+{
+  tree decl;
+
+  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+			       library_name, NULL_TREE);
+  set_call_expr_flags (decl, attr);
+
+  set_builtin_decl (code, decl, true);
+}
+
+static REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+
+static bool
+ortho_init (void)
+{
+  tree n;
+
+  input_location = BUILTINS_LOCATION;
+
+  /* Create a global binding.  Don't use push_binding, as neither a BLOCK nor
+     a BIND_EXPR are needed.  */
+  push_binding (GLOBAL_BINDING);
+
+  build_common_tree_nodes (0, 0);
+
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("int"), integer_type_node);
+  pushdecl (n);
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("char"), char_type_node);
+  pushdecl (n);
+
+  /* Create alloca builtin.  */
+  {
+    tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
+    tree func_type = build_function_type (ptr_type_node, args_type);
+
+    define_builtin ("__builtin_alloca", func_type,
+		    BUILT_IN_ALLOCA, NULL, 0);
+
+    stack_alloc_function_ptr = build1
+      (ADDR_EXPR,
+       build_pointer_type (func_type),
+       builtin_decl_implicit (BUILT_IN_ALLOCA));
+  }
+
+  {
+    tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_stack_save", ptr_ftype,
+		    BUILT_IN_STACK_SAVE, NULL, 0);
+  }
+
+  {
+    tree ftype_ptr = build_function_type_list (void_type_node,
+					       ptr_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_stack_restore", ftype_ptr,
+		    BUILT_IN_STACK_RESTORE, NULL, 0);
+  }
+
+  {
+    tree ftype_ptr = build_function_type_list (void_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_trap", ftype_ptr,
+		    BUILT_IN_TRAP, NULL, ECF_NOTHROW | ECF_LEAF);
+    TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
+  }
+
+  fp_const_m_p5 = real_value_negate (&dconsthalf);
+
+  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.
+
+  return true;
+}
+
+static void
+ortho_finish (void)
+{
+}
+
+static unsigned int
+ortho_option_lang_mask (void)
+{
+  return CL_vhdl;
+}
+
+static bool
+ortho_post_options (const char **pfilename)
+{
+  if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
+    *pfilename = "*stdin*";
+
+  /* Default hook.  */
+  lhd_post_options (pfilename);
+
+  /* Run the back-end.  */
+  return false;
+}
+
+extern "C" int lang_handle_option (const char *opt, const char *arg);
+
+static bool
+ortho_handle_option (size_t code, const char *arg,
+		     int value ATTRIBUTE_UNUSED,
+		     int kind ATTRIBUTE_UNUSED,
+                     location_t loc ATTRIBUTE_UNUSED,
+                     const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  const char *opt;
+
+  opt = cl_options[code].opt_text;
+
+  switch (code)
+    {
+    case OPT__elab:
+    case OPT_l:
+    case OPT_c:
+    case OPT__anaelab:
+      /* Only a few options have a real arguments.  */
+      return lang_handle_option (opt, arg) != 0;
+    default:
+      /* The other options must have a joint argument.  */
+      if (arg != NULL)
+	{
+	  size_t len1;
+	  size_t len2;
+	  char *nopt;
+
+	  len1 = strlen (opt);
+	  len2 = strlen (arg);
+	  nopt = (char *) alloca (len1 + len2 + 1);
+	  memcpy (nopt, opt, len1);
+	  memcpy (nopt + len1, arg, len2);
+	  nopt[len1 + len2] = 0;
+	  opt = nopt;
+	}
+      return lang_handle_option (opt, NULL) != 0;
+    }
+}
+
+extern "C" int lang_parse_file (const char *filename);
+
+static void
+ortho_parse_file (void)
+{
+  const char *filename;
+  const char *dbg_filename;
+
+  if (num_in_fnames == 0)
+    filename = NULL;
+  else
+    filename = in_fnames[0];
+
+  /* Use absolute filenames for debug info.  Works better than relative
+     filenames with some debuggers/tools.  */
+  if (filename == NULL)
+    dbg_filename = "*stdin*";
+  else if (IS_ABSOLUTE_PATH (filename))
+    dbg_filename = filename;
+  else
+    dbg_filename = concat (getpwd (), "/", filename, NULL);
+
+  linemap_add (line_table, LC_ENTER, 0, dbg_filename, 1);
+  input_location = linemap_line_start (line_table, 1, 252);
+
+  if (!lang_parse_file (filename))
+    errorcount++;
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
+}
+
+/*  Called by the back-end or by the front-end when the address of EXP
+    must be taken.
+    This function should found the base object (if any), and mark it as
+    addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+    object cannot be addressable (front-end restriction).
+    Returns TRUE in case of success, FALSE in case of failure.
+    Note that the status is never checked by the back-end.  */
+static bool
+ortho_mark_addressable (tree exp)
+{
+  tree n;
+
+  n = exp;
+
+  while (1)
+    switch (TREE_CODE (n))
+      {
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case ARRAY_RANGE_REF:
+	n = TREE_OPERAND (n, 0);
+	break;
+
+      case FUNCTION_DECL:
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case INDIRECT_REF:
+	return true;
+
+      default:
+	gcc_unreachable ();
+      }
+}
+
+static tree
+ortho_truthvalue_conversion (tree expr)
+{
+  tree expr_type;
+  tree t;
+  tree f;
+
+  expr_type = TREE_TYPE (expr);
+  if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
+    {
+      t = integer_one_node;
+      f = integer_zero_node;
+    }
+  else
+    {
+      f = TYPE_MIN_VALUE (expr_type);
+      t = TYPE_MAX_VALUE (expr_type);
+    }
+
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      /* Not 0 is true.  */
+      return integer_zerop (expr) ? f : t;
+
+    case REAL_CST:
+      return real_zerop (expr) ? f : t;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+/* The following function has been copied and modified from c-convert.c.  */
+
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+  const char *invalid_conv_diag;
+
+  if (type == error_mark_node
+      || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if ((invalid_conv_diag
+       = targetm.invalid_conversion (TREE_TYPE (expr), type)))
+    {
+      error (invalid_conv_diag);
+      return error_mark_node;
+    }
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1 (NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
+    {
+      gcc_unreachable ();
+    }
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      tree t = ortho_truthvalue_conversion (expr);
+      if (TREE_CODE (t) == ERROR_MARK)
+	return t;
+
+      /* If it returns a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (t) == NOP_EXPR)
+	return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
+      else
+	return fold_build1 (NOP_EXPR, type, t);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+
+  gcc_unreachable ();
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD BITS_PER_WORD
+#endif
+
+/*  This variable keeps a table for types for each precision so that we only
+    allocate each of them once. Signed and unsigned types are kept separate.
+ */
+static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/*  Return an integer type with the number of bits of precision given by
+    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+    it is a signed type.  */
+static tree
+type_for_size (unsigned int precision, int unsignedp)
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+  if (unsignedp)
+    t = make_unsigned_type (precision);
+  else
+    t = make_signed_type (precision);
+
+  if (precision <= MAX_BITS_PER_WORD)
+    signed_and_unsigned_types[precision][unsignedp] = t;
+
+  return t;
+}
+
+/*  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+    an unsigned type; otherwise a signed type is returned.  */
+static tree
+type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  if (SCALAR_INT_MODE_P (mode))
+    return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+
+  if (mode == TYPE_MODE (void_type_node))
+    return void_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  return NULL_TREE;
+}
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "vhdl"
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT ortho_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH ortho_finish
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK ortho_option_lang_mask
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS ortho_post_options
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
+#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE ortho_parse_file
+
+#define pushlevel lhd_do_nothing_i
+#define poplevel lhd_do_nothing_iii_return_null_tree
+#define set_block lhd_do_nothing_t
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+union GTY((desc ("0"),
+	   chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
+  lang_tree_node
+{
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+};
+
+/* GHDL does not use the lang_decl and lang_type.
+
+   FIXME: the variable_size annotation here is needed because these types are
+   variable-sized in some other front-ends.  Due to gengtype deficiency, the
+   GTY options of such types have to agree across all front-ends.  */
+
+struct GTY((variable_size)) lang_type { char dummy; };
+struct GTY((variable_size)) lang_decl { char dummy; };
+
+struct GTY(()) language_function
+{
+  char dummy;
+};
+
+
+extern "C" {
+
+struct GTY(()) chain_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+chain_init (struct chain_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+chain_append (struct chain_constr_type *constr, tree el)
+{
+  if (constr->first == NULL_TREE)
+    {
+      gcc_assert (constr->last == NULL_TREE);
+      constr->first = el;
+    }
+  else
+    TREE_CHAIN (constr->last) = el;
+  constr->last = el;
+}
+
+struct GTY(()) list_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+list_init (struct list_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+ortho_list_append (struct list_constr_type *constr, tree el)
+{
+  tree res;
+
+  res = tree_cons (NULL_TREE, el, NULL_TREE);
+  if (constr->first == NULL_TREE)
+    constr->first = res;
+  else
+    TREE_CHAIN (constr->last) = res;
+  constr->last = res;
+}
+
+enum ON_op_kind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or,
+  ON_Xor,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
+  ERROR_MARK,
+
+  PLUS_EXPR,
+  MINUS_EXPR,
+  MULT_EXPR,
+  ERROR_MARK,
+  TRUNC_MOD_EXPR,
+  FLOOR_MOD_EXPR,
+
+  BIT_AND_EXPR,
+  BIT_IOR_EXPR,
+  BIT_XOR_EXPR,
+
+  BIT_NOT_EXPR,
+  NEGATE_EXPR,
+  ABS_EXPR,
+
+  EQ_EXPR,
+  NE_EXPR,
+  LE_EXPR,
+  LT_EXPR,
+  GE_EXPR,
+  GT_EXPR,
+};
+
+tree
+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));
+
+  switch (kind)
+    {
+    case ON_Div_Ov:
+      if (TREE_CODE (left_type) == REAL_TYPE)
+	code = RDIV_EXPR;
+      else
+	code = TRUNC_DIV_EXPR;
+      break;
+    default:
+      code = ON_op_to_TREE_CODE[kind];
+      break;
+    }
+  return build2 (code, left_type, left, 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);
+}
+
+tree
+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);
+}
+
+tree
+new_convert_ov (tree val, tree rtype)
+{
+  tree val_type;
+  enum tree_code val_code;
+  enum tree_code rtype_code;
+  enum tree_code code;
+
+  val_type = TREE_TYPE (val);
+  if (val_type == rtype)
+    return val;
+
+  /*  FIXME: check conversions.  */
+  val_code = TREE_CODE (val_type);
+  rtype_code = TREE_CODE (rtype);
+  if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
+    {
+      /*  REAL to INTEGER
+          Gcc only handles FIX_TRUNC_EXPR, but we need rounding.  */
+      tree m_p5;
+      tree p5;
+      tree zero;
+      tree saved;
+      tree comp;
+      tree adj;
+      tree res;
+
+      m_p5 = build_real (val_type, fp_const_m_p5);
+      p5 = build_real (val_type, dconsthalf);
+      zero = build_real (val_type, dconst0);
+      saved = save_expr (val);
+      comp = build2 (GE_EXPR, integer_type_node, saved, zero);
+      /*  FIXME: instead of res = res + (comp ? .5 : -.5)
+	  do: res = res (comp ? + : -) .5  */
+      adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
+      res = build2 (PLUS_EXPR, val_type, saved, adj);
+      res = build1 (FIX_TRUNC_EXPR, rtype, res);
+      return res;
+    }
+  else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
+    code = FLOAT_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
+    code = NOP_EXPR;
+  else
+    gcc_unreachable ();
+
+  return build1 (code, rtype, val);
+}
+
+tree
+new_alloca (tree rtype, tree size)
+{
+  tree res;
+
+  /* Must save stack except when at function level.  */
+  if (cur_binding_level->prev != NULL
+      && cur_binding_level->prev->prev != NULL)
+    cur_binding_level->save_stack = 1;
+
+  res = build_call_nary (ptr_type_node, stack_alloc_function_ptr,
+                         1, fold_convert (size_type_node, size));
+  return fold_convert (rtype, res);
+}
+
+tree
+new_signed_literal (tree ltype, long long value)
+{
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = double_int_to_tree (ltype, double_int::from_pair (hi, lo));
+  return res;
+}
+
+tree
+new_unsigned_literal (tree ltype, unsigned long long value)
+{
+  tree res;
+  unsigned HOST_WIDE_INT lo;
+  unsigned HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = double_int_to_tree (ltype, double_int::from_pair (hi, lo));
+  return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+  tree res;
+
+  res = build_int_cst (ltype, 0);
+  return res;
+}
+
+tree
+new_float_literal (tree ltype, double value)
+{
+  signed long long s;
+  double frac;
+  int ex;
+  REAL_VALUE_TYPE r_sign;
+  REAL_VALUE_TYPE r_exp;
+  REAL_VALUE_TYPE r;
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  frac = frexp (value, &ex);
+
+  s = ldexp (frac, 60);
+  lo = s;
+  hi = (s >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  real_from_integer (&r_sign, DFmode, double_int::from_pair (hi, lo), SIGNED);
+  real_2expN (&r_exp, ex - 60, DFmode);
+  real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
+  res = build_real (ltype, r);
+  return res;
+}
+
+struct GTY(()) o_element_list
+{
+  tree res;
+  struct chain_constr_type chain;
+};
+
+void
+new_uncomplete_record_type (tree *res)
+{
+  *res = make_node (RECORD_TYPE);
+}
+
+void
+start_record_type (struct o_element_list *elements)
+{
+  elements->res = make_node (RECORD_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+start_uncomplete_record_type (tree res, struct o_element_list *elements)
+{
+  elements->res = res;
+  chain_init (&elements->chain);
+}
+
+static void
+new_record_union_field (struct o_element_list *list,
+			tree *el,
+			tree ident,
+			tree etype)
+{
+  tree res;
+
+  res = build_decl (input_location, FIELD_DECL, ident, etype);
+  DECL_CONTEXT (res) = list->res;
+  chain_append (&list->chain, res);
+  *el = res;
+}
+
+void
+new_record_field (struct o_element_list *list,
+		  tree *el,
+		  tree ident,
+		  tree etype)
+{
+  return new_record_union_field (list, el, ident, etype);
+}
+
+void
+finish_record_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+
+  if (TYPE_NAME (elements->res) != NULL_TREE)
+    {
+      /*  The type was completed.  */
+      rest_of_type_compilation (elements->res, 1);
+    }
+}
+
+void
+start_union_type (struct o_element_list *elements)
+{
+  elements->res =  make_node (UNION_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+new_union_field (struct o_element_list *elements,
+		 tree *el,
+		 tree ident,
+		 tree etype)
+{
+  return new_record_union_field (elements, el, ident, etype);
+}
+
+void
+finish_union_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+}
+
+tree
+new_unsigned_type (int size)
+{
+  return make_unsigned_type (size);
+}
+
+tree
+new_signed_type (int size)
+{
+  return make_signed_type (size);
+}
+
+tree
+new_float_type (void)
+{
+  tree res;
+
+  res = make_node (REAL_TYPE);
+  TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
+  layout_type (res);
+  return res;
+}
+
+tree
+new_access_type (tree dtype)
+{
+  tree res;
+
+  if (dtype == NULL_TREE)
+    {
+      res = make_node (POINTER_TYPE);
+      TREE_TYPE (res) = NULL_TREE;
+      /* Seems necessary.  */
+      SET_TYPE_MODE (res, Pmode);
+      layout_type (res);
+      return res;
+    }
+  else
+    return build_pointer_type (dtype);
+}
+
+void
+finish_access_type (tree atype, tree dtype)
+{
+  gcc_assert (TREE_CODE (atype) == POINTER_TYPE
+	      && TREE_TYPE (atype) == NULL_TREE);
+
+  TREE_TYPE (atype) = dtype;
+}
+
+tree
+new_array_type (tree el_type, tree index_type)
+{
+  return build_array_type (el_type, index_type);
+}
+
+
+tree
+new_constrained_array_type (tree atype, tree length)
+{
+  tree range_type;
+  tree index_type;
+  tree len;
+  tree one;
+  tree res;
+
+  index_type = TYPE_DOMAIN (atype);
+  if (integer_zerop (length))
+    {
+      /*  Handle null array, by creating a one-length array...  */
+      len = size_zero_node;
+    }
+  else
+    {
+      one = build_int_cstu (index_type, 1);
+      len = build2 (MINUS_EXPR, index_type, length, one);
+      len = fold (len);
+    }
+
+  range_type = build_range_type (index_type, size_zero_node, len);
+  res = build_array_type (TREE_TYPE (atype), range_type);
+
+  /* Constrained arrays are *always* a subtype of its array type.
+     Just copy alias set.  */
+  TYPE_ALIAS_SET (res) = get_alias_set (atype);
+  return res;
+}
+
+void
+new_boolean_type (tree *res,
+		  tree false_id ATTRIBUTE_UNUSED, tree *false_e,
+		  tree true_id ATTRIBUTE_UNUSED, tree *true_e)
+{
+  *res = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (*res) = 1;
+  fixup_unsigned_type (*res);
+  *false_e = TYPE_MIN_VALUE (*res);
+  *true_e = TYPE_MAX_VALUE (*res);
+}
+
+struct o_enum_list
+{
+  tree res;
+  struct chain_constr_type chain;
+  int num;
+  int size;
+};
+
+void
+start_enum_type (struct o_enum_list *list, int size)
+{
+  list->res = make_node (ENUMERAL_TYPE);
+  /* Set precision and sign now, as this is used to normalize literals.  */
+  TYPE_PRECISION (list->res) = size;
+  TYPE_UNSIGNED (list->res) = 1;
+  chain_init (&list->chain);
+  list->num = 0;
+  list->size = size;
+}
+
+void
+new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
+{
+  *res = build_int_cstu (list->res, (HOST_WIDE_INT)(list->num));
+  chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
+  list->num++;
+}
+
+void
+finish_enum_type (struct o_enum_list *list, tree *res)
+{
+  *res = list->res;
+  TYPE_VALUES (*res) = list->chain.first;
+  set_min_and_max_values_for_integral_type (*res, list->size, UNSIGNED);
+  layout_type (*res);
+}
+
+struct GTY(()) o_record_aggr_list
+{
+  /* Type of the record.  */
+  tree atype;
+  /* Type of the next field to be added.  */
+  tree field;
+  /* Vector of elements.  */
+  // VEC(constructor_elt,gc) *elts;
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_record_aggr (struct o_record_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  list->field = TYPE_FIELDS (atype);
+  //list->elts = VEC_alloc (constructor_elt, gc, fields_length (atype));
+  vec_alloc(list->elts, fields_length (atype));
+}
+
+void
+new_record_aggr_el (struct o_record_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, list->field, value);
+  list->field = TREE_CHAIN (list->field);
+}
+
+void
+finish_record_aggr (struct o_record_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+struct GTY(()) o_array_aggr_list
+{
+  tree atype;
+  /* Vector of elements.  */
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_array_aggr (struct o_array_aggr_list *list, tree atype)
+{
+  tree nelts;
+  unsigned HOST_WIDE_INT n;
+
+  list->atype = atype;
+  list->elts = NULL;
+
+  nelts = array_type_nelts (atype);
+  gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts));
+
+  n = tree_to_uhwi (nelts) + 1;
+  vec_alloc(list->elts, n);
+}
+
+void
+new_array_aggr_el (struct o_array_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, NULL_TREE, value);
+}
+
+void
+finish_array_aggr (struct o_array_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+tree
+new_union_aggr (tree atype, tree field, tree value)
+{
+  tree res;
+
+  res = build_constructor_single (atype, field, value);
+  TREE_CONSTANT (res) = 1;
+  return res;
+}
+
+tree
+new_default_value (tree atype)
+{
+  return build_constructor (atype, NULL);
+}
+
+tree
+new_indexed_element (tree arr, tree index)
+{
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
+		 arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_slice (tree arr, tree res_type, tree index)
+{
+  gcc_assert (TREE_CODE (res_type) == ARRAY_TYPE);
+
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+  tree res;
+
+  gcc_assert (RECORD_OR_UNION_TYPE_P (TREE_TYPE (rec)));
+
+  res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
+  return res;
+}
+
+tree
+new_access_element (tree acc)
+{
+  tree acc_type;
+
+  acc_type = TREE_TYPE (acc);
+  gcc_assert (TREE_CODE (acc_type) == POINTER_TYPE);
+
+  return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
+}
+
+tree
+new_offsetof (tree rec_type, tree field, tree rtype)
+{
+  tree off;
+  tree bit_off;
+  HOST_WIDE_INT pos;
+  tree res;
+
+  gcc_assert (DECL_CONTEXT (field) == rec_type);
+
+  off = DECL_FIELD_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (off));
+
+  bit_off = DECL_FIELD_BIT_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (bit_off));
+
+  pos = TREE_INT_CST_LOW (off)
+        + (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
+  res = build_int_cstu (rtype, pos);
+  return res;
+}
+
+tree
+new_sizeof (tree atype, tree rtype)
+{
+ tree size;
+
+ size = TYPE_SIZE_UNIT (atype);
+
+ return fold (build1 (NOP_EXPR, rtype, size));
+}
+
+tree
+new_alignof (tree atype, tree rtype)
+{
+  return build_int_cstu (rtype, TYPE_ALIGN_UNIT (atype));
+}
+
+static tree
+ortho_build_addr (tree lvalue, tree atype)
+{
+  tree res;
+
+  if (TREE_CODE (lvalue) == INDIRECT_REF)
+    {
+      /* ADDR_REF(INDIRECT_REF(x)) -> x.  */
+      res = TREE_OPERAND (lvalue, 0);
+    }
+  else
+    {
+      tree ptr_type;
+
+      /* &base[off] -> base+off.  */
+      ortho_mark_addressable (lvalue);
+
+      if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+	ptr_type = build_pointer_type (TREE_TYPE (lvalue));
+      else
+	ptr_type = atype;
+      res = fold_build1 (ADDR_EXPR, ptr_type, lvalue);
+    }
+
+  if (TREE_TYPE (res) != atype)
+    res = fold_build1 (NOP_EXPR, atype, res);
+
+  return res;
+}
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+/*  Return a pointer to function FUNC. */
+static tree
+build_function_ptr (tree func)
+{
+  return build1 (ADDR_EXPR,
+		 build_pointer_type (TREE_TYPE (func)), func);
+}
+
+tree
+new_subprogram_address (tree subprg, tree atype)
+{
+  return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
+}
+
+tree
+new_value (tree lvalue)
+{
+  return lvalue;
+}
+
+void
+new_debug_line_decl (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+new_type_decl (tree ident, tree atype)
+{
+  tree decl;
+
+  TYPE_NAME (atype) = ident;
+  decl = build_decl (input_location, TYPE_DECL, ident, atype);
+  TYPE_STUB_DECL (atype) = decl;
+  pushdecl (decl);
+  /*
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+  */
+}
+
+enum o_storage { o_storage_external,
+		 o_storage_public,
+		 o_storage_private,
+		 o_storage_local };
+
+static void
+set_storage (tree Node, enum o_storage storage)
+{
+  switch (storage)
+    {
+    case o_storage_external:
+      DECL_EXTERNAL (Node) = 1;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 0;
+      break;
+    case o_storage_public:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_private:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_local:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 0;
+      break;
+    }
+}
+
+void
+new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree cst;
+
+  cst = build_decl (input_location, VAR_DECL, ident, atype);
+  set_storage (cst, storage);
+  TREE_READONLY (cst) = 1;
+  pushdecl (cst);
+  switch (storage)
+    {
+    case o_storage_local:
+      gcc_unreachable ();
+    case o_storage_external:
+      /*  We are at top level if Current_Function_Decl is null.  */
+      rest_of_decl_compilation (cst, current_function_decl == NULL_TREE, 0);
+      break;
+    case o_storage_public:
+    case o_storage_private:
+      break;
+    }
+  *res = cst;
+}
+
+void
+start_init_value (tree *decl ATTRIBUTE_UNUSED)
+{
+}
+
+void
+finish_init_value (tree *decl, tree val)
+{
+  DECL_INITIAL (*decl) = val;
+  TREE_CONSTANT (val) = 1;
+  TREE_STATIC (*decl) = 1;
+  rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0);
+}
+
+void
+new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree var;
+
+  var = build_decl (input_location, VAR_DECL, ident, atype);
+  if (current_function_decl != NULL_TREE)
+    {
+      /*  Local variable. */
+      TREE_STATIC (var) = 0;
+      DECL_EXTERNAL (var) = 0;
+      TREE_PUBLIC (var) = 0;
+    }
+  else
+    set_storage (var, storage);
+
+  pushdecl (var);
+
+  if (current_function_decl == NULL_TREE)
+    rest_of_decl_compilation (var, 1, 0);
+
+  *res = var;
+}
+
+struct GTY(()) o_inter_list
+{
+  tree ident;
+  enum o_storage storage;
+
+  /*  Return type.  */
+  tree rtype;
+
+  /*  List of parameter types.  */
+  struct list_constr_type param_list;
+
+  /*  Chain of parameters declarations.  */
+  struct chain_constr_type param_chain;
+};
+
+void
+start_function_decl (struct o_inter_list *interfaces,
+		     tree ident,
+		     enum o_storage storage,
+		     tree rtype)
+{
+  interfaces->ident = ident;
+  interfaces->storage = storage;
+  interfaces->rtype = rtype;
+  chain_init (&interfaces->param_chain);
+  list_init (&interfaces->param_list);
+}
+
+void
+start_procedure_decl (struct o_inter_list *interfaces,
+		      tree ident,
+		      enum o_storage storage)
+{
+  start_function_decl (interfaces, ident, storage, void_type_node);
+}
+
+void
+new_interface_decl (struct o_inter_list *interfaces,
+		    tree *res,
+		    tree ident,
+		    tree atype)
+{
+  tree r;
+
+  r = build_decl (input_location, PARM_DECL, ident, atype);
+  /* DECL_CONTEXT (Res, Xxx); */
+
+  /*  Do type conversion: convert boolean and enums to int  */
+  switch (TREE_CODE (atype))
+    {
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      DECL_ARG_TYPE (r) = integer_type_node;
+    default:
+      DECL_ARG_TYPE (r) = atype;
+    }
+
+  layout_decl (r, 0);
+
+  chain_append (&interfaces->param_chain, r);
+  ortho_list_append (&interfaces->param_list, atype);
+  *res = r;
+}
+
+void
+finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
+{
+  tree decl;
+  tree result;
+  tree parm;
+  int is_global;
+
+  /* Append a void type in the parameter types chain, so that the function
+     is known not be have variables arguments.  */
+  ortho_list_append (&interfaces->param_list, void_type_node);
+
+  decl = build_decl (input_location, FUNCTION_DECL, interfaces->ident,
+		     build_function_type (interfaces->rtype,
+					  interfaces->param_list.first));
+  DECL_SOURCE_LOCATION (decl) = input_location;
+
+  is_global = current_function_decl == NULL_TREE
+    || interfaces->storage == o_storage_external;
+  if (is_global)
+    set_storage (decl, interfaces->storage);
+  else
+    {
+      /*  A nested subprogram.  */
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+    }
+  /*  The function exist in static storage. */
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  TREE_ADDRESSABLE (decl) = 1;
+
+  /*  Declare the result.
+      FIXME: should be moved in start_function_body. */
+  result = build_decl (input_location,
+                       RESULT_DECL, NULL_TREE, interfaces->rtype);
+  DECL_RESULT (decl) = result;
+  DECL_CONTEXT (result) = decl;
+
+  DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
+  /* Set DECL_CONTEXT of parameters.  */
+  for (parm = interfaces->param_chain.first;
+       parm != NULL_TREE;
+       parm = TREE_CHAIN (parm))
+    DECL_CONTEXT (parm) = decl;
+
+  pushdecl (decl);
+
+  /* External functions are never nested.
+     Remove their context, which is set by pushdecl.  */
+  if (interfaces->storage == o_storage_external)
+    DECL_CONTEXT (decl) = NULL_TREE;
+
+  if (is_global)
+    rest_of_decl_compilation (decl, 1, 0);
+
+  *res = decl;
+}
+
+void
+start_subprogram_body (tree func)
+{
+  gcc_assert (current_function_decl == DECL_CONTEXT (func));
+  current_function_decl = func;
+
+  /* The function is not anymore external.  */
+  DECL_EXTERNAL (func) = 0;
+
+  push_binding (FUNCTION_BINDING);
+}
+
+void
+finish_subprogram_body (void)
+{
+  tree bind;
+  tree func;
+  tree parent;
+
+  bind = pop_binding ();
+
+  func = current_function_decl;
+
+  /* Decl initial contains the BLOCK for the function.  */
+  DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+
+  /* The saved tree is the BIND_EXPR.  */
+  DECL_SAVED_TREE (func) = bind;
+
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (func, false);
+
+  /* Store the end of the function.  */
+  cfun->function_end_locus = input_location;
+
+  parent = DECL_CONTEXT (func);
+
+  if (parent != NULL)
+    cgraph_node::get_create (func);
+  else
+    cgraph_node::finalize_function (func, false);
+
+  current_function_decl = parent;
+  set_cfun (NULL);
+}
+
+
+void
+new_debug_line_stmt (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+start_declare_stmt (void)
+{
+  push_binding (LOCAL_BINDING);
+}
+
+void
+finish_declare_stmt (void)
+{
+  tree bind;
+
+  bind = pop_binding ();
+  append_stmt (bind);
+}
+
+
+struct GTY(()) o_assoc_list
+{
+  tree subprg;
+  vec<tree, va_gc> *vecptr;
+};
+
+void
+start_association (struct o_assoc_list *assocs, tree subprg)
+{
+  assocs->subprg = subprg;
+  assocs->vecptr = NULL;
+}
+
+void
+new_association (struct o_assoc_list *assocs, tree val)
+{
+  vec_safe_push(assocs->vecptr, val);
+}
+
+tree
+new_function_call (struct o_assoc_list *assocs)
+{
+  return build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                         build_function_ptr (assocs->subprg),
+                         assocs->vecptr);
+}
+
+void
+new_procedure_call (struct o_assoc_list *assocs)
+{
+  tree res;
+
+  res = build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                        build_function_ptr (assocs->subprg),
+                        assocs->vecptr);
+  TREE_SIDE_EFFECTS (res) = 1;
+  append_stmt (res);
+}
+
+void
+new_assign_stmt (tree target, tree value)
+{
+  tree n;
+
+  n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
+  TREE_SIDE_EFFECTS (n) = 1;
+  append_stmt (n);
+}
+
+void
+new_func_return_stmt (tree value)
+{
+  tree assign;
+  tree stmt;
+  tree res;
+
+  res = DECL_RESULT (current_function_decl);
+  assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
+  TREE_SIDE_EFFECTS (assign) = 1;
+  stmt = build1 (RETURN_EXPR, void_type_node, assign);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+void
+new_proc_return_stmt (void)
+{
+  tree stmt;
+
+  stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+
+struct GTY(()) o_if_block
+{
+  /* STATEMENT_LIST containing the if.  */
+  tree prev_stmts;
+
+  /* The COND_EXPR.  */
+  tree if_stmt;
+};
+
+void
+start_if_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmt;
+  tree stmts;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  append_stmt (stmt);
+  block->prev_stmts = cur_stmts;
+  block->if_stmt = stmt;
+  cur_stmts = stmts;
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+  cur_stmts = alloc_stmt_list ();
+  COND_EXPR_ELSE (block->if_stmt) = cur_stmts;
+}
+
+void
+finish_if_stmt (struct o_if_block *block)
+{
+  cur_stmts = block->prev_stmts;
+}
+
+struct GTY(()) o_snode
+{
+  tree beg_label;
+  tree end_label;
+};
+
+/* Create an artificial label.  */
+static tree
+build_label (void)
+{
+  tree res;
+
+  res = build_decl (input_location, LABEL_DECL, NULL_TREE, void_type_node);
+  DECL_CONTEXT (res) = current_function_decl;
+  DECL_ARTIFICIAL (res) = 1;
+  return res;
+}
+
+void
+start_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  label->beg_label = build_label ();
+
+  stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
+  append_stmt (stmt);
+
+  label->end_label = build_label ();
+}
+
+void
+finish_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
+  TREE_USED (label->beg_label) = 1;
+  append_stmt (stmt);
+  /*  Emit the end label only if there is a goto to it.
+      (Return may be used to exit from the loop).  */
+  if (TREE_USED (label->end_label))
+    {
+      stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
+      append_stmt (stmt);
+    }
+}
+
+void
+new_exit_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
+  append_stmt (stmt);
+  TREE_USED (l->end_label) = 1;
+}
+
+void
+new_next_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
+  TREE_USED (l->beg_label) = 1;
+  append_stmt (stmt);
+}
+
+struct GTY(()) o_case_block
+{
+  tree prev_stmts;
+  tree case_type;
+  tree end_label;
+  int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+  tree stmt;
+  tree stmts;
+
+  block->prev_stmts = cur_stmts;
+  block->case_type = TREE_TYPE (value);
+  block->end_label = build_label ();
+  block->add_break = 0;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (SWITCH_EXPR, block->case_type, value, stmts, NULL_TREE);
+  append_stmt (stmt);
+  cur_stmts = stmts;
+}
+
+void
+start_choice (struct o_case_block *block)
+{
+  tree stmt;
+
+  if (block->add_break)
+    {
+      stmt = build1 (GOTO_EXPR, block->case_type, block->end_label);
+      append_stmt (stmt);
+
+      block->add_break = 0;
+    }
+}
+
+void
+new_expr_choice (struct o_case_block *block ATTRIBUTE_UNUSED, tree expr)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (expr, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_range_choice (struct o_case_block *block ATTRIBUTE_UNUSED,
+		  tree low, tree high)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (low, high, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_default_choice (struct o_case_block *block ATTRIBUTE_UNUSED)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (NULL_TREE, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+finish_choice (struct o_case_block *block)
+{
+  block->add_break = 1;
+}
+
+void
+finish_case_stmt (struct o_case_block *block)
+{
+  tree stmt;
+
+  cur_stmts = block->prev_stmts;
+  stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
+  append_stmt (stmt);
+}
+
+bool
+compare_identifier_string (tree id, const char *str, size_t len)
+{
+  if (IDENTIFIER_LENGTH (id) != len)
+    return false;
+  if (!memcmp (IDENTIFIER_POINTER (id), str, len))
+    return true;
+  else
+    return false;
+}
+
+void
+get_identifier_string (tree id, const char **str, int *len)
+{
+  *len = IDENTIFIER_LENGTH (id);
+  *str = IDENTIFIER_POINTER (id);
+}
+
+// C linkage wrappers for two (now C++) functions so that
+// Ada code can call them without name mangling
+tree get_identifier_with_length_c (const char *c, size_t s)
+{
+  return get_identifier_with_length(c, s);
+}
+
+int toplev_main_c (int argc, char **argv)
+{
+  toplev toplev (true, true);
+  return toplev.main(argc, argv);
+}
+
+void
+debug_tree_c (tree expr)
+{
+  warning (OPT_Wall, "Debug tree");
+  debug_tree (expr);
+}
+
+} // end extern "C"
+
+#include "debug.h"
+#include "gt-vhdl-ortho-lang.h"
+#include "gtype-vhdl.h"
diff --git a/src/ortho/gcc/ortho-lang-6.c b/src/ortho/gcc/ortho-lang-6.c
new file mode 100644
index 000000000..d2d247976
--- /dev/null
+++ b/src/ortho/gcc/ortho-lang-6.c
@@ -0,0 +1,2153 @@
+/* GCC back-end for ortho
+  Copyright (C) 2002-1014 Tristan Gingold and al.
+
+  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.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "hash-set.h"
+#include "machmode.h"
+#include "vec.h"
+#include "double-int.h"
+#include "input.h"
+#include "alias.h"
+#include "symtab.h"
+#include "wide-int.h"
+#include "inchash.h"
+#include "real.h"
+#include "tree.h"
+
+#include "bitmap.h"
+#include "hash-map.h"
+#include "is-a.h"
+#include "plugin-api.h"
+#include "hard-reg-set.h"
+#include "input.h"
+#include "function.h"
+#include "ipa-ref.h"
+#include "cgraph.h"
+
+#include "fold-const.h"
+
+#include <stddef.h>
+#include <math.h>
+
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "toplev.h"
+#include "opts.h"
+#include "options.h"
+#include "tree-iterator.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
+
+#include "print-tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
+#include "varasm.h"
+
+/* Returns the number of FIELD_DECLs in TYPE.
+   Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h.  */
+
+static int
+fields_length (const_tree type)
+{
+  tree t = TYPE_FIELDS (type);
+  int count = 0;
+
+  for (; t; t = DECL_CHAIN (t))
+    if (TREE_CODE (t) == FIELD_DECL)
+      ++count;
+
+  return count;
+}
+
+/* TODO:
+ * remove stmt_list_stack, save in if/case/loop block
+ * Re-add -v (if necessary)
+ */
+
+static tree type_for_size (unsigned int precision, int unsignedp);
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+struct GTY(()) binding_level
+{
+  /*  The BIND_EXPR node for this binding.  */
+  tree bind;
+
+  /*  The BLOCK node for this binding.  */
+  tree block;
+
+  /*  If true, stack must be saved (alloca is used).  */
+  int save_stack;
+
+  /*  Parent binding level.  */
+  struct binding_level *prev;
+
+  /*  Decls in this binding.  */
+  tree first_decl;
+  tree last_decl;
+
+  /*  Blocks in this binding.  */
+  tree first_block;
+  tree last_block;
+
+  /* Statements list containing the binding. */
+  tree prev_stmts;
+};
+
+/*  The current binding level.  */
+static GTY(()) struct binding_level *cur_binding_level = NULL;
+
+/*  Chain of unused binding levels.  */
+static GTY(()) struct binding_level *old_binding_levels = NULL;
+
+/*  Chain of statements currently generated.  */
+static GTY(()) tree cur_stmts = NULL_TREE;
+
+enum binding_kind { GLOBAL_BINDING, FUNCTION_BINDING, LOCAL_BINDING };
+
+static void
+push_binding (enum binding_kind kind)
+{
+  struct binding_level *res;
+
+  /* Get a binding level (old ones are recycled).  */
+  if (old_binding_levels == NULL)
+    res = ggc_alloc<binding_level> ();
+  else
+    {
+      res = old_binding_levels;
+      old_binding_levels = res->prev;
+    }
+
+  /* Init.  */
+  res->first_decl = NULL_TREE;
+  res->last_decl = NULL_TREE;
+
+  res->first_block = NULL_TREE;
+  res->last_block = NULL_TREE;
+
+  res->save_stack = 0;
+
+  switch (kind)
+    {
+    case GLOBAL_BINDING:
+      res->bind = NULL_TREE;
+      res->block = NULL_TREE;
+      res->prev = NULL;
+      res->prev_stmts = NULL;
+      break;
+    case FUNCTION_BINDING:
+    case LOCAL_BINDING:
+      res->block = make_node (BLOCK);
+      TREE_USED (res->block) = true;
+      res->bind = build3 (BIND_EXPR, void_type_node,
+			  NULL_TREE, NULL_TREE, res->block);
+      TREE_SIDE_EFFECTS (res->bind) = true;
+      res->prev_stmts = cur_stmts;
+      cur_stmts = alloc_stmt_list ();
+      break;
+    }
+
+  switch (kind)
+    {
+    case GLOBAL_BINDING:
+      /* No supercontext for the global binding.  */
+      break;
+    case FUNCTION_BINDING:
+      /* No containing block.  */
+      BLOCK_SUPERCONTEXT (res->block) = current_function_decl;
+      break;
+    case LOCAL_BINDING:
+      /* Append the block created.  */
+      if (cur_binding_level->first_block == NULL)
+	cur_binding_level->first_block = res->block;
+      else
+	BLOCK_CHAIN (cur_binding_level->last_block) = res->block;
+      cur_binding_level->last_block = res->block;
+
+      BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
+      break;
+    }
+
+  /* Chain previous binding, set current binding.  */
+  res->prev = cur_binding_level;
+  cur_binding_level = res;
+}
+
+static tree
+pushdecl (tree decl)
+{
+  /* Set context (always a function or NULL if top-level).  */
+  DECL_CONTEXT (decl) = current_function_decl;
+
+  /* Chain the declaration.  */
+  if (cur_binding_level->first_decl == NULL)
+    cur_binding_level->first_decl = decl;
+  else
+    TREE_CHAIN (cur_binding_level->last_decl) = decl;
+  cur_binding_level->last_decl = decl;
+
+  return decl;
+}
+
+static tree
+pop_binding (void)
+{
+  tree res;
+  struct binding_level *cur;
+
+  cur = cur_binding_level;
+  res = cur->bind;
+
+  if (cur->save_stack)
+    {
+      tree tmp_var;
+      tree save;
+      tree save_call;
+      tree restore;
+      tree t;
+
+      /* Create an artificial var to save the stack pointer.  */
+      tmp_var = build_decl (input_location, VAR_DECL, NULL, ptr_type_node);
+      DECL_ARTIFICIAL (tmp_var) = true;
+      DECL_IGNORED_P (tmp_var) = true;
+      TREE_USED (tmp_var) = true;
+      pushdecl (tmp_var);
+
+      /* Create the save stmt.  */
+      save_call = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_SAVE), 0);
+      save = build2 (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
+      TREE_SIDE_EFFECTS (save) = true;
+
+      /* Create the restore stmt.  */
+      restore = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_RESTORE), 1, tmp_var);
+
+      /* Build a try-finally block.
+	 The statement list is the block of current statements.  */
+      t = build2 (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
+      TREE_SIDE_EFFECTS (t) = true;
+
+      /* The finally block is the restore stmt.  */
+      append_to_statement_list (restore, &TREE_OPERAND (t, 1));
+
+      /* The body of the BIND_BLOCK is the save stmt, followed by the
+	 try block.  */
+      BIND_EXPR_BODY (res) = NULL_TREE;
+      append_to_statement_list (save, &BIND_EXPR_BODY (res));
+      append_to_statement_list (t, &BIND_EXPR_BODY (res));
+    }
+  else
+    {
+      /* The body of the BIND_BLOCK is the statement block.  */
+      BIND_EXPR_BODY (res) = cur_stmts;
+    }
+  BIND_EXPR_VARS (res) = cur->first_decl;
+
+  BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
+  BLOCK_VARS (cur->block) = cur->first_decl;
+
+  /* Set current statements list and current binding.  */
+  cur_stmts = cur->prev_stmts;
+  cur_binding_level = cur->prev;
+
+  /* Put removed binding to the recycle list.  */
+  cur->prev = old_binding_levels;
+  old_binding_levels = cur;
+
+  return res;
+}
+
+static void
+append_stmt (tree stmt)
+{
+  /* Set location (if not done).  */
+  if (!EXPR_HAS_LOCATION (stmt))
+    SET_EXPR_LOCATION (stmt, input_location);
+
+  TREE_SIDE_EFFECTS (stmt) = true;
+  append_to_statement_list (stmt, &cur_stmts);
+}
+
+static GTY(()) tree stack_alloc_function_ptr;
+
+static bool
+global_bindings_p (void)
+{
+  return cur_binding_level->prev == NULL;
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.  */
+static void
+define_builtin (const char *name,
+		tree type,
+		enum built_in_function code,
+		const char *library_name,
+		int attr)
+{
+  tree decl;
+
+  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+			       library_name, NULL_TREE);
+  set_call_expr_flags (decl, attr);
+
+  set_builtin_decl (code, decl, true);
+}
+
+static REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+
+static bool
+ortho_init (void)
+{
+  tree n;
+
+  input_location = BUILTINS_LOCATION;
+
+  /* Create a global binding.  Don't use push_binding, as neither a BLOCK nor
+     a BIND_EXPR are needed.  */
+  push_binding (GLOBAL_BINDING);
+
+  build_common_tree_nodes (false);
+
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("int"), integer_type_node);
+  pushdecl (n);
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("char"), char_type_node);
+  pushdecl (n);
+
+  /* Create alloca builtin.  */
+  {
+    tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
+    tree func_type = build_function_type (ptr_type_node, args_type);
+
+    define_builtin ("__builtin_alloca", func_type,
+		    BUILT_IN_ALLOCA, NULL, 0);
+
+    stack_alloc_function_ptr = build1
+      (ADDR_EXPR,
+       build_pointer_type (func_type),
+       builtin_decl_implicit (BUILT_IN_ALLOCA));
+  }
+
+  {
+    tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_stack_save", ptr_ftype,
+		    BUILT_IN_STACK_SAVE, NULL, 0);
+  }
+
+  {
+    tree ftype_ptr = build_function_type_list (void_type_node,
+					       ptr_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_stack_restore", ftype_ptr,
+		    BUILT_IN_STACK_RESTORE, NULL, 0);
+  }
+
+  {
+    tree ftype_ptr = build_function_type_list (void_type_node, NULL_TREE);
+
+    define_builtin ("__builtin_trap", ftype_ptr,
+		    BUILT_IN_TRAP, NULL, ECF_NOTHROW | ECF_LEAF);
+    TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
+  }
+
+  fp_const_m_p5 = real_value_negate (&dconsthalf);
+
+  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.
+
+  return true;
+}
+
+static void
+ortho_finish (void)
+{
+}
+
+static unsigned int
+ortho_option_lang_mask (void)
+{
+  return CL_vhdl;
+}
+
+static bool
+ortho_post_options (const char **pfilename)
+{
+  if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
+    *pfilename = "*stdin*";
+
+  /* Default hook.  */
+  lhd_post_options (pfilename);
+
+  /* Run the back-end.  */
+  return false;
+}
+
+extern "C" int lang_handle_option (const char *opt, const char *arg);
+
+static bool
+ortho_handle_option (size_t code, const char *arg,
+		     int value ATTRIBUTE_UNUSED,
+		     int kind ATTRIBUTE_UNUSED,
+                     location_t loc ATTRIBUTE_UNUSED,
+                     const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  const char *opt;
+
+  opt = cl_options[code].opt_text;
+
+  switch (code)
+    {
+    case OPT__elab:
+    case OPT_l:
+    case OPT_c:
+    case OPT__anaelab:
+      /* Only a few options have a real arguments.  */
+      return lang_handle_option (opt, arg) != 0;
+    default:
+      /* The other options must have a joint argument.  */
+      if (arg != NULL)
+	{
+	  size_t len1;
+	  size_t len2;
+	  char *nopt;
+
+	  len1 = strlen (opt);
+	  len2 = strlen (arg);
+	  nopt = (char *) alloca (len1 + len2 + 1);
+	  memcpy (nopt, opt, len1);
+	  memcpy (nopt + len1, arg, len2);
+	  nopt[len1 + len2] = 0;
+	  opt = nopt;
+	}
+      return lang_handle_option (opt, NULL) != 0;
+    }
+}
+
+extern "C" int lang_parse_file (const char *filename);
+
+static void
+ortho_parse_file (void)
+{
+  const char *filename;
+  const char *dbg_filename;
+
+  if (num_in_fnames == 0)
+    filename = NULL;
+  else
+    filename = in_fnames[0];
+
+  /* Use absolute filenames for debug info.  Works better than relative
+     filenames with some debuggers/tools.  */
+  if (filename == NULL)
+    dbg_filename = "*stdin*";
+  else if (IS_ABSOLUTE_PATH (filename))
+    dbg_filename = filename;
+  else
+    dbg_filename = concat (getpwd (), "/", filename, NULL);
+
+  linemap_add (line_table, LC_ENTER, 0, dbg_filename, 1);
+  input_location = linemap_line_start (line_table, 1, 252);
+
+  if (!lang_parse_file (filename))
+    errorcount++;
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
+}
+
+/*  Called by the back-end or by the front-end when the address of EXP
+    must be taken.
+    This function should found the base object (if any), and mark it as
+    addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+    object cannot be addressable (front-end restriction).
+    Returns TRUE in case of success, FALSE in case of failure.
+    Note that the status is never checked by the back-end.  */
+static bool
+ortho_mark_addressable (tree exp)
+{
+  tree n;
+
+  n = exp;
+
+  while (1)
+    switch (TREE_CODE (n))
+      {
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case ARRAY_RANGE_REF:
+	n = TREE_OPERAND (n, 0);
+	break;
+
+      case FUNCTION_DECL:
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case INDIRECT_REF:
+	return true;
+
+      default:
+	gcc_unreachable ();
+      }
+}
+
+static tree
+ortho_truthvalue_conversion (tree expr)
+{
+  tree expr_type;
+  tree t;
+  tree f;
+
+  expr_type = TREE_TYPE (expr);
+  if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
+    {
+      t = integer_one_node;
+      f = integer_zero_node;
+    }
+  else
+    {
+      f = TYPE_MIN_VALUE (expr_type);
+      t = TYPE_MAX_VALUE (expr_type);
+    }
+
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      /* Not 0 is true.  */
+      return integer_zerop (expr) ? f : t;
+
+    case REAL_CST:
+      return real_zerop (expr) ? f : t;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+/* The following function has been copied and modified from c-convert.c.  */
+
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+  const char *invalid_conv_diag;
+
+  if (type == error_mark_node
+      || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if ((invalid_conv_diag
+       = targetm.invalid_conversion (TREE_TYPE (expr), type)))
+    {
+      error (invalid_conv_diag);
+      return error_mark_node;
+    }
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1 (NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
+    {
+      gcc_unreachable ();
+    }
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      tree t = ortho_truthvalue_conversion (expr);
+      if (TREE_CODE (t) == ERROR_MARK)
+	return t;
+
+      /* If it returns a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (t) == NOP_EXPR)
+	return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
+      else
+	return fold_build1 (NOP_EXPR, type, t);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+
+  gcc_unreachable ();
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD BITS_PER_WORD
+#endif
+
+/*  This variable keeps a table for types for each precision so that we only
+    allocate each of them once. Signed and unsigned types are kept separate.
+ */
+static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/*  Return an integer type with the number of bits of precision given by
+    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+    it is a signed type.  */
+static tree
+type_for_size (unsigned int precision, int unsignedp)
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+  if (unsignedp)
+    t = make_unsigned_type (precision);
+  else
+    t = make_signed_type (precision);
+
+  if (precision <= MAX_BITS_PER_WORD)
+    signed_and_unsigned_types[precision][unsignedp] = t;
+
+  return t;
+}
+
+/*  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+    an unsigned type; otherwise a signed type is returned.  */
+static tree
+type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  if (SCALAR_INT_MODE_P (mode))
+    return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+
+  if (mode == TYPE_MODE (void_type_node))
+    return void_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  return NULL_TREE;
+}
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "vhdl"
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT ortho_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH ortho_finish
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK ortho_option_lang_mask
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS ortho_post_options
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
+#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE ortho_parse_file
+
+#define pushlevel lhd_do_nothing_i
+#define poplevel lhd_do_nothing_iii_return_null_tree
+#define set_block lhd_do_nothing_t
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+union GTY((desc ("0"),
+	   chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
+  lang_tree_node
+{
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+};
+
+/* GHDL does not use the lang_decl and lang_type.
+
+   FIXME: the variable_size annotation here is needed because these types are
+   variable-sized in some other front-ends.  Due to gengtype deficiency, the
+   GTY options of such types have to agree across all front-ends.  */
+
+struct GTY((variable_size)) lang_type { char dummy; };
+struct GTY((variable_size)) lang_decl { char dummy; };
+
+struct GTY(()) language_function
+{
+  char dummy;
+};
+
+
+extern "C" {
+
+struct GTY(()) chain_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+chain_init (struct chain_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+chain_append (struct chain_constr_type *constr, tree el)
+{
+  if (constr->first == NULL_TREE)
+    {
+      gcc_assert (constr->last == NULL_TREE);
+      constr->first = el;
+    }
+  else
+    TREE_CHAIN (constr->last) = el;
+  constr->last = el;
+}
+
+struct GTY(()) list_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+list_init (struct list_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+ortho_list_append (struct list_constr_type *constr, tree el)
+{
+  tree res;
+
+  res = tree_cons (NULL_TREE, el, NULL_TREE);
+  if (constr->first == NULL_TREE)
+    constr->first = res;
+  else
+    TREE_CHAIN (constr->last) = res;
+  constr->last = res;
+}
+
+enum ON_op_kind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or,
+  ON_Xor,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
+  ERROR_MARK,
+
+  PLUS_EXPR,
+  MINUS_EXPR,
+  MULT_EXPR,
+  ERROR_MARK,
+  TRUNC_MOD_EXPR,
+  FLOOR_MOD_EXPR,
+
+  BIT_AND_EXPR,
+  BIT_IOR_EXPR,
+  BIT_XOR_EXPR,
+
+  BIT_NOT_EXPR,
+  NEGATE_EXPR,
+  ABS_EXPR,
+
+  EQ_EXPR,
+  NE_EXPR,
+  LE_EXPR,
+  LT_EXPR,
+  GE_EXPR,
+  GT_EXPR,
+};
+
+tree
+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));
+
+  switch (kind)
+    {
+    case ON_Div_Ov:
+      if (TREE_CODE (left_type) == REAL_TYPE)
+	code = RDIV_EXPR;
+      else
+	code = TRUNC_DIV_EXPR;
+      break;
+    default:
+      code = ON_op_to_TREE_CODE[kind];
+      break;
+    }
+  return build2 (code, left_type, left, 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);
+}
+
+tree
+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);
+}
+
+tree
+new_convert_ov (tree val, tree rtype)
+{
+  tree val_type;
+  enum tree_code val_code;
+  enum tree_code rtype_code;
+  enum tree_code code;
+
+  val_type = TREE_TYPE (val);
+  if (val_type == rtype)
+    return val;
+
+  /*  FIXME: check conversions.  */
+  val_code = TREE_CODE (val_type);
+  rtype_code = TREE_CODE (rtype);
+  if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
+    {
+      /*  REAL to INTEGER
+          Gcc only handles FIX_TRUNC_EXPR, but we need rounding.  */
+      tree m_p5;
+      tree p5;
+      tree zero;
+      tree saved;
+      tree comp;
+      tree adj;
+      tree res;
+
+      m_p5 = build_real (val_type, fp_const_m_p5);
+      p5 = build_real (val_type, dconsthalf);
+      zero = build_real (val_type, dconst0);
+      saved = save_expr (val);
+      comp = build2 (GE_EXPR, integer_type_node, saved, zero);
+      /*  FIXME: instead of res = res + (comp ? .5 : -.5)
+	  do: res = res (comp ? + : -) .5  */
+      adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
+      res = build2 (PLUS_EXPR, val_type, saved, adj);
+      res = build1 (FIX_TRUNC_EXPR, rtype, res);
+      return res;
+    }
+  else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
+    code = FLOAT_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
+    code = NOP_EXPR;
+  else
+    gcc_unreachable ();
+
+  return build1 (code, rtype, val);
+}
+
+tree
+new_alloca (tree rtype, tree size)
+{
+  tree res;
+
+  /* Must save stack except when at function level.  */
+  if (cur_binding_level->prev != NULL
+      && cur_binding_level->prev->prev != NULL)
+    cur_binding_level->save_stack = 1;
+
+  res = build_call_nary (ptr_type_node, stack_alloc_function_ptr,
+                         1, fold_convert (size_type_node, size));
+  return fold_convert (rtype, res);
+}
+
+tree
+new_signed_literal (tree ltype, long long value)
+{
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = double_int_to_tree (ltype, double_int::from_pair (hi, lo));
+  return res;
+}
+
+tree
+new_unsigned_literal (tree ltype, unsigned long long value)
+{
+  tree res;
+  unsigned HOST_WIDE_INT lo;
+  unsigned HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = double_int_to_tree (ltype, double_int::from_pair (hi, lo));
+  return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+  tree res;
+
+  res = build_int_cst (ltype, 0);
+  return res;
+}
+
+tree
+new_float_literal (tree ltype, double value)
+{
+  signed long long s;
+  double frac;
+  int ex;
+  REAL_VALUE_TYPE r_sign;
+  REAL_VALUE_TYPE r_exp;
+  REAL_VALUE_TYPE r;
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  frac = frexp (value, &ex);
+
+  s = ldexp (frac, 60);
+  lo = s;
+  hi = (s >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  real_from_integer (&r_sign, DFmode, double_int::from_pair (hi, lo), SIGNED);
+  real_2expN (&r_exp, ex - 60, DFmode);
+  real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
+  res = build_real (ltype, r);
+  return res;
+}
+
+struct GTY(()) o_element_list
+{
+  tree res;
+  struct chain_constr_type chain;
+};
+
+void
+new_uncomplete_record_type (tree *res)
+{
+  *res = make_node (RECORD_TYPE);
+}
+
+void
+start_record_type (struct o_element_list *elements)
+{
+  elements->res = make_node (RECORD_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+start_uncomplete_record_type (tree res, struct o_element_list *elements)
+{
+  elements->res = res;
+  chain_init (&elements->chain);
+}
+
+static void
+new_record_union_field (struct o_element_list *list,
+			tree *el,
+			tree ident,
+			tree etype)
+{
+  tree res;
+
+  res = build_decl (input_location, FIELD_DECL, ident, etype);
+  DECL_CONTEXT (res) = list->res;
+  chain_append (&list->chain, res);
+  *el = res;
+}
+
+void
+new_record_field (struct o_element_list *list,
+		  tree *el,
+		  tree ident,
+		  tree etype)
+{
+  return new_record_union_field (list, el, ident, etype);
+}
+
+void
+finish_record_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+
+  if (TYPE_NAME (elements->res) != NULL_TREE)
+    {
+      /*  The type was completed.  */
+      rest_of_type_compilation (elements->res, 1);
+    }
+}
+
+void
+start_union_type (struct o_element_list *elements)
+{
+  elements->res =  make_node (UNION_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+new_union_field (struct o_element_list *elements,
+		 tree *el,
+		 tree ident,
+		 tree etype)
+{
+  return new_record_union_field (elements, el, ident, etype);
+}
+
+void
+finish_union_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+}
+
+tree
+new_unsigned_type (int size)
+{
+  return make_unsigned_type (size);
+}
+
+tree
+new_signed_type (int size)
+{
+  return make_signed_type (size);
+}
+
+tree
+new_float_type (void)
+{
+  tree res;
+
+  res = make_node (REAL_TYPE);
+  TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
+  layout_type (res);
+  return res;
+}
+
+tree
+new_access_type (tree dtype)
+{
+  tree res;
+
+  if (dtype == NULL_TREE)
+    {
+      res = make_node (POINTER_TYPE);
+      TREE_TYPE (res) = NULL_TREE;
+      /* Seems necessary.  */
+      SET_TYPE_MODE (res, Pmode);
+      layout_type (res);
+      return res;
+    }
+  else
+    return build_pointer_type (dtype);
+}
+
+void
+finish_access_type (tree atype, tree dtype)
+{
+  gcc_assert (TREE_CODE (atype) == POINTER_TYPE
+	      && TREE_TYPE (atype) == NULL_TREE);
+
+  TREE_TYPE (atype) = dtype;
+}
+
+tree
+new_array_type (tree el_type, tree index_type)
+{
+  return build_array_type (el_type, index_type);
+}
+
+
+tree
+new_constrained_array_type (tree atype, tree length)
+{
+  tree range_type;
+  tree index_type;
+  tree len;
+  tree one;
+  tree res;
+
+  index_type = TYPE_DOMAIN (atype);
+  if (integer_zerop (length))
+    {
+      /*  Handle null array, by creating a one-length array...  */
+      len = size_zero_node;
+    }
+  else
+    {
+      one = build_int_cstu (index_type, 1);
+      len = build2 (MINUS_EXPR, index_type, length, one);
+      len = fold (len);
+    }
+
+  range_type = build_range_type (index_type, size_zero_node, len);
+  res = build_array_type (TREE_TYPE (atype), range_type);
+
+  /* Constrained arrays are *always* a subtype of its array type.
+     Just copy alias set.  */
+  TYPE_ALIAS_SET (res) = get_alias_set (atype);
+  return res;
+}
+
+void
+new_boolean_type (tree *res,
+		  tree false_id ATTRIBUTE_UNUSED, tree *false_e,
+		  tree true_id ATTRIBUTE_UNUSED, tree *true_e)
+{
+  *res = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (*res) = 1;
+  fixup_unsigned_type (*res);
+  *false_e = TYPE_MIN_VALUE (*res);
+  *true_e = TYPE_MAX_VALUE (*res);
+}
+
+struct o_enum_list
+{
+  tree res;
+  struct chain_constr_type chain;
+  int num;
+  int size;
+};
+
+void
+start_enum_type (struct o_enum_list *list, int size)
+{
+  list->res = make_node (ENUMERAL_TYPE);
+  /* Set precision and sign now, as this is used to normalize literals.  */
+  TYPE_PRECISION (list->res) = size;
+  TYPE_UNSIGNED (list->res) = 1;
+  chain_init (&list->chain);
+  list->num = 0;
+  list->size = size;
+}
+
+void
+new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
+{
+  *res = build_int_cstu (list->res, (HOST_WIDE_INT)(list->num));
+  chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
+  list->num++;
+}
+
+void
+finish_enum_type (struct o_enum_list *list, tree *res)
+{
+  *res = list->res;
+  TYPE_VALUES (*res) = list->chain.first;
+  set_min_and_max_values_for_integral_type (*res, list->size, UNSIGNED);
+  layout_type (*res);
+}
+
+struct GTY(()) o_record_aggr_list
+{
+  /* Type of the record.  */
+  tree atype;
+  /* Type of the next field to be added.  */
+  tree field;
+  /* Vector of elements.  */
+  // VEC(constructor_elt,gc) *elts;
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_record_aggr (struct o_record_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  list->field = TYPE_FIELDS (atype);
+  //list->elts = VEC_alloc (constructor_elt, gc, fields_length (atype));
+  vec_alloc(list->elts, fields_length (atype));
+}
+
+void
+new_record_aggr_el (struct o_record_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, list->field, value);
+  list->field = TREE_CHAIN (list->field);
+}
+
+void
+finish_record_aggr (struct o_record_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+struct GTY(()) o_array_aggr_list
+{
+  tree atype;
+  /* Vector of elements.  */
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_array_aggr (struct o_array_aggr_list *list, tree atype)
+{
+  tree nelts;
+  unsigned HOST_WIDE_INT n;
+
+  list->atype = atype;
+  list->elts = NULL;
+
+  nelts = array_type_nelts (atype);
+  gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts));
+
+  n = tree_to_uhwi (nelts) + 1;
+  vec_alloc(list->elts, n);
+}
+
+void
+new_array_aggr_el (struct o_array_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, NULL_TREE, value);
+}
+
+void
+finish_array_aggr (struct o_array_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+tree
+new_union_aggr (tree atype, tree field, tree value)
+{
+  tree res;
+
+  res = build_constructor_single (atype, field, value);
+  TREE_CONSTANT (res) = 1;
+  return res;
+}
+
+tree
+new_default_value (tree atype)
+{
+  return build_constructor (atype, NULL);
+}
+
+tree
+new_indexed_element (tree arr, tree index)
+{
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
+		 arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_slice (tree arr, tree res_type, tree index)
+{
+  gcc_assert (TREE_CODE (res_type) == ARRAY_TYPE);
+
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+  tree res;
+
+  gcc_assert (RECORD_OR_UNION_TYPE_P (TREE_TYPE (rec)));
+
+  res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
+  return res;
+}
+
+tree
+new_access_element (tree acc)
+{
+  tree acc_type;
+
+  acc_type = TREE_TYPE (acc);
+  gcc_assert (TREE_CODE (acc_type) == POINTER_TYPE);
+
+  return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
+}
+
+tree
+new_offsetof (tree rec_type, tree field, tree rtype)
+{
+  tree off;
+  tree bit_off;
+  HOST_WIDE_INT pos;
+  tree res;
+
+  gcc_assert (DECL_CONTEXT (field) == rec_type);
+
+  off = DECL_FIELD_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (off));
+
+  bit_off = DECL_FIELD_BIT_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (bit_off));
+
+  pos = TREE_INT_CST_LOW (off)
+        + (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
+  res = build_int_cstu (rtype, pos);
+  return res;
+}
+
+tree
+new_sizeof (tree atype, tree rtype)
+{
+ tree size;
+
+ size = TYPE_SIZE_UNIT (atype);
+
+ return fold (build1 (NOP_EXPR, rtype, size));
+}
+
+tree
+new_alignof (tree atype, tree rtype)
+{
+  return build_int_cstu (rtype, TYPE_ALIGN_UNIT (atype));
+}
+
+static tree
+ortho_build_addr (tree lvalue, tree atype)
+{
+  tree res;
+
+  if (TREE_CODE (lvalue) == INDIRECT_REF)
+    {
+      /* ADDR_REF(INDIRECT_REF(x)) -> x.  */
+      res = TREE_OPERAND (lvalue, 0);
+    }
+  else
+    {
+      tree ptr_type;
+
+      /* &base[off] -> base+off.  */
+      ortho_mark_addressable (lvalue);
+
+      if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+	ptr_type = build_pointer_type (TREE_TYPE (lvalue));
+      else
+	ptr_type = atype;
+      res = fold_build1 (ADDR_EXPR, ptr_type, lvalue);
+    }
+
+  if (TREE_TYPE (res) != atype)
+    res = fold_build1 (NOP_EXPR, atype, res);
+
+  return res;
+}
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+/*  Return a pointer to function FUNC. */
+static tree
+build_function_ptr (tree func)
+{
+  return build1 (ADDR_EXPR,
+		 build_pointer_type (TREE_TYPE (func)), func);
+}
+
+tree
+new_subprogram_address (tree subprg, tree atype)
+{
+  return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
+}
+
+tree
+new_value (tree lvalue)
+{
+  return lvalue;
+}
+
+void
+new_debug_line_decl (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+new_type_decl (tree ident, tree atype)
+{
+  tree decl;
+
+  TYPE_NAME (atype) = ident;
+  decl = build_decl (input_location, TYPE_DECL, ident, atype);
+  TYPE_STUB_DECL (atype) = decl;
+  pushdecl (decl);
+  /*
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+  */
+}
+
+enum o_storage { o_storage_external,
+		 o_storage_public,
+		 o_storage_private,
+		 o_storage_local };
+
+static void
+set_storage (tree Node, enum o_storage storage)
+{
+  switch (storage)
+    {
+    case o_storage_external:
+      DECL_EXTERNAL (Node) = 1;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 0;
+      break;
+    case o_storage_public:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_private:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_local:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 0;
+      break;
+    }
+}
+
+void
+new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree cst;
+
+  cst = build_decl (input_location, VAR_DECL, ident, atype);
+  set_storage (cst, storage);
+  TREE_READONLY (cst) = 1;
+  pushdecl (cst);
+  switch (storage)
+    {
+    case o_storage_local:
+      gcc_unreachable ();
+    case o_storage_external:
+      /*  We are at top level if Current_Function_Decl is null.  */
+      rest_of_decl_compilation (cst, current_function_decl == NULL_TREE, 0);
+      break;
+    case o_storage_public:
+    case o_storage_private:
+      break;
+    }
+  *res = cst;
+}
+
+void
+start_init_value (tree *decl ATTRIBUTE_UNUSED)
+{
+}
+
+void
+finish_init_value (tree *decl, tree val)
+{
+  DECL_INITIAL (*decl) = val;
+  TREE_CONSTANT (val) = 1;
+  TREE_STATIC (*decl) = 1;
+  rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0);
+}
+
+void
+new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree var;
+
+  var = build_decl (input_location, VAR_DECL, ident, atype);
+  if (current_function_decl != NULL_TREE)
+    {
+      /*  Local variable. */
+      TREE_STATIC (var) = 0;
+      DECL_EXTERNAL (var) = 0;
+      TREE_PUBLIC (var) = 0;
+    }
+  else
+    set_storage (var, storage);
+
+  pushdecl (var);
+
+  if (current_function_decl == NULL_TREE)
+    rest_of_decl_compilation (var, 1, 0);
+
+  *res = var;
+}
+
+struct GTY(()) o_inter_list
+{
+  tree ident;
+  enum o_storage storage;
+
+  /*  Return type.  */
+  tree rtype;
+
+  /*  List of parameter types.  */
+  struct list_constr_type param_list;
+
+  /*  Chain of parameters declarations.  */
+  struct chain_constr_type param_chain;
+};
+
+void
+start_function_decl (struct o_inter_list *interfaces,
+		     tree ident,
+		     enum o_storage storage,
+		     tree rtype)
+{
+  interfaces->ident = ident;
+  interfaces->storage = storage;
+  interfaces->rtype = rtype;
+  chain_init (&interfaces->param_chain);
+  list_init (&interfaces->param_list);
+}
+
+void
+start_procedure_decl (struct o_inter_list *interfaces,
+		      tree ident,
+		      enum o_storage storage)
+{
+  start_function_decl (interfaces, ident, storage, void_type_node);
+}
+
+void
+new_interface_decl (struct o_inter_list *interfaces,
+		    tree *res,
+		    tree ident,
+		    tree atype)
+{
+  tree r;
+
+  r = build_decl (input_location, PARM_DECL, ident, atype);
+  /* DECL_CONTEXT (Res, Xxx); */
+
+  /*  Do type conversion: convert boolean and enums to int  */
+  switch (TREE_CODE (atype))
+    {
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      DECL_ARG_TYPE (r) = integer_type_node;
+    default:
+      DECL_ARG_TYPE (r) = atype;
+    }
+
+  layout_decl (r, 0);
+
+  chain_append (&interfaces->param_chain, r);
+  ortho_list_append (&interfaces->param_list, atype);
+  *res = r;
+}
+
+void
+finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
+{
+  tree decl;
+  tree result;
+  tree parm;
+  int is_global;
+
+  /* Append a void type in the parameter types chain, so that the function
+     is known not be have variables arguments.  */
+  ortho_list_append (&interfaces->param_list, void_type_node);
+
+  decl = build_decl (input_location, FUNCTION_DECL, interfaces->ident,
+		     build_function_type (interfaces->rtype,
+					  interfaces->param_list.first));
+  DECL_SOURCE_LOCATION (decl) = input_location;
+
+  is_global = current_function_decl == NULL_TREE
+    || interfaces->storage == o_storage_external;
+  if (is_global)
+    set_storage (decl, interfaces->storage);
+  else
+    {
+      /*  A nested subprogram.  */
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+    }
+  /*  The function exist in static storage. */
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  TREE_ADDRESSABLE (decl) = 1;
+
+  /*  Declare the result.
+      FIXME: should be moved in start_function_body. */
+  result = build_decl (input_location,
+                       RESULT_DECL, NULL_TREE, interfaces->rtype);
+  DECL_RESULT (decl) = result;
+  DECL_CONTEXT (result) = decl;
+
+  DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
+  /* Set DECL_CONTEXT of parameters.  */
+  for (parm = interfaces->param_chain.first;
+       parm != NULL_TREE;
+       parm = TREE_CHAIN (parm))
+    DECL_CONTEXT (parm) = decl;
+
+  pushdecl (decl);
+
+  /* External functions are never nested.
+     Remove their context, which is set by pushdecl.  */
+  if (interfaces->storage == o_storage_external)
+    DECL_CONTEXT (decl) = NULL_TREE;
+
+  if (is_global)
+    rest_of_decl_compilation (decl, 1, 0);
+
+  *res = decl;
+}
+
+void
+start_subprogram_body (tree func)
+{
+  gcc_assert (current_function_decl == DECL_CONTEXT (func));
+  current_function_decl = func;
+
+  /* The function is not anymore external.  */
+  DECL_EXTERNAL (func) = 0;
+
+  push_binding (FUNCTION_BINDING);
+}
+
+void
+finish_subprogram_body (void)
+{
+  tree bind;
+  tree func;
+  tree parent;
+
+  bind = pop_binding ();
+
+  func = current_function_decl;
+
+  /* Decl initial contains the BLOCK for the function.  */
+  DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+
+  /* The saved tree is the BIND_EXPR.  */
+  DECL_SAVED_TREE (func) = bind;
+
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (func, false);
+
+  /* Store the end of the function.  */
+  cfun->function_end_locus = input_location;
+
+  parent = DECL_CONTEXT (func);
+
+  if (parent != NULL)
+    cgraph_node::get_create (func);
+  else
+    cgraph_node::finalize_function (func, false);
+
+  current_function_decl = parent;
+  set_cfun (NULL);
+}
+
+
+void
+new_debug_line_stmt (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+start_declare_stmt (void)
+{
+  push_binding (LOCAL_BINDING);
+}
+
+void
+finish_declare_stmt (void)
+{
+  tree bind;
+
+  bind = pop_binding ();
+  append_stmt (bind);
+}
+
+
+struct GTY(()) o_assoc_list
+{
+  tree subprg;
+  vec<tree, va_gc> *vecptr;
+};
+
+void
+start_association (struct o_assoc_list *assocs, tree subprg)
+{
+  assocs->subprg = subprg;
+  assocs->vecptr = NULL;
+}
+
+void
+new_association (struct o_assoc_list *assocs, tree val)
+{
+  vec_safe_push(assocs->vecptr, val);
+}
+
+tree
+new_function_call (struct o_assoc_list *assocs)
+{
+  return build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                         build_function_ptr (assocs->subprg),
+                         assocs->vecptr);
+}
+
+void
+new_procedure_call (struct o_assoc_list *assocs)
+{
+  tree res;
+
+  res = build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                        build_function_ptr (assocs->subprg),
+                        assocs->vecptr);
+  TREE_SIDE_EFFECTS (res) = 1;
+  append_stmt (res);
+}
+
+void
+new_assign_stmt (tree target, tree value)
+{
+  tree n;
+
+  n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
+  TREE_SIDE_EFFECTS (n) = 1;
+  append_stmt (n);
+}
+
+void
+new_func_return_stmt (tree value)
+{
+  tree assign;
+  tree stmt;
+  tree res;
+
+  res = DECL_RESULT (current_function_decl);
+  assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
+  TREE_SIDE_EFFECTS (assign) = 1;
+  stmt = build1 (RETURN_EXPR, void_type_node, assign);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+void
+new_proc_return_stmt (void)
+{
+  tree stmt;
+
+  stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+
+struct GTY(()) o_if_block
+{
+  /* STATEMENT_LIST containing the if.  */
+  tree prev_stmts;
+
+  /* The COND_EXPR.  */
+  tree if_stmt;
+};
+
+void
+start_if_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmt;
+  tree stmts;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  append_stmt (stmt);
+  block->prev_stmts = cur_stmts;
+  block->if_stmt = stmt;
+  cur_stmts = stmts;
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+  cur_stmts = alloc_stmt_list ();
+  COND_EXPR_ELSE (block->if_stmt) = cur_stmts;
+}
+
+void
+finish_if_stmt (struct o_if_block *block)
+{
+  cur_stmts = block->prev_stmts;
+}
+
+struct GTY(()) o_snode
+{
+  tree beg_label;
+  tree end_label;
+};
+
+/* Create an artificial label.  */
+static tree
+build_label (void)
+{
+  tree res;
+
+  res = build_decl (input_location, LABEL_DECL, NULL_TREE, void_type_node);
+  DECL_CONTEXT (res) = current_function_decl;
+  DECL_ARTIFICIAL (res) = 1;
+  return res;
+}
+
+void
+start_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  label->beg_label = build_label ();
+
+  stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
+  append_stmt (stmt);
+
+  label->end_label = build_label ();
+}
+
+void
+finish_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
+  TREE_USED (label->beg_label) = 1;
+  append_stmt (stmt);
+  /*  Emit the end label only if there is a goto to it.
+      (Return may be used to exit from the loop).  */
+  if (TREE_USED (label->end_label))
+    {
+      stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
+      append_stmt (stmt);
+    }
+}
+
+void
+new_exit_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
+  append_stmt (stmt);
+  TREE_USED (l->end_label) = 1;
+}
+
+void
+new_next_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
+  TREE_USED (l->beg_label) = 1;
+  append_stmt (stmt);
+}
+
+struct GTY(()) o_case_block
+{
+  tree prev_stmts;
+  tree case_type;
+  tree end_label;
+  int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+  tree stmt;
+  tree stmts;
+
+  block->prev_stmts = cur_stmts;
+  block->case_type = TREE_TYPE (value);
+  block->end_label = build_label ();
+  block->add_break = 0;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (SWITCH_EXPR, block->case_type, value, stmts, NULL_TREE);
+  append_stmt (stmt);
+  cur_stmts = stmts;
+}
+
+void
+start_choice (struct o_case_block *block)
+{
+  tree stmt;
+
+  if (block->add_break)
+    {
+      stmt = build1 (GOTO_EXPR, block->case_type, block->end_label);
+      append_stmt (stmt);
+
+      block->add_break = 0;
+    }
+}
+
+void
+new_expr_choice (struct o_case_block *block ATTRIBUTE_UNUSED, tree expr)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (expr, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_range_choice (struct o_case_block *block ATTRIBUTE_UNUSED,
+		  tree low, tree high)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (low, high, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_default_choice (struct o_case_block *block ATTRIBUTE_UNUSED)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (NULL_TREE, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+finish_choice (struct o_case_block *block)
+{
+  block->add_break = 1;
+}
+
+void
+finish_case_stmt (struct o_case_block *block)
+{
+  tree stmt;
+
+  cur_stmts = block->prev_stmts;
+  stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
+  append_stmt (stmt);
+}
+
+bool
+compare_identifier_string (tree id, const char *str, size_t len)
+{
+  if (IDENTIFIER_LENGTH (id) != len)
+    return false;
+  if (!memcmp (IDENTIFIER_POINTER (id), str, len))
+    return true;
+  else
+    return false;
+}
+
+void
+get_identifier_string (tree id, const char **str, int *len)
+{
+  *len = IDENTIFIER_LENGTH (id);
+  *str = IDENTIFIER_POINTER (id);
+}
+
+// C linkage wrappers for two (now C++) functions so that
+// Ada code can call them without name mangling
+tree get_identifier_with_length_c (const char *c, size_t s)
+{
+  return get_identifier_with_length(c, s);
+}
+
+int toplev_main_c (int argc, char **argv)
+{
+  toplev toplev (NULL, true);
+  return toplev.main(argc, argv);
+}
+
+void
+debug_tree_c (tree expr)
+{
+  warning (OPT_Wall, "Debug tree");
+  debug_tree (expr);
+}
+
+} // end extern "C"
+
+#include "debug.h"
+#include "gt-vhdl-ortho-lang.h"
+#include "gtype-vhdl.h"