]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - gcc/ada/gcc-interface/misc.c
Wrap option names in gcc internal messages with %< and %>.
[thirdparty/gcc.git] / gcc / ada / gcc-interface / misc.c
index 7401d2df27fc44009541f6edef9480728e151fc3..5737165949e470e4d24dc1763f52e6b66411061b 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                           C Implementation File                          *
  *                                                                          *
- *          Copyright (C) 1992-2017, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2019, 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- *
@@ -77,9 +77,6 @@ int optimize;
 #undef optimize_size
 int optimize_size;
 
-#undef flag_compare_debug
-int flag_compare_debug;
-
 #undef flag_short_enums
 int flag_short_enums;
 
@@ -138,8 +135,9 @@ gnat_option_lang_mask (void)
    are marked as Ada-specific.  Return true on success or false on failure.  */
 
 static bool
-gnat_handle_option (size_t scode, const char *arg, int value, int kind,
-                   location_t loc, const struct cl_option_handlers *handlers)
+gnat_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
+                   int kind, location_t loc,
+                   const struct cl_option_handlers *handlers)
 {
   enum opt_code code = (enum opt_code) scode;
 
@@ -168,8 +166,10 @@ gnat_handle_option (size_t scode, const char *arg, int value, int kind,
       /* These are handled by the front-end.  */
       break;
 
+    case OPT_fopenacc:
     case OPT_fshort_enums:
     case OPT_fsigned_char:
+    case OPT_funsigned_char:
       /* These are handled by the middle-end.  */
       break;
 
@@ -256,7 +256,7 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 {
   /* Excess precision other than "fast" requires front-end support.  */
   if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD)
-    sorry ("-fexcess-precision=standard for Ada");
+    sorry ("%<-fexcess-precision=standard%> for Ada");
   flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
 
   /* No psABI change warnings for Ada.  */
@@ -265,6 +265,9 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
   /* No return type warnings for Ada.  */
   warn_return_type = 0;
 
+  /* No string overflow warnings for Ada.  */
+  warn_stringop_overflow = 0;
+
   /* No caret by default for Ada.  */
   if (!global_options_set.x_flag_diagnostics_show_caret)
     global_dc->show_caret = false;
@@ -279,7 +282,6 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
   gnat_encodings = global_options.x_gnat_encodings;
   optimize = global_options.x_optimize;
   optimize_size = global_options.x_optimize_size;
-  flag_compare_debug = global_options.x_flag_compare_debug;
   flag_stack_check = global_options.x_flag_stack_check;
   flag_short_enums = global_options.x_flag_short_enums;
 
@@ -342,7 +344,6 @@ internal_error_function (diagnostic_context *context, const char *msgid,
   sp_loc.Bounds = &temp_loc;
   sp_loc.Array = loc;
 
-  Current_Error_Node = error_gnat_node;
   Compiler_Abort (sp, sp_loc, true);
 }
 
@@ -392,7 +393,7 @@ gnat_init_gcc_eh (void)
   using_eh_for_cleanups ();
 
   /* Turn on -fexceptions, -fnon-call-exceptions and -fdelete-dead-exceptions.
-     The first one triggers the generation of the necessary exception tables.
+     The first one activates the support for exceptions in the compiler.
      The second one is useful for two reasons: 1/ we map some asynchronous
      signals like SEGV to exceptions, so we need to ensure that the insns
      which can lead to such signals are correctly attached to the exception
@@ -402,10 +403,26 @@ gnat_init_gcc_eh (void)
      for such calls to actually raise in Ada.
      The third one is an optimization that makes it possible to delete dead
      instructions that may throw exceptions, most notably loads and stores,
-     as permitted in Ada.  */
+     as permitted in Ada.
+     Turn off -faggressive-loop-optimizations because it may optimize away
+     out-of-bound array accesses that we want to be able to catch.
+     If checks are disabled, we use the same settings as the C++ compiler,
+     except for the runtime on platforms where S'Machine_Overflow is true
+     because the runtime depends on FP (hardware) checks being properly
+     handled despite being compiled in -gnatp mode.  */
   flag_exceptions = 1;
-  flag_non_call_exceptions = 1;
   flag_delete_dead_exceptions = 1;
+  if (Suppress_Checks)
+    {
+      if (!global_options_set.x_flag_non_call_exceptions)
+       flag_non_call_exceptions = Machine_Overflows_On_Target && GNAT_Mode;
+    }
+  else
+    {
+      flag_non_call_exceptions = 1;
+      flag_aggressive_loop_optimizations = 0;
+      warn_aggressive_loop_optimizations = 0;
+    }
 
   init_eh ();
 }
@@ -469,6 +486,7 @@ gnat_print_type (FILE *file, tree node, int indent)
   switch (TREE_CODE (node))
     {
     case FUNCTION_TYPE:
+    case METHOD_TYPE:
       print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
       break;
 
@@ -680,12 +698,12 @@ gnat_get_fixed_point_type_info (const_tree type,
 
 /* Return true if types T1 and T2 are identical for type hashing purposes.
    Called only after doing all language independent checks.  At present,
-   this function is only called when both types are FUNCTION_TYPE.  */
+   this is only called when both types are FUNCTION_TYPE or METHOD_TYPE.  */
 
 static bool
 gnat_type_hash_eq (const_tree t1, const_tree t2)
 {
-  gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE);
+  gcc_assert (FUNC_OR_METHOD_TYPE_P (t1) && TREE_CODE (t1) == TREE_CODE (t2));
   return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2),
                              TYPE_RETURN_UNCONSTRAINED_P (t2),
                              TYPE_RETURN_BY_DIRECT_REF_P (t2),
@@ -709,6 +727,10 @@ gnat_get_alias_set (tree type)
   if (TYPE_IS_PADDING_P (type))
     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 
+  /* If this is an extra subtype, use the base type.  */
+  else if (TYPE_IS_EXTRA_SUBTYPE_P (type))
+    return get_alias_set (get_base_type (type));
+
   /* If the type is an unconstrained array, use the type of the
      self-referential array we make.  */
   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -733,64 +755,27 @@ gnat_type_max_size (const_tree gnu_type)
   /* First see what we can get from TYPE_SIZE_UNIT, which might not
      be constant even for simple expressions if it has already been
      elaborated and possibly replaced by a VAR_DECL.  */
-  tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
-
-  /* If we don't have a constant, try to look at attributes which should have
-     stayed untouched.  */
-  if (!tree_fits_uhwi_p (max_unitsize))
+  tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
+
+  /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
+     which should stay untouched.  */
+  if (!tree_fits_uhwi_p (max_size_unit)
+      && RECORD_OR_UNION_TYPE_P (gnu_type)
+      && !TYPE_FAT_POINTER_P (gnu_type)
+      && TYPE_ADA_SIZE (gnu_type))
     {
-      /* For record types, see what we can get from TYPE_ADA_SIZE.  */
-      if (RECORD_OR_UNION_TYPE_P (gnu_type)
-         && !TYPE_FAT_POINTER_P (gnu_type)
-         && TYPE_ADA_SIZE (gnu_type))
-       {
-         tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
-
-         /* If we have succeeded in finding a constant, round it up to the
-            type's alignment and return the result in units.  */
-         if (tree_fits_uhwi_p (max_adasize))
-           max_unitsize
-             = size_binop (CEIL_DIV_EXPR,
-                           round_up (max_adasize, TYPE_ALIGN (gnu_type)),
-                           bitsize_unit_node);
-       }
-
-      /* For array types, see what we can get from TYPE_INDEX_TYPE.  */
-      else if (TREE_CODE (gnu_type) == ARRAY_TYPE
-              && TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))
-              && tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))))
-       {
-         tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-         tree hb = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-         if (TREE_CODE (lb) != INTEGER_CST
-             && TYPE_RM_SIZE (TREE_TYPE (lb))
-             && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (lb)), 16) <= 0)
-           lb = TYPE_MIN_VALUE (TREE_TYPE (lb));
-         if (TREE_CODE (hb) != INTEGER_CST
-             && TYPE_RM_SIZE (TREE_TYPE (hb))
-             && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (hb)), 16) <= 0)
-           hb = TYPE_MAX_VALUE (TREE_TYPE (hb));
-         if (TREE_CODE (lb) == INTEGER_CST && TREE_CODE (hb) == INTEGER_CST)
-           {
-             tree ctype = get_base_type (TREE_TYPE (lb));
-             lb = fold_convert (ctype, lb);
-             hb = fold_convert (ctype, hb);
-             if (tree_int_cst_le (lb, hb))
-               {
-                 tree length
-                   = fold_build2 (PLUS_EXPR, ctype,
-                                  fold_build2 (MINUS_EXPR, ctype, hb, lb),
-                                  build_int_cst (ctype, 1));
-                 max_unitsize
-                   = fold_build2 (MULT_EXPR, sizetype,
-                                  fold_convert (sizetype, length),
-                                  TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
-               }
-           }
-       }
+      tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
+
+      /* If we have succeeded in finding a constant, round it up to the
+        type's alignment and return the result in units.  */
+      if (tree_fits_uhwi_p (max_ada_size))
+       max_size_unit
+         = size_binop (CEIL_DIV_EXPR,
+                       round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
+                       bitsize_unit_node);
     }
 
-  return max_unitsize;
+  return max_size_unit;
 }
 
 static tree get_array_bit_stride (tree);
@@ -1301,11 +1286,14 @@ enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int))
          }
 
       /* If no predefined C types were found, register the mode itself.  */
-      if (!skip_p)
+      int nunits, precision, bitsize;
+      if (!skip_p
+         && GET_MODE_NUNITS (i).is_constant (&nunits)
+         && GET_MODE_PRECISION (i).is_constant (&precision)
+         && GET_MODE_BITSIZE (i).is_constant (&bitsize))
        f (GET_MODE_NAME (i), digs, complex_p,
-          vector_p ? GET_MODE_NUNITS (i) : 0, float_rep,
-          GET_MODE_PRECISION (i), GET_MODE_BITSIZE (i),
-          GET_MODE_ALIGNMENT (i));
+          vector_p ? nunits : 0, float_rep,
+          precision, bitsize, GET_MODE_ALIGNMENT (i));
     }
 }