===================================================================
@@ -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;
===================================================================
@@ -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
===================================================================
@@ -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
===================================================================
@@ -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<c
|| (TREE_CODE (type) == RECORD_TYPE
&& CONSTRUCTOR_BITFIELD_P (obj)
&& !initializer_constant_valid_for_bitfield_p (val))
- || !initializer_constant_valid_p (val, TREE_TYPE (val)))
+ || !initializer_constant_valid_p (val,
+ TREE_TYPE (val),
+ TYPE_REVERSE_STORAGE_ORDER (type)))
allconstant = false;
if (!TREE_READONLY (val))
@@ -2748,6 +2750,7 @@ gnat_rewrite_reference (tree ref, rewrit
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
data, init),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
+ REF_REVERSE_STORAGE_ORDER (result) = REF_REVERSE_STORAGE_ORDER (ref);
break;
case ARRAY_REF:
===================================================================
@@ -154,6 +154,9 @@ extern tree maybe_pad_type (tree type, t
bool is_user_type, bool definition,
bool set_rm_size);
+/* Return a copy of the padded TYPE but with reverse storage order. */
+extern tree set_reverse_storage_order_on_pad_type (tree type);
+
enum alias_set_op
{
ALIAS_SET_COPY,
===================================================================
@@ -2170,7 +2170,7 @@ Attribute_to_gnu (Node_Id gnat_node, tre
tree gnu_field_offset;
tree gnu_inner;
machine_mode mode;
- int unsignedp, volatilep;
+ int unsignedp, reversep, volatilep;
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_prefix = remove_conversions (gnu_prefix, true);
@@ -2192,7 +2192,7 @@ Attribute_to_gnu (Node_Id gnat_node, tre
&& TREE_CODE (gnu_prefix) == FIELD_DECL));
get_inner_reference (gnu_prefix, &bitsize, &bitpos, &gnu_offset,
- &mode, &unsignedp, &volatilep, false);
+ &mode, &unsignedp, &reversep, &volatilep, false);
if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
{