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
This commit is contained in:
Doug Rupp
Arnaud Charlet
parent
bcac2b894b
commit
6d21c8af17
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue