This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Cleanup in renaming support
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 25 May 2015 15:03:01 +0200
- Subject: [Ada] Cleanup in renaming support
- Authentication-results: sourceware.org; auth=none
This is in preparation for the upcoming reimplementation.
Tested on x86_64-suse-linux, applied on the mainline.
2015-05-25 Eric Botcazou <ebotcazou@adacore.com>
* 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) <object>: 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) <N_Object_Renaming_Declaration>: 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 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/renaming6.ad[sb]: New test.
--
Eric Botcazou
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 223641)
+++ gcc-interface/utils.c (working copy)
@@ -233,8 +233,8 @@ static GTY(()) vec<tree, va_gc> *global_
/* An array of builtin function declarations. */
static GTY(()) vec<tree, va_gc> *builtin_decls;
-/* An array of global renaming pointers. */
-static GTY(()) vec<tree, va_gc> *global_renaming_pointers;
+/* An array of global non-constant renamings. */
+static GTY(()) vec<tree, va_gc> *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 a
*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
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 223641)
+++ gcc-interface/decl.c (working copy)
@@ -1517,15 +1517,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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, E
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
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 223641)
+++ gcc-interface/utils2.c (working copy)
@@ -2692,10 +2692,10 @@ gnat_stabilize_reference (tree ref, bool
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
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. */
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 223641)
+++ gcc-interface/gigi.h (working copy)
@@ -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 a
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. */
Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h (revision 223641)
+++ gcc-interface/ada-tree.h (working copy)
@@ -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. */
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 223641)
+++ gcc-interface/trans.c (working copy)
@@ -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, tr
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_no
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<elab_info> ();
+ /* 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<elab_info> ();
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:
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;
-- { 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" } }