This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] Fix tree node sharing problem (2/2)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 29 Nov 2006 09:27:14 +0100
- Subject: [PATCH] Fix tree node sharing problem (2/2)
Hi,
Ada is very sensitive to tree node sharing because it deals with a lot of
parameterized global types. When the variable components are gimplified via
gimplify_type_sizes, they cause temporaries to be created and these are tied
to a given subprogram; hence the gimplification cannot occur on the original
expression attached to the type but on a copy that has previously been
created when sharing was detected. This is the mark/copy-if-shared/unmark
mechanism in the gimplifier.
The current mechanism doesn't work well in two cases: pointers to scalar types
with variable bounds (previous message) and complex chains of variable-sized
aggregate types involving SAVE_EXPRs (this message).
In the second case, the problem is that the unsharing phase of gimplification
stops at SAVE_EXPRs, on the grounds that SAVE_EXPRs must by definition not be
copied. But nodes under the SAVE_EXPRs can be shared too (here between the
elaboration procedure of the spec of a package and that of its body) and thus
needs to be unshared too.
Therefore the proposed fix is to teach the gimplifier to unshare nodes under
SAVE_EXPRs too, without of course unsharing the SAVE_EXPRs themselves.
Bootstrapped/regtested on i586-suse-linux, OK for mainline?
2006-11-29 Eric Botcazou <ebotcazou@adacore.com>
* gimplify.c (mostly_copy_tree_r): Copy trees under SAVE_EXPR
and TARGET_EXPR nodes. Stop at BIND_EXPR nodes.
(copy_if_shared_r): Remove redundant code dealing with types,
decls and constants. Remove bogus ATTRIBUTE_UNUSED marker.
(unmark_visited_r): Remove bogus ATTRIBUTE_UNUSED marker.
ada/
* trans.c (unshare_save_expr): Delete.
(gigi): Do not unshare trees under SAVE_EXPRs here.
2006-11-29 ?Eric Botcazou ?<ebotcazou@adacore.com>
* gnat.dg/varsize_aggregates.adb: New test.
:ADDPATCH gimplifier:
--
Eric Botcazou
*** gcc/gimplify.c.0 2006-07-09 08:49:19.000000000 +0200
--- gcc/gimplify.c 2006-07-09 13:09:59.143164232 +0200
*************** annotate_all_with_locus (tree *stmt_p, l
*** 740,746 ****
}
}
! /* Similar to copy_tree_r() but do not copy SAVE_EXPR or TARGET_EXPR nodes.
These nodes model computations that should only be done once. If we
were to unshare something like SAVE_EXPR(i++), the gimplification
process would create wrong code. */
--- 740,746 ----
}
}
! /* Similar to copy_tree_r but do not copy SAVE_EXPR or TARGET_EXPR nodes.
These nodes model computations that should only be done once. If we
were to unshare something like SAVE_EXPR(i++), the gimplification
process would create wrong code. */
*************** static tree
*** 749,806 ****
mostly_copy_tree_r (tree *tp, int *walk_subtrees, void *data)
{
enum tree_code code = TREE_CODE (*tp);
! /* Don't unshare types, decls, constants and SAVE_EXPR nodes. */
if (TREE_CODE_CLASS (code) == tcc_type
|| TREE_CODE_CLASS (code) == tcc_declaration
|| TREE_CODE_CLASS (code) == tcc_constant
! || code == SAVE_EXPR || code == TARGET_EXPR
/* We can't do anything sensible with a BLOCK used as an expression,
but we also can't just die when we see it because of non-expression
uses. So just avert our eyes and cross our fingers. Silly Java. */
|| code == BLOCK)
*walk_subtrees = 0;
! else
! {
! gcc_assert (code != BIND_EXPR);
! copy_tree_r (tp, walk_subtrees, data);
! }
return NULL_TREE;
}
/* Callback for walk_tree to unshare most of the shared trees rooted at
*TP. If *TP has been visited already (i.e., TREE_VISITED (*TP) == 1),
! then *TP is deep copied by calling copy_tree_r.
!
! This unshares the same trees as copy_tree_r with the exception of
! SAVE_EXPR nodes. These nodes model computations that should only be
! done once. If we were to unshare something like SAVE_EXPR(i++), the
! gimplification process would create wrong code. */
static tree
! copy_if_shared_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
! void *data ATTRIBUTE_UNUSED)
{
- tree t = *tp;
- enum tree_code code = TREE_CODE (t);
-
- /* Skip types, decls, and constants. But we do want to look at their
- types and the bounds of types. Mark them as visited so we properly
- unmark their subtrees on the unmark pass. If we've already seen them,
- don't look down further. */
- if (TREE_CODE_CLASS (code) == tcc_type
- || TREE_CODE_CLASS (code) == tcc_declaration
- || TREE_CODE_CLASS (code) == tcc_constant)
- {
- if (TREE_VISITED (t))
- *walk_subtrees = 0;
- else
- TREE_VISITED (t) = 1;
- }
-
/* If this node has been visited already, unshare it and don't look
any deeper. */
! else if (TREE_VISITED (t))
{
walk_tree (tp, mostly_copy_tree_r, NULL, NULL);
*walk_subtrees = 0;
--- 749,784 ----
mostly_copy_tree_r (tree *tp, int *walk_subtrees, void *data)
{
enum tree_code code = TREE_CODE (*tp);
!
! /* Stop at types, decls, constants like copy_tree_r. */
if (TREE_CODE_CLASS (code) == tcc_type
|| TREE_CODE_CLASS (code) == tcc_declaration
|| TREE_CODE_CLASS (code) == tcc_constant
! /* Cope with the statement expression extension. */
! || code == BIND_EXPR
/* We can't do anything sensible with a BLOCK used as an expression,
but we also can't just die when we see it because of non-expression
uses. So just avert our eyes and cross our fingers. Silly Java. */
|| code == BLOCK)
*walk_subtrees = 0;
!
! /* Do not copy SAVE_EXPR or TARGET_EXPR nodes. */
! else if (code != SAVE_EXPR && code != TARGET_EXPR)
! copy_tree_r (tp, walk_subtrees, data);
return NULL_TREE;
}
/* Callback for walk_tree to unshare most of the shared trees rooted at
*TP. If *TP has been visited already (i.e., TREE_VISITED (*TP) == 1),
! then *TP is deep copied by calling mostly_copy_tree_r. */
static tree
! copy_if_shared_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
/* If this node has been visited already, unshare it and don't look
any deeper. */
! if (TREE_VISITED (*tp))
{
walk_tree (tp, mostly_copy_tree_r, NULL, NULL);
*walk_subtrees = 0;
*************** copy_if_shared_r (tree *tp, int *walk_su
*** 808,824 ****
/* Otherwise, mark the tree as visited and keep looking. */
else
! TREE_VISITED (t) = 1;
return NULL_TREE;
}
static tree
! unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
! void *data ATTRIBUTE_UNUSED)
{
if (TREE_VISITED (*tp))
TREE_VISITED (*tp) = 0;
else
*walk_subtrees = 0;
--- 786,807 ----
/* Otherwise, mark the tree as visited and keep looking. */
else
! TREE_VISITED (*tp) = 1;
return NULL_TREE;
}
+ /* Callback for walk_tree to unmark the visited trees rooted at *TP.
+ Subtrees are walked until the first unvisited node is encountered. */
+
static tree
! unmark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
+ /* If this node has been visited, unmark it and keep looking. */
if (TREE_VISITED (*tp))
TREE_VISITED (*tp) = 0;
+
+ /* Otherwise, don't look any deeper. */
else
*walk_subtrees = 0;
Index: trans.c
===================================================================
RCS file: /gnat.dev/cvs/Dev/gnat/trans.c,v
retrieving revision 1.68.2.138.2.27
diff -u -p -r1.68.2.138.2.27 trans.c
--- trans.c 19 Jun 2006 20:31:35 -0000 1.68.2.138.2.27
+++ trans.c 9 Jul 2006 08:34:16 -0000
@@ -149,7 +149,6 @@ static void insert_code_for (Node_Id);
static void start_stmt_group (void);
static void add_cleanup (tree);
static tree mark_visited (tree *, int *, void *);
-static tree unshare_save_expr (tree *, int *, void *);
static tree end_stmt_group (void);
static void add_stmt_list (List_Id);
static tree build_stmt_group (List_Id, bool);
@@ -255,16 +254,6 @@ gigi (Node_Id gnat_root, int max_gnat_no
tree gnu_body = DECL_SAVED_TREE (info->elab_proc);
tree gnu_stmts;
- /* Unshare SAVE_EXPRs between subprograms. These are not unshared by
- the gimplifier for obvious reasons, but it turns out that we need to
- unshare them for the global level because of SAVE_EXPRs made around
- checks for global objects and around allocators for global objects
- of variable size, in order to prevent node sharing in the underlying
- expression. Note that this implicitly assumes that the SAVE_EXPR
- nodes themselves are not shared between subprograms, which would be
- an upstream bug for which we would not change the outcome. */
- walk_tree_without_duplicates (&gnu_body, unshare_save_expr, NULL);
-
/* Set the current function to be the elaboration procedure and gimplify
what we have. */
current_function_decl = info->elab_proc;
@@ -292,7 +281,7 @@ gigi (Node_Id gnat_root, int max_gnat_no
/* Perform initializations for this module. */
void
-gnat_init_stmt_group ()
+gnat_init_stmt_group (void)
{
/* Initialize ourselves. */
init_code_table ();
@@ -4474,7 +4463,7 @@ insert_code_for (Node_Id gnat_node)
/* Start a new statement group chained to the previous group. */
static void
-start_stmt_group ()
+start_stmt_group (void)
{
struct stmt_group *group = stmt_group_free_list;
@@ -4610,20 +4599,6 @@ mark_visited (tree *tp, int *walk_subtre
return NULL_TREE;
}
-/* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */
-
-static tree
-unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
- void *data ATTRIBUTE_UNUSED)
-{
- tree t = *tp;
-
- if (TREE_CODE (t) == SAVE_EXPR)
- TREE_OPERAND (t, 0) = unshare_expr (TREE_OPERAND (t, 0));
-
- return NULL_TREE;
-}
-
/* Add GNU_CLEANUP, a cleanup action, to the current code group. */
static void
@@ -4646,7 +4621,7 @@ set_block_for_group (tree gnu_block)
BLOCK or cleanups were set. */
static tree
-end_stmt_group ()
+end_stmt_group (void)
{
struct stmt_group *group = current_stmt_group;
tree gnu_retval = group->stmt_list;
package body p is
procedure Make (C : out Local_T) is
Tmp : Local_T (Tag_One);
begin
C := Tmp;
end;
package Iteration is
type Message_T is
record
S : Local_T;
end record;
type Iterator_T is
record
S : Local_T;
end record;
type Access_Iterator_T is access Iterator_T;
end Iteration;
package body Iteration is
procedure Construct (Iterator : in out Access_Iterator_T;
Message : Message_T) is
begin
Iterator.S := Message.S;
end;
end Iteration;
begin
null;
end p;
with q;
package p is
type Tag_T is (Tag_One, Tag_Two);
type Local_T (Tag : Tag_T := Tag_One) is
record
case Tag is
when Tag_One =>
A : q.T;
B : Integer;
when Tag_Two =>
null;
end case;
end record;
procedure Make (C : out Local_T);
end p;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with r; use r;
package q is
type T is record
A : Unbounded_String;
B : L;
end record;
end q;
with s;
package r is
Max : constant Natural := s.Value;
type List_T is array (Natural range <>) of Integer;
type L is record
List : List_T (1 .. Max);
end record;
end r;
package s is
function Value return Natural;
end s;