* *
* C Implementation File *
* *
- * Copyright (C) 1992-2016, 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- *
#undef optimize_size
int optimize_size;
-#undef flag_compare_debug
-int flag_compare_debug;
-
#undef flag_short_enums
int flag_short_enums;
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;
handle_generated_option (&global_options, &global_options_set,
OPT_Wunused, NULL, value,
gnat_option_lang_mask (), kind, loc,
- handlers, global_dc);
+ handlers, true, global_dc);
warn_uninitialized = value;
warn_maybe_uninitialized = value;
break;
/* 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;
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
- && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
- sorry ("-fexcess-precision=standard for Ada");
+ if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD)
+ sorry ("%<-fexcess-precision=standard%> for Ada");
flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
/* No psABI change warnings for Ada. */
warn_psabi = 0;
+ /* 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;
- /* Set strict overflow by default for Ada. */
- if (!global_options_set.x_flag_strict_overflow)
- global_options.x_flag_strict_overflow = true;
-
/* Warn only if STABS is not the default: we don't want to emit a warning if
the user did not use a -gstabs option. */
if (PREFERRED_DEBUGGING_TYPE != DBX_DEBUG && write_symbols == DBX_DEBUG)
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;
sp_loc.Bounds = &temp_loc;
sp_loc.Array = loc;
- Current_Error_Node = error_gnat_node;
Compiler_Abort (sp, sp_loc, true);
}
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
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 ();
}
switch (TREE_CODE (node))
{
case FUNCTION_TYPE:
+ case METHOD_TYPE:
print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
break;
/* 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),
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)
get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
/* If the type can alias any other types, return the alias set 0. */
- else if (TYPE_P (type) && TYPE_UNIVERSAL_ALIASING_P (type))
+ else if (TYPE_P (type)
+ && !TYPE_IS_DUMMY_P (type)
+ && TYPE_UNIVERSAL_ALIASING_P (type))
return 0;
return -1;
/* 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);
+ 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_unitsize)
+ 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))
{
- tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
+ 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_adasize))
- max_unitsize
+ if (tree_fits_uhwi_p (max_ada_size))
+ max_size_unit
= size_binop (CEIL_DIV_EXPR,
- round_up (max_adasize, TYPE_ALIGN (gnu_type)),
+ 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);
}
info->ndimensions = i;
+ info->rank = NULL_TREE;
/* Too many dimensions? Give up generating proper description: yield instead
nested arrays. Note that in this case, this hook is invoked once on each
structure. */
for (i = (convention_fortran_p ? info->ndimensions - 1 : 0),
dimen = first_dimen;
- 0 <= i && i < info->ndimensions;
+ IN_RANGE (i, 0, info->ndimensions - 1);
i += (convention_fortran_p ? -1 : 1),
dimen = TREE_TYPE (dimen))
{
and XUA types. */
if (TYPE_CONTEXT (first_dimen)
&& TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE
- && contains_placeholder_p (TYPE_MIN_VALUE (index_type))
+ && CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (index_type))
&& gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
{
info->dimen[i].lower_bound = NULL_TREE;
is an In Out parameter, but it's probably best to err on the side of
passing more things by reference. */
- if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
+ if (AGGREGATE_TYPE_P (gnu_type)
+ && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type))
+ || compare_tree_int (TYPE_SIZE_UNIT (gnu_type),
+ TYPE_ALIGN (gnu_type)) > 0))
return true;
- if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
+ if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
return true;
- if (AGGREGATE_TYPE_P (gnu_type)
- && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type))
- || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type),
- TYPE_ALIGN (gnu_type))))
+ if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
return true;
return false;
}
/* 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));
}
}
int
fp_prec_to_size (int prec)
{
- machine_mode mode;
+ opt_scalar_float_mode opt_mode;
- for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
- mode = GET_MODE_WIDER_MODE (mode))
- if (GET_MODE_PRECISION (mode) == prec)
- return GET_MODE_BITSIZE (mode);
+ FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT)
+ {
+ scalar_float_mode mode = opt_mode.require ();
+ if (GET_MODE_PRECISION (mode) == prec)
+ return GET_MODE_BITSIZE (mode);
+ }
gcc_unreachable ();
}
int
fp_size_to_prec (int size)
{
- machine_mode mode;
+ opt_scalar_float_mode opt_mode;
- for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
- mode = GET_MODE_WIDER_MODE (mode))
- if (GET_MODE_BITSIZE (mode) == size)
- return GET_MODE_PRECISION (mode);
+ FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT)
+ {
+ scalar_mode mode = opt_mode.require ();
+ if (GET_MODE_BITSIZE (mode) == size)
+ return GET_MODE_PRECISION (mode);
+ }
gcc_unreachable ();
}
MARK_TS_TYPED (EXIT_STMT);
}
+/* Return the size of a tree with CODE, which is a language-specific tree code
+ in category tcc_constant, tcc_exceptional or tcc_type. The default expects
+ never to be called. */
+
+static size_t
+gnat_tree_size (enum tree_code code)
+{
+ gcc_checking_assert (code >= NUM_TREE_CODES);
+ switch (code)
+ {
+ case UNCONSTRAINED_ARRAY_TYPE:
+ return sizeof (tree_type_non_common);
+ default:
+ gcc_unreachable ();
+ }
+}
+
/* Return the lang specific structure attached to NODE. Allocate it (cleared)
if needed. */
#define LANG_HOOKS_NAME "GNU Ada"
#undef LANG_HOOKS_IDENTIFIER_SIZE
#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_TREE_SIZE
+#define LANG_HOOKS_TREE_SIZE gnat_tree_size
#undef LANG_HOOKS_INIT
#define LANG_HOOKS_INIT gnat_init
#undef LANG_HOOKS_OPTION_LANG_MASK
#undef LANG_HOOKS_TYPE_HASH_EQ
#define LANG_HOOKS_TYPE_HASH_EQ gnat_type_hash_eq
#undef LANG_HOOKS_GETDECLS
-#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+#define LANG_HOOKS_GETDECLS hook_tree_void_null
#undef LANG_HOOKS_PUSHDECL
#define LANG_HOOKS_PUSHDECL gnat_return_tree
+#undef LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL
+#define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL hook_bool_const_tree_false
#undef LANG_HOOKS_GET_ALIAS_SET
#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
#undef LANG_HOOKS_PRINT_DECL
#undef LANG_HOOKS_GET_DEBUG_TYPE
#define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type
#undef LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO
-#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO \
- gnat_get_fixed_point_type_info
+#define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO gnat_get_fixed_point_type_info
#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
+#undef LANG_HOOKS_INIT_TS
+#define LANG_HOOKS_INIT_TS gnat_init_ts
#undef LANG_HOOKS_EH_PERSONALITY
#define LANG_HOOKS_EH_PERSONALITY gnat_eh_personality
#undef LANG_HOOKS_DEEP_UNSHARING
#define LANG_HOOKS_DEEP_UNSHARING true
-#undef LANG_HOOKS_INIT_TS
-#define LANG_HOOKS_INIT_TS gnat_init_ts
-#undef LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL
-#define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL hook_bool_const_tree_false
+#undef LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS
+#define LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS true
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
projects / thirdparty / gcc.git / blobdiff