decl.c (gnat_to_gnu_entity): Also use return-by-invisible-reference if the return type is By_Reference.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: Also
	use return-by-invisible-reference if the return type is By_Reference.
	Tidy up and skip the processing of the return type if it is void.

From-SVN: r166916

2 files changed, 95 insertions, 100 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b621053..b1a8da7c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2010-11-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: Also
+	use return-by-invisible-reference if the return type is By_Reference.
+	Tidy up and skip the processing of the return type if it is void.
+
 2010-11-17  Joseph Myers  <joseph@codesourcery.com>
 
 	* gcc-interface/misc.c (gnat_parse_file): Take no arguments.
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 7181653..262ee5d 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3827,9 +3827,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
     /* Subprogram Entities
 
-       The following access functions are defined for subprograms (functions
-       or procedures):
+       The following access functions are defined for subprograms:
 
+		Etype       	Return type or Standard_Void_Type.
 		First_Formal	The first formal parameter.
 		Is_Imported     Indicates that the subprogram has appeared in
 				an INTERFACE or IMPORT pragma.  For now we
@@ -3837,10 +3837,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		Is_Exported     Likewise but for an EXPORT pragma.
 		Is_Inlined      True if the subprogram is to be inlined.
 
-       In addition for function subprograms we have:
-
-		Etype       	Return type of the function.
-
        Each parameter is first checked by calling must_pass_by_ref on its
        type to determine if it is passed by reference.  For parameters which
        are copied in, if they are Ada In Out or Out parameters, their return
@@ -3873,18 +3869,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     case E_Function:
     case E_Procedure:
       {
+	/* The type returned by a function or else Standard_Void_Type for a
+	   procedure.  */
+	Entity_Id gnat_return_type = Etype (gnat_entity);
+	tree gnu_return_type;
 	/* The first GCC parameter declaration (a PARM_DECL node).  The
 	   PARM_DECL nodes are chained through the TREE_CHAIN field, so this
 	   actually is the head of this parameter list.  */
 	tree gnu_param_list = NULL_TREE;
 	/* Likewise for the stub associated with an exported procedure.  */
 	tree gnu_stub_param_list = NULL_TREE;
-	/* The type returned by a function.  If the subprogram is a procedure
-	   this type should be void_type_node.  */
-	tree gnu_return_type = void_type_node;
-	/* List of fields in return type of procedure with copy-in copy-out
-	   parameters.  */
-	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
@@ -3894,6 +3888,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   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_cico_list = NULL_TREE;
+	/* List of fields in return type of procedure with copy-in copy-out
+	   parameters.  */
+	tree gnu_field_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;
@@ -3905,7 +3902,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	bool public_flag = Is_Public (gnat_entity) || imported_p;
 	bool extern_flag
 	  = (Is_Public (gnat_entity) && !definition) || imported_p;
-
        /* The semantics of "pure" in Ada essentially matches that of "const"
           in the back-end.  In particular, both properties are orthogonal to
           the "nothrow" property if the EH circuitry is explicit in the
@@ -3917,7 +3913,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	bool const_flag
 	  = (Exception_Mechanism == Back_End_Exceptions
 	     && Is_Pure (gnat_entity));
-
 	bool volatile_flag = No_Return (gnat_entity);
 	bool return_by_direct_ref_p = false;
 	bool return_by_invisi_ref_p = false;
@@ -3942,8 +3937,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    if (Ekind (Alias (gnat_entity)) == E_Enumeration_Literal)
 	      gnat_to_gnu_entity (Etype (Alias (gnat_entity)), NULL_TREE, 0);
 
-	    gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity),
-					   gnu_expr, 0);
+	    gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity), gnu_expr, 0);
 
 	    /* Elaborate any Itypes in the parameters of this entity.  */
 	    for (gnat_temp = First_Formal_With_Extras (gnat_entity);
@@ -3978,97 +3972,92 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   In the current state we neither warn nor err, and calls will just
 	   be handled as for regular subprograms.  */
 
-	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 (Returns_By_Ref (gnat_entity))
+	/* Look into the return type and get its associated GCC tree.  If it
+	   is not void, compute various flags for the subprogram type.  */
+	if (Ekind (gnat_return_type) == E_Void)
+	  gnu_return_type = void_type_node;
+	else
 	  {
-	    gnu_return_type = build_pointer_type (gnu_return_type);
-	    return_by_direct_ref_p = true;
-	  }
+	    gnu_return_type = gnat_to_gnu_type (gnat_return_type);
 
-	/* 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);
-	    return_unconstrained_p = true;
-	  }
+	    /* If this function returns by reference, make the actual return
+	       type the pointer type and make a note of that.  */
+	    if (Returns_By_Ref (gnat_entity))
+	      {
+		gnu_return_type = build_pointer_type (gnu_return_type);
+		return_by_direct_ref_p = true;
+	      }
 
-	/* If the type requires a transient scope, the result is allocated
-	   on the secondary stack, so the result type of the function is
-	   just a pointer.  */
-	else if (Requires_Transient_Scope (Etype (gnat_entity)))
-	  {
-	    gnu_return_type = build_pointer_type (gnu_return_type);
-	    return_unconstrained_p = true;
-	  }
+	    /* If we are supposed to return an unconstrained array type, make
+	       the actual return type the fat pointer type.  */
+	    else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
+	      {
+		gnu_return_type = TREE_TYPE (gnu_return_type);
+		return_unconstrained_p = true;
+	      }
 
-	/* If the type is a padded type and the underlying type would not
-	   be passed by reference or this function has a foreign convention,
-	   return the underlying type.  */
-	else if (TYPE_IS_PADDING_P (gnu_return_type)
-		 && (!default_pass_by_ref (TREE_TYPE
-					   (TYPE_FIELDS (gnu_return_type)))
-		     || Has_Foreign_Convention (gnat_entity)))
-	  gnu_return_type = TREE_TYPE (TYPE_FIELDS (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)))
-	  {
-	    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;
-	  }
+	    /* Likewise, if the return type requires a transient scope, the
+	       return value will be allocated on the secondary stack so the
+	       actual return type is the pointer type.  */
+	    else if (Requires_Transient_Scope (gnat_return_type))
+	      {
+		gnu_return_type = build_pointer_type (gnu_return_type);
+		return_unconstrained_p = true;
+	      }
 
-	/* If the return type has a size that overflows, we cannot have
-	   a function that returns that type.  This usage doesn't make
-	   sense anyway, so give an error here.  */
-	if (TYPE_SIZE_UNIT (gnu_return_type)
-	    && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
-	    && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
-	  {
-	    post_error ("cannot return type whose size overflows",
-			gnat_entity);
-	    gnu_return_type = copy_node (gnu_return_type);
-	    TYPE_SIZE (gnu_return_type) = bitsize_zero_node;
-	    TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node;
-	    TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type;
-	    TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE;
-	  }
+	    /* 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).  */
+	    else if (kind == E_Function
+		     && Mechanism (gnat_entity) == By_Reference)
+	      return_by_invisi_ref_p = true;
+
+	    /* Likewise, if the return type is itself By_Reference.  */
+	    else if (TREE_ADDRESSABLE (gnu_return_type))
+	      return_by_invisi_ref_p = true;
+
+	    /* If the type is a padded type and the underlying type would not
+	       be passed by reference or the function has a foreign convention,
+	       return the underlying type.  */
+	    else if (TYPE_IS_PADDING_P (gnu_return_type)
+		     && (!default_pass_by_ref
+			  (TREE_TYPE (TYPE_FIELDS (gnu_return_type)))
+			 || Has_Foreign_Convention (gnat_entity)))
+	      gnu_return_type = TREE_TYPE (TYPE_FIELDS (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)))
+	      {
+		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;
+	      }
 
-	/* Look at all our parameters and get the type of
-	   each.  While doing this, build a copy-out structure if
-	   we need one.  */
+	    /* If the return type has a size that overflows, we cannot have
+	       a function that returns that type.  This usage doesn't make
+	       sense anyway, so give an error here.  */
+	    if (TYPE_SIZE_UNIT (gnu_return_type)
+		&& TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
+		&& TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
+	      {
+		post_error ("cannot return type whose size overflows",
+			    gnat_entity);
+		gnu_return_type = copy_node (gnu_return_type);
+		TYPE_SIZE (gnu_return_type) = bitsize_zero_node;
+		TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node;
+		TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type;
+		TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE;
+	      }
+	  }
 
-	/* Loop over the parameters and get their associated GCC tree.
-	   While doing this, build a copy-out structure if we need one.  */
+	/* Loop over the parameters and get their associated GCC tree.  While
+	   doing this, build a copy-in copy-out structure if we need one.  */
 	for (gnat_param = First_Formal_With_Extras (gnat_entity), parmnum = 0;
 	     Present (gnat_param);
 	     gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)