From 43018f5892ff43551abad3f339bcb55cf74c89cf Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 14 Nov 2018 11:41:30 +0000 Subject: [PATCH] [Ada] Enhance constraints propagation to ease the work of optimizers This patch recognizes additional object declarations whose defining identifier is known statically to be valid. This allows additional optimizations to be performed by the front-end. Executing: gcc -c -gnatDG p.ads On the following sources: ---- with G; With Q; package P is Val : constant Positive := Q.Config_Value ("Size"); package My_G is new G (Val); end P; ---- generic Num : Natural := 0; package G is Multi : constant Boolean := Num > 0; type Info is array (True .. Multi) of Integer; type Arr is array (Natural range <>) of Boolean; type Rec (D : Natural) is record C : character; I : Info; E : Arr (0 .. D); end record; end G; ---- package Q is function Config_Value (S : String) return Integer; end Q; ---- Must yield (note that variable Multi has been statically optimized to true): ---- with g; with q; p_E : short_integer := 0; package p is p__R2s : constant integer := q.q__config_value ("Size"); [constraint_error when not (p__R2s >= 1) "range check failed"] p__val : constant positive := p__R2s; package p__my_g is p__my_g__num : constant natural := p__val; package p__my_g__g renames p__my_g; package p__my_g__gGH renames p__my_g__g; p__my_g__multi : constant boolean := true; type p__my_g__info is array (true .. p__my_g__multi) of integer; type p__my_g__arr is array (0 .. 16#7FFF_FFFF# range <>) of boolean; type p__my_g__rec (d : natural) is record c : character; i : p__my_g__info; e : p__my_g__arr (0 .. d); end record; [type p__my_g__TinfoB is array (true .. p__my_g__multi range <>) of integer] freeze p__my_g__TinfoB [ procedure p__my_g__TinfoBIP (_init : in out p__my_g__TinfoB) is begin null; return; end p__my_g__TinfoBIP; ] freeze p__my_g__info [] freeze p__my_g__arr [ procedure p__my_g__arrIP (_init : in out p__my_g__arr) is begin null; return; end p__my_g__arrIP; ] freeze p__my_g__rec [ procedure p__my_g__recIP (_init : in out p__my_g__rec; d : natural) is begin _init.d := d; null; return; end p__my_g__recIP; ] end p__my_g; package my_g is new g (p__val); end p; freeze_generic info [subtype TinfoD1 is boolean range true .. multi] freeze_generic TinfoD1 [type TinfoB is array (true .. multi range <>) of integer] freeze_generic TinfoB freeze_generic arr freeze_generic rec ---- 2018-11-14 Ed Schonberg gcc/ada/ * sem_ch3.adb (Analyze_Object_Declaration): Use the Actual_Subtype to preserve information about a constant initialized with a non-static entity that is known to be valid, when the type of the entity has a narrower range than that of the nominal subtype of the constant. * checks.adb (Determine_Range): If the expression is a constant entity that is known-valid and has a defined Actual_Subtype, use it to determine the actual bounds of the value, to enable additional optimizations. From-SVN: r266123 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/checks.adb | 13 ++++++++++++- gcc/ada/sem_ch3.adb | 32 ++++++++++++++++++++++++-------- 3 files changed, 48 insertions(+), 9 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c407793..3af7802 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2018-11-14 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declaration): Use the + Actual_Subtype to preserve information about a constant + initialized with a non-static entity that is known to be valid, + when the type of the entity has a narrower range than that of + the nominal subtype of the constant. + * checks.adb (Determine_Range): If the expression is a constant + entity that is known-valid and has a defined Actual_Subtype, use + it to determine the actual bounds of the value, to enable + additional optimizations. + 2018-11-14 Hristian Kirtchev * back_end.adb, checks.adb, exp_ch3.adb, exp_ch4.adb, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 6b9e654..89f26fa 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -722,7 +722,7 @@ package body Checks is -- Generate a check to raise PE if alignment may be inappropriate else - -- If the original expression is a non-static constant, use the name + -- If the original expression is a nonstatic constant, use the name -- of the constant itself rather than duplicating its initialization -- expression, which was extracted above. @@ -4563,6 +4563,17 @@ package body Checks is or else Assume_No_Invalid_Values or else Assume_Valid then + -- If this is a known valid constant with a nonstatic value, it may + -- have inherited a narrower subtype from its initial value; use this + -- saved subtype (see sem_ch3.adb). + + if Is_Entity_Name (N) + and then Ekind (Entity (N)) = E_Constant + and then Present (Actual_Subtype (Entity (N))) + then + Typ := Actual_Subtype (Entity (N)); + end if; + null; else Typ := Underlying_Type (Base_Type (Typ)); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 32797d8..fae1d5d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3657,7 +3657,7 @@ package body Sem_Ch3 is Prev_Entity : Entity_Id := Empty; procedure Check_Dynamic_Object (Typ : Entity_Id); - -- A library-level object with non-static discriminant constraints may + -- A library-level object with nonstatic discriminant constraints may -- require dynamic allocation. The declaration is illegal if the -- profile includes the restriction No_Implicit_Heap_Allocations. @@ -3672,7 +3672,7 @@ package body Sem_Ch3 is -- This function is called when a non-generic library level object of a -- task type is declared. Its function is to count the static number of -- tasks declared within the type (it is only called if Has_Task is set - -- for T). As a side effect, if an array of tasks with non-static bounds + -- for T). As a side effect, if an array of tasks with nonstatic bounds -- or a variant record type is encountered, Check_Restriction is called -- indicating the count is unknown. @@ -4357,8 +4357,24 @@ package body Sem_Ch3 is Set_Current_Value (Id, E); end if; - elsif Is_Scalar_Type (T) and then Is_OK_Static_Expression (E) then + elsif Is_Scalar_Type (T) + and then Is_OK_Static_Expression (E) + then + Set_Is_Known_Valid (Id); + + -- If it is a constant initialized with a valid nonstatic entity, + -- the constant is known valid as well, and can inherit the subtype + -- of the entity if it is a subtype of the given type. This info + -- is preserved on the actual subtype of the constant. + + elsif Is_Scalar_Type (T) + and then Is_Entity_Name (E) + and then Is_Known_Valid (Entity (E)) + and then In_Subrange_Of (Etype (Entity (E)), T) + then Set_Is_Known_Valid (Id); + Set_Ekind (Id, E_Constant); + Set_Actual_Subtype (Id, Etype (Entity (E))); end if; -- Deal with setting of null flags @@ -5399,7 +5415,7 @@ package body Sem_Ch3 is ("subtype mark required", One_Cstr); -- String subtype must have a lower bound of 1 in SPARK. - -- Note that we do not need to test for the non-static case + -- Note that we do not need to test for the nonstatic case -- here, since that was already taken care of in -- Process_Range_Expr_In_Decl. @@ -12471,7 +12487,7 @@ package body Sem_Ch3 is end if; -- It is unsafe to share the bounds of a scalar type, because the Itype - -- is elaborated on demand, and if a bound is non-static then different + -- is elaborated on demand, and if a bound is nonstatic, then different -- orders of elaboration in different units will lead to different -- external symbols. @@ -16421,7 +16437,7 @@ package body Sem_Ch3 is -- Because the implicit base is used in the conversion of the bounds, we -- have to freeze it now. This is similar to what is done for numeric - -- types, and it equally suspicious, but otherwise a non-static bound + -- types, and it equally suspicious, but otherwise a nonstatic bound -- will have a reference to an unfrozen type, which is rejected by Gigi -- (???). This requires specific care for definition of stream -- attributes. For details, see comments at the end of @@ -19343,8 +19359,8 @@ package body Sem_Ch3 is end if; -- In the subtype indication case, if the immediate parent of the - -- new subtype is non-static, then the subtype we create is non- - -- static, even if its bounds are static. + -- new subtype is nonstatic, then the subtype we create is nonstatic, + -- even if its bounds are static. if Nkind (N) = N_Subtype_Indication and then not Is_OK_Static_Subtype (Entity (Subtype_Mark (N))) -- 2.7.4