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

Message ID 20200602085939.GA119916@adacore.com
State New
Headers show
Series
  • [Ada] Get rid of more references to Universal_Integer in expanded code
Related show

Commit Message

Pierre-Marie de Rodat June 2, 2020, 8:59 a.m.
This further tweaks the expanded code generated by the front-end, so as
to avoid having references to Universal_Integer reaching the code
generator, either directly or indirectly through attributes returning
Universal_Integer.

The reason is that Universal_Integer must be a type as large as the
largest supported integer type and, therefore, can be much larger than
what is really needed here.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

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

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) <Attribute_Storage_Size>: 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.

Patch

--- gcc/ada/exp_aggr.adb
+++ 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:

--- gcc/ada/exp_attr.adb
+++ 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),

--- gcc/ada/sem_res.adb
+++ 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;

--- gcc/ada/tbuild.adb
+++ 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),