From 6d21c8af174ff13abfce72ca8be40c1def60c53f Mon Sep 17 00:00:00 2001
From: Doug Rupp <rupp@adacore.com>
Date: Wed, 9 Apr 2008 07:29:49 +0000
Subject: [PATCH] decl.c (validate_size): Set minimum size for fat pointers
same as access types.
2008-04-09 Doug Rupp <rupp@adacore.com>
* decl.c (validate_size): Set minimum size for fat pointers same as
access types. Code clean ups.
* gmem.c (xstrdup32): New macro for 32bit dup on VMS, noop otherwise
(__gnat_gmem_a2l_initialize): Dup exename into 32 bit memory on VMS
* s-auxdec-vms_64.ads, s-auxdec.ads (Short_Address_Size): New constant
* s-crtl.ads (malloc32) New function, alias for malloc
(realloc32) New function, alias for realloc
* socket.c (__gnat_new_socket_set): Malloc fd_set in 32 bits on VMS
* utils2.c (build_call_alloc_dealloc): Return call to short malloc if
allocator size is 32 and default pointer size is 64.
(find_common_type): Document assumption on t1/t2 vs lhs/rhs. Force use of
lhs type if smaller, whatever the modes.
* gigi.h (malloc32_decl): New macro definition
* utils.c (init_gigi_decls): New malloc32_decl
Various code clean ups.
* s-asthan-vms-alpha.adb (Process_AST.To_Address): Unchecked convert to
Task_Address vice System.Address.
* s-taspri-vms.ads: Import System.Aux_DEC
(Task_Address): New subtype of System.Aux_DEC.Short_Address
(Task_Address_Size): New constant size of System.Aux_DEC.Short_Address
* s-asthan-vms-alpha.adb (Process_AST.To_Address): Unchecked convert to
Task_Address vice System.Address.
* s-inmaop-vms.adb: Import System.Task_Primitives
(To_Address): Unchecked convert to Task_Address vice System.Address
* s-taprop-vms.adb (Timed_Delay): Always set the timer even if delay
expires now.
(To_Task_ID) Unchecked convert from Task_Adddress vice System.Address
(To_Address) Unchecked convert to Task_Address vice System.Address
* s-tpopde-vms.adb: Remove unnecessary warning pragmas
* g-socthi-vms.ads: Add 32bit size clauses on socket access types.
From-SVN: r134131
---
gcc/ada/ChangeLog | 47 ++++++++++++++++++++++++++++++++++
gcc/ada/decl.c | 10 +++-----
gcc/ada/g-socthi-vms.ads | 6 ++++-
gcc/ada/gigi.h | 5 ++++
gcc/ada/gmem.c | 15 ++++++++---
gcc/ada/s-asthan-vms-alpha.adb | 8 +++---
gcc/ada/s-auxdec-vms_64.ads | 9 ++++---
gcc/ada/s-inmaop-vms.adb | 4 ++-
gcc/ada/s-taprop-vms.adb | 8 +++---
gcc/ada/s-tpopde-vms.adb | 7 +----
gcc/ada/socket.c | 7 ++++-
gcc/ada/utils.c | 12 +++++++++
gcc/ada/utils2.c | 9 ++++++-
13 files changed, 117 insertions(+), 30 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 716f1bd37dfe..fe17591183e0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+2008-04-09 Doug Rupp <rupp@adacore.com>
+
+ * decl.c (validate_size): Set minimum size for fat pointers same as
+ access types. Code clean ups.
+
+ * gmem.c (xstrdup32): New macro for 32bit dup on VMS, noop otherwise
+ (__gnat_gmem_a2l_initialize): Dup exename into 32 bit memory on VMS
+
+ * s-auxdec-vms_64.ads, s-auxdec.ads (Short_Address_Size): New constant
+
+ * s-crtl.ads (malloc32) New function, alias for malloc
+ (realloc32) New function, alias for realloc
+
+ * socket.c (__gnat_new_socket_set): Malloc fd_set in 32 bits on VMS
+
+ * utils2.c (build_call_alloc_dealloc): Return call to short malloc if
+ allocator size is 32 and default pointer size is 64.
+ (find_common_type): Document assumption on t1/t2 vs lhs/rhs. Force use of
+ lhs type if smaller, whatever the modes.
+
+ * gigi.h (malloc32_decl): New macro definition
+
+ * utils.c (init_gigi_decls): New malloc32_decl
+ Various code clean ups.
+
+ * s-asthan-vms-alpha.adb (Process_AST.To_Address): Unchecked convert to
+ Task_Address vice System.Address.
+
+ * s-taspri-vms.ads: Import System.Aux_DEC
+ (Task_Address): New subtype of System.Aux_DEC.Short_Address
+ (Task_Address_Size): New constant size of System.Aux_DEC.Short_Address
+
+ * s-asthan-vms-alpha.adb (Process_AST.To_Address): Unchecked convert to
+ Task_Address vice System.Address.
+
+ * s-inmaop-vms.adb: Import System.Task_Primitives
+ (To_Address): Unchecked convert to Task_Address vice System.Address
+
+ * s-taprop-vms.adb (Timed_Delay): Always set the timer even if delay
+ expires now.
+ (To_Task_ID) Unchecked convert from Task_Adddress vice System.Address
+ (To_Address) Unchecked convert to Task_Address vice System.Address
+
+ * s-tpopde-vms.adb: Remove unnecessary warning pragmas
+
+ * g-socthi-vms.ads: Add 32bit size clauses on socket access types.
+
2008-04-08 Eric Botcazou <ebotcazou@adacore.com>
* gigi.h (standard_datatypes): Add ADT_fdesc_type and ADT_null_fdesc.
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index aca69ff84a38..eabc9211e196 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -6852,15 +6852,13 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size);
/* Modify the size of the type to be that of the maximum size if it has a
- discriminant or the size of a thin pointer if this is a fat pointer. */
+ discriminant. */
if (type_size && CONTAINS_PLACEHOLDER_P (type_size))
type_size = max_size (type_size, true);
- else if (TYPE_FAT_POINTER_P (gnu_type))
- type_size = bitsize_int (POINTER_SIZE);
- /* If this is an access type, the minimum size is that given by the smallest
- integral mode that's valid for pointers. */
- if (TREE_CODE (gnu_type) == POINTER_TYPE)
+ /* If this is an access type or a fat pointer, the minimum size is that given
+ by the smallest integral mode that's valid for pointers. */
+ if ((TREE_CODE (gnu_type) == POINTER_TYPE) || TYPE_FAT_POINTER_P (gnu_type))
{
enum machine_mode p_mode;
diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads
index b55a58d3757c..b2af2ca020b7 100644
--- a/gcc/ada/g-socthi-vms.ads
+++ b/gcc/ada/g-socthi-vms.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2007, AdaCore --
+-- Copyright (C) 2002-2008, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -151,6 +151,7 @@ package GNAT.Sockets.Thin is
-- Socket address
type Sockaddr_Access is access all Sockaddr;
+ for Sockaddr_Access'Size use 32;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
@@ -164,6 +165,7 @@ package GNAT.Sockets.Thin is
-- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In;
+ for Sockaddr_In_Access'Size use 32;
pragma Convention (C, Sockaddr_In_Access);
-- Access to internet socket address
@@ -203,6 +205,7 @@ package GNAT.Sockets.Thin is
-- Host entry
type Hostent_Access is access all Hostent;
+ for Hostent_Access'Size use 32;
pragma Convention (C, Hostent_Access);
-- Access to host entry
@@ -216,6 +219,7 @@ package GNAT.Sockets.Thin is
-- Service entry
type Servent_Access is access all Servent;
+ for Servent_Access'Size use 32;
pragma Convention (C, Servent_Access);
-- Access to service entry
diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h
index 59a17ab66af6..4ca53df75300 100644
--- a/gcc/ada/gigi.h
+++ b/gcc/ada/gigi.h
@@ -379,7 +379,11 @@ enum standard_datatypes
/* Null pointer for above type */
ADT_null_fdesc,
+ /* Function declaration nodes for run-time functions for allocating memory.
+ Ada allocators cause calls to these functions to be generated. Malloc32
+ is used only on 64bit systems needing to allocate 32bit memory. */
ADT_malloc_decl,
+ ADT_malloc32_decl,
/* Likewise for freeing memory. */
ADT_free_decl,
@@ -413,6 +417,7 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
#define fdesc_type_node gnat_std_decls[(int) ADT_fdesc_type]
#define null_fdesc_node gnat_std_decls[(int) ADT_null_fdesc]
#define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
+#define malloc32_decl gnat_std_decls[(int) ADT_malloc32_decl]
#define free_decl gnat_std_decls[(int) ADT_free_decl]
#define jmpbuf_type gnat_std_decls[(int) ADT_jmpbuf_type]
#define jmpbuf_ptr_type gnat_std_decls[(int) ADT_jmpbuf_ptr_type]
diff --git a/gcc/ada/gmem.c b/gcc/ada/gmem.c
index b319993ea5ab..f19f77fca0b6 100644
--- a/gcc/ada/gmem.c
+++ b/gcc/ada/gmem.c
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 2000-2007, Free Software Foundation, Inc. *
+ * Copyright (C) 2000-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -50,6 +50,13 @@
*/
+#ifdef VMS
+#include <string.h>
+#define xstrdup32(S) strcpy ((__char_ptr32) _malloc32 (strlen (S) + 1), S)
+#else
+#define xstrdup32(S) S
+#endif
+
#include <stdio.h>
static FILE *gmemfile;
@@ -141,8 +148,10 @@ long long __gnat_gmem_initialize (char *dumpname)
void __gnat_gmem_a2l_initialize (char *exearg)
{
/* Resolve the executable filename to use in later invocations of
- the libaddr2line symbolization service. */
- exename = __gnat_locate_exec_on_path (exearg);
+ the libaddr2line symbolization service. Ensure that on VMS
+ exename is allocated in 32 bit memory for compatibility
+ with libaddr2line. */
+ exename = xstrdup32 (__gnat_locate_exec_on_path (exearg));
}
/* Read next allocation of deallocation information from the GMEM file and
diff --git a/gcc/ada/s-asthan-vms-alpha.adb b/gcc/ada/s-asthan-vms-alpha.adb
index b6b8395d498c..16e627d43e94 100644
--- a/gcc/ada/s-asthan-vms-alpha.adb
+++ b/gcc/ada/s-asthan-vms-alpha.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -545,16 +545,16 @@ package body System.AST_Handling is
-- from which we can obtain the task and entry number information.
function To_Address is new Ada.Unchecked_Conversion
- (ST.Task_Id, System.Address);
+ (ST.Task_Id, System.Task_Primitives.Task_Address);
begin
System.Machine_Code.Asm
- (Template => "addl $27,0,%0",
+ (Template => "addq $27,0,%0",
Outputs => AST_Handler_Data_Ref'Asm_Output ("=r", Handler_Data_Ptr),
Volatile => True);
System.Machine_Code.Asm
- (Template => "ldl $27,%0",
+ (Template => "ldq $27,%0",
Inputs => Descriptor_Ref'Asm_Input
("m", Handler_Data_Ptr.Original_Descriptor_Ref),
Volatile => True);
diff --git a/gcc/ada/s-auxdec-vms_64.ads b/gcc/ada/s-auxdec-vms_64.ads
index 9d55cb8f50e2..bb763667b5b2 100644
--- a/gcc/ada/s-auxdec-vms_64.ads
+++ b/gcc/ada/s-auxdec-vms_64.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -96,9 +96,10 @@ package System.Aux_DEC is
function "or" (Left, Right : Largest_Integer) return Largest_Integer;
function "xor" (Left, Right : Largest_Integer) return Largest_Integer;
- Address_Zero : constant Address;
- No_Addr : constant Address;
- Address_Size : constant := Standard'Address_Size;
+ Address_Zero : constant Address;
+ No_Addr : constant Address;
+ Address_Size : constant := Standard'Address_Size;
+ Short_Address_Size : constant := 32;
function "+" (Left : Address; Right : Integer) return Address;
function "+" (Left : Integer; Right : Address) return Address;
diff --git a/gcc/ada/s-inmaop-vms.adb b/gcc/ada/s-inmaop-vms.adb
index 34eaf09547dc..7d6a45b5dbac 100644
--- a/gcc/ada/s-inmaop-vms.adb
+++ b/gcc/ada/s-inmaop-vms.adb
@@ -38,6 +38,7 @@ with System.Aux_DEC;
with System.Parameters;
with System.Tasking;
with System.Tasking.Initialization;
+with System.Task_Primitives;
with System.Task_Primitives.Operations;
with System.Task_Primitives.Operations.DEC;
@@ -51,7 +52,8 @@ package body System.Interrupt_Management.Operations is
use type unsigned_short;
function To_Address is
- new Ada.Unchecked_Conversion (Task_Id, System.Address);
+ new Ada.Unchecked_Conversion
+ (Task_Id, System.Task_Primitives.Task_Address);
package POP renames System.Task_Primitives.Operations;
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index f1be10194a46..544fa13bdeb6 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -131,10 +131,12 @@ package body System.Task_Primitives.Operations is
-----------------------
function To_Task_Id is
- new Ada.Unchecked_Conversion (System.Address, Task_Id);
+ new Ada.Unchecked_Conversion
+ (System.Task_Primitives.Task_Address, Task_Id);
function To_Address is
- new Ada.Unchecked_Conversion (Task_Id, System.Address);
+ new Ada.Unchecked_Conversion
+ (Task_Id, System.Task_Primitives.Task_Address);
function Get_Exc_Stack_Addr return Address;
-- Replace System.Soft_Links.Get_Exc_Stack_Addr_NT
@@ -519,7 +521,7 @@ package body System.Task_Primitives.Operations is
if Time /= 0.0 or else Mode /= Relative then
Sleep_Time := To_OS_Time (Time, Mode);
- if Mode = Relative or else OS_Clock < Sleep_Time then
+ if Mode = Relative or else OS_Clock <= Sleep_Time then
Self_ID.Common.State := Delay_Sleep;
Self_ID.Common.LL.AST_Pending := True;
diff --git a/gcc/ada/s-tpopde-vms.adb b/gcc/ada/s-tpopde-vms.adb
index c222c0cdad9f..e552efa56991 100644
--- a/gcc/ada/s-tpopde-vms.adb
+++ b/gcc/ada/s-tpopde-vms.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -69,17 +69,12 @@ package body System.Task_Primitives.Operations.DEC is
-- Local Subprograms --
-----------------------
- pragma Warnings (Off);
- -- Task_Id is 64 bits wide (but only 32 bits significant) on Integrity/VMS
-
function To_Unsigned_Longword is new
Ada.Unchecked_Conversion (Task_Id, Unsigned_Longword);
function To_Task_Id is new
Ada.Unchecked_Conversion (Unsigned_Longword, Task_Id);
- pragma Warnings (On);
-
function To_FAB_RAB is new
Ada.Unchecked_Conversion (Address, FAB_RAB_Access_Type);
diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c
index 53620c4e1a7b..f88ed8cdd07b 100644
--- a/gcc/ada/socket.c
+++ b/gcc/ada/socket.c
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 2003-2007, Free Software Foundation, Inc. *
+ * Copyright (C) 2003-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -340,7 +340,12 @@ __gnat_new_socket_set (fd_set *set)
{
fd_set *new;
+#ifdef VMS
+extern void *__gnat_malloc32 (__SIZE_TYPE__);
+ new = (fd_set *) __gnat_malloc32 (sizeof (fd_set));
+#else
new = (fd_set *) __gnat_malloc (sizeof (fd_set));
+#endif
if (set)
memcpy (new, set, sizeof (fd_set));
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 76f4aabbb262..01aa7522b035 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -584,6 +584,18 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
Empty);
DECL_IS_MALLOC (malloc_decl) = 1;
+ /* malloc32 is a function declaration tree for a function to allocate
+ 32bit memory on a 64bit system. Needed only on 64bit VMS. */
+ malloc32_decl = create_subprog_decl (get_identifier ("__gnat_malloc32"),
+ NULL_TREE,
+ build_function_type (ptr_void_type_node,
+ tree_cons (NULL_TREE,
+ sizetype,
+ endlink)),
+ NULL_TREE, false, true, true, NULL,
+ Empty);
+ DECL_IS_MALLOC (malloc32_decl) = 1;
+
/* free is a function declaration tree for a function to free memory. */
free_decl
= create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c
index 170fad7fac1b..a380d4498bc2 100644
--- a/gcc/ada/utils2.c
+++ b/gcc/ada/utils2.c
@@ -1918,7 +1918,14 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
{
if (Nkind (gnat_node) != N_Allocator || !Comes_From_Source (gnat_node))
Check_No_Implicit_Heap_Alloc (gnat_node);
- return build_call_1_expr (malloc_decl, gnu_size);
+
+ /* 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 (UI_To_Int (Esize (Etype (gnat_node))) == 32 && POINTER_SIZE == 64)
+ return build_call_1_expr (malloc32_decl, gnu_size);
+ else
+ return build_call_1_expr (malloc_decl, gnu_size);
}
}
--
GitLab