[Ada] Optimize generation of checks for fixed-point types

gcc/ada/

	* checks.ads (Determine_Range_To_Discrete): New procedure.
	* checks.adb (Apply_Scalar_Range_Check): Call it to determine
	a range for the expression when the target type is discrete.
	And also apply the tests for discrete types to fixed-point
	types when they are treated as integers.
	(Apply_Type_Conversion_Checks): Apply checks to conversions
	involving fixed-point types when they are treated as integers.
	(Determine_Range) <N_Type_Conversion>: Factor out code into...
	(Determine_Range_To_Discrete): ...this new procedure and add
	support for fixed-point types when they are treated as integers.
	* einfo.ads (Type_High_Bound): Remove obsolete sentence.
	(Type_Low_Bound): Likewise.
	* exp_ch4.adb (Discrete_Range_Check): Remove obsolete code.
	(Real_Range_Check): Likewise.
	(Expand_N_Type_Conversion): In case of a no-op conversion, clear
	the Do_Range_Check flag on the operand before substituting it.
	Remove calls to Real_Range_Check and Discrete_Range_Check that
	are not guarded by the Do_Range_Check flag, and an assertion.
	* sem_res.adb (Resolve_Type_Conversion): Always apply range
	checks in GNATprove mode; in normal mode, use the updated type
	of the operand in the test against Universal_Fixed.  Remove
	obsolete code setting the Do_Range_Check flag at the end.

5 files changed, 139 insertions, 122 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 1914fc3..c7a3321 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3258,23 +3258,16 @@ package body Checks is
       end if;
 
       --  Return if we know expression is definitely in the range of the target
-      --  type as determined by Determine_Range. Right now we only do this for
-      --  discrete types, and not fixed-point or floating-point types.
-
-      --  The additional less-precise tests below catch these cases
-
-      --  In GNATprove_Mode, also deal with the case of a conversion from
-      --  floating-point to integer. It is only possible because analysis
-      --  in GNATprove rules out the possibility of a NaN or infinite value.
+      --  type as determined by Determine_Range_To_Discrete. Right now we only
+      --  do this for discrete target types, i.e. neither for fixed-point nor
+      --  for floating-point types. But the additional less precise tests below
+      --  catch these cases.
 
       --  Note: skip this if we are given a source_typ, since the point of
       --  supplying a Source_Typ is to stop us looking at the expression.
       --  We could sharpen this test to be out parameters only ???
 
       if Is_Discrete_Type (Target_Typ)
-        and then (Is_Discrete_Type (Etype (Expr))
-                   or else (GNATprove_Mode
-                             and then Is_Floating_Point_Type (Etype (Expr))))
         and then not Is_Unconstrained_Subscr_Ref
         and then No (Source_Typ)
       then
@@ -3318,35 +3311,8 @@ package body Checks is
 
                   --  Otherwise determine range of value
 
-                  if Is_Discrete_Type (Etype (Expr)) then
-                     Determine_Range
-                       (Expr, OK, Lo, Hi, Assume_Valid => True);
-
-                  --  When converting a float to an integer type, determine the
-                  --  range in real first, and then convert the bounds using
-                  --  UR_To_Uint which correctly rounds away from zero when
-                  --  half way between two integers, as required by normal
-                  --  Ada 95 rounding semantics. It is only possible because
-                  --  analysis in GNATprove rules out the possibility of a NaN
-                  --  or infinite value.
-
-                  elsif GNATprove_Mode
-                    and then Is_Floating_Point_Type (Etype (Expr))
-                  then
-                     declare
-                        Hir : Ureal;
-                        Lor : Ureal;
-
-                     begin
-                        Determine_Range_R
-                          (Expr, OK, Lor, Hir, Assume_Valid => True);
-
-                        if OK then
-                           Lo := UR_To_Uint (Lor);
-                           Hi := UR_To_Uint (Hir);
-                        end if;
-                     end;
-                  end if;
+                  Determine_Range_To_Discrete
+                    (Expr, OK, Lo, Hi, Fixed_Int, Assume_Valid => True);
 
                   if OK then
 
@@ -3389,10 +3355,12 @@ package body Checks is
       --  Check if we can determine at compile time whether Expr is in the
       --  range of the target type. Note that if S_Typ is within the bounds
       --  of Target_Typ then this must be the case. This check is meaningful
-      --  only if this is not a conversion between integer and real types.
+      --  only if this is not a conversion between integer and real types,
+      --  unless for a fixed-point type if Fixed_Int is set.
 
       if not Is_Unconstrained_Subscr_Ref
-        and then Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
+        and then (Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
+                   or else (Fixed_Int and then Is_Discrete_Type (Target_Typ)))
         and then
           (In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int)
 
@@ -3705,12 +3673,15 @@ package body Checks is
                then
                   Apply_Float_Conversion_Check (Expr, Target_Type);
                else
-                  --  Conversions involving fixed-point types are expanded
-                  --  separately, and do not need a Range_Check flag, except
-                  --  in GNATprove_Mode, where the explicit constraint check
-                  --  will not be generated.
+                  --  Raw conversions involving fixed-point types are expanded
+                  --  separately and do not need a Range_Check flag yet, except
+                  --  in GNATprove_Mode where this expansion is not performed.
+                  --  This does not apply to conversion where fixed-point types
+                  --  are treated as integers, which are precisely generated by
+                  --  this expansion.
 
                   if GNATprove_Mode
+                    or else Conv_OK
                     or else (not Is_Fixed_Point_Type (Expr_Type)
                               and then not Is_Fixed_Point_Type (Target_Type))
                   then
@@ -5354,38 +5325,11 @@ package body Checks is
             end case;
 
          when N_Type_Conversion =>
+            --  For a type conversion, we can try to refine the range using the
+            --  converted value.
 
-            --  For type conversion from one discrete type to another, we can
-            --  refine the range using the converted value.
-
-            if Is_Discrete_Type (Etype (Expression (N))) then
-               Determine_Range (Expression (N), OK1, Lor, Hir, Assume_Valid);
-
-            --  When converting a float to an integer type, determine the range
-            --  in real first, and then convert the bounds using UR_To_Uint
-            --  which correctly rounds away from zero when half way between two
-            --  integers, as required by normal Ada 95 rounding semantics. It
-            --  is only possible because analysis in GNATprove rules out the
-            --  possibility of a NaN or infinite value.
-
-            elsif GNATprove_Mode
-              and then Is_Floating_Point_Type (Etype (Expression (N)))
-            then
-               declare
-                  Lor_Real, Hir_Real : Ureal;
-               begin
-                  Determine_Range_R (Expression (N), OK1, Lor_Real, Hir_Real,
-                                     Assume_Valid);
-
-                  if OK1 then
-                     Lor := UR_To_Uint (Lor_Real);
-                     Hir := UR_To_Uint (Hir_Real);
-                  end if;
-               end;
-
-            else
-               OK1 := False;
-            end if;
+            Determine_Range_To_Discrete
+              (Expression (N), OK1, Lor, Hir, Conversion_OK (N), Assume_Valid);
 
          --  Nothing special to do for all other expression kinds
 
@@ -5905,6 +5849,96 @@ package body Checks is
          end if;
    end Determine_Range_R;
 
+   ---------------------------------
+   -- Determine_Range_To_Discrete --
+   ---------------------------------
+
+   procedure Determine_Range_To_Discrete
+     (N            : Node_Id;
+      OK           : out Boolean;
+      Lo           : out Uint;
+      Hi           : out Uint;
+      Fixed_Int    : Boolean := False;
+      Assume_Valid : Boolean := False)
+   is
+      Typ : constant Entity_Id := Etype (N);
+
+   begin
+      --  For a discrete type, simply defer to Determine_Range
+
+      if Is_Discrete_Type (Typ) then
+         Determine_Range (N, OK, Lo, Hi, Assume_Valid);
+
+      --  For a fixed point type treated as an integer, we can determine the
+      --  range using the Corresponding_Integer_Value of the bounds of the
+      --  type or base type. This is done by the calls to Expr_Value below.
+
+      elsif Is_Fixed_Point_Type (Typ) and then Fixed_Int then
+         declare
+            Btyp, Ftyp : Entity_Id;
+            Bound      : Node_Id;
+
+         begin
+            if Assume_Valid then
+               Ftyp := Typ;
+            else
+               Ftyp := Underlying_Type (Base_Type (Typ));
+            end if;
+
+            Btyp := Base_Type (Ftyp);
+
+            --  First the low bound
+
+            Bound := Type_Low_Bound (Ftyp);
+
+            if Compile_Time_Known_Value (Bound) then
+               Lo := Expr_Value (Bound);
+            else
+               Lo := Expr_Value (Type_Low_Bound (Btyp));
+            end if;
+
+            --  Then the high bound
+
+            Bound := Type_High_Bound (Ftyp);
+
+            if Compile_Time_Known_Value (Bound) then
+               Hi := Expr_Value (Bound);
+            else
+               Hi := Expr_Value (Type_High_Bound (Btyp));
+            end if;
+
+            OK := True;
+         end;
+
+      --  For a floating-point type, we can determine the range in real first,
+      --  and then convert the bounds using UR_To_Uint, which correctly rounds
+      --  away from zero when half way between two integers, as required by
+      --  normal Ada 95 rounding semantics. But this is only possible because
+      --  GNATprove's analysis rules out the possibility of a NaN or infinite.
+
+      elsif GNATprove_Mode and then Is_Floating_Point_Type (Typ) then
+         declare
+            Lo_Real, Hi_Real : Ureal;
+
+         begin
+            Determine_Range_R (N, OK, Lo_Real, Hi_Real, Assume_Valid);
+
+            if OK then
+               Lo := UR_To_Uint (Lo_Real);
+               Hi := UR_To_Uint (Hi_Real);
+            else
+               Lo := No_Uint;
+               Hi := No_Uint;
+            end if;
+         end;
+
+      else
+         Lo := No_Uint;
+         Hi := No_Uint;
+         OK := False;
+      end if;
+   end Determine_Range_To_Discrete;
+
    ------------------------------------
    -- Discriminant_Checks_Suppressed --
    ------------------------------------
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index aca1b7e..d75c602 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -338,6 +338,21 @@ package Checks is
    --  For that to happen, the possibility of arguments of infinite or NaN
    --  value should be taken into account, which is not the case currently.
 
+   procedure Determine_Range_To_Discrete
+     (N            : Node_Id;
+      OK           : out Boolean;
+      Lo           : out Uint;
+      Hi           : out Uint;
+      Fixed_Int    : Boolean := False;
+      Assume_Valid : Boolean := False);
+   --  Similar to Determine_Range, but attempts to return a discrete range even
+   --  if N is not of a discrete type by doing a conversion. The Fixed_Int flag
+   --  if set causes any fixed-point values to be treated as though they were
+   --  discrete values (i.e. the underlying integer value is used), in which
+   --  case no conversion is needed. At the current time, this is used only for
+   --  discrete types, for fixed-point types if Fixed_Int is set, and also for
+   --  floating-point types in GNATprove, see Determine_Range_R above.
+
    procedure Install_Null_Excluding_Check (N : Node_Id);
    --  Determines whether an access node requires a run-time access check and
    --  if so inserts the appropriate run-time check.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8368fb3..a4b4f0f 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -4596,15 +4596,13 @@ package Einfo is
 --       Applies to scalar types. Returns the tree node (Node_Id) that contains
 --       the high bound of a scalar type. The returned value is literal for a
 --       base type, but may be an expression in the case of scalar type with
---       dynamic bounds. Note that in the case of a fixed point type, the high
---       bound is in units of small, and is an integer.
+--       dynamic bounds.
 
 --    Type_Low_Bound (synthesized)
 --       Applies to scalar types. Returns the tree node (Node_Id) that contains
 --       the low bound of a scalar type. The returned value is literal for a
 --       base type, but may be an expression in the case of scalar type with
---       dynamic bounds. Note that in the case of a fixed point type, the low
---       bound is in units of small, and is an integer.
+--       dynamic bounds.
 
 --    Underlying_Full_View (Node19)
 --       Defined in private subtypes that are the completion of other private
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 74b8f27..efdc235 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11465,11 +11465,6 @@ package body Exp_Ch4 is
       --  Start of processing for Discrete_Range_Check
 
       begin
-         --  Clear the Do_Range_Check flag on N if needed: this can occur when
-         --  e.g. a trivial type conversion is rewritten by its expression.
-
-         Set_Do_Range_Check (N, False);
-
          --  Nothing more to do if conversion was rewritten
 
          if Nkind (N) /= N_Type_Conversion then
@@ -11478,12 +11473,6 @@ package body Exp_Ch4 is
 
          Expr := Expression (N);
 
-         --  Nothing to do if no range check flag set
-
-         if not Do_Range_Check (Expr) then
-            return;
-         end if;
-
          --  Clear the Do_Range_Check flag on Expr
 
          Set_Do_Range_Check (Expr, False);
@@ -11756,11 +11745,6 @@ package body Exp_Ch4 is
          Tnn    : Entity_Id;
 
       begin
-         --  Clear the Do_Range_Check flag on N if needed: this can occur when
-         --  e.g. a trivial type conversion is rewritten by its expression.
-
-         Set_Do_Range_Check (N, False);
-
          --  Nothing more to do if conversion was rewritten
 
          if Nkind (N) /= N_Type_Conversion then
@@ -12032,20 +12016,16 @@ package body Exp_Ch4 is
       --  Nothing at all to do if conversion is to the identical type so remove
       --  the conversion completely, it is useless, except that it may carry
       --  an Assignment_OK attribute, which must be propagated to the operand
-      --  and the Do_Range_Check flag on Operand should be taken into account.
+      --  and the Do_Range_Check flag on the operand must be cleared, if any.
 
       if Operand_Type = Target_Type then
          if Assignment_OK (N) then
             Set_Assignment_OK (Operand);
          end if;
 
-         Rewrite (N, Relocate_Node (Operand));
-
-         if Do_Range_Check (Operand) then
-            pragma Assert (Is_Discrete_Type (Operand_Type));
+         Set_Do_Range_Check (Operand, False);
 
-            Discrete_Range_Check;
-         end if;
+         Rewrite (N, Relocate_Node (Operand));
 
          goto Done;
       end if;
@@ -12468,16 +12448,11 @@ package body Exp_Ch4 is
 
          if Is_Fixed_Point_Type (Target_Type) then
             Expand_Convert_Fixed_To_Fixed (N);
-            Real_Range_Check;
-
          elsif Is_Integer_Type (Target_Type) then
             Expand_Convert_Fixed_To_Integer (N);
-            Discrete_Range_Check;
-
          else
             pragma Assert (Is_Floating_Point_Type (Target_Type));
             Expand_Convert_Fixed_To_Float (N);
-            Real_Range_Check;
          end if;
 
       --  Case of conversions to a fixed-point type
@@ -12492,11 +12467,9 @@ package body Exp_Ch4 is
       then
          if Is_Integer_Type (Operand_Type) then
             Expand_Convert_Integer_To_Fixed (N);
-            Real_Range_Check;
          else
             pragma Assert (Is_Floating_Point_Type (Operand_Type));
             Expand_Convert_Float_To_Fixed (N);
-            Real_Range_Check;
          end if;
 
       --  Case of array conversions
@@ -12656,8 +12629,6 @@ package body Exp_Ch4 is
       --  Here at end of processing
 
    <<Done>>
-      pragma Assert (not Do_Range_Check (N));
-
       --  Apply predicate check if required. Note that we can't just call
       --  Apply_Predicate_Check here, because the type looks right after
       --  the conversion and it would omit the check. The Comes_From_Source
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ba91a62..8256b83 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -11747,16 +11747,14 @@ package body Sem_Res is
       Simplify_Type_Conversion (N);
 
       --  If after evaluation we still have a type conversion, then we may need
-      --  to apply checks required for a subtype conversion.
-
-      --  Skip these type conversion checks if universal fixed operands
-      --  are involved, since range checks are handled separately for
-      --  these cases (in the appropriate Expand routines in unit Exp_Fixd).
+      --  to apply checks required for a subtype conversion. But skip them if
+      --  universal fixed operands are involved, since range checks are handled
+      --  separately for these cases, after the expansion done by Exp_Fixd.
 
       if Nkind (N) = N_Type_Conversion
         and then not Is_Generic_Type (Root_Type (Target_Typ))
         and then Target_Typ /= Universal_Fixed
-        and then Operand_Typ /= Universal_Fixed
+        and then Etype (Operand) /= Universal_Fixed
       then
          Apply_Type_Conversion_Checks (N);
       end if;
@@ -11995,11 +11993,12 @@ package body Sem_Res is
            (N, Target_Typ, Static_Failure_Is_Error => True);
       end if;
 
-      --  If at this stage we have a fixed point to integer conversion, make
-      --  sure that the Do_Range_Check flag is set which is not always done
-      --  by exp_fixd.adb.
+      --  If at this stage we have a fixed to integer conversion, make sure the
+      --  Do_Range_Check flag is set, because such conversions in general need
+      --  a range check. We only need this if expansion is off, see above why.
 
       if Nkind (N) = N_Type_Conversion
+        and then not Expander_Active
         and then Is_Integer_Type (Target_Typ)
         and then Is_Fixed_Point_Type (Operand_Typ)
         and then not Range_Checks_Suppressed (Target_Typ)