From 6d21c8af174ff13abfce72ca8be40c1def60c53f Mon Sep 17 00:00:00 2001 From: Doug Rupp 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 * 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 716f1bd..fe17591 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,50 @@ +2008-04-09 Doug Rupp + + * 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 * 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 aca69ff..eabc921 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 b55a58d..b2af2ca 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 59a17ab..4ca53df 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 b319993..f19f77f 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 +#define xstrdup32(S) strcpy ((__char_ptr32) _malloc32 (strlen (S) + 1), S) +#else +#define xstrdup32(S) S +#endif + #include 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 b6b8395..16e627d 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 9d55cb8..bb76366 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 34eaf09..7d6a45b 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 f1be101..544fa13 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 c222c0c..e552efa 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 53620c4..f88ed8c 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 76f4aab..01aa752 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 170fad7..a380d44 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); } } -- 2.7.4