From 39c61276fd8577bec79eff31da4080398a373a24 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 22 Oct 2018 11:03:17 +0000 Subject: [PATCH] utils.c (unchecked_convert): Use local variables for the biased and reverse SSO attributes of both types. * gcc-interface/utils.c (unchecked_convert): Use local variables for the biased and reverse SSO attributes of both types. Further extend the processing of integral types in the presence of reverse SSO to all scalar types. From-SVN: r265381 --- gcc/ada/ChangeLog | 7 +++ gcc/ada/gcc-interface/utils.c | 87 ++++++++++++++++++++------------- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gnat.dg/sso14.adb | 52 ++++++++++++++++++++ gcc/testsuite/gnat.dg/sso15.adb | 52 ++++++++++++++++++++ 5 files changed, 168 insertions(+), 35 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/sso14.adb create mode 100644 gcc/testsuite/gnat.dg/sso15.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c002cdb1a1e..73666129f55 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-10-22 Eric Botcazou + + * gcc-interface/utils.c (unchecked_convert): Use local variables for + the biased and reverse SSO attributes of both types. + Further extend the processing of integral types in the presence of + reverse SSO to all scalar types. + 2018-10-22 Eric Botcazou * gcc-interface/trans.c (Pragma_to_gnu) : Use diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 1ce2f725927..e7dfb41d141 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -5092,8 +5092,16 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) tree etype = TREE_TYPE (expr); enum tree_code ecode = TREE_CODE (etype); enum tree_code code = TREE_CODE (type); + const bool ebiased + = (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)); + const bool biased + = (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)); + const bool ereverse + = (AGGREGATE_TYPE_P (etype) && TYPE_REVERSE_STORAGE_ORDER (etype)); + const bool reverse + = (AGGREGATE_TYPE_P (type) && TYPE_REVERSE_STORAGE_ORDER (type)); tree tem; - int c; + int c = 0; /* If the expression is already of the right type, we are done. */ if (etype == type) @@ -5109,7 +5117,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)))) || code == UNCONSTRAINED_ARRAY_TYPE) { - if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)) + if (ebiased) { tree ntype = copy_type (etype); TYPE_BIASED_REPRESENTATION_P (ntype) = 0; @@ -5117,7 +5125,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = build1 (NOP_EXPR, ntype, expr); } - if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) + if (biased) { tree rtype = copy_type (type); TYPE_BIASED_REPRESENTATION_P (rtype) = 0; @@ -5146,30 +5154,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) Finally, for the sake of consistency, we do the unchecked conversion to an integral type with reverse storage order as soon as the source type is an aggregate type with reverse storage order, even if there - are no considerations of precision or size involved. */ - else if (INTEGRAL_TYPE_P (type) - && TYPE_RM_SIZE (type) - && (tree_int_cst_compare (TYPE_RM_SIZE (type), - TYPE_SIZE (type)) < 0 - || (AGGREGATE_TYPE_P (etype) - && TYPE_REVERSE_STORAGE_ORDER (etype)))) + are no considerations of precision or size involved. Ultimately, we + further extend this processing to any scalar type. */ + else if ((INTEGRAL_TYPE_P (type) + && TYPE_RM_SIZE (type) + && ((c = tree_int_cst_compare (TYPE_RM_SIZE (type), + TYPE_SIZE (type))) < 0 + || ereverse)) + || (SCALAR_FLOAT_TYPE_P (type) && ereverse)) { tree rec_type = make_node (RECORD_TYPE); - unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (type)); tree field_type, field; - if (AGGREGATE_TYPE_P (etype)) - TYPE_REVERSE_STORAGE_ORDER (rec_type) - = TYPE_REVERSE_STORAGE_ORDER (etype); + TYPE_REVERSE_STORAGE_ORDER (rec_type) = ereverse; - if (type_unsigned_for_rm (type)) - field_type = make_unsigned_type (prec); + if (c < 0) + { + const unsigned HOST_WIDE_INT prec + = TREE_INT_CST_LOW (TYPE_RM_SIZE (type)); + if (type_unsigned_for_rm (type)) + field_type = make_unsigned_type (prec); + else + field_type = make_signed_type (prec); + SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type)); + } else - field_type = make_signed_type (prec); - SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type)); + field_type = type; field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type, - NULL_TREE, bitsize_zero_node, 1, 0); + NULL_TREE, bitsize_zero_node, c < 0, 0); finish_record_type (rec_type, field, 1, false); @@ -5184,31 +5197,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) The same considerations as above apply if the target type is an aggregate type with reverse storage order and we also proceed similarly. */ - else if (INTEGRAL_TYPE_P (etype) - && TYPE_RM_SIZE (etype) - && (tree_int_cst_compare (TYPE_RM_SIZE (etype), - TYPE_SIZE (etype)) < 0 - || (AGGREGATE_TYPE_P (type) - && TYPE_REVERSE_STORAGE_ORDER (type)))) + else if ((INTEGRAL_TYPE_P (etype) + && TYPE_RM_SIZE (etype) + && ((c = tree_int_cst_compare (TYPE_RM_SIZE (etype), + TYPE_SIZE (etype))) < 0 + || reverse)) + || (SCALAR_FLOAT_TYPE_P (etype) && reverse)) { tree rec_type = make_node (RECORD_TYPE); - unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype)); vec *v; vec_alloc (v, 1); tree field_type, field; - if (AGGREGATE_TYPE_P (type)) - TYPE_REVERSE_STORAGE_ORDER (rec_type) - = TYPE_REVERSE_STORAGE_ORDER (type); + TYPE_REVERSE_STORAGE_ORDER (rec_type) = reverse; - if (type_unsigned_for_rm (etype)) - field_type = make_unsigned_type (prec); + if (c < 0) + { + const unsigned HOST_WIDE_INT prec + = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype)); + if (type_unsigned_for_rm (etype)) + field_type = make_unsigned_type (prec); + else + field_type = make_signed_type (prec); + SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype)); + } else - field_type = make_signed_type (prec); - SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype)); + field_type = etype; field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type, - NULL_TREE, bitsize_zero_node, 1, 0); + NULL_TREE, bitsize_zero_node, c < 0, 0); finish_record_type (rec_type, field, 1, false); @@ -5308,8 +5325,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) signed and have the same precision. */ tree type_rm_size; if (!notrunc_p + && !biased && INTEGRAL_TYPE_P (type) - && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) && (type_rm_size = TYPE_RM_SIZE (type)) && tree_int_cst_compare (type_rm_size, TYPE_SIZE (type)) < 0 && !(INTEGRAL_TYPE_P (etype) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 42a33ae0099..fa4247ac165 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-22 Eric Botcazou + + * gnat.dg/sso14.adb: New test. + * gnat.dg/sso15.adb: Likewise. + 2018-10-22 Eric Botcazou * gnat.dg/warn19.ad[sb]: New test. diff --git a/gcc/testsuite/gnat.dg/sso14.adb b/gcc/testsuite/gnat.dg/sso14.adb new file mode 100644 index 00000000000..6c50f152524 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso14.adb @@ -0,0 +1,52 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with System; +with Ada.Unchecked_Conversion; + +procedure SSO14 is + + type Arr is array (1 .. Integer'Size) of Boolean; + pragma Pack (Arr); + for Arr'Scalar_Storage_Order use System.High_Order_First; + + function From_Float is new Ada.Unchecked_Conversion (Float, Arr); + function From_Int is new Ada.Unchecked_Conversion (Integer, Arr); + + type R_Float is record + F : Float; + end record; + for R_Float'Bit_Order use System.High_Order_First; + for R_Float'Scalar_Storage_Order use System.High_Order_First; + + type R_Int is record + I : Integer; + end record; + for R_Int'Bit_Order use System.High_Order_First; + for R_Int'Scalar_Storage_Order use System.High_Order_First; + + F1 : Float := 1.234567; + FA : Arr; + F2 : R_Float; + for F2'Address use FA'Address; + pragma Import (Ada, F2); + + I1 : Integer := 1234567; + IA : Arr; + I2 : R_Int; + for I2'Address use IA'Address; + pragma Import (Ada, I2); + +begin + -- Check that converting a FP value yields a big-endian array + FA := From_Float (F1); + if F2.F /= F1 then + raise Program_Error; + end if; + + -- Check that converting an integer value yields a big-endian array. + IA := From_Int (I1); + if I2.I /= I1 then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/sso15.adb b/gcc/testsuite/gnat.dg/sso15.adb new file mode 100644 index 00000000000..19d255a6395 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso15.adb @@ -0,0 +1,52 @@ +-- { dg-do run } +-- { dg-options "-gnatws" } + +with System; +with Ada.Unchecked_Conversion; + +procedure SSO15 is + + type Arr is array (1 .. Integer'Size) of Boolean; + pragma Pack (Arr); + for Arr'Scalar_Storage_Order use System.High_Order_First; + + function To_Float is new Ada.Unchecked_Conversion (Arr, Float); + function To_Int is new Ada.Unchecked_Conversion (Arr, Integer); + + type R_Float is record + F : Float; + end record; + for R_Float'Bit_Order use System.High_Order_First; + for R_Float'Scalar_Storage_Order use System.High_Order_First; + + type R_Int is record + I : Integer; + end record; + for R_Int'Bit_Order use System.High_Order_First; + for R_Int'Scalar_Storage_Order use System.High_Order_First; + + A : Arr := (1 .. 2 => True, others => False); + + F1 : Float; + F2 : R_Float; + for F2'Address use A'Address; + pragma Import (Ada, F2); + + I1 : Integer; + I2 : R_Int; + for I2'Address use A'Address; + pragma Import (Ada, I2); + +begin + -- Check that converting to FP yields a big-endian value. + F1 := To_Float (A); + if F2.F /= F1 then + raise Program_Error; + end if; + + -- Check that converting to integer yields a big-endian value. + I1 := To_Int (A); + if I2.I /= I1 then + raise Program_Error; + end if; +end; -- 2.30.2