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

1 files changed, 34 insertions, 15 deletions

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 84eb1ae..6ee95b7 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/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;