From 7e1957a40d722beba8d9d002c7d15b01a18e7736 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 18 Mar 2005 12:47:18 +0100
Subject: [PATCH] ada-tree.h: (DECL_RENAMING_GLOBAL_P): New predicate.
2005-03-17 Eric Botcazou <ebotcazou@adacore.com>
* ada-tree.h: (DECL_RENAMING_GLOBAL_P): New predicate.
(DECL_RENAMED_OBJECT): New accessor macro.
(SET_DECL_RENAMED_OBJECT): New setter macro.
* decl.c (gnat_to_gnu_entity) <E_Variable>: Stabilize the renamed
object in all cases. Attach the renamed object to the VAR_DECL.
(gnat_to_gnu_field): Do not lift the record wrapper if the size of the
field is not prescribed.
* misc.c (gnat_handle_option): Handle -gnatO separately.
(gnat_print_decl) <VAR_DECL>: New case.
Print the DECL_RENAMED_OBJECT node.
* lang.opt: Declare separate -gnatO option.
* trans.c (tree_transform) <N_Identifier>: If the object is a renaming
pointer, replace it with the renamed object.
<N_Validate_Unchecked_Conversion>: Warn for a conversion to a fat
pointer type if the source is not a fat pointer type whose underlying
array has the same non-zero alias set as that of the destination array.
From-SVN: r96660
---
gcc/ada/ada-tree.h | 11 ++++++++
gcc/ada/decl.c | 41 ++++++++++-------------------
gcc/ada/lang.opt | 4 +++
gcc/ada/misc.c | 24 ++++++++---------
gcc/ada/trans.c | 65 ++++++++++++++++++++++++----------------------
5 files changed, 75 insertions(+), 70 deletions(-)
diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h
index fad1513ab8fa..4ea4b27a9144 100644
--- a/gcc/ada/ada-tree.h
+++ b/gcc/ada/ada-tree.h
@@ -260,6 +260,9 @@ struct lang_type GTY(()) {tree t; };
/* 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. */
@@ -275,6 +278,14 @@ struct lang_type GTY(()) {tree t; };
#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))
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 098d485af834..db806209f70c 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -498,6 +498,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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)
{
@@ -777,30 +778,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int 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)
@@ -1063,6 +1056,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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
@@ -5140,17 +5138,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
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
diff --git a/gcc/ada/lang.opt b/gcc/ada/lang.opt
index 584220c2ea8d..4f60bf96587a 100644
--- a/gcc/ada/lang.opt
+++ b/gcc/ada/lang.opt
@@ -65,6 +65,10 @@ gant
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
diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c
index 4646c863e8a2..03b156c25a3c 100644
--- a/gcc/ada/misc.c
+++ b/gcc/ada/misc.c
@@ -259,7 +259,6 @@ gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
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)))
{
@@ -314,17 +313,13 @@ gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
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;
}
@@ -506,7 +501,12 @@ gnat_print_decl (FILE *file, tree node, int indent)
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;
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 7e6485557a47..10955e352316 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -393,7 +393,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
&& 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))
@@ -402,34 +402,17 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
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));
@@ -746,8 +729,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
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);
}
@@ -4012,6 +3994,27 @@ gnat_to_gnu (Node_Id gnat_node)
("\\?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;
--
GitLab