ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.

	* gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.
	* gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify
	and adjust for above renaming.
	* gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new
	gnu_expr_alt_type parameter.  Convert the expression to it instead
	of changing its type in place.
	(build_function_stub): Adjust call to above function.

From-SVN: r138518

gcc/ada/ChangeLog

 2008-08-01  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE.
+	* gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify
+	and adjust for above renaming.
+	* gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new
+	gnu_expr_alt_type parameter.  Convert the expression to it instead
+	of changing its type in place.
+	(build_function_stub): Adjust call to above function.
+
+2008-08-01  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove dead
 	code.  Do not get full definition of deferred constants with address
 	clause for a use.  Do not ignore deferred constant definitions with

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

@@ -294,10 +294,10 @@ struct lang_type GTY(()) {tree t; };
 #define SET_DECL_FUNCTION_STUB(NODE, X) \
   SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X)
 
-/* In a PARM_DECL, points to the alternate TREE_TYPE */
-#define DECL_PARM_ALT(NODE) \
+/* In a PARM_DECL, points to the alternate TREE_TYPE.  */
+#define DECL_PARM_ALT_TYPE(NODE) \
   GET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE))
-#define SET_DECL_PARM_ALT(NODE, X) \
+#define SET_DECL_PARM_ALT_TYPE(NODE, X) \
   SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
 
 /* In a FIELD_DECL corresponding to a discriminant, contains the

gcc/ada/gcc-interface/decl.c

@@ -4841,11 +4841,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
     gnu_param_type
       = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type))));
 
-  /* VMS descriptors are themselves passed by reference.
-     Build both a 32bit and 64bit descriptor, one of which will be chosen
-     in fill_vms_descriptor. */
+  /* VMS descriptors are themselves passed by reference.  */
   if (mech == By_Descriptor)
     {
+      /* Build both a 32-bit and 64-bit descriptor, one of which will be
+	 chosen in fill_vms_descriptor.  */
       gnu_param_type_alt
         = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
 						      Mechanism (gnat_param),
@@ -4856,14 +4856,10 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
 						    gnat_subprog));
     }
   else if (mech == By_Short_Descriptor)
-    {
-      gnu_param_type_alt = NULL_TREE;
-
-      gnu_param_type
-        = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
+    gnu_param_type
+      = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
 						    Mechanism (gnat_param),
 						    gnat_subprog));
-    }
 
   /* Arrays are passed as pointers to element type for foreign conventions.  */
   else if (foreign
@@ -4961,8 +4957,9 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));
 
-  /* Save the alternate descriptor for later. */
-  SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt);
+  /* Save the alternate descriptor type, if any.  */
+  if (gnu_param_type_alt)
+    SET_DECL_PARM_ALT_TYPE (gnu_param, gnu_param_type_alt);
 
   /* If no Mechanism was specified, indicate what we're using, then
      back-annotate it.  */

gcc/ada/gcc-interface/utils.c

@@ -3564,54 +3564,45 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
     gcc_unreachable ();
 }
 
-/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a
-   regular pointer or fat pointer type.  GNAT_SUBPROG is the subprogram to
-   which the VMS descriptor is passed.  */
+/* 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.  */
 
 static tree
-convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
+convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type,
+			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 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo)));
-  tree is64bit;
-  tree save_type = TREE_TYPE (gnu_expr);
-  tree gnu_expr32, gnu_expr64;
+  tree is64bit, gnu_expr32, gnu_expr64;
 
+  /* 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)
-    /* If the field name is not MBO, it must be 32bit and no alternate */
     return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
 
-  /* Otherwise primary must be 64bit and alternate 32bit */
-
-  /* Test for 64bit descriptor */
+  /* Build the test for 64-bit descriptor.  */
   mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
   mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
-  is64bit = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
-            build_binary_op (EQ_EXPR, integer_type_node,
-                                convert (integer_type_node, mbo),
-                                integer_one_node),
-            build_binary_op (EQ_EXPR, integer_type_node,
-                                convert (integer_type_node, mbmo),
-                                integer_minus_one_node));
-
-  gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr,
-                                         gnat_subprog);
-  /* Convert 32bit alternate. Hack alert ??? */
-  TREE_TYPE (gnu_expr) = DECL_PARM_ALT (gnu_expr);
-  gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr,
-                                         gnat_subprog);
-  TREE_TYPE (gnu_expr) = save_type;
-
-  if (POINTER_TYPE_P (gnu_type))
-     return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
-
-  else if (TYPE_FAT_POINTER_P (gnu_type))
-      return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
-  else
-    gcc_unreachable ();
+  is64bit
+    = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+		       build_binary_op (EQ_EXPR, integer_type_node,
+					convert (integer_type_node, mbo),
+					integer_one_node),
+		       build_binary_op (EQ_EXPR, integer_type_node,
+					convert (integer_type_node, mbmo),
+					integer_minus_one_node));
+
+  /* Build the 2 possible end results.  */
+  gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog);
+  gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr);
+  gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
+
+  return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
 }
 
 /* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
@@ -3642,8 +3633,11 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
        gnu_arg_types = TREE_CHAIN (gnu_arg_types))
     {
       if (DECL_BY_DESCRIPTOR_P (gnu_stub_param))
-	gnu_param = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
-					    gnu_stub_param, gnat_subprog);
+	gnu_param
+	  = convert_vms_descriptor (TREE_VALUE (gnu_arg_types),
+				    gnu_stub_param,
+				    DECL_PARM_ALT_TYPE (gnu_stub_param),
+				    gnat_subprog);
       else
 	gnu_param = gnu_stub_param;