Index: ada/freeze.adb =================================================================== --- ada/freeze.adb (.../trunk/gcc) (revision 228112) +++ ada/freeze.adb (.../branches/scalar-storage-order/gcc) (revision 228133) @@ -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 - - if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then + -- 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) + 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. - - 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); + Error_Msg_Sloc := Sloc (SSO_ADC); + Error_Msg_N + ("scalar storage order for& specified# inconsistent with " + & "bit order", Rec); + end if; + + -- 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; Index: ada/gcc-interface/utils.c =================================================================== --- ada/gcc-interface/utils.c (.../trunk/gcc) (revision 228112) +++ ada/gcc-interface/utils.c (.../branches/scalar-storage-order/gcc) (revision 228133) @@ -963,6 +963,7 @@ make_packable_type (tree type, bool in_r TYPE_NAME (new_type) = TYPE_NAME (type); TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); + TYPE_REVERSE_STORAGE_ORDER (new_type) = TYPE_REVERSE_STORAGE_ORDER (type); if (TREE_CODE (type) == RECORD_TYPE) TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type); @@ -1181,14 +1182,15 @@ pad_type_hasher::equal (pad_type_hash *t type1 = t1->type; type2 = t2->type; - /* We consider that the padded types are equivalent if they pad the same - type and have the same size, alignment and RM size. Taking the mode - into account is redundant since it is determined by the others. */ + /* We consider that the padded types are equivalent if they pad the same type + and have the same size, alignment, RM size and storage order. Taking the + mode into account is redundant since it is determined by the others. */ return TREE_TYPE (TYPE_FIELDS (type1)) == TREE_TYPE (TYPE_FIELDS (type2)) && TYPE_SIZE (type1) == TYPE_SIZE (type2) && TYPE_ALIGN (type1) == TYPE_ALIGN (type2) - && TYPE_ADA_SIZE (type1) == TYPE_ADA_SIZE (type2); + && TYPE_ADA_SIZE (type1) == TYPE_ADA_SIZE (type2) + && TYPE_REVERSE_STORAGE_ORDER (type1) == TYPE_REVERSE_STORAGE_ORDER (type2); } /* Look up the padded TYPE in the hash table and return its canonical version @@ -1458,6 +1460,31 @@ built: return record; } + +/* Return a copy of the padded TYPE but with reverse storage order. */ + +tree +set_reverse_storage_order_on_pad_type (tree type) +{ + tree field, canonical_pad_type; + +#ifdef ENABLE_CHECKING + /* If the inner type is not scalar then the function does nothing. */ + tree inner_type = TREE_TYPE (TYPE_FIELDS (type)); + gcc_assert (!AGGREGATE_TYPE_P (inner_type) && !VECTOR_TYPE_P (inner_type)); +#endif + + /* This is required for the canonicalization. */ + gcc_assert (TREE_CONSTANT (TYPE_SIZE (type))); + + field = copy_node (TYPE_FIELDS (type)); + type = copy_type (type); + DECL_CONTEXT (field) = type; + TYPE_FIELDS (type) = field; + TYPE_REVERSE_STORAGE_ORDER (type) = 1; + canonical_pad_type = lookup_and_insert_pad_type (type); + return canonical_pad_type ? canonical_pad_type : type; +} /* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP. If this is a multi-dimensional array type, do this recursively. @@ -3365,7 +3392,7 @@ gnat_types_compatible_p (tree t1, tree t return 1; /* Array types are also compatible if they are constrained and have the same - domain(s) and the same component type. */ + domain(s), the same component type and the same scalar storage order. */ if (code == ARRAY_TYPE && (TYPE_DOMAIN (t1) == TYPE_DOMAIN (t2) || (TYPE_DOMAIN (t1) @@ -3376,7 +3403,8 @@ gnat_types_compatible_p (tree t1, tree t TYPE_MAX_VALUE (TYPE_DOMAIN (t2))))) && (TREE_TYPE (t1) == TREE_TYPE (t2) || (TREE_CODE (TREE_TYPE (t1)) == ARRAY_TYPE - && gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2))))) + && gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2)))) + && TYPE_REVERSE_STORAGE_ORDER (t1) == TYPE_REVERSE_STORAGE_ORDER (t2)) return 1; return 0; @@ -4857,17 +4885,38 @@ unchecked_convert (tree type, tree expr, } /* If we are converting to an integral type whose precision is not equal - to its size, first unchecked convert to a record type that contains an - field of the given precision. Then extract the field. */ + to its size, first unchecked convert to a record type that contains a + field of the given precision. Then extract the result from the field. + + There is a subtlety if the source type is an aggregate type with reverse + storage order because its representation is not contiguous in the native + storage order, i.e. a direct unchecked conversion to an integral type + with N bits of precision cannot read the first N bits of the aggregate + type. To overcome it, we do an unchecked conversion to an integral type + with reverse storage order and return the resulting value. This also + ensures that the result of the unchecked conversion doesn't depend on + the endianness of the target machine, but only on the storage order of + the aggregate type. + + 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) - && 0 != compare_tree_int (TYPE_RM_SIZE (type), - GET_MODE_BITSIZE (TYPE_MODE (type)))) + && (0 != compare_tree_int (TYPE_RM_SIZE (type), + GET_MODE_BITSIZE (TYPE_MODE (type))) + || (AGGREGATE_TYPE_P (etype) + && TYPE_REVERSE_STORAGE_ORDER (etype)))) { 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); + if (TYPE_UNSIGNED (type)) field_type = make_unsigned_type (prec); else @@ -4886,11 +4935,16 @@ unchecked_convert (tree type, tree expr, /* Similarly if we are converting from an integral type whose precision is not equal to its size, first copy into a field of the given precision - and unchecked convert the record type. */ + and unchecked convert the record type. + + 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) - && 0 != compare_tree_int (TYPE_RM_SIZE (etype), - GET_MODE_BITSIZE (TYPE_MODE (etype)))) + && (0 != compare_tree_int (TYPE_RM_SIZE (etype), + GET_MODE_BITSIZE (TYPE_MODE (etype))) + || (AGGREGATE_TYPE_P (type) + && TYPE_REVERSE_STORAGE_ORDER (type)))) { tree rec_type = make_node (RECORD_TYPE); unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype)); @@ -4898,6 +4952,10 @@ unchecked_convert (tree type, tree expr, vec_alloc (v, 1); tree field_type, field; + if (AGGREGATE_TYPE_P (type)) + TYPE_REVERSE_STORAGE_ORDER (rec_type) + = TYPE_REVERSE_STORAGE_ORDER (type); + if (TYPE_UNSIGNED (etype)) field_type = make_unsigned_type (prec); else Index: ada/gcc-interface/decl.c =================================================================== --- ada/gcc-interface/decl.c (.../trunk/gcc) (revision 228112) +++ ada/gcc-interface/decl.c (.../branches/scalar-storage-order/gcc) (revision 228133) @@ -1808,6 +1808,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit TYPE_ALIGN (gnu_type) = align > 0 ? align : TYPE_ALIGN (gnu_field_type); + /* Propagate the reverse storage order flag to the record type so + that the required byte swapping is performed when retrieving the + enclosed modular value. */ + TYPE_REVERSE_STORAGE_ORDER (gnu_type) + = Reverse_Storage_Order (Original_Array_Type (gnat_entity)); + relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); /* Don't declare the field as addressable since we won't be taking @@ -2155,8 +2161,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit for (index = ndim - 1; index >= 0; index--) { tem = build_nonshared_array_type (tem, gnu_index_types[index]); - if (Reverse_Storage_Order (gnat_entity) && !GNAT_Mode) - sorry ("non-default Scalar_Storage_Order"); + if (index == ndim - 1) + TYPE_REVERSE_STORAGE_ORDER (tem) + = Reverse_Storage_Order (gnat_entity); TYPE_MULTI_ARRAY_P (tem) = (index > 0); if (array_type_has_nonaliased_component (tem, gnat_entity)) TYPE_NONALIASED_COMPONENT (tem) = 1; @@ -2519,6 +2526,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit { gnu_type = build_nonshared_array_type (gnu_type, gnu_index_types[index]); + if (index == ndim - 1) + TYPE_REVERSE_STORAGE_ORDER (gnu_type) + = Reverse_Storage_Order (gnat_entity); TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0); if (array_type_has_nonaliased_component (gnu_type, gnat_entity)) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; @@ -2881,8 +2891,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit gnu_type = make_node (tree_code_for_record_type (gnat_entity)); TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_PACKED (gnu_type) = (packed != 0) || has_rep; - if (Reverse_Storage_Order (gnat_entity) && !GNAT_Mode) - sorry ("non-default Scalar_Storage_Order"); + TYPE_REVERSE_STORAGE_ORDER (gnu_type) + = Reverse_Storage_Order (gnat_entity); process_attributes (&gnu_type, &attr_list, true, gnat_entity); if (!definition) @@ -3292,6 +3302,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_PACKED (gnu_type) = TYPE_PACKED (gnu_base_type); + TYPE_REVERSE_STORAGE_ORDER (gnu_type) + = Reverse_Storage_Order (gnat_entity); process_attributes (&gnu_type, &attr_list, true, gnat_entity); /* Set the size, alignment and alias set of the new type to @@ -3346,6 +3358,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit TYPE_NAME (new_variant) = concat_name (TYPE_NAME (gnu_type), IDENTIFIER_POINTER (suffix)); + TYPE_REVERSE_STORAGE_ORDER (new_variant) + = TYPE_REVERSE_STORAGE_ORDER (gnu_type); copy_and_substitute_in_size (new_variant, old_variant, gnu_subst_list); v->new_type = new_variant; @@ -5553,6 +5567,16 @@ gnat_to_gnu_component_type (Entity_Id gn gnat_array); } + /* If the component type is a padded type made for a non-bit-packed array + of scalars with reverse storage order, we need to propagate the reverse + storage order to the padding type since it is the innermost enclosing + aggregate type around the scalar. */ + if (TYPE_IS_PADDING_P (gnu_type) + && Reverse_Storage_Order (gnat_array) + && !Is_Bit_Packed_Array (gnat_array) + && Is_Scalar_Type (gnat_type)) + gnu_type = set_reverse_storage_order_on_pad_type (gnu_type); + if (Has_Volatile_Components (gnat_array)) { const int quals @@ -6724,6 +6748,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, else gnu_pos = NULL_TREE; + /* If the field's type is a padded type made for a scalar field of a record + type with reverse storage order, we need to propagate the reverse storage + order to the padding type since it is the innermost enclosing aggregate + type around the scalar. */ + if (TYPE_IS_PADDING_P (gnu_field_type) + && TYPE_REVERSE_STORAGE_ORDER (gnu_record_type) + && Is_Scalar_Type (gnat_field_type)) + gnu_field_type = set_reverse_storage_order_on_pad_type (gnu_field_type); + gcc_assert (TREE_CODE (gnu_field_type) != RECORD_TYPE || !TYPE_CONTAINS_TEMPLATE_P (gnu_field_type)); @@ -7040,6 +7073,8 @@ components_to_record (tree gnu_record_ty TYPE_NAME (gnu_union_type) = gnu_union_name; TYPE_ALIGN (gnu_union_type) = 0; TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type); + TYPE_REVERSE_STORAGE_ORDER (gnu_union_type) + = TYPE_REVERSE_STORAGE_ORDER (gnu_record_type); } /* If all the fields down to this level have a rep clause, find out @@ -7091,6 +7126,8 @@ components_to_record (tree gnu_record_ty record actually gets only the alignment required. */ TYPE_ALIGN (gnu_variant_type) = TYPE_ALIGN (gnu_record_type); TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type); + TYPE_REVERSE_STORAGE_ORDER (gnu_variant_type) + = TYPE_REVERSE_STORAGE_ORDER (gnu_record_type); /* Similarly, if the outer record has a size specified and all the fields have a rep clause, we can propagate the size. */ @@ -7183,6 +7220,8 @@ components_to_record (tree gnu_record_ty position at this level. */ tree gnu_rep_type = make_node (RECORD_TYPE); tree gnu_rep_part; + TYPE_REVERSE_STORAGE_ORDER (gnu_rep_type) + = TYPE_REVERSE_STORAGE_ORDER (gnu_variant_type); finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info); gnu_rep_part = create_rep_part (gnu_rep_type, gnu_variant_type, @@ -7390,6 +7429,8 @@ components_to_record (tree gnu_record_ty gnu_field_list = gnu_rep_list; else { + TYPE_REVERSE_STORAGE_ORDER (gnu_rep_type) + = TYPE_REVERSE_STORAGE_ORDER (gnu_record_type); finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info); /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields Index: ada/gcc-interface/utils2.c =================================================================== --- ada/gcc-interface/utils2.c (.../trunk/gcc) (revision 228112) +++ ada/gcc-interface/utils2.c (.../branches/scalar-storage-order/gcc) (revision 228133) @@ -1412,11 +1412,11 @@ build_unary_op (enum tree_code op_code, HOST_WIDE_INT bitpos; tree offset, inner; machine_mode mode; - int unsignedp, volatilep; + int unsignedp, reversep, volatilep; inner = get_inner_reference (operand, &bitsize, &bitpos, &offset, - &mode, &unsignedp, &volatilep, - false); + &mode, &unsignedp, &reversep, + &volatilep, false); /* If INNER is a padding type whose field has a self-referential size, convert to that inner type. We know the offset is zero @@ -1920,7 +1920,9 @@ gnat_build_constructor (tree type, vec