From ea292448322b87fcd3f8da04467420b49f609053 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 25 May 2015 14:00:28 +0000 Subject: [PATCH] ada-tree.h (DECL_RENAMING_GLOBAL_P): Rename into... * gcc-interface/ada-tree.h (DECL_RENAMING_GLOBAL_P): Rename into... (DECL_GLOBAL_NONCONSTANT_RENAMING_P): ...this. * gcc-interface/gigi.h (record_global_renaming_pointer): Delete. (invalidate_global_renaming_pointers): Likewise. (record_global_nonconstant_renaming): New. (invalidate_global_nonconstant_renamings): Likewise. (get_inner_constant_reference): Likewise. (gnat_constant_reference_p): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust to above and register the renaming pointer only if the object is non-constant. (elaborate_expression_1): Call get_inner_constant_reference instead of get_inner_reference. * gcc-interface/trans.c (fold_constant_decl_in_expr): Minor tweak. (Identifier_to_gnu): Adjust to above and do not recheck the renamed object before substituting it. (Compilation_Unit_to_gnu): Adjust to above renaming. Minor tweaks. (gnat_to_gnu) : Do not return the result at the global level. (N_Exception_Renaming_Declaration): Likewise. * gcc-interface/utils.c (global_renaming_pointers): Rename into... (global_nonconstant_renamings): ...this. (destroy_gnat_utils): Adjust to above renaming. (record_global_renaming_pointer): Rename into... (record_global_nonconstant_renaming): ...this. (invalidate_global_renaming_pointers): Rename into... (invalidate_global_nonconstant_renamings): ...this and do not recheck the renamed object before invalidating. * gcc-interface/utils2.c (gnat_stabilize_reference): Minor tweak. (get_inner_constant_reference): New public function. (gnat_constant_reference_p): New predicate. From-SVN: r223644 --- gcc/ada/ChangeLog | 33 +++++++++++++ gcc/ada/gcc-interface/ada-tree.h | 7 +-- gcc/ada/gcc-interface/decl.c | 26 ++++------ gcc/ada/gcc-interface/gigi.h | 19 +++++-- gcc/ada/gcc-interface/trans.c | 66 +++++++++++++------------ gcc/ada/gcc-interface/utils.c | 31 ++++++------ gcc/ada/gcc-interface/utils2.c | 77 +++++++++++++++++++++++++++-- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/renaming6.adb | 31 ++++++++++++ gcc/testsuite/gnat.dg/renaming6.ads | 14 ++++++ 10 files changed, 231 insertions(+), 77 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/renaming6.adb create mode 100644 gcc/testsuite/gnat.dg/renaming6.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5afd2f8f583..ae967f7e908 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2015-05-25 Eric Botcazou + + * gcc-interface/ada-tree.h (DECL_RENAMING_GLOBAL_P): Rename into... + (DECL_GLOBAL_NONCONSTANT_RENAMING_P): ...this. + * gcc-interface/gigi.h (record_global_renaming_pointer): Delete. + (invalidate_global_renaming_pointers): Likewise. + (record_global_nonconstant_renaming): New. + (invalidate_global_nonconstant_renamings): Likewise. + (get_inner_constant_reference): Likewise. + (gnat_constant_reference_p): Likewise. + * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust to above + and register the renaming pointer only if the object is non-constant. + (elaborate_expression_1): Call get_inner_constant_reference instead + of get_inner_reference. + * gcc-interface/trans.c (fold_constant_decl_in_expr): Minor tweak. + (Identifier_to_gnu): Adjust to above and do not recheck the renamed + object before substituting it. + (Compilation_Unit_to_gnu): Adjust to above renaming. Minor tweaks. + (gnat_to_gnu) : Do not return the + result at the global level. + (N_Exception_Renaming_Declaration): Likewise. + * gcc-interface/utils.c (global_renaming_pointers): Rename into... + (global_nonconstant_renamings): ...this. + (destroy_gnat_utils): Adjust to above renaming. + (record_global_renaming_pointer): Rename into... + (record_global_nonconstant_renaming): ...this. + (invalidate_global_renaming_pointers): Rename into... + (invalidate_global_nonconstant_renamings): ...this and do not recheck + the renamed object before invalidating. + * gcc-interface/utils2.c (gnat_stabilize_reference): Minor tweak. + (get_inner_constant_reference): New public function. + (gnat_constant_reference_p): New predicate. + 2015-05-25 Javier Miranda * einfo.ads, einfo.adb (Has_Out_Or_In_Out_Parameter): This attribute diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index ba5765d0dba..f496b8efca3 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2014, Free Software Foundation, Inc. * + * Copyright (C) 1992-2015, 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- * @@ -394,8 +394,9 @@ do { \ is readonly. */ #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (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)) +/* Nonzero in a VAR_DECL if it is a global non-constant renaming. */ +#define DECL_GLOBAL_NONCONSTANT_RENAMING_P(NODE) \ + DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE)) /* In a FIELD_DECL corresponding to a discriminant, contains the discriminant number. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index d908a1b750d..7480593a338 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1517,15 +1517,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) DECL_LOOP_PARM_P (gnu_decl) = 1; /* If this is a renaming pointer, attach the renamed object to it and - register it if we are at the global level. Note that an external - constant is at the global level. */ + register it if we are at the global level and the renamed object + is a non-constant reference. Note that an external constant is at + the global level. */ if (renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); - if ((!definition && kind == E_Constant) || global_bindings_p ()) + + if (((!definition && kind == E_Constant) || global_bindings_p ()) + && !gnat_constant_reference_p (renamed_obj)) { - DECL_RENAMING_GLOBAL_P (gnu_decl) = 1; - record_global_renaming_pointer (gnu_decl); + DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_decl) = 1; + record_global_nonconstant_renaming (gnu_decl); } } @@ -6245,18 +6248,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, inner = skip_simple_constant_arithmetic (inner); if (handled_component_p (inner)) - { - HOST_WIDE_INT bitsize, bitpos; - tree offset; - machine_mode mode; - int unsignedp, volatilep; - - inner = get_inner_reference (inner, &bitsize, &bitpos, &offset, - &mode, &unsignedp, &volatilep, false); - /* If the offset is variable, err on the side of caution. */ - if (offset) - inner = NULL_TREE; - } + inner = get_inner_constant_reference (inner); expr_variable_p = !(inner diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 6d65fc519e4..0419a53fc22 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2014, Free Software Foundation, Inc. * + * Copyright (C) 1992-2015, 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- * @@ -716,11 +716,11 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, const_flag, public_flag, extern_flag, \ static_flag, false, attr_list, gnat_node) -/* Record DECL as a global renaming pointer. */ -extern void record_global_renaming_pointer (tree decl); +/* Record DECL as a global non-constant renaming. */ +extern void record_global_nonconstant_renaming (tree decl); -/* Invalidate the global renaming pointers. */ -extern void invalidate_global_renaming_pointers (void); +/* Invalidate the global non-constant renamings. */ +extern void invalidate_global_nonconstant_renamings (void); /* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is its type and RECORD_TYPE is the type of the enclosing record. If SIZE is @@ -966,6 +966,15 @@ extern tree gnat_protect_expr (tree exp); through something we don't know how to stabilize. */ extern tree gnat_stabilize_reference (tree ref, bool force, bool *success); +/* This is equivalent to get_inner_reference in expr.c but it returns the + ultimate containing object only if the reference (lvalue) is constant, + i.e. if it doesn't depend on the context in which it is evaluated. */ +extern tree get_inner_constant_reference (tree exp); + +/* Return true if REF is a constant reference, i.e. a reference (lvalue) that + doesn't depend on the context in which it is evaluated. */ +extern bool gnat_constant_reference_p (tree ref); + /* If EXPR is an expression that is invariant in the current function, in the sense that it can be evaluated anywhere in the function and any number of times, return EXPR or an equivalent expression. Otherwise return NULL. */ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 917a9a6c282..03f3e3016a6 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1004,9 +1004,9 @@ fold_constant_decl_in_expr (tree exp) return fold (build4 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2), TREE_OPERAND (exp, 3))); - case VIEW_CONVERT_EXPR: case REALPART_EXPR: case IMAGPART_EXPR: + case VIEW_CONVERT_EXPR: op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0)); if (op0 == TREE_OPERAND (exp, 0)) return exp; @@ -1165,15 +1165,14 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) true, false))) gnu_result = DECL_INITIAL (gnu_result); - /* If it's a renaming pointer and, either the renamed object is constant - or we are at the right binding level, we can reference the renamed - object directly, since it is constant or has been protected against + /* If it's a renaming pointer and not a global non-constant renaming or + we are at the global level, the we can reference the renamed object + directly, since it is either constant or has been protected against multiple evaluations. */ if (TREE_CODE (gnu_result) == VAR_DECL && !DECL_LOOP_PARM_P (gnu_result) && DECL_RENAMED_OBJECT (gnu_result) - && (TREE_CONSTANT (DECL_RENAMED_OBJECT (gnu_result)) - || !DECL_RENAMING_GLOBAL_P (gnu_result) + && (!DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_result) || global_bindings_p ())) gnu_result = DECL_RENAMED_OBJECT (gnu_result); @@ -5143,28 +5142,24 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) add_stmt_list (Actions (Aux_Decls_Node (gnat_node))); finalize_from_limited_with (); - /* Save away what we've made so far and record this potential elaboration - procedure. */ - info = ggc_alloc (); + /* Save away what we've made so far and finish it up. */ set_current_block_context (gnu_elab_proc_decl); gnat_poplevel (); DECL_SAVED_TREE (gnu_elab_proc_decl) = end_stmt_group (); - set_end_locus_from_node (gnu_elab_proc_decl, gnat_unit); + gnu_elab_proc_stack->pop (); + /* Record this potential elaboration procedure for later processing. */ + info = ggc_alloc (); info->next = elab_info_list; info->elab_proc = gnu_elab_proc_decl; info->gnat_node = gnat_node; elab_info_list = info; - /* Generate elaboration code for this unit, if necessary, and say whether - we did or not. */ - gnu_elab_proc_stack->pop (); - - /* Invalidate the global renaming pointers. This is necessary because - stabilization of the renamed entities may create SAVE_EXPRs which - have been tied to a specific elaboration routine just above. */ - invalidate_global_renaming_pointers (); + /* Invalidate the global non-constant renamings. This is necessary because + stabilization of the renamed entities may create SAVE_EXPRs which have + been tied to a specific elaboration routine just above. */ + invalidate_global_nonconstant_renamings (); /* Force the processing for all nodes that remain in the queue. */ process_deferred_decl_context (true); @@ -5695,31 +5690,40 @@ gnat_to_gnu (Node_Id gnat_node) case N_Object_Renaming_Declaration: gnat_temp = Defining_Entity (gnat_node); + gnu_result = alloc_stmt_list (); /* Don't do anything if this renaming is handled by the front end or if we are just annotating types and this object has a composite or task - type, don't elaborate it. We return the result in case it has any - SAVE_EXPRs in it that need to be evaluated here. */ + type, don't elaborate it. We return the result in case it contains + any SAVE_EXPRs that need to be evaluated here, but this cannot occur + at the global level (see Renaming, case 2 in gnat_to_gnu_entity). */ if (!Is_Renaming_Of_Object (gnat_temp) && ! (type_annotate_only && (Is_Array_Type (Etype (gnat_temp)) || Is_Record_Type (Etype (gnat_temp)) || Is_Concurrent_Type (Etype (gnat_temp))))) - gnu_result - = gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Object (gnat_temp)), 1); - else - gnu_result = alloc_stmt_list (); + { + tree gnu_temp + = gnat_to_gnu_entity (gnat_temp, + gnat_to_gnu (Renamed_Object (gnat_temp)), 1); + if (!global_bindings_p ()) + gnu_result = gnu_temp; + } break; case N_Exception_Renaming_Declaration: gnat_temp = Defining_Entity (gnat_node); - if (Renamed_Entity (gnat_temp) != Empty) - gnu_result - = gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Entity (gnat_temp)), 1); - else - gnu_result = alloc_stmt_list (); + gnu_result = alloc_stmt_list (); + + /* See the above case for the rationale. */ + if (Present (Renamed_Entity (gnat_temp))) + { + tree gnu_temp + = gnat_to_gnu_entity (gnat_temp, + gnat_to_gnu (Renamed_Entity (gnat_temp)), 1); + if (!global_bindings_p ()) + gnu_result = gnu_temp; + } break; case N_Implicit_Label_Declaration: diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 59688574dab..184c7d53e9e 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -233,8 +233,8 @@ static GTY(()) vec *global_decls; /* An array of builtin function declarations. */ static GTY(()) vec *builtin_decls; -/* An array of global renaming pointers. */ -static GTY(()) vec *global_renaming_pointers; +/* An array of global non-constant renamings. */ +static GTY(()) vec *global_nonconstant_renamings; /* A chain of unused BLOCK nodes. */ static GTY((deletable)) tree free_block_chain; @@ -323,8 +323,8 @@ destroy_gnat_utils (void) pad_type_hash_table->empty (); pad_type_hash_table = NULL; - /* Invalidate the global renaming pointers. */ - invalidate_global_renaming_pointers (); + /* Invalidate the global non-constant renamings. */ + invalidate_global_nonconstant_renamings (); } /* GNAT_ENTITY is a GNAT tree node for an entity. Associate GNU_DECL, a GCC @@ -2718,34 +2718,31 @@ process_attributes (tree *node, struct attrib **attr_list, bool in_place, *attr_list = NULL; } -/* Record DECL as a global renaming pointer. */ +/* Record DECL as a global non-constant renaming. */ void -record_global_renaming_pointer (tree decl) +record_global_nonconstant_renaming (tree decl) { gcc_assert (!DECL_LOOP_PARM_P (decl) && DECL_RENAMED_OBJECT (decl)); - vec_safe_push (global_renaming_pointers, decl); + vec_safe_push (global_nonconstant_renamings, decl); } -/* Invalidate the global renaming pointers that are not constant, lest their - renamed object contains SAVE_EXPRs tied to an elaboration routine. Note - that we should not blindly invalidate everything here because of the need - to propagate constant values through renaming. */ +/* Invalidate the global non-constant renamings, lest their renamed object + contains SAVE_EXPRs tied to an elaboration routine. */ void -invalidate_global_renaming_pointers (void) +invalidate_global_nonconstant_renamings (void) { unsigned int i; tree iter; - if (global_renaming_pointers == NULL) + if (global_nonconstant_renamings == NULL) return; - FOR_EACH_VEC_ELT (*global_renaming_pointers, i, iter) - if (!TREE_CONSTANT (DECL_RENAMED_OBJECT (iter))) - SET_DECL_RENAMED_OBJECT (iter, NULL_TREE); + FOR_EACH_VEC_ELT (*global_nonconstant_renamings, i, iter) + SET_DECL_RENAMED_OBJECT (iter, NULL_TREE); - vec_free (global_renaming_pointers); + vec_free (global_nonconstant_renamings); } /* Return true if VALUE is a known to be a multiple of FACTOR, which must be diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index e25b815a5dd..e09b5b9d425 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -2692,10 +2692,10 @@ gnat_stabilize_reference (tree ref, bool force, bool *success) break; case COMPONENT_REF: - result = build3 (COMPONENT_REF, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), force, - success), - TREE_OPERAND (ref, 1), NULL_TREE); + result = build3 (COMPONENT_REF, type, + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force, + success), + TREE_OPERAND (ref, 1), NULL_TREE); break; case BIT_FIELD_REF: @@ -2782,6 +2782,75 @@ gnat_stabilize_reference (tree ref, bool force, bool *success) return result; } +/* This is equivalent to get_inner_reference in expr.c but it returns the + ultimate containing object only if the reference (lvalue) is constant, + i.e. if it doesn't depend on the context in which it is evaluated. */ + +tree +get_inner_constant_reference (tree exp) +{ + while (true) + { + switch (TREE_CODE (exp)) + { + case BIT_FIELD_REF: + break; + + case COMPONENT_REF: + if (TREE_OPERAND (exp, 2) != NULL_TREE) + return NULL_TREE; + + if (!TREE_CONSTANT (DECL_FIELD_OFFSET (TREE_OPERAND (exp, 1)))) + return NULL_TREE; + break; + + case ARRAY_REF: + case ARRAY_RANGE_REF: + { + if (TREE_OPERAND (exp, 2) != NULL_TREE + || TREE_OPERAND (exp, 3) != NULL_TREE) + return NULL_TREE; + + tree array_type = TREE_TYPE (TREE_OPERAND (exp, 0)); + if (!TREE_CONSTANT (TREE_OPERAND (exp, 1)) + || !TREE_CONSTANT (TYPE_MIN_VALUE (TYPE_DOMAIN (array_type))) + || !TREE_CONSTANT (TYPE_SIZE_UNIT (TREE_TYPE (array_type)))) + return NULL_TREE; + } + break; + + case REALPART_EXPR: + case IMAGPART_EXPR: + case VIEW_CONVERT_EXPR: + break; + + default: + goto done; + } + + exp = TREE_OPERAND (exp, 0); + } + +done: + return exp; +} + +/* Return true if REF is a constant reference, i.e. a reference (lvalue) that + doesn't depend on the context in which it is evaluated. */ + +bool +gnat_constant_reference_p (tree ref) +{ + if (handled_component_p (ref)) + { + ref = get_inner_constant_reference (ref); + if (!ref) + return false; + } + + return DECL_P (ref); +} + /* If EXPR is an expression that is invariant in the current function, in the sense that it can be evaluated anywhere in the function and any number of times, return EXPR or an equivalent expression. Otherwise return NULL. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 942bad53547..2d8cd01f8a6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2015-05-25 Eric Botcazou + + * gnat.dg/renaming6.ad[sb]: New test. + 2015-05-25 Andreas Tobler * gcc.target/i386/pr64317.c: Use 'dg-require-effective-target ia32' diff --git a/gcc/testsuite/gnat.dg/renaming6.adb b/gcc/testsuite/gnat.dg/renaming6.adb new file mode 100644 index 00000000000..2dcd5c71477 --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming6.adb @@ -0,0 +1,31 @@ +-- { dg-do compile } +-- { dg-options "-fdump-tree-original" } + +package body Renaming6 is + + function Get_I return Integer is + begin + return I; + end; + + procedure Set_I (Val : Integer) is + begin + I := Val; + end; + + function Get_J return Integer is + begin + return J; + end; + + procedure Set_J (Val : Integer) is + begin + J := Val; + end; + +end Renaming6; + +-- { dg-final { scan-tree-dump-times "atomic_load" 2 "original" } } +-- { dg-final { scan-tree-dump-times "atomic_store" 2 "original" } } +-- { dg-final { scan-tree-dump-not "j" "original" } } +-- { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gnat.dg/renaming6.ads b/gcc/testsuite/gnat.dg/renaming6.ads new file mode 100644 index 00000000000..5cfef5b999f --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming6.ads @@ -0,0 +1,14 @@ +package Renaming6 is + + I : Integer; + pragma Atomic (I); + + function Get_I return Integer; + procedure Set_I (Val : Integer); + + J : Integer renames I; + + function Get_J return Integer; + procedure Set_J (Val : Integer); + +end Renaming6; -- 2.30.2