[Ada] Get rid of more references to Universal_Integer in expanded code
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
Pierre-Marie de Rodat
parent
b0f920c96a
commit
445514c037
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue