From 40486f926ce9f5c09d6211244c2d8dc46b94f03f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 17 Jun 2020 07:41:34 -0400 Subject: [PATCH] [Ada] AI12-0385 Predefined shifts and rotates should be static gcc/ada/ * Makefile.rtl: Add target pair for interfac.ads. * libgnat/interfac.ads: Add a comment. * libgnat/interfac__2020.ads: New, used for bootstrap purposes. * sem_util.adb (Is_Static_Function): Always return False for pre Ada 2020 to e.g. ignore the Static aspect in Interfaces for Ada < 2020. --- gcc/ada/Makefile.rtl | 3 + gcc/ada/libgnat/interfac.ads | 2 + gcc/ada/libgnat/interfac__2020.ads | 198 +++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.adb | 13 ++- 4 files changed, 212 insertions(+), 4 deletions(-) create mode 100644 gcc/ada/libgnat/interfac__2020.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index fc978a2..62fbd55 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -2618,6 +2618,9 @@ ifeq ($(strip $(filter-out linux%,$(target_os))),) g-sercom.adb. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the runtime version of this unit (not used during GNAT build) + +package Interfaces is + pragma No_Elaboration_Code_All; + pragma Pure; + + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + + type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1; + for Integer_8'Size use 8; + + type Integer_16 is range -2 ** 15 .. 2 ** 15 - 1; + for Integer_16'Size use 16; + + type Integer_32 is range -2 ** 31 .. 2 ** 31 - 1; + for Integer_32'Size use 32; + + type Integer_64 is new Long_Long_Integer; + for Integer_64'Size use 64; + -- Note: we use Long_Long_Integer'First instead of -2 ** 63 to allow this + -- unit to compile when using custom target configuration files where the + -- maximum integer is 32 bits. This is useful for static analysis tools + -- such as SPARK or CodePeer. In the normal case Long_Long_Integer is + -- always 64-bits so we get the desired 64-bit type. + + type Unsigned_8 is mod 2 ** 8; + for Unsigned_8'Size use 8; + + type Unsigned_16 is mod 2 ** 16; + for Unsigned_16'Size use 16; + + type Unsigned_24 is mod 2 ** 24; + for Unsigned_24'Size use 24; + -- Declare this type for compatibility with legacy Ada compilers. + -- This is particularly useful in the context of CodePeer analysis. + + type Unsigned_32 is mod 2 ** 32; + for Unsigned_32'Size use 32; + + type Unsigned_64 is mod 2 ** Long_Long_Integer'Size; + for Unsigned_64'Size use 64; + -- See comment on Integer_64 above + + function Shift_Left + (Value : Unsigned_8; + Amount : Natural) return Unsigned_8 + with Import, Convention => Intrinsic, Static; + + function Shift_Right + (Value : Unsigned_8; + Amount : Natural) return Unsigned_8 + with Import, Convention => Intrinsic, Static; + + function Shift_Right_Arithmetic + (Value : Unsigned_8; + Amount : Natural) return Unsigned_8 + with Import, Convention => Intrinsic, Static; + + function Rotate_Left + (Value : Unsigned_8; + Amount : Natural) return Unsigned_8 + with Import, Convention => Intrinsic, Static; + + function Rotate_Right + (Value : Unsigned_8; + Amount : Natural) return Unsigned_8 + with Import, Convention => Intrinsic, Static; + + function Shift_Left + (Value : Unsigned_16; + Amount : Natural) return Unsigned_16 + with Import, Convention => Intrinsic, Static; + + function Shift_Right + (Value : Unsigned_16; + Amount : Natural) return Unsigned_16 + with Import, Convention => Intrinsic, Static; + + function Shift_Right_Arithmetic + (Value : Unsigned_16; + Amount : Natural) return Unsigned_16 + with Import, Convention => Intrinsic, Static; + + function Rotate_Left + (Value : Unsigned_16; + Amount : Natural) return Unsigned_16 + with Import, Convention => Intrinsic, Static; + + function Rotate_Right + (Value : Unsigned_16; + Amount : Natural) return Unsigned_16 + with Import, Convention => Intrinsic, Static; + + function Shift_Left + (Value : Unsigned_32; + Amount : Natural) return Unsigned_32 + with Import, Convention => Intrinsic, Static; + + function Shift_Right + (Value : Unsigned_32; + Amount : Natural) return Unsigned_32 + with Import, Convention => Intrinsic, Static; + + function Shift_Right_Arithmetic + (Value : Unsigned_32; + Amount : Natural) return Unsigned_32 + with Import, Convention => Intrinsic, Static; + + function Rotate_Left + (Value : Unsigned_32; + Amount : Natural) return Unsigned_32 + with Import, Convention => Intrinsic, Static; + + function Rotate_Right + (Value : Unsigned_32; + Amount : Natural) return Unsigned_32 + with Import, Convention => Intrinsic, Static; + + function Shift_Left + (Value : Unsigned_64; + Amount : Natural) return Unsigned_64 + with Import, Convention => Intrinsic, Static; + + function Shift_Right + (Value : Unsigned_64; + Amount : Natural) return Unsigned_64 + with Import, Convention => Intrinsic, Static; + + function Shift_Right_Arithmetic + (Value : Unsigned_64; + Amount : Natural) return Unsigned_64 + with Import, Convention => Intrinsic, Static; + + function Rotate_Left + (Value : Unsigned_64; + Amount : Natural) return Unsigned_64 + with Import, Convention => Intrinsic, Static; + + function Rotate_Right + (Value : Unsigned_64; + Amount : Natural) return Unsigned_64 + with Import, Convention => Intrinsic, Static; + + -- IEEE Floating point types + + type IEEE_Float_32 is digits 6; + for IEEE_Float_32'Size use 32; + + type IEEE_Float_64 is digits 15; + for IEEE_Float_64'Size use 64; + + -- If there is an IEEE extended float available on the machine, we assume + -- that it is available as Long_Long_Float. + + -- Note: it is harmless, and explicitly permitted, to include additional + -- types in interfaces, so it is not wrong to have IEEE_Extended_Float + -- defined even if the extended format is not available. + + type IEEE_Extended_Float is new Long_Long_Float; + +end Interfaces; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a80cc5c..e126b43 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -18835,16 +18835,21 @@ package body Sem_Util is function Is_Static_Function (Subp : Entity_Id) return Boolean is begin - return Has_Aspect (Subp, Aspect_Static) + -- Always return False for pre Ada 2020 to e.g. ignore the Static + -- aspect in package Interfaces for Ada_Version < 2020 and also + -- for efficiency. + + return Ada_Version >= Ada_2020 + and then Has_Aspect (Subp, Aspect_Static) and then (No (Find_Value_Of_Aspect (Subp, Aspect_Static)) or else Is_True (Static_Boolean (Find_Value_Of_Aspect (Subp, Aspect_Static)))); end Is_Static_Function; - ------------------------------ - -- Is_Static_Function_Call -- - ------------------------------ + ----------------------------- + -- Is_Static_Function_Call -- + ----------------------------- function Is_Static_Function_Call (Call : Node_Id) return Boolean is function Has_All_Static_Actuals (Call : Node_Id) return Boolean; -- 2.7.4