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
This commit is contained in:
Eric Botcazou
Arnaud Charlet
parent
e602394c38
commit
7e1957a40d
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user