ada-tree.h (DECL_BY_DOUBLE_REF_P): New macro.

	* gcc-interface/ada-tree.h (DECL_BY_DOUBLE_REF_P): New macro.
	* gcc-interface/gigi.h (annotate_object): Add BY_DOUBLE_REF parameter.
	* gcc-interface/decl.c (annotate_object): Likewise and handle it.
	(gnat_to_gnu_entity): Adjust calls to annotate_object.
	(gnat_to_gnu_param): If fat pointer types are passed by reference on
	the target, pass them by explicit reference.
	* gcc-interface/misc.c (default_pass_by_ref): Fix type of constant.
	* gcc-interface/trans.c (Identifier_to_gnu): Do DECL_BY_DOUBLE_REF_P.
	(Subprogram_Body_to_gnu): Adjust call to annotate_object.
	(call_to_gnu): Handle DECL_BY_DOUBLE_REF_P.
	* gcc-interface/utils.c (convert_vms_descriptor): Add BY_REF parameter
	and handle it.
	(build_function_stub): Iterate on the parameters of the subprogram in
	lieu of on the argument types.  Adjust call to convert_vms_descriptor.

From-SVN: r165250

gcc/ada/ChangeLog

+2010-10-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.h (DECL_BY_DOUBLE_REF_P): New macro.
+	* gcc-interface/gigi.h (annotate_object): Add BY_DOUBLE_REF parameter.
+	* gcc-interface/decl.c (annotate_object): Likewise and handle it.
+	(gnat_to_gnu_entity): Adjust calls to annotate_object.
+	(gnat_to_gnu_param): If fat pointer types are passed by reference on
+	the target, pass them by explicit reference.
+	* gcc-interface/misc.c (default_pass_by_ref): Fix type of constant.
+	* gcc-interface/trans.c (Identifier_to_gnu): Do DECL_BY_DOUBLE_REF_P.
+	(Subprogram_Body_to_gnu): Adjust call to annotate_object.
+	(call_to_gnu): Handle DECL_BY_DOUBLE_REF_P.
+	* gcc-interface/utils.c (convert_vms_descriptor): Add BY_REF parameter
+	and handle it.
+	(build_function_stub): Iterate on the parameters of the subprogram in
+	lieu of on the argument types.  Adjust call to convert_vms_descriptor.
+
 2010-10-09  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/misc.c: Delete prototypes.

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

@@ -332,14 +332,18 @@ do {						   \
    constant CONSTRUCTOR.  */
 #define DECL_CONST_ADDRESS_P(NODE) DECL_LANG_FLAG_0 (CONST_DECL_CHECK (NODE))
 
-/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
+/* Nonzero in a PARM_DECL if it is always used by double reference, i.e. a
+   pair of INDIRECT_REFs is needed to access the object.  */
+#define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE))
+
+/* Nonzero in a DECL if it is always used by reference, i.e. an INDIRECT_REF
    is needed to access the object.  */
 #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
 
 /* Nonzero in a FIELD_DECL that is a dummy built for some internal reason.  */
 #define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE))
 
-/* Nonzero if this decl is a PARM_DECL for an Ada array being passed to a
+/* Nonzero in a PARM_DECL if it is made for an Ada array being passed to a
    foreign convention subprogram.  */
 #define DECL_BY_COMPONENT_PTR_P(NODE) DECL_LANG_FLAG_3 (PARM_DECL_CHECK (NODE))
 
@@ -347,7 +351,7 @@ do {						   \
 #define DECL_ELABORATION_PROC_P(NODE) \
   DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE))
 
-/* Nonzero if this is a decl for a pointer that points to something which
+/* Nonzero in a DECL if it is made for a pointer that points to something which
    is readonly.  Used mostly for fat pointers.  */
 #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
 

gcc/ada/gcc-interface/decl.c

@@ -972,7 +972,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			save_gnu_tree (gnat_entity, gnu_decl, true);
 			saved = true;
 			annotate_object (gnat_entity, gnu_type, NULL_TREE,
-					 false);
+					 false, false);
 			break;
 		      }
 
@@ -1471,7 +1471,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   type of the object and not on the object directly, and makes it
 	   possible to support all confirming representation clauses.  */
 	annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
-			 used_by_ref);
+			 used_by_ref, false);
       }
       break;
 
@@ -5282,7 +5282,8 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   bool in_param = (Ekind (gnat_param) == E_In_Parameter);
   /* The parameter can be indirectly modified if its address is taken.  */
   bool ro_param = in_param && !Address_Taken (gnat_param);
-  bool by_return = false, by_component_ptr = false, by_ref = false;
+  bool by_return = false, by_component_ptr = false;
+  bool by_ref = false, by_double_ref = false;
   tree gnu_param;
 
   /* Copy-return is used only for the first parameter of a valued procedure.
@@ -5399,6 +5400,19 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
     {
       gnu_param_type = build_reference_type (gnu_param_type);
       by_ref = true;
+
+      /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
+	 passed by reference.  Pass them by explicit reference, this will
+	 generate more debuggable code at -O0.  */
+      if (TYPE_IS_FAT_POINTER_P (gnu_param_type)
+	  && targetm.calls.pass_by_reference (NULL,
+					      TYPE_MODE (gnu_param_type),
+					      gnu_param_type,
+					      true))
+	{
+	   gnu_param_type = build_reference_type (gnu_param_type);
+	   by_double_ref = true;
+	}
     }
 
   /* Pass In Out or Out parameters using copy-in copy-out mechanism.  */
@@ -5441,6 +5455,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   gnu_param = create_param_decl (gnu_param_name, gnu_param_type,
 				 ro_param || by_ref || by_component_ptr);
   DECL_BY_REF_P (gnu_param) = by_ref;
+  DECL_BY_DOUBLE_REF_P (gnu_param) = by_double_ref;
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
   DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
                                       mech == By_Short_Descriptor);
@@ -7397,13 +7412,18 @@ annotate_value (tree gnu_size)
 /* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
    and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
    size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
-   BY_REF is true if the object is used by reference.  */
+   BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
+   true if the object is used by double reference.  */
 
 void
-annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref,
+		 bool by_double_ref)
 {
   if (by_ref)
     {
+      if (by_double_ref)
+	gnu_type = TREE_TYPE (gnu_type);
+
       if (TYPE_IS_FAT_POINTER_P (gnu_type))
 	gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
       else

gcc/ada/gcc-interface/gigi.h

@@ -139,9 +139,10 @@ extern tree choices_to_gnu (tree operand, Node_Id choices);
 /* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
    and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
    size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
-   BY_REF is true if the object is used by reference.  */
+   BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
+   true if the object is used by double reference.  */
 extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
-			     bool by_ref);
+			     bool by_ref, bool by_double_ref);
 
 /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
    type with all size expressions that contain F updated by replacing F

gcc/ada/gcc-interface/misc.c

@@ -619,8 +619,8 @@ gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
   *highval = TYPE_MAX_VALUE (gnu_type);
 }
 
-/* GNU_TYPE is a type. Determine if it should be passed by reference by
-   default.  */
+/* GNU_TYPE is the type of a subprogram parameter.  Determine if it should be
+   passed by reference by default.  */
 
 bool
 default_pass_by_ref (tree gnu_type)
@@ -632,7 +632,7 @@ default_pass_by_ref (tree gnu_type)
      is an In Out parameter, but it's probably best to err on the side of
      passing more things by reference.  */
 
-  if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
+  if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
     return true;
 
   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
@@ -647,8 +647,8 @@ default_pass_by_ref (tree gnu_type)
   return false;
 }
 
-/* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
-   it should be passed by reference. */
+/* GNU_TYPE is the type of a subprogram parameter.  Determine if it must be
+   passed by reference.  */
 
 bool
 must_pass_by_ref (tree gnu_type)

gcc/ada/gcc-interface/trans.c

@@ -989,6 +989,10 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       tree renamed_obj;
 
       if (TREE_CODE (gnu_result) == PARM_DECL
+	  && DECL_BY_DOUBLE_REF_P (gnu_result))
+	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+
+      if (TREE_CODE (gnu_result) == PARM_DECL
 	  && DECL_BY_COMPONENT_PTR_P (gnu_result))
 	gnu_result
 	  = build_unary_op (INDIRECT_REF, NULL_TREE,
@@ -2595,9 +2599,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
        gnat_param = Next_Formal_With_Extras (gnat_param))
     {
       tree gnu_param = get_gnu_tree (gnat_param);
+      bool is_var_decl = (TREE_CODE (gnu_param) == VAR_DECL);
+
       annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE,
-		       DECL_BY_REF_P (gnu_param));
-      if (TREE_CODE (gnu_param) == VAR_DECL)
+		       DECL_BY_REF_P (gnu_param),
+		       !is_var_decl && DECL_BY_DOUBLE_REF_P (gnu_param));
+
+      if (is_var_decl)
 	save_gnu_tree (gnat_param, NULL_TREE, false);
     }
 
@@ -2900,6 +2908,12 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	  /* The symmetry of the paths to the type of an entity is broken here
 	     since arguments don't know that they will be passed by ref.  */
 	  gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
+
+	  if (DECL_BY_DOUBLE_REF_P (gnu_formal))
+	    gnu_actual
+	      = build_unary_op (ADDR_EXPR, TREE_TYPE (gnu_formal_type),
+				gnu_actual);
+
 	  gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
 	}
       else if (gnu_formal

gcc/ada/gcc-interface/utils.c

@@ -3171,24 +3171,35 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 
 /* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
    pointer or fat pointer type.  GNU_EXPR_ALT_TYPE is the alternate (32-bit)
-   pointer type of GNU_EXPR.  GNAT_SUBPROG is the subprogram to which the
-   VMS descriptor is passed.  */
+   pointer type of GNU_EXPR.  BY_REF is true if the result is to be used by
+   reference.  GNAT_SUBPROG is the subprogram to which the VMS descriptor is
+   passed.  */
 
 static tree
 convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
-			Entity_Id gnat_subprog)
+			bool by_ref, Entity_Id gnat_subprog)
 {
   tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
   tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
   tree mbo = TYPE_FIELDS (desc_type);
   const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo));
   tree mbmo = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (mbo)));
-  tree is64bit, gnu_expr32, gnu_expr64;
+  tree real_type, is64bit, gnu_expr32, gnu_expr64;
+
+  if (by_ref)
+    real_type = TREE_TYPE (gnu_type);
+  else
+    real_type = gnu_type;
 
   /* If the field name is not MBO, it must be 32-bit and no alternate.
      Otherwise primary must be 64-bit and alternate 32-bit.  */
   if (strcmp (mbostr, "MBO") != 0)
-    return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+    {
+      tree ret = convert_vms_descriptor32 (real_type, gnu_expr, gnat_subprog);
+      if (by_ref)
+	ret = build_unary_op (ADDR_EXPR, gnu_type, ret);
+      return ret;
+    }
 
   /* Build the test for 64-bit descriptor.  */
   mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
@@ -3203,9 +3214,13 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
 					integer_minus_one_node));
 
   /* Build the 2 possible end results.  */
-  gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog);
+  gnu_expr64 = convert_vms_descriptor64 (real_type, gnu_expr, gnat_subprog);
+  if (by_ref)
+    gnu_expr64 =  build_unary_op (ADDR_EXPR, gnu_type, gnu_expr64);
   gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr);
-  gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+  gnu_expr32 = convert_vms_descriptor32 (real_type, gnu_expr, gnat_subprog);
+  if (by_ref)
+    gnu_expr32 =  build_unary_op (ADDR_EXPR, gnu_type, gnu_expr32);
 
   return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
 }
@@ -3217,7 +3232,7 @@ void
 build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
 {
   tree gnu_subprog_type, gnu_subprog_addr, gnu_subprog_call;
-  tree gnu_stub_param, gnu_arg_types, gnu_param;
+  tree gnu_subprog_param, gnu_stub_param, gnu_param;
   tree gnu_stub_decl = DECL_FUNCTION_STUB (gnu_subprog);
   VEC(tree,gc) *gnu_param_vec = NULL;
 
@@ -3235,17 +3250,21 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
   /* Loop over the parameters of the stub and translate any of them
      passed by descriptor into a by reference one.  */
   for (gnu_stub_param = DECL_ARGUMENTS (gnu_stub_decl),
-       gnu_arg_types = TYPE_ARG_TYPES (gnu_subprog_type);
+       gnu_subprog_param = DECL_ARGUMENTS (gnu_subprog);
        gnu_stub_param;
        gnu_stub_param = TREE_CHAIN (gnu_stub_param),
-       gnu_arg_types = TREE_CHAIN (gnu_arg_types))
+       gnu_subprog_param = TREE_CHAIN (gnu_subprog_param))
     {
       if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
-	gnu_param
-	  = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
-				    gnu_stub_param,
-				    DECL_PARM_ALT_TYPE (gnu_stub_param),
-				    gnat_subprog);
+	{
+	  gcc_assert (DECL_BY_REF_P (gnu_subprog_param));
+	  gnu_param
+	    = convert_vms_descriptor (TREE_TYPE (gnu_subprog_param),
+				      gnu_stub_param,
+				      DECL_PARM_ALT_TYPE (gnu_stub_param),
+				      DECL_BY_DOUBLE_REF_P (gnu_subprog_param),
+				      gnat_subprog);
+	}
       else
 	gnu_param = gnu_stub_param;