decl.c (gnat_to_gnu_param): Force 32bit descriptor if TARGET_MALLOC64 clear.

2008-08-06  Doug Rupp  <rupp@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_param): Force 32bit descriptor if
	TARGET_MALLOC64 clear.

	* gcc-interface/utils2.c (build_call_alloc_dealloc): Force 32bit malloc
	if TARGET_MALLOC64 clear.

	* gcc-interface/gigi.h (TARGET_ABI_OPEN_VMS): Move here from utils2.c
	(TARGET_MALLC64): New macro. Default to clear.

From-SVN: r138768

gcc/ada/ChangeLog

 2008-08-06  Doug Rupp  <rupp@adacore.com>
 
+	* gcc-interface/decl.c (gnat_to_gnu_param): Force 32bit descriptor if
+	TARGET_MALLOC64 clear.
+
+	* gcc-interface/utils2.c (build_call_alloc_dealloc): Force 32bit malloc
+	if TARGET_MALLOC64 clear.
+
+	* gcc-interface/gigi.h (TARGET_ABI_OPEN_VMS): Move here from utils2.c
+	(TARGET_MALLC64): New macro. Default to clear.
+
+2008-08-06  Doug Rupp  <rupp@adacore.com>
+
 	* gcc-interface/utils2.c (snames.h) Include
 	(TARGET_ABI_OPEN_VMS): Initialize.
 	(build_call_alloc_dealloc); [TARGET_ABI_OPEN_VMS] Allocate on 32bit heap

gcc/ada/gcc-interface/decl.c

@@ -4842,7 +4842,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
       = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type))));
 
   /* VMS descriptors are themselves passed by reference.  */
-  if (mech == By_Descriptor)
+  if (mech == By_Short_Descriptor ||
+      (mech == By_Descriptor && TARGET_ABI_OPEN_VMS && !TARGET_MALLOC64))
+    gnu_param_type
+      = build_pointer_type (build_vms_descriptor32 (gnu_param_type,
+						    Mechanism (gnat_param),
+						    gnat_subprog));
+  else if (mech == By_Descriptor)
     {
       /* Build both a 32-bit and 64-bit descriptor, one of which will be
 	 chosen in fill_vms_descriptor.  */
@@ -4855,11 +4861,6 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
 						    Mechanism (gnat_param),
 						    gnat_subprog));
     }
-  else if (mech == By_Short_Descriptor)
-    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

gcc/ada/gcc-interface/gigi.h

@@ -913,3 +913,17 @@ extern Nat get_words_be (void);
 extern Nat get_bytes_be (void);
 extern Nat get_bits_be (void);
 extern Nat get_strict_alignment (void);
+
+/* Let code know whether we are targetting VMS without need of
+   intrusive preprocessor directives.  */
+#ifndef TARGET_ABI_OPEN_VMS
+#define TARGET_ABI_OPEN_VMS 0
+#endif
+
+/* VMS macro set by default, when clear forces 32bit mallocs and 32bit
+   Descriptors. Always used in combination with TARGET_ABI_OPEN_VMS
+   so no effect on non-VMS systems. */
+#ifndef TARGET_MALLOC64
+#define TARGET_MALLOC64 0
+#endif
+

gcc/ada/gcc-interface/utils2.c

@@ -47,12 +47,6 @@
 #include "gigi.h"
 #include "snames.h"
 
-/* Let code below know whether we are targetting VMS without need of
-   intrusive preprocessor directives.  */
-#ifndef TARGET_ABI_OPEN_VMS
-#define TARGET_ABI_OPEN_VMS 0
-#endif
-
 static tree find_common_type (tree, tree);
 static bool contains_save_expr_p (tree);
 static tree contains_null_expr (tree);
@@ -1957,9 +1951,11 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
       /* If the allocator size is 32bits but the pointer size is 64bits then
 	 allocate 32bit memory (sometimes necessary on 64bit VMS). Otherwise
 	 default to standard malloc. */
-      if (TARGET_ABI_OPEN_VMS && POINTER_SIZE == 64
-	  && (UI_To_Int (Esize (Etype (gnat_node))) == 32
-	      || Convention (Etype (gnat_node)) == Convention_C))
+      if (TARGET_ABI_OPEN_VMS &&
+          (!TARGET_MALLOC64 ||
+           (POINTER_SIZE == 64
+	    && (UI_To_Int (Esize (Etype (gnat_node))) == 32
+	        || Convention (Etype (gnat_node)) == Convention_C))))
         return build_call_1_expr (malloc32_decl, gnu_size);
       else
         return build_call_1_expr (malloc_decl, gnu_size);