ada: Use truncation for dynamic conversions from floating point to fixed point

This changes the implementation of dynamic conversions from floating-point
to ordinary fixed-point types, from rounding (to the nearest number) to
truncation (toward zero), so as to make them consistent with both static
conversions between these types and also the value of the Machine_Rounds
attribute, which is False for all fixed-point types with GNAT.

The rounding is still available under the debug switch -gnatd.N for the
sake of backward compatibility with the previous implementation.

gcc/ada/

	* debug.adb (d.N): Document new usage.
	* exp_ch4.adb (Expand_N_Type_Conversion): Copy the Float_Truncate
	flag when rewriting a floating-point to fixed-point conversion as
	a floating-point to integer conversion.
	* exp_fixd.adb: Add with and use clauses for Debug.
	(Expand_Convert_Fixed_To_Fixed): Generate a truncation in all cases
	except if the result is explicitly rounded.
	(Expand_Convert_Integer_To_Fixed): Likewise.
	(Expand_Convert_Float_To_Fixed): Generate a truncation for all kind
	of fixed-point types, except if the result is explicitly rounded, or
	-gnatd.N is specified and the type is an ordinary fixed-point type.
	* sinfo.ads (Float_Truncate): Document usage for floating-point to
	fixed-point conversions.

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 9566e095d1a0310f4f9cc73da852c92879fa25d3..fd94203faf8b594e2e8e5be0f3ba718e8b5b9fb1 100644 (file)
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -125,7 +125,7 @@ package body Debug is
    --  d.K  Do not reject components in extensions overlapping with parent
    --  d.L  Depend on back end for limited types in if and case expressions
    --  d.M  Relaxed RM semantics
-   --  d.N
+   --  d.N  Use rounding when converting from floating point to fixed point
    --  d.O  Dump internal SCO tables
    --  d.P  Previous (non-optimized) handling of length comparisons
    --  d.Q  Previous (incomplete) style check for binary operators
@@ -906,6 +906,10 @@ package body Debug is
    --  d.M  Relaxed RM semantics. This flag sets Opt.Relaxed_RM_Semantics
    --       See Opt.Relaxed_RM_Semantics for more details.
 
+   --  d.N  Use rounding instead of truncation when dynamically converting from
+   --       a floating-point type to an ordinary fixed-point type, for the sake
+   --       of compatibility with earlier versions of the compiler.
+
    --  d.O  Dump internal SCO tables. Before outputting the SCO information to
    --       the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
    --       are dumped for debugging purposes.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 5c9c6686c01f5e4e57405d76283790ad62b4daac..7be240bce0e4ced0ea2f703e85034b1985a887dc 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -12150,8 +12150,12 @@ package body Exp_Ch4 is
                Expr_Id : constant Entity_Id := Make_Temporary (Loc, 'T', Conv);
                Int_Typ : constant Entity_Id :=
                  Small_Integer_Type_For (RM_Size (Btyp), Uns => False);
+               Trunc   : constant Boolean   := Float_Truncate (Conv);
 
             begin
+               Conv := Convert_To (Int_Typ, Expression (Conv));
+               Set_Float_Truncate (Conv, Trunc);
+
                --  Generate a temporary with the integer value. Required in the
                --  CCG compiler to ensure that run-time checks reference this
                --  integer expression (instead of the resulting fixed-point
@@ -12163,8 +12167,7 @@ package body Exp_Ch4 is
                    Defining_Identifier => Expr_Id,
                    Object_Definition   => New_Occurrence_Of (Int_Typ, Loc),
                    Constant_Present    => True,
-                   Expression          =>
-                     Convert_To (Int_Typ, Expression (Conv))));
+                   Expression          => Conv));
 
                --  Create integer objects for range checking of result.
 

diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index 61c2f923f0825fe31e1169ffc296a5d53b1f6480..b7a996ab6151db621dd22193d03129ae74f00dc9 100644 (file)
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -25,6 +25,7 @@
 
 with Atree;          use Atree;
 with Checks;         use Checks;
+with Debug;          use Debug;
 with Einfo;          use Einfo;
 with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;    use Einfo.Utils;
@@ -1624,13 +1625,14 @@ package body Exp_Fixd is
 
       --  Fall through to use floating-point for the close result set case,
       --  as a result of the numerator or denominator of the small ratio not
-      --  being a sufficiently small integer.
+      --  being sufficiently small. See also Expand_Convert_Float_To_Fixed.
 
       Set_Result (N,
         Build_Multiply (N,
           Fpt_Value (Expr),
           Real_Literal (N, Small_Ratio)),
-        Rng_Check);
+        Rng_Check,
+        Trunc => not Rounded_Result (N));
    end Expand_Convert_Fixed_To_Fixed;
 
    -----------------------------------
@@ -1769,23 +1771,23 @@ package body Exp_Fixd is
       if Small = Ureal_1 then
          Set_Result (N, Expr, Rng_Check, Trunc => True);
 
-      --  Normal case where multiply is required. Rounding is truncating
-      --  for decimal fixed point types only, see RM 4.6(29), except if the
-      --  conversion comes from an attribute reference 'Round (RM 3.5.10 (14)):
-      --  The attribute is implemented by means of a conversion that must
-      --  round.
+      --  Normal case where multiply is required. The conversion is truncating
+      --  for fixed-point types, see RM 4.6(29), except if the conversion comes
+      --  from an attribute reference 'Round (RM 3.5.10 (14)): the attribute is
+      --  implemented by means of a conversion that needs to round. However, if
+      --  the switch -gnatd.N is specified, we use rounding for ordinary fixed-
+      --  point types, for compatibility with earlier versions of the compiler.
 
       else
-         Set_Result
-           (N     => N,
-            Expr  =>
-              Build_Multiply
-                (N => N,
-                 L => Fpt_Value (Expr),
-                 R => Real_Literal (N, Ureal_1 / Small)),
-            Rchk  => Rng_Check,
-            Trunc => Is_Decimal_Fixed_Point_Type (Result_Type)
-                       and not Rounded_Result (N));
+         Set_Result (N,
+           Build_Multiply (N,
+             L => Fpt_Value (Expr),
+             R => Real_Literal (N, Ureal_1 / Small)),
+          Rchk  => Rng_Check,
+          Trunc => not Rounded_Result (N)
+                     and then not
+                       (Debug_Flag_Dot_NN
+                         and then Is_Ordinary_Fixed_Point_Type (Result_Type)));
       end if;
    end Expand_Convert_Float_To_Fixed;
 
@@ -1852,13 +1854,14 @@ package body Exp_Fixd is
 
       --  Fall through to use floating-point for the close result set case,
       --  as a result of the numerator or denominator of the small value not
-      --  being a sufficiently small integer.
+      --  being sufficiently small. See also Expand_Convert_Float_To_Fixed.
 
       Set_Result (N,
         Build_Multiply (N,
           Fpt_Value (Expr),
           Real_Literal (N, Ureal_1 / Small)),
-        Rng_Check);
+        Rng_Check,
+        Trunc => not Rounded_Result (N));
    end Expand_Convert_Integer_To_Fixed;
 
    --------------------------------

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index e4fd6794f4b6059ad4a51fc4379b6afb5bee25fd..0f698cd68ee8ccc81e170e1195374837043c1b42 100644 (file)
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1329,8 +1329,9 @@ package Sinfo is
    --    to the entity for the first subtype.
 
    --  Float_Truncate
-   --    A flag present in type conversion nodes. This is used for float to
-   --    integer conversions where truncation is required rather than rounding.
+   --    A flag present in type conversion nodes. It is used for floating-point
+   --    to fixed-point or integer conversions, where truncation is required
+   --    rather than rounding.
 
    --  Forwards_OK
    --    A flag present in the N_Assignment_Statement node. It is used only