From 445514c037052ee4ff513a957e7c21bee36ad0d5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 20 Dec 2019 16:57:50 +0100 Subject: [PATCH] [Ada] Get rid of more references to Universal_Integer in expanded code 2020-06-02 Eric Botcazou 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) : 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. --- gcc/ada/exp_aggr.adb | 15 ++++--- gcc/ada/exp_attr.adb | 10 ++++- gcc/ada/libgnat/a-sequio.adb | 2 +- gcc/ada/sem_res.adb | 78 ++++++++++++++++++++++++------------ gcc/ada/tbuild.adb | 19 ++++++--- 5 files changed, 86 insertions(+), 38 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f4b959516d7..05508d821d4 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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 diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 731d223122c..a4957b38f59 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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; diff --git a/gcc/ada/libgnat/a-sequio.adb b/gcc/ada/libgnat/a-sequio.adb index 9519a871fa5..95a95a2d372 100644 --- a/gcc/ada/libgnat/a-sequio.adb +++ b/gcc/ada/libgnat/a-sequio.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 21cbe0aa8a5..ee9772cfca8 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index bb5532d9b8f..1302d97ea85 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -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 -- 2.30.2