* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134131
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
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;
-- --
-- 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- --
-- Socket address
type Sockaddr_Access is access all Sockaddr;
+ for Sockaddr_Access'Size use 32;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
-- 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
-- Host entry
type Hostent_Access is access all Hostent;
+ for Hostent_Access'Size use 32;
pragma Convention (C, Hostent_Access);
-- Access to host entry
-- Service entry
type Servent_Access is access all Servent;
+ for Servent_Access'Size use 32;
pragma Convention (C, Servent_Access);
-- Access to service entry
/* 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,
#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]
* *
* 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- *
*/
+#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;
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
-- --
-- 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- --
-- 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);
-- --
-- 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- --
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;
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;
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;
-----------------------
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
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;
-- --
-- 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- --
-- 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);
* *
* 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- *
{
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));
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,
{
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);
}
}
\f
OSDN Git Service
