OSDN Git Service

* back-end.adb (Call_Back_End): Pass Standard_Character to gigi.
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / misc.c
index 63d7805..481c85a 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                           C Implementation File                          *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -66,7 +66,7 @@
 
 static bool gnat_init                  (void);
 static unsigned int gnat_init_options  (unsigned int, const char **);
-static int gnat_handle_option          (size_t, const char *, int);
+static int gnat_handle_option          (size_t, const char *, int, int);
 static bool gnat_post_options          (const char **);
 static alias_set_type gnat_get_alias_set (tree);
 static void gnat_print_decl            (FILE *, tree, int);
@@ -74,11 +74,11 @@ static void gnat_print_type         (FILE *, tree, int);
 static const char *gnat_printable_name (tree, int);
 static const char *gnat_dwarf_name     (tree, int);
 static tree gnat_return_tree           (tree);
-static int gnat_eh_type_covers         (tree, tree);
 static void gnat_parse_file            (int);
 static void internal_error_function    (const char *, va_list *);
 static tree gnat_type_max_size         (const_tree);
 static void gnat_get_subrange_bounds   (const_tree, tree *, tree *);
+static tree gnat_eh_personality                (void);
 
 /* Definitions for our language-specific hooks.  */
 
@@ -106,8 +106,6 @@ static void gnat_get_subrange_bounds        (const_tree, tree *, tree *);
 #define LANG_HOOKS_WRITE_GLOBALS       gnat_write_global_declarations
 #undef  LANG_HOOKS_GET_ALIAS_SET
 #define LANG_HOOKS_GET_ALIAS_SET       gnat_get_alias_set
-#undef  LANG_HOOKS_MARK_ADDRESSABLE
-#define LANG_HOOKS_MARK_ADDRESSABLE    gnat_mark_addressable
 #undef  LANG_HOOKS_PRINT_DECL
 #define LANG_HOOKS_PRINT_DECL          gnat_print_decl
 #undef  LANG_HOOKS_PRINT_TYPE
@@ -131,9 +129,11 @@ static void gnat_get_subrange_bounds       (const_tree, tree *, tree *);
 #undef  LANG_HOOKS_ATTRIBUTE_TABLE
 #define LANG_HOOKS_ATTRIBUTE_TABLE     gnat_internal_attribute_table
 #undef  LANG_HOOKS_BUILTIN_FUNCTION
-#define LANG_HOOKS_BUILTIN_FUNCTION        gnat_builtin_function
+#define LANG_HOOKS_BUILTIN_FUNCTION    gnat_builtin_function
+#undef  LANG_HOOKS_EH_PERSONALITY
+#define LANG_HOOKS_EH_PERSONALITY      gnat_eh_personality
 
-const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
 /* How much we want of our DWARF extensions.  Some of our dwarf+ extensions
    are incompatible with regular GDB versions, so we must make sure to only
@@ -176,9 +176,6 @@ gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 
   /* Call the front end.  */
   _ada_gnat1drv ();
-
-  /* We always have a single compilation unit in Ada.  */
-  cgraph_finalize_compilation_unit ();
 }
 
 /* Decode all the language specific options that cannot be decoded by GCC.
@@ -187,7 +184,8 @@ gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
    that have been successfully decoded or 0 on failure.  */
 
 static int
-gnat_handle_option (size_t scode, const char *arg, int value)
+gnat_handle_option (size_t scode, const char *arg, int value,
+                   int kind ATTRIBUTE_UNUSED)
 {
   const struct cl_option *option = &cl_options[scode];
   enum opt_code code = (enum opt_code) scode;
@@ -211,12 +209,7 @@ gnat_handle_option (size_t scode, const char *arg, int value)
 
     case OPT_Wall:
       warn_unused = value;
-
-      /* We save the value of warn_uninitialized, since if they put
-        -Wuninitialized on the command line, we need to generate a
-        warning about not using it without also specifying -O.  */
-      if (warn_uninitialized != 1)
-       warn_uninitialized = (value ? 2 : 0);
+      warn_uninitialized = value;
       break;
 
       /* These are used in the GCC Makefile.  */
@@ -391,9 +384,35 @@ internal_error_function (const char *msgid, va_list *ap)
 static bool
 gnat_init (void)
 {
-  /* Performs whatever initialization steps needed by the language-dependent
-     lexical analyzer.  */
-  gnat_init_decl_processing ();
+  /* Do little here, most of the standard declarations are set up after the
+     front-end has been run.  Use the same `char' as C, this doesn't really
+     matter since we'll use the explicit `unsigned char' for Character.  */
+  build_common_tree_nodes (flag_signed_char, true);
+
+  /* In Ada, we use a signed type for SIZETYPE.  Use the signed type
+     corresponding to the width of Pmode.  In most cases when ptr_mode
+     and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
+     But we get far better code using the width of Pmode.  */
+  size_type_node = gnat_type_for_mode (Pmode, 0);
+  set_sizetype (size_type_node);
+  TYPE_NAME (sizetype) = get_identifier ("size_type");
+
+  /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
+  boolean_type_node = make_unsigned_type (8);
+  TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
+  SET_TYPE_RM_MAX_VALUE (boolean_type_node,
+                        build_int_cst (boolean_type_node, 1));
+  SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
+
+  build_common_tree_nodes_2 (0);
+  sbitsize_one_node = sbitsize_int (1);
+  sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT);
+  boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
+
+  ptr_void_type_node = build_pointer_type (void_type_node);
+
+  /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
+  internal_reference_types ();
 
   /* Add the input filename as the last argument.  */
   if (main_input_filename)
@@ -403,11 +422,9 @@ gnat_init (void)
       gnat_argv[gnat_argc] = NULL;
     }
 
+  /* Register our internal error function.  */
   global_dc->internal_error = &internal_error_function;
 
-  /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
-  internal_reference_types ();
-
   return true;
 }
 
@@ -436,13 +453,6 @@ gnat_init_gcc_eh (void)
      right exception regions.  */
   using_eh_for_cleanups ();
 
-  eh_personality_libfunc = init_one_libfunc (USING_SJLJ_EXCEPTIONS
-                                            ? "__gnat_eh_personality_sj"
-                                            : "__gnat_eh_personality");
-  lang_eh_type_covers = gnat_eh_type_covers;
-  lang_eh_runtime_type = gnat_return_tree;
-  default_init_unwind_resume_libfunc ();
-
   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
      the generation of the necessary exception runtime tables. The second one
      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
@@ -470,17 +480,17 @@ gnat_print_decl (FILE *file, tree node, int indent)
   switch (TREE_CODE (node))
     {
     case CONST_DECL:
-      print_node (file, "const_corresponding_var",
+      print_node (file, "corresponding var",
                  DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
       break;
 
     case FIELD_DECL:
-      print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
+      print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
                  indent + 4);
       break;
 
     case VAR_DECL:
-      print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
+      print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
                  indent + 4);
       break;
 
@@ -497,7 +507,7 @@ gnat_print_type (FILE *file, tree node, int indent)
   switch (TREE_CODE (node))
     {
     case FUNCTION_TYPE:
-      print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
+      print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
       break;
 
     case INTEGER_TYPE:
@@ -528,8 +538,13 @@ gnat_print_type (FILE *file, tree node, int indent)
       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
       break;
 
+    case VECTOR_TYPE:
+      print_node (file,"representative array",
+                 TYPE_REPRESENTATIVE_ARRAY (node), indent + 4);
+      break;
+
     case RECORD_TYPE:
-      if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
+      if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
        print_node (file, "unconstrained array",
                    TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
       else
@@ -582,28 +597,13 @@ gnat_return_tree (tree t)
   return t;
 }
 
-/* Return true if type A catches type B. Callback for flow analysis from
-   the exception handling part of the back-end.  */
-
-static int
-gnat_eh_type_covers (tree a, tree b)
-{
-  /* a catches b if they represent the same exception id or if a
-     is an "others".
-
-     ??? integer_zero_node for "others" is hardwired in too many places
-     currently.  */
-  return (a == b || a == integer_zero_node);
-}
-\f
 /* Get the alias set corresponding to a type or expression.  */
 
 static alias_set_type
 gnat_get_alias_set (tree type)
 {
   /* If this is a padding type, use the type of the first field.  */
-  if (TREE_CODE (type) == RECORD_TYPE
-      && TYPE_IS_PADDING_P (type))
+  if (TYPE_IS_PADDING_P (type))
     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 
   /* If the type is an unconstrained array, use the type of the
@@ -659,14 +659,8 @@ gnat_type_max_size (const_tree gnu_type)
 static void
 gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
 {
-  tree min = TYPE_MIN_VALUE (gnu_type);
-  tree max = TYPE_MAX_VALUE (gnu_type);
-  /* If the bounds aren't constant, use non-representable constant values
-     to get the same effect on debug info without tree sharing issues.  */
-  *lowval
-    = TREE_CONSTANT (min) ? min : build_int_cstu (integer_type_node, -1);
-  *highval
-    = TREE_CONSTANT (max) ? max : build_int_cstu (integer_type_node, -1);
+  *lowval = TYPE_MIN_VALUE (gnu_type);
+  *highval = TYPE_MAX_VALUE (gnu_type);
 }
 
 /* GNU_TYPE is a type. Determine if it should be passed by reference by
@@ -709,7 +703,7 @@ must_pass_by_ref (tree gnu_type)
      and does not produce compatibility problems with C, since C does
      not have such objects.  */
   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
-         || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
+         || TREE_ADDRESSABLE (gnu_type)
          || (TYPE_SIZE (gnu_type)
              && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 }
@@ -729,10 +723,11 @@ must_pass_by_ref (tree gnu_type)
 void
 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
 {
-  enum machine_mode i;
+  int iloop;
 
-  for (i = 0; i < NUM_MACHINE_MODES; i++)
+  for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++)
     {
+      enum machine_mode i = (enum machine_mode) iloop;
       enum machine_mode j;
       bool float_p = 0;
       bool complex_p = 0;
@@ -821,3 +816,19 @@ fp_size_to_prec (int size)
 
   gcc_unreachable ();
 }
+
+static GTY(()) tree gnat_eh_personality_decl;
+
+static tree
+gnat_eh_personality (void)
+{
+  if (!gnat_eh_personality_decl)
+    gnat_eh_personality_decl
+      = build_personality_function (USING_SJLJ_EXCEPTIONS
+                                   ? "__gnat_eh_personality_sj"
+                                   : "__gnat_eh_personality");
+
+  return gnat_eh_personality_decl;
+}
+
+#include "gt-ada-misc.h"