Commit 5b9c3fc4 by Arnaud Charlet

[multiple changes]

2010-06-23  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb: Minor reformatting.

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.
	* opt.ads (Heap_Size): New global variable.
	* gcc-interface/utils2.c (maybe_wrap_malloc): Remove mostly redundant 
	TARGET_MALLOC64 check. Fix comment.

From-SVN: r161243
parent 13d923cc
2010-06-23 Robert Dewar <dewar@adacore.com> 2010-06-23 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb: Minor reformatting.
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.
* opt.ads (Heap_Size): New global variable.
* gcc-interface/utils2.c (maybe_wrap_malloc): Remove mostly redundant
TARGET_MALLOC64 check. Fix comment.
2010-06-23 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb, exp_ch4.adb, s-rannum.ads, sem.adb, sem_ch12.adb: Minor * sem_ch6.adb, exp_ch4.adb, s-rannum.ads, sem.adb, sem_ch12.adb: Minor
reformatting. Add comments. reformatting. Add comments.
* errout.adb (Finalize): Properly adjust warning count when deleting * errout.adb (Finalize): Properly adjust warning count when deleting
......
...@@ -111,6 +111,7 @@ package body Bindgen is ...@@ -111,6 +111,7 @@ package body Bindgen is
-- Main_Priority : Integer; -- Main_Priority : Integer;
-- Time_Slice_Value : Integer; -- Time_Slice_Value : Integer;
-- Heap_Size : Natural;
-- WC_Encoding : Character; -- WC_Encoding : Character;
-- Locking_Policy : Character; -- Locking_Policy : Character;
-- Queuing_Policy : Character; -- Queuing_Policy : Character;
...@@ -136,6 +137,10 @@ package body Bindgen is ...@@ -136,6 +137,10 @@ package body Bindgen is
-- A value of zero indicates that time slicing should be suppressed. If no -- 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. -- 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 -- WC_Encoding shows the wide character encoding method used for the main
-- program. This is one of the encoding letters defined in -- program. This is one of the encoding letters defined in
-- System.WCh_Con.WC_Encoding_Letters. -- System.WCh_Con.WC_Encoding_Letters.
...@@ -615,6 +620,15 @@ package body Bindgen is ...@@ -615,6 +620,15 @@ package body Bindgen is
WBI (" Features_Set : Integer;"); WBI (" Features_Set : Integer;");
WBI (" pragma Import (C, Features_Set, " & WBI (" pragma Import (C, Features_Set, " &
"""__gnat_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; end if;
-- Initialize stack limit variable of the environment task if the -- Initialize stack limit variable of the environment task if the
...@@ -786,7 +800,18 @@ package body Bindgen is ...@@ -786,7 +800,18 @@ package body Bindgen is
WBI (" if Features_Set = 0 then"); WBI (" if Features_Set = 0 then");
WBI (" Set_Features;"); WBI (" Set_Features;");
WBI (" end if;"); 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;
end if; end if;
-- Generate call to set Initialize_Scalar values if active -- Generate call to set Initialize_Scalar values if active
......
...@@ -116,6 +116,11 @@ package body Bindusg is ...@@ -116,6 +116,11 @@ package body Bindusg is
Write_Line (" -h Output this usage (help) information"); 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 -- Lines for -I switch
Write_Line (" -Idir Specify library and source files search path"); Write_Line (" -Idir Specify library and source files search path");
......
...@@ -1823,13 +1823,12 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node) ...@@ -1823,13 +1823,12 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
tree malloc_ptr; tree malloc_ptr;
/* On VMS, if 64-bit memory is disabled or pointers are 64-bit and the /* On VMS, if pointers are 64-bit and the allocator size is 32-bit or
allocator size is 32-bit or Convention C, allocate 32-bit memory. */ Convention C, allocate 32-bit memory. */
if (TARGET_ABI_OPEN_VMS if (TARGET_ABI_OPEN_VMS
&& (!TARGET_MALLOC64 && (POINTER_SIZE == 64
|| (POINTER_SIZE == 64 && (UI_To_Int (Esize (Etype (gnat_node))) == 32
&& (UI_To_Int (Esize (Etype (gnat_node))) == 32 || Convention (Etype (gnat_node)) == Convention_C)))
|| Convention (Etype (gnat_node)) == Convention_C))))
malloc_ptr = build_call_1_expr (malloc32_decl, size_to_malloc); malloc_ptr = build_call_1_expr (malloc32_decl, size_to_malloc);
else else
malloc_ptr = build_call_1_expr (malloc_decl, size_to_malloc); malloc_ptr = build_call_1_expr (malloc_decl, size_to_malloc);
......
...@@ -1568,15 +1568,18 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext) ...@@ -1568,15 +1568,18 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
#endif #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;}; struct feature {char *name; int* gl_addr;};
/* Default values for GNAT features set by environment. */ /* 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 */ /* Array feature logical names and global variable addresses */
static struct feature features[] = { static struct feature features[] = {
{"GNAT$NO_MALLOC_64", &__gl_no_malloc_64}, {"GNAT$NO_MALLOC_64", &__gl_heap_size},
{0, 0} {0, 0}
}; };
...@@ -1607,10 +1610,14 @@ void __gnat_set_features () ...@@ -1607,10 +1610,14 @@ void __gnat_set_features ()
else else
strcpy (buff, ""); strcpy (buff, "");
if (strcmp (buff, "ENABLE") == 0) if ((strcmp (buff, "ENABLE") == 0) ||
*features [i].gl_addr = 1; (strcmp (buff, "TRUE") == 0) ||
else if (strcmp (buff, "DISABLE") == 0) (strcmp (buff, "1") == 0))
*features [i].gl_addr = 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; __gnat_features_set = 1;
......
...@@ -585,6 +585,11 @@ package Opt is ...@@ -585,6 +585,11 @@ package Opt is
-- GNAT -- GNAT
-- True if compiling in GNAT system mode (-gnatg switch) -- 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; HLO_Active : Boolean := False;
-- GNAT -- GNAT
-- True if High Level Optimizer is activated (-gnatH switch) -- True if High Level Optimizer is activated (-gnatH switch)
......
...@@ -98,7 +98,7 @@ package body Sem_Ch6 is ...@@ -98,7 +98,7 @@ package body Sem_Ch6 is
----------------------- -----------------------
procedure Analyze_Return_Statement (N : Node_Id); procedure Analyze_Return_Statement (N : Node_Id);
-- Common processing for simple_ and extended_return_statements -- Common processing for simple and extended return statements
procedure Analyze_Function_Return (N : Node_Id); procedure Analyze_Function_Return (N : Node_Id);
-- Subsidiary to Analyze_Return_Statement. Called when the return statement -- Subsidiary to Analyze_Return_Statement. Called when the return statement
...@@ -106,7 +106,7 @@ package body Sem_Ch6 is ...@@ -106,7 +106,7 @@ package body Sem_Ch6 is
procedure Analyze_Return_Type (N : Node_Id); procedure Analyze_Return_Type (N : Node_Id);
-- Subsidiary to Process_Formals: analyze subtype mark in function -- Subsidiary to Process_Formals: analyze subtype mark in function
-- specification, in a context where the formals are visible and hide -- specification in a context where the formals are visible and hide
-- outer homographs. -- outer homographs.
procedure Analyze_Subprogram_Body_Helper (N : Node_Id); procedure Analyze_Subprogram_Body_Helper (N : Node_Id);
......
...@@ -271,6 +271,19 @@ package body Switch.B is ...@@ -271,6 +271,19 @@ package body Switch.B is
Ptr := Ptr + 1; Ptr := Ptr + 1;
Usage_Requested := True; 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 -- Processing for i switch
when 'i' => when 'i' =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment