From afa8d9397ae35ff4aca9b28c0e8c610b99c1292f Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 17 Jul 2015 09:29:31 +0000 Subject: [PATCH] * expmed.c (flip_storage_order): Deal with complex modes specially. Use the precision of the mode instead of its size to find an integral counterpart. (extract_bit_field_1): Deal with complex modes specially. * expr.c (read_complex_part): Make public. (get_inner_reference): Call reverse_storage_order_for_component_p. (expand_expr_real_1): Allow early exit for CONCATs as well. * expr.h (read_complex_part): Declare. * tree-dfa.c (get_ref_base_and_extent): Call reverse_storage_order_for_component_p. * tree.h (reverse_storage_order_for_component_p): New inline predicate. ada/ * freeze.adb (Check_Component_Storage_Order): Skip a record component if it has Complex_Representation. (Freeze_Record_Type): If the type has Complex_Representation, skip the regular treatment of Scalar_Storage_Order attribute and instead issue a warning if it is present. testsuite/ * c-c++-common/sso/init13.h: New helper. * c-c++-common/sso/p13.c: New test. * c-c++-common/sso/q13.c: Likewise. * c-c++-common/sso/t13.c: Likewise. * gnat.dg/sso/init13.ads: New helper. * gnat.dg/sso/p13.adb: New test. * gnat.dg/sso/q13.adb: Likewise. * gnat.dg/sso/t13.adb: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/scalar-storage-order@225925 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/freeze.adb | 107 +++++++++++++--------- gcc/expmed.c | 37 +++++++- gcc/expr.c | 25 ++--- gcc/expr.h | 1 + gcc/testsuite/c-c++-common/sso/init13.h | 15 +++ gcc/testsuite/c-c++-common/sso/p13.c | 64 +++++++++++++ gcc/testsuite/c-c++-common/sso/q13.c | 50 ++++++++++ gcc/testsuite/c-c++-common/sso/t13.c | 56 +++++++++++ gcc/testsuite/gcc.c-torture/execute/990413-2.c | 1 + gcc/testsuite/gcc.c-torture/execute/bitfld-6.c | 2 + gcc/testsuite/gcc.c-torture/execute/bitfld-7.c | 2 + gcc/testsuite/gcc.c-torture/execute/comp-goto-1.c | 2 + gcc/testsuite/gcc.c-torture/execute/pr65401.c | 1 + gcc/testsuite/gnat.dg/sso/init13.ads | 33 +++++++ gcc/testsuite/gnat.dg/sso/p13.adb | 63 +++++++++++++ gcc/testsuite/gnat.dg/sso/q13.adb | 53 +++++++++++ gcc/testsuite/gnat.dg/sso/t13.adb | 56 +++++++++++ gcc/tree-dfa.c | 23 +---- gcc/tree.h | 45 +++++++-- 19 files changed, 545 insertions(+), 91 deletions(-) create mode 100644 gcc/testsuite/c-c++-common/sso/init13.h create mode 100644 gcc/testsuite/c-c++-common/sso/p13.c create mode 100644 gcc/testsuite/c-c++-common/sso/q13.c create mode 100644 gcc/testsuite/c-c++-common/sso/t13.c create mode 100644 gcc/testsuite/gnat.dg/sso/init13.ads create mode 100644 gcc/testsuite/gnat.dg/sso/p13.adb create mode 100644 gcc/testsuite/gnat.dg/sso/q13.adb create mode 100644 gcc/testsuite/gnat.dg/sso/t13.adb diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c7ad86c1d41..4d24f15f597 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1196,9 +1196,14 @@ package body Freeze is Attribute_Scalar_Storage_Order); Comp_ADC_Present := Present (Comp_ADC); - -- Case of record or array component: check storage order compatibility + -- Case of record or array component: check storage order compatibility. + -- But, if the record has Complex_Representation, then it is treated as + -- a scalar in the back end so the storage order is irrelevant. - if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then + if (Is_Record_Type (Comp_Type) + and then not Has_Complex_Representation (Comp_Type)) + or else Is_Array_Type (Comp_Type) + then Comp_SSO_Differs := Reverse_Storage_Order (Encl_Type) /= @@ -3958,61 +3963,73 @@ package body Freeze is Next_Entity (Comp); end loop; - -- Deal with default setting of reverse storage order + SSO_ADC := Get_Attribute_Definition_Clause + (Rec, Attribute_Scalar_Storage_Order); - Set_SSO_From_Default (Rec); + -- If the record type has Complex_Representation, then it is treated + -- as a scalar in the back end so the storage order is irrelevant. - -- Check consistent attribute setting on component types + if Has_Complex_Representation (Rec) then + if Present (SSO_ADC) then + Error_Msg_N + ("??storage order has no effect with " + & "Complex_Representation", SSO_ADC); + end if; - SSO_ADC := Get_Attribute_Definition_Clause - (Rec, Attribute_Scalar_Storage_Order); + else + -- Deal with default setting of reverse storage order - declare - Comp_ADC_Present : Boolean; - begin - Comp := First_Component (Rec); - while Present (Comp) loop - Check_Component_Storage_Order - (Encl_Type => Rec, - Comp => Comp, - ADC => SSO_ADC, - Comp_ADC_Present => Comp_ADC_Present); - SSO_ADC_Component := SSO_ADC_Component or Comp_ADC_Present; - Next_Component (Comp); - end loop; - end; + Set_SSO_From_Default (Rec); + + -- Check consistent attribute setting on component types - -- Now deal with reverse storage order/bit order issues + declare + Comp_ADC_Present : Boolean; + begin + Comp := First_Component (Rec); + while Present (Comp) loop + Check_Component_Storage_Order + (Encl_Type => Rec, + Comp => Comp, + ADC => SSO_ADC, + Comp_ADC_Present => Comp_ADC_Present); + SSO_ADC_Component := SSO_ADC_Component or Comp_ADC_Present; + Next_Component (Comp); + end loop; + end; - if Present (SSO_ADC) then + -- Now deal with reverse storage order/bit order issues - -- Check compatibility of Scalar_Storage_Order with Bit_Order, if - -- the former is specified. + if Present (SSO_ADC) then - if Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) then + -- Check compatibility of Scalar_Storage_Order with Bit_Order, + -- if the former is specified. - -- Note: report error on Rec, not on SSO_ADC, as ADC may apply - -- to some ancestor type. + if Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) then - Error_Msg_Sloc := Sloc (SSO_ADC); - Error_Msg_N - ("scalar storage order for& specified# inconsistent with " - & "bit order", Rec); - end if; + -- Note: report error on Rec, not on SSO_ADC, as ADC may + -- apply to some ancestor type. - -- Warn if there is an Scalar_Storage_Order attribute definition - -- clause but no component clause, no component that itself has - -- such an attribute definition, and no pragma Pack. + Error_Msg_Sloc := Sloc (SSO_ADC); + Error_Msg_N + ("scalar storage order for& specified# inconsistent with " + & "bit order", Rec); + end if; - if not (Placed_Component - or else - SSO_ADC_Component - or else - Is_Packed (Rec)) - then - Error_Msg_N - ("??scalar storage order specified but no component clause", - SSO_ADC); + -- Warn if there is a Scalar_Storage_Order attribute definition + -- clause but no component clause, no component that itself has + -- such an attribute definition, and no pragma Pack. + + if not (Placed_Component + or else + SSO_ADC_Component + or else + Is_Packed (Rec)) + then + Error_Msg_N + ("??scalar storage order specified but no component " + & "clause", SSO_ADC); + end if; end if; end if; diff --git a/gcc/expmed.c b/gcc/expmed.c index 42866927f20..b77ed61a5bd 100644 --- a/gcc/expmed.c +++ b/gcc/expmed.c @@ -380,6 +380,17 @@ flip_storage_order (enum machine_mode mode, rtx x) if (mode == QImode) return x; + if (COMPLEX_MODE_P (mode)) + { + rtx real = read_complex_part (x, false); + rtx imag = read_complex_part (x, true); + + real = flip_storage_order (GET_MODE_INNER (mode), real); + imag = flip_storage_order (GET_MODE_INNER (mode), imag); + + return gen_rtx_CONCAT (mode, real, imag); + } + if (__builtin_expect (reverse_storage_order_supported < 0, 0)) check_reverse_storage_order_support (); @@ -391,8 +402,12 @@ flip_storage_order (enum machine_mode mode, rtx x) && __builtin_expect (reverse_float_storage_order_supported < 0, 0)) check_reverse_float_storage_order_support (); - int_mode = int_mode_for_mode (mode); - gcc_assert (int_mode != BLKmode); + int_mode = mode_for_size (GET_MODE_PRECISION (mode), MODE_INT, 0); + if (int_mode == BLKmode) + { + sorry ("reverse storage order for %smode", GET_MODE_NAME (mode)); + return x; + } x = gen_lowpart (int_mode, x); } @@ -1867,9 +1882,21 @@ extract_bit_field_1 (rtx str_rtx, unsigned HOST_WIDE_INT bitsize, /* Should probably push op0 out to memory and then do a load. */ gcc_assert (int_mode != BLKmode); - target = extract_fixed_bit_field (int_mode, op0, bitsize, bitnum, - target, unsignedp, reverse); - return convert_extracted_bit_field (target, mode, tmode, unsignedp); + target = extract_fixed_bit_field (int_mode, op0, bitsize, bitnum, target, + unsignedp, reverse); + + /* Complex values must be reversed piecewise, so we need to undo the global + reversal, convert to the complex mode and reverse again. */ + if (reverse && COMPLEX_MODE_P (tmode)) + { + target = flip_storage_order (int_mode, target); + target = convert_extracted_bit_field (target, mode, tmode, unsignedp); + target = flip_storage_order (tmode, target); + } + else + target = convert_extracted_bit_field (target, mode, tmode, unsignedp); + + return target; } /* Generate code to extract a byte-field from STR_RTX diff --git a/gcc/expr.c b/gcc/expr.c index d4eaedbf2bb..7a539590de8 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -3047,7 +3047,7 @@ write_complex_part (rtx cplx, rtx val, bool imag_p) /* Extract one of the components of the complex value CPLX. Extract the real part if IMAG_P is false, and the imaginary part if it's true. */ -static rtx +rtx read_complex_part (rtx cplx, bool imag_p) { machine_mode cmode, imode; @@ -6889,18 +6889,12 @@ get_inner_reference (tree exp, HOST_WIDE_INT *pbitsize, blkmode_bitfield = true; *punsignedp = DECL_UNSIGNED (field); - /* ??? Fortran can take COMPONENT_REF of a void type. */ - *preversep - = !VOID_TYPE_P (TREE_TYPE (TREE_OPERAND (exp, 0))) - && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (TREE_OPERAND (exp, 0))) - && !AGGREGATE_TYPE_P (TREE_TYPE (exp)); } else if (TREE_CODE (exp) == BIT_FIELD_REF) { size_tree = TREE_OPERAND (exp, 1); *punsignedp = (! INTEGRAL_TYPE_P (TREE_TYPE (exp)) || TYPE_UNSIGNED (TREE_TYPE (exp))); - *preversep = REF_REVERSE_STORAGE_ORDER (exp); /* For vector types, with the correct size of access, use the mode of inner type. */ @@ -6913,12 +6907,6 @@ get_inner_reference (tree exp, HOST_WIDE_INT *pbitsize, { mode = TYPE_MODE (TREE_TYPE (exp)); *punsignedp = TYPE_UNSIGNED (TREE_TYPE (exp)); - *preversep - = ((TREE_CODE (exp) == ARRAY_REF - && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (TREE_OPERAND (exp, 0)))) - || (TREE_CODE (exp) == MEM_REF - && REF_REVERSE_STORAGE_ORDER (exp))) - && !AGGREGATE_TYPE_P (TREE_TYPE (exp)); if (mode == BLKmode) size_tree = TYPE_SIZE (TREE_TYPE (exp)); @@ -6934,6 +6922,8 @@ get_inner_reference (tree exp, HOST_WIDE_INT *pbitsize, *pbitsize = tree_to_uhwi (size_tree); } + *preversep = reverse_storage_order_for_component_p (exp); + /* Compute cumulative bit-offset for nested component-refs and array-refs, and find the ultimate containing object. */ while (1) @@ -10182,9 +10172,12 @@ expand_expr_real_1 (tree exp, rtx target, machine_mode tmode, if (GET_CODE (op0) == CONCAT && !must_force_mem) { if (bitpos == 0 - && bitsize == GET_MODE_BITSIZE (GET_MODE (op0)) - && !reversep) - return op0; + && bitsize == GET_MODE_BITSIZE (GET_MODE (op0))) + { + if (reversep) + op0 = flip_storage_order (GET_MODE (op0), op0); + return op0; + } if (bitpos == 0 && bitsize == GET_MODE_BITSIZE (GET_MODE (XEXP (op0, 0))) && bitsize) diff --git a/gcc/expr.h b/gcc/expr.h index 9082dd19802..2bcb1288b03 100644 --- a/gcc/expr.h +++ b/gcc/expr.h @@ -212,6 +212,7 @@ extern rtx_insn *emit_move_insn_1 (rtx, rtx); extern rtx_insn *emit_move_complex_push (machine_mode, rtx, rtx); extern rtx_insn *emit_move_complex_parts (rtx, rtx); extern void write_complex_part (rtx, rtx, bool); +extern rtx read_complex_part (rtx, bool); extern rtx emit_move_resolve_push (machine_mode, rtx); /* Push a block of length SIZE (perhaps variable) diff --git a/gcc/testsuite/c-c++-common/sso/init13.h b/gcc/testsuite/c-c++-common/sso/init13.h new file mode 100644 index 00000000000..ee58972cfdd --- /dev/null +++ b/gcc/testsuite/c-c++-common/sso/init13.h @@ -0,0 +1,15 @@ +#define I (__extension__ 1.0iF) +#define Pi 3.1415927f + +struct __attribute__((scalar_storage_order("little-endian"))) R1 +{ + _Complex float F; +}; + +struct __attribute__((scalar_storage_order("big-endian"))) R2 +{ + _Complex float F; +}; + +struct R1 My_R1 = { Pi - Pi * I }; +struct R2 My_R2 = { Pi - Pi * I }; diff --git a/gcc/testsuite/c-c++-common/sso/p13.c b/gcc/testsuite/c-c++-common/sso/p13.c new file mode 100644 index 00000000000..08ecf292e44 --- /dev/null +++ b/gcc/testsuite/c-c++-common/sso/p13.c @@ -0,0 +1,64 @@ +/* { dg-do run } */ + +#include + +#include "init13.h" +#include "dump.h" + +int main (void) +{ + struct R1 Local_R1; + struct R2 Local_R2; + + put ("My_R1 :"); + dump (&My_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "My_R1 : db 0f 49 40 db 0f 49 c0\n" } */ + + put ("My_R2 :"); + dump (&My_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "My_R2 : 40 49 0f db c0 49 0f db\n" } */ + + Local_R1 = My_R1; + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } */ + + Local_R2 = My_R2; + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } */ + + Local_R1.F = Pi - Pi * I; + + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } */ + + Local_R2.F = Pi - Pi * I; + + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } */ + + Local_R1.F = Local_R2.F; + + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } */ + + Local_R2.F = Local_R1.F; + + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } */ + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/sso/q13.c b/gcc/testsuite/c-c++-common/sso/q13.c new file mode 100644 index 00000000000..ee34bb2289d --- /dev/null +++ b/gcc/testsuite/c-c++-common/sso/q13.c @@ -0,0 +1,50 @@ +/* { dg-do run } */ + +#include + +#include "init13.h" +#include "dump.h" + +#ifdef __cplusplus +extern "C" +#endif +void abort (void); + +int main (void) +{ + struct R1 A1 = My_R1; + struct R1 B1 = My_R1; + + struct R2 A2 = My_R2; + struct R2 B2 = My_R2; + + put ("A1 :"); + dump (&A1, sizeof (struct R1)); + new_line (); + /* { dg-output "A1 : db 0f 49 40 db 0f 49 c0\n" } */ + + put ("B1 :"); + dump (&B1, sizeof (struct R1)); + new_line (); + /* { dg-output "B1 : db 0f 49 40 db 0f 49 c0\n" } */ + + put ("A2 :"); + dump (&A2, sizeof (struct R2)); + new_line (); + /* { dg-output "A2 : 40 49 0f db c0 49 0f db\n" } */ + + put ("B2 :"); + dump (&B2, sizeof (struct R2)); + new_line (); + /* { dg-output "B2 : 40 49 0f db c0 49 0f db\n" } */ + + if (A1.F != B1.F) abort (); + + if (A1.F != Pi - Pi * I) abort (); + + if (A2.F != B2.F) abort (); + + if (A2.F != Pi - Pi * I) abort (); + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/sso/t13.c b/gcc/testsuite/c-c++-common/sso/t13.c new file mode 100644 index 00000000000..a0f43413449 --- /dev/null +++ b/gcc/testsuite/c-c++-common/sso/t13.c @@ -0,0 +1,56 @@ +/* { dg-do run } */ + +#include + +#include "init13.h" +#include "dump.h" + +int main (void) +{ + struct R1 Local_R1; + struct R2 Local_R2; + + Local_R1.F = My_R1.F + (1.0f + 1.0f * I); + + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : ee 87 84 40 db 0f 09 c0\n" } */ + + Local_R2.F = My_R2.F + (1.0f + 1.0f * I); + + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 84 87 ee c0 09 0f db\n" } */ + + Local_R1.F = Pi - Pi * I; + + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } */ + + Local_R2.F = Pi - Pi * I; + + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } */ + + Local_R1.F = Local_R1.F + (1.0f + 1.0f * I); + + put ("Local_R1 :"); + dump (&Local_R1, sizeof (struct R1)); + new_line (); + /* { dg-output "Local_R1 : ee 87 84 40 db 0f 09 c0\n" } */ + + Local_R2.F = Local_R2.F + (1.0f + 1.0f * I); + + put ("Local_R2 :"); + dump (&Local_R2, sizeof (struct R2)); + new_line (); + /* { dg-output "Local_R2 : 40 84 87 ee c0 09 0f db\n" } */ + + return 0; +} diff --git a/gcc/testsuite/gcc.c-torture/execute/990413-2.c b/gcc/testsuite/gcc.c-torture/execute/990413-2.c index 3beb5403b87..65a5a353462 100644 --- a/gcc/testsuite/gcc.c-torture/execute/990413-2.c +++ b/gcc/testsuite/gcc.c-torture/execute/990413-2.c @@ -1,5 +1,6 @@ /* This tests for a bug in regstack that was breaking glibc's math library. */ /* { dg-skip-if "" { ! { i?86-*-* x86_64-*-* } } { "*" } { "" } } */ +/* { dg-skip-if "requires default endianness" { *-*-* } "-fsso-struct=*" "" } */ extern void abort (void); diff --git a/gcc/testsuite/gcc.c-torture/execute/bitfld-6.c b/gcc/testsuite/gcc.c-torture/execute/bitfld-6.c index 50927dc1d53..d54a7376017 100644 --- a/gcc/testsuite/gcc.c-torture/execute/bitfld-6.c +++ b/gcc/testsuite/gcc.c-torture/execute/bitfld-6.c @@ -1,3 +1,5 @@ +/* { dg-skip-if "requires default endianness" { *-*-* } "-fsso-struct=*" "" } */ + union U { const int a; diff --git a/gcc/testsuite/gcc.c-torture/execute/bitfld-7.c b/gcc/testsuite/gcc.c-torture/execute/bitfld-7.c index e9a61df52f3..158ee2b13eb 100644 --- a/gcc/testsuite/gcc.c-torture/execute/bitfld-7.c +++ b/gcc/testsuite/gcc.c-torture/execute/bitfld-7.c @@ -1,3 +1,5 @@ +/* { dg-skip-if "requires default endianness" { *-*-* } "-fsso-struct=*" "" } */ + union U { const int a; diff --git a/gcc/testsuite/gcc.c-torture/execute/comp-goto-1.c b/gcc/testsuite/gcc.c-torture/execute/comp-goto-1.c index 3bf9a26f655..3e5da01a6e4 100644 --- a/gcc/testsuite/gcc.c-torture/execute/comp-goto-1.c +++ b/gcc/testsuite/gcc.c-torture/execute/comp-goto-1.c @@ -1,3 +1,5 @@ +/* { dg-skip-if "requires default endianness" { *-*-* } "-fsso-struct=*" "" } */ + #include #if !defined(NO_LABEL_VALUES) && (!defined(STACK_SIZE) || STACK_SIZE >= 4000) && __INT_MAX__ >= 2147483647 diff --git a/gcc/testsuite/gcc.c-torture/execute/pr65401.c b/gcc/testsuite/gcc.c-torture/execute/pr65401.c index 82cfafc04c0..cf8c7532355 100644 --- a/gcc/testsuite/gcc.c-torture/execute/pr65401.c +++ b/gcc/testsuite/gcc.c-torture/execute/pr65401.c @@ -1,4 +1,5 @@ /* PR rtl-optimization/65401 */ +/* { dg-skip-if "requires default endianness" { *-*-* } "-fsso-struct=*" "" } */ struct S { unsigned short s[64]; }; diff --git a/gcc/testsuite/gnat.dg/sso/init13.ads b/gcc/testsuite/gnat.dg/sso/init13.ads new file mode 100644 index 00000000000..9cac9e9c567 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso/init13.ads @@ -0,0 +1,33 @@ +with Ada.Numerics; use Ada.Numerics; +with System; + +package Init13 is + + type Complex is record + R : Float; + I : Float; + end record; + pragma Complex_Representation (Complex); + + type R1 is record + F : Complex; + end record; + for R1'Bit_Order use System.Low_Order_First; + for R1'Scalar_Storage_Order use System.Low_Order_First; + for R1 use record + F at 0 range 0 .. 63; + end record; + + type R2 is record + F : Complex; + end record; + for R2'Bit_Order use System.High_Order_First; + for R2'Scalar_Storage_Order use System.High_Order_First; + for R2 use record + F at 0 range 0 .. 63; + end record; + + My_R1 : constant R1 := (F => (Pi, -Pi)); + My_R2 : constant R2 := (F => (Pi, -Pi)); + +end Init13; diff --git a/gcc/testsuite/gnat.dg/sso/p13.adb b/gcc/testsuite/gnat.dg/sso/p13.adb new file mode 100644 index 00000000000..49db1114c68 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso/p13.adb @@ -0,0 +1,63 @@ +-- { dg-do run } + +with Init13; use Init13; +with Ada.Numerics; use Ada.Numerics; +with Text_IO; use Text_IO; +with Dump; + +procedure P13 is + + Local_R1 : R1; + Local_R2 : R2; + +begin + Put ("My_R1 :"); + Dump (My_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "My_R1 : db 0f 49 40 db 0f 49 c0\n" } + + Put ("My_R2 :"); + Dump (My_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "My_R2 : 40 49 0f db c0 49 0f db\n" } + + Local_R1 := My_R1; + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } + + Local_R2 := My_R2; + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } + + Local_R1.F := (Pi, -Pi); + + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } + + Local_R2.F := (Pi, -Pi); + + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } + + Local_R1.F := Local_R2.F; + + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } + + Local_R2.F := Local_R1.F; + + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } +end; diff --git a/gcc/testsuite/gnat.dg/sso/q13.adb b/gcc/testsuite/gnat.dg/sso/q13.adb new file mode 100644 index 00000000000..e07530fb2aa --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso/q13.adb @@ -0,0 +1,53 @@ +-- { dg-do run } + +with Init13; use Init13; +with Ada.Numerics; use Ada.Numerics; +with Text_IO; use Text_IO; +with Dump; + +procedure Q13 is + + A1 : R1 := My_R1; + B1 : R1 := My_R1; + + A2 : R2 := My_R2; + B2 : R2 := My_R2; + +begin + Put ("A1 :"); + Dump (A1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "A1 : db 0f 49 40 db 0f 49 c0\n" } + + Put ("B1 :"); + Dump (B1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "B1 : db 0f 49 40 db 0f 49 c0\n" } + + Put ("A2 :"); + Dump (A2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "A2 : 40 49 0f db c0 49 0f db\n" } + + Put ("B2 :"); + Dump (B2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "B2 : 40 49 0f db c0 49 0f db\n" } + + if A1.F /= B1.F then + raise Program_Error; + end if; + + if A1.F /= (Pi, -Pi) then + raise Program_Error; + end if; + + if A2.F /= B2.F then + raise Program_Error; + end if; + + if A2.F /= (Pi, -Pi) then + raise Program_Error; + end if; + +end; diff --git a/gcc/testsuite/gnat.dg/sso/t13.adb b/gcc/testsuite/gnat.dg/sso/t13.adb new file mode 100644 index 00000000000..e00371f7520 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso/t13.adb @@ -0,0 +1,56 @@ +-- { dg-do run } + +with Init13; use Init13; +with Ada.Numerics; use Ada.Numerics; +with Text_IO; use Text_IO; +with Dump; + +procedure T13 is + + Local_R1 : R1; + Local_R2 : R2; + +begin + Local_R1.F := (My_R1.F.R + 1.0, My_R1.F.I + 1.0); + + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : ee 87 84 40 db 0f 09 c0\n" } + + Local_R2.F := (My_R2.F.R + 1.0, My_R2.F.I + 1.0); + + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 84 87 ee c0 09 0f db\n" } + + Local_R1.F := (Pi, -Pi); + + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : db 0f 49 40 db 0f 49 c0\n" } + + Local_R2.F := (Pi, -Pi); + + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 49 0f db c0 49 0f db\n" } + + Local_R1.F := (Local_R1.F.R + 1.0, Local_R1.F.I + 1.0); + + Put ("Local_R1 :"); + Dump (Local_R1'Address, R1'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R1 : ee 87 84 40 db 0f 09 c0\n" } + + Local_R2.F := (Local_R2.F.R + 1.0, Local_R2.F.I + 1.0); + + Put ("Local_R2 :"); + Dump (Local_R2'Address, R2'Max_Size_In_Storage_Elements); + New_Line; + -- { dg-output "Local_R2 : 40 84 87 ee c0 09 0f db\n" } + +end; diff --git a/gcc/tree-dfa.c b/gcc/tree-dfa.c index 788d4d3a1d4..eaf8df6671c 100644 --- a/gcc/tree-dfa.c +++ b/gcc/tree-dfa.c @@ -416,17 +416,9 @@ get_ref_base_and_extent (tree exp, HOST_WIDE_INT *poffset, /* First get the final access size and the storage order from just the outermost expression. */ if (TREE_CODE (exp) == COMPONENT_REF) - { - size_tree = DECL_SIZE (TREE_OPERAND (exp, 1)); - *preverse - = TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (TREE_OPERAND (exp, 0))) - && !AGGREGATE_TYPE_P (TREE_TYPE (exp)); - } + size_tree = DECL_SIZE (TREE_OPERAND (exp, 1)); else if (TREE_CODE (exp) == BIT_FIELD_REF) - { - size_tree = TREE_OPERAND (exp, 1); - *preverse = REF_REVERSE_STORAGE_ORDER (exp); - } + size_tree = TREE_OPERAND (exp, 1); else if (!VOID_TYPE_P (TREE_TYPE (exp))) { machine_mode mode = TYPE_MODE (TREE_TYPE (exp)); @@ -434,20 +426,13 @@ get_ref_base_and_extent (tree exp, HOST_WIDE_INT *poffset, size_tree = TYPE_SIZE (TREE_TYPE (exp)); else bitsize = int (GET_MODE_PRECISION (mode)); - *preverse - = ((TREE_CODE (exp) == ARRAY_REF - && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (TREE_OPERAND (exp, 0)))) - || (TREE_CODE (exp) == MEM_REF - && REF_REVERSE_STORAGE_ORDER (exp))) - && !AGGREGATE_TYPE_P (TREE_TYPE (exp)); } - else - *preverse = false; - if (size_tree != NULL_TREE && TREE_CODE (size_tree) == INTEGER_CST) bitsize = wi::to_offset (size_tree); + *preverse = reverse_storage_order_for_component_p (exp); + /* Initially, maxsize is the same as the accessed element size. In the following it will only grow (or become -1). */ maxsize = bitsize; diff --git a/gcc/tree.h b/gcc/tree.h index 7732b249a0e..045bddd6380 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -4306,23 +4306,56 @@ handled_component_p (const_tree t) } } -/* Return true if REF is a storage order barrier, i.e. a VIEW_CONVERT_EXPR +/* Return true T is a component with reverse storage order. */ + +static inline bool +reverse_storage_order_for_component_p (tree t) +{ + /* The storage order only applies to scalar components. */ + if (AGGREGATE_TYPE_P (TREE_TYPE (t))) + return false; + + if (TREE_CODE (t) == REALPART_EXPR || TREE_CODE (t) == IMAGPART_EXPR) + t = TREE_OPERAND (t, 0); + + switch (TREE_CODE (t)) + { + case ARRAY_REF: + case COMPONENT_REF: + /* ??? Fortran can take COMPONENT_REF of a void type. */ + return !VOID_TYPE_P (TREE_TYPE (TREE_OPERAND (t, 0))) + && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (TREE_OPERAND (t, 0))); + + case BIT_FIELD_REF: + case MEM_REF: + return REF_REVERSE_STORAGE_ORDER (t); + + case ARRAY_RANGE_REF: + case VIEW_CONVERT_EXPR: + default: + return false; + } + + gcc_unreachable (); +} + +/* Return true if T is a storage order barrier, i.e. a VIEW_CONVERT_EXPR that can modify the storage order of objects. Note that, even if the TYPE_REVERSE_STORAGE_ORDER flag is set on both the inner type and the outer type, a VIEW_CONVERT_EXPR can modify the storage order because it can change the partition of the aggregate object into scalars. */ static inline bool -storage_order_barrier_p (const_tree ref) +storage_order_barrier_p (const_tree t) { - if (TREE_CODE (ref) != VIEW_CONVERT_EXPR) + if (TREE_CODE (t) != VIEW_CONVERT_EXPR) return false; - if (AGGREGATE_TYPE_P (TREE_TYPE (ref)) - && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (ref))) + if (AGGREGATE_TYPE_P (TREE_TYPE (t)) + && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (t))) return true; - tree op = TREE_OPERAND (ref, 0); + tree op = TREE_OPERAND (t, 0); if (AGGREGATE_TYPE_P (TREE_TYPE (op)) && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (op))) -- 2.11.4.GIT