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
----
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-11-14 Ed Schonberg <schonb...@adacore.com>
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.--- gcc/ada/checks.adb
+++ 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));
--- gcc/ada/sem_ch3.adb
+++ 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)))
