Commit 4c8125f4 by Eric Botcazou Committed by Eric Botcazou

gigi.h (mark_visited): Declare.

	* gigi.h (mark_visited): Declare.
	* decl.c (gnat_to_gnu_entity): Use mark_visited instead of marking
	only the topmost node of expressions.
	(elaborate_expression_1): Look deeper for read-only variable.
	* trans.c (add_decl_expr): Use mark_visited instead of marking by hand.
	(mark_visited): Move logic to mark_visited_r.  Invoke walk_tree.
	(mark_visited_r): New function.

From-SVN: r135819
parent e793b0fe
2008-05-23 Eric Botcazou <ebotcazou@adacore.com>
* gigi.h (mark_visited): Declare.
* decl.c (gnat_to_gnu_entity): Use mark_visited instead of marking
only the topmost node of expressions.
(elaborate_expression_1): Look deeper for read-only variable.
* trans.c (add_decl_expr): Use mark_visited instead of marking by hand.
(mark_visited): Move logic to mark_visited_r. Invoke walk_tree.
(mark_visited_r): New function.
2008-05-23 Vincent Celier <celier@adacore.com> 2008-05-23 Vincent Celier <celier@adacore.com>
* snames.adb: * snames.adb:
...@@ -876,7 +876,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -876,7 +876,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* ??? No DECL_EXPR is created so we need to mark /* ??? No DECL_EXPR is created so we need to mark
the expression manually lest it is shared. */ the expression manually lest it is shared. */
if (global_bindings_p ()) if (global_bindings_p ())
TREE_VISITED (gnu_decl) = 1; mark_visited (&gnu_decl);
save_gnu_tree (gnat_entity, gnu_decl, true); save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true; saved = true;
break; break;
...@@ -2343,7 +2343,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2343,7 +2343,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* ??? create_type_decl is not invoked on the inner types so /* ??? create_type_decl is not invoked on the inner types so
the MULT_EXPR node built above will never be marked. */ the MULT_EXPR node built above will never be marked. */
TREE_VISITED (TYPE_SIZE_UNIT (gnu_arr_type)) = 1; mark_visited (&TYPE_SIZE_UNIT (gnu_arr_type));
} }
} }
...@@ -4379,9 +4379,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4379,9 +4379,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* ??? The context of gnu_field is not necessarily gnu_type so /* ??? The context of gnu_field is not necessarily gnu_type so
the MULT_EXPR node built above may not be marked by the call the MULT_EXPR node built above may not be marked by the call
to create_type_decl below. Mark it manually for now. */ to create_type_decl below. */
if (global_bindings_p ()) if (global_bindings_p ())
TREE_VISITED (DECL_FIELD_OFFSET (gnu_field)) = 1; mark_visited (&DECL_FIELD_OFFSET (gnu_field));
} }
} }
...@@ -5295,10 +5295,12 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity, ...@@ -5295,10 +5295,12 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
bool need_debug) bool need_debug)
{ {
tree gnu_decl = NULL_TREE; tree gnu_decl = NULL_TREE;
/* Strip any conversions to see if the expression is a readonly variable. /* Skip any conversions and simple arithmetics to see if the expression
??? This really should remain readonly, but we have to think about is a read-only variable.
??? This really should remain read-only, but we have to think about
the typing of the tree here. */ the typing of the tree here. */
tree gnu_inner_expr = remove_conversions (gnu_expr, true); tree gnu_inner_expr
= skip_simple_arithmetic (remove_conversions (gnu_expr, true));
bool expr_global = Is_Public (gnat_entity) || global_bindings_p (); bool expr_global = Is_Public (gnat_entity) || global_bindings_p ();
bool expr_variable; bool expr_variable;
...@@ -5314,7 +5316,7 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity, ...@@ -5314,7 +5316,7 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
gnu_expr, NULL_TREE); gnu_expr, NULL_TREE);
/* If GNU_EXPR is neither a placeholder nor a constant, nor a variable /* If GNU_EXPR is neither a placeholder nor a constant, nor a variable
that is a constant, make a variable that is initialized to contain the that is read-only, make a variable that is initialized to contain the
bound when the package containing the definition is elaborated. If bound when the package containing the definition is elaborated. If
this entity is defined at top level and a bound or discriminant value this entity is defined at top level and a bound or discriminant value
isn't a constant or a reference to a discriminant, replace the bound isn't a constant or a reference to a discriminant, replace the bound
......
...@@ -102,6 +102,11 @@ extern void set_block_for_group (tree); ...@@ -102,6 +102,11 @@ extern void set_block_for_group (tree);
Get SLOC from GNAT_ENTITY. */ Get SLOC from GNAT_ENTITY. */
extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity); extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity);
/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
sized gimplified. We use this to indicate all variable sizes and
positions in global types may not be shared by any subprograms. */
extern void mark_visited (tree *);
/* Finalize any From_With_Type incomplete types. We do this after processing /* Finalize any From_With_Type incomplete types. We do this after processing
our compilation unit and after processing its spec, if this is a body. */ our compilation unit and after processing its spec, if this is a body. */
extern void finalize_from_with_types (void); extern void finalize_from_with_types (void);
......
...@@ -186,7 +186,6 @@ static void Compilation_Unit_to_gnu (Node_Id); ...@@ -186,7 +186,6 @@ static void Compilation_Unit_to_gnu (Node_Id);
static void record_code_position (Node_Id); static void record_code_position (Node_Id);
static void insert_code_for (Node_Id); static void insert_code_for (Node_Id);
static void add_cleanup (tree, Node_Id); static void add_cleanup (tree, Node_Id);
static tree mark_visited (tree *, int *, void *);
static tree unshare_save_expr (tree *, int *, void *); static tree unshare_save_expr (tree *, int *, void *);
static void add_stmt_list (List_Id); static void add_stmt_list (List_Id);
static void push_exception_label_stack (tree *, Entity_Id); static void push_exception_label_stack (tree *, Entity_Id);
...@@ -5102,13 +5101,13 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) ...@@ -5102,13 +5101,13 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
/* Mark everything as used to prevent node sharing with subprograms. /* Mark everything as used to prevent node sharing with subprograms.
Note that walk_tree knows how to deal with TYPE_DECL, but neither Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */ VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
walk_tree (&gnu_stmt, mark_visited, NULL, NULL); mark_visited (&gnu_stmt);
if (TREE_CODE (gnu_decl) == VAR_DECL if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL) || TREE_CODE (gnu_decl) == CONST_DECL)
{ {
walk_tree (&DECL_SIZE (gnu_decl), mark_visited, NULL, NULL); mark_visited (&DECL_SIZE (gnu_decl));
walk_tree (&DECL_SIZE_UNIT (gnu_decl), mark_visited, NULL, NULL); mark_visited (&DECL_SIZE_UNIT (gnu_decl));
walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL); mark_visited (&DECL_INITIAL (gnu_decl));
} }
/* In any case, we have to deal with our own TYPE_ADA_SIZE field. */ /* In any case, we have to deal with our own TYPE_ADA_SIZE field. */
if (TREE_CODE (gnu_decl) == TYPE_DECL if (TREE_CODE (gnu_decl) == TYPE_DECL
...@@ -5116,7 +5115,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) ...@@ -5116,7 +5115,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
|| TREE_CODE (type) == UNION_TYPE || TREE_CODE (type) == UNION_TYPE
|| TREE_CODE (type) == QUAL_UNION_TYPE) || TREE_CODE (type) == QUAL_UNION_TYPE)
&& (t = TYPE_ADA_SIZE (type))) && (t = TYPE_ADA_SIZE (type)))
walk_tree (&t, mark_visited, NULL, NULL); mark_visited (&t);
} }
else else
add_stmt_with_node (gnu_stmt, gnat_entity); add_stmt_with_node (gnu_stmt, gnat_entity);
...@@ -5150,13 +5149,10 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) ...@@ -5150,13 +5149,10 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
} }
} }
/* Utility function to mark nodes with TREE_VISITED and types as having their /* Callback for walk_tree to mark the visited trees rooted at *TP. */
sized gimplified. Called from walk_tree. We use this to indicate all
variable sizes and positions in global types may not be shared by any
subprogram. */
static tree static tree
mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) mark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{ {
if (TREE_VISITED (*tp)) if (TREE_VISITED (*tp))
*walk_subtrees = 0; *walk_subtrees = 0;
...@@ -5186,6 +5182,16 @@ unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, ...@@ -5186,6 +5182,16 @@ unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
return NULL_TREE; return NULL_TREE;
} }
/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
sized gimplified. We use this to indicate all variable sizes and
positions in global types may not be shared by any subprogram. */
void
mark_visited (tree *tp)
{
walk_tree (tp, mark_visited_r, NULL, NULL);
}
/* Add GNU_CLEANUP, a cleanup action, to the current code group and /* Add GNU_CLEANUP, a cleanup action, to the current code group and
set its location to that of GNAT_NODE if present. */ set its location to that of GNAT_NODE if present. */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment