summaryrefslogtreecommitdiff
path: root/src/ortho/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'src/ortho/gcc')
-rw-r--r--src/ortho/gcc/Makefile86
-rw-r--r--src/ortho/gcc/Makefile.conf.linux4
-rw-r--r--src/ortho/gcc/lang.opt96
-rw-r--r--src/ortho/gcc/ortho-lang.c2191
-rw-r--r--src/ortho/gcc/ortho_gcc-main.adb42
-rw-r--r--src/ortho/gcc/ortho_gcc-main.ads1
-rw-r--r--src/ortho/gcc/ortho_gcc.adb121
-rw-r--r--src/ortho/gcc/ortho_gcc.ads701
-rw-r--r--src/ortho/gcc/ortho_gcc.private.ads269
-rw-r--r--src/ortho/gcc/ortho_gcc_front.ads2
-rw-r--r--src/ortho/gcc/ortho_ident.adb56
-rw-r--r--src/ortho/gcc/ortho_ident.ads30
-rw-r--r--src/ortho/gcc/ortho_nodes.ads3
13 files changed, 3602 insertions, 0 deletions
diff --git a/src/ortho/gcc/Makefile b/src/ortho/gcc/Makefile
new file mode 100644
index 0000000..5aafb31
--- /dev/null
+++ b/src/ortho/gcc/Makefile
@@ -0,0 +1,86 @@
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_objdir=.
+agcc_srcdir=$(ortho_srcdir)/gcc
+SED=sed
+BE=gcc
+GNATMAKE=gnatmake
+CC=gcc
+CXX=g++
+COMPILER=$(CXX)
+LINKER=$(CXX)
+
+# Modify AGCC_GCCSRC_DIR and AGCC_GCCOBJ_DIR for your environment
+AGCC_GCCSRC_DIR:=$(HOME)/Projects/gcc4.9.2/source/gcc-4.9.2/
+AGCC_GCCOBJ_DIR:=$(HOME)/Projects/gcc4.9.2/build/
+
+# Supplied by main GCC Makefile, copied here for compatibility with same
+GMPLIBS = -L$(AGCC_GCCOBJ_DIR)./gmp/.libs -L$(AGCC_GCCOBJ_DIR)./mpfr/.libs \
+ -L$(AGCC_GCCOBJ_DIR)./mpc/src/.libs -lmpc -lmpfr -lgmp
+GMPINC = -I$(AGCC_GCCOBJ_DIR)./gmp -I$(AGCC_GCCSRC_DIR)/gmp \
+ -I$(AGCC_GCCOBJ_DIR)./mpfr -I$(AGCC_GCCSRC_DIR)/mpfr \
+ -I$(AGCC_GCCSRC_DIR)/mpc/src
+
+HOST_LIBS =
+ZLIB=-lz
+
+# Override variables in Makefile.conf for your environment
+-include $(orthobe_srcdir)/Makefile.conf
+
+all: $(ortho_exec)
+
+ORTHO_BASENAME=ortho_gcc
+include $(ortho_srcdir)/Makefile.inc
+
+AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
+ -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \
+ -I$(AGCC_GCCSRC_DIR)/libcpp/include $(GMPINC)
+AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
+
+ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
+ $(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
+ $(COMPILER) -c -o $@ $< $(AGCC_CFLAGS) $(INCLUDES)
+
+AGCC_LOCAL_OBJS=ortho-lang.o
+
+AGCC_DEPS := $(AGCC_LOCAL_OBJS)
+AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
+ $(AGCC_GCCOBJ_DIR)gcc/attribs.o \
+ $(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \
+ $(AGCC_GCCOBJ_DIR)libiberty/libiberty.a
+
+LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a
+LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a
+LIBIBERTY = $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+CPPLIB= # Not needed for GHDL
+
+BACKEND = $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
+ $(AGCC_GCCOBJ_DIR)/gcc/libcommon-target.a
+
+BACKENDLIBS = $(CLOOGLIBS) $(GMPLIBS) $(PLUGINLIBS) $(HOST_LIBS) \
+ $(ZLIB)
+LIBS = $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \
+ $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \
+ $(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS)
+
+$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force
+ $(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \
+ -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
+ -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \
+ $(BACKEND) $(LIBS) $(BACKENDLIBS)
+
+agcc-clean: force
+ $(RM) -f $(agcc_objdir)/*.o
+ $(RM) -f $(agcc_srcdir)/*~
+
+clean: agcc-clean
+ $(RM) -f *.o *.ali ortho_nodes-main
+ $(RM) b~*.ad? *~
+
+distclean: clean agcc-clean
+
+
+force:
+
+.PHONY: force all clean agcc-clean
diff --git a/src/ortho/gcc/Makefile.conf.linux b/src/ortho/gcc/Makefile.conf.linux
new file mode 100644
index 0000000..00ea917
--- /dev/null
+++ b/src/ortho/gcc/Makefile.conf.linux
@@ -0,0 +1,4 @@
+# Example Makefile.conf
+# Copy this file to Makefile.conf and edit as necessary for your platform
+
+HOST_LIBS = -ldl -lstdc++
diff --git a/src/ortho/gcc/lang.opt b/src/ortho/gcc/lang.opt
new file mode 100644
index 0000000..562fbe0
--- /dev/null
+++ b/src/ortho/gcc/lang.opt
@@ -0,0 +1,96 @@
+Language
+vhdl
+
+-std=
+vhdl Joined
+Select the vhdl standard
+
+-compile-standard
+vhdl
+Used during compiler build to compile the std.standard package
+
+-bootstrap
+vhdl
+Used during compiler build to compile std packages
+
+-work=
+vhdl Joined
+Set the name of the work library
+
+-workdir=
+vhdl Joined
+Set the directory of the work library
+
+P
+vhdl JoinedOrMissing
+;-P<dir> Add <dir> to the end of the vhdl library path
+
+-elab
+vhdl Separate
+--elab <name> Used internally during elaboration of <name>
+
+-anaelab
+vhdl Separate
+--anaelab <name> Used internally during elaboration of <name>
+
+; -c is a driver option for gcc. --ghdl-source is used instead.
+;c
+;vhdl Separate
+;-c <filename> Analyze <filename> for --anaelab
+
+;v
+;vhdl
+;Verbose
+
+-warn-
+vhdl Joined
+--warn-<name> Warn about <name>
+
+-ghdl
+vhdl Joined
+--ghdl-<option> Pass <option> to vhdl front-end
+
+-expect-failure
+vhdl
+Expect a compiler error (used for testsuite)
+
+-no-vital-checks
+vhdl
+Disable VITAL checks
+
+-vital-checks
+vhdl
+Enable VITAL checks
+
+fexplicit
+vhdl
+Explicit function declarations override implicit one in use
+
+frelaxed-rules
+vhdl
+Relax some LRM rules to compile vendor libraries
+
+fpsl
+vhdl
+Allow PSL asserts in comments
+
+-no-direct-drivers
+vhdl
+Disable direct drivers optimization
+
+-syn-binding
+vhdl
+Use synthetizer rules for default bindings
+
+l
+vhdl Joined Separate
+-l<filename> Put list of files for link in <filename>
+
+; -C was commented out, as it is already defined for C/C++.
+;C
+;vhdl
+;Allow any character in comments
+
+-mb-comments
+vhdl
+Allow any character in comments
diff --git a/src/ortho/gcc/ortho-lang.c b/src/ortho/gcc/ortho-lang.c
new file mode 100644
index 0000000..c19012e
--- /dev/null
+++ b/src/ortho/gcc/ortho-lang.c
@@ -0,0 +1,2191 @@
+/* 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 <stddef.h>
+#include <math.h>
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.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 "real.h"
+#include "tree-iterator.h"
+#include "function.h"
+#include "cgraph.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
+
+/* Undefine for gcc-4.8 */
+#define GCC49
+
+#ifdef GCC49
+
+#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;
+}
+
+#else
+
+// adapt gcc4.9 practice to gcc4.8 functions
+bool
+tree_fits_uhwi_p (const_tree t)
+{
+ return host_integerp (t, 1);
+}
+
+unsigned HOST_WIDE_INT
+tree_to_uhwi (const_tree t)
+{
+ return tree_low_cst (t, 1);
+}
+
+#endif
+
+/* 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;
+};
+
+/* 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;
+
+static void
+push_binding (void)
+{
+ struct binding_level *res;
+
+ 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;
+
+ res->bind = make_node (BIND_EXPR);
+ res->block = make_node (BLOCK);
+ BIND_EXPR_BLOCK (res->bind) = res->block;
+ TREE_SIDE_EFFECTS (res->bind) = true;
+ TREE_TYPE (res->bind) = void_type_node;
+ TREE_USED (res->block) = true;
+
+ if (cur_binding_level != NULL)
+ {
+ /* 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;
+ }
+
+ res->prev = cur_binding_level;
+ cur_binding_level = res;
+}
+
+static void
+push_decl (tree decl)
+{
+ DECL_CONTEXT (decl) = current_function_decl;
+
+ 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;
+}
+
+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;
+ push_decl (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;
+
+ cur_binding_level = cur->prev;
+ cur->prev = old_binding_levels;
+ old_binding_levels = cur;
+
+ return res;
+}
+
+// naive conversion to new vec API following the wiki at
+// http://gcc.gnu.org/wiki/cxx-conversion/cxx-vec
+// see also push_stmts, pop_stmts
+static vec <tree> stmt_list_stack = vec<tree>();
+
+static void
+push_stmts (tree stmts)
+{
+ stmt_list_stack.safe_push(cur_stmts);
+ cur_stmts = stmts;
+}
+
+static void
+pop_stmts (void)
+{
+ cur_stmts = stmt_list_stack.pop();
+}
+
+static void
+append_stmt (tree stmt)
+{
+ 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 top;
+
+static GTY(()) tree stack_alloc_function_ptr;
+
+static bool
+global_bindings_p (void)
+{
+ return cur_binding_level->prev == NULL;
+}
+
+static tree
+pushdecl (tree t)
+{
+ //gcc_unreachable ();
+ // gcc4.8.2 we get here from build_common_builtin_nodes () call in ortho_init
+ return t;
+}
+
+static tree
+builtin_function (const char *name,
+ tree type,
+ int function_code,
+ enum built_in_class decl_class,
+ const char *library_name,
+ tree attrs ATTRIBUTE_UNUSED);
+
+REAL_VALUE_TYPE fp_const_p5; /* 0.5 */
+REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+REAL_VALUE_TYPE fp_const_zero; /* 0.0 */
+
+static bool
+ortho_init (void)
+{
+ tree n;
+
+ input_location = BUILTINS_LOCATION;
+
+ /* Create a global binding. */
+ push_binding ();
+
+ build_common_tree_nodes (0, 0);
+
+ n = build_decl (input_location,
+ TYPE_DECL, get_identifier ("int"), integer_type_node);
+ push_decl (n);
+ n = build_decl (input_location,
+ TYPE_DECL, get_identifier ("char"), char_type_node);
+ push_decl (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);
+
+ set_builtin_decl
+ (BUILT_IN_ALLOCA,
+ builtin_function
+ ("__builtin_alloca", func_type,
+ BUILT_IN_ALLOCA, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+
+ 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);
+
+ set_builtin_decl
+ (BUILT_IN_STACK_SAVE,
+ builtin_function
+ ("__builtin_stack_save", ptr_ftype,
+ BUILT_IN_STACK_SAVE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+ }
+
+ {
+ tree ftype_ptr;
+
+ ftype_ptr = build_function_type
+ (void_type_node,
+ tree_cons (NULL_TREE, ptr_type_node, NULL_TREE));
+
+ set_builtin_decl
+ (BUILT_IN_STACK_RESTORE,
+ builtin_function
+ ("__builtin_stack_restore", ftype_ptr,
+ BUILT_IN_STACK_RESTORE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+ }
+ {
+ REAL_VALUE_TYPE v;
+
+ REAL_VALUE_FROM_INT (v, 1, 0, DFmode);
+ real_ldexp (&fp_const_p5, &v, -1);
+
+ REAL_VALUE_FROM_INT (v, -1, -1, DFmode);
+ real_ldexp (&fp_const_m_p5, &v, -1);
+
+ REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
+ }
+
+ 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);
+
+ // This stops compile failures writing debug information when both -g and -O2
+ // (or -O1, -O3 or -Os) options are present.
+ // Should really make it conditional on specific options
+ // FIXME : re-evaluate if this is still necessary with newer gccrevisions
+ dwarf_strict = 1;
+
+ /* 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;
+
+ if (num_in_fnames == 0)
+ filename = NULL;
+ else
+ filename = in_fnames[0];
+
+ linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 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 ();
+}
+
+/* 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.
+
+ If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+ the name to be called if we can't opencode the function. If
+ ATTRS is nonzero, use that for the function's attribute list. */
+static tree
+builtin_function (const char *name,
+ tree type,
+ int function_code,
+ enum built_in_class decl_class,
+ const char *library_name,
+ tree attrs ATTRIBUTE_UNUSED)
+{
+ tree decl = build_decl (input_location,
+ FUNCTION_DECL, get_identifier (name), type);
+ DECL_EXTERNAL (decl) = 1;
+ TREE_PUBLIC (decl) = 1;
+ if (library_name)
+ SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+ make_decl_rtl (decl);
+ DECL_BUILT_IN_CLASS (decl) = decl_class;
+ DECL_FUNCTION_CODE (decl) = (built_in_function) function_code;
+ DECL_SOURCE_LOCATION (decl) = input_location;
+ return decl;
+}
+
+#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_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE signed_type
+#undef LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
+#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
+#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, fp_const_p5);
+ zero = build_real (val_type, fp_const_zero);
+ 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 = build_int_cst_wide (ltype, lo, hi);
+ 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 = build_int_cst_wide (ltype, lo, hi);
+ return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+ tree res;
+
+ res = build_int_cst_wide (ltype, 0, 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);
+ res = build_int_cst_wide (long_integer_type_node, lo, hi);
+ REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
+ 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);
+ // as of gcc4.8, TYPE_PRECISION of 0 is rigorously enforced!
+ TYPE_PRECISION(list->res) = size;
+ 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;
+ TYPE_UNSIGNED (*res) = 1;
+ TYPE_PRECISION (*res) = list->size;
+ set_min_and_max_values_for_integral_type (*res, list->size, 1);
+ 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_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)
+{
+#if 0
+ tree res;
+ tree el_ptr_type;
+ tree el_type;
+ tree res_ptr_type;
+#endif
+
+ /* *((RES_TYPE *)(&ARR[INDEX]))
+ convert ARR to a pointer, add index, and reconvert to array ? */
+ 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);
+#if 0
+ el_type = TREE_TYPE (TREE_TYPE (arr));
+ el_ptr_type = build_pointer_type (el_type);
+
+ res = build4 (ARRAY_REF, el_type, arr, index, NULL_TREE, NULL_TREE);
+ res = build1 (ADDR_EXPR, el_ptr_type, res);
+ res_ptr_type = build_pointer_type (res_type);
+ res = build1 (NOP_EXPR, res_ptr_type, res);
+ res = build1 (INDIRECT_REF, res_type, res);
+ return res;
+#endif
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+ tree res;
+
+ gcc_assert (TREE_CODE (TREE_TYPE (rec)) == RECORD_TYPE);
+
+ 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;
+ push_decl (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;
+ push_decl (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_const_value (tree *cst ATTRIBUTE_UNUSED)
+{
+}
+
+void
+finish_const_value (tree *cst, tree val)
+{
+ DECL_INITIAL (*cst) = val;
+ TREE_CONSTANT (val) = 1;
+ TREE_STATIC (*cst) = 1;
+ rest_of_decl_compilation
+ (*cst, 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);
+
+ push_decl (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;
+
+ push_decl (decl);
+
+ /* External functions are never nested.
+ Remove their context, which is set by push_decl. */
+ 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_stmts (alloc_stmt_list ());
+ push_binding ();
+}
+
+void
+finish_subprogram_body (void)
+{
+ tree bind;
+ tree func;
+ tree parent;
+
+ bind = pop_binding ();
+ pop_stmts ();
+
+ func = current_function_decl;
+ DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+ 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_get_create_node (func);
+ else
+ cgraph_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_stmts (alloc_stmt_list ());
+ push_binding ();
+}
+
+void
+finish_declare_stmt (void)
+{
+ tree bind;
+
+ bind = pop_binding ();
+ pop_stmts ();
+ 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
+{
+ tree 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);
+ block->stmt = stmt;
+ append_stmt (stmt);
+ push_stmts (stmts);
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+ tree stmts;
+
+ pop_stmts ();
+ stmts = alloc_stmt_list ();
+ COND_EXPR_ELSE (block->stmt) = stmts;
+ push_stmts (stmts);
+}
+
+void
+finish_if_stmt (struct o_if_block *block ATTRIBUTE_UNUSED)
+{
+ pop_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 case_type;
+ tree end_label;
+ int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+ tree stmt;
+ tree 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);
+ push_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;
+
+ pop_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)
+{
+ 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_gcc-main.adb b/src/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 0000000..70c8a7f
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,42 @@
+-- GCC back-end for ortho
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with System;
+with Ortho_Gcc_Front;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+ gnat_argc : Integer;
+ gnat_argv : System.Address;
+
+ pragma Import (C, gnat_argc);
+ pragma Import (C, gnat_argv);
+
+ function Toplev_Main (Argc : Integer; Argv : System.Address)
+ return Integer;
+ pragma Import (C, Toplev_Main, "toplev_main_c");
+
+ Status : Exit_Status;
+begin
+ Ortho_Gcc_Front.Init;
+
+ -- Note: GCC set signal handlers...
+ Status := Exit_Status (Toplev_Main (gnat_argc, gnat_argv));
+ Set_Exit_Status (Status);
+end Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc-main.ads b/src/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 0000000..4bd73a1
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1 @@
+procedure Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc.adb b/src/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 0000000..ae7b4f5
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,121 @@
+-- GCC back-end for ortho.
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Ortho_Gcc is
+
+ function New_Lit (Lit : O_Cnode) return O_Enode is
+ begin
+ return O_Enode (Lit);
+ end New_Lit;
+
+ function New_Obj (Obj : O_Dnode) return O_Lnode is
+ begin
+ return O_Lnode (Obj);
+ end New_Obj;
+
+ function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+ begin
+ return O_Enode (Obj);
+ end New_Obj_Value;
+
+ procedure New_Debug_Filename_Decl (Filename : String) is
+ begin
+ null;
+ end New_Debug_Filename_Decl;
+
+ procedure New_Debug_Comment_Decl (Comment : String)
+ is
+ pragma Unreferenced (Comment);
+ begin
+ null;
+ end New_Debug_Comment_Decl;
+
+ procedure New_Debug_Comment_Stmt (Comment : String)
+ is
+ pragma Unreferenced (Comment);
+ begin
+ null;
+ end New_Debug_Comment_Stmt;
+
+ -- Representation of a C String: this is an access to a bounded string.
+ -- Therefore, with GNAT, such an access is a thin pointer.
+ subtype Fat_C_String is String (Positive);
+ type C_String is access all Fat_C_String;
+ pragma Convention (C, C_String);
+
+ C_String_Null : constant C_String := null;
+
+ -- Return the length of a C String (ie, the number of characters before
+ -- the Nul).
+ function C_String_Len (Str : C_String) return Natural;
+ pragma Import (C, C_String_Len, "strlen");
+
+ function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+ return Integer;
+ pragma Export (C, Lang_Handle_Option);
+
+ function Lang_Parse_File (Filename : C_String) return Integer;
+ pragma Export (C, Lang_Parse_File);
+
+ function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+ return Integer
+ is
+ procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+ (Name => String_Acc, Object => String);
+
+ Res : Natural;
+ Ada_Opt : String_Acc;
+ Ada_Arg : String_Acc;
+ Len : Natural;
+ begin
+ Len := C_String_Len (Opt);
+ Ada_Opt := new String'(Opt (1 .. Len));
+ if Arg /= C_String_Null then
+ Len := C_String_Len (Arg);
+ Ada_Arg := new String'(Arg (1 .. Len));
+ else
+ Ada_Arg := null;
+ end if;
+ Res := Ortho_Gcc_Front.Decode_Option (Ada_Opt, Ada_Arg);
+ Unchecked_Deallocation (Ada_Opt);
+ Unchecked_Deallocation (Ada_Arg);
+ return Res;
+ end Lang_Handle_Option;
+
+ function Lang_Parse_File (Filename : C_String) return Integer
+ is
+ Len : Natural;
+ File : String_Acc;
+ begin
+ if Filename = C_String_Null then
+ File := null;
+ else
+ Len := C_String_Len (Filename);
+ File := new String'(Filename.all (1 .. Len));
+ end if;
+
+ if Ortho_Gcc_Front.Parse (File) then
+ return 1;
+ else
+ return 0;
+ end if;
+ end Lang_Parse_File;
+
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 0000000..0afdc08
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,701 @@
+-- DO NOT MODIFY - this file was generated from:
+-- ortho_nodes.common.ads and ortho_gcc.private.ads
+--
+-- GCC back-end for ortho.
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+-- Interface to create nodes.
+package Ortho_Gcc is
+
+-- Start of common part
+
+ type O_Enode is private;
+ type O_Cnode is private;
+ type O_Lnode is private;
+ type O_Tnode is private;
+ type O_Snode is private;
+ type O_Dnode is private;
+ type O_Fnode is private;
+
+ O_Cnode_Null : constant O_Cnode;
+ O_Dnode_Null : constant O_Dnode;
+ O_Enode_Null : constant O_Enode;
+ O_Fnode_Null : constant O_Fnode;
+ O_Lnode_Null : constant O_Lnode;
+ O_Snode_Null : constant O_Snode;
+ O_Tnode_Null : constant O_Tnode;
+
+ -- True if the code generated supports nested subprograms.
+ Has_Nested_Subprograms : constant Boolean;
+
+ ------------------------
+ -- Type definitions --
+ ------------------------
+
+ type O_Element_List is limited private;
+
+ -- Build a record type.
+ procedure Start_Record_Type (Elements : out O_Element_List);
+ -- Add a field in the record; not constrained array are prohibited, since
+ -- its size is unlimited.
+ procedure New_Record_Field
+ (Elements : in out O_Element_List;
+ El : out O_Fnode;
+ Ident : O_Ident; Etype : O_Tnode);
+ -- Finish the record type.
+ procedure Finish_Record_Type
+ (Elements : in out O_Element_List; Res : out O_Tnode);
+
+ -- Build an uncomplete record type:
+ -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+ -- This type can be declared or used to define access types on it.
+ -- Then, complete (if necessary) the record type, by calling
+ -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+ procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+ procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+ Elements : out O_Element_List);
+
+ -- Build an union type.
+ procedure Start_Union_Type (Elements : out O_Element_List);
+ procedure New_Union_Field
+ (Elements : in out O_Element_List;
+ El : out O_Fnode;
+ Ident : O_Ident;
+ Etype : O_Tnode);
+ procedure Finish_Union_Type
+ (Elements : in out O_Element_List; Res : out O_Tnode);
+
+ -- Build an access type.
+ -- DTYPE may be O_tnode_null in order to build an incomplete access type.
+ -- It is completed with finish_access_type.
+ function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+ procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+ -- Build an array type.
+ -- The array is not constrained and unidimensional.
+ function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+ return O_Tnode;
+
+ -- Build a constrained array type.
+ function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+ return O_Tnode;
+
+ -- Build a scalar type; size may be 8, 16, 32 or 64.
+ function New_Unsigned_Type (Size : Natural) return O_Tnode;
+ function New_Signed_Type (Size : Natural) return O_Tnode;
+
+ -- Build a float type.
+ function New_Float_Type return O_Tnode;
+
+ -- Build a boolean type.
+ procedure New_Boolean_Type (Res : out O_Tnode;
+ False_Id : O_Ident;
+ False_E : out O_Cnode;
+ True_Id : O_Ident;
+ True_E : out O_Cnode);
+
+ -- Create an enumeration
+ type O_Enum_List is limited private;
+
+ -- Elements are declared in order, the first is ordered from 0.
+ procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+ procedure New_Enum_Literal (List : in out O_Enum_List;
+ Ident : O_Ident; Res : out O_Cnode);
+ procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+ ----------------
+ -- Literals --
+ ----------------
+
+ -- Create a literal from an integer.
+ function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+ return O_Cnode;
+ function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+ return O_Cnode;
+
+ function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+ return O_Cnode;
+
+ -- Create a null access literal.
+ function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+ -- Build a record/array aggregate.
+ -- The aggregate is constant, and therefore can be only used to initialize
+ -- constant declaration.
+ -- ATYPE must be either a record type or an array subtype.
+ -- Elements must be added in the order, and must be literals or aggregates.
+ type O_Record_Aggr_List is limited private;
+ type O_Array_Aggr_List is limited private;
+
+ procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+ Atype : O_Tnode);
+ procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+ Value : O_Cnode);
+ procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+ Res : out O_Cnode);
+
+ procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+ procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+ Value : O_Cnode);
+ procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+ Res : out O_Cnode);
+
+ -- Build an union aggregate.
+ function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+ return O_Cnode;
+
+ -- Returns the size in bytes of ATYPE. The result is a literal of
+ -- unsigned type RTYPE
+ -- ATYPE cannot be an unconstrained array type.
+ function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+ -- Returns the alignment in bytes for ATYPE. The result is a literal of
+ -- unsgined type RTYPE.
+ function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+ -- Returns the offset of FIELD in its record ATYPE. The result is a
+ -- literal of unsigned type or access type RTYPE.
+ function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode;
+
+ -- Get the address of a subprogram.
+ function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+ return O_Cnode;
+
+ -- Get the address of LVALUE.
+ -- ATYPE must be a type access whose designated type is the type of LVALUE.
+ -- FIXME: what about arrays.
+ function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+ return O_Cnode;
+
+ -- Same as New_Address but without any restriction.
+ function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+ return O_Cnode;
+
+ -------------------
+ -- Expressions --
+ -------------------
+
+ type ON_Op_Kind is
+ (
+ -- Not an operation; invalid.
+ ON_Nil,
+
+ -- Dyadic operations.
+ ON_Add_Ov, -- ON_Dyadic_Op_Kind
+ ON_Sub_Ov, -- ON_Dyadic_Op_Kind
+ ON_Mul_Ov, -- ON_Dyadic_Op_Kind
+ ON_Div_Ov, -- ON_Dyadic_Op_Kind
+ ON_Rem_Ov, -- ON_Dyadic_Op_Kind
+ ON_Mod_Ov, -- ON_Dyadic_Op_Kind
+
+ -- Binary operations.
+ ON_And, -- ON_Dyadic_Op_Kind
+ ON_Or, -- ON_Dyadic_Op_Kind
+ ON_Xor, -- ON_Dyadic_Op_Kind
+
+ -- Monadic operations.
+ ON_Not, -- ON_Monadic_Op_Kind
+ ON_Neg_Ov, -- ON_Monadic_Op_Kind
+ ON_Abs_Ov, -- ON_Monadic_Op_Kind
+
+ -- Comparaisons
+ ON_Eq, -- ON_Compare_Op_Kind
+ ON_Neq, -- ON_Compare_Op_Kind
+ ON_Le, -- ON_Compare_Op_Kind
+ ON_Lt, -- ON_Compare_Op_Kind
+ ON_Ge, -- ON_Compare_Op_Kind
+ ON_Gt -- ON_Compare_Op_Kind
+ );
+
+ subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+ subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+ subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+ type O_Storage is (O_Storage_External,
+ O_Storage_Public,
+ O_Storage_Private,
+ O_Storage_Local);
+ -- Specifies the storage kind of a declaration.
+ -- O_STORAGE_EXTERNAL:
+ -- The declaration do not either reserve memory nor generate code, and
+ -- is imported either from an other file or from a later place in the
+ -- current file.
+ -- O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+ -- The declaration reserves memory or generates code.
+ -- With O_STORAGE_PUBLIC, the declaration is exported outside of the
+ -- file while with O_STORAGE_PRIVATE, the declaration is local to the
+ -- file.
+
+ Type_Error : exception;
+ Syntax_Error : exception;
+
+ -- Create a value from a literal.
+ function New_Lit (Lit : O_Cnode) return O_Enode;
+
+ -- Create a dyadic operation.
+ -- Left and right nodes must have the same type.
+ -- Binary operation is allowed only on boolean types.
+ -- The result is of the type of the operands.
+ function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+ return O_Enode;
+
+ -- Create a monadic operation.
+ -- Result is of the type of operand.
+ function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+ return O_Enode;
+
+ -- Create a comparaison operator.
+ -- NTYPE is the type of the result and must be a boolean type.
+ function New_Compare_Op
+ (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+ return O_Enode;
+
+
+ type O_Inter_List is limited private;
+ type O_Assoc_List is limited private;
+ type O_If_Block is limited private;
+ type O_Case_Block is limited private;
+
+
+ -- Get an element of an array.
+ -- INDEX must be of the type of the array index.
+ function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+ return O_Lnode;
+
+ -- Get a slice of an array; this is equivalent to a conversion between
+ -- an array or an array subtype and an array subtype.
+ -- RES_TYPE must be an array_sub_type whose base type is the same as the
+ -- base type of ARR.
+ -- INDEX must be of the type of the array index.
+ function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+ return O_Lnode;
+
+ -- Get an element of a record.
+ -- Type of REC must be a record type.
+ function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+ return O_Lnode;
+
+ -- Reference an access.
+ -- Type of ACC must be an access type.
+ function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+ -- Do a conversion.
+ -- Allowed conversions are:
+ -- FIXME: to write.
+ function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+ -- Get the address of LVALUE.
+ -- ATYPE must be a type access whose designated type is the type of LVALUE.
+ -- FIXME: what about arrays.
+ function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+ -- Same as New_Address but without any restriction.
+ function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+ return O_Enode;
+
+ -- Get the value of an Lvalue.
+ function New_Value (Lvalue : O_Lnode) return O_Enode;
+ function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+ -- Get an lvalue from a declaration.
+ function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+ -- Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+ function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+ -- Declare a type.
+ -- This simply gives a name to a type.
+ procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+ ---------------------
+ -- Declarations. --
+ ---------------------
+
+ -- Filename of the next declaration.
+ procedure New_Debug_Filename_Decl (Filename : String);
+
+ -- Line number of the next declaration.
+ procedure New_Debug_Line_Decl (Line : Natural);
+
+ -- Add a comment in the declarative region.
+ procedure New_Debug_Comment_Decl (Comment : String);
+
+ -- Declare a constant.
+ -- This simply gives a name to a constant value or aggregate.
+ -- A constant cannot be modified and its storage cannot be local.
+ -- ATYPE must be constrained.
+ procedure New_Const_Decl
+ (Res : out O_Dnode;
+ Ident : O_Ident;
+ Storage : O_Storage;
+ Atype : O_Tnode);
+
+ -- Set the value of a non-external constant.
+ procedure Start_Const_Value (Const : in out O_Dnode);
+ procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+ -- Create a variable declaration.
+ -- A variable can be local only inside a function.
+ -- ATYPE must be constrained.
+ procedure New_Var_Decl
+ (Res : out O_Dnode;
+ Ident : O_Ident;
+ Storage : O_Storage;
+ Atype : O_Tnode);
+
+ -- Start a subprogram declaration.
+ -- Note: nested subprograms are allowed, ie o_storage_local subprograms can
+ -- be declared inside a subprograms. It is not allowed to declare
+ -- o_storage_external subprograms inside a subprograms.
+ -- Return type and interfaces cannot be a composite type.
+ procedure Start_Function_Decl
+ (Interfaces : out O_Inter_List;
+ Ident : O_Ident;
+ Storage : O_Storage;
+ Rtype : O_Tnode);
+ -- For a subprogram without return value.
+ procedure Start_Procedure_Decl
+ (Interfaces : out O_Inter_List;
+ Ident : O_Ident;
+ Storage : O_Storage);
+
+ -- Add an interface declaration to INTERFACES.
+ procedure New_Interface_Decl
+ (Interfaces : in out O_Inter_List;
+ Res : out O_Dnode;
+ Ident : O_Ident;
+ Atype : O_Tnode);
+ -- Finish the function declaration, get the node and a statement list.
+ procedure Finish_Subprogram_Decl
+ (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+ -- Start a subprogram body.
+ -- Note: the declaration may have an external storage, in this case it
+ -- becomes public.
+ procedure Start_Subprogram_Body (Func : O_Dnode);
+ -- Finish a subprogram body.
+ procedure Finish_Subprogram_Body;
+
+
+ -------------------
+ -- Statements. --
+ -------------------
+
+ -- Add a line number as a statement.
+ procedure New_Debug_Line_Stmt (Line : Natural);
+
+ -- Add a comment as a statement.
+ procedure New_Debug_Comment_Stmt (Comment : String);
+
+ -- Start a declarative region.
+ procedure Start_Declare_Stmt;
+ procedure Finish_Declare_Stmt;
+
+ -- Create a function call or a procedure call.
+ procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+ procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+ function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+ procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+ -- Assign VALUE to TARGET, type must be the same or compatible.
+ -- FIXME: what about slice assignment?
+ procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+ -- Exit from the subprogram and return VALUE.
+ procedure New_Return_Stmt (Value : O_Enode);
+ -- Exit from the subprogram, which doesn't return value.
+ procedure New_Return_Stmt;
+
+ -- Build an IF statement.
+ procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+ procedure New_Else_Stmt (Block : in out O_If_Block);
+ procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+ -- Create a infinite loop statement.
+ procedure Start_Loop_Stmt (Label : out O_Snode);
+ procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+ -- Exit from a loop stmt or from a for stmt.
+ procedure New_Exit_Stmt (L : O_Snode);
+ -- Go to the start of a loop stmt or of a for stmt.
+ -- Loops/Fors between L and the current points are exited.
+ procedure New_Next_Stmt (L : O_Snode);
+
+ -- Case statement.
+ -- VALUE is the selector and must be a discrete type.
+ procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+ -- A choice branch is composed of expr, range or default choices.
+ -- A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+ -- The statements are after the finish_choice.
+ procedure Start_Choice (Block : in out O_Case_Block);
+ procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+ procedure New_Range_Choice (Block : in out O_Case_Block;
+ Low, High : O_Cnode);
+ procedure New_Default_Choice (Block : in out O_Case_Block);
+ procedure Finish_Choice (Block : in out O_Case_Block);
+ procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+-- End of common part
+private
+ -- GCC supports nested subprograms.
+ Has_Nested_Subprograms : constant Boolean := True;
+
+ pragma Convention (C, O_Storage);
+ -- pragma Convention (C, ON_Op_Kind);
+
+ subtype Tree is System.Address;
+ NULL_TREE : constant Tree := System.Null_Address;
+
+ subtype Vec_Ptr is System.Address;
+
+ type O_Cnode is new Tree;
+ type O_Enode is new Tree;
+ type O_Lnode is new Tree;
+ type O_Tnode is new Tree;
+ type O_Fnode is new Tree;
+ type O_Dnode is new Tree;
+ type O_Snode is record
+ Beg_Label : Tree;
+ End_Label : Tree;
+ end record;
+ pragma Convention (C, O_Snode);
+
+ O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+ O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+ O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+ O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+ O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+ O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+ O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+ pragma Inline (New_Lit);
+ pragma Inline (New_Obj);
+ pragma Inline (New_Obj_Value);
+
+ -- Efficiently append element EL to a chain.
+ -- FIRST is the first element of the chain (must NULL_TREE if the chain
+ -- is empty),
+ -- LAST is the last element of the chain (idem).
+ type Chain_Constr_Type is record
+ First : Tree;
+ Last : Tree;
+ end record;
+ pragma Convention (C, Chain_Constr_Type);
+ procedure Chain_Init (Constr : out Chain_Constr_Type);
+ pragma Import (C, Chain_Init);
+ procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+ pragma Import (C, Chain_Append);
+
+ -- Efficiently append element EL to a list.
+ type List_Constr_Type is record
+ First : Tree;
+ Last : Tree;
+ end record;
+ pragma Convention (C, List_Constr_Type);
+ procedure List_Init (Constr : out List_Constr_Type);
+ pragma Import (C, List_Init);
+ procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+ pragma Import (C, List_Append, "ortho_list_append");
+
+ type O_Loop_Block is record
+ Beg_Label : Tree;
+ End_Label : Tree;
+ end record;
+ pragma Convention (C, O_Loop_Block);
+
+ type O_Inter_List is record
+ Ident : O_Ident;
+ Storage : O_Storage;
+ -- Return type.
+ Rtype : O_Tnode;
+ -- List of parameter types.
+ Param_List : List_Constr_Type;
+ -- Chain of parameters declarations.
+ Param_Chain : Chain_Constr_Type;
+ end record;
+ pragma Convention (C, O_Inter_List);
+
+ type O_Element_List is record
+ Res : Tree;
+ Chain : Chain_Constr_Type;
+ end record;
+ pragma Convention (C, O_Element_List);
+
+ type O_Case_Block is record
+ Case_Type : Tree;
+ End_Label : Tree;
+ Add_Break : Integer;
+ end record;
+ pragma Convention (C, O_Case_Block);
+
+ type O_If_Block is record
+ Stmt : Tree;
+ end record;
+ pragma Convention (C, O_If_Block);
+
+ type O_Aggr_List is record
+ Atype : Tree;
+ Chain : Chain_Constr_Type;
+ end record;
+
+ type O_Record_Aggr_List is record
+ Atype : Tree;
+ Afield : Tree;
+ Vec : Vec_Ptr;
+ end record;
+ pragma Convention (C, O_Record_Aggr_List);
+
+ type O_Array_Aggr_List is record
+ Atype : Tree;
+ Vec : Vec_Ptr;
+ end record;
+ pragma Convention (C, O_Array_Aggr_List);
+
+ type O_Assoc_List is record
+ Subprg : Tree;
+ List : List_Constr_Type;
+ end record;
+ pragma Convention (C, O_Assoc_List);
+
+ type O_Enum_List is record
+ -- The enumeral_type node.
+ Res : Tree;
+ -- Chain of literals.
+ Chain : Chain_Constr_Type;
+ -- Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+ Num : Natural;
+ -- Size of the enumeration type.
+ Size : Natural;
+ end record;
+ pragma Convention (C, O_Enum_List);
+
+ pragma Import (C, New_Dyadic_Op);
+ pragma Import (C, New_Monadic_Op);
+ pragma Import (C, New_Compare_Op);
+
+ pragma Import (C, New_Convert_Ov);
+ pragma Import (C, New_Alloca);
+
+ pragma Import (C, New_Signed_Literal);
+ pragma Import (C, New_Unsigned_Literal);
+ pragma Import (C, New_Float_Literal);
+ pragma Import (C, New_Null_Access);
+
+ pragma Import (C, Start_Record_Type);
+ pragma Import (C, New_Record_Field);
+ pragma Import (C, Finish_Record_Type);
+ pragma Import (C, New_Uncomplete_Record_Type);
+ pragma Import (C, Start_Uncomplete_Record_Type);
+
+ pragma Import (C, Start_Union_Type);
+ pragma Import (C, New_Union_Field);
+ pragma Import (C, Finish_Union_Type);
+
+ pragma Import (C, New_Unsigned_Type);
+ pragma Import (C, New_Signed_Type);
+ pragma Import (C, New_Float_Type);
+
+ pragma Import (C, New_Access_Type);
+ pragma Import (C, Finish_Access_Type);
+
+ pragma Import (C, New_Array_Type);
+ pragma Import (C, New_Constrained_Array_Type);
+
+ pragma Import (C, New_Boolean_Type);
+ pragma Import (C, Start_Enum_Type);
+ pragma Import (C, New_Enum_Literal);
+ pragma Import (C, Finish_Enum_Type);
+
+ pragma Import (C, Start_Record_Aggr);
+ pragma Import (C, New_Record_Aggr_El);
+ pragma Import (C, Finish_Record_Aggr);
+ pragma Import (C, Start_Array_Aggr);
+ pragma Import (C, New_Array_Aggr_El);
+ pragma Import (C, Finish_Array_Aggr);
+ pragma Import (C, New_Union_Aggr);
+
+ pragma Import (C, New_Indexed_Element);
+ pragma Import (C, New_Slice);
+ pragma Import (C, New_Selected_Element);
+ pragma Import (C, New_Access_Element);
+
+ pragma Import (C, New_Sizeof);
+ pragma Import (C, New_Alignof);
+ pragma Import (C, New_Offsetof);
+
+ pragma Import (C, New_Address);
+ pragma Import (C, New_Global_Address);
+ pragma Import (C, New_Unchecked_Address);
+ pragma Import (C, New_Global_Unchecked_Address);
+ pragma Import (C, New_Subprogram_Address);
+
+ pragma Import (C, New_Value);
+
+ pragma Import (C, New_Type_Decl);
+ pragma Import (C, New_Debug_Line_Decl);
+ pragma Import (C, New_Const_Decl);
+ pragma Import (C, New_Var_Decl);
+
+ pragma Import (C, Start_Const_Value);
+ pragma Import (C, Finish_Const_Value);
+
+ pragma Import (C, Start_Function_Decl);
+ pragma Import (C, Start_Procedure_Decl);
+ pragma Import (C, New_Interface_Decl);
+ pragma Import (C, Finish_Subprogram_Decl);
+
+ pragma Import (C, Start_Subprogram_Body);
+ pragma Import (C, Finish_Subprogram_Body);
+
+ pragma Import (C, New_Debug_Line_Stmt);
+ pragma Import (C, Start_Declare_Stmt);
+ pragma Import (C, Finish_Declare_Stmt);
+ pragma Import (C, Start_Association);
+ pragma Import (C, New_Association);
+ pragma Import (C, New_Function_Call);
+ pragma Import (C, New_Procedure_Call);
+
+ pragma Import (C, New_Assign_Stmt);
+
+ pragma Import (C, Start_If_Stmt);
+ pragma Import (C, New_Else_Stmt);
+ pragma Import (C, Finish_If_Stmt);
+
+ pragma Import (C, New_Return_Stmt);
+ pragma Import_Procedure (New_Return_Stmt,
+ "new_func_return_stmt", (O_Enode));
+ pragma Import_Procedure (New_Return_Stmt,
+ "new_proc_return_stmt", null);
+
+ pragma Import (C, Start_Loop_Stmt);
+ pragma Import (C, Finish_Loop_Stmt);
+ pragma Import (C, New_Exit_Stmt);
+ pragma Import (C, New_Next_Stmt);
+
+ pragma Import (C, Start_Case_Stmt);
+ pragma Import (C, Start_Choice);
+ pragma Import (C, New_Expr_Choice);
+ pragma Import (C, New_Range_Choice);
+ pragma Import (C, New_Default_Choice);
+ pragma Import (C, Finish_Choice);
+ pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.private.ads b/src/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 0000000..cc2f556
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,269 @@
+-- GCC back-end for ortho.
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with System;
+with Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+-- Interface to create nodes.
+package Ortho_Gcc is
+
+private
+ -- GCC supports nested subprograms.
+ Has_Nested_Subprograms : constant Boolean := True;
+
+ pragma Convention (C, O_Storage);
+ -- pragma Convention (C, ON_Op_Kind);
+
+ subtype Tree is System.Address;
+ NULL_TREE : constant Tree := System.Null_Address;
+
+ subtype Vec_Ptr is System.Address;
+
+ type O_Cnode is new Tree;
+ type O_Enode is new Tree;
+ type O_Lnode is new Tree;
+ type O_Tnode is new Tree;
+ type O_Fnode is new Tree;
+ type O_Dnode is new Tree;
+ type O_Snode is record
+ Beg_Label : Tree;
+ End_Label : Tree;
+ end record;
+ pragma Convention (C, O_Snode);
+
+ O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+ O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+ O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+ O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+ O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+ O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+ O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+ pragma Inline (New_Lit);
+ pragma Inline (New_Obj);
+ pragma Inline (New_Obj_Value);
+
+ -- Efficiently append element EL to a chain.
+ -- FIRST is the first element of the chain (must NULL_TREE if the chain
+ -- is empty),
+ -- LAST is the last element of the chain (idem).
+ type Chain_Constr_Type is record
+ First : Tree;
+ Last : Tree;
+ end record;
+ pragma Convention (C, Chain_Constr_Type);
+ procedure Chain_Init (Constr : out Chain_Constr_Type);
+ pragma Import (C, Chain_Init);
+ procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+ pragma Import (C, Chain_Append);
+
+ -- Efficiently append element EL to a list.
+ type List_Constr_Type is record
+ First : Tree;
+ Last : Tree;
+ end record;
+ pragma Convention (C, List_Constr_Type);
+ procedure List_Init (Constr : out List_Constr_Type);
+ pragma Import (C, List_Init);
+ procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+ pragma Import (C, List_Append, "ortho_list_append");
+
+ type O_Loop_Block is record
+ Beg_Label : Tree;
+ End_Label : Tree;
+ end record;
+ pragma Convention (C, O_Loop_Block);
+
+ type O_Inter_List is record
+ Ident : O_Ident;
+ Storage : O_Storage;
+ -- Return type.
+ Rtype : O_Tnode;
+ -- List of parameter types.
+ Param_List : List_Constr_Type;
+ -- Chain of parameters declarations.
+ Param_Chain : Chain_Constr_Type;
+ end record;
+ pragma Convention (C, O_Inter_List);
+
+ type O_Element_List is record
+ Res : Tree;
+ Chain : Chain_Constr_Type;
+ end record;
+ pragma Convention (C, O_Element_List);
+
+ type O_Case_Block is record
+ Case_Type : Tree;
+ End_Label : Tree;
+ Add_Break : Integer;
+ end record;
+ pragma Convention (C, O_Case_Block);
+
+ type O_If_Block is record
+ Stmt : Tree;
+ end record;
+ pragma Convention (C, O_If_Block);
+
+ type O_Aggr_List is record
+ Atype : Tree;
+ Chain : Chain_Constr_Type;
+ end record;
+
+ type O_Record_Aggr_List is record
+ Atype : Tree;
+ Afield : Tree;
+ Vec : Vec_Ptr;
+ end record;
+ pragma Convention (C, O_Record_Aggr_List);
+
+ type O_Array_Aggr_List is record
+ Atype : Tree;
+ Vec : Vec_Ptr;
+ end record;
+ pragma Convention (C, O_Array_Aggr_List);
+
+ type O_Assoc_List is record
+ Subprg : Tree;
+ List : List_Constr_Type;
+ end record;
+ pragma Convention (C, O_Assoc_List);
+
+ type O_Enum_List is record
+ -- The enumeral_type node.
+ Res : Tree;
+ -- Chain of literals.
+ Chain : Chain_Constr_Type;
+ -- Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+ Num : Natural;
+ -- Size of the enumeration type.
+ Size : Natural;
+ end record;
+ pragma Convention (C, O_Enum_List);
+
+ pragma Import (C, New_Dyadic_Op);
+ pragma Import (C, New_Monadic_Op);
+ pragma Import (C, New_Compare_Op);
+
+ pragma Import (C, New_Convert_Ov);
+ pragma Import (C, New_Alloca);
+
+ pragma Import (C, New_Signed_Literal);
+ pragma Import (C, New_Unsigned_Literal);
+ pragma Import (C, New_Float_Literal);
+ pragma Import (C, New_Null_Access);
+
+ pragma Import (C, Start_Record_Type);
+ pragma Import (C, New_Record_Field);
+ pragma Import (C, Finish_Record_Type);
+ pragma Import (C, New_Uncomplete_Record_Type);
+ pragma Import (C, Start_Uncomplete_Record_Type);
+
+ pragma Import (C, Start_Union_Type);
+ pragma Import (C, New_Union_Field);
+ pragma Import (C, Finish_Union_Type);
+
+ pragma Import (C, New_Unsigned_Type);
+ pragma Import (C, New_Signed_Type);
+ pragma Import (C, New_Float_Type);
+
+ pragma Import (C, New_Access_Type);
+ pragma Import (C, Finish_Access_Type);
+
+ pragma Import (C, New_Array_Type);
+ pragma Import (C, New_Constrained_Array_Type);
+
+ pragma Import (C, New_Boolean_Type);
+ pragma Import (C, Start_Enum_Type);
+ pragma Import (C, New_Enum_Literal);
+ pragma Import (C, Finish_Enum_Type);
+
+ pragma Import (C, Start_Record_Aggr);
+ pragma Import (C, New_Record_Aggr_El);
+ pragma Import (C, Finish_Record_Aggr);
+ pragma Import (C, Start_Array_Aggr);
+ pragma Import (C, New_Array_Aggr_El);
+ pragma Import (C, Finish_Array_Aggr);
+ pragma Import (C, New_Union_Aggr);
+
+ pragma Import (C, New_Indexed_Element);
+ pragma Import (C, New_Slice);
+ pragma Import (C, New_Selected_Element);
+ pragma Import (C, New_Access_Element);
+
+ pragma Import (C, New_Sizeof);
+ pragma Import (C, New_Alignof);
+ pragma Import (C, New_Offsetof);
+
+ pragma Import (C, New_Address);
+ pragma Import (C, New_Global_Address);
+ pragma Import (C, New_Unchecked_Address);
+ pragma Import (C, New_Global_Unchecked_Address);
+ pragma Import (C, New_Subprogram_Address);
+
+ pragma Import (C, New_Value);
+
+ pragma Import (C, New_Type_Decl);
+ pragma Import (C, New_Debug_Line_Decl);
+ pragma Import (C, New_Const_Decl);
+ pragma Import (C, New_Var_Decl);
+
+ pragma Import (C, Start_Const_Value);
+ pragma Import (C, Finish_Const_Value);
+
+ pragma Import (C, Start_Function_Decl);
+ pragma Import (C, Start_Procedure_Decl);
+ pragma Import (C, New_Interface_Decl);
+ pragma Import (C, Finish_Subprogram_Decl);
+
+ pragma Import (C, Start_Subprogram_Body);
+ pragma Import (C, Finish_Subprogram_Body);
+
+ pragma Import (C, New_Debug_Line_Stmt);
+ pragma Import (C, Start_Declare_Stmt);
+ pragma Import (C, Finish_Declare_Stmt);
+ pragma Import (C, Start_Association);
+ pragma Import (C, New_Association);
+ pragma Import (C, New_Function_Call);
+ pragma Import (C, New_Procedure_Call);
+
+ pragma Import (C, New_Assign_Stmt);
+
+ pragma Import (C, Start_If_Stmt);
+ pragma Import (C, New_Else_Stmt);
+ pragma Import (C, Finish_If_Stmt);
+
+ pragma Import (C, New_Return_Stmt);
+ pragma Import_Procedure (New_Return_Stmt,
+ "new_func_return_stmt", (O_Enode));
+ pragma Import_Procedure (New_Return_Stmt,
+ "new_proc_return_stmt", null);
+
+ pragma Import (C, Start_Loop_Stmt);
+ pragma Import (C, Finish_Loop_Stmt);
+ pragma Import (C, New_Exit_Stmt);
+ pragma Import (C, New_Next_Stmt);
+
+ pragma Import (C, Start_Case_Stmt);
+ pragma Import (C, Start_Choice);
+ pragma Import (C, New_Expr_Choice);
+ pragma Import (C, New_Range_Choice);
+ pragma Import (C, New_Default_Choice);
+ pragma Import (C, Finish_Choice);
+ pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc_front.ads b/src/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 0000000..553057b
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,2 @@
+with Ortho_Front;
+package Ortho_Gcc_Front renames Ortho_Front;
diff --git a/src/ortho/gcc/ortho_ident.adb b/src/ortho/gcc/ortho_ident.adb
new file mode 100644
index 0000000..770fece
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,56 @@
+-- GCC back-end for ortho (identifiers)
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+package body Ortho_Ident is
+ function Get_Identifier_With_Length (Str : Address; Size : Integer)
+ return O_Ident;
+ pragma Import (C, Get_Identifier_With_Length,
+ "get_identifier_with_length_c");
+
+ function Compare_Identifier_String
+ (Id : O_Ident; Str : Address; Size : Integer)
+ return Boolean;
+ pragma Import (C, Compare_Identifier_String);
+ pragma Warnings (Off, Compare_Identifier_String);
+
+ function Get_Identifier (Str : String) return O_Ident is
+ begin
+ return Get_Identifier_With_Length (Str'Address, Str'Length);
+ end Get_Identifier;
+
+ function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+ begin
+ return Compare_Identifier_String (Id, Str'Address, Str'Length);
+ end Is_Equal;
+
+ function Get_String (Id : O_Ident) return String
+ is
+ procedure Get_Identifier_String
+ (Id : O_Ident; Str_Ptr : Address; Len_Ptr : Address);
+ pragma Import (C, Get_Identifier_String);
+
+ Len : Natural;
+ type Str_Acc is access String (Positive);
+ Str : Str_Acc;
+ begin
+ Get_Identifier_String (Id, Str'Address, Len'Address);
+ return Str (1 .. Len);
+ end Get_String;
+
+end Ortho_Ident;
+
diff --git a/src/ortho/gcc/ortho_ident.ads b/src/ortho/gcc/ortho_ident.ads
new file mode 100644
index 0000000..76c09ce
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,30 @@
+-- GCC back-end for ortho (identifiers)
+-- Copyright (C) 2002-1014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with System; use System;
+
+package Ortho_Ident is
+ subtype O_Ident is Address;
+ function Get_Identifier (Str : String) return O_Ident;
+ function Get_String (Id : O_Ident) return String;
+ function Is_Equal (L, R : O_Ident) return Boolean renames System."=";
+ function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+ O_Ident_Nul : constant O_Ident;
+private
+ O_Ident_Nul : constant O_Ident := Null_Address;
+end Ortho_Ident;
diff --git a/src/ortho/gcc/ortho_nodes.ads b/src/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 0000000..7c6c4a0
--- /dev/null
+++ b/src/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,3 @@
+with Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
generated by cgit (git 2.34.1) at 2024-12-20 14:45:22 +0000