Patchwork [Ada] VMS 32/64bit heap handling

login
register
mail settings
Submitter Arnaud Charlet
Date June 23, 2010, 5:49 a.m.
Message ID <20100623054944.GA28719@adacore.com>
Download mbox | patch
Permalink /patch/56585/
State New
Headers show

Comments

Arnaud Charlet - June 23, 2010, 5:49 a.m.
VMS is a historically 32bit operating system in a 64bit world and
with the need to retain binary compatibility with old applications. The
stack remains forever 32bit but the heap can be either 32bit or 64bit. A
logical name (aka environment variable) is currently used to switch 
between, but was considered too coarse, so a binder switch is 
introduced: -Hnn where nn is 32 or 64 to lock an image to a particular 
heap regardless of the logical name setting.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-23  Doug Rupp  <rupp@adacore.com>

	* bindusg.adb (Display): Write -Hnn line.
	* bindgen.adb (Gen_Adainit_Ada): Write Heap_Size to binder file as 
	necessary.
	* init.c (__gl_heap_size): Rename from __gl_no_malloc_64 and change
	valid values to 32 and 64.
	(GNAT$NO_MALLOC_64): Recognize TRUE, 1, FALSE, and 0 in addition to
	ENABLE, DISABLE as valid settings.
	* switch-b.adb (Scan_Binder_Switches): Process -Hnn switch.
	* memtrack-vms_64.adb (Gnat_Heap_Size): Rename from Gnat_No_Malloc64
	and change valid values to 32 and 64.
	* s-memory-vms_64.adb (Gnat_Heap_Size): Likewise.
	* opt.ads (Heap_Size): New global variable.
	* gcc-interface/utils2.c (maybe_wrap_malloc): Remove mostly redundant 
	TARGET_MALLOC64 check. Fix comment.

Patch

Index: bindusg.adb
===================================================================
--- bindusg.adb	(revision 161161)
+++ bindusg.adb	(working copy)
@@ -116,6 +116,11 @@  package body Bindusg is
 
       Write_Line ("  -h        Output this usage (help) information");
 
+      --  Line for -H switch
+
+      Write_Line ("  -Hnn      Use nn bit heap where nn is 32 or 64 " &
+                  "(VMS Only)");
+
       --  Lines for -I switch
 
       Write_Line ("  -Idir     Specify library and source files search path");
Index: bindgen.adb
===================================================================
--- bindgen.adb	(revision 161159)
+++ bindgen.adb	(working copy)
@@ -111,6 +111,7 @@  package body Bindgen is
 
    --     Main_Priority                 : Integer;
    --     Time_Slice_Value              : Integer;
+   --     Heap_Size                     : Natural;
    --     WC_Encoding                   : Character;
    --     Locking_Policy                : Character;
    --     Queuing_Policy                : Character;
@@ -136,6 +137,10 @@  package body Bindgen is
    --  A value of zero indicates that time slicing should be suppressed. If no
    --  pragma is present, and no -T switch was used, the value is -1.
 
+   --  Heap_Size is the heap to use for memory allocations set by use of a
+   --  -Hnn parameter for the binder or by the GNAT$NO_MALLOC_64 logical.
+   --  Valid values are 32 and 64. This switch is only available on VMS.
+
    --  WC_Encoding shows the wide character encoding method used for the main
    --  program. This is one of the encoding letters defined in
    --  System.WCh_Con.WC_Encoding_Letters.
@@ -615,6 +620,15 @@  package body Bindgen is
             WBI ("      Features_Set : Integer;");
             WBI ("      pragma Import (C, Features_Set, " &
                  """__gnat_features_set"");");
+
+            if Opt.Heap_Size /= 0 then
+               WBI ("");
+               WBI ("      Heap_Size : Integer;");
+               WBI ("      pragma Import (C, Heap_Size, " &
+                    """__gl_heap_size"");");
+
+               Write_Statement_Buffer;
+            end if;
          end if;
 
          --  Initialize stack limit variable of the environment task if the
@@ -786,7 +800,18 @@  package body Bindgen is
             WBI ("      if Features_Set = 0 then");
             WBI ("         Set_Features;");
             WBI ("      end if;");
+
+            --  Features_Set may twiddle the heap size according to a logical
+            --  name, but the binder switch must override.
+
+            if Opt.Heap_Size /= 0 then
+               Set_String ("      Heap_Size := ");
+               Set_Int (Opt.Heap_Size);
+               Set_Char   (';');
+               Write_Statement_Buffer;
+            end if;
          end if;
+
       end if;
 
       --  Generate call to set Initialize_Scalar values if active
Index: init.c
===================================================================
--- init.c	(revision 161205)
+++ init.c	(working copy)
@@ -1568,15 +1568,18 @@  __gnat_adjust_context_for_raise (int sig
 
 #endif
 
-/* Feature logical name and global variable address pair */
+/* Feature logical name and global variable address pair.
+   If we ever add another feature logical to this list, the
+   feature struct will need to be enhanced to take into account
+   possible values for *gl_addr.  */
 struct feature {char *name; int* gl_addr;};
 
 /* Default values for GNAT features set by environment. */
-int __gl_no_malloc_64 = 0;
+int __gl_heap_size = 64;
 
 /* Array feature logical names and global variable addresses */
 static struct feature features[] = {
-  {"GNAT$NO_MALLOC_64", &__gl_no_malloc_64},
+  {"GNAT$NO_MALLOC_64", &__gl_heap_size},
   {0, 0}
 };
 
@@ -1607,10 +1610,14 @@  void __gnat_set_features ()
        else
          strcpy (buff, "");
 
-       if (strcmp (buff, "ENABLE") == 0)
-          *features [i].gl_addr = 1;
-       else if (strcmp (buff, "DISABLE") == 0)
-          *features [i].gl_addr = 0;
+       if ((strcmp (buff, "ENABLE") == 0) ||
+           (strcmp (buff, "TRUE") == 0) ||
+           (strcmp (buff, "1") == 0))
+          *features [i].gl_addr = 32;
+       else if ((strcmp (buff, "DISABLE") == 0) ||
+                (strcmp (buff, "FALSE") == 0) ||
+                (strcmp (buff, "0") == 0))
+          *features [i].gl_addr = 64;
     }
 
     __gnat_features_set = 1;
Index: switch-b.adb
===================================================================
--- switch-b.adb	(revision 161161)
+++ switch-b.adb	(working copy)
@@ -271,6 +271,19 @@  package body Switch.B is
             Ptr := Ptr + 1;
             Usage_Requested := True;
 
+         --  Processing for H switch
+
+         when 'H' =>
+            if Ptr = Max then
+               Bad_Switch (Switch_Chars);
+            end if;
+
+            Ptr := Ptr + 1;
+            Scan_Nat (Switch_Chars, Max, Ptr, Heap_Size, C);
+            if Heap_Size /= 32 and then Heap_Size /= 64 then
+               Bad_Switch (Switch_Chars);
+            end if;
+
          --  Processing for i switch
 
          when 'i' =>
Index: opt.ads
===================================================================
--- opt.ads	(revision 161183)
+++ opt.ads	(working copy)
@@ -585,6 +585,11 @@  package Opt is
    --  GNAT
    --  True if compiling in GNAT system mode (-gnatg switch)
 
+   Heap_Size : Nat := 0;
+   --  GNATBIND
+   --  Heap size for memory allocations. Valid values are 32 and 64. Only
+   --  available on VMS.
+
    HLO_Active : Boolean := False;
    --  GNAT
    --  True if High Level Optimizer is activated (-gnatH switch)
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 161073)
+++ gcc-interface/utils2.c	(working copy)
@@ -1823,13 +1823,12 @@  maybe_wrap_malloc (tree data_size, tree 
 
   tree malloc_ptr;
 
-  /* On VMS, if 64-bit memory is disabled or pointers are 64-bit and the
-     allocator size is 32-bit or Convention C, allocate 32-bit memory.  */
+  /* On VMS, if pointers are 64-bit and the allocator size is 32-bit or
+     Convention C, allocate 32-bit memory.  */
   if (TARGET_ABI_OPEN_VMS
-      && (!TARGET_MALLOC64
-	  || (POINTER_SIZE == 64
-	      && (UI_To_Int (Esize (Etype (gnat_node))) == 32
-		  || Convention (Etype (gnat_node)) == Convention_C))))
+      && (POINTER_SIZE == 64
+	     && (UI_To_Int (Esize (Etype (gnat_node))) == 32
+		 || Convention (Etype (gnat_node)) == Convention_C)))
     malloc_ptr = build_call_1_expr (malloc32_decl, size_to_malloc);
   else
     malloc_ptr = build_call_1_expr (malloc_decl, size_to_malloc);