* langhooks.h (struct lang_hooks): Add new field deep_unsharing.
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 19 May 2010 17:53:58 +0000 (17:53 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 19 May 2010 17:53:58 +0000 (17:53 +0000)
* langhooks-def.h (LANG_HOOKS_DEEP_UNSHARING): New macro.
(LANG_HOOKS_INITIALIZER): Add LANG_HOOKS_DEEP_UNSHARING.
* gimplify.c: (mostly_copy_tree_r): Copy trees under SAVE_EXPR and
TARGET_EXPR nodes, but only once, if instructed to do so.  Do not
propagate the 'data' argument to copy_tree_r.
(copy_if_shared_r): Remove bogus ATTRIBUTE_UNUSED marker.
Propagate 'data' argument to walk_tree.
(copy_if_shared): New function.
(unmark_visited_r): Remove bogus ATTRIBUTE_UNUSED marker.
(unmark_visited): New function.
(unshare_body): Call copy_if_shared instead of doing it manually.
(unvisit_body): Call unmark_visited instead of doing it manually.
ada/
* gcc-interface/misc.c (LANG_HOOKS_DEEP_UNSHARING): Redefine.
* gcc-interface/trans.c (unshare_save_expr): Delete.
(gigi): Do not unshare trees under SAVE_EXPRs here.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159592 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed:
gcc/ChangeLog
gcc/ada/ChangeLog
gcc/ada/gcc-interface/misc.c
gcc/ada/gcc-interface/trans.c
gcc/gimplify.c
gcc/langhooks-def.h
gcc/langhooks.h
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/discr23.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/discr23.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/discr23_pkg.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/controlled1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads [new file with mode: 0644]

index d9a89d7..aaaa6cb 100644 (file)
@@ -1,3 +1,19 @@
+2010-05-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * langhooks.h (struct lang_hooks): Add new field deep_unsharing.
+       * langhooks-def.h (LANG_HOOKS_DEEP_UNSHARING): New macro.
+       (LANG_HOOKS_INITIALIZER): Add LANG_HOOKS_DEEP_UNSHARING.
+       * gimplify.c: (mostly_copy_tree_r): Copy trees under SAVE_EXPR and
+       TARGET_EXPR nodes, but only once, if instructed to do so.  Do not
+       propagate the 'data' argument to copy_tree_r.
+       (copy_if_shared_r): Remove bogus ATTRIBUTE_UNUSED marker.
+       Propagate 'data' argument to walk_tree.
+       (copy_if_shared): New function.
+       (unmark_visited_r): Remove bogus ATTRIBUTE_UNUSED marker.
+       (unmark_visited): New function.
+       (unshare_body): Call copy_if_shared instead of doing it manually.
+       (unvisit_body): Call unmark_visited instead of doing it manually.
+
 2010-05-19  Nathan Froyd  <froydnj@codesourcery.com>
 
        * hooks.h (hook_tree_tree_tree_bool_null): Rename to...
index 822790b..d5aa53a 100644 (file)
@@ -1,3 +1,9 @@
+2010-05-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/misc.c (LANG_HOOKS_DEEP_UNSHARING): Redefine.
+       * gcc-interface/trans.c (unshare_save_expr): Delete.
+       (gigi): Do not unshare trees under SAVE_EXPRs here.
+
 2010-05-18  Nathan Froyd  <froydnj@codesourcery.com>
 
        * gcc-interface/trans.c (call_to_gnu): Use build_call_vec instead of
index 0f85393..dba6dca 100644 (file)
@@ -132,6 +132,8 @@ static tree gnat_eh_personality             (void);
 #define LANG_HOOKS_BUILTIN_FUNCTION    gnat_builtin_function
 #undef  LANG_HOOKS_EH_PERSONALITY
 #define LANG_HOOKS_EH_PERSONALITY      gnat_eh_personality
+#undef  LANG_HOOKS_DEEP_UNSHARING
+#define LANG_HOOKS_DEEP_UNSHARING      true
 
 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
index 13e9d1a..b025020 100644 (file)
@@ -191,7 +191,6 @@ static void Compilation_Unit_to_gnu (Node_Id);
 static void record_code_position (Node_Id);
 static void insert_code_for (Node_Id);
 static void add_cleanup (tree, Node_Id);
-static tree unshare_save_expr (tree *, int *, void *);
 static void add_stmt_list (List_Id);
 static void push_exception_label_stack (tree *, Entity_Id);
 static tree build_stmt_group (List_Id, bool);
@@ -636,16 +635,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
     {
       tree gnu_body = DECL_SAVED_TREE (info->elab_proc), 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);
-
       /* We should have a BIND_EXPR but it may not have any statements in it.
         If it doesn't have any, we have nothing to do except for setting the
         flag on the GNAT node.  Otherwise, process the function as others.  */
@@ -5865,20 +5854,6 @@ mark_visited (tree t)
   walk_tree (&t, mark_visited_r, NULL, NULL);
 }
 
-/* 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 and
    set its location to that of GNAT_NODE if present.  */
 
index 2b40272..8f19ced 100644 (file)
@@ -820,9 +820,44 @@ annotate_all_with_location (gimple_seq stmt_p, location_t location)
       annotate_one_with_location (gs, location);
     }
 }
-
-
-/* Similar to copy_tree_r() but do not copy SAVE_EXPR or TARGET_EXPR nodes.
+\f
+/* This page contains routines to unshare tree nodes, i.e. to duplicate tree
+   nodes that are referenced more than once in GENERIC functions.  This is
+   necessary because gimplification (translation into GIMPLE) is performed
+   by modifying tree nodes in-place, so gimplication of a shared node in a
+   first context could generate an invalid GIMPLE form in a second context.
+
+   This is achieved with a simple mark/copy/unmark algorithm that walks the
+   GENERIC representation top-down, marks nodes with TREE_VISITED the first
+   time it encounters them, duplicates them if they already have TREE_VISITED
+   set, and finally removes the TREE_VISITED marks it has set.
+
+   The algorithm works only at the function level, i.e. it generates a GENERIC
+   representation of a function with no nodes shared within the function when
+   passed a GENERIC function (except for nodes that are allowed to be shared).
+
+   At the global level, it is also necessary to unshare tree nodes that are
+   referenced in more than one function, for the same aforementioned reason.
+   This requires some cooperation from the front-end.  There are 2 strategies:
+
+     1. Manual unsharing.  The front-end needs to call unshare_expr on every
+        expression that might end up being shared across functions.
+
+     2. Deep unsharing.  This is an extension of regular unsharing.  Instead
+        of calling unshare_expr on expressions that might be shared across
+        functions, the front-end pre-marks them with TREE_VISITED.  This will
+        ensure that they are unshared on the first reference within functions
+        when the regular unsharing algorithm runs.  The counterpart is that
+        this algorithm must look deeper than for manual unsharing, which is
+        specified by LANG_HOOKS_DEEP_UNSHARING.
+
+  If there are only few specific cases of node sharing across functions, it is
+  probably easier for a front-end to unshare the expressions manually.  On the
+  contrary, if the expressions generated at the global level are as widespread
+  as expressions generated within functions, deep unsharing is very likely the
+  way to go.  */
+
+/* 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.  */
@@ -830,21 +865,39 @@ annotate_all_with_location (gimple_seq stmt_p, location_t location)
 static tree
 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)
+  tree t = *tp;
+  enum tree_code code = TREE_CODE (t);
+
+  /* Do not copy SAVE_EXPR or TARGET_EXPR nodes themselves, but copy
+     their subtrees if we can make sure to do it only once.  */
+  if (code == SAVE_EXPR || code == TARGET_EXPR)
+    {
+      if (data && !pointer_set_insert ((struct pointer_set_t *)data, t))
+       ;
+      else
+       *walk_subtrees = 0;
+    }
+
+  /* Stop at types, decls, constants like copy_tree_r.  */
+  else if (TREE_CODE_CLASS (code) == tcc_type
+          || TREE_CODE_CLASS (code) == tcc_declaration
+          || TREE_CODE_CLASS (code) == tcc_constant
+          /* 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 we avert our eyes
+             and cross our fingers.  Silly Java.  */
+          || code == BLOCK)
     *walk_subtrees = 0;
+
+  /* Cope with the statement expression extension.  */
+  else if (code == STATEMENT_LIST)
+    ;
+
+  /* Leave the bulk of the work to copy_tree_r itself.  */
   else
     {
       gcc_assert (code != BIND_EXPR);
-      copy_tree_r (tp, walk_subtrees, data);
+      copy_tree_r (tp, walk_subtrees, NULL);
     }
 
   return NULL_TREE;
@@ -852,16 +905,10 @@ mostly_copy_tree_r (tree *tp, int *walk_subtrees, void *data)
 
 /* 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.  */
+   then *TP is deep copied by calling mostly_copy_tree_r.  */
 
 static tree
-copy_if_shared_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
-                 void *data ATTRIBUTE_UNUSED)
+copy_if_shared_r (tree *tp, int *walk_subtrees, void *data)
 {
   tree t = *tp;
   enum tree_code code = TREE_CODE (t);
@@ -884,27 +931,29 @@ copy_if_shared_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
      any deeper.  */
   else if (TREE_VISITED (t))
     {
-      walk_tree (tp, mostly_copy_tree_r, NULL, NULL);
+      walk_tree (tp, mostly_copy_tree_r, data, NULL);
       *walk_subtrees = 0;
     }
 
-  /* Otherwise, mark the tree as visited and keep looking.  */
+  /* Otherwise, mark the node 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;
+/* Unshare most of the shared trees rooted at *TP. */
 
-  return NULL_TREE;
+static inline void
+copy_if_shared (tree *tp)
+{
+  /* If the language requires deep unsharing, we need a pointer set to make
+     sure we don't repeatedly unshare subtrees of unshareable nodes.  */
+  struct pointer_set_t *visited
+    = lang_hooks.deep_unsharing ? pointer_set_create () : NULL;
+  walk_tree (tp, copy_if_shared_r, visited, NULL);
+  if (visited)
+    pointer_set_destroy (visited);
 }
 
 /* Unshare all the trees in BODY_P, a pointer into the body of FNDECL, and the
@@ -916,12 +965,40 @@ unshare_body (tree *body_p, tree fndecl)
 {
   struct cgraph_node *cgn = cgraph_node (fndecl);
 
-  walk_tree (body_p, copy_if_shared_r, NULL, NULL);
+  copy_if_shared (body_p);
+
   if (body_p == &DECL_SAVED_TREE (fndecl))
     for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
       unshare_body (&DECL_SAVED_TREE (cgn->decl), cgn->decl);
 }
 
+/* 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)
+{
+  tree t = *tp;
+
+  /* If this node has been visited, unmark it and keep looking.  */
+  if (TREE_VISITED (t))
+    TREE_VISITED (t) = 0;
+
+  /* Otherwise, don't look any deeper.  */
+  else
+    *walk_subtrees = 0;
+
+  return NULL_TREE;
+}
+
+/* Unmark the visited trees rooted at *TP.  */
+
+static inline void
+unmark_visited (tree *tp)
+{
+  walk_tree (tp, unmark_visited_r, NULL, NULL);
+}
+
 /* Likewise, but mark all trees as not visited.  */
 
 static void
@@ -929,7 +1006,8 @@ unvisit_body (tree *body_p, tree fndecl)
 {
   struct cgraph_node *cgn = cgraph_node (fndecl);
 
-  walk_tree (body_p, unmark_visited_r, NULL, NULL);
+  unmark_visited (body_p);
+
   if (body_p == &DECL_SAVED_TREE (fndecl))
     for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
       unvisit_body (&DECL_SAVED_TREE (cgn->decl), cgn->decl);
index 673ac03..68b5b72 100644 (file)
@@ -111,6 +111,7 @@ extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *,
 #define LANG_HOOKS_EH_PERSONALITY      lhd_gcc_personality
 #define LANG_HOOKS_EH_RUNTIME_TYPE     lhd_pass_through_t
 #define LANG_HOOKS_EH_USE_CXA_END_CLEANUP      false
+#define LANG_HOOKS_DEEP_UNSHARING      false
 
 /* Attribute hooks.  */
 #define LANG_HOOKS_ATTRIBUTE_TABLE             NULL
@@ -297,6 +298,7 @@ extern void lhd_end_section (void);
   LANG_HOOKS_EH_PERSONALITY, \
   LANG_HOOKS_EH_RUNTIME_TYPE, \
   LANG_HOOKS_EH_USE_CXA_END_CLEANUP, \
+  LANG_HOOKS_DEEP_UNSHARING \
 }
 
 #endif /* GCC_LANG_HOOKS_DEF_H */
index 5ae2e46..c0744e8 100644 (file)
@@ -446,6 +446,10 @@ struct lang_hooks
      is enabled.  */
   bool eh_use_cxa_end_cleanup;
 
+  /* True if this language requires deep unsharing of tree nodes prior to
+     gimplification.  */
+  bool deep_unsharing;
+
   /* Whenever you add entries here, make sure you adjust langhooks-def.h
      and langhooks.c accordingly.  */
 };
index 84c0dd7..dc5afe3 100644 (file)
@@ -1,3 +1,11 @@
+2010-05-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/discr23.ad[sb]: New test.
+       * gnat.dg/discr23_pkg.ads: New helper.
+
+       * gnat.dg/specs/controlled1.ads: New test.
+       * gnat.dg/specs/controlled1_pkg.ads: New helper.
+
 2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/44055
diff --git a/gcc/testsuite/gnat.dg/discr23.adb b/gcc/testsuite/gnat.dg/discr23.adb
new file mode 100644 (file)
index 0000000..1d1e695
--- /dev/null
@@ -0,0 +1,18 @@
+--  { dg-do compile }
+
+with Discr23_Pkg; use Discr23_Pkg;
+
+package body Discr23 is
+
+  N : constant Text := Get;
+
+  function Try (A : in Text) return Text is
+  begin
+    return A;
+  exception
+    when others => return N;
+  end;
+
+  procedure Dummy is begin null; end;
+
+end Discr23;
diff --git a/gcc/testsuite/gnat.dg/discr23.ads b/gcc/testsuite/gnat.dg/discr23.ads
new file mode 100644 (file)
index 0000000..8e673b3
--- /dev/null
@@ -0,0 +1,7 @@
+-- { dg-do compile }
+
+package Discr23 is
+
+  procedure Dummy;
+
+end Discr23;
diff --git a/gcc/testsuite/gnat.dg/discr23_pkg.ads b/gcc/testsuite/gnat.dg/discr23_pkg.ads
new file mode 100644 (file)
index 0000000..339734b
--- /dev/null
@@ -0,0 +1,12 @@
+package Discr23_Pkg is
+
+  subtype Size_Range is Positive range 1 .. 256;
+
+  type Text (Size : Size_Range) is
+    record
+      Characters : String( 1.. Size);
+    end record;
+
+  function Get return Text;
+
+end Discr23_Pkg;
diff --git a/gcc/testsuite/gnat.dg/specs/controlled1.ads b/gcc/testsuite/gnat.dg/specs/controlled1.ads
new file mode 100644 (file)
index 0000000..1ceedaf
--- /dev/null
@@ -0,0 +1,35 @@
+--  { dg-do compile }
+
+with Ada.Finalization;
+with Controlled1_Pkg; use Controlled1_Pkg;
+
+package Controlled1 is
+
+   type Collection is new Ada.Finalization.Controlled with null record;
+
+   type Object_Kind_Type is (One, Two);
+
+   type Byte_Array is array (Natural range <>) of Integer;
+
+   type Bounded_Byte_Array_Type is record
+     A : Byte_Array (1 .. Value);
+   end record;
+
+   type Object_Type is tagged record
+     A : Bounded_Byte_Array_Type;
+   end record;
+
+   type R_Object_Type is new Object_Type with record
+      L : Collection;
+   end record;
+
+   type Obj_Type (Kind : Object_Kind_Type := One) is record
+      case Kind is
+         when One => R : R_Object_Type;
+         when others => null;
+      end case;
+   end record;
+
+   type Obj_Array_Type is array (Positive range <>) of Obj_Type;
+
+end Controlled1;
diff --git a/gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads b/gcc/testsuite/gnat.dg/specs/controlled1_pkg.ads
new file mode 100644 (file)
index 0000000..3d08c1e
--- /dev/null
@@ -0,0 +1,7 @@
+-- { dg-excess-errors "no code generated" }
+
+package Controlled1_Pkg is
+
+  function Value return Natural;
+
+end Controlled1_Pkg;