OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Get rid of more references to Universal_Integer in expanded code

Browse Source 
2020-06-02  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Build_Array_Aggr_Code): Set the type of the PAT
	on the zero used to clear the array.
	* exp_attr.adb (Expand_N_Attribute_Reference)
	<Attribute_Alignment>: In the CW case, directly convert from the
	alignment's type to the target type if the parent is an
	unchecked conversion.
	* sem_res.adb (Set_String_Literal_Subtype): In the dynamic case,
	use the general expression for the upper bound only when needed.
	Set the base type of the index as the type of the low bound.
	(Simplify_Type_Conversion): Do an intermediate conversion to the
	root type of the target type if the operand is an integer
	literal.
	* tbuild.adb (Convert_To): Get rid of an intermediate conversion
	to Universal_Integer if the inner expression has integer tyoe.
	* libgnat/a-sequio.adb (Byte_Swap): Make use of an equivalent
	static expression in the case statement.
This commit is contained in:
Eric Botcazou 2019-12-20 16:57:50 +01:00 committed by Pierre-Marie de Rodat
parent b0f920c96a
commit 445514c037
5 changed files with 86 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/exp_aggr.adb
View File

@ -2043,12 +2043,15 @@ package body Exp_Aggr is
and then Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ))
then
Append_To (New_Code,
Make_Assignment_Statement (Loc,
Name => New_Copy_Tree (Into),
Expression =>
Unchecked_Convert_To (Typ,
Make_Integer_Literal (Loc, Uint_0))));
declare
Zero : constant Node_Id := Make_Integer_Literal (Loc, Uint_0);
begin
Analyze_And_Resolve (Zero, Packed_Array_Impl_Type (Typ));
Append_To (New_Code,
Make_Assignment_Statement (Loc,
Name => New_Copy_Tree (Into),
Expression => Unchecked_Convert_To (Typ, Zero)));
end;
end if;
-- If the component type contains tasks, we need to build a Master

10
gcc/ada/exp_attr.adb
View File

@ -2459,12 +2459,20 @@ package body Exp_Attr is
New_Node := Build_Get_Alignment (Loc, New_Node);
-- Case where the context is an unchecked conversion to a specific
-- integer type. We directly convert from the alignment's type.
if Nkind (Parent (N)) = N_Unchecked_Type_Conversion then
Rewrite (N, New_Node);
Analyze_And_Resolve (N);
return;
-- Case where the context is a specific integer type with which
-- the original attribute was compatible. But the alignment has a
-- specific type in a-tags.ads (Standard.Natural) so, in order to
-- preserve type compatibility, we must convert explicitly.
if Typ /= Standard_Natural then
elsif Typ /= Standard_Natural then
New_Node := Convert_To (Typ, New_Node);
end if;

2
gcc/ada/libgnat/a-sequio.adb
View File

@ -73,7 +73,7 @@ package body Ada.Sequential_IO is
procedure Byte_Swap (Siz : in out size_t) is
use System.Byte_Swapping;
begin
case Siz'Size is
case size_t'Size is
when 32 => Siz := size_t (Bswap_32 (U32 (Siz)));
when 64 => Siz := size_t (Bswap_64 (U64 (Siz)));
when others => raise Program_Error;

78
gcc/ada/sem_res.adb
View File

@ -266,7 +266,8 @@ package body Sem_Res is
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. Currently simplifies a combination of floating-point
-- to integer conversion and Rounding or Truncation attribute.
-- to integer conversion and Rounding or Truncation attribute, and also the
-- conversion of an integer literal to a dynamic integer type.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
@ -12477,37 +12478,51 @@ package body Sem_Res is
-- If the lower bound is not static we create a range for the string
-- literal, using the index type and the known length of the literal.
-- The index type is not necessarily Positive, so the upper bound is
-- computed as T'Val (T'Pos (Low_Bound) + L - 1).
-- If the length is 1, then the upper bound is set to a mere copy of
-- the lower bound; or else, if the index type is a signed integer,
-- then the upper bound is computed as Low_Bound + L - 1; otherwise,
-- the upper bound is computed as T'Val (T'Pos (Low_Bound) + L - 1).
else
declare
Index_List : constant List_Id := New_List;
Index_Type : constant Entity_Id := Etype (First_Index (Typ));
High_Bound : constant Node_Id :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Val,
Prefix =>
New_Occurrence_Of (Index_Type, Loc),
Expressions => New_List (
Make_Op_Add (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Pos,
Prefix =>
New_Occurrence_Of (Index_Type, Loc),
Expressions =>
New_List (New_Copy_Tree (Low_Bound))),
Right_Opnd =>
Make_Integer_Literal (Loc,
String_Length (Strval (N)) - 1))));
Length : constant Nat := String_Length (Strval (N));
Index_List : constant List_Id := New_List;
Index_Type : constant Entity_Id := Etype (First_Index (Typ));
Array_Subtype : Entity_Id;
Drange : Node_Id;
High_Bound : Node_Id;
Index : Node_Id;
Index_Subtype : Entity_Id;
begin
if Length = 1 then
High_Bound := New_Copy_Tree (Low_Bound);
elsif Is_Signed_Integer_Type (Index_Type) then
High_Bound :=
Make_Op_Add (Loc,
Left_Opnd => New_Copy_Tree (Low_Bound),
Right_Opnd => Make_Integer_Literal (Loc, Length - 1));
else
High_Bound :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Val,
Prefix =>
New_Occurrence_Of (Index_Type, Loc),
Expressions => New_List (
Make_Op_Add (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Pos,
Prefix =>
New_Occurrence_Of (Index_Type, Loc),
Expressions =>
New_List (New_Copy_Tree (Low_Bound))),
Right_Opnd =>
Make_Integer_Literal (Loc, Length - 1))));
end if;
if Is_Integer_Type (Index_Type) then
Set_String_Literal_Low_Bound
(Subtype_Id, Make_Integer_Literal (Loc, 1));
@ -12522,10 +12537,10 @@ package body Sem_Res is
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (Base_Type (Index_Type), Loc)));
Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
end if;
Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
Analyze_And_Resolve
(String_Literal_Low_Bound (Subtype_Id), Base_Type (Index_Type));
-- Build bona fide subtype for the string, and wrap it in an
-- unchecked conversion, because the back end expects the
@ -12611,6 +12626,19 @@ package body Sem_Res is
Relocate_Node (First (Expressions (Operand))));
Set_Float_Truncate (N, Truncate);
end;
-- Special processing for the conversion of an integer literal to
-- a dynamic type: we first convert the literal to the root type
-- and then convert the result to the target type, the goal being
-- to avoid doing range checks in Universal_Integer type.
elsif Is_Integer_Type (Target_Typ)
and then not Is_Generic_Type (Root_Type (Target_Typ))
and then Nkind (Operand) = N_Integer_Literal
and then Opnd_Typ = Universal_Integer
then
Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
Analyze_And_Resolve (Operand);
end if;
end;
end if;

19
gcc/ada/tbuild.adb
View File

@ -116,10 +116,19 @@ package body Tbuild is
Result : Node_Id;
begin
if Present (Etype (Expr))
and then (Etype (Expr)) = Typ
then
if Present (Etype (Expr)) and then Etype (Expr) = Typ then
return Relocate_Node (Expr);
-- Case where the expression is a conversion to universal integer of
-- an expression with an integer type, and we can thus eliminate the
-- intermediate conversion to universal integer.
elsif Nkind (Expr) = N_Type_Conversion
and then Entity (Subtype_Mark (Expr)) = Universal_Integer
and then Is_Integer_Type (Etype (Expression (Expr)))
then
return Convert_To (Typ, Expression (Expr));
else
Result :=
Make_Type_Conversion (Sloc (Expr),
@ -853,8 +862,8 @@ package body Tbuild is
then
return Relocate_Node (Expr);
-- Cases where the inner expression is itself an unchecked conversion
-- to the same type, and we can thus eliminate the outer conversion.
-- Case where the expression is itself an unchecked conversion to
-- the same type, and we can thus eliminate the outer conversion.
elsif Nkind (Expr) = N_Unchecked_Type_Conversion
and then Entity (Subtype_Mark (Expr)) = Typ