/* Nonzero in a PARM_DECL if we are to pass by descriptor. */
#define DECL_BY_DESCRIPTOR_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
+/* Nonzero in a VAR_DECL if it is a pointer renaming a global object. */
+#define DECL_RENAMING_GLOBAL_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE))
+
/* In a CONST_DECL, points to a VAR_DECL that is allocatable to
memory. Used when a scalar constant is aliased or has its
address taken. */
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
+/* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a
+ renaming pointer, otherwise 0. Note that this object is guaranteed to
+ be protected against multiple evaluations. */
+#define DECL_RENAMED_OBJECT(NODE) \
+ GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
+#define SET_DECL_RENAMED_OBJECT(NODE, X) \
+ SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
+
/* In a FIELD_DECL corresponding to a discriminant, contains the
discriminant number. */
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
bool inner_const_flag = const_flag;
bool static_p = Is_Statically_Allocated (gnat_entity);
tree gnu_ext_name = NULL_TREE;
+ tree renamed_obj = NULL_TREE;
if (Present (Renamed_Object (gnat_entity)) && !definition)
{
/* Otherwise, make this into a constant pointer to the object we
are to rename.
- Stabilize it if we are not at the global level since in this
- case the renaming evaluation may directly dereference the
- initial value we make here instead of the pointer we will
- assign it to. We don't want variables in the expression to be
- evaluated every time the renaming is used, since the value of
- these variables may change in between.
-
- If we are at the global level and the value is not constant,
- create_var_decl generates a mere elaboration assignment and
- does not attach the initial expression to the declaration.
- There is no possible direct initial-value dereference then. */
+ Stabilize it since in this case the renaming evaluation may
+ directly dereference the initial value we make here instead
+ of the pointer we will assign it to. We don't want variables
+ in the expression to be evaluated every time the renaming is
+ used, since their value may change in between. */
else
{
+ bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
inner_const_flag = TREE_READONLY (gnu_expr);
const_flag = true;
gnu_type = build_reference_type (gnu_type);
- gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr);
+ renamed_obj = gnat_stabilize_reference (gnu_expr, true);
+ gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
if (!global_bindings_p ())
{
- bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
-
- gnu_expr = gnat_stabilize_reference (gnu_expr, true);
-
/* If the original expression had side effects, put a
SAVE_EXPR around this whole thing. */
if (has_side_effects)
static_p, attr_list, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
+ if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+ {
+ SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
+ DECL_RENAMING_GLOBAL_P (gnu_decl) = global_bindings_p ();
+ }
/* If we have an address clause and we've made this indirect, it's
not enough to merely mark the type as volatile since volatile
gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true);
- /* If the field's type is justified modular and the size of the packed
- array it wraps is the same as that of the field, we can make the field
- the type of the inner object. Note that we may need to do so if the
- record is packed or the field has a component clause, but these cases
- are handled later. */
- if (TREE_CODE (gnu_field_type) == RECORD_TYPE
- && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
- && tree_int_cst_equal (TYPE_SIZE (gnu_field_type),
- TYPE_ADA_SIZE (gnu_field_type)))
- gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
-
/* If we are packing this record, have a specified size that's smaller than
that of the field type, or a position is specified, and the field type
is also a record that's BLKmode and with a small constant size, see if
Ada Joined Undocumented
; Catches typos
+gnatO
+Ada Separate
+; Sets name of output ALI file (internal switch)
+
gnat
Ada Joined
-gnat<options> Specify options to GNAT
const struct cl_option *option = &cl_options[scode];
enum opt_code code = (enum opt_code) scode;
char *q;
- unsigned int i;
if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
{
gnat_argv[gnat_argc][0] = '-';
strcpy (gnat_argv[gnat_argc] + 1, arg);
gnat_argc++;
+ break;
- if (arg[0] == 'O')
- for (i = 1; i < save_argc - 1; i++)
- if (!strncmp (save_argv[i], "-gnatO", 6))
- if (save_argv[++i][0] != '-')
- {
- /* Preserve output filename as GCC doesn't save it for GNAT. */
- gnat_argv[gnat_argc] = xstrdup (save_argv[i]);
- gnat_argc++;
- break;
- }
+ case OPT_gnatO:
+ gnat_argv[gnat_argc] = xstrdup ("-O");
+ gnat_argc++;
+ gnat_argv[gnat_argc] = xstrdup (arg);
+ gnat_argc++;
break;
}
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),
indent + 4);
break;
&& DECL_BY_COMPONENT_PTR_P (gnu_result))))
{
bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
- tree initial;
+ tree renamed_obj;
if (TREE_CODE (gnu_result) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (gnu_result))
convert (build_pointer_type (gnu_result_type),
gnu_result));
- /* If the object is constant, we try to do the dereference directly
- through the DECL_INITIAL. This is actually required in order to get
- correct aliasing information for renamed objects that are components
- of non-aliased aggregates, because the type of the renamed object and
- that of the aggregate don't alias.
-
- Note that we expect the initial value to have been stabilized.
- If it contains e.g. a variable reference, we certainly don't want
- to re-evaluate the variable each time the renaming is used.
-
- Stabilization is currently not performed at the global level but
- create_var_decl avoids setting DECL_INITIAL if the value is not
- constant then, and we get to the pointer dereference below.
-
- ??? Couldn't the aliasing issue show up again in this case ?
- There is no obvious reason why not. */
- else if (TREE_READONLY (gnu_result)
- && DECL_INITIAL (gnu_result)
- /* Strip possible conversion to reference type. */
- && ((initial = TREE_CODE (DECL_INITIAL (gnu_result))
- == NOP_EXPR
- ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0)
- : DECL_INITIAL (gnu_result), 1))
- && TREE_CODE (initial) == ADDR_EXPR
- && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF
- || (TREE_CODE (TREE_OPERAND (initial, 0))
- == COMPONENT_REF)))
- gnu_result = TREE_OPERAND (initial, 0);
+ /* If it's a renaming pointer and we are at the right binding level,
+ we can reference the renamed object directly, since the renamed
+ expression has been protected against multiple evaluations. */
+ else if (TREE_CODE (gnu_result) == VAR_DECL
+ && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) != 0
+ && (! DECL_RENAMING_GLOBAL_P (gnu_result)
+ || global_bindings_p ())
+ /* Make sure it's an lvalue like INDIRECT_REF. */
+ && (TREE_CODE_CLASS (TREE_CODE (renamed_obj)) == 'd'
+ || TREE_CODE_CLASS (TREE_CODE (renamed_obj)) == 'r'))
+ gnu_result = renamed_obj;
else
gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
fold (gnu_result));
if (CONTAINS_PLACEHOLDER_P (gnu_result))
{
if (TREE_CODE (gnu_prefix) != TYPE_DECL)
- gnu_result = substitute_placeholder_in_expr (gnu_result,
- gnu_expr);
+ gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
else
gnu_result = max_size (gnu_result, true);
}
("\\?or use `pragma No_Strict_Aliasing (&);`",
gnat_node, Target_Type (gnat_node));
}
+
+ /* The No_Strict_Aliasing flag is not propagated to the back-end for
+ fat pointers so unconditionally warn in problematic cases. */
+ else if (TYPE_FAT_POINTER_P (gnu_target_type))
+ {
+ tree array_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
+
+ if (get_alias_set (array_type) != 0
+ && (!TYPE_FAT_POINTER_P (gnu_source_type)
+ || (get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type))))
+ != get_alias_set (array_type))))
+ {
+ post_error_ne
+ ("?possible aliasing problem for type&",
+ gnat_node, Target_Type (gnat_node));
+ post_error
+ ("\\?use -fno-strict-aliasing switch for references",
+ gnat_node);
+ }
+ }
}
gnu_result = alloc_stmt_list ();
break;
projects / gcc.git / commitdiff