From d8b3ccb951a6af120a84b92205ee6d80141eb5f6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 16:36:39 +0200 Subject: [PATCH] [multiple changes] 2011-08-01 Javier Miranda * sem_util.adb (Abstract_Interface_List): Complete condition when processing private type declarations to avoid reading unavailable attribute. (Is_Synchronized_Tagged_Type): Complete condition when processing private extension declaration nodes to avoid reading unavailable attribute. 2011-08-01 Thomas Quinot * sem_ch3.adb: Minor reformatting. 2011-08-01 Thomas Quinot * s-parame-ae653.ads, s-parame-vms-alpha.ads, s-parame-hpux.ads, i-cpoint.adb, i-cstrin.adb, i-cpoint.ads, i-cstrin.ads, s-parame-vms-ia64.ads, s-parame.ads, i-c.ads, s-parame-vxworks.ads, s-parame-vms-restrict.ads: Remove duplicated Interfaces.C.* packages for VMS, instead parametrize the common implementation with System.Parameters declarations. From-SVN: r177038 --- gcc/ada/ChangeLog | 22 ++++++++++++++++++++++ gcc/ada/i-c.ads | 6 +++--- gcc/ada/i-cpoint.adb | 6 ++++-- gcc/ada/i-cpoint.ads | 5 ++++- gcc/ada/i-cstrin.adb | 6 +++--- gcc/ada/i-cstrin.ads | 5 +++-- gcc/ada/s-parame-ae653.ads | 11 ++++++++++- gcc/ada/s-parame-hpux.ads | 11 ++++++++++- gcc/ada/s-parame-vms-alpha.ads | 13 ++++++++++++- gcc/ada/s-parame-vms-ia64.ads | 13 ++++++++++++- gcc/ada/s-parame-vms-restrict.ads | 13 ++++++++++++- gcc/ada/s-parame-vxworks.ads | 11 ++++++++++- gcc/ada/s-parame.ads | 11 ++++++++++- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_util.adb | 6 +++++- 15 files changed, 121 insertions(+), 20 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 88e6a37..49d6da6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2011-08-01 Javier Miranda + + * sem_util.adb (Abstract_Interface_List): Complete condition when + processing private type declarations to avoid reading unavailable + attribute. + (Is_Synchronized_Tagged_Type): Complete condition when processing + private extension declaration nodes to avoid reading unavailable + attribute. + +2011-08-01 Thomas Quinot + + * sem_ch3.adb: Minor reformatting. + +2011-08-01 Thomas Quinot + + * s-parame-ae653.ads, s-parame-vms-alpha.ads, s-parame-hpux.ads, + i-cpoint.adb, i-cstrin.adb, i-cpoint.ads, i-cstrin.ads, + s-parame-vms-ia64.ads, s-parame.ads, i-c.ads, s-parame-vxworks.ads, + s-parame-vms-restrict.ads: Remove duplicated Interfaces.C.* packages + for VMS, instead parametrize the common implementation with + System.Parameters declarations. + 2011-08-01 Eric Botcazou * gnat_rm.texi: Document limitation of Pragma No_Strict_Aliasing. diff --git a/gcc/ada/i-c.ads b/gcc/ada/i-c.ads index 9e98b05..1088836 100644 --- a/gcc/ada/i-c.ads +++ b/gcc/ada/i-c.ads @@ -54,10 +54,10 @@ package Interfaces.C is -- a non-private system.address type. type ptrdiff_t is - range -(2 ** (Standard'Address_Size - Integer'(1))) .. - +(2 ** (Standard'Address_Size - Integer'(1)) - 1); + range -(2 ** (System.Parameters.ptr_bits - Integer'(1))) .. + +(2 ** (System.Parameters.ptr_bits - Integer'(1)) - 1); - type size_t is mod 2 ** Standard'Address_Size; + type size_t is mod 2 ** System.Parameters.ptr_bits; -- Floating-Point diff --git a/gcc/ada/i-cpoint.adb b/gcc/ada/i-cpoint.adb index 0e6b320..6506448 100644 --- a/gcc/ada/i-cpoint.adb +++ b/gcc/ada/i-cpoint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -36,7 +36,7 @@ with Ada.Unchecked_Conversion; package body Interfaces.C.Pointers is - type Addr is mod Memory_Size; + type Addr is mod 2 ** System.Parameters.ptr_bits; function To_Pointer is new Ada.Unchecked_Conversion (Addr, Pointer); function To_Addr is new Ada.Unchecked_Conversion (Pointer, Addr); @@ -195,6 +195,7 @@ package body Interfaces.C.Pointers is subtype A is Element_Array (L .. H); type PA is access A; + for PA'Size use System.Parameters.ptr_bits; function To_PA is new Ada.Unchecked_Conversion (Pointer, PA); begin @@ -238,6 +239,7 @@ package body Interfaces.C.Pointers is subtype A is Element_Array (L .. H); type PA is access A; + for PA'Size use System.Parameters.ptr_bits; function To_PA is new Ada.Unchecked_Conversion (Pointer, PA); begin diff --git a/gcc/ada/i-cpoint.ads b/gcc/ada/i-cpoint.ads index 0535119..e6a8ae4 100644 --- a/gcc/ada/i-cpoint.ads +++ b/gcc/ada/i-cpoint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1993-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1993-2010, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -33,6 +33,8 @@ -- -- ------------------------------------------------------------------------------ +with System.Parameters; + generic type Index is (<>); type Element is private; @@ -43,6 +45,7 @@ package Interfaces.C.Pointers is pragma Preelaborate; type Pointer is access all Element; + for Pointer'Size use System.Parameters.ptr_bits; pragma No_Strict_Aliasing (Pointer); -- We turn off any strict aliasing assumptions for the pointer type, diff --git a/gcc/ada/i-cstrin.adb b/gcc/ada/i-cstrin.adb index e35ef36..8148946 100644 --- a/gcc/ada/i-cstrin.adb +++ b/gcc/ada/i-cstrin.adb @@ -42,10 +42,10 @@ package body Interfaces.C.Strings is -- this type will in fact be used for aliasing values of other types. function To_chars_ptr is - new Ada.Unchecked_Conversion (Address, chars_ptr); + new Ada.Unchecked_Conversion (System.Parameters.C_Address, chars_ptr); function To_Address is - new Ada.Unchecked_Conversion (chars_ptr, Address); + new Ada.Unchecked_Conversion (chars_ptr, System.Parameters.C_Address); ----------------------- -- Local Subprograms -- @@ -70,7 +70,7 @@ package body Interfaces.C.Strings is -- compatible, so we directly import here the malloc and free routines. function Memory_Alloc (Size : size_t) return chars_ptr; - pragma Import (C, Memory_Alloc, "__gnat_malloc"); + pragma Import (C, Memory_Alloc, System.Parameters.C_Malloc_Linkname); procedure Memory_Free (Address : chars_ptr); pragma Import (C, Memory_Free, "__gnat_free"); diff --git a/gcc/ada/i-cstrin.ads b/gcc/ada/i-cstrin.ads index 7bfee8f..bc6df77 100644 --- a/gcc/ada/i-cstrin.ads +++ b/gcc/ada/i-cstrin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1993-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1993-2010, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -37,6 +37,7 @@ package Interfaces.C.Strings is pragma Preelaborate; type char_array_access is access all char_array; + for char_array_access'Size use System.Parameters.ptr_bits; pragma No_Strict_Aliasing (char_array_access); -- Since this type is used for external interfacing, with the pointer @@ -91,7 +92,7 @@ package Interfaces.C.Strings is private type chars_ptr is access all Character; - pragma Convention (C, chars_ptr); + for chars_ptr'Size use System.Parameters.ptr_bits; pragma No_Strict_Aliasing (chars_ptr); -- Since this type is used for external interfacing, with the pointer diff --git a/gcc/ada/s-parame-ae653.ads b/gcc/ada/s-parame-ae653.ads index ceb2405..ae8a210 100644 --- a/gcc/ada/s-parame-ae653.ads +++ b/gcc/ada/s-parame-ae653.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -112,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame-hpux.ads b/gcc/ada/s-parame-hpux.ads index 38f8cb5..7bb22b0 100644 --- a/gcc/ada/s-parame-hpux.ads +++ b/gcc/ada/s-parame-hpux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -110,6 +110,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame-vms-alpha.ads b/gcc/ada/s-parame-vms-alpha.ads index 5e1d24e..308656c 100644 --- a/gcc/ada/s-parame-vms-alpha.ads +++ b/gcc/ada/s-parame-vms-alpha.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -46,6 +46,8 @@ -- Note: do not introduce any pragma Inline statements into this unit, since -- otherwise the relinking and rebinding capability would be deactivated. +with System.Aux_DEC; + package System.Parameters is pragma Pure; @@ -110,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := 32; + subtype C_Address is System.Short_Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc32"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame-vms-ia64.ads b/gcc/ada/s-parame-vms-ia64.ads index 029dfee..29ec808 100644 --- a/gcc/ada/s-parame-vms-ia64.ads +++ b/gcc/ada/s-parame-vms-ia64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -46,6 +46,8 @@ -- Note: do not introduce any pragma Inline statements into this unit, since -- otherwise the relinking and rebinding capability would be deactivated. +with System.Aux_DEC; + package System.Parameters is pragma Pure; @@ -110,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := 32; + subtype C_Address is System.Short_Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc32"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame-vms-restrict.ads b/gcc/ada/s-parame-vms-restrict.ads index 3456f24..7c3cbd6 100644 --- a/gcc/ada/s-parame-vms-restrict.ads +++ b/gcc/ada/s-parame-vms-restrict.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -46,6 +46,8 @@ -- Note: do not introduce any pragma Inline statements into this unit, since -- otherwise the relinking and rebinding capability would be deactivated. +with System.Aux_DEC; + package System.Parameters is pragma Pure; @@ -110,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := 32; + subtype C_Address is System.Short_Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc32"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame-vxworks.ads b/gcc/ada/s-parame-vxworks.ads index 411d67d..715eb04 100644 --- a/gcc/ada/s-parame-vxworks.ads +++ b/gcc/ada/s-parame-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -112,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/s-parame.ads b/gcc/ada/s-parame.ads index 2110034..526139f 100644 --- a/gcc/ada/s-parame.ads +++ b/gcc/ada/s-parame.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -112,6 +112,15 @@ package System.Parameters is -- is that this is the same as type Long_Integer, but this is not true -- of all targets. For example, in OpenVMS long /= Long_Integer. + ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; + -- Number of bits in Interaces.C pointers, normally a standard address, + -- except on 64-bit VMS where they are 32-bit addresses, for compatibility + -- with legacy code. + + C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + ---------------------------------------------- -- Behavior of Pragma Finalize_Storage_Only -- ---------------------------------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c44b4e7..c101d93 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1175,7 +1175,7 @@ package body Sem_Ch3 is -- In ASIS mode, the access_to_subprogram may be analyzed twice, -- when it is part of an unconstrained type and subtype expansion - -- is disabled. To avoid back-end problems with shared profiles, + -- is disabled. To avoid back-end problems with shared profiles, -- use previous subprogram type as the designated type. if ASIS_Mode diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b7cf370..f42c8ec 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -165,7 +165,10 @@ package body Sem_Util is Nod := Type_Definition (Parent (Typ)); elsif Nkind (Parent (Typ)) = N_Private_Type_Declaration then - if Present (Full_View (Typ)) then + if Present (Full_View (Typ)) + and then Nkind (Parent (Full_View (Typ))) + = N_Full_Type_Declaration + then Nod := Type_Definition (Parent (Full_View (Typ))); -- If the full-view is not available we cannot do anything else @@ -7335,6 +7338,7 @@ package body Sem_Util is and then Is_Synchronized_Interface (E)) or else (Ekind (E) = E_Record_Type_With_Private + and then Nkind (Parent (E)) = N_Private_Extension_Declaration and then (Synchronized_Present (Parent (E)) or else Is_Synchronized_Interface (Etype (E)))); end Is_Synchronized_Tagged_Type; -- 2.7.4