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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 72bbd6b393c92149b96dbafcda056406034da4f7..19f9e38504219b405e87b2960d60d105a25129ff 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index c9e90457803e18ffa675ef79ab0ae537cc080072..a136f96bcc81a38e0a8d243158cb29dcaa3d3c48 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 1b3fa24137c17e687a636ff8e2dc3862c74aeb66..e1c2fe923c9471aeaa5826ef9c7db8cfdee47d31 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/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
+

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 84d5a587f5bd92194146c985c31c3d2739d1ce4d..0462426251f76935247bd293b0d6a5001109fa06 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/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);