diff options
Diffstat (limited to 'ortho/agcc')
29 files changed, 0 insertions, 3651 deletions
diff --git a/ortho/agcc/Makefile.inc b/ortho/agcc/Makefile.inc deleted file mode 100644 index b5da6f0..0000000 --- a/ortho/agcc/Makefile.inc +++ /dev/null @@ -1,112 +0,0 @@ -# -*- Makefile -*- for agcc, the Ada binding for GCC internals. -# Copyright (C) 2002, 2003, 2004, 2005 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. - -# Variable used: -# AGCC_GCCSRC_DIR: the gcc source base directory (ie gcc-X.Y.Z-objs/) -# AGCC_GCCOBJ_DIR: the gcc objects base directory -# agcc_srcdir: the agcc source directory -# agcc_objdir: the agcc object directory - -AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \ - -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config -AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS) - -AGCC_LOCAL_OBJS=agcc-bindings.o agcc-version.o - -AGCC_DEPS := $(agcc_srcdir)/agcc-trees.ads \ - $(agcc_srcdir)/agcc-hwint.ads \ - $(agcc_srcdir)/agcc-hconfig.ads \ - $(agcc_srcdir)/agcc-real.ads \ - $(agcc_srcdir)/agcc-machmode.ads \ - $(agcc_srcdir)/agcc-tm.ads \ - $(agcc_srcdir)/agcc-options.ads \ - $(AGCC_LOCAL_OBJS) -AGCC_OBJS := $(AGCC_LOCAL_OBJS) \ - $(AGCC_GCCOBJ_DIR)/gcc/toplev.o \ - $(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \ - $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \ - $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a - -# Set rights to prevent editing. -GENERATE_VIA_GEN_TREE=\ - $(RM) -f $@ && \ - $(agcc_objdir)/gen_tree -C $(AGCC_GCCOBJ_DIR)/gcc - < $< > $@ && \ - chmod a-w $@ - -$(agcc_srcdir)/agcc-trees.ads: $(agcc_srcdir)/agcc-trees.ads.in \ - $(agcc_objdir)/gen_tree - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-hwint.ads: $(agcc_srcdir)/agcc-hwint.ads.in \ - $(agcc_objdir)/gen_tree - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-hconfig.ads: $(agcc_srcdir)/agcc-hconfig.ads.in \ - $(agcc_objdir)/gen_tree - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-real.ads: $(agcc_srcdir)/agcc-real.ads.in \ - $(agcc_objdir)/gen_tree - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-machmode.ads: $(agcc_srcdir)/agcc-machmode.ads.in \ - $(agcc_objdir)/gen_tree \ - $(AGCC_GCCOBJ_DIR)/gcc/insn-modes.h - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-tm.ads: $(agcc_srcdir)/agcc-tm.ads.in \ - $(agcc_objdir)/gen_tree - $(GENERATE_VIA_GEN_TREE) - -$(agcc_srcdir)/agcc-options.ads: $(agcc_srcdir)/agcc-options.ads.in \ - $(agcc_objdir)/gen_tree \ - $(AGCC_GCCOBJ_DIR)/gcc/options.h - $(GENERATE_VIA_GEN_TREE) - -$(agcc_objdir)/gen_tree: $(agcc_objdir)/gen_tree.o - $(CC) -o $@ $< - -$(agcc_objdir)/gen_tree.o: $(agcc_srcdir)/gen_tree.c \ - $(AGCC_GCCSRC_DIR)/gcc/tree.def $(AGCC_GCCSRC_DIR)/gcc/tree.h \ - $(AGCC_GCCOBJ_DIR)/gcc/tree-check.h - $(CC) -c -o $@ $< $(AGCC_CFLAGS) - -agcc-bindings.o: $(agcc_srcdir)/agcc-bindings.c \ - $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \ - $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-agcc-bindings.h - $(CC) -c -o $@ $< $(AGCC_CFLAGS) - -agcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c - -$(RM) -f $@ - echo '#include "version.h"' > $@ - sed -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@ - echo 'const char bug_report_url[] = "<URL:mailto:ghdl@free.fr>";' >> $@ - -agcc-version.o: agcc-version.c - $(CC) -c -o $@ $< $(AGCC_CFLAGS) - -agcc-clean: force - $(RM) -f $(agcc_objdir)/gen_tree $(agcc_objdir)/gen_tree.o - $(RM) -f $(agcc_objdir)/*.o - $(RM) -f $(agcc_srcdir)/*~ - -agcc-maintainer-clean: force - $(RM) -f $(AGCC_DEPS) - - -.PHONY: agcc-clean agcc-maintainer-clean diff --git a/ortho/agcc/agcc-autils.adb b/ortho/agcc/agcc-autils.adb deleted file mode 100644 index 30eb1e6..0000000 --- a/ortho/agcc/agcc-autils.adb +++ /dev/null @@ -1,93 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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_Conversion; -with Agcc.Hconfig; use Agcc.Hconfig; -with Agcc.Machmode; use Agcc.Machmode; - -package body Agcc.Autils is - Arr_Len : constant Natural := Unsigned_64'Size / HOST_WIDE_INT'Size; - type Arr_Conv is array (Natural range 0 .. Arr_Len - 1) of HOST_WIDE_INT; - - subtype Assert_Type is Boolean range True .. True; - Assert_Arr_Len_Is_1_Or_2 : constant Assert_Type := - Arr_Len = 1 or Arr_Len = 2; - pragma Unreferenced (Assert_Arr_Len_Is_1_Or_2); - - procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT) is - function Unchecked_Conversion is new Ada.Unchecked_Conversion - (Source => Unsigned_64, Target => Arr_Conv); - Res : Arr_Conv; - begin - Res := Unchecked_Conversion (V); - if Arr_Len = 1 then - H := 0; - L := Res (0); - else - if HOST_WORDS_BIG_ENDIAN then - L := Res (1); - H := Res (0); - else - L := Res (0); - H := Res (1); - end if; - end if; - end To_Host_Wide_Int; - - procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT) is - function Unchecked_Conversion is new Ada.Unchecked_Conversion - (Source => Integer_64, Target => Arr_Conv); - Res : Arr_Conv; - begin - Res := Unchecked_Conversion (V); - if Arr_Len = 1 then - if V < 0 then - H := -1; - else - H := 0; - end if; - L := Res (0); - else - if HOST_WORDS_BIG_ENDIAN then - L := Res (1); - H := Res (0); - else - L := Res (0); - H := Res (1); - end if; - end if; - end To_Host_Wide_Int; - - function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE - is - Mant_Size : constant Natural := 60; - Rfract : IEEE_Float_64; - Fract : Integer_64; - Exp : Integer; - L, H : HOST_WIDE_INT; - Mantisse : REAL_VALUE_TYPE; - begin - -- Note: this works only when REAL_ARITHMETIC is defined!!! - Exp := IEEE_Float_64'Exponent (V); - Rfract := IEEE_Float_64'Fraction (V); - Rfract := IEEE_Float_64'Scaling (Rfract, Mant_Size); - Fract := Integer_64 (Rfract); - To_Host_Wide_Int (Fract, L, H); - REAL_VALUE_FROM_INT (Mantisse'Address, L, H, DFmode); - return REAL_VALUE_LDEXP (Mantisse, Exp - Mant_Size); - end To_Real_Value_Type; -end Agcc.Autils; diff --git a/ortho/agcc/agcc-autils.ads b/ortho/agcc/agcc-autils.ads deleted file mode 100644 index 8ca7da4..0000000 --- a/ortho/agcc/agcc-autils.ads +++ /dev/null @@ -1,28 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Hwint; use Agcc.Hwint; -with Agcc.Real; use Agcc.Real; -with Interfaces; use Interfaces; - --- Additional utils. -package Agcc.Autils is - procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT); - procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT); - function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE; -end Agcc.Autils; - diff --git a/ortho/agcc/agcc-bindings.c b/ortho/agcc/agcc-bindings.c deleted file mode 100644 index 2dbe33b..0000000 --- a/ortho/agcc/agcc-bindings.c +++ /dev/null @@ -1,738 +0,0 @@ -/* Ada bindings for GCC internals - Bindings for Ada. - Copyright (C) 2002, 2003, 2004, 2005 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. -*/ -#include <stddef.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 "real.h" -#include "toplev.h" - -enum tree_code -get_tree_code (tree t) -{ - return TREE_CODE (t); -} - -void -set_tree_constant (tree t, int flag) -{ - TREE_CONSTANT (t) = flag; -} - -int -get_tree_constant (tree t) -{ - return TREE_CONSTANT (t); -} - -void -set_tree_public (tree t, int flag) -{ - TREE_PUBLIC (t) = flag; -} - -void -set_tree_static (tree t, int flag) -{ - TREE_STATIC (t) = flag; -} - -void -set_tree_type (tree t, tree val) -{ - TREE_TYPE (t) = val; -} - -tree -get_tree_type (tree t) -{ - return TREE_TYPE (t); -} - -void -set_tree_chain (tree t, tree chain) -{ - TREE_CHAIN (t) = chain; -} - -tree -get_tree_chain (tree t) -{ - return TREE_CHAIN (t); -} - -void -set_tree_unsigned (tree t, int flag) -{ - TREE_UNSIGNED (t) = flag; -} - -int -get_tree_unsigned (tree t) -{ - return TREE_UNSIGNED (t); -} - -void -set_tree_addressable (tree t, int flag) -{ - TREE_ADDRESSABLE (t) = flag; -} - -int -get_tree_addressable (tree t) -{ - return TREE_ADDRESSABLE (t); -} - -void -set_tree_side_effects (tree t, int flag) -{ - TREE_SIDE_EFFECTS (t) = flag; -} - -void -set_tree_readonly (tree t, int flag) -{ - TREE_READONLY (t) = flag; -} - -void -set_tree_operand (tree t, unsigned int n, tree val) -{ - TREE_OPERAND (t, n) = val; -} - -tree -get_tree_operand (tree t, unsigned int n) -{ - return TREE_OPERAND (t, n); -} - -int -get_tree_this_volatile (tree t) -{ - return TREE_THIS_VOLATILE (t); -} - -int -set_tree_this_volatile (tree t, int val) -{ - TREE_THIS_VOLATILE (t) = val; -} - -tree -get_tree_purpose (tree l) -{ - return TREE_PURPOSE (l); -} - -tree -get_tree_value (tree l) -{ - return TREE_VALUE (l); -} - -int -get_tree_used (tree n) -{ - return TREE_USED (n); -} - -void -set_tree_used (tree n, int flag) -{ - TREE_USED (n) = flag; -} - -HOST_WIDE_INT -get_tree_int_cst_low (tree node) -{ - return TREE_INT_CST_LOW (node); -} - -HOST_WIDE_INT -get_tree_int_cst_high (tree node) -{ - return TREE_INT_CST_HIGH (node); -} - -tree -get_constructor_elts (tree c) -{ - return CONSTRUCTOR_ELTS (c); -} - -tree -(build_int_2) (HOST_WIDE_INT lo, HOST_WIDE_INT hi) -{ - return build_int_2 (lo, hi); -} - -void -set_decl_arg_type (tree decl, tree val) -{ - DECL_ARG_TYPE (decl) = val; -} - -void -set_decl_external (tree decl, int val) -{ - DECL_EXTERNAL (decl) = val; -} - -int -get_decl_external (tree decl) -{ - return DECL_EXTERNAL (decl); -} - -void -set_decl_arguments (tree decl, tree args) -{ - DECL_ARGUMENTS (decl) = args; -} - -tree -get_decl_arguments (tree decl) -{ - return DECL_ARGUMENTS (decl); -} - -void -set_decl_result (tree decl, tree res) -{ - DECL_RESULT (decl) = res; -} - -tree -get_decl_result (tree decl) -{ - return DECL_RESULT (decl); -} - -void -set_decl_context (tree decl, tree context) -{ - DECL_CONTEXT (decl) = context; -} - -tree -get_decl_context (tree decl) -{ - return DECL_CONTEXT (decl); -} - -void -set_decl_initial (tree decl, tree res) -{ - DECL_INITIAL (decl) = res; -} - -tree -get_decl_initial (tree decl) -{ - return DECL_INITIAL (decl); -} - -tree -get_decl_name (tree decl) -{ - return DECL_NAME (decl); -} - -tree -get_decl_assembler_name (tree decl) -{ - return DECL_ASSEMBLER_NAME (decl); -} - -void -set_DECL_ASSEMBLER_NAME (tree decl, tree name) -{ - SET_DECL_ASSEMBLER_NAME (decl, name); -} - -void -set_decl_built_in_class (tree decl, enum built_in_class class) -{ - DECL_BUILT_IN_CLASS (decl) = class; -} - -void -set_decl_function_code (tree decl, int code) -{ - DECL_FUNCTION_CODE (decl) = code; -} - -tree -get_decl_field_offset (tree decl) -{ - return DECL_FIELD_OFFSET (decl); -} - -tree -get_decl_field_bit_offset (tree decl) -{ - return DECL_FIELD_BIT_OFFSET (decl); -} - -int -integral_type_p (tree type) -{ - return INTEGRAL_TYPE_P (type); -} - -void -set_type_values (tree type, tree values) -{ - TYPE_VALUES (type) = values; -} - -void -set_type_name (tree type, tree name) -{ - TYPE_NAME (type) = name; -} - -tree -get_type_name (tree type) -{ - return TYPE_NAME (type); -} - -void -set_type_min_value (tree type, tree val) -{ - TYPE_MIN_VALUE (type) = val; -} - -tree -get_type_min_value (tree type) -{ - return TYPE_MIN_VALUE (type); -} - -void -set_type_max_value (tree type, tree val) -{ - TYPE_MAX_VALUE (type) = val; -} - -tree -get_type_max_value (tree type) -{ - return TYPE_MAX_VALUE (type); -} - -void -set_type_size (tree type, tree size) -{ - TYPE_SIZE (type) = size; -} - -tree -get_type_size (tree type) -{ - return TYPE_SIZE (type); -} - -void -set_type_precision (tree type, int precision) -{ - TYPE_PRECISION (type) = precision; -} - -int -get_type_precision (tree type) -{ - return TYPE_PRECISION (type); -} - -void -set_type_fields (tree type, tree fields) -{ - TYPE_FIELDS (type) = fields; -} - -tree -get_type_fields (tree type) -{ - return TYPE_FIELDS (type); -} - -void -set_type_stub_decl (tree type, tree decl) -{ - TYPE_STUB_DECL (type) = decl; -} - -tree -get_type_domain (tree type) -{ - return TYPE_DOMAIN (type); -} - -void -set_type_domain (tree type, tree domain) -{ - TYPE_DOMAIN (type) = domain; -} - -void * -get_type_lang_specific (tree node) -{ - return TYPE_LANG_SPECIFIC (node); -} - -void -set_type_lang_specific (tree node, void *val) -{ - TYPE_LANG_SPECIFIC (node) = val; -} - -int -get_type_is_sizetype (tree node) -{ - return TYPE_IS_SIZETYPE (node); -} - -void -set_type_pointer_to (tree node, tree dnode) -{ - TYPE_POINTER_TO (node) = dnode; -} - -tree -get_type_pointer_to (tree node) -{ - return TYPE_POINTER_TO (node); -} - -enum machine_mode -get_type_mode (tree node) -{ - return TYPE_MODE (node); -} - -void -set_type_mode (tree node, enum machine_mode mode) -{ - TYPE_MODE (node) = mode; -} - -void -set_current_function_decl (tree decl) -{ - current_function_decl = decl; -} - -tree -get_current_function_decl (void) -{ - return current_function_decl; -} - -int -double_type_size (void) -{ - return DOUBLE_TYPE_SIZE; -} - -int -bits_per_unit (void) -{ - return BITS_PER_UNIT; -} - -tree -(size_int) (HOST_WIDE_INT number) -{ - return size_int (number); -} - -tree -get_type_size_unit (tree node) -{ - return TYPE_SIZE_UNIT (node); -} - -/* For agcc.real: */ -REAL_VALUE_TYPE -get_REAL_VALUE_ATOF (const char *s, enum machine_mode mode) -{ - return REAL_VALUE_ATOF (s, mode); -} - -REAL_VALUE_TYPE -get_REAL_VALUE_LDEXP (REAL_VALUE_TYPE x, int n) -{ - REAL_VALUE_TYPE res; - real_ldexp (&res, &x, n); - return res; -} - -void -get_REAL_VALUE_FROM_INT (REAL_VALUE_TYPE *d, HOST_WIDE_INT l, HOST_WIDE_INT h, - enum machine_mode mode) -{ - REAL_VALUE_FROM_INT (*d, l, h, mode); -} - -int -get_identifier_length (tree node) -{ - return IDENTIFIER_LENGTH (node); -} - -const char * -get_identifier_pointer (tree node) -{ - return IDENTIFIER_POINTER (node); -} - -tree -get_block_supercontext (tree node) -{ - return BLOCK_SUPERCONTEXT (node); -} - -void -set_block_supercontext (tree block, tree sc) -{ - BLOCK_SUPERCONTEXT (block) = sc; -} - -void -set_block_vars (tree block, tree vars) -{ - BLOCK_VARS (block) = vars; -} - -const int tree_identifier_size = sizeof (struct tree_identifier); - -#if 0 -static void -ggc_mark_tree_ptr (void *elt) -{ - ggc_mark_tree (*(tree *) elt); -} -#endif - -#undef ggc_mark_tree -void -ggc_mark_tree (tree expr) -{ - gt_ggc_m_9tree_node (expr); -} - -#if 0 -void -ggc_add_tree_root (void *base, int nelt) -{ - ggc_add_root (base, nelt, sizeof (tree), ggc_mark_tree_ptr); -} -#endif - -int -get_mode_bitsize (enum machine_mode mode) -{ - return GET_MODE_BITSIZE (mode); -} - -int -get_errorcount (void) -{ - return errorcount; -} - -void -set_errorcount (int c) -{ - errorcount = c; -} - - -/* Defined in agcc.fe */ -extern const char language_name[]; -extern bool lang_init (void); -extern void lang_finish (void); -extern unsigned int lang_init_options (unsigned int argc, const char **argv); -extern int lang_handle_option (size_t code, const char *argc, int value); -extern bool lang_post_options (const char **); -extern HOST_WIDE_INT lang_get_alias_set (tree t); -extern bool mark_addressable (tree t); - -extern int global_bindings_p (void); -extern int kept_level_p (void); -extern tree getdecls (void); -extern void pushlevel (int); -extern tree poplevel (int, int, int); -extern void insert_block (tree); -extern void set_block (tree); -extern tree pushdecl (tree); - -extern tree type_for_mode (enum machine_mode, int); -extern tree type_for_size (unsigned int, int); -extern tree unsigned_type (tree); -extern tree signed_type (tree); -extern tree signed_or_unsigned_type (int, tree); -extern tree truthvalue_conversion (tree); -extern void lang_parse_file (int); - -#undef LANG_HOOKS_NAME -#define LANG_HOOKS_NAME language_name -#undef LANG_HOOKS_IDENTIFIER_SIZE -#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) -#undef LANG_HOOKS_INIT -#define LANG_HOOKS_INIT lang_init -#undef LANG_HOOKS_FINISH -#define LANG_HOOKS_FINISH lang_finish -#undef LANG_HOOKS_INIT_OPTIONS -#define LANG_HOOKS_INIT_OPTIONS lang_init_options -#undef LANG_HOOKS_HANDLE_OPTION -#define LANG_HOOKS_HANDLE_OPTION lang_handle_option -#undef LANG_HOOKS_POST_OPTIONS -#define LANG_HOOKS_POST_OPTIONS lang_post_options -#undef LANG_HOOKS_GET_ALIAS_SET -#define LANG_HOOKS_GET_ALIAS_SET lang_get_alias_set -#undef LANG_HOOKS_HONOR_READONLY -#define LANG_HOOKS_HONOR_READONLY true -#undef LANG_HOOKS_TRUTHVALUE_CONVERSION -#define LANG_HOOKS_TRUTHVALUE_CONVERSION truthvalue_conversion -#undef LANG_HOOKS_MARK_ADDRESSABLE -#define LANG_HOOKS_MARK_ADDRESSABLE mark_addressable - -#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 lang_parse_file - -const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; - -/* Tree code classes. */ - -#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, - -const char tree_code_type[] = { -#include "tree.def" - 'x' -}; -#undef DEFTREECODE - -/* Table indexed by tree code giving number of expression - operands beyond the fixed part of the node structure. - Not used for types or decls. */ - -#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, - -const unsigned char tree_code_length[] = { -#include "tree.def" - 0 -}; -#undef DEFTREECODE - -#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) NAME, -const char * const tree_code_name[] = { -#include "tree.def" - "@@dummy" -}; -#undef DEFTREECODE - -union lang_tree_node - GTY((desc ("0"), - chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) -{ - union tree_node GTY ((tag ("0"), - desc ("tree_node_structure (&%h)"))) - generic; -}; - -struct lang_decl GTY(()) -{ -}; - -struct lang_type GTY (()) -{ -}; - -struct language_function GTY (()) -{ -}; - -tree -c_common_truthvalue_conversion (tree expr) -{ - if (TREE_CODE (TREE_TYPE (expr)) == BOOLEAN_TYPE) - return expr; - if (TREE_CODE (expr) == INTEGER_CST) - return integer_zerop (expr) ? integer_zero_node : integer_one_node; - - abort (); -} - -int -get_PROMOTE_PROTOTYPES (void) -{ - return PROMOTE_PROTOTYPES; -} - -struct binding_level GTY(()) -{ - tree names; - tree blocks; - tree block_created_by_back_end; - struct binding_level *level_chain; -}; - -extern GTY(()) struct binding_level *current_binding_level; -extern GTY((deletable (""))) struct binding_level *old_binding_level; - -struct binding_level * -alloc_binding_level (void) -{ - return (struct binding_level *)ggc_alloc (sizeof (struct binding_level)); -} - -#ifndef MAX_BITS_PER_WORD -#define MAX_BITS_PER_WORD BITS_PER_WORD -#endif - -extern GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2]; - -#include "debug.h" -#include "gt-vhdl-agcc-bindings.h" -#include "gtype-vhdl.h" - diff --git a/ortho/agcc/agcc-convert.ads b/ortho/agcc/agcc-convert.ads deleted file mode 100644 index 964dd81..0000000 --- a/ortho/agcc/agcc-convert.ads +++ /dev/null @@ -1,26 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; - -package Agcc.Convert is - function Convert_To_Integer (Atype : Tree; Expr : Tree) return Tree; - function Convert_To_Pointer (Atype : Tree; Expr : Tree) return Tree; -private - pragma Import (C, Convert_To_Integer); - pragma Import (C, Convert_To_Pointer); -end Agcc.Convert; diff --git a/ortho/agcc/agcc-diagnostic.ads b/ortho/agcc/agcc-diagnostic.ads deleted file mode 100644 index 4558896..0000000 --- a/ortho/agcc/agcc-diagnostic.ads +++ /dev/null @@ -1,24 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Diagnostic is - function Get_Errorcount return Integer; - procedure Set_Errorcount (Cnt : Integer); -private - pragma Import (C, Get_Errorcount); - pragma Import (C, Set_Errorcount); -end Agcc.Diagnostic; diff --git a/ortho/agcc/agcc-fe.ads b/ortho/agcc/agcc-fe.ads deleted file mode 100644 index 7c2b110..0000000 --- a/ortho/agcc/agcc-fe.ads +++ /dev/null @@ -1,238 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; -with Agcc.Machmode; use Agcc.Machmode; -with Agcc.Hwint; use Agcc.Hwint; -with Agcc.Options; use Agcc.Options; -with Interfaces.C_Streams; use Interfaces.C_Streams; -with C; use C; - -package Agcc.Fe is - -- Subprograms that must be defined by the front-end. - - -- Defined in langhooks.h - function Lang_Init_Options (Argc : Integer; Argv : C_String_Array) - return Integer; - - -- Front-end function expected by GCC. - function Lang_Handle_Option (Code : Opt_Code; - Arg : C_String; - Value : Integer) - return Integer; - - type C_String_Acc is access C_String; - pragma Convention (C, C_String_Acc); - - function Lang_Post_Options (Filename : C_String_Acc) return C_Bool; - - function Lang_Init return C_Bool; - - procedure Lang_Finish; - - --procedure Lang_Clear_Binding_Stack; - - -- Return the typed-based alias set for T, which may be an expression - -- or a type. Return -1 if we don't do anything special. - -- O means can alias everything. - function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT; - - --function Lang_Expand_Constant (N : Tree) return Tree; - - --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return C_Bool; - - procedure Lang_Parse_File (Debug : C_Bool); - - -- 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. - function Mark_Addressable (Exp : Tree) return C_Bool; - - -- Possibly apply default attributes to function FUNC represented by - -- a FUNCTION_DECL. - procedure Insert_Default_Attributes (Func : Tree); - - -- Lexical scopes. - -- Roughly speaking, it is used to mark declarations regions. - - -- Enter in a new lexical scope. INSIDE should be FALSE (TRUE iff called - -- from the inside of the front end, ie from gcc internal code). - procedure Pushlevel (Inside : C_Bool); - - -- Add a declaration to the current scope. - -- Note: GCC backend expect PUSHDECL to return its argument; however, - -- it is only seldom used. Both forms exist and are aliased with a third - -- one which is exported under the C name. - -- (Unfortunatly, it is not possible to export the function and to import - -- the procedure). - procedure Pushdecl (Decl : Tree); - function Pushdecl (Decl : Tree) return Tree; - - -- This function has to be defined. - function Exported_Pushdecl (Decl : Tree) return Tree; - - -- Get the declarations of the current scope. - function Getdecls return Tree; - - procedure Set_Block (Block : Tree); - - -- Return non-zero if we are currently in the global binding level. - function Global_Bindings_P return Integer; - - -- Insert BLOCK at the end of the list of subblocks of the - -- current binding level. This is used when a BIND_EXPR is expanded, - -- to handle the BLOCK node inside the BIND_EXPR. - procedure Insert_Block (Block : Tree); - - -- Exit the current scope. - -- FUNCTIONBODY is TRUE iff the scope corresponds to a subprogram scope. - -- Used forms (both imported). - procedure Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool); - function Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool) - return Tree; - - -- Exported form. - function Exported_Poplevel - (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool) - return Tree; - - -- Perform all the initialization steps that are language-specific. - --procedure Lang_Init; - - -- Perform all the finalization steps that are language-specific. - --procedure Lang_Finish; - - -- 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. - function Type_For_Size (Precision : Natural; Unsignedp : C_Bool) - return Tree; - - -- Return a data type that has machine mode MODE. UNSIGNEDP selects - -- an unsigned type; otherwise a signed type is returned. - function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool) - return Tree; - - -- Return the unsigned version of a TYPE_NODE, a scalar type. - function Unsigned_Type (Type_Node : Tree) return Tree; - - -- Return the signed version of a TYPE_NODE, a scalar type. - function Signed_Type (Type_Node : Tree) return Tree; - - -- Return a type the same as TYPE except unsigned or signed according to - -- UNSIGNEDP. - function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree) - return Tree; - - -- 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. - function Builtin_Function - (Name: System.Address; - Ftype : Tree; - Function_Code : Built_In_Function; - Class : Built_In_Class; - Library_Name : System.Address) - return Tree; - - -- Set debug flag of the parser. - procedure Set_Yydebug (Flag : C_Bool); - - - -- Hooks for print-tree.c: - procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural); - procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural); - procedure Print_Lang_Identifier - (File : FILEs; Node : Tree; Indent : Natural); - procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural); - - -- Print any language-specific compilation statistics. - procedure Print_Lang_Statistics; - - - -- Finish to copy a ..._DECL node (the LANG_DECL_SPECIFIC field). - procedure Copy_Lang_Decl (Node : Tree); - - -- Normalize boolean value EXPR. - function Truthvalue_Conversion (Expr : Tree) return Tree; - - -- Procedure called in case of sizeof applied to an incomplete type. - procedure Incomplete_Type_Error (Value : Tree; Atype : Tree); - - -- This function must be defined in the language-specific files. - -- expand_expr calls it to build the cleanup-expression for a TARGET_EXPR. - function Maybe_Build_Cleanup (Decl : Tree) return Tree; - - --Language_String : constant Chars; - Flag_Traditional : Integer := 0; -private - pragma Export (C, Lang_Init_Options); - pragma Export (C, Lang_Handle_Option); - pragma Export (C, Lang_Post_Options); - pragma Export (C, Lang_Init); - pragma Export (C, Lang_Finish); - pragma Export (C, Lang_Get_Alias_Set); - - pragma Export (C, Lang_Parse_File); - - pragma Export (C, Mark_Addressable); - pragma Export (C, Insert_Default_Attributes); - - pragma Import (C, Pushdecl); - pragma Export (C, Exported_Pushdecl, "pushdecl"); - pragma Export (C, Pushlevel); - pragma Export (C, Set_Block); - pragma Export (C, Insert_Block); - pragma Export (C, Global_Bindings_P); - pragma Import (C, Poplevel); - pragma Export (C, Exported_Poplevel, "poplevel"); - pragma Export (C, Getdecls); - - pragma Export (C, Type_For_Size); - pragma Export (C, Type_For_Mode); - pragma Export (C, Unsigned_Type); - pragma Export (C, Signed_Type); - pragma Export (C, Signed_Or_Unsigned_Type); - - pragma Export (C, Builtin_Function); - - - pragma Export (C, Set_Yydebug); - - pragma Export (C, Print_Lang_Decl); - pragma Export (C, Print_Lang_Type); - pragma Export (C, Print_Lang_Identifier); - pragma Export (C, Lang_Print_Xnode); - - pragma Export (C, Print_Lang_Statistics); - pragma Export (C, Copy_Lang_Decl); - - pragma Export (C, Truthvalue_Conversion); - pragma Export (C, Incomplete_Type_Error); - pragma Export (C, Maybe_Build_Cleanup); - - pragma Export (C, Flag_Traditional); -end Agcc.Fe; - diff --git a/ortho/agcc/agcc-ggc.ads b/ortho/agcc/agcc-ggc.ads deleted file mode 100644 index 4892d59..0000000 --- a/ortho/agcc/agcc-ggc.ads +++ /dev/null @@ -1,33 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; - -package Agcc.Ggc is - procedure Ggc_Add_Root (Base : System.Address; - Nelt : Natural; - Size : Natural; - Func : System.Address); - - procedure Ggc_Add_Tree_Root (Base : System.Address; Nelt : Natural); - - procedure Ggc_Mark_Tree (Expr : Tree); -private - pragma Import (C, Ggc_Add_Root); - pragma Import (C, Ggc_Mark_Tree); - pragma Import (C, Ggc_Add_Tree_Root); -end Agcc.Ggc; diff --git a/ortho/agcc/agcc-ghdl.c b/ortho/agcc/agcc-ghdl.c deleted file mode 100644 index 211d5e0..0000000 --- a/ortho/agcc/agcc-ghdl.c +++ /dev/null @@ -1,658 +0,0 @@ -/* Ada bindings for GCC internals. - Copyright (C) 2002, 2003, 2004, 2005 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. -*/ -#include "config.h" -#include "system.h" -#include "tree.h" -#include "flags.h" -#include <stdio.h> - -#if 0 -const char *const language_string = "ghdl"; -int flag_traditional; -#endif - -/* Convertion from a C string to the corresponding cannonical - Ada (GNAT) String. */ -struct str_template -{ - int first; - int last; -}; - -struct str_fatptr -{ - const char *array; - struct str_template *tpl; -}; - -#if 0 -/* Called by toplev.c, to initialize the parser. */ -const char * -init_parse (const char *filename) -{ - struct str_template temp1 = {1, strlen (filename)}; - struct str_fatptr fp = {filename, &temp1}; - - ghdl1__init_parse (fp); - return filename; -} -#endif - -void -lang_init_options (void) -{ - extern int gnat_argc; - extern const char **gnat_argv; - extern const char *progname; - - /* Initialize ada.command_line. */ - gnat_argc = 1; - gnat_argv = &progname; - - adainit (); -} - -#if 0 -/* Decode all the language specific options that cannot be decoded by GCC. The - option decoding phase of GCC calls this routine on the flags that it cannot - decode. Return 1 if successful, otherwise return 0. */ - -int -lang_decode_option (argc, argv) - int argc; - char **argv; -{ - return 0; -} - -void -lang_print_xnode(file, t, i) - FILE *file; - tree t; - int i; -{ - return; -} - -/* Routines Expected by gcc: */ - -/* These are used to build types for various sizes. The code below - is a simplified version of that of GNAT. */ - -#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 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. */ - -tree -type_for_size (precision, unsignedp) - unsigned precision; - int unsignedp; -{ - tree t; - - if (precision <= MAX_BITS_PER_WORD - && signed_and_unsigned_types[precision][unsignedp] != 0) - return signed_and_unsigned_types[precision][unsignedp]; - - if (unsignedp) - t = signed_and_unsigned_types[precision][1] - = make_unsigned_type (precision); - else - t = signed_and_unsigned_types[precision][0] - = make_signed_type (precision); - - return t; -} - - -/* Return a data type that has machine mode MODE. UNSIGNEDP selects - an unsigned type; otherwise a signed type is returned. */ - -tree -type_for_mode (mode, unsignedp) - enum machine_mode mode; - int unsignedp; -{ - return type_for_size (GET_MODE_BITSIZE (mode), unsignedp); -} - -/* Return the unsigned version of a TYPE_NODE, a scalar type. */ - -tree -unsigned_type (type_node) - tree type_node; -{ - return type_for_size (TYPE_PRECISION (type_node), 1); -} - -/* Return the signed version of a TYPE_NODE, a scalar type. */ - -tree -signed_type (type_node) - tree type_node; -{ - return type_for_size (TYPE_PRECISION (type_node), 0); -} - -/* Return a type the same as TYPE except unsigned or signed according to - UNSIGNEDP. */ - -tree -signed_or_unsigned_type (unsignedp, type) - int unsignedp; - tree type; -{ - if (! INTEGRAL_TYPE_P (type) || TREE_UNSIGNED (type) == unsignedp) - return type; - else - return type_for_size (TYPE_PRECISION (type), unsignedp); -} - -void -init_type_for_size (void) -{ - ggc_add_tree_root (signed_and_unsigned_types, - sizeof (signed_and_unsigned_types) / sizeof (tree)); -} -#endif - - -#if 0 -/* These functions and variables deal with binding contours. We only - need these functions for the list of PARM_DECLs, but we leave the - functions more general; these are a simplified version of the - functions from GNAT. */ - -/* For each binding contour we allocate a binding_level structure which records - the entities defined or declared in that contour. Contours include: - - the global one - one for each subprogram definition - one for each compound statement (declare block) - - Binding contours are used to create GCC tree BLOCK nodes. */ - -struct binding_level -{ - /* A chain of ..._DECL nodes for all variables, constants, functions, - parameters and type declarations. These ..._DECL nodes are chained - through the TREE_CHAIN field. Note that these ..._DECL nodes are stored - in the reverse of the order supplied to be compatible with the - back-end. */ - tree names; - /* For each level (except the global one), a chain of BLOCK nodes for all - the levels that were entered and exited one level down from this one. */ - tree blocks; - /* The back end may need, for its own internal processing, to create a BLOCK - node. This field is set aside for this purpose. If this field is non-null - when the level is popped, i.e. when poplevel is invoked, we will use such - block instead of creating a new one from the 'names' field, that is the - ..._DECL nodes accumulated so far. Typically the routine 'pushlevel' - will be called before setting this field, so that if the front-end had - inserted ..._DECL nodes in the current block they will not be lost. */ - tree block_created_by_back_end; - /* The binding level containing this one (the enclosing binding level). */ - struct binding_level *level_chain; -}; - -/* The binding level currently in effect. */ -static struct binding_level *current_binding_level = NULL; - -/* The outermost binding level. This binding level is created when the - compiler is started and it will exist through the entire compilation. */ -static struct binding_level *global_binding_level; - -/* Binding level structures are initialized by copying this one. */ -static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL}; - -/* Return non-zero if we are currently in the global binding level. */ - -int -global_bindings_p () -{ - return current_binding_level == global_binding_level ? -1 : 0; -} - -/* Return the list of declarations in the current level. Note that this list - is in reverse order (it has to be so for back-end compatibility). */ - -tree -getdecls () -{ - return current_binding_level->names; -} - -/* Nonzero if the current level needs to have a BLOCK made. */ - -int -kept_level_p () -{ - return (current_binding_level->names != 0); -} - -/* Enter a new binding level. The input parameter is ignored, but has to be - specified for back-end compatibility. */ - -void -pushlevel (ignore) - int ignore; -{ - struct binding_level *newlevel - = (struct binding_level *) xmalloc (sizeof (struct binding_level)); - - *newlevel = clear_binding_level; - - /* Add this level to the front of the chain (stack) of levels that are - active. */ - newlevel->level_chain = current_binding_level; - current_binding_level = newlevel; -} - -/* Exit a binding level. - Pop the level off, and restore the state of the identifier-decl mappings - that were in effect when this level was entered. - - If KEEP is nonzero, this level had explicit declarations, so - and create a "block" (a BLOCK node) for the level - to record its declarations and subblocks for symbol table output. - - If FUNCTIONBODY is nonzero, this level is the body of a function, - so create a block as if KEEP were set and also clear out all - label names. - - If REVERSE is nonzero, reverse the order of decls before putting - them into the BLOCK. */ - -tree -poplevel (keep, reverse, functionbody) - int keep; - int reverse; - int functionbody; -{ - /* Points to a BLOCK tree node. This is the BLOCK node construted for the - binding level that we are about to exit and which is returned by this - routine. */ - tree block_node = NULL_TREE; - tree decl_chain; - tree decl_node; - tree subblock_chain = current_binding_level->blocks; - tree subblock_node; - tree block_created_by_back_end; - - /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL - nodes chained through the `names' field of current_binding_level are in - reverse order except for PARM_DECL node, which are explicitely stored in - the right order. */ - decl_chain = (reverse) ? nreverse (current_binding_level->names) - : current_binding_level->names; - - block_created_by_back_end = current_binding_level->block_created_by_back_end; - if (block_created_by_back_end != 0) - { - block_node = block_created_by_back_end; - - /* Check if we are about to discard some information that was gathered - by the front-end. Nameley check if the back-end created a new block - without calling pushlevel first. To understand why things are lost - just look at the next case (i.e. no block created by back-end. */ - if ((keep || functionbody) && (decl_chain || subblock_chain)) - abort (); - } - - /* If there were any declarations in the current binding level, or if this - binding level is a function body, or if there are any nested blocks then - create a BLOCK node to record them for the life of this function. */ - else if (keep || functionbody) - block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0); - - /* Record the BLOCK node just built as the subblock its enclosing scope. */ - for (subblock_node = subblock_chain; subblock_node; - subblock_node = TREE_CHAIN (subblock_node)) - BLOCK_SUPERCONTEXT (subblock_node) = block_node; - - /* Clear out the meanings of the local variables of this level. */ - - for (subblock_node = decl_chain; subblock_node; - subblock_node = TREE_CHAIN (subblock_node)) - if (DECL_NAME (subblock_node) != 0) - /* If the identifier was used or addressed via a local extern decl, - don't forget that fact. */ - if (DECL_EXTERNAL (subblock_node)) - { - if (TREE_USED (subblock_node)) - TREE_USED (DECL_NAME (subblock_node)) = 1; - if (TREE_ADDRESSABLE (subblock_node)) - TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1; - } - - /* Pop the current level. */ - current_binding_level = current_binding_level->level_chain; - - if (functionbody) - { - /* This is the top level block of a function. The ..._DECL chain stored - in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't - leave them in the BLOCK because they are found in the FUNCTION_DECL - instead. */ - DECL_INITIAL (current_function_decl) = block_node; - BLOCK_VARS (block_node) = 0; - } - else if (block_node) - { - if (block_created_by_back_end == NULL) - current_binding_level->blocks - = chainon (current_binding_level->blocks, block_node); - } - - /* If we did not make a block for the level just exited, any blocks made for - inner levels (since they cannot be recorded as subblocks in that level) - must be carried forward so they will later become subblocks of something - else. */ - else if (subblock_chain) - current_binding_level->blocks - = chainon (current_binding_level->blocks, subblock_chain); - if (block_node) - TREE_USED (block_node) = 1; - - return block_node; -} - -/* Insert BLOCK at the end of the list of subblocks of the - current binding level. This is used when a BIND_EXPR is expanded, - to handle the BLOCK node inside the BIND_EXPR. */ - -void -insert_block (block) - tree block; -{ - TREE_USED (block) = 1; - current_binding_level->blocks - = chainon (current_binding_level->blocks, block); -} - -/* Set the BLOCK node for the innermost scope - (the one we are currently in). */ - -void -set_block (block) - tree block; -{ - current_binding_level->block_created_by_back_end = block; -} - -/* Records a ..._DECL node DECL as belonging to the current lexical scope. - Returns the ..._DECL node. */ - -tree -pushdecl (decl) - tree decl; -{ - /* External objects aren't nested, other objects may be. */ - if (DECL_EXTERNAL (decl)) - DECL_CONTEXT (decl) = 0; - else - DECL_CONTEXT (decl) = current_function_decl; - - /* Put the declaration on the list. The list of declarations is in reverse - order. The list will be reversed later if necessary. This needs to be - this way for compatibility with the back-end. */ - - TREE_CHAIN (decl) = current_binding_level->names; - current_binding_level->names = decl; - - /* For the declaration of a type, set its name if it is not already set. */ - - if (TREE_CODE (decl) == TYPE_DECL - && TYPE_NAME (TREE_TYPE (decl)) == 0) - TYPE_NAME (TREE_TYPE (decl)) = decl; /* DECL_NAME (decl); */ - - return decl; -} -#endif - -#ifndef CHAR_TYPE_SIZE -#define CHAR_TYPE_SIZE BITS_PER_UNIT -#endif - -#ifndef INT_TYPE_SIZE -#define INT_TYPE_SIZE BITS_PER_WORD -#endif - -#undef SIZE_TYPE -#define SIZE_TYPE "long unsigned int" - -#if 0 -/* Create the predefined scalar types such as `integer_type_node' needed - in the gcc back-end and initialize the global binding level. */ - -void -init_decl_processing () -{ - tree endlink; - - error_mark_node = make_node (ERROR_MARK); - TREE_TYPE (error_mark_node) = error_mark_node; - - initialize_sizetypes (); - - /* The structure `tree_identifier' is the GCC tree data structure that holds - IDENTIFIER_NODE nodes. We need to call `set_identifier_size' to tell GCC - that we have not added any language specific fields to IDENTIFIER_NODE - nodes. */ - set_identifier_size (sizeof (struct tree_identifier)); - lineno = 0; - - /* Make the binding_level structure for global names. */ - pushlevel (0); - global_binding_level = current_binding_level; - - build_common_tree_nodes (0); - pushdecl (build_decl (TYPE_DECL, get_identifier ("int"), - integer_type_node)); - pushdecl (build_decl (TYPE_DECL, get_identifier ("char"), - char_type_node)); - set_sizetype (unsigned_type_node); - build_common_tree_nodes_2 (0); - -} -#endif - - -#if 0 -/* Perform all the initialization steps that are language-specific. */ - -void -lang_init () -{} - -/* Perform all the finalization steps that are language-specific. */ - -void -lang_finish () -{} - -/* Return a short string identifying this language to the debugger. */ - -const char * -lang_identify () -{ - return "vhdl"; -} - -/* If DECL has a cleanup, build and return that cleanup here. - This is a callback called by expand_expr. */ - -tree -maybe_build_cleanup (decl) - tree decl; -{ return NULL_TREE; } - -/* Print an error message for invalid use of an incomplete type. */ - -void -incomplete_type_error (dont_care_1, dont_care_2) - tree dont_care_1, dont_care_2; -{ abort (); } - -tree -truthvalue_conversion (expr) - tree expr; -{ return expr;} - -int -mark_addressable (expr) - tree expr; -{return 0;} -#endif - -#if 0 -/* Print any language-specific compilation statistics. */ - -void -print_lang_statistics () -{} - -/* Since we don't use the DECL_LANG_SPECIFIC field, this is a no-op. */ - -void -copy_lang_decl (node) - tree node; -{} - -/* Hooks for print-tree.c: */ - -void -print_lang_decl (file, node, indent) - FILE *file; - tree node; - int indent; -{} - -void -print_lang_type (file, node, indent) - FILE *file; - tree node; - int indent; -{} - -void -print_lang_identifier (file, node, indent) - FILE *file; - tree node; - int indent; -{} -#endif - -#if 0 -/* Performs whatever initialization steps are needed by the language-dependent - lexical analyzer. */ - -void -init_lex () -{} - - -/* Sets some debug flags for the parser. It does nothing here. */ - -void -set_yydebug (value) - int value; -{} -#endif - -#if 0 -/* Routine to print parse error message. */ -void -yyerror (str) - char *str; -{ - fprintf (stderr, "%s\n", str); -} -#endif - -#if 0 -/* Return the typed-based alias set for T, which may be an expression - or a type. Return -1 if we don't do anything special. */ - -HOST_WIDE_INT -lang_get_alias_set (t) - tree t ATTRIBUTE_UNUSED; -{ - return -1; -} -#endif - -#if 0 -/* 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. */ - -tree -builtin_function (name, type, function_code, class, library_name) - const char *name; - tree type; - int function_code; - enum built_in_class class; - const char *library_name; -{ - tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); - DECL_EXTERNAL (decl) = 1; - TREE_PUBLIC (decl) = 1; - if (library_name) - DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); - make_decl_rtl (decl, NULL_PTR, 1); - pushdecl (decl); - DECL_BUILT_IN_CLASS (decl) = class; - DECL_FUNCTION_CODE (decl) = function_code; - return decl; -} -#endif - -#if 0 -/* Mark language-specific parts of T for garbage-collection. */ - -void -lang_mark_tree (t) - tree t ATTRIBUTE_UNUSED; -{ -} -#endif - -void -print_chain (tree t) -{ - while (t != NULL) - { - print_node_brief (stdout, "", t, 0); - fprintf (stdout, "\n"); - t = TREE_CHAIN (t); - } -} diff --git a/ortho/agcc/agcc-hconfig.ads.in b/ortho/agcc/agcc-hconfig.ads.in deleted file mode 100644 index 3662c95..0000000 --- a/ortho/agcc/agcc-hconfig.ads.in +++ /dev/null @@ -1,21 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Hconfig is -@host_big_endian -end Agcc.Hconfig; diff --git a/ortho/agcc/agcc-hwint.ads.in b/ortho/agcc/agcc-hwint.ads.in deleted file mode 100644 index 245f211..0000000 --- a/ortho/agcc/agcc-hwint.ads.in +++ /dev/null @@ -1,23 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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 Interfaces; - -package Agcc.Hwint is - pragma Preelaborate (Agcc.Hwint); -@host_wide_int -end Agcc.Hwint; diff --git a/ortho/agcc/agcc-input.ads b/ortho/agcc/agcc-input.ads deleted file mode 100644 index d7ff5ec..0000000 --- a/ortho/agcc/agcc-input.ads +++ /dev/null @@ -1,29 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Input is - type Location_T is record - File : Chars; - Line : Integer; - end record; - pragma Convention (C_Pass_By_Copy, Location_T); - - Input_Location : Location_T; - pragma Import (C, Input_Location); -end Agcc.Input; - - diff --git a/ortho/agcc/agcc-libiberty.ads b/ortho/agcc/agcc-libiberty.ads deleted file mode 100644 index 89784b7..0000000 --- a/ortho/agcc/agcc-libiberty.ads +++ /dev/null @@ -1,21 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Libiberty is - function Xmalloc (Size : Size_T) return Chars; - pragma Import (C, Xmalloc); -end Agcc.Libiberty; diff --git a/ortho/agcc/agcc-machmode.ads.in b/ortho/agcc/agcc-machmode.ads.in deleted file mode 100644 index ccc6980..0000000 --- a/ortho/agcc/agcc-machmode.ads.in +++ /dev/null @@ -1,35 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Machmode is - pragma Preelaborate (Agcc.Machmode); - - type Machine_Mode is - ( -@machmode - ); - pragma Convention (C, Machine_Mode); - - function GET_MODE_BITSIZE (Mode : Machine_Mode) return Natural; - Ptr_Mode : Machine_Mode; - -private - pragma Import (C, GET_MODE_BITSIZE); - pragma Import (C, Ptr_Mode); -end Agcc.Machmode; - diff --git a/ortho/agcc/agcc-options.ads.in b/ortho/agcc/agcc-options.ads.in deleted file mode 100644 index 8931edd..0000000 --- a/ortho/agcc/agcc-options.ads.in +++ /dev/null @@ -1,31 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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. - --- This file is preprocessed by gen_tree to create agcc-options.ads - -package Agcc.Options is - -@options_CL - - type Opt_Code is - ( -@options_OPTs - ); - - pragma Convention (C, Opt_Code); -end Agcc.Options; diff --git a/ortho/agcc/agcc-output.ads b/ortho/agcc/agcc-output.ads deleted file mode 100644 index 6ecab6e..0000000 --- a/ortho/agcc/agcc-output.ads +++ /dev/null @@ -1,24 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; - -package Agcc.Output is - procedure Make_Function_Rtl (Func : Tree); -private - pragma Import (C, Make_Function_Rtl); -end Agcc.Output; diff --git a/ortho/agcc/agcc-real.ads.in b/ortho/agcc/agcc-real.ads.in deleted file mode 100644 index ec6b080..0000000 --- a/ortho/agcc/agcc-real.ads.in +++ /dev/null @@ -1,42 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Hwint; use Agcc.Hwint; -with Agcc.Machmode; use Agcc.Machmode; - -package Agcc.Real is - pragma Preelaborate (Agcc.Real); - - type REAL_VALUE_TYPE is private; - - function REAL_VALUE_ATOF (S : System.Address; M : Machine_Mode) - return REAL_VALUE_TYPE; - - function REAL_VALUE_LDEXP (X : REAL_VALUE_TYPE; N : Integer) - return REAL_VALUE_TYPE; - - procedure REAL_VALUE_FROM_INT (D : System.Address; - Lo, Hi : HOST_WIDE_INT; - Mode : Machine_Mode); -private -@real - -- FIXME: check about the convention on other machines. - pragma Convention (C_Pass_By_Copy, REAL_VALUE_TYPE); - pragma Import (C, REAL_VALUE_ATOF, "get_REAL_VALUE_ATOF"); - pragma Import (C, REAL_VALUE_LDEXP, "get_REAL_VALUE_LDEXP"); - pragma Import (C, REAL_VALUE_FROM_INT, "get_REAL_VALUE_FROM_INT"); -end Agcc.Real; diff --git a/ortho/agcc/agcc-rtl.ads b/ortho/agcc/agcc-rtl.ads deleted file mode 100644 index e45143a..0000000 --- a/ortho/agcc/agcc-rtl.ads +++ /dev/null @@ -1,31 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Input; use Agcc.Input; -with System; - -package Agcc.Rtl is - -- Defines RTX as an opaque type. - type Rtx is new System.Address; - - procedure Emit_Line_Note (Loc : Location_T); - function Emit_Line_Note (Loc : Location_T) return Rtx; - procedure Emit_Nop; -private - pragma Import (C, Emit_Line_Note); - pragma Import (C, Emit_Nop); -end Agcc.Rtl; diff --git a/ortho/agcc/agcc-stor_layout.ads b/ortho/agcc/agcc-stor_layout.ads deleted file mode 100644 index aeaa4d7..0000000 --- a/ortho/agcc/agcc-stor_layout.ads +++ /dev/null @@ -1,24 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; - -package Agcc.Stor_Layout is - procedure Fixup_Unsigned_Type (Atype : Tree); -private - pragma Import (C, Fixup_Unsigned_Type); -end Agcc.Stor_Layout; diff --git a/ortho/agcc/agcc-tm.ads.in b/ortho/agcc/agcc-tm.ads.in deleted file mode 100644 index 7fea03c..0000000 --- a/ortho/agcc/agcc-tm.ads.in +++ /dev/null @@ -1,37 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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. - --- Definitions about target machine. - -package Agcc.Tm is - pragma Preelaborate (Agcc.Tm); - - function DOUBLE_TYPE_SIZE return Natural; - function LONG_DOUBLE_TYPE_SIZE return Natural; - function BITS_PER_UNIT return Natural; - function BITS_PER_WORD return Natural; - function PROMOTE_PROTOTYPES return C_Bool; -@tm -private - pragma Import (C, DOUBLE_TYPE_SIZE); - pragma Import (C, LONG_DOUBLE_TYPE_SIZE); - pragma Import (C, BITS_PER_UNIT); - pragma Import (C, BITS_PER_WORD); - pragma Import (C, PROMOTE_PROTOTYPES, "get_PROMOTE_PROTOTYPES"); -end Agcc.Tm; - diff --git a/ortho/agcc/agcc-toplev.ads b/ortho/agcc/agcc-toplev.ads deleted file mode 100644 index a816f54..0000000 --- a/ortho/agcc/agcc-toplev.ads +++ /dev/null @@ -1,51 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees; use Agcc.Trees; -with System; -with Agcc.Hwint; use Agcc.Hwint; - -package Agcc.Toplev is - procedure Rest_Of_Decl_Compilation (Decl : Tree; - Asmspec : System.Address; - Top_Level : C_Bool; - At_End : C_Bool); - procedure Rest_Of_Type_Compilation (Decl : Tree; Toplevel : C_Bool); - procedure Rest_Of_Compilation (Decl : Tree); - - function Exact_Log2_Wide (X : HOST_WIDE_INT) return Integer; - function Floor_Log2_Wide (X : HOST_WIDE_INT) return Integer; - - procedure Error (Msg : System.Address); - - procedure Announce_Function (Func : Tree); - - function Toplev_Main (Argc : Integer; Argv : System.Address) - return Integer; -private - pragma Import (C, Rest_Of_Decl_Compilation); - pragma Import (C, Rest_Of_Type_Compilation); - pragma Import (C, Rest_Of_Compilation); - - pragma Import (C, Exact_Log2_Wide); - pragma Import (C, Floor_Log2_Wide); - - pragma Import (C, Error); - - pragma Import (C, Announce_Function); - pragma Import (C, Toplev_Main); -end Agcc.Toplev; diff --git a/ortho/agcc/agcc-trees.adb b/ortho/agcc/agcc-trees.adb deleted file mode 100644 index a13aba3..0000000 --- a/ortho/agcc/agcc-trees.adb +++ /dev/null @@ -1,33 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc.Trees is - function Build_Int (Low : HOST_WIDE_INT) return Tree is - begin - if Low < 0 then - return Build_Int_2_Wide (Low, -1); - else - return Build_Int_2_Wide (Low, 0); - end if; - end Build_Int; - - procedure Expand_Start_Bindings (Flags : Integer) is - begin - Expand_Start_Bindings_And_Block (Flags, NULL_TREE); - end Expand_Start_Bindings; - -end Agcc.Trees; diff --git a/ortho/agcc/agcc-trees.ads.in b/ortho/agcc/agcc-trees.ads.in deleted file mode 100644 index 5eb2d58..0000000 --- a/ortho/agcc/agcc-trees.ads.in +++ /dev/null @@ -1,514 +0,0 @@ --- Ada bindings for GCC internals. -*- Ada -*- --- Copyright (C) 2002, 2003, 2004, 2005 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. - --- This file is preprocessed by gen_tree to create agcc-trees.ads --- gen_tree adds enumerations from GCC C files. - -with System; use System; -with Agcc.Hwint; use Agcc.Hwint; -with Agcc.Real; use Agcc.Real; -with Agcc.Machmode; use Agcc.Machmode; - -package Agcc.Trees is - --pragma No_Elaboration_Code (Agcc.Trees); - - type Tree is new System.Address; - - NULL_TREE : constant Tree; - - type Tree_Code is - ( -@tree_code - ); - pragma Convention (C, Tree_Code); - - type Built_In_Class is - (NOT_BUILT_IN, BUILT_IN_FRONTEND, BUILT_IN_MD, BUILT_IN_NORMAL); - pragma Convention (C, Built_In_Class); - - type Built_In_Function is - ( -@built_in_function - ); - pragma Convention (C, Built_In_Function); - - type Tree_Index is - ( -@tree_index - ); - - type Type_Qual_Type is new Integer; -@type_qual - - type Global_Trees_Array is array (Tree_Index) of Tree; - pragma Convention (C, Global_Trees_Array); - Global_Trees : Global_Trees_Array; - pragma Import (C, Global_Trees); - - Error_Mark_Node : Tree renames Global_Trees (TI_ERROR_MARK); - Void_Type_Node : Tree renames Global_Trees (TI_VOID_TYPE); - Ptr_Type_Node : Tree renames Global_Trees (TI_PTR_TYPE); - Const_Ptr_Type_Node : Tree renames Global_Trees (TI_CONST_PTR_TYPE); - Integer_Zero_Node : Tree renames Global_Trees (TI_INTEGER_ZERO); - Integer_One_Node : Tree renames Global_Trees (TI_INTEGER_ONE); - Size_Zero_Node : Tree renames Global_Trees (TI_SIZE_ZERO); - - type Size_Type_Kind is - ( -@size_type_kind - ); - - type Sizetype_Tab_Array is array (Size_Type_Kind) of Tree; - pragma Convention (C, Sizetype_Tab_Array); - Sizetype_Tab : Sizetype_Tab_Array; - pragma Import (C, Sizetype_Tab); - - Bitsizetype : Tree renames Sizetype_Tab (TK_BITSIZETYPE); - Sizetype : Tree renames Sizetype_Tab (TK_SIZETYPE); - - type Integer_Types_Kind is - ( -@integer_types - ); - - type Integer_Types_Array is array (Integer_Types_Kind) of Tree; - pragma Convention (C, Integer_Types_Array); - Integer_Types : Integer_Types_Array; - pragma Import (C, Integer_Types); - - Integer_Type_Node : Tree renames Integer_Types (itk_int); - Unsigned_Type_Node : Tree renames Integer_Types (itk_unsigned_int); - Char_Type_Node : Tree renames Integer_Types (itk_char); - - function Build (Code: Tree_Code; T: Tree; O0, O1: Tree) return Tree; - function Build (Code: Tree_Code; T: Tree; O0, O1, O2: Tree) return Tree; - function Build1 (Code: Tree_Code; T: Tree; O: Tree) return Tree; - function Build_Constructor (T : Tree; V : Tree) return Tree; - function Build_Block (Vars : Tree; - Tags : Tree; - Subblocks : Tree; - Supercontext : Tree; - Chain : Tree) - return Tree; - function Build_Decl (Code : Tree_Code; T1 : Tree; T2: Tree) return Tree; - function Build_Int_2 (Low, Hi: HOST_WIDE_INT) return Tree; - function Build_Int_2_Wide (Low, Hi: HOST_WIDE_INT) return Tree; - function Build_Real (Rtype : Tree; D : REAL_VALUE_TYPE) return Tree; - function Build_Function_Type (Value_Type : Tree; Arg_Type : Tree) - return Tree; - function Build_Pointer_Type (Atype : Tree) return Tree; - function Get_Identifier (Str : System.Address) return Tree; - function Build_String (Len : Integer; Str : System.Address) return Tree; - function Build_Index_Type (Max : Tree) return Tree; - function Build_Range_Type (Basetype : Tree; Low : Tree; High : Tree) - return Tree; - function Build_Array_Type (El_Type : Tree; Domain : Tree) return Tree; - function Make_Node (Code : Tree_Code) return Tree; - function Build_Qualified_Type (Atype : Tree; Qual : Type_Qual_Type) - return Tree; - - function Build_Save_Expr (Expr : Tree) return Tree; - - function Make_Signed_Type (Precision : Natural) return Tree; - function Make_Unsigned_Type (Precision : Natural) return Tree; - procedure Initialize_Sizetypes; - procedure Set_Sizetype (Atype : Tree); - - function Host_Integerp (T : Tree; Pos : Integer) return Integer; - - function Chainon (Op1, Op2 : Tree) return Tree; - function Listify (Node : Tree) return Tree; - function Tree_Cons (Purpose : Tree; Value : Tree; Chain : Tree) - return Tree; - function Nreverse (Chain : Tree) return Tree; - function Build_Tree_List (Purpose : Tree; Value : Tree) return Tree; - - function Size_In_Bytes (Decl : Tree) return Tree; - procedure Set_Identifier_Size (Size : Natural); - - function Get_Inner_Reference - (Exp : Tree; - Pbitsize : Address; -- HOST_WIDE_INT pointer - Pbitpos : Address; -- HOST_WIDE_INT pointer - Poffset : Address; -- Tree pointer - Pmode : Address; -- MACHINE_MODE pointer - Punsignedp : Address; -- int pointer - Pvolatilep : Address) -- int pointer - return Tree; - - Current_Function_Decl : Tree; - - function Integer_Zerop (Expr : Tree) return C_Bool; - function Integer_Onep (Expr : Tree) return C_Bool; - function Real_Zerop (Expr : Tree) return C_Bool; - - procedure Layout_Type (Atype : Tree); - procedure Layout_Decl (Decl : Tree; Align : Natural); - - procedure Expand_Start_Bindings_And_Block (Flags : Integer; Block : Tree); - procedure Expand_Start_Bindings (Flags : Integer); - procedure Expand_End_Bindings - (Vars : Tree; Mark_Ends: C_Bool; Dont_Jump_In : C_Bool); - - procedure Init_Function_Start - (Subr : Tree; Filename : Chars; Line : Integer); - procedure Expand_Function_Start - (Subr : Tree; Parms_Have_Cleanups : C_Bool); - procedure Expand_Function_End - (Filename : Chars; Line : Integer; End_Bindings : C_Bool); - procedure Push_Function_Context; - procedure Pop_Function_Context; - procedure Put_Var_Into_Stack (Expr : Tree; Rescan : C_Bool); - procedure Expand_Null_Return; - procedure Expand_Return (Expr : Tree); - procedure Expand_Expr_Stmt (Expr : Tree); - procedure Expand_Decl (Decl : Tree); - procedure Expand_Decl_Init (Decl : Tree); - - function Expand_Exit_Something return Integer; - - -- Conditions (IF). - procedure Expand_Start_Cond (Cond : Tree; Has_Exit : C_Bool); - procedure Expand_Start_Elseif (Cond : Tree); - procedure Expand_Start_Else; - procedure Expand_End_Cond; - - -- Loops (FOR, WHILE, DO-WHILE, CONTINUE, EXIT ...) - type Nesting is private; - Nesting_Null : constant Nesting; - function Expand_Start_Loop (Exit_Flag : C_Bool) return Nesting; - procedure Expand_Continue_Loop (Which_Loop: Nesting); - procedure Expand_End_Loop; - function Expand_Start_Loop_Continue_Elsewhere (Exit_Flag : C_Bool) - return Nesting; - procedure Expand_Loop_Continue_Here; - procedure Expand_Exit_Loop (Which_Loop : Nesting); - function Expand_Exit_Loop_If_False (Which_Loop : Nesting; Cond : Tree) - return Integer; - - -- multibranch (SWITCH). - procedure Expand_Start_Case - (Exit_Flag : C_Bool; Expr : Tree; Etype : Tree; Printname : Chars); - function Pushcase - (Value : Tree; Converter : Address; Label : Tree; Duplicate : Address) - return Integer; - function Pushcase_Range - (Low, High : Tree; Converter : Address; Label : Tree; Duplicate : Address) - return Integer; - function Add_Case_Node (Low, High : Tree; Label : Tree; Duplicate : Address) - return Integer; - procedure Expand_End_Case_Type (Orig_Index : Tree; Orig_Type : Tree); - - procedure Debug_Tree (T: Tree); - - function Fold (Atree : Tree) return Tree; - function Size_Binop (Code : Tree_Code; arg0, Arg1 : Tree) return Tree; - function Size_Int (Number : HOST_WIDE_INT) return Tree; - - function Convert (Atype : Tree; Expr : Tree) return Tree; - - -- Create an INTEGER_CST whose value is LOW signed extended to - -- 2 HOST_WIDE_INT. - function Build_Int (Low : HOST_WIDE_INT) return Tree; - - function Get_TREE_CODE (T : Tree) return Tree_Code; - procedure Set_TREE_CONSTANT (T : Tree; Val : C_Bool); - function Get_TREE_CONSTANT (T : Tree) return C_Bool; - procedure Set_TREE_PUBLIC (Decl: Tree; Val : C_Bool); - procedure Set_TREE_STATIC (Decl : Tree; Val : C_Bool); - procedure Set_TREE_TYPE (Decl : Tree; T : Tree); - function Get_TREE_TYPE (Decl : Tree) return Tree; - procedure Set_TREE_CHAIN (Decl : Tree; Chain : Tree); - function Get_TREE_CHAIN (Decl : Tree) return Tree; - procedure Set_TREE_UNSIGNED (Decl : Tree; Val: C_Bool); - function Get_TREE_UNSIGNED (Decl : Tree) return C_Bool; - procedure Set_TREE_ADDRESSABLE (Decl : Tree; Val: C_Bool); - function Get_TREE_ADDRESSABLE (Decl : Tree) return C_Bool; - procedure Set_TREE_SIDE_EFFECTS (Decl : Tree; Val: C_Bool); - procedure Set_TREE_READONLY (Decl : Tree; Val: C_Bool); - procedure Set_TREE_OPERAND (T : Tree; N : Natural; Val : Tree); - function Get_TREE_OPERAND (T : Tree; N : Natural) return Tree; - procedure Set_TREE_THIS_VOLATILE (T : Tree; Val : C_Bool); - function Get_TREE_THIS_VOLATILE (T : Tree) return C_Bool; - function Get_TREE_VALUE (Decl : Tree) return Tree; - function Get_TREE_PURPOSE (Decl : Tree) return Tree; - function Get_TREE_USED (Decl : Tree) return C_Bool; - procedure Set_TREE_USED (Decl : Tree; Flag : C_Bool); - - function Get_TREE_INT_CST_LOW (Node : Tree) return HOST_WIDE_INT; - function Get_TREE_INT_CST_HIGH (Node : Tree) return HOST_WIDE_INT; - - function Get_CONSTRUCTOR_ELTS (Cons : Tree) return Tree; - - procedure Set_DECL_ARG_TYPE (Decl : Tree; Val : Tree); - procedure Set_DECL_EXTERNAL (Decl : Tree; Val : C_Bool); - function Get_DECL_EXTERNAL (Decl : Tree) return C_Bool; - procedure Set_DECL_ARGUMENTS (Decl : Tree; Args : Tree); - function Get_DECL_ARGUMENTS (Decl : Tree) return Tree; - procedure Set_DECL_RESULT (Decl : Tree; Res : Tree); - function Get_DECL_RESULT (Decl : Tree) return Tree; - procedure Set_DECL_CONTEXT (Decl : Tree; Context : Tree); - function Get_DECL_CONTEXT (Decl : Tree) return Tree; - function Get_DECL_INITIAL (Decl : Tree) return Tree; - procedure Set_DECL_INITIAL (Decl : Tree; Init : Tree); - function Get_DECL_NAME (Decl : Tree) return Tree; - function Get_DECL_ASSEMBLER_NAME (Decl : Tree) return Tree; - procedure Set_DECL_ASSEMBLER_NAME (Decl : Tree; Name : Tree); - procedure Set_DECL_BUILT_IN_CLASS (Decl : Tree; Class : Built_In_Class); - procedure Set_DECL_FUNCTION_CODE (Decl : Tree; Code : Built_In_Function); - function Get_DECL_FIELD_OFFSET (Decl : Tree) return Tree; - function Get_DECL_FIELD_BIT_OFFSET (Decl : Tree) return Tree; - - procedure Set_TYPE_VALUES (Atype : Tree; Values: Tree); - procedure Set_TYPE_NAME (Atype : Tree; Name: Tree); - function Get_TYPE_NAME (Atype : Tree) return Tree; - procedure Set_TYPE_MIN_VALUE (Atype : Tree; Val: Tree); - function Get_TYPE_MIN_VALUE (Atype : Tree) return Tree; - procedure Set_TYPE_MAX_VALUE (Atype : Tree; Val: Tree); - function Get_TYPE_MAX_VALUE (Atype : Tree) return Tree; - procedure Set_TYPE_SIZE (Atype : Tree; Size: Tree); - function Get_TYPE_SIZE (Atype : Tree) return Tree; - procedure Set_TYPE_PRECISION (Atype : Tree; Precision : Integer); - function Get_TYPE_PRECISION (Atype : Tree) return Integer; - procedure Set_TYPE_FIELDS (Atype : Tree; Fields : Tree); - function Get_TYPE_FIELDS (Atype : Tree) return Tree; - procedure Set_TYPE_STUB_DECL (Atype : Tree; Decl : Tree); - procedure Set_TYPE_LANG_SPECIFIC (Atype : Tree; Val : System.Address); - function Get_TYPE_LANG_SPECIFIC (Atype : Tree) return System.Address; - function Get_TYPE_IS_SIZETYPE (Atype : Tree) return C_Bool; - function Get_TYPE_DOMAIN (Atype : Tree) return Tree; - procedure Set_TYPE_DOMAIN (Atype : Tree; Domain : Tree); - function Get_TYPE_SIZE_UNIT (Atype : Tree) return Tree; - function Get_TYPE_POINTER_TO (Atype : Tree) return Tree; - procedure Set_TYPE_POINTER_TO (Atype : Tree; Dtype : Tree); - function INTEGRAL_TYPE_P (Atype : Tree) return C_Bool; - procedure Set_TYPE_MODE (Atype : Tree; Mode : Machine_Mode); - function Get_TYPE_MODE (Atype : Tree) return Machine_Mode; - - function Get_BLOCK_SUPERCONTEXT (Ablock : Tree) return Tree; - procedure Set_BLOCK_SUPERCONTEXT (Ablock : Tree; Sc : Tree); - procedure Set_BLOCK_VARS (Ablock : Tree; Vars : Tree); - - function Get_IDENTIFIER_LENGTH (N : Tree) return Integer; - function Get_IDENTIFIER_POINTER (N : Tree) return Chars; - - procedure Build_Common_Tree_Nodes (Signed_Char : C_Bool); - procedure Build_Common_Tree_Nodes_2 (Short_Double : C_Bool); - - -- Points to the name of the input file from which the current input - -- being parsed originally came (before it went into cpp). - Input_Filename : Chars; - - Main_Input_Filename : Chars; - - -- Current line number in input file. - Lineno : Integer; - - -- sizeof (struct tree_identifier). - Tree_Identifier_Size : Natural; - - -- Create DECL_RTL for a declaration for a static or external variable or - -- static or external function. - procedure Make_Decl_Rtl (Decl : Tree; Asmspec : Chars; Top_Level : C_Bool); - -private - NULL_TREE : constant Tree := Tree (System.Null_Address); - - type Nesting is new System.Address; - Nesting_Null : constant Nesting := Nesting (Null_Address); - - pragma Import (C, Current_Function_Decl); - pragma Import (C, Set_Identifier_Size); - - pragma Import (C, Build); - pragma Import (C, Build1); - pragma Import (C, Build_Constructor); - pragma Import (C, Build_Block); - pragma Import (C, Build_Decl); - pragma Import (C, Build_Int_2); - pragma Import (C, Build_Int_2_Wide); - pragma Import (C, Build_Real); - pragma Import (C, Build_Function_Type); - pragma Import (C, Build_Pointer_Type); - pragma Import (C, Get_Identifier); - pragma Import (C, Build_String); - pragma Import (C, Make_Node); - pragma Import (C, Build_Index_Type); - pragma Import (C, Build_Range_Type); - pragma Import (C, Build_Array_Type); - pragma Import (C, Build_Qualified_Type); - pragma Import (C, Build_Save_Expr, "save_expr"); - - pragma Import (C, Make_Signed_Type); - pragma Import (C, Make_Unsigned_Type); - pragma Import (C, Initialize_Sizetypes); - pragma Import (C, Set_Sizetype); - pragma Import (C, Host_Integerp); - - pragma Import (C, Chainon); - pragma Import (C, Listify); - pragma Import (C, Tree_Cons); - pragma Import (C, Nreverse); - pragma Import (C, Build_Tree_List); - - pragma Import (C, Size_In_Bytes); - pragma Import (C, Get_Inner_Reference); - - pragma Import (C, Integer_Zerop); - pragma Import (C, Integer_Onep); - pragma Import (C, Real_Zerop); - - pragma Import (C, Layout_Type); - pragma Import (C, Layout_Decl); - - pragma Import (C, Expand_Start_Bindings_And_Block); - pragma Import (C, Expand_End_Bindings); - - pragma Import (C, Init_Function_Start); - pragma Import (C, Expand_Function_Start); - pragma Import (C, Expand_Function_End); - pragma Import (C, Push_Function_Context); - pragma Import (C, Pop_Function_Context); - pragma Import (C, Put_Var_Into_Stack); - - pragma Import (C, Expand_Null_Return); - pragma Import (C, Expand_Return); - pragma Import (C, Expand_Expr_Stmt); - pragma Import (C, Expand_Decl); - pragma Import (C, Expand_Decl_Init); - - pragma Import (C, Expand_Exit_Something); - - pragma Import (C, Expand_Start_Cond); - pragma Import (C, Expand_Start_Elseif); - pragma Import (C, Expand_Start_Else); - pragma Import (C, Expand_End_Cond); - - pragma Import (C, Expand_Start_Loop); - pragma Import (C, Expand_Continue_Loop); - pragma Import (C, Expand_End_Loop); - pragma Import (C, Expand_Start_Loop_Continue_Elsewhere); - pragma Import (C, Expand_Loop_Continue_Here); - pragma Import (C, Expand_Exit_Loop); - pragma Import (C, Expand_Exit_Loop_If_False); - - pragma Import (C, Expand_Start_Case); - pragma Import (C, Pushcase); - pragma Import (C, Pushcase_Range); - pragma Import (C, Add_Case_Node); - pragma Import (C, Expand_End_Case_Type); - - pragma Import (C, Debug_Tree); - - pragma Import (C, Fold); - pragma Import (C, Size_Binop); - pragma Import (C, Size_Int); - pragma Import (C, Convert); - - -- Import pragma clauses for C MACROs. - pragma Import (C, Get_TREE_CODE); - pragma Import (C, Set_TREE_CONSTANT); - pragma Import (C, Get_TREE_CONSTANT); - pragma Import (C, Set_TREE_PUBLIC); - pragma Import (C, Set_TREE_STATIC); - pragma Import (C, Set_TREE_TYPE); - pragma Import (C, Get_TREE_TYPE); - pragma Import (C, Set_TREE_CHAIN); - pragma Import (C, Get_TREE_CHAIN); - pragma Import (C, Set_TREE_UNSIGNED); - pragma Import (C, Get_TREE_UNSIGNED); - pragma Import (C, Set_TREE_ADDRESSABLE); - pragma Import (C, Get_TREE_ADDRESSABLE); - pragma Import (C, Set_TREE_SIDE_EFFECTS); - pragma Import (C, Set_TREE_READONLY); - pragma Import (C, Get_TREE_OPERAND); - pragma Import (C, Set_TREE_OPERAND); - pragma Import (C, Get_TREE_THIS_VOLATILE); - pragma Import (C, Set_TREE_THIS_VOLATILE); - pragma Import (C, Get_TREE_PURPOSE); - pragma Import (C, Get_TREE_VALUE); - pragma Import (C, Get_TREE_USED); - pragma Import (C, Set_TREE_USED); - - pragma Import (C, Get_TREE_INT_CST_LOW); - pragma Import (C, Get_TREE_INT_CST_HIGH); - - pragma Import (C, Get_CONSTRUCTOR_ELTS); - pragma Import (C, Set_TYPE_VALUES); - pragma Import (C, Set_TYPE_NAME); - pragma Import (C, Get_TYPE_NAME); - pragma Import (C, Set_TYPE_MIN_VALUE); - pragma Import (C, Get_TYPE_MIN_VALUE); - pragma Import (C, Set_TYPE_MAX_VALUE); - pragma Import (C, Get_TYPE_MAX_VALUE); - pragma Import (C, Set_TYPE_SIZE); - pragma Import (C, Get_TYPE_SIZE); - pragma Import (C, Set_TYPE_PRECISION); - pragma Import (C, Get_TYPE_PRECISION); - pragma Import (C, Set_TYPE_FIELDS); - pragma Import (C, Get_TYPE_FIELDS); - pragma Import (C, Set_TYPE_STUB_DECL); - pragma Import (C, Set_TYPE_LANG_SPECIFIC); - pragma Import (C, Get_TYPE_LANG_SPECIFIC); - pragma Import (C, Get_TYPE_IS_SIZETYPE); - pragma Import (C, Get_TYPE_DOMAIN); - pragma Import (C, Set_TYPE_DOMAIN); - pragma Import (C, Get_TYPE_POINTER_TO); - pragma Import (C, Set_TYPE_POINTER_TO); - pragma Import (C, Get_TYPE_SIZE_UNIT); - pragma Import (C, INTEGRAL_TYPE_P); - pragma Import (C, Set_TYPE_MODE); - pragma Import (C, Get_TYPE_MODE); - - pragma Import (C, Set_DECL_ARG_TYPE); - pragma Import (C, Set_DECL_EXTERNAL); - pragma Import (C, Get_DECL_EXTERNAL); - pragma Import (C, Set_DECL_ARGUMENTS); - pragma Import (C, Get_DECL_ARGUMENTS); - pragma Import (C, Set_DECL_RESULT); - pragma Import (C, Get_DECL_RESULT); - pragma Import (C, Set_DECL_CONTEXT); - pragma Import (C, Get_DECL_CONTEXT); - pragma Import (C, Get_DECL_INITIAL); - pragma Import (C, Set_DECL_INITIAL); - pragma Import (C, Get_DECL_NAME); - pragma Import (C, Set_DECL_ASSEMBLER_NAME, "set_DECL_ASSEMBLER_NAME"); - pragma Import (C, Get_DECL_ASSEMBLER_NAME); - pragma Import (C, Set_DECL_BUILT_IN_CLASS); - pragma Import (C, Set_DECL_FUNCTION_CODE); - pragma Import (C, Get_DECL_FIELD_OFFSET); - pragma Import (C, Get_DECL_FIELD_BIT_OFFSET); - - pragma Import (C, Get_BLOCK_SUPERCONTEXT); - pragma Import (C, Set_BLOCK_SUPERCONTEXT); - pragma Import (C, Set_BLOCK_VARS); - - pragma Import (C, Get_IDENTIFIER_LENGTH); - pragma Import (C, Get_IDENTIFIER_POINTER); - - pragma Import (C, Build_Common_Tree_Nodes); - pragma Import (C, Build_Common_Tree_Nodes_2); - - pragma Import (C, Input_Filename); - pragma Import (C, Main_Input_Filename); - pragma Import (C, Lineno); - - pragma Import (C, Tree_Identifier_Size); - - pragma Import (C, Make_Decl_Rtl); -end Agcc.Trees; diff --git a/ortho/agcc/agcc.adb b/ortho/agcc/agcc.adb deleted file mode 100644 index da2fe43..0000000 --- a/ortho/agcc/agcc.adb +++ /dev/null @@ -1,23 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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 Agcc is - function "+" (B : C_Bool) return Boolean is - begin - return B /= C_False; - end "+"; -end Agcc; diff --git a/ortho/agcc/agcc.ads b/ortho/agcc/agcc.ads deleted file mode 100644 index c21745c..0000000 --- a/ortho/agcc/agcc.ads +++ /dev/null @@ -1,45 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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.C; - -package Agcc is - pragma Pure (Agcc); - - subtype Chars is System.Address; - NULL_Chars : Chars renames System.Null_Address; - - Nul : constant Character := Character'Val (0); - - -- Names size_t. - type Size_T is new Interfaces.C.size_t; - - -- Ada representation of boolean type in C. - -- Never compare with C_TRUE, since in C any value different from 0 is - -- considered as true. - type C_Bool is new Integer; - pragma Convention (C, C_Bool); - - subtype C_Boolean is C_Bool range 0 .. 1; - - C_False : constant C_Bool := 0; - C_True : constant C_Bool := 1; - - function "+" (B : C_Bool) return Boolean; - pragma Inline ("+"); -end Agcc; diff --git a/ortho/agcc/agcc.sed b/ortho/agcc/agcc.sed deleted file mode 100644 index 9252e4a..0000000 --- a/ortho/agcc/agcc.sed +++ /dev/null @@ -1,23 +0,0 @@ -# SED script used to extract lines enclosed in /* BEGIN ... END */ of a -# gnatbind C generated files. -# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold - -# If the current line starts with /* BEGIN, read next line and go to keep. -\@/* BEGIN@ { - n - b keep -} -# The current line is discarded, and a the cycle is restarted. -d - -# keep the lines. -: keep -# If the current line starts with END, then it is removed and a new cycle is -# started. -\@ END@ d -# Print the current line -p -# Read the next line -n -# Go to keep. -b keep diff --git a/ortho/agcc/c.adb b/ortho/agcc/c.adb deleted file mode 100644 index 1b88636..0000000 --- a/ortho/agcc/c.adb +++ /dev/null @@ -1,55 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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_Conversion; -with System; - -package body C is - function C_String_Len (Str : C_String) return Natural is - begin - if Str = null then - return 0; - end if; - for I in Str'Range loop - if Str (I) = Character'Val (0) then - return I - 1; - end if; - end loop; - raise Program_Error; - end C_String_Len; - - function Image (Str : C_Str_Len) return String is - begin - if Str.Str = null then - return ''' & Character'Val (Str.Len) & '''; - else - return Str.Str (1 .. Str.Len); - end if; - end Image; - - function To_C_String (Acc : access String) return C_String - is - function Unchecked_Conversion is new Ada.Unchecked_Conversion - (Source => System.Address, Target => C_String); - begin - -- Check ACC is nul-terminated. - if Acc (Acc.all'Last) /= Character'Val (0) then - raise Program_Error; - end if; - return Unchecked_Conversion (Acc (Acc.all'First)'Address); - end To_C_String; -end C; diff --git a/ortho/agcc/c.ads b/ortho/agcc/c.ads deleted file mode 100644 index 01ff030..0000000 --- a/ortho/agcc/c.ads +++ /dev/null @@ -1,64 +0,0 @@ --- Ada bindings for GCC internals. --- Copyright (C) 2002, 2003, 2004, 2005 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_Conversion; -with System; - -package C is - pragma Preelaborate (C); - - -- 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); - - -- Convert an address to a C_STRING. - function To_C_String is new Ada.Unchecked_Conversion - (Source => System.Address, Target => C_String); - - -- NULL for a string. - C_String_Null : constant C_String; - - -- Convert an Ada access string to a C_String. - -- This simply takes the address of the first character of ACC. This - -- is unchecked, so be careful with the life of ACC. - -- The last element of the string designated by ACC must be the NUL-char. - -- This is a little bit more restrictive than being only NUL-terminated. - function To_C_String (Acc : access String) return C_String; - - -- Return the length of a C String (ie, the number of characters before - -- the Nul). - function C_String_Len (Str : C_String) return Natural; - - -- An (very large) array of C String. This is the type of ARGV. - type C_String_Array is array (Natural) of C_String; - pragma Convention (C, C_String_Array); - - -- A structure for a string (len and address). - type C_Str_Len is record - Len : Natural; - Str : C_String; - end record; - pragma Convention (C_Pass_By_Copy, C_Str_Len); - - type C_Str_Len_Acc is access C_Str_Len; - - function Image (Str : C_Str_Len) return String; -private - C_String_Null : constant C_String := null; -end C; diff --git a/ortho/agcc/gen_tree.c b/ortho/agcc/gen_tree.c deleted file mode 100644 index ff826b4..0000000 --- a/ortho/agcc/gen_tree.c +++ /dev/null @@ -1,575 +0,0 @@ -/* Ada bindings for GCC internals - generate Ada files. - Copyright (C) 2002, 2003, 2004, 2005 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. -*/ - -#include "config.h" -#include "system.h" -#include "coretypes.h" -#include "tm.h" -#include "flags.h" -#include "tree.h" -#include "real.h" -#include "options.h" -#undef abort - -static const char *progname; - -/* Taken from tree.h. */ - - -#define XSTR(X) #X -#define STR(X) XSTR(X) -static const char *treecode_sym[] = -{ -#define DEFTREECODE(SYM, STRING, TYPE, NARGS) #SYM, -#include "tree.def" -#undef DEFTREECODE - NULL -}; - -static const char *treecode_string[] = -{ -#define DEFTREECODE(SYM, STRING, TYPE, NARGS) STRING, -#include "tree.def" -#undef DEFTREECODE - NULL -}; - -void -gen_tree_code (void) -{ - int i, j; - size_t len; - const size_t indent = 24; - - for (i = 0; treecode_sym[i] != NULL; i++) - { - len = strlen (treecode_sym[i]); - printf (" %s, ", treecode_sym[i]); - for (j = len; j < indent; j++) - putchar (' '); - printf ("-- %s\n", treecode_string[i]); - } - printf (" LAST_AND_UNUSED_TREE_CODE\n"); -} - -static const char *built_in_function_sym[] = -{ -#if 0 -#define DEF_BUILTIN(x) #x, -#else -#define DEF_BUILTIN(ENUM, N, C, T, LT, B, F, NA, ATTR, IMP) #ENUM, -#endif -#include "builtins.def" -#undef DEF_BUILTIN - NULL -}; - -static void -print_underscore (const char *sym) -{ - for (; *sym != 0; sym++) - { - if (sym[0] == '_' && (sym[1] == '_' || sym[1] == 0)) - fputs ("_u", stdout); - else - fputc (sym[0], stdout); - } -} - -void -gen_built_in_function (void) -{ - int i; - - for (i = 0; built_in_function_sym[i] != NULL; i++) - { - fputs (" ", stdout); - print_underscore (built_in_function_sym[i]); - fputs (",\n", stdout); - } - - printf (" END_BUILTINS\n"); -} - -#if 0 -static const char *machmode_sym[] = -{ -#if 0 -#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER) #SYM, -#else -#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER, INNER) \ - #SYM, -#endif -#include "machmode.def" -#undef DEF_MACHMODE - NULL -}; -#endif - -static void -gen_machmode (void) -{ - int i; - char line[128]; - FILE *f; - int do_emit; - char *p; - - f = fopen ("insn-modes.h", "r"); - if (f == NULL) - { - fprintf (stderr, "cannot open insn-modes\n"); - exit (1); - } - - do_emit = 0; - while (1) - { - if (fgets (line, sizeof (line), f) == NULL) - break; - if (!do_emit) - { - if (strncmp (line, "enum machine_mode", 17) == 0) - do_emit = 1; - } - else if (memcmp (line, " MAX_MACHINE_MODE,", 19) == 0) - { - fclose (f); - break; - } - else - { - /* Search for " [A-Z0-9_]*mode,". */ - p = line; - if (p[0] != ' ' || p[1] != ' ') - continue; - p += 2; - while ((*p >= 'A' && *p <= 'Z') - || (*p >= '0' && *p <= '9') - || (*p == '_')) - p++; - if (memcmp (p, "mode,", 5) == 0) - { - p[4] = 0; - printf (" %s,\n", line + 2); - } - } - - } - printf (" MAX_MACHINE_MODE\n"); -} - -static void -gen_options_CL (void) -{ - printf (" CL_C : constant Integer := %d;\n", CL_C); - printf (" CL_vhdl : constant Integer := %d;\n", CL_vhdl); -} - -static void -gen_options_OPTs (void) -{ - char line[128]; - FILE *f; - int do_emit; - char *p; - - f = fopen ("options.h", "r"); - if (f == NULL) - { - fprintf (stderr, "cannot open options.h\n"); - exit (1); - } - - do_emit = 0; - while (1) - { - if (fgets (line, sizeof (line), f) == NULL) - break; - if (!do_emit) - { - if (strncmp (line, "enum opt_code", 13) == 0) - do_emit = 1; - } - else if (memcmp (line, " N_OPTS", 9) == 0) - { - fclose (f); - break; - } - else - { - /* Search for " [A-Z0-9]*mode,". */ - p = line; - if (memcmp (p, " OPT_", 6) != 0) - continue; - printf (" OPT"); - for (p = line + 5; *p != ','; p++) - { - if (p[0] == '_' && (p[1] == ',' || p[1] == '_')) - fputs ("_U", stdout); - else - { - if (p[0] >= 'A' && p[0] <= 'Z') - putchar ('U'); - putchar (p[0]); - } - } - printf (",\n"); - } - - } - printf (" N_OPTS\n"); -} - -struct xtab_t -{ - int val; - const char *name; -}; - -void -gen_enumeration (const struct xtab_t *xtab, int max, const char *max_name) -{ - int i; - - for (i = 0; i < max; i++) - { - const struct xtab_t *t; - - for (t = xtab; t->name; t++) - if (t->val == i) - break; - - if (t->name == NULL) - { - fprintf (stderr, "gen_enumeration: kind %d unknown (max is %s)\n", - i, max_name); - exit (1); - } - - printf (" %s,\n", t->name); - } - printf (" %s\n", max_name); -} - -const struct xtab_t size_type_names[] = -{ - { SIZETYPE, "TK_SIZETYPE" }, - { SSIZETYPE, "TK_SSIZETYPE" }, - { USIZETYPE, "TK_USIZETYPE" }, - { BITSIZETYPE, "TK_BITSIZETYPE" }, - { SBITSIZETYPE, "TK_SBITSIZETYPE" }, - { UBITSIZETYPE, "TK_UBITSIZETYPE" }, - { 0, NULL} -}; - -static void -gen_size_type (void) -{ - gen_enumeration (size_type_names, TYPE_KIND_LAST, "TYPE_KIND_LAST"); -} - - -const struct xtab_t type_qual_tab[] = -{ - { TYPE_UNQUALIFIED, "TYPE_UNQUALIFIED" }, - { TYPE_QUAL_CONST, "TYPE_QUAL_CONST" }, - { TYPE_QUAL_VOLATILE, "TYPE_QUAL_VOLATILE" }, - { TYPE_QUAL_RESTRICT, "TYPE_QUAL_RESTRICT" }, - { 0, NULL} -}; - -void -gen_type_qual (void) -{ - const struct xtab_t *t; - for (t = type_qual_tab; t->name; t++) - printf (" %s : constant Type_Qual_Type := %d;\n", t->name, t->val); -} - -const struct xtab_t tree_index_tab[] = -{ - /* Defined in tree.h */ - { TI_ERROR_MARK, "TI_ERROR_MARK" }, - { TI_INTQI_TYPE, "TI_INTQI_TYPE" }, - { TI_INTHI_TYPE, "TI_INTHI_TYPE" }, - { TI_INTSI_TYPE, "TI_INTSI_TYPE" }, - { TI_INTDI_TYPE, "TI_INTDI_TYPE" }, - { TI_INTTI_TYPE, "TI_INTTI_TYPE" }, - - { TI_UINTQI_TYPE, "TI_UINTQI_TYPE" }, - { TI_UINTHI_TYPE, "TI_UINTHI_TYPE" }, - { TI_UINTSI_TYPE, "TI_UINTSI_TYPE" }, - { TI_UINTDI_TYPE, "TI_UINTDI_TYPE" }, - { TI_UINTTI_TYPE, "TI_UINTTI_TYPE" }, - - { TI_INTEGER_ZERO, "TI_INTEGER_ZERO" }, - { TI_INTEGER_ONE, "TI_INTEGER_ONE" }, - { TI_INTEGER_MINUS_ONE, "TI_INTEGER_MINUS_ONE" }, - { TI_NULL_POINTER, "TI_NULL_POINTER" }, - - { TI_SIZE_ZERO, "TI_SIZE_ZERO" }, - { TI_SIZE_ONE, "TI_SIZE_ONE" }, - - { TI_BITSIZE_ZERO, "TI_BITSIZE_ZERO" }, - { TI_BITSIZE_ONE, "TI_BITSIZE_ONE" }, - { TI_BITSIZE_UNIT, "TI_BITSIZE_UNIT" }, - - { TI_PUBLIC, "TI_PUBLIC" }, - { TI_PROTECTED, "TI_PROTECTED" }, - { TI_PRIVATE, "TI_PRIVATE" }, - - { TI_BOOLEAN_FALSE, "TI_BOOLEAN_FALSE" }, - { TI_BOOLEAN_TRUE, "TI_BOOLEAN_TRUE" }, - - { TI_COMPLEX_INTEGER_TYPE, "TI_COMPLEX_INTEGER_TYPE" }, - { TI_COMPLEX_FLOAT_TYPE, "TI_COMPLEX_FLOAT_TYPE" }, - { TI_COMPLEX_DOUBLE_TYPE, "TI_COMPLEX_DOUBLE_TYPE" }, - { TI_COMPLEX_LONG_DOUBLE_TYPE, "TI_COMPLEX_LONG_DOUBLE_TYPE" }, - - { TI_FLOAT_TYPE, "TI_FLOAT_TYPE" }, - { TI_DOUBLE_TYPE, "TI_DOUBLE_TYPE" }, - { TI_LONG_DOUBLE_TYPE, "TI_LONG_DOUBLE_TYPE" }, - - { TI_FLOAT_PTR_TYPE, "TI_FLOAT_PTR_TYPE" }, - { TI_DOUBLE_PTR_TYPE, "TI_DOUBLE_PTR_TYPE" }, - { TI_LONG_DOUBLE_PTR_TYPE, "TI_LONG_DOUBLE_PTR_TYPE" }, - { TI_INTEGER_PTR_TYPE, "TI_INTEGER_PTR_TYPE" }, - - { TI_VOID_TYPE, "TI_VOID_TYPE" }, - { TI_PTR_TYPE, "TI_PTR_TYPE" }, - { TI_CONST_PTR_TYPE, "TI_CONST_PTR_TYPE" }, - { TI_SIZE_TYPE, "TI_SIZE_TYPE" }, - { TI_PTRDIFF_TYPE, "TI_PTRDIFF_TYPE" }, - { TI_VA_LIST_TYPE, "TI_VA_LIST_TYPE" }, - { TI_BOOLEAN_TYPE, "TI_BOOLEAN_TYPE" }, - - { TI_VOID_LIST_NODE, "TI_VOID_LIST_NODE" }, - - { TI_UV4SF_TYPE, "TI_UV4SF_TYPE" }, - { TI_UV4SI_TYPE, "TI_UV4SI_TYPE" }, - { TI_UV8HI_TYPE, "TI_UV8HI_TYPE" }, - { TI_UV8QI_TYPE, "TI_UV8QI_TYPE" }, - { TI_UV4HI_TYPE, "TI_UV4HI_TYPE" }, - { TI_UV2HI_TYPE, "TI_UV2HI_TYPE" }, - { TI_UV2SI_TYPE, "TI_UV2SI_TYPE" }, - { TI_UV2SF_TYPE, "TI_UV2SF_TYPE" }, - { TI_UV2DI_TYPE, "TI_UV2DI_TYPE" }, - { TI_UV1DI_TYPE, "TI_UV1DI_TYPE" }, - { TI_UV16QI_TYPE, "TI_UV16QI_TYPE" }, - - { TI_V4SF_TYPE, "TI_V4SF_TYPE" }, - { TI_V16SF_TYPE, "TI_V16SF_TYPE" }, - { TI_V4SI_TYPE, "TI_V4SI_TYPE" }, - { TI_V8HI_TYPE, "TI_V8HI_TYPE" }, - { TI_V8QI_TYPE, "TI_V8QI_TYPE" }, - { TI_V4HI_TYPE, "TI_V4HI_TYPE" }, - { TI_V2HI_TYPE, "TI_V2HI_TYPE" }, - { TI_V2SI_TYPE, "TI_V2SI_TYPE" }, - { TI_V2SF_TYPE, "TI_V2SF_TYPE" }, - { TI_V2DF_TYPE, "TI_V2DF_TYPE" }, - { TI_V2DI_TYPE, "TI_V2DI_TYPE" }, - { TI_V1DI_TYPE, "TI_V1DI_TYPE" }, - { TI_V16QI_TYPE, "TI_V16QI_TYPE" }, - { TI_V4DF_TYPE, "TI_V4DF_TYPE" }, - - { TI_MAIN_IDENTIFIER, "TI_MAIN_IDENTIFIER" }, - - { 0, NULL } -}; - -const struct xtab_t integer_types_tab[] = -{ - { itk_char, "itk_char" }, - { itk_signed_char, "itk_signed_char" }, - { itk_unsigned_char, "itk_unsigned_char" }, - { itk_short, "itk_short" }, - { itk_unsigned_short, "itk_unsigned_short" }, - { itk_int, "itk_int" }, - { itk_unsigned_int, "itk_unsigned_int" }, - { itk_long, "itk_long" }, - { itk_unsigned_long, "itk_unsigned_long" }, - { itk_long_long, "itk_long_long" }, - { itk_unsigned_long_long, "itk_unsigned_long_long" }, - { 0, NULL } -}; - - -void -gen_tree_index (void) -{ - gen_enumeration (tree_index_tab, TI_MAX, "TI_MAX"); -} - -void -gen_integer_types (void) -{ - gen_enumeration (integer_types_tab, itk_none, "itk_none"); -} - -static void -gen_host_wide_int_decl (void) -{ - int l; - switch (sizeof (HOST_WIDE_INT)) - { - case 4: - l = 32; - break; - case 8: - l = 64; - break; - default: - fprintf (stderr, "%s: cannot handle sizeof (HOST_WIDE_INT) %d\n", - progname, sizeof (HOST_WIDE_INT)); - exit (1); - } - printf (" type HOST_WIDE_INT is new Interfaces.Integer_%d;\n", l); - printf (" type UNSIGNED_HOST_WIDE_INT is new Interfaces.Unsigned_%d;\n", - l); -} - -static void -gen_host_big_endian (void) -{ -#ifdef HOST_WORDS_BIG_ENDIAN - printf (" HOST_WORDS_BIG_ENDIAN : constant Boolean := True;\n"); -#else - printf (" HOST_WORDS_BIG_ENDIAN : constant Boolean := False;\n"); -#endif -} - -static void -gen_real (void) -{ - printf (" type Real_Value_Type_Arr is array (0 .. %d) of HOST_WIDE_INT;\n", - (sizeof (REAL_VALUE_TYPE) / sizeof (HOST_WIDE_INT)) - 1); - printf (" type REAL_VALUE_TYPE is record\n" - " r : Real_Value_Type_Arr;\n" - " end record;\n"); -} - -static void -gen_tm (void) -{ -#ifndef MAX_BITS_PER_WORD -#define MAX_BITS_PER_WORD BITS_PER_WORD -#endif - /* This is a constant. */ - printf (" MAX_BITS_PER_WORD : constant Natural := %d;\n", - MAX_BITS_PER_WORD); -} - -int -main (int argc, char *argv[]) -{ - FILE *infile; - char line[2048]; - const char *filename; - int c; - - progname = argv[0]; - - while ((c = getopt (argc, argv, "C:")) != -1) - switch (c) - { - case 'C': - chdir (optarg); - break; - case '?': - fprintf (stderr, "%s: unknown option '%s'\n", progname, optopt); - exit (1); - default: - abort (); - } - - if (argc - optind != 1) - { - fprintf (stderr, "usage: %s FILENAME\n", progname); - exit (1); - } - filename = argv[optind]; - if (strcmp (filename, "-") == 0) - infile = stdin; - else - infile = fopen (filename, "r"); - if (infile == NULL) - { - fprintf (stderr, "%s: cannot open %s (%s)\n", progname, filename, - strerror (errno)); - exit (1); - } -#if 0 -#ifdef REAL_IS_NOT_DOUBLE - printf ("-- REAL_IS_NOT_DOUBLE is not yet implemented\n"); - printf ("You loose\n"); - return 1; -#endif -#endif - printf ("-- Automatically generated by %s\n", progname); - printf ("-- from %s\n", filename); - printf ("-- DO NOT EDIT THIS FILE\n"); - - while (fgets (line, sizeof (line), infile) != NULL) - { - if (line[0] != '@') - fputs (line, stdout); - else - { - char *p; - - for (p = line + 1; isalpha (*p) || *p == '_'; p++) - ; - *p = 0; - - if (!strcmp (line, "@tree_code")) - gen_tree_code (); - else if (!strcmp (line, "@built_in_function")) - gen_built_in_function (); - else if (!strcmp (line, "@size_type_kind")) - gen_size_type (); - else if (!strcmp (line, "@type_qual")) - gen_type_qual (); - else if (!strcmp (line, "@host_wide_int")) - gen_host_wide_int_decl (); - else if (!strcmp (line, "@tree_index")) - gen_tree_index (); - else if (!strcmp (line, "@integer_types")) - gen_integer_types (); - else if (!strcmp (line, "@host_big_endian")) - gen_host_big_endian (); - else if (!strcmp (line, "@real")) - gen_real (); - else if (!strcmp (line, "@machmode")) - gen_machmode (); - else if (!strcmp (line, "@tm")) - gen_tm (); - else if (!strcmp (line, "@options_CL")) - gen_options_CL (); - else if (!strcmp (line, "@options_OPTs")) - gen_options_OPTs (); - else - { - fprintf (stderr, "unknown code `%s'\n", line); - exit (1); - } - } - } - return 0; -} |