tree.h (TREE_ADDRESSABLE): Document its effect for function types.

	* tree.h (TREE_ADDRESSABLE): Document its effect for function types.
	* calls.c (expand_call): Pass the function type to aggregate_value_p.
	* function.c (aggregate_value_p): Do not honor DECL_BY_REFERENCE on
	the target function of a CALL_EXPR.  Honor TREE_ADDRESSABLE on the
	function type instead.  Reorder and simplify checks.

	* gimplify.c (gimplify_modify_expr_rhs) <WITH_SIZE_EXPR>: New case.
ada/
	* gcc-interface/ada-tree.h (TYPE_RETURNS_UNCONSTRAINED_P): Rename into.
	(TYPE_RETURN_UNCONSTRAINED_P): ...this.
	(TYPE_RETURNS_BY_REF_P): Rename into.
	(TYPE_RETURN_BY_DIRECT_REF_P): ...this.
	(TYPE_RETURNS_BY_TARGET_PTR_P): Delete.
	* gcc-interface/gigi.h (create_subprog_type): Adjust parameter names.
	(build_return_expr): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>:
	Rename local variables.  If the return Mechanism is By_Reference, pass
	return_by_invisible_ref_p to create_subprog_type instead of toggling
	TREE_ADDRESSABLE.  Test return_by_invisible_ref_p in order to annotate
	the mechanism.  Use regular return for contrained types with non-static
	size and return by invisible reference for unconstrained return types
	with default discriminants.  Update comment.
	* gcc-interface/trans.c (Subprogram_Body_to_gnu): If the function
	returns by invisible reference, turn the RESULT_DECL into a pointer.
	Do not handle DECL_BY_REF_P in the CICO case here.
	(call_to_gnu): Remove code handling return by target pointer.  For a
	function call, if the return type has non-constant size, generate the
	assignment with an INIT_EXPR.
	(gnat_to_gnu) <N_Return_Statement>: Remove dead code in the CICO case.
	If the function returns by invisible reference, build the copy return
	operation manually.
	(add_decl_expr): Initialize the variable with an INIT_EXPR.
	* gcc-interface/utils.c (create_subprog_type): Adjust parameter names.
	Adjust for renaming of macros.  Copy the node only when necessary.
	(create_subprog_decl): Do not toggle TREE_ADDRESSABLE on the return
	type, only change DECL_BY_REFERENCE on the RETURN_DECL.
	(convert_from_reference): Delete.
	(is_byref_result): Likewise.
	(gnat_genericize_r): Likewise.
	(gnat_genericize): Likewise.
	(end_subprog_body): Do not call gnat_genericize.
	* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: New case.
	(build_return_expr): Adjust parameter names, logic and comment.

From-SVN: r158139

gcc/ChangeLog

+2010-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* tree.h (TREE_ADDRESSABLE): Document its effect for function types.
+	* calls.c (expand_call): Pass the function type to aggregate_value_p.
+	* function.c (aggregate_value_p): Do not honor DECL_BY_REFERENCE on
+	the target function of a CALL_EXPR.  Honor TREE_ADDRESSABLE on the
+	function type instead.  Reorder and simplify checks.
+
+	* gimplify.c (gimplify_modify_expr_rhs) <WITH_SIZE_EXPR>: New case.
+
 2010-04-08  Jing Yu  <jingyu@google.com>
 	    Zdenek Dvorak  <ook@ucw.cz>
 

gcc/ada/ChangeLog

+2010-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.h (TYPE_RETURNS_UNCONSTRAINED_P): Rename into.
+	(TYPE_RETURN_UNCONSTRAINED_P): ...this.
+	(TYPE_RETURNS_BY_REF_P): Rename into.
+	(TYPE_RETURN_BY_DIRECT_REF_P): ...this.
+	(TYPE_RETURNS_BY_TARGET_PTR_P): Delete.
+	* gcc-interface/gigi.h (create_subprog_type): Adjust parameter names.
+	(build_return_expr): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>:
+	Rename local variables.  If the return Mechanism is By_Reference, pass
+	return_by_invisible_ref_p to create_subprog_type instead of toggling
+	TREE_ADDRESSABLE.  Test return_by_invisible_ref_p in order to annotate
+	the mechanism.  Use regular return for contrained types with non-static
+	size and return by invisible reference for unconstrained return types
+	with default discriminants.  Update comment.
+	* gcc-interface/trans.c (Subprogram_Body_to_gnu): If the function
+	returns by invisible reference, turn the RESULT_DECL into a pointer.
+	Do not handle DECL_BY_REF_P in the CICO case here.
+	(call_to_gnu): Remove code handling return by target pointer.  For a
+	function call, if the return type has non-constant size, generate the
+	assignment with an INIT_EXPR.
+	(gnat_to_gnu) <N_Return_Statement>: Remove dead code in the CICO case.
+	If the function returns by invisible reference, build the copy return
+	operation manually.
+	(add_decl_expr): Initialize the variable with an INIT_EXPR.
+	* gcc-interface/utils.c (create_subprog_type): Adjust parameter names.
+	Adjust for renaming of macros.  Copy the node only when necessary.
+	(create_subprog_decl): Do not toggle TREE_ADDRESSABLE on the return
+	type, only change DECL_BY_REFERENCE on the RETURN_DECL.
+	(convert_from_reference): Delete.
+	(is_byref_result): Likewise.
+	(gnat_genericize_r): Likewise.
+	(gnat_genericize): Likewise.
+	(end_subprog_body): Do not call gnat_genericize.
+	* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: New case.
+	(build_return_expr): Adjust parameter names, logic and comment.
+
 2010-04-07  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* exp_pakd.adb (Create_Packed_Array_Type): Always use a modular type

gcc/ada/gcc-interface/ada-tree.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -90,7 +90,7 @@ do {							    \
 
 /* For FUNCTION_TYPE, nonzero if this denotes a function returning an
    unconstrained array or record.  */
-#define TYPE_RETURNS_UNCONSTRAINED_P(NODE) \
+#define TYPE_RETURN_UNCONSTRAINED_P(NODE) \
   TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE))
 
 /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes
@@ -135,8 +135,10 @@ do {							    \
 #define TYPE_CONVENTION_FORTRAN_P(NODE) \
   TYPE_LANG_FLAG_4 (ARRAY_TYPE_CHECK (NODE))
 
-/* For FUNCTION_TYPEs, nonzero if the function returns by reference.  */
-#define TYPE_RETURNS_BY_REF_P(NODE) \
+/* For FUNCTION_TYPEs, nonzero if the function returns by direct reference,
+   i.e. the callee returns a pointer to a memory location it has allocated
+   and the caller only needs to dereference the pointer.  */
+#define TYPE_RETURN_BY_DIRECT_REF_P(NODE) \
   TYPE_LANG_FLAG_4 (FUNCTION_TYPE_CHECK (NODE))
 
 /* For VOID_TYPE, ENUMERAL_TYPE, UNION_TYPE, and RECORD_TYPE, nonzero if this
@@ -148,11 +150,6 @@ do {							    \
     || TREE_CODE (NODE) == UNION_TYPE || TREE_CODE (NODE) == ENUMERAL_TYPE) \
    && TYPE_DUMMY_P (NODE))
 
-/* For FUNCTION_TYPEs, nonzero if function returns by being passed a pointer
-   to a place to store its result.  */
-#define TYPE_RETURNS_BY_TARGET_PTR_P(NODE) \
-  TYPE_LANG_FLAG_5 (FUNCTION_TYPE_CHECK (NODE))
-
 /* For an INTEGER_TYPE, nonzero if TYPE_ACTUAL_BOUNDS is present.  */
 #define TYPE_HAS_ACTUAL_BOUNDS_P(NODE) \
   TYPE_LANG_FLAG_5 (INTEGER_TYPE_CHECK (NODE))

gcc/ada/gcc-interface/decl.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -3799,13 +3799,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	tree gnu_field_list = NULL_TREE;
 	/* Non-null for subprograms containing parameters passed by copy-in
 	   copy-out (Ada In Out or Out parameters not passed by reference),
-	   in which case it is the list of nodes used to specify the values of
-	   the in out/out parameters that are returned as a record upon
+	   in which case it is the list of nodes used to specify the values
+	   of the In Out/Out parameters that are returned as a record upon
 	   procedure return.  The TREE_PURPOSE of an element of this list is
 	   a field of the record and the TREE_VALUE is the PARM_DECL
 	   corresponding to that field.  This list will be saved in the
 	   TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create.  */
-	tree gnu_return_list = NULL_TREE;
+	tree gnu_cico_list = NULL_TREE;
 	/* If an import pragma asks to map this subprogram to a GCC builtin,
 	   this is the builtin DECL node.  */
 	tree gnu_builtin_decl = NULL_TREE;
@@ -3831,9 +3831,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	     && Is_Pure (gnat_entity));
 
 	bool volatile_flag = No_Return (gnat_entity);
-	bool returns_by_ref = false;
-	bool returns_unconstrained = false;
-	bool returns_by_target_ptr = false;
+	bool return_by_direct_ref_p = false;
+	bool return_by_invisi_ref_p = false;
+	bool return_unconstrained_p = false;
 	bool has_copy_in_out = false;
 	bool has_stub = false;
 	int parmnum;
@@ -3885,37 +3885,39 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (kind == E_Function || kind == E_Subprogram_Type)
 	  gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
 
-	/* If this function returns by reference, make the actual
-	   return type of this function the pointer and mark the decl.  */
+	/* If this function returns by reference, make the actual return
+	   type of this function the pointer and mark the decl.  */
 	if (Returns_By_Ref (gnat_entity))
 	  {
-	    returns_by_ref = true;
 	    gnu_return_type = build_pointer_type (gnu_return_type);
+	    return_by_direct_ref_p = true;
 	  }
 
-	/* If the Mechanism is By_Reference, ensure the return type uses
-	   the machine's by-reference mechanism, which may not the same
-	   as above (e.g., it might be by passing a fake parameter).  */
-	else if (kind == E_Function
-		 && Mechanism (gnat_entity) == By_Reference)
-	  {
-	    TREE_ADDRESSABLE (gnu_return_type) = 1;
-
-	    /* We expect this bit to be reset by gigi shortly, so can avoid a
-	       type node copy here.  This actually also prevents troubles with
-	       the generation of debug information for the function, because
-	       we might have issued such info for this type already, and would
-	       be attaching a distinct type node to the function if we made a
-	       copy here.  */
-	  }
-
-	/* If we are supposed to return an unconstrained array,
-	   actually return a fat pointer and make a note of that.  Return
-	   a pointer to an unconstrained record of variable size.  */
+	/* If the Mechanism is By_Reference, ensure this function uses the
+	   target's by-invisible-reference mechanism, which may not be the
+	   same as above (e.g. it might be passing an extra parameter).
+
+	   Prior to GCC 4, this was handled by just setting TREE_ADDRESSABLE
+	   on the result type.  Everything required to pass by invisible
+	   reference using the target's mechanism (e.g. an extra parameter)
+	   was handled at RTL expansion time.
+
+	   This doesn't work with GCC 4 any more for several reasons.  First,
+	   the gimplification process might need to create temporaries of this
+	   type and the gimplifier ICEs on such attempts; that's why the flag
+	   is now set on the function type instead.  Second, the middle-end
+	   now also relies on a different attribute, DECL_BY_REFERENCE on the
+	   RESULT_DECL, and expects the by-invisible-reference-ness to be made
+	   explicit in the function body.  */
+	else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference)
+	  return_by_invisi_ref_p = true;
+
+	/* If we are supposed to return an unconstrained array, actually return
+	   a fat pointer and make a note of that.  */
 	else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
 	  {
 	    gnu_return_type = TREE_TYPE (gnu_return_type);
-	    returns_unconstrained = true;
+	    return_unconstrained_p = true;
 	  }
 
 	/* If the type requires a transient scope, the result is allocated
@@ -3924,7 +3926,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	else if (Requires_Transient_Scope (Etype (gnat_entity)))
 	  {
 	    gnu_return_type = build_pointer_type (gnu_return_type);
-	    returns_unconstrained = true;
+	    return_unconstrained_p = true;
 	  }
 
 	/* If the type is a padded type and the underlying type would not
@@ -3936,20 +3938,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		     || Has_Foreign_Convention (gnat_entity)))
 	  gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
 
-	/* If the return type has a non-constant size, we convert the function
-	   into a procedure and its caller will pass a pointer to an object as
-	   the first parameter when we call the function.  This can happen for
-	   an unconstrained type with a maximum size or a constrained type with
-	   a size not known at compile time.  */
-	if (TYPE_SIZE_UNIT (gnu_return_type)
-	    && !TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type)))
+	/* If the return type is unconstrained, that means it must have a
+	   maximum size.  Use the padded type as the effective return type.
+	   And ensure the function uses the target's by-invisible-reference
+	   mechanism to avoid copying too much data when it returns.  */
+	if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
 	  {
-	    returns_by_target_ptr = true;
-	    gnu_param_list
-	      = create_param_decl (get_identifier ("TARGET"),
-				   build_reference_type (gnu_return_type),
-				   true);
-	    gnu_return_type = void_type_node;
+	    gnu_return_type
+	      = maybe_pad_type (gnu_return_type,
+				max_size (TYPE_SIZE (gnu_return_type), true),
+				0, gnat_entity, false, false, false, true);
+	    return_by_invisi_ref_p = true;
 	  }
 
 	/* If the return type has a size that overflows, we cannot have
@@ -4091,8 +4090,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			       &DECL_SOURCE_LOCATION (gnu_field));
 		TREE_CHAIN (gnu_field) = gnu_field_list;
 		gnu_field_list = gnu_field;
-		gnu_return_list = tree_cons (gnu_field, gnu_param,
-					     gnu_return_list);
+		gnu_cico_list
+		  = tree_cons (gnu_field, gnu_param, gnu_cico_list);
 	      }
 	  }
 
@@ -4105,8 +4104,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	/* If we have a CICO list but it has only one entry, we convert
 	   this function into a function that simply returns that one
 	   object.  */
-	if (list_length (gnu_return_list) == 1)
-	  gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
+	if (list_length (gnu_cico_list) == 1)
+	  gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list));
 
 	if (Has_Stdcall_Convention (gnat_entity))
 	  prepend_one_attribute_to
@@ -4131,22 +4130,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	gnu_param_list = nreverse (gnu_param_list);
 	if (has_stub)
 	  gnu_stub_param_list = nreverse (gnu_stub_param_list);
-	gnu_return_list = nreverse (gnu_return_list);
+	gnu_cico_list = nreverse (gnu_cico_list);
 
 	if (Ekind (gnat_entity) == E_Function)
-	  Set_Mechanism (gnat_entity,
-			 (returns_by_ref || returns_unconstrained
-			  ? By_Reference : By_Copy));
+	  Set_Mechanism (gnat_entity, return_unconstrained_p
+				      || return_by_direct_ref_p
+				      || return_by_invisi_ref_p
+				      ? By_Reference : By_Copy);
 	gnu_type
 	  = create_subprog_type (gnu_return_type, gnu_param_list,
-				 gnu_return_list, returns_unconstrained,
-				 returns_by_ref, returns_by_target_ptr);
+				 gnu_cico_list, return_unconstrained_p,
+				 return_by_direct_ref_p,
+				 return_by_invisi_ref_p);
 
 	if (has_stub)
 	  gnu_stub_type
 	    = create_subprog_type (gnu_return_type, gnu_stub_param_list,
-				   gnu_return_list, returns_unconstrained,
-				   returns_by_ref, returns_by_target_ptr);
+				   gnu_cico_list, return_unconstrained_p,
+				   return_by_direct_ref_p,
+				   return_by_invisi_ref_p);
 
 	/* A subprogram (something that doesn't return anything) shouldn't
 	   be considered const since there would be no reason for such a

gcc/ada/gcc-interface/gigi.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -545,19 +545,19 @@ extern void add_parallel_type (tree decl, tree parallel_type);
 /* Return the parallel type associated to a type, if any.  */
 extern tree get_parallel_type (tree type);
 
-/* Returns a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
-   subprogram. If it is void_type_node, then we are dealing with a procedure,
-   otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
-   PARM_DECL nodes that are the subprogram arguments.  CICO_LIST is the
-   copy-in/copy-out list to be stored into TYPE_CI_CO_LIST.
-   RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
-   object.  RETURNS_BY_REF is true if the function returns by reference.
-   RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
-   first parameter) the address of the place to copy its result.  */
+/* Return a FUNCTION_TYPE node.  RETURN_TYPE is the type returned by the
+   subprogram.  If it is VOID_TYPE, then we are dealing with a procedure,
+   otherwise we are dealing with a function.  PARAM_DECL_LIST is a list of
+   PARM_DECL nodes that are the subprogram parameters.  CICO_LIST is the
+   copy-in/copy-out list to be stored into the TYPE_CICO_LIST field.
+   RETURN_UNCONSTRAINED_P is true if the function returns an unconstrained
+   object.  RETURN_BY_DIRECT_REF_P is true if the function returns by direct
+   reference.  RETURN_BY_INVISI_REF_P is true if the function returns by
+   invisible reference.  */
 extern tree create_subprog_type (tree return_type, tree param_decl_list,
-                                 tree cico_list, bool returns_unconstrained,
-                                 bool returns_by_ref,
-                                 bool returns_by_target_ptr);
+				 tree cico_list, bool return_unconstrained_p,
+				 bool return_by_direct_ref_p,
+				 bool return_by_invisi_ref_p);
 
 /* Return a copy of TYPE, but safe to modify in any way.  */
 extern tree copy_type (tree type);
@@ -804,7 +804,7 @@ extern tree build_cond_expr (tree result_type, tree condition_operand,
                              tree true_operand, tree false_operand);
 
 /* Similar, but for RETURN_EXPR.  */
-extern tree build_return_expr (tree result_decl, tree ret_val);
+extern tree build_return_expr (tree ret_obj, tree ret_val);
 
 /* Build a CALL_EXPR to call FUNDECL with one argument, ARG.  Return
    the CALL_EXPR.  */

gcc/ada/gcc-interface/trans.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -2196,6 +2196,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
        ? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node));
   /* The FUNCTION_DECL node corresponding to the subprogram spec.   */
   tree gnu_subprog_decl;
+  /* Its RESULT_DECL node.  */
+  tree gnu_result_decl;
   /* The FUNCTION_TYPE node corresponding to the subprogram spec.  */
   tree gnu_subprog_type;
   tree gnu_cico_list;
@@ -2219,9 +2221,18 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
     = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
 			  Acts_As_Spec (gnat_node)
 			  && !present_gnu_tree (gnat_subprog_id));
-
+  gnu_result_decl = DECL_RESULT (gnu_subprog_decl);
   gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
 
+  /* If the function returns by invisible reference, make it explicit in the
+     function body.  See gnat_to_gnu_entity, E_Subprogram_Type case.  */
+  if (TREE_ADDRESSABLE (gnu_subprog_type))
+    {
+      TREE_TYPE (gnu_result_decl)
+	= build_reference_type (TREE_TYPE (gnu_result_decl));
+      relayout_decl (gnu_result_decl);
+    }
+
   /* Propagate the debug mode.  */
   if (!Needs_Debug_Info (gnat_subprog_id))
     DECL_IGNORED_P (gnu_subprog_decl) = 1;
@@ -2319,9 +2330,18 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
       gnu_result = end_stmt_group ();
     }
 
-  /* If we made a special return label, we need to make a block that contains
-     the definition of that label and the copying to the return value.  That
-     block first contains the function, then the label and copy statement.  */
+    /* If we are dealing with a return from an Ada procedure with parameters
+       passed by copy-in/copy-out, we need to return a record containing the
+       final values of these parameters.  If the list contains only one entry,
+       return just that entry though.
+
+       For a full description of the copy-in/copy-out parameter mechanism, see
+       the part of the gnat_to_gnu_entity routine dealing with the translation
+       of subprograms.
+
+       We need to make a block that contains the definition of that label and
+       the copying of the return value.  It first contains the function, then
+       the label and copy statement.  */
   if (TREE_VALUE (gnu_return_label_stack))
     {
       tree gnu_retval;
@@ -2339,12 +2359,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 	gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
 					     gnu_cico_list);
 
-      if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval))
-	gnu_retval = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
-
-      add_stmt_with_node
-	(build_return_expr (DECL_RESULT (gnu_subprog_decl), gnu_retval),
-	 End_Label (Handled_Statement_Sequence (gnat_node)));
+      add_stmt_with_node (build_return_expr (gnu_result_decl, gnu_retval),
+			  End_Label (Handled_Statement_Sequence (gnat_node)));
       gnat_poplevel ();
       gnu_result = end_stmt_group ();
     }
@@ -2396,8 +2412,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
   tree gnu_subprog_node = gnat_to_gnu (Name (gnat_node));
   /* The FUNCTION_TYPE node giving the GCC type of the subprogram.  */
   tree gnu_subprog_type = TREE_TYPE (gnu_subprog_node);
-  tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE,
-					  gnu_subprog_node);
+  tree gnu_subprog_addr
+    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog_node);
   Entity_Id gnat_formal;
   Node_Id gnat_actual;
   tree gnu_actual_list = NULL_TREE;
@@ -2433,51 +2449,6 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
       }
     }
 
-  /* If we are calling by supplying a pointer to a target, set up that pointer
-     as the first argument.  Use GNU_TARGET if one was passed; otherwise, make
-     a target by building a variable and use the maximum size of the type if
-     it has self-referential size.  */
-  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
-    {
-      tree gnu_ret_type
-	= TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type)));
-
-      if (!gnu_target)
-	{
-	  tree gnu_obj_type;
-
-	  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_ret_type)))
-	    gnu_obj_type
-	      = maybe_pad_type (gnu_ret_type,
-				max_size (TYPE_SIZE (gnu_ret_type), true),
-				0, Etype (Name (gnat_node)), false, false,
-				false, true);
-	  else
-	    gnu_obj_type = gnu_ret_type;
-
-	  /* ??? We may be about to create a static temporary if we happen to
-	     be at the global binding level.  That's a regression from what
-	     the 3.x back-end would generate in the same situation, but we
-	     don't have a mechanism in Gigi for creating automatic variables
-	     in the elaboration routines.  */
-	  gnu_target
-	    = create_var_decl (create_tmp_var_name ("LR"), NULL, gnu_obj_type,
-			       NULL, false, false, false, false, NULL,
-			       gnat_node);
-
-	  *gnu_result_type_p = gnu_ret_type;
-	}
-
-      gnu_actual_list
-	= tree_cons (NULL_TREE,
-		     build_unary_op (ADDR_EXPR, NULL_TREE,
-				     unchecked_convert (gnu_ret_type,
-							gnu_target,
-							false)),
-		     NULL_TREE);
-
-    }
-
   /* The only way we can be making a call via an access type is if Name is an
      explicit dereference.  In that case, get the list of formal args from the
      type the access type is pointing to.  Otherwise, get the formals from
@@ -2784,53 +2755,43 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 				      nreverse (gnu_actual_list));
   set_expr_location_from_node (gnu_subprog_call, gnat_node);
 
-  /* If we return by passing a target, the result is the target after the
-     call.  We must not emit the call directly here because this might be
-     evaluated as part of an expression with conditions to control whether
-     the call should be emitted or not.  */
-  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
-    {
-      /* Conceptually, what we need is a COMPOUND_EXPR of the call followed by
-	 the target object.  Doing so would potentially be inefficient though,
-	 as this expression might be wrapped up into a SAVE_EXPR later, which
-	 would incur a pointless temporary copy of the whole object.
-
-	 What we do instead is build a COMPOUND_EXPR returning the address of
-	 the target, and then dereference.  Wrapping up the COMPOUND_EXPR into
-	 a SAVE_EXPR then only incurs a mere pointer copy.  */
-      tree gnu_target_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_target);
-      set_expr_location_from_node (gnu_target_addr, gnat_node);
-      gnu_result = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_target_addr),
-			   gnu_subprog_call, gnu_target_addr);
-      return build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
-    }
-
-  /* If it is a function call, the result is the call expression unless
-     a target is specified, in which case we copy the result into the target
-     and return the assignment statement.  */
-  else if (Nkind (gnat_node) == N_Function_Call)
+  /* If it's a function call, the result is the call expression unless a target
+     is specified, in which case we copy the result into the target and return
+     the assignment statement.  */
+  if (Nkind (gnat_node) == N_Function_Call)
     {
       gnu_result = gnu_subprog_call;
+      enum tree_code op_code;
 
-      /* If the function returns an unconstrained array or by reference,
-	 we have to de-dereference the pointer.  */
-      if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type)
-	  || TYPE_RETURNS_BY_REF_P (gnu_subprog_type))
+      /* If the function returns an unconstrained array or by direct reference,
+	 we have to dereference the pointer.  */
+      if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type)
+	  || TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type))
 	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
 
       if (gnu_target)
-	gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
-				      gnu_target, gnu_result);
+	{
+	  /* ??? If the return type has non-constant size, then force the
+	     return slot optimization as we would not be able to generate
+	     a temporary.  That's what has been done historically.  */
+	  if (TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_subprog_type))))
+	    op_code = MODIFY_EXPR;
+	  else
+	    op_code = INIT_EXPR;
+
+	  gnu_result
+	    = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_result);
+	}
       else
 	*gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
 
       return gnu_result;
     }
 
-  /* If this is the case where the GNAT tree contains a procedure call
-     but the Ada procedure has copy in copy out parameters, the special
-     parameter passing mechanism must be used.  */
-  else if (TYPE_CI_CO_LIST (gnu_subprog_type) != NULL_TREE)
+  /* If this is the case where the GNAT tree contains a procedure call but the
+     Ada procedure has copy-in/copy-out parameters, then the special parameter
+     passing mechanism must be used.  */
+  if (TYPE_CI_CO_LIST (gnu_subprog_type))
     {
       /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
 	 in copy out parameters.  */
@@ -4636,25 +4597,10 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Return_Statement:
       {
-	/* The gnu function type of the subprogram currently processed.  */
-	tree gnu_subprog_type = TREE_TYPE (current_function_decl);
-	/* The return value from the subprogram.  */
-	tree gnu_ret_val = NULL_TREE;
-	/* The place to put the return value.  */
-	tree gnu_lhs;
-
-	/* If we are dealing with a "return;" from an Ada procedure with
-	   parameters passed by copy in copy out, we need to return a record
-	   containing the final values of these parameters.  If the list
-	   contains only one entry, return just that entry.
-
-	   For a full description of the copy in copy out parameter mechanism,
-	   see the part of the gnat_to_gnu_entity routine dealing with the
-	   translation of subprograms.
-
-	   But if we have a return label defined, convert this into
-	   a branch to that label.  */
+	tree gnu_ret_val, gnu_ret_obj;
 
+	/* If we have a return label defined, convert this into a branch to
+	   that label.  The return proper will be handled elsewhere.  */
 	if (TREE_VALUE (gnu_return_label_stack))
 	  {
 	    gnu_result = build1 (GOTO_EXPR, void_type_node,
@@ -4662,90 +4608,69 @@ gnat_to_gnu (Node_Id gnat_node)
 	    break;
 	  }
 
-	else if (TYPE_CI_CO_LIST (gnu_subprog_type))
-	  {
-	    gnu_lhs = DECL_RESULT (current_function_decl);
-	    if (list_length (TYPE_CI_CO_LIST (gnu_subprog_type)) == 1)
-	      gnu_ret_val = TREE_VALUE (TYPE_CI_CO_LIST (gnu_subprog_type));
-	    else
-	      gnu_ret_val
-		= gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
-					  TYPE_CI_CO_LIST (gnu_subprog_type));
-	  }
-
-	/* If the Ada subprogram is a function, we just need to return the
-	   expression.   If the subprogram returns an unconstrained
-	   array, we have to allocate a new version of the result and
-	   return it.  If we return by reference, return a pointer.  */
-
-	else if (Present (Expression (gnat_node)))
+	/* If the subprogram is a function, we must return the expression.  */
+	if (Present (Expression (gnat_node)))
 	  {
-	    /* If the current function returns by target pointer and we
-	       are doing a call, pass that target to the call.  */
-	    if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)
-		&& Nkind (Expression (gnat_node)) == N_Function_Call)
+	    tree gnu_subprog_type = TREE_TYPE (current_function_decl);
+	    tree gnu_result_decl = DECL_RESULT (current_function_decl);
+	    gnu_ret_val = gnat_to_gnu (Expression (gnat_node));
+
+	    /* Do not remove the padding from GNU_RET_VAL if the inner type is
+	       self-referential since we want to allocate the fixed size.  */
+	    if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
+		&& TYPE_IS_PADDING_P
+		   (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
+		&& CONTAINS_PLACEHOLDER_P
+		   (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))
+	      gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
+
+	    /* If the subprogram returns by direct reference, return a pointer
+	       to the return value.  */
+	    if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)
+		|| By_Ref (gnat_node))
+	      gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
+
+	    /* Otherwise, if it returns an unconstrained array, we have to
+	       allocate a new version of the result and return it.  */
+	    else if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type))
 	      {
-		gnu_lhs
-		  = build_unary_op (INDIRECT_REF, NULL_TREE,
-				    DECL_ARGUMENTS (current_function_decl));
-		gnu_result = call_to_gnu (Expression (gnat_node),
-					  &gnu_result_type, gnu_lhs);
+		gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
+		gnu_ret_val = build_allocator (TREE_TYPE (gnu_ret_val),
+					       gnu_ret_val,
+					       TREE_TYPE (gnu_subprog_type),
+					       Procedure_To_Call (gnat_node),
+					       Storage_Pool (gnat_node),
+					       gnat_node, false);
 	      }
-	    else
+
+	    /* If the subprogram returns by invisible reference, dereference
+	       the pointer it is passed using the type of the return value
+	       and build the copy operation manually.  This ensures that we
+	       don't copy too much data, for example if the return type is
+	       unconstrained with a maximum size.  */
+	    if (TREE_ADDRESSABLE (gnu_subprog_type))
 	      {
-		gnu_ret_val = gnat_to_gnu (Expression (gnat_node));
-
-		if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
-		  /* The original return type was unconstrained so dereference
-		     the TARGET pointer in the actual return value's type.  */
-		  gnu_lhs
-		    = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
-				      DECL_ARGUMENTS (current_function_decl));
-		else
-		  gnu_lhs = DECL_RESULT (current_function_decl);
-
-		/* Do not remove the padding from GNU_RET_VAL if the inner
-		   type is self-referential since we want to allocate the fixed
-		   size in that case.  */
-		if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
-		    && TYPE_IS_PADDING_P
-		       (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
-		    && CONTAINS_PLACEHOLDER_P
-		       (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))
-		  gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
-
-		if (TYPE_RETURNS_BY_REF_P (gnu_subprog_type)
-		    || By_Ref (gnat_node))
-		  gnu_ret_val
-		    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
-
-		else if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type))
-		  {
-		    gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
-		    gnu_ret_val
-		      = build_allocator (TREE_TYPE (gnu_ret_val),
-					 gnu_ret_val,
-					 TREE_TYPE (gnu_subprog_type),
-					 Procedure_To_Call (gnat_node),
-					 Storage_Pool (gnat_node),
-					 gnat_node, false);
-		  }
+		gnu_ret_obj
+		  = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
+				    gnu_result_decl);
+		gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+					      gnu_ret_obj, gnu_ret_val);
+		add_stmt_with_node (gnu_result, gnat_node);
+		gnu_ret_val = NULL_TREE;
+		gnu_ret_obj = gnu_result_decl;
 	      }
+
+	    /* Otherwise, build a regular return.  */
+	    else
+	      gnu_ret_obj = gnu_result_decl;
 	  }
 	else
-	  /* If the Ada subprogram is a regular procedure, just return.  */
-	  gnu_lhs = NULL_TREE;
-
-	if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
 	  {
-	    if (gnu_ret_val)
-	      gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
-					    gnu_lhs, gnu_ret_val);
-	    add_stmt_with_node (gnu_result, gnat_node);
-	    gnu_lhs = NULL_TREE;
+	    gnu_ret_val = NULL_TREE;
+	    gnu_ret_obj = NULL_TREE;
 	  }
 
-	gnu_result = build_return_expr (gnu_lhs, gnu_ret_val);
+	gnu_result = build_return_expr (gnu_ret_obj, gnu_ret_val);
       }
       break;
 
@@ -5605,7 +5530,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
       else
 	t = gnu_decl;
 
-      gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, t, gnu_init);
+      gnu_stmt = build_binary_op (INIT_EXPR, NULL_TREE, t, gnu_init);
 
       DECL_INITIAL (gnu_decl) = NULL_TREE;
       if (TREE_READONLY (gnu_decl))

gcc/ada/gcc-interface/utils.c

@@ -1095,58 +1095,54 @@ split_plus (tree in, tree *pvar)
     return bitsize_zero_node;
 }
 
-/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
-   subprogram. If it is void_type_node, then we are dealing with a procedure,
-   otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
-   PARM_DECL nodes that are the subprogram arguments.  CICO_LIST is the
-   copy-in/copy-out list to be stored into TYPE_CICO_LIST.
-   RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
-   object.  RETURNS_BY_REF is true if the function returns by reference.
-   RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
-   first parameter) the address of the place to copy its result.  */
+/* Return a FUNCTION_TYPE node.  RETURN_TYPE is the type returned by the
+   subprogram.  If it is VOID_TYPE, then we are dealing with a procedure,
+   otherwise we are dealing with a function.  PARAM_DECL_LIST is a list of
+   PARM_DECL nodes that are the subprogram parameters.  CICO_LIST is the
+   copy-in/copy-out list to be stored into the TYPE_CICO_LIST field.
+   RETURN_UNCONSTRAINED_P is true if the function returns an unconstrained
+   object.  RETURN_BY_DIRECT_REF_P is true if the function returns by direct
+   reference.  RETURN_BY_INVISI_REF_P is true if the function returns by
+   invisible reference.  */
 
 tree
 create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
-                     bool returns_unconstrained, bool returns_by_ref,
-                     bool returns_by_target_ptr)
+		     bool return_unconstrained_p, bool return_by_direct_ref_p,
+		     bool return_by_invisi_ref_p)
 {
   /* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
-     the subprogram formal parameters. This list is generated by traversing the
-     input list of PARM_DECL nodes.  */
-  tree param_type_list = NULL;
-  tree param_decl;
-  tree type;
+     the subprogram formal parameters.  This list is generated by traversing
+     the input list of PARM_DECL nodes.  */
+  tree param_type_list = NULL_TREE;
+  tree t, type;
 
-  for (param_decl = param_decl_list; param_decl;
-       param_decl = TREE_CHAIN (param_decl))
-    param_type_list = tree_cons (NULL_TREE, TREE_TYPE (param_decl),
-				 param_type_list);
+  for (t = param_decl_list; t; t = TREE_CHAIN (t))
+    param_type_list = tree_cons (NULL_TREE, TREE_TYPE (t), param_type_list);
 
   /* The list of the function parameter types has to be terminated by the void
      type to signal to the back-end that we are not dealing with a variable
-     parameter subprogram, but that the subprogram has a fixed number of
-     parameters.  */
+     parameter subprogram, but that it has a fixed number of parameters.  */
   param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list);
 
-  /* The list of argument types has been created in reverse
-     so nreverse it.   */
+  /* The list of argument types has been created in reverse so reverse it.  */
   param_type_list = nreverse (param_type_list);
 
   type = build_function_type (return_type, param_type_list);
 
-  /* TYPE may have been shared since GCC hashes types.  If it has a CICO_LIST
-     or the new type should, make a copy of TYPE.  Likewise for
-     RETURNS_UNCONSTRAINED and RETURNS_BY_REF.  */
-  if (TYPE_CI_CO_LIST (type) || cico_list
-      || TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained
-      || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref
-      || TYPE_RETURNS_BY_TARGET_PTR_P (type) != returns_by_target_ptr)
-    type = copy_type (type);
+  /* TYPE may have been shared since GCC hashes types.  If it has a different
+     CICO_LIST, make a copy.  Likewise for the various flags.  */
+  if (TYPE_CI_CO_LIST (type) != cico_list
+      || TYPE_RETURN_UNCONSTRAINED_P (type) != return_unconstrained_p
+      || TYPE_RETURN_BY_DIRECT_REF_P (type) != return_by_direct_ref_p
+      || TREE_ADDRESSABLE (type) != return_by_invisi_ref_p)
+    {
+      type = copy_type (type);
+      TYPE_CI_CO_LIST (type) = cico_list;
+      TYPE_RETURN_UNCONSTRAINED_P (type) = return_unconstrained_p;
+      TYPE_RETURN_BY_DIRECT_REF_P (type) = return_by_direct_ref_p;
+      TREE_ADDRESSABLE (type) = return_by_invisi_ref_p;
+    }
 
-  TYPE_CI_CO_LIST (type) = cico_list;
-  TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
-  TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
-  TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
   return type;
 }
 
@@ -1828,9 +1824,10 @@ create_subprog_decl (tree subprog_name, tree asm_name,
 		     bool public_flag, bool extern_flag,
                      struct attrib *attr_list, Node_Id gnat_node)
 {
-  tree return_type  = TREE_TYPE (subprog_type);
-  tree subprog_decl = build_decl (input_location,
-				  FUNCTION_DECL, subprog_name, subprog_type);
+  tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name,
+				  subprog_type);
+  tree result_decl = build_decl (input_location, RESULT_DECL, NULL_TREE,
+				 TREE_TYPE (subprog_type));
 
   /* If this is a non-inline function nested inside an inlined external
      function, we cannot honor both requests without cloning the nested
@@ -1851,23 +1848,11 @@ create_subprog_decl (tree subprog_name, tree asm_name,
   TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
   DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
   DECL_ARGUMENTS (subprog_decl) = param_decl_list;
-  DECL_RESULT (subprog_decl)    = build_decl (input_location,
-					      RESULT_DECL, 0, return_type);
-  DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
-  DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
-
-  /* TREE_ADDRESSABLE is set on the result type to request the use of the
-     target by-reference return mechanism.  This is not supported all the
-     way down to RTL expansion with GCC 4, which ICEs on temporary creation
-     attempts with such a type and expects DECL_BY_REFERENCE to be set on
-     the RESULT_DECL instead - see gnat_genericize for more details.  */
-  if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
-    {
-      tree result_decl = DECL_RESULT (subprog_decl);
 
-      TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
-      DECL_BY_REFERENCE (result_decl) = 1;
-    }
+  DECL_ARTIFICIAL (result_decl) = 1;
+  DECL_IGNORED_P (result_decl) = 1;
+  DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (subprog_type);
+  DECL_RESULT (subprog_decl) = result_decl;
 
   if (asm_name)
     {
@@ -1921,163 +1906,6 @@ begin_subprog_body (tree subprog_decl)
   get_pending_sizes ();
 }
 
-
-/* Helper for the genericization callback.  Return a dereference of VAL
-   if it is of a reference type.  */
-
-static tree
-convert_from_reference (tree val)
-{
-  tree value_type, ref;
-
-  if (TREE_CODE (TREE_TYPE (val)) != REFERENCE_TYPE)
-    return val;
-
-  value_type =  TREE_TYPE (TREE_TYPE (val));
-  ref = build1 (INDIRECT_REF, value_type, val);
-
-  /* See if what we reference is CONST or VOLATILE, which requires
-     looking into array types to get to the component type.  */
-
-  while (TREE_CODE (value_type) == ARRAY_TYPE)
-    value_type = TREE_TYPE (value_type);
-
-  TREE_READONLY (ref)
-    = (TYPE_QUALS (value_type) & TYPE_QUAL_CONST);
-  TREE_THIS_VOLATILE (ref)
-    = (TYPE_QUALS (value_type) & TYPE_QUAL_VOLATILE);
-
-  TREE_SIDE_EFFECTS (ref)
-    = (TREE_THIS_VOLATILE (ref) || TREE_SIDE_EFFECTS (val));
-
-  return ref;
-}
-
-/* Helper for the genericization callback.  Returns true if T denotes
-   a RESULT_DECL with DECL_BY_REFERENCE set.  */
-
-static inline bool
-is_byref_result (tree t)
-{
-  return (TREE_CODE (t) == RESULT_DECL && DECL_BY_REFERENCE (t));
-}
-
-
-/* Tree walking callback for gnat_genericize. Currently ...
-
-   o Adjust references to the function's DECL_RESULT if it is marked
-     DECL_BY_REFERENCE and so has had its type turned into a reference
-     type at the end of the function compilation.  */
-
-static tree
-gnat_genericize_r (tree *stmt_p, int *walk_subtrees, void *data)
-{
-  /* This implementation is modeled after what the C++ front-end is
-     doing, basis of the downstream passes behavior.  */
-
-  tree stmt = *stmt_p;
-  struct pointer_set_t *p_set = (struct pointer_set_t*) data;
-
-  /* If we have a direct mention of the result decl, dereference.  */
-  if (is_byref_result (stmt))
-    {
-      *stmt_p = convert_from_reference (stmt);
-      *walk_subtrees = 0;
-      return NULL;
-    }
-
-  /* Otherwise, no need to walk the same tree twice.  */
-  if (pointer_set_contains (p_set, stmt))
-    {
-      *walk_subtrees = 0;
-      return NULL_TREE;
-    }
-
-  /* If we are taking the address of what now is a reference, just get the
-     reference value.  */
-  if (TREE_CODE (stmt) == ADDR_EXPR
-      && is_byref_result (TREE_OPERAND (stmt, 0)))
-    {
-      *stmt_p = convert (TREE_TYPE (stmt), TREE_OPERAND (stmt, 0));
-      *walk_subtrees = 0;
-    }
-
-  /* Don't dereference an by-reference RESULT_DECL inside a RETURN_EXPR.  */
-  else if (TREE_CODE (stmt) == RETURN_EXPR
-           && TREE_OPERAND (stmt, 0)
-	   && is_byref_result (TREE_OPERAND (stmt, 0)))
-    *walk_subtrees = 0;
-
-  /* Don't look inside trees that cannot embed references of interest.  */
-  else if (IS_TYPE_OR_DECL_P (stmt))
-    *walk_subtrees = 0;
-
-  pointer_set_insert (p_set, *stmt_p);
-
-  return NULL;
-}
-
-/* Perform lowering of Ada trees to GENERIC. In particular:
-
-   o Turn a DECL_BY_REFERENCE RESULT_DECL into a real by-reference decl
-     and adjust all the references to this decl accordingly.  */
-
-static void
-gnat_genericize (tree fndecl)
-{
-  /* Prior to GCC 4, an explicit By_Reference result mechanism for a function
-     was handled by simply setting TREE_ADDRESSABLE on the result type.
-     Everything required to actually pass by invisible ref using the target
-     mechanism (e.g. extra parameter) was handled at RTL expansion time.
-
-     This doesn't work with GCC 4 any more for several reasons.  First, the
-     gimplification process might need the creation of temporaries of this
-     type, and the gimplifier ICEs on such attempts.  Second, the middle-end
-     now relies on a different attribute for such cases (DECL_BY_REFERENCE on
-     RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to
-     be explicitly accounted for by the front-end in the function body.
-
-     We achieve the complete transformation in two steps:
-
-     1/ create_subprog_decl performs early attribute tweaks: it clears
-        TREE_ADDRESSABLE from the result type and sets DECL_BY_REFERENCE on
-        the result decl.  The former ensures that the bit isn't set in the GCC
-        tree saved for the function, so prevents ICEs on temporary creation.
-        The latter we use here to trigger the rest of the processing.
-
-     2/ This function performs the type transformation on the result decl
-        and adjusts all the references to this decl from the function body
-	accordingly.
-
-     Clearing TREE_ADDRESSABLE from the type differs from the C++ front-end
-     strategy, which escapes the gimplifier temporary creation issues by
-     creating it's own temporaries using TARGET_EXPR nodes.  Our way relies
-     on simple specific support code in aggregate_value_p to look at the
-     target function result decl explicitly.  */
-
-  struct pointer_set_t *p_set;
-  tree decl_result = DECL_RESULT (fndecl);
-
-  if (!DECL_BY_REFERENCE (decl_result))
-    return;
-
-  /* Make the DECL_RESULT explicitly by-reference and adjust all the
-     occurrences in the function body using the common tree-walking facility.
-     We want to see every occurrence of the result decl to adjust the
-     referencing tree, so need to use our own pointer set to control which
-     trees should be visited again or not.  */
-
-  p_set = pointer_set_create ();
-
-  TREE_TYPE (decl_result) = build_reference_type (TREE_TYPE (decl_result));
-  TREE_ADDRESSABLE (decl_result) = 0;
-  relayout_decl (decl_result);
-
-  walk_tree (&DECL_SAVED_TREE (fndecl), gnat_genericize_r, p_set, NULL);
-
-  pointer_set_destroy (p_set);
-}
-
 /* Finish the definition of the current subprogram BODY and finalize it.  */
 
 void
@@ -2111,9 +1939,6 @@ end_subprog_body (tree body)
   if (type_annotate_only)
     return;
 
-  /* Perform the required pre-gimplification transformations on the tree.  */
-  gnat_genericize (fndecl);
-
   /* Dump functions before gimplification.  */
   dump_function (TDI_original, fndecl);
 

gcc/ada/gcc-interface/utils2.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2010, 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- *
@@ -609,6 +609,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
 
   switch (op_code)
     {
+    case INIT_EXPR:
     case MODIFY_EXPR:
       /* If there were integral or pointer conversions on the LHS, remove
 	 them; we'll be putting them back below if needed.  Likewise for
@@ -1397,45 +1398,40 @@ build_cond_expr (tree result_type, tree condition_operand,
   return result;
 }
 
-/* Similar, but for RETURN_EXPR.  If RESULT_DECL is non-zero, build
-   a RETURN_EXPR around the assignment of RET_VAL to RESULT_DECL.
-   If RESULT_DECL is zero, build a bare RETURN_EXPR.  */
+/* Similar, but for RETURN_EXPR.  If RET_VAL is non-null, build a RETURN_EXPR
+   around the assignment of RET_VAL to RET_OBJ.  Otherwise just build a bare
+   RETURN_EXPR around RESULT_OBJ, which may be null in this case.  */
 
 tree
-build_return_expr (tree result_decl, tree ret_val)
+build_return_expr (tree ret_obj, tree ret_val)
 {
   tree result_expr;
 
-  if (result_decl)
+  if (ret_val)
     {
       /* The gimplifier explicitly enforces the following invariant:
 
-           RETURN_EXPR
-               |
-           MODIFY_EXPR
-           /        \
-          /          \
-      RESULT_DECL    ...
+	      RETURN_EXPR
+		  |
+	      MODIFY_EXPR
+	      /        \
+	     /          \
+	 RET_OBJ        ...
 
-      As a consequence, type-homogeneity dictates that we use the type
-      of the RESULT_DECL as the operation type.  */
-
-      tree operation_type = TREE_TYPE (result_decl);
-
-      /* Convert the right operand to the operation type.  Note that
-         it's the same transformation as in the MODIFY_EXPR case of
-         build_binary_op with the additional guarantee that the type
-         cannot involve a placeholder, since otherwise the function
-         would use the "target pointer" return mechanism.  */
+	 As a consequence, type consistency dictates that we use the type
+	 of the RET_OBJ as the operation type.  */
+      tree operation_type = TREE_TYPE (ret_obj);
 
+      /* Convert the right operand to the operation type.  Note that it's the
+	 same transformation as in the MODIFY_EXPR case of build_binary_op,
+	 with the assumption that the type cannot involve a placeholder.  */
       if (operation_type != TREE_TYPE (ret_val))
 	ret_val = convert (operation_type, ret_val);
 
-      result_expr
-	= build2 (MODIFY_EXPR, operation_type, result_decl, ret_val);
+      result_expr = build2 (MODIFY_EXPR, operation_type, ret_obj, ret_val);
     }
   else
-    result_expr = NULL_TREE;
+    result_expr = ret_obj;
 
   return build1 (RETURN_EXPR, void_type_node, result_expr);
 }

gcc/calls.c

@@ -2089,7 +2089,7 @@ expand_call (tree exp, rtx target, int ignore)
   /* Set up a place to return a structure.  */
 
   /* Cater to broken compilers.  */
-  if (aggregate_value_p (exp, (!fndecl ? fntype : fndecl)))
+  if (aggregate_value_p (exp, fntype))
     {
       /* This call returns a big structure.  */
       flags &= ~(ECF_CONST | ECF_PURE | ECF_LOOPING_CONST_OR_PURE);

gcc/function.c

@@ -1853,41 +1853,36 @@ struct rtl_opt_pass pass_instantiate_virtual_regs =
 int
 aggregate_value_p (const_tree exp, const_tree fntype)
 {
+  const_tree type = (TYPE_P (exp)) ? exp : TREE_TYPE (exp);
   int i, regno, nregs;
   rtx reg;
 
-  const_tree type = (TYPE_P (exp)) ? exp : TREE_TYPE (exp);
-
-  /* DECL node associated with FNTYPE when relevant, which we might need to
-     check for by-invisible-reference returns, typically for CALL_EXPR input
-     EXPressions.  */
-  const_tree fndecl = NULL_TREE;
-
   if (fntype)
     switch (TREE_CODE (fntype))
       {
       case CALL_EXPR:
-	fndecl = get_callee_fndecl (fntype);
-	fntype = (fndecl
-		  ? TREE_TYPE (fndecl)
-		  : TREE_TYPE (TREE_TYPE (CALL_EXPR_FN (fntype))));
+	{
+	  tree fndecl = get_callee_fndecl (fntype);
+	  fntype = (fndecl
+		    ? TREE_TYPE (fndecl)
+		    : TREE_TYPE (TREE_TYPE (CALL_EXPR_FN (fntype))));
+	}
 	break;
       case FUNCTION_DECL:
-	fndecl = fntype;
-	fntype = TREE_TYPE (fndecl);
+	fntype = TREE_TYPE (fntype);
 	break;
       case FUNCTION_TYPE:
       case METHOD_TYPE:
         break;
       case IDENTIFIER_NODE:
-	fntype = 0;
+	fntype = NULL_TREE;
 	break;
       default:
-	/* We don't expect other rtl types here.  */
+	/* We don't expect other tree types here.  */
 	gcc_unreachable ();
       }
 
-  if (TREE_CODE (type) == VOID_TYPE)
+  if (VOID_TYPE_P (type))
     return 0;
 
   /* If a record should be passed the same as its first (and only) member
@@ -1901,24 +1896,21 @@ aggregate_value_p (const_tree exp, const_tree fntype)
       && DECL_BY_REFERENCE (exp))
     return 1;
 
-  /* If the EXPression is a CALL_EXPR, honor DECL_BY_REFERENCE set on the
-     called function RESULT_DECL, meaning the function returns in memory by
-     invisible reference.  This check lets front-ends not set TREE_ADDRESSABLE
-     on the function type, which used to be the way to request such a return
-     mechanism but might now be causing troubles at gimplification time if
-     temporaries with the function type need to be created.  */
-  if (TREE_CODE (exp) == CALL_EXPR && fndecl && DECL_RESULT (fndecl)
-      && DECL_BY_REFERENCE (DECL_RESULT (fndecl)))
+  /* Function types that are TREE_ADDRESSABLE force return in memory.  */
+  if (fntype && TREE_ADDRESSABLE (fntype))
     return 1;
 
-  if (targetm.calls.return_in_memory (type, fntype))
-    return 1;
   /* Types that are TREE_ADDRESSABLE must be constructed in memory,
      and thus can't be returned in registers.  */
   if (TREE_ADDRESSABLE (type))
     return 1;
+
   if (flag_pcc_struct_return && AGGREGATE_TYPE_P (type))
     return 1;
+
+  if (targetm.calls.return_in_memory (type, fntype))
+    return 1;
+
   /* Make sure we have suitable call-clobbered regs to return
      the value in; if not, we must return it in memory.  */
   reg = hard_function_value (type, 0, fntype, 0);
@@ -1933,6 +1925,7 @@ aggregate_value_p (const_tree exp, const_tree fntype)
   for (i = 0; i < nregs; i++)
     if (! call_used_regs[regno + i])
       return 1;
+
   return 0;
 }
 

gcc/gimplify.c

@@ -4278,6 +4278,18 @@ gimplify_modify_expr_rhs (tree *expr_p, tree *from_p, tree *to_p,
 	ret = GS_UNHANDLED;
 	break;
 
+      case WITH_SIZE_EXPR:
+	/* Likewise for calls that return an aggregate of non-constant size,
+	   since we would not be able to generate a temporary at all.  */
+	if (TREE_CODE (TREE_OPERAND (*from_p, 0)) == CALL_EXPR)
+	  {
+	    *from_p = TREE_OPERAND (*from_p, 0);
+	    ret = GS_OK;
+	  }
+	else
+	  ret = GS_UNHANDLED;
+	break;
+
 	/* If we're initializing from a container, push the initialization
 	   inside it.  */
       case CLEANUP_POINT_EXPR:

gcc/tree.h

@@ -1110,9 +1110,10 @@ extern void omp_clause_range_check_failed (const_tree, const char *, int,
    In CONSTRUCTOR nodes, it means object constructed must be in memory.
    In LABEL_DECL nodes, it means a goto for this label has been seen
    from a place outside all binding contours that restore stack levels.
-   In ..._TYPE nodes, it means that objects of this type must
-   be fully addressable.  This means that pieces of this
-   object cannot go into register parameters, for example.
+   In ..._TYPE nodes, it means that objects of this type must be fully
+   addressable.  This means that pieces of this object cannot go into
+   register parameters, for example.  If this a function type, this
+   means that the value must be returned in memory.
    In IDENTIFIER_NODEs, this means that some extern decl for this name
    had its address taken.  That matters for inline functions.  */
 #define TREE_ADDRESSABLE(NODE) ((NODE)->base.addressable_flag)