From 7e1957a40d722beba8d9d002c7d15b01a18e7736 Mon Sep 17 00:00:00 2001 From: Eric Botcazou 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 * 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) : 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) : New case. Print the DECL_RENAMED_OBJECT node. * lang.opt: Declare separate -gnatO option. * trans.c (tree_transform) : If the object is a renaming pointer, replace it with the renamed object. : 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 fad1513ab8f..4ea4b27a914 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 098d485af83..db806209f70 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 584220c2ea8..4f60bf96587 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 Specify options to GNAT diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index 4646c863e8a..03b156c25a3 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 7e6485557a4..10955e35231 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;