From 6a987d785122fb015aac527e927818bdc9975a7b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 22 Dec 2019 19:37:20 +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 (Others_Check): In the positional case, use the general expression for the comparison only when needed. * exp_attr.adb (Expand_Fpt_Attribute;): Use a simple conversion to the target type instead of an unchecked conversion to the base type to do the range check, as in the other cases. (Expand_N_Attribute_Reference) : Do the Max operation in the type of the storage size variable, and use Convert_To as in the other cases. * tbuild.adb (Convert_To): Do not get rid of an intermediate conversion to Universal_Integer here... * sem_res.adb (Simplify_Type_Conversion): ...but here instead. --- gcc/ada/exp_aggr.adb | 61 +++++++++++++++++++++++++++++++------------- gcc/ada/exp_attr.adb | 21 ++++++++------- gcc/ada/sem_res.adb | 17 +++++++++--- gcc/ada/tbuild.adb | 10 -------- 4 files changed, 66 insertions(+), 43 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 05508d821d4..dad83d4636a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5853,26 +5853,51 @@ package body Exp_Aggr is -- raise Constraint_Error; -- end if; + -- in the general case, but the following simpler test: + + -- [constraint_error when + -- Aggr_Lo + (Nb_Elements - 1) > Aggr_Hi]; + + -- instead if the index type is a signed integer. + elsif Nb_Elements > Uint_0 then - Cond := - Make_Op_Gt (Loc, - Left_Opnd => - Make_Op_Add (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Ind_Typ, Loc), - Attribute_Name => Name_Pos, - Expressions => - New_List - (Duplicate_Subexpr_Move_Checks (Aggr_Lo))), - Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)), + if Nb_Elements = Uint_1 then + Cond := + Make_Op_Gt (Loc, + Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo), + Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi)); + + elsif Is_Signed_Integer_Type (Ind_Typ) then + Cond := + Make_Op_Gt (Loc, + Left_Opnd => + Make_Op_Add (Loc, + Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo), + Right_Opnd => + Make_Integer_Literal (Loc, Nb_Elements - 1)), + Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi)); - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Ind_Typ, Loc), - Attribute_Name => Name_Pos, - Expressions => New_List ( - Duplicate_Subexpr_Move_Checks (Aggr_Hi)))); + else + Cond := + Make_Op_Gt (Loc, + Left_Opnd => + Make_Op_Add (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ind_Typ, Loc), + Attribute_Name => Name_Pos, + Expressions => + New_List + (Duplicate_Subexpr_Move_Checks (Aggr_Lo))), + Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)), + + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ind_Typ, Loc), + Attribute_Name => Name_Pos, + Expressions => New_List ( + Duplicate_Subexpr_Move_Checks (Aggr_Hi)))); + end if; -- If we are dealing with an aggregate containing an others choice -- and discrete choices we generate the following test: diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index a4957b38f59..ce939e714a5 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1096,12 +1096,10 @@ package body Exp_Attr is Selector_Name => Make_Identifier (Loc, Nam)); -- The generated call is given the provided set of parameters, and then - -- wrapped in a conversion which converts the result to the target type - -- We use the base type as the target because a range check may be - -- required. + -- wrapped in a conversion which converts the result to the target type. Rewrite (N, - Unchecked_Convert_To (Base_Type (Etype (N)), + Convert_To (Typ, Make_Function_Call (Loc, Name => Fnm, Parameter_Associations => Args))); @@ -6011,12 +6009,13 @@ package body Exp_Attr is if Is_Access_Type (Ptyp) then if Present (Storage_Size_Variable (Root_Type (Ptyp))) then Rewrite (N, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Typ, Loc), - Attribute_Name => Name_Max, - Expressions => New_List ( - Make_Integer_Literal (Loc, 0), - Convert_To (Typ, + Convert_To (Typ, + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of + (Etype (Storage_Size_Variable (Root_Type (Ptyp))), Loc), + Attribute_Name => Name_Max, + Expressions => New_List ( + Make_Integer_Literal (Loc, 0), New_Occurrence_Of (Storage_Size_Variable (Root_Type (Ptyp)), Loc))))); @@ -6069,7 +6068,7 @@ package body Exp_Attr is else Rewrite (N, - OK_Convert_To (Typ, + Convert_To (Typ, Make_Function_Call (Loc, Name => New_Occurrence_Of (Alloc_Op, Loc), diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ee9772cfca8..143191b6180 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -265,9 +265,7 @@ 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, and also the - -- conversion of an integer literal to a dynamic integer type. + -- have been applied. This rewrites the conversion into a simpler form. function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id; -- A universal_fixed expression in an universal context is unambiguous if @@ -12630,7 +12628,7 @@ package body Sem_Res is -- 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. + -- to avoid doing range checks in universal integer. elsif Is_Integer_Type (Target_Typ) and then not Is_Generic_Type (Root_Type (Target_Typ)) @@ -12639,6 +12637,17 @@ package body Sem_Res is then Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand); Analyze_And_Resolve (Operand); + + -- If the expression is a conversion to universal integer of an + -- an expression with an integer type, then we can eliminate the + -- intermediate conversion to universal integer. + + elsif Nkind (Operand) = N_Type_Conversion + and then Entity (Subtype_Mark (Operand)) = Universal_Integer + and then Is_Integer_Type (Etype (Expression (Operand))) + then + Rewrite (Operand, Relocate_Node (Expression (Operand))); + Analyze_And_Resolve (Operand); end if; end; end if; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 1302d97ea85..0ce1071655e 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -119,16 +119,6 @@ package body Tbuild is 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), -- 2.30.2