cgraphunit.c (cgraph_finalize_compilation_unit): Call finalize_size_functions before further processing.

	* cgraphunit.c (cgraph_finalize_compilation_unit): Call
	finalize_size_functions before further processing.
	* stor-layout.c: Include cgraph.h, tree-inline.h and tree-dump.h.
	(variable_size): Call self_referential_size on size expressions
	that contain a PLACEHOLDER_EXPR.
	(size_functions): New static variable.
	(copy_self_referential_tree_r): New static function.
	(self_referential_size): Likewise.
	(finalize_size_functions): New global function.
	* tree.c: Include tree-inline.h.
	(push_without_duplicates): New static function.
	(find_placeholder_in_expr): New global function.
	(substitute_in_expr) <tcc_declaration>: Return the replacement object
	on equality.
	<tcc_expression>: Likewise.
	<tcc_vl_exp>: If the replacement object is a constant, try to inline
	the call in the expression.
	* tree.h (finalize_size_functions): Declare.
	(find_placeholder_in_expr): Likewise.
	(FIND_PLACEHOLDER_IN_EXPR): New macro.
	(substitute_placeholder_in_expr): Update comment.
	* tree-inline.c (remap_decl): Do not unshare trees if do_not_unshare
	is true.
	(copy_tree_body_r): Likewise.
	(copy_tree_body): New static function.
	(maybe_inline_call_in_expr): New global function.
	* tree-inline.h (struct copy_body_data): Add do_not_unshare field.
	(maybe_inline_call_in_expr): Declare.
	* Makefile.in (tree.o): Depend on TREE_INLINE_H.
	(stor-layout.o): Depend on CGRAPH_H, TREE_INLINE_H, TREE_DUMP_H and
	GIMPLE_H.
ada/
	* gcc-interface/decl.c: Include tree-inline.h.
	(annotate_value) <CALL_EXPR>: Try to inline the call in the expression.
	* gcc-interface/utils.c (max_size) <CALL_EXPR>: Likewise.
	* gcc-interface/utils2.c: Include tree-inline.
	(known_alignment) <CALL_EXPR>: Likewise.

From-SVN: r149112

28 files changed, 856 insertions, 20 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 4cb0958..d55f4b8 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,37 @@
+2009-06-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* cgraphunit.c (cgraph_finalize_compilation_unit): Call
+	finalize_size_functions before further processing.
+	* stor-layout.c: Include cgraph.h, tree-inline.h and tree-dump.h.
+	(variable_size): Call self_referential_size on size expressions
+	that contain a PLACEHOLDER_EXPR.
+	(size_functions): New static variable.
+	(copy_self_referential_tree_r): New static function.
+	(self_referential_size): Likewise.
+	(finalize_size_functions): New global function.
+	* tree.c: Include tree-inline.h.
+	(push_without_duplicates): New static function.
+	(find_placeholder_in_expr): New global function.
+	(substitute_in_expr) <tcc_declaration>: Return the replacement object
+	on equality.
+	<tcc_expression>: Likewise.
+	<tcc_vl_exp>: If the replacement object is a constant, try to inline
+	the call in the expression.
+	* tree.h (finalize_size_functions): Declare.
+	(find_placeholder_in_expr): Likewise.
+	(FIND_PLACEHOLDER_IN_EXPR): New macro.
+	(substitute_placeholder_in_expr): Update comment.
+	* tree-inline.c (remap_decl): Do not unshare trees if do_not_unshare
+	is true.
+	(copy_tree_body_r): Likewise.
+	(copy_tree_body): New static function.
+	(maybe_inline_call_in_expr): New global function.
+	* tree-inline.h (struct copy_body_data): Add do_not_unshare field.
+	(maybe_inline_call_in_expr): Declare.
+	* Makefile.in (tree.o): Depend on TREE_INLINE_H.
+	(stor-layout.o): Depend on CGRAPH_H, TREE_INLINE_H, TREE_DUMP_H and
+	GIMPLE_H.
+
 2009-06-30  Richard Guenther  <rguenther@suse.de>
 
 	* tree-ssa-dce.c (mark_all_reaching_defs_necessary_1): Always
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 18089fb..c196aca 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -2127,8 +2127,8 @@ langhooks.o : langhooks.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
 tree.o : tree.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
    all-tree.def $(FLAGS_H) $(FUNCTION_H) $(PARAMS_H) \
    $(TOPLEV_H) $(GGC_H) $(HASHTAB_H) $(TARGET_H) output.h $(TM_P_H) langhooks.h \
-   $(REAL_H) gt-tree.h tree-iterator.h $(BASIC_BLOCK_H) $(TREE_FLOW_H) \
-   $(OBSTACK_H) pointer-set.h fixed-value.h
+   $(REAL_H) gt-tree.h $(TREE_INLINE_H) tree-iterator.h $(BASIC_BLOCK_H) \
+   $(TREE_FLOW_H) $(OBSTACK_H) pointer-set.h fixed-value.h
 tree-dump.o: tree-dump.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
    $(TREE_H) langhooks.h $(TOPLEV_H) $(SPLAY_TREE_H) $(TREE_DUMP_H) \
    tree-iterator.h $(TREE_PASS_H) $(DIAGNOSTIC_H) $(REAL_H) fixed-value.h
@@ -2144,7 +2144,7 @@ print-tree.o : print-tree.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H
 stor-layout.o : stor-layout.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
    $(TREE_H) $(PARAMS_H) $(FLAGS_H) $(FUNCTION_H) $(EXPR_H) output.h $(RTL_H) \
    $(GGC_H) $(TM_P_H) $(TARGET_H) langhooks.h $(REGS_H) gt-stor-layout.h \
-   $(TOPLEV_H)
+   $(TOPLEV_H) $(CGRAPH_H) $(TREE_INLINE_H) $(TREE_DUMP_H) $(GIMPLE_H)
 tree-ssa-structalias.o: tree-ssa-structalias.c \
    $(SYSTEM_H) $(CONFIG_H) coretypes.h $(TM_H) $(GGC_H) $(OBSTACK_H) $(BITMAP_H) \
    $(FLAGS_H) $(RTL_H) $(TM_P_H) hard-reg-set.h $(BASIC_BLOCK_H) output.h \
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 94ff870..65d3720 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,13 @@
 2009-06-30  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/decl.c: Include tree-inline.h.
+	(annotate_value) <CALL_EXPR>: Try to inline the call in the expression.
+	* gcc-interface/utils.c (max_size) <CALL_EXPR>: Likewise.
+	* gcc-interface/utils2.c: Include tree-inline.
+	(known_alignment) <CALL_EXPR>: Likewise.
+
+2009-06-30  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* raise-gcc.c: Include dwarf2.h conditionally.
 	
 2009-06-29  Tom Tromey  <tromey@redhat.com>
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 48acbfb..f380213 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -33,6 +33,7 @@
 #include "ggc.h"
 #include "target.h"
 #include "expr.h"
+#include "tree-inline.h"
 
 #include "ada.h"
 #include "types.h"
@@ -7190,6 +7191,15 @@ annotate_value (tree gnu_size)
     case EQ_EXPR:		tcode = Eq_Expr; break;
     case NE_EXPR:		tcode = Ne_Expr; break;
 
+    case CALL_EXPR:
+      {
+	tree t = maybe_inline_call_in_expr (gnu_size);
+	if (t)
+	  return annotate_value (t);
+      }
+
+      /* Fall through... */
+
     default:
       return No_Uint;
     }
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index a4d77a3..aa12eb7 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -2333,10 +2333,15 @@ max_size (tree exp, bool max_p)
     case tcc_vl_exp:
       if (code == CALL_EXPR)
 	{
-	  tree *argarray;
-	  int i, n = call_expr_nargs (exp);
-	  gcc_assert (n > 0);
+	  tree t, *argarray;
+	  int n, i;
+
+	  t = maybe_inline_call_in_expr (exp);
+	  if (t)
+	    return max_size (t, max_p);
 
+	  n = call_expr_nargs (exp);
+	  gcc_assert (n > 0);
 	  argarray = (tree *) alloca (n * sizeof (tree));
 	  for (i = 0; i < n; i++)
 	    argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index aab01f9b..8ee9d4d 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -31,6 +31,7 @@
 #include "ggc.h"
 #include "flags.h"
 #include "output.h"
+#include "tree-inline.h"
 
 #include "ada.h"
 #include "types.h"
@@ -215,6 +216,15 @@ known_alignment (tree exp)
       this_alignment = expr_align (TREE_OPERAND (exp, 0));
       break;
 
+    case CALL_EXPR:
+      {
+	tree t = maybe_inline_call_in_expr (exp);
+	if (t)
+	  return known_alignment (t);
+      }
+
+      /* Fall through... */
+
     default:
       /* For other pointer expressions, we assume that the pointed-to object
 	 is at least as aligned as the pointed-to type.  Beware that we can
diff --git a/gcc/cgraphunit.c b/gcc/cgraphunit.c
index 53d99bf..97c28f4 100644
--- a/gcc/cgraphunit.c
+++ b/gcc/cgraphunit.c
@@ -1012,6 +1012,7 @@ cgraph_finalize_compilation_unit (void)
   if (errorcount || sorrycount)
     return;
 
+  finalize_size_functions ();
   finish_aliases_1 ();
 
   if (!quiet_flag)
diff --git a/gcc/stor-layout.c b/gcc/stor-layout.c
index d65452b..84f65e1 100644
--- a/gcc/stor-layout.c
+++ b/gcc/stor-layout.c
@@ -37,6 +37,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "langhooks.h"
 #include "regs.h"
 #include "params.h"
+#include "cgraph.h"
+#include "tree-inline.h"
+#include "tree-dump.h"
+#include "gimple.h"
 
 /* Data type for the expressions representing sizes of data types.
    It is the first integer type laid out.  */
@@ -53,6 +57,7 @@ unsigned int initial_max_fld_align = TARGET_DEFAULT_PACK_STRUCT;
    called only by a front end.  */
 static int reference_types_internal = 0;
 
+static tree self_referential_size (tree);
 static void finalize_record_size (record_layout_info);
 static void finalize_type_size (tree);
 static void place_union_field (record_layout_info, tree);
@@ -117,13 +122,19 @@ variable_size (tree size)
 {
   tree save;
 
+  /* Obviously.  */
+  if (TREE_CONSTANT (size))
+    return size;
+
+  /* If the size is self-referential, we can't make a SAVE_EXPR (see
+     save_expr for the rationale).  But we can do something else.  */
+  if (CONTAINS_PLACEHOLDER_P (size))
+    return self_referential_size (size);
+
   /* If the language-processor is to take responsibility for variable-sized
      items (e.g., languages which have elaboration procedures like Ada),
-     just return SIZE unchanged.  Likewise for self-referential sizes and
-     constant sizes.  */
-  if (TREE_CONSTANT (size)
-      || lang_hooks.decls.global_bindings_p () < 0
-      || CONTAINS_PLACEHOLDER_P (size))
+     just return SIZE unchanged.  */
+  if (lang_hooks.decls.global_bindings_p () < 0)
     return size;
 
   size = save_expr (size);
@@ -157,6 +168,206 @@ variable_size (tree size)
 
   return size;
 }
+
+/* An array of functions used for self-referential size computation.  */
+static GTY(()) VEC (tree, gc) *size_functions;
+
+/* Similar to copy_tree_r but do not copy component references involving
+   PLACEHOLDER_EXPRs.  These nodes are spotted in find_placeholder_in_expr
+   and substituted in substitute_in_expr.  */
+
+static tree
+copy_self_referential_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)
+    {
+      *walk_subtrees = 0;
+      return NULL_TREE;
+    }
+
+  /* This is the pattern built in ada/make_aligning_type.  */
+  else if (code == ADDR_EXPR
+	   && TREE_CODE (TREE_OPERAND (*tp, 0)) == PLACEHOLDER_EXPR)
+    {
+      *walk_subtrees = 0;
+      return NULL_TREE;
+    }
+
+  /* Default case: the component reference.  */
+  else if (code == COMPONENT_REF)
+    {
+      tree inner;
+      for (inner = TREE_OPERAND (*tp, 0);
+	   REFERENCE_CLASS_P (inner);
+	   inner = TREE_OPERAND (inner, 0))
+	;
+
+      if (TREE_CODE (inner) == PLACEHOLDER_EXPR)
+	{
+	  *walk_subtrees = 0;
+	  return NULL_TREE;
+	}
+    }
+
+  /* We're not supposed to have them in self-referential size trees
+     because we wouldn't properly control when they are evaluated.
+     However, not creating superfluous SAVE_EXPRs requires accurate
+     tracking of readonly-ness all the way down to here, which we
+     cannot always guarantee in practice.  So punt in this case.  */
+  else if (code == SAVE_EXPR)
+    return error_mark_node;
+
+  return copy_tree_r (tp, walk_subtrees, data);
+}
+
+/* Given a SIZE expression that is self-referential, return an equivalent
+   expression to serve as the actual size expression for a type.  */
+
+static tree
+self_referential_size (tree size)
+{
+  static unsigned HOST_WIDE_INT fnno = 0;
+  VEC (tree, heap) *self_refs = NULL;
+  tree param_type_list = NULL, param_decl_list = NULL, arg_list = NULL;
+  tree t, ref, return_type, fntype, fnname, fndecl;
+  unsigned int i;
+  char buf[128];
+
+  /* Do not factor out simple operations.  */
+  t = skip_simple_arithmetic (size);
+  if (TREE_CODE (t) == CALL_EXPR)
+    return size;
+
+  /* Collect the list of self-references in the expression.  */
+  find_placeholder_in_expr (size, &self_refs);
+  gcc_assert (VEC_length (tree, self_refs) > 0);
+
+  /* Obtain a private copy of the expression.  */
+  t = size;
+  if (walk_tree (&t, copy_self_referential_tree_r, NULL, NULL) != NULL_TREE)
+    return size;
+  size = t;
+
+  /* Build the parameter and argument lists in parallel; also
+     substitute the former for the latter in the expression.  */
+  for (i = 0; VEC_iterate (tree, self_refs, i, ref); i++)
+    {
+      tree subst, param_name, param_type, param_decl;
+
+      if (DECL_P (ref))
+	{
+	  /* We shouldn't have true variables here.  */
+	  gcc_assert (TREE_READONLY (ref));
+	  subst = ref;
+	}
+      /* This is the pattern built in ada/make_aligning_type.  */
+      else if (TREE_CODE (ref) == ADDR_EXPR)
+        subst = ref;
+      /* Default case: the component reference.  */
+      else
+	subst = TREE_OPERAND (ref, 1);
+
+      sprintf (buf, "p%d", i);
+      param_name = get_identifier (buf);
+      param_type = TREE_TYPE (ref);
+      param_decl
+	= build_decl (input_location, PARM_DECL, param_name, param_type);
+      if (targetm.calls.promote_prototypes (NULL_TREE)
+	  && INTEGRAL_TYPE_P (param_type)
+	  && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
+	DECL_ARG_TYPE (param_decl) = integer_type_node;
+      else
+	DECL_ARG_TYPE (param_decl) = param_type;
+      DECL_ARTIFICIAL (param_decl) = 1;
+      TREE_READONLY (param_decl) = 1;
+
+      size = substitute_in_expr (size, subst, param_decl);
+
+      param_type_list = tree_cons (NULL_TREE, param_type, param_type_list);
+      param_decl_list = chainon (param_decl, param_decl_list);
+      arg_list = tree_cons (NULL_TREE, ref, arg_list);
+    }
+
+  VEC_free (tree, heap, self_refs);
+
+  /* Append 'void' to indicate that the number of parameters is fixed.  */
+  param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list);
+
+  /* The 3 lists have been created in reverse order.  */
+  param_type_list = nreverse (param_type_list);
+  param_decl_list = nreverse (param_decl_list);
+  arg_list = nreverse (arg_list);
+
+  /* Build the function type.  */
+  return_type = TREE_TYPE (size);
+  fntype = build_function_type (return_type, param_type_list);
+
+  /* Build the function declaration.  */
+  sprintf (buf, "SZ"HOST_WIDE_INT_PRINT_UNSIGNED, fnno++);
+  fnname = get_file_function_name (buf);
+  fndecl = build_decl (input_location, FUNCTION_DECL, fnname, fntype);
+  for (t = param_decl_list; t; t = TREE_CHAIN (t))
+    DECL_CONTEXT (t) = fndecl;
+  DECL_ARGUMENTS (fndecl) = param_decl_list;
+  DECL_RESULT (fndecl)
+    = build_decl (input_location, RESULT_DECL, 0, return_type);
+  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+  /* The function has been created by the compiler and we don't
+     want to emit debug info for it.  */
+  DECL_ARTIFICIAL (fndecl) = 1;
+  DECL_IGNORED_P (fndecl) = 1;
+
+  /* It is supposed to be "const" and never throw.  */
+  TREE_READONLY (fndecl) = 1;
+  TREE_NOTHROW (fndecl) = 1;
+
+  /* We want it to be inlined when this is deemed profitable, as
+     well as discarded if every call has been integrated.  */
+  DECL_DECLARED_INLINE_P (fndecl) = 1;
+
+  /* It is made up of a unique return statement.  */
+  DECL_INITIAL (fndecl) = make_node (BLOCK);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+  t = build2 (MODIFY_EXPR, return_type, DECL_RESULT (fndecl), size);
+  DECL_SAVED_TREE (fndecl) = build1 (RETURN_EXPR, void_type_node, t);
+  TREE_STATIC (fndecl) = 1;
+
+  /* Put it onto the list of size functions.  */
+  VEC_safe_push (tree, gc, size_functions, fndecl);
+
+  /* Replace the original expression with a call to the size function.  */
+  return build_function_call_expr (fndecl, arg_list);
+}
+
+/* Take, queue and compile all the size functions.  It is essential that
+   the size functions be gimplified at the very end of the compilation
+   in order to guarantee transparent handling of self-referential sizes.
+   Otherwise the GENERIC inliner would not be able to inline them back
+   at each of their call sites, thus creating artificial non-constant
+   size expressions which would trigger nasty problems later on.  */
+
+void
+finalize_size_functions (void)
+{
+  unsigned int i;
+  tree fndecl;
+
+  for (i = 0; VEC_iterate(tree, size_functions, i, fndecl); i++)
+    {
+      dump_function (TDI_original, fndecl);
+      gimplify_function_tree (fndecl);
+      dump_function (TDI_generic, fndecl);
+      cgraph_finalize_function (fndecl, false);
+    }
+
+  VEC_free (tree, gc, size_functions);
+}
 
 #ifndef MAX_FIXED_MODE_SIZE
 #define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 12d70b9..578be4d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,20 @@
+2009-06-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/discr12.adb: New test.
+	* gnat.dg/discr12_pkg.ads: New helper.
+	* gnat.dg/discr13.adb: New test.
+	* gnat.dg/discr14.ad[sb]: Likewise.
+	* gnat.dg/discr15.adb: Likewise.
+	* gnat.dg/discr15_pkg.ads: New helper.
+	* gnat.dg/discr16.adb: New test.
+	* gnat.dg/discr16_g.ads: New helper.
+	* gnat.dg/discr16_pkg.ads: Likewise.
+	* gnat.dg/discr16_cont.ads: Likewise.
+	* gnat.dg/discr17.adb: New test.
+	* gnat.dg/discr18.adb: Likewise.
+	* gnat.dg/discr18_pkg.ads: New helper.
+	* gnat.dg/discr19.adb: New test.
+
 2009-06-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/40576
diff --git a/gcc/testsuite/gnat.dg/discr12.adb b/gcc/testsuite/gnat.dg/discr12.adb
new file mode 100644
index 0000000..ae72850
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr12.adb
@@ -0,0 +1,35 @@
+-- { dg-do compile }
+
+with Discr12_Pkg; use Discr12_Pkg;
+
+procedure Discr12 is
+
+  subtype Small_Int is Integer range 1..10;
+
+  package P is
+
+    type PT_W_Disc (D : Small_Int) is private;
+
+    type Rec_W_Private (D1 : Integer) is
+    record
+      C : PT_W_Disc (D1);
+    end record;
+
+    type Rec_01 (D3 : Integer) is
+    record
+      C1 : Rec_W_Private (D3);
+    end record;
+
+    type Arr is array (1 .. 5) of Rec_01(Dummy(0));
+
+  private
+    type PT_W_Disc (D : Small_Int) is 
+    record
+      Str : String (1 .. D);
+    end record;
+
+  end P;
+
+begin
+  Null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr12_pkg.ads b/gcc/testsuite/gnat.dg/discr12_pkg.ads
new file mode 100644
index 0000000..7851463
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr12_pkg.ads
@@ -0,0 +1,5 @@
+package Discr12_Pkg is
+
+  function Dummy (I : Integer) return Integer;
+
+end Discr12_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr13.adb b/gcc/testsuite/gnat.dg/discr13.adb
new file mode 100644
index 0000000..3dcf215
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr13.adb
@@ -0,0 +1,30 @@
+-- { dg-do compile }
+
+with Discr12_Pkg; use Discr12_Pkg;
+
+procedure Discr13 is
+
+  function F1 return Integer is
+  begin
+    return Dummy (1);
+  end F1;
+
+  protected type Poe (D3 : Integer := F1) is
+    entry E (D3 .. F1);    -- F1 evaluated
+    function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean;
+  end Poe;
+
+  protected body Poe is
+    entry E (for I in D3 .. F1) when True is
+    begin
+      null;
+    end E;
+    function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean is
+    begin
+      return False;
+    end Is_Ok;
+  end Poe;
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr14.adb b/gcc/testsuite/gnat.dg/discr14.adb
new file mode 100644
index 0000000..490ec43
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr14.adb
@@ -0,0 +1,11 @@
+-- { dg-do compile }
+
+package body Discr14 is
+
+   procedure ASSIGN( TARGET : in out SW_TYPE_INFO ;
+                     SOURCE : in     SW_TYPE_INFO ) is
+   begin
+      TARGET := new T_SW_TYPE_DESCRIPTOR( SOURCE.SW_TYPE, SOURCE.DIMENSION );
+   end ASSIGN;
+
+end Discr14;
diff --git a/gcc/testsuite/gnat.dg/discr14.ads b/gcc/testsuite/gnat.dg/discr14.ads
new file mode 100644
index 0000000..a6b5a0a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr14.ads
@@ -0,0 +1,42 @@
+package Discr14 is
+
+  type COMPLETION_CODE is (SUCCESS, FAILURE, NONE);
+
+  type T_SW_TYPE is (NONE, COMPLETION_CODE_TYPE);       
+
+  type T_COMPLETION_CODE_RANGE (CONSTRAINED: BOOLEAN := FALSE) is
+  record
+     case CONSTRAINED is
+        when TRUE =>
+           FIRST  : COMPLETION_CODE := SUCCESS;
+           LAST   : COMPLETION_CODE := FAILURE;
+        when FALSE =>
+           null;
+     end case;
+  end record;
+
+  type T_SW_DIMENSIONS is range 0 .. 3;
+
+  type T_SW_INDEX_LIST is array (T_SW_DIMENSIONS range <>) of POSITIVE;
+
+  type T_SW_TYPE_DESCRIPTOR (SW_TYPE   :  T_SW_TYPE       := NONE;
+                             DIMENSION :  T_SW_DIMENSIONS := 0)  is
+  record
+     BOUNDS : T_SW_INDEX_LIST (1 .. DIMENSION);
+
+     case SW_TYPE is
+
+        when COMPLETION_CODE_TYPE  =>
+           COMPLETION_CODE_RANGE   : T_COMPLETION_CODE_RANGE;
+
+        when OTHERS  =>
+           null;
+
+     end case;
+  end record;
+
+  type SW_TYPE_INFO is access T_SW_TYPE_DESCRIPTOR;
+
+  procedure ASSIGN(TARGET : in out SW_TYPE_INFO; SOURCE : in SW_TYPE_INFO) ;
+
+end Discr14;
diff --git a/gcc/testsuite/gnat.dg/discr15.adb b/gcc/testsuite/gnat.dg/discr15.adb
new file mode 100644
index 0000000..0030ac7d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr15.adb
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+with Discr15_Pkg; use Discr15_Pkg;
+
+procedure Discr15 (History : in Rec_Multi_Moment_History) is
+
+  Sub: constant Rec_Multi_Moment_History := Sub_History_Of (History);
+  subtype Vec is String(0..Sub.Last);
+  Mmts : array(1..Sub.Size) of Vec;
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr15_pkg.ads b/gcc/testsuite/gnat.dg/discr15_pkg.ads
new file mode 100644
index 0000000..1f3bf28
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr15_pkg.ads
@@ -0,0 +1,16 @@
+package Discr15_Pkg is
+
+   type Moment is new Positive;
+
+   type Multi_Moment_History is array (Natural range <>, Moment range <>) of Float;
+
+   type Rec_Multi_Moment_History (Len : Natural; Size : Moment) is
+   record
+      Moments : Multi_Moment_History(0..Len, 1..Size);
+      Last    : Natural;
+   end record;
+
+   function Sub_History_Of (History : Rec_Multi_Moment_History)
+      return Rec_Multi_Moment_History;
+
+end Discr15_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr16.adb b/gcc/testsuite/gnat.dg/discr16.adb
new file mode 100644
index 0000000..c4c24fd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16.adb
@@ -0,0 +1,23 @@
+-- { dg-do compile }
+
+with Discr16_G;
+with Discr16_Cont; use Discr16_Cont;
+
+procedure Discr16 is
+
+  generic
+    type T is (<>);
+  function MAX_ADD_G(X : T; I : INTEGER) return T;
+
+  function MAX_ADD_G(X : T; I : INTEGER) return T is
+  begin
+    return T'val(T'pos(X) + LONG_INTEGER(I));
+  end;
+
+  function MAX_ADD is new MAX_ADD_G(ES6A);
+
+  package P is new Discr16_G(ES6A, MAX_ADD);
+
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_cont.ads b/gcc/testsuite/gnat.dg/discr16_cont.ads
new file mode 100644
index 0000000..ea041ca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_cont.ads
@@ -0,0 +1,7 @@
+with Discr16_Pkg; use Discr16_Pkg;
+
+package Discr16_Cont is
+
+  type ES6a is new ET3a range E2..E4;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_g.ads b/gcc/testsuite/gnat.dg/discr16_g.ads
new file mode 100644
index 0000000..f163f75
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_g.ads
@@ -0,0 +1,18 @@
+generic
+
+  type T is (<>);
+  with function MAX_ADD(X : T; I : INTEGER) return T;
+
+package Discr16_G is
+
+  LO : T := T'val(T'pos(T'first));
+  HI : T := T'val(T'pos(MAX_ADD(LO, 15)));
+
+  type A2 is array(T range <>) of T;
+
+  type R2(D : T) is
+  record
+    C : A2(LO..D);
+  end record;
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr16_pkg.ads b/gcc/testsuite/gnat.dg/discr16_pkg.ads
new file mode 100644
index 0000000..985785f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr16_pkg.ads
@@ -0,0 +1,7 @@
+package Discr16_Pkg is
+
+  type ET3a is (E1, E2, E3, E4, E5);
+  for ET3a use (E1=> 32_001, E2=> 32_002, E3=> 32_003,
+                E4=> 32_004, E5=> 32_005);
+
+end;
diff --git a/gcc/testsuite/gnat.dg/discr17.adb b/gcc/testsuite/gnat.dg/discr17.adb
new file mode 100644
index 0000000..d7b480c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr17.adb
@@ -0,0 +1,66 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Discr17 is
+
+  F1_Poe : Integer := 18;
+
+  function F1 return Integer is
+  begin
+    F1_Poe := F1_Poe - 1;
+    return F1_Poe;
+ end F1;
+
+  generic
+    type T is limited private;
+    with function Is_Ok (X : T) return Boolean;
+  procedure Check;
+
+  procedure Check is
+  begin
+
+    declare
+      type Poe is new T;
+      X : Poe;
+      Y : Poe;
+    begin
+      null;
+    end;
+
+    declare
+      type Poe is new T;
+      type Arr is array (1 .. 2) of Poe;
+      X : Arr;
+      B : Boolean := Is_Ok (T (X (1)));
+    begin
+      null;
+    end;
+
+ end;
+
+  protected type Poe (D3 : Integer := F1) is
+    entry E (D3 .. F1);    -- F1 evaluated
+    function Is_Ok return Boolean;
+  end Poe;
+
+  protected body Poe is
+    entry E (for I in D3 .. F1) when True is
+    begin
+      null;
+    end E;
+    function Is_Ok return Boolean is
+    begin
+      return False;
+    end Is_Ok;
+  end Poe;
+
+  function Is_Ok (C : Poe) return Boolean is
+  begin
+    return C.Is_Ok;
+  end Is_Ok;
+
+  procedure Chk is new Check (Poe, Is_Ok);
+
+begin
+   Chk;
+end;
diff --git a/gcc/testsuite/gnat.dg/discr18.adb b/gcc/testsuite/gnat.dg/discr18.adb
new file mode 100644
index 0000000..bd3fd79
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr18.adb
@@ -0,0 +1,19 @@
+-- { dg-do compile }
+
+with Discr18_Pkg; use Discr18_Pkg;
+
+procedure Discr18 is
+
+  String_10 : String (1..10) := "1234567890";
+
+  MD : Multiple_Discriminants (A => 10, B => 10) :=
+         Multiple_Discriminants'(A  => 10,
+                                 B  => 10,
+                                 S1 => String_10,
+                                 S2 => String_10);
+  MDE : Multiple_Discriminant_Extension (C => 10) :=
+          (MD with C  => 10, S3 => String_10);
+
+begin
+  Do_Something(MDE);
+end;
diff --git a/gcc/testsuite/gnat.dg/discr18_pkg.ads b/gcc/testsuite/gnat.dg/discr18_pkg.ads
new file mode 100644
index 0000000..72f7fec
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr18_pkg.ads
@@ -0,0 +1,19 @@
+package Discr18_Pkg is
+
+   subtype Length is Natural range 0..256;
+
+   type Multiple_Discriminants (A, B : Length) is tagged
+      record
+         S1 : String (1..A);
+         S2 : String (1..B);
+      end record;
+
+   procedure Do_Something (Rec : in out Multiple_Discriminants);
+
+   type Multiple_Discriminant_Extension (C : Length) is
+      new Multiple_Discriminants (A => C, B => C)
+      with record
+         S3 : String (1..C);
+      end record;
+
+end Discr18_Pkg;
diff --git a/gcc/testsuite/gnat.dg/discr19.adb b/gcc/testsuite/gnat.dg/discr19.adb
new file mode 100644
index 0000000..8f5c56b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr19.adb
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+
+procedure Discr19 is
+
+   type Arr_Int_T is array (Integer range <>) of Integer;
+
+   type Abs_Tag_Rec_T (N : Integer; M : Integer) is abstract tagged record
+      Arr_Int : Arr_Int_T (1..M);
+   end record;
+
+   type Tag_Rec_T (M : Integer)
+     is new Abs_Tag_Rec_T (N => 1, M => M) with null record;
+
+begin
+   null;
+end;
diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c
index b97b9b2..648e30b 100644
--- a/gcc/tree-inline.c
+++ b/gcc/tree-inline.c
@@ -287,7 +287,10 @@ remap_decl (tree decl, copy_body_data *id)
       return t;
     }
 
-  return unshare_expr (*n);
+  if (id->do_not_unshare)
+    return *n;
+  else
+    return unshare_expr (*n);
 }
 
 static tree
@@ -997,7 +1000,10 @@ copy_tree_body_r (tree *tp, int *walk_subtrees, void *data)
 		 but we absolutely rely on that.  As fold_indirect_ref
 	         does other useful transformations, try that first, though.  */
 	      tree type = TREE_TYPE (TREE_TYPE (*n));
-	      new_tree = unshare_expr (*n);
+	      if (id->do_not_unshare)
+		new_tree = *n;
+	      else
+		new_tree = unshare_expr (*n);
 	      old = *tp;
 	      *tp = gimple_fold_indirect_ref (new_tree);
 	      if (! *tp)
@@ -1993,6 +1999,20 @@ copy_cfg_body (copy_body_data * id, gcov_type count, int frequency,
   return new_fndecl;
 }
 
+/* Make a copy of the body of SRC_FN so that it can be inserted inline in
+   another function.  */
+
+static tree
+copy_tree_body (copy_body_data *id)
+{
+  tree fndecl = id->src_fn;
+  tree body = DECL_SAVED_TREE (fndecl);
+
+  walk_tree (&body, copy_tree_body_r, id, NULL);
+
+  return body;
+}
+
 static tree
 copy_body (copy_body_data *id, gcov_type count, int frequency,
 	   basic_block entry_block_map, basic_block exit_block_map)
@@ -4605,6 +4625,60 @@ tree_function_versioning (tree old_decl, tree new_decl,
   return;
 }
 
+/* EXP is CALL_EXPR present in a GENERIC expression tree.  Try to integrate
+   the callee and return the inlined body on success.  */
+
+tree
+maybe_inline_call_in_expr (tree exp)
+{
+  tree fn = get_callee_fndecl (exp);
+
+  /* We can only try to inline "const" functions.  */
+  if (fn && TREE_READONLY (fn) && DECL_SAVED_TREE (fn))
+    {
+      struct pointer_map_t *decl_map = pointer_map_create ();
+      call_expr_arg_iterator iter;
+      copy_body_data id;
+      tree param, arg, t;
+
+      /* Remap the parameters.  */
+      for (param = DECL_ARGUMENTS (fn), arg = first_call_expr_arg (exp, &iter);
+	   param;
+	   param = TREE_CHAIN (param), arg = next_call_expr_arg (&iter))
+	*pointer_map_insert (decl_map, param) = arg;
+
+      memset (&id, 0, sizeof (id));
+      id.src_fn = fn;
+      id.dst_fn = current_function_decl;
+      id.src_cfun = DECL_STRUCT_FUNCTION (fn);
+      id.decl_map = decl_map;
+
+      id.copy_decl = copy_decl_no_change;
+      id.transform_call_graph_edges = CB_CGE_DUPLICATE;
+      id.transform_new_cfg = false;
+      id.transform_return_to_modify = true;
+      id.transform_lang_insert_block = false;
+
+      /* Make sure not to unshare trees behind the front-end's back
+	 since front-end specific mechanisms may rely on sharing.  */
+      id.regimplify = false;
+      id.do_not_unshare = true;
+
+      /* We're not inside any EH region.  */
+      id.eh_region = -1;
+
+      t = copy_tree_body (&id);
+      pointer_map_destroy (decl_map);
+
+      /* We can only return something suitable for use in a GENERIC
+	 expression tree.  */
+      if (TREE_CODE (t) == MODIFY_EXPR)
+	return TREE_OPERAND (t, 1);
+    }
+
+   return NULL_TREE;
+}
+
 /* Duplicate a type, fields and all.  */
 
 tree
diff --git a/gcc/tree-inline.h b/gcc/tree-inline.h
index 37e60bf..542eb72 100644
--- a/gcc/tree-inline.h
+++ b/gcc/tree-inline.h
@@ -102,6 +102,9 @@ typedef struct copy_body_data
   /* True if this statement will need to be regimplified.  */
   bool regimplify;
 
+  /* True if trees should not be unshared.  */
+  bool do_not_unshare;
+
   /* > 0 if we are remapping a type currently.  */
   int remapping_type_depth;
 
@@ -157,6 +160,7 @@ extern tree copy_tree_body_r (tree *, int *, void *);
 extern void insert_decl_map (copy_body_data *, tree, tree);
 
 unsigned int optimize_inline_calls (tree);
+tree maybe_inline_call_in_expr (tree);
 bool tree_inlinable_function_p (tree);
 tree copy_tree_r (tree *, int *, void *);
 tree copy_decl_no_change (tree decl, copy_body_data *id);
diff --git a/gcc/tree.c b/gcc/tree.c
index c4ed82b..ad81827 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -45,6 +45,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "output.h"
 #include "target.h"
 #include "langhooks.h"
+#include "tree-inline.h"
 #include "tree-iterator.h"
 #include "basic-block.h"
 #include "tree-flow.h"
@@ -2678,11 +2679,102 @@ type_contains_placeholder_p (tree type)
   return result;
 }
 
+/* Push tree EXP onto vector QUEUE if it is not already present.  */
+
+static void
+push_without_duplicates (tree exp, VEC (tree, heap) **queue)
+{
+  unsigned int i;
+  tree iter;
+
+  for (i = 0; VEC_iterate (tree, *queue, i, iter); i++)
+    if (simple_cst_equal (iter, exp) == 1)
+      break;
+
+  if (!iter)
+    VEC_safe_push (tree, heap, *queue, exp);
+}
+
+/* Given a tree EXP, find all occurences of references to fields
+   in a PLACEHOLDER_EXPR and place them in vector REFS without
+   duplicates.  Also record VAR_DECLs and CONST_DECLs.  Note that
+   we assume here that EXP contains only arithmetic expressions
+   or CALL_EXPRs with PLACEHOLDER_EXPRs occurring only in their
+   argument list.  */
+
+void
+find_placeholder_in_expr (tree exp, VEC (tree, heap) **refs)
+{
+  enum tree_code code = TREE_CODE (exp);
+  tree inner;
+  int i;
+
+  /* We handle TREE_LIST and COMPONENT_REF separately.  */
+  if (code == TREE_LIST)
+    {
+      FIND_PLACEHOLDER_IN_EXPR (TREE_CHAIN (exp), refs);
+      FIND_PLACEHOLDER_IN_EXPR (TREE_VALUE (exp), refs);
+    }
+  else if (code == COMPONENT_REF)
+    {
+      for (inner = TREE_OPERAND (exp, 0);
+	   REFERENCE_CLASS_P (inner);
+	   inner = TREE_OPERAND (inner, 0))
+	;
+
+      if (TREE_CODE (inner) == PLACEHOLDER_EXPR)
+	push_without_duplicates (exp, refs);
+      else
+	FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), refs);
+   }
+  else
+    switch (TREE_CODE_CLASS (code))
+      {
+      case tcc_constant:
+	break;
+
+      case tcc_declaration:
+	/* Variables allocated to static storage can stay.  */
+        if (!TREE_STATIC (exp))
+	  push_without_duplicates (exp, refs);
+	break;
+
+      case tcc_expression:
+	/* This is the pattern built in ada/make_aligning_type.  */
+	if (code == ADDR_EXPR
+	    && TREE_CODE (TREE_OPERAND (exp, 0)) == PLACEHOLDER_EXPR)
+	  {
+	    push_without_duplicates (exp, refs);
+	    break;
+	  }
+
+        /* Fall through...  */
+
+      case tcc_exceptional:
+      case tcc_unary:
+      case tcc_binary:
+      case tcc_comparison:
+      case tcc_reference:
+	for (i = 0; i < TREE_CODE_LENGTH (code); i++)
+	  FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, i), refs);
+	break;
+
+      case tcc_vl_exp:
+	for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++)
+	  FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, i), refs);
+	break;
+
+      default:
+	gcc_unreachable ();
+      }
+}
+
 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
    return a tree with all occurrences of references to F in a
-   PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
-   contains only arithmetic expressions or a CALL_EXPR with a
-   PLACEHOLDER_EXPR occurring only in its arglist.  */
+   PLACEHOLDER_EXPR replaced by R.  Also handle VAR_DECLs and
+   CONST_DECLs.  Note that we assume here that EXP contains only
+   arithmetic expressions or CALL_EXPRs with PLACEHOLDER_EXPRs
+   occurring only in their argument list.  */
 
 tree
 substitute_in_expr (tree exp, tree f, tree r)
@@ -2733,14 +2825,24 @@ substitute_in_expr (tree exp, tree f, tree r)
     switch (TREE_CODE_CLASS (code))
       {
       case tcc_constant:
-      case tcc_declaration:
 	return exp;
 
+      case tcc_declaration:
+	if (exp == f)
+	  return r;
+	else
+	  return exp;
+
+      case tcc_expression:
+	if (exp == f)
+	  return r;
+
+        /* Fall through...  */
+
       case tcc_exceptional:
       case tcc_unary:
       case tcc_binary:
       case tcc_comparison:
-      case tcc_expression:
       case tcc_reference:
 	switch (TREE_CODE_LENGTH (code))
 	  {
@@ -2803,6 +2905,17 @@ substitute_in_expr (tree exp, tree f, tree r)
 
 	  new_tree = NULL_TREE;
 
+	  /* If we are trying to replace F with a constant, inline back
+	     functions which do nothing else than computing a value from
+	     the arguments they are passed.  This makes it possible to
+	     fold partially or entirely the replacement expression.  */
+	  if (CONSTANT_CLASS_P (r) && code == CALL_EXPR)
+	    {
+	      tree t = maybe_inline_call_in_expr (exp);
+	      if (t)
+		return SUBSTITUTE_IN_EXPR (t, f, r);
+	    }
+
 	  for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++)
 	    {
 	      tree op = TREE_OPERAND (exp, i);
diff --git a/gcc/tree.h b/gcc/tree.h
index 3a748a7..e2eb76e 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -4216,6 +4216,7 @@ extern tree round_down (tree, int);
 extern tree get_pending_sizes (void);
 extern void put_pending_size (tree);
 extern void put_pending_sizes (tree);
+extern void finalize_size_functions (void);
 
 /* Type for sizes of data-type.  */
 
@@ -4361,10 +4362,30 @@ extern bool contains_placeholder_p (const_tree);
 
 extern bool type_contains_placeholder_p (tree);
 
+/* Given a tree EXP, find all occurences of references to fields
+   in a PLACEHOLDER_EXPR and place them in vector REFS without
+   duplicates.  Also record VAR_DECLs and CONST_DECLs.  Note that
+   we assume here that EXP contains only arithmetic expressions
+   or CALL_EXPRs with PLACEHOLDER_EXPRs occurring only in their
+   argument list.  */
+
+extern void find_placeholder_in_expr (tree, VEC (tree, heap) **);
+
+/* This macro calls the above function but short-circuits the common
+   case of a constant to save time and also checks for NULL.  */
+
+#define FIND_PLACEHOLDER_IN_EXPR(EXP, V) \
+do {					 \
+  if((EXP) && !TREE_CONSTANT (EXP))	 \
+    find_placeholder_in_expr (EXP, V);	 \
+} while (0)
+
 /* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
    return a tree with all occurrences of references to F in a
-   PLACEHOLDER_EXPR replaced by R.   Note that we assume here that EXP
-   contains only arithmetic expressions.  */
+   PLACEHOLDER_EXPR replaced by R.  Also handle VAR_DECLs and
+   CONST_DECLs.  Note that we assume here that EXP contains only
+   arithmetic expressions or CALL_EXPRs with PLACEHOLDER_EXPRs
+   occurring only in their argument list.  */
 
 extern tree substitute_in_expr (tree, tree, tree);