From a98217beaa82d397893ea6f9eed30e74937427a2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 28 May 2018 08:54:41 +0000 Subject: [PATCH] [Ada] Better accuracy in float-to-fixed conversions This patch improves the accuracy of conversions from a floating point to a fixed point type when the fixed point type has a specified Snall that is not a power of two. Previously the conversion of Fixed_Point_Type'First to some floating point number and back to Fixed_Point_Type raised Constraint error. This result is within the accuracy imposed by tne Numerics annex of the RM but is certainly undesirable. This patch transforms the conversion to avoid extra manipulations of the 'Small of the type, so that the identity: Fixed_T (Float_T (Fixed_Val)) = Fixed_Val holds over the range of Fixed_T. 2018-05-28 Ed Schonberg gcc/ada/ * exp_ch4.adb (Real_Range_Check): Specialize float-to-fixed conversions when bounds of fixed type are static, to remove some spuerfluous implicit conversions and provide an accurate result when converting back and forth between the fixed point type and a floating point type. gcc/testsuite/ * gnat.dg/fixedpnt5.adb: New testcase. From-SVN: r260832 --- gcc/ada/ChangeLog | 7 ++ gcc/ada/exp_ch4.adb | 115 +++++++++++++++++++++++----- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gnat.dg/fixedpnt5.adb | 58 ++++++++++++++ 4 files changed, 166 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/fixedpnt5.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b0951c18a4..abcf424b309 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-05-28 Ed Schonberg + + * exp_ch4.adb (Real_Range_Check): Specialize float-to-fixed conversions + when bounds of fixed type are static, to remove some spuerfluous + implicit conversions and provide an accurate result when converting + back and forth between the fixed point type and a floating point type. + 2018-05-28 Ed Schonberg * exp_unst.adb (Unnest_Subprogram): Prevent creation of empty diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 65de38e9e83..caa64b96e41 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10937,8 +10937,13 @@ package body Exp_Ch4 is Lo : constant Node_Id := Type_Low_Bound (Target_Type); Hi : constant Node_Id := Type_High_Bound (Target_Type); Xtyp : constant Entity_Id := Etype (Operand); - Conv : Node_Id; - Tnn : Entity_Id; + + Conv : Node_Id; + Lo_Arg : Node_Id; + Lo_Val : Node_Id; + Hi_Arg : Node_Id; + Hi_Val : Node_Id; + Tnn : Entity_Id; begin -- Nothing to do if conversion was rewritten @@ -11041,34 +11046,108 @@ package body Exp_Ch4 is Tnn := Make_Temporary (Loc, 'T', Conv); + -- For a conversion from Float to Fixed where the bounds of the + -- fixed-point type are static, we can obtain a more accurate + -- fixed-point value by converting the result of the floating- + -- point expression to an appropriate integer type, and then + -- performing an unchecked conversion to the target fixed-point + -- type. The range check can then use the corresponding integer + -- value of the bounds instead of requiring further conversions. + -- This preserves the identity: + + -- Fix_Val = Fixed_Type (Float_Type (Fix_Val)) + + -- which used to fail when Fix_Val was a bound of the type and + -- the 'Small was not a representable number. + -- This transformation requires an integer type large enough to + -- accommodate a fixed-point value. This will not be the case + -- in systems where Duration is larger than Long_Integer. + + if Is_Ordinary_Fixed_Point_Type (Target_Type) + and then Is_Floating_Point_Type (Operand_Type) + and then RM_Size (Base_Type (Target_Type)) <= + RM_Size (Standard_Long_Integer) + and then Nkind (Lo) = N_Real_Literal + and then Nkind (Hi) = N_Real_Literal + then + -- Find the integer type of the right size to perform an unchecked + -- conversion to the target fixed-point type. + + declare + Int_Type : Entity_Id; + Bfx_Type : constant Entity_Id := Base_Type (Target_Type); + + begin + if RM_Size (Bfx_Type) > RM_Size (Standard_Integer) then + Int_Type := Standard_Long_Integer; + + elsif + RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer) + then + Int_Type := Standard_Integer; + + else + Int_Type := Standard_Short_Integer; + end if; + + -- Create integer objects for range checking of result. + + Lo_Arg := Unchecked_Convert_To (Int_Type, + New_Occurrence_Of (Tnn, Loc)); + Lo_Val := Make_Integer_Literal (Loc, + Corresponding_Integer_Value (Lo)); + + Hi_Arg := Unchecked_Convert_To (Int_Type, + New_Occurrence_Of (Tnn, Loc)); + Hi_Val := Make_Integer_Literal (Loc, + Corresponding_Integer_Value (Hi)); + + -- Rewrite conversion as an integer conversion of the + -- original floating-point expression, followed by an + -- unchecked conversion to the target fixed-point type. + + Conv := Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (Target_Type, Loc), + Expression => + Convert_To (Int_Type, Expression (Conv))); + end; + + else -- For all other conversions + + Lo_Arg := New_Occurrence_Of (Tnn, Loc); + Lo_Val := Make_Attribute_Reference (Loc, + Attribute_Name => Name_First, + Prefix => + New_Occurrence_Of (Target_Type, Loc)); + + Hi_Arg := New_Occurrence_Of (Tnn, Loc); + Hi_Val := Make_Attribute_Reference (Loc, + Attribute_Name => Name_Last, + Prefix => + New_Occurrence_Of (Target_Type, Loc)); + end if; + + -- Build code for range checking + Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, Defining_Identifier => Tnn, Object_Definition => New_Occurrence_Of (Btyp, Loc), Constant_Present => True, Expression => Conv), - Make_Raise_Constraint_Error (Loc, - Condition => + Condition => Make_Or_Else (Loc, - Left_Opnd => Make_Op_Lt (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_First, - Prefix => - New_Occurrence_Of (Target_Type, Loc))), + Left_Opnd => Lo_Arg, + Right_Opnd => Lo_Val), Right_Opnd => Make_Op_Gt (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Last, - Prefix => - New_Occurrence_Of (Target_Type, Loc)))), - Reason => CE_Range_Check_Failed))); + Left_Opnd => Hi_Arg, + Right_Opnd => Hi_Val)), + Reason => CE_Range_Check_Failed))); Rewrite (N, New_Occurrence_Of (Tnn, Loc)); Analyze_And_Resolve (N, Btyp); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3717830a1b2..5f9d7f840ea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-28 Ed Schonberg + + * gnat.dg/fixedpnt5.adb: New testcase. + 2018-05-28 Justin Squirek * gnat.dg/array31.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/fixedpnt5.adb b/gcc/testsuite/gnat.dg/fixedpnt5.adb new file mode 100644 index 00000000000..7175ddc13f5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/fixedpnt5.adb @@ -0,0 +1,58 @@ +-- { dg-do run } + +with Text_IO; use Text_IO; +with Ada.Numerics; use Ada.Numerics; +with Unchecked_Conversion; + +procedure Fixedpnt5 is + -- Test conversions from Floating point to Fixed point types when the + -- fixed type has a Small that is not a power of two. Verify that the + -- conversions are reversible, so that: + -- + -- Fixed_T (Float_T (Fixed_Var)) = Fixed_Var + -- + -- for a range of fixed values, in particular at the boundary of type. + + type T_Fixed_Type is delta PI/32768.0 range -PI .. PI - PI/32768.0; + for T_Fixed_Type'Small use PI/32768.0; + + function To_Fix is new Unchecked_Conversion (Short_Integer, T_Fixed_Type); + Fixed_Point_Var : T_Fixed_Type; + Float_Var : Float; + +begin + Fixed_Point_Var := -PI; + Float_Var := Float(Fixed_Point_Var); + Fixed_Point_Var := T_Fixed_Type (Float_Var); + + Fixed_Point_Var := T_Fixed_Type'First; + Float_Var := Float(Fixed_Point_Var); + Fixed_Point_Var := T_Fixed_Type (Float_Var); + + if Fixed_Point_Var /= T_Fixed_Type'First then + raise Program_Error; + end if; + + fixed_point_var := t_fixed_type'Last; + Float_Var := Float(Fixed_Point_Var); + Fixed_Point_Var := T_Fixed_Type (Float_Var); + + if Fixed_Point_Var /= T_Fixed_Type'Last then + raise Program_Error; + end if; + + for I in -32768 .. 32767 loop + fixed_Point_Var := To_Fix (Short_Integer (I)); + Float_Var := Float (Fixed_Point_Var); + if T_Fixed_Type (Float_Var) /= FIxed_Point_Var then + Put_Line ("Not reversibloe"); + Put_Line (Integer'Image (I)); + raise Program_Error; + end if; + end loop; + + Fixed_Point_Var := T_Fixed_Type (Float_Var * 2.0); + raise Program_Error; +exception + when others => null; +end Fixedpnt5; -- 2.30.2