Skip to content

R
riscv-gcc-1
Commit 910d20fc by Robert Dewar Committed by Arnaud Charlet
Options

decl.c (gnat_to_gnu_type, [...]): Wrap modular packed array types in both… 

decl.c (gnat_to_gnu_type, [...]): Wrap modular packed array types in both little- and big-endian cases.

2004-09-21  Robert Dewar  <dewar@gnat.com>

	* decl.c (gnat_to_gnu_type, case E_Modular_Integer_Type): Wrap modular
	packed array types in both little- and big-endian cases. This change
	ensures that we no longer count on the unused bits being initialized
	for such types (and in particular ensures that equality testing will
	only read the relevant bits).
	Change name TYPE_LEFT_JUSTIFIED_MODULAR_P to TYPE_JUSTIFIED_MODULAR_P
	These changes mean that we no longer need to initialize small packed
	arrays.
	(gnat_to_gnu_entity) <E_Record_Subtype>: Apply the same
	optimization to an LJM field as to its parent field.

	* ada-tree.h:, trans.c, utils.c, utils2.c:
	Change name TYPE_LEFT_JUSTIFIED_MODULAR_P to TYPE_JUSTIFIED_MODULAR_P

From-SVN: r87806
parent f1b18462
Showing with 74 additions and 50 deletions
gcc/ada/ChangeLog
2004-09-21 Robert Dewar <dewar@gnat.com>
* decl.c (gnat_to_gnu_type, case E_Modular_Integer_Type): Wrap modular
packed array types in both little- and big-endian cases. This change
ensures that we no longer count on the unused bits being initialized
for such types (and in particular ensures that equality testing will
only read the relevant bits).
Change name TYPE_LEFT_JUSTIFIED_MODULAR_P to TYPE_JUSTIFIED_MODULAR_P
These changes mean that we no longer need to initialize small packed
arrays.
(gnat_to_gnu_entity) <E_Record_Subtype>: Apply the same
optimization to an LJM field as to its parent field.
* ada-tree.h, trans.c, utils.c, utils2.c:
Change name TYPE_LEFT_JUSTIFIED_MODULAR_P to TYPE_JUSTIFIED_MODULAR_P
2004-09-20 Jan Hubicka <jh@suse.cz> 2004-09-20 Jan Hubicka <jh@suse.cz>
* utils.c (gnat_finalize): Remove. * utils.c (gnat_finalize): Remove.
......
gcc/ada/ada-tree.h
...@@ -86,8 +86,8 @@ struct lang_type GTY(()) {tree t; }; ...@@ -86,8 +86,8 @@ struct lang_type GTY(()) {tree t; };
TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE)) TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE))
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes
a left-justified modular type (will only be true for RECORD_TYPE). */ a justified modular type (will only be true for RECORD_TYPE). */
#define TYPE_LEFT_JUSTIFIED_MODULAR_P(NODE) \ #define TYPE_JUSTIFIED_MODULAR_P(NODE) \
TYPE_LANG_FLAG_1 (RECORD_OR_UNION_CHECK (NODE)) TYPE_LANG_FLAG_1 (RECORD_OR_UNION_CHECK (NODE))
/* Nonzero in an arithmetic subtype if this is a subtype not known to the /* Nonzero in an arithmetic subtype if this is a subtype not known to the
...@@ -290,4 +290,4 @@ struct lang_type GTY(()) {tree t; }; ...@@ -290,4 +290,4 @@ struct lang_type GTY(()) {tree t; };
#define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2) #define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
#define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0) #define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0)
#define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1) #define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1)
#define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 2) #define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE(NODE, HANDLER_STMT, 2)
gcc/ada/decl.c
...@@ -1341,9 +1341,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1341,9 +1341,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If the type we are dealing with is to represent a packed array, /* If the type we are dealing with is to represent a packed array,
we need to have the bits left justified on big-endian targets we need to have the bits left justified on big-endian targets
(see exp_packd.ads). We build a record with a bitfield of the and right justified on little-endian targets. We also need to
appropriate size to achieve this. */ ensure that when the value is read (e.g. for comparison of two
if (Is_Packed_Array_Type (gnat_entity) && BYTES_BIG_ENDIAN) such values), we only get the good bits, since the unused bits
are uninitialized. Both goals are accomplished by wrapping the
modular value in an enclosing struct. */
if (Is_Packed_Array_Type (gnat_entity))
{ {
tree gnu_field_type = gnu_type; tree gnu_field_type = gnu_type;
tree gnu_field; tree gnu_field;
...@@ -1362,7 +1365,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1362,7 +1365,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field_type, gnu_type, 1, 0, 0, 0); gnu_field_type, gnu_type, 1, 0, 0, 0);
finish_record_type (gnu_type, gnu_field, false, false); finish_record_type (gnu_type, gnu_field, false, false);
TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type) = 1; TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize)); SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
} }
...@@ -2108,7 +2111,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2108,7 +2111,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
save_gnu_tree (gnat_entity, NULL_TREE, false); save_gnu_tree (gnat_entity, NULL_TREE, false);
while (TREE_CODE (gnu_inner_type) == RECORD_TYPE while (TREE_CODE (gnu_inner_type) == RECORD_TYPE
&& (TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_inner_type) && (TYPE_JUSTIFIED_MODULAR_P (gnu_inner_type)
|| TYPE_IS_PADDING_P (gnu_inner_type))) || TYPE_IS_PADDING_P (gnu_inner_type)))
gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type)); gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type));
...@@ -2164,7 +2167,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2164,7 +2167,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (TREE_CODE (gnu_type) == RECORD_TYPE if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type)) && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner_type; TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner_type;
} }
} }
...@@ -2631,9 +2634,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2631,9 +2634,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If there was a component clause, the field types must be /* If there was a component clause, the field types must be
the same for the type and subtype, so copy the data from the same for the type and subtype, so copy the data from
the old field to avoid recomputation here. */ the old field to avoid recomputation here. Also if the
field is justified modular and the optimization in
gnat_to_gnu_field was applied. */
if (Present (Component_Clause if (Present (Component_Clause
(Original_Record_Component (gnat_field)))) (Original_Record_Component (gnat_field)))
|| (TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
&& TREE_TYPE (TYPE_FIELDS (gnu_field_type))
== TREE_TYPE (gnu_old_field)))
{ {
gnu_size = DECL_SIZE (gnu_old_field); gnu_size = DECL_SIZE (gnu_old_field);
gnu_field_type = TREE_TYPE (gnu_old_field); gnu_field_type = TREE_TYPE (gnu_old_field);
...@@ -4650,8 +4659,8 @@ make_packable_type (tree type) ...@@ -4650,8 +4659,8 @@ make_packable_type (tree type)
the alignment to try for an integral type. For QUAL_UNION_TYPE, the alignment to try for an integral type. For QUAL_UNION_TYPE,
also copy the size. */ also copy the size. */
TYPE_NAME (new_type) = TYPE_NAME (type); TYPE_NAME (new_type) = TYPE_NAME (type);
TYPE_LEFT_JUSTIFIED_MODULAR_P (new_type) TYPE_JUSTIFIED_MODULAR_P (new_type)
= TYPE_LEFT_JUSTIFIED_MODULAR_P (type); = TYPE_JUSTIFIED_MODULAR_P (type);
TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
if (TREE_CODE (type) == RECORD_TYPE) if (TREE_CODE (type) == RECORD_TYPE)
...@@ -5021,15 +5030,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -5021,15 +5030,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true); gnat_field, FIELD_DECL, false, true);
/* If the field's type is left-justified modular, the wrapper can prevent /* If the field's type is justified modular, the wrapper can prevent
packing so we make the field the type of the inner object unless the packing so we make the field the type of the inner object unless the
situation forbids it. We may not do that when the field is addressable_p, situation forbids it. We may not do that when the field is addressable_p,
typically because in that case this field may later be passed by-ref for typically because in that case this field may later be passed by-ref for
a formal argument expecting the left justification. The condition below a formal argument expecting the justification. The condition below
is then matching the addressable_p code for COMPONENT_REF. */ is then matching the addressable_p code for COMPONENT_REF. */
if (!Is_Aliased (gnat_field) && flag_strict_aliasing if (!Is_Aliased (gnat_field) && flag_strict_aliasing
&& TREE_CODE (gnu_field_type) == RECORD_TYPE && TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type)) && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type))
gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type)); gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
/* If we are packing this record, have a specified size that's smaller than /* If we are packing this record, have a specified size that's smaller than
...@@ -5175,12 +5184,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -5175,12 +5184,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
gnu_pos = NULL_TREE; gnu_pos = NULL_TREE;
else else
{ {
/* Unless this field is aliased, we can remove any left-justified /* Unless this field is aliased, we can remove any justified
modular type since it's only needed in the unchecked conversion modular type since it's only needed in the unchecked conversion
case, which doesn't apply here. */ case, which doesn't apply here. */
if (!needs_strict_alignment if (!needs_strict_alignment
&& TREE_CODE (gnu_field_type) == RECORD_TYPE && TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type)) && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type))
gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type)); gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
gnu_field_type gnu_field_type
......
gcc/ada/trans.c
...@@ -1606,7 +1606,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -1606,7 +1606,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
gnu_target, gnu_target,
false)), false)),
NULL_TREE); NULL_TREE);
} }
/* The only way we can be making a call via an access type is if Name is an /* The only way we can be making a call via an access type is if Name is an
...@@ -1668,7 +1668,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -1668,7 +1668,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
tree gnu_temp; tree gnu_temp;
/* Remove any unpadding on the actual and make a copy. But if /* Remove any unpadding on the actual and make a copy. But if
the actual is a left-justified modular type, first convert the actual is a justified modular type, first convert
to it. */ to it. */
if (TREE_CODE (gnu_name) == COMPONENT_REF if (TREE_CODE (gnu_name) == COMPONENT_REF
&& ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0))) && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
...@@ -1677,7 +1677,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -1677,7 +1677,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
(TREE_TYPE (TREE_OPERAND (gnu_name, 0)))))) (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0); gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
else if (TREE_CODE (gnu_name_type) == RECORD_TYPE else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
&& (TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_name_type))) && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)))
gnu_name = convert (gnu_name_type, gnu_name); gnu_name = convert (gnu_name_type, gnu_name);
gnu_actual = save_expr (gnu_name); gnu_actual = save_expr (gnu_name);
...@@ -1714,7 +1714,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -1714,7 +1714,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
if (Ekind (gnat_formal) != E_In_Parameter if (Ekind (gnat_formal) != E_In_Parameter
&& TREE_CODE (gnu_name) == CONSTRUCTOR && TREE_CODE (gnu_name) == CONSTRUCTOR
&& TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name))) && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name)))
gnu_name = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), gnu_name = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))),
gnu_name); gnu_name);
...@@ -1829,7 +1829,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -1829,7 +1829,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
else else
{ {
tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual)); tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
if (Ekind (gnat_formal) != E_In_Parameter) if (Ekind (gnat_formal) != E_In_Parameter)
gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list); gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
...@@ -2083,7 +2083,6 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) ...@@ -2083,7 +2083,6 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
build_unary_op (ADDR_EXPR, NULL_TREE, build_unary_op (ADDR_EXPR, NULL_TREE,
gnu_jmpbuf_decl))); gnu_jmpbuf_decl)));
if (Present (First_Real_Statement (gnat_node))) if (Present (First_Real_Statement (gnat_node)))
process_decls (Statements (gnat_node), Empty, process_decls (Statements (gnat_node), Empty,
First_Real_Statement (gnat_node), true, true); First_Real_Statement (gnat_node), true, true);
...@@ -2521,11 +2520,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -2521,11 +2520,11 @@ gnat_to_gnu (Node_Id gnat_node)
tree gnu_type; tree gnu_type;
/* Get the type of the result, looking inside any padding and /* Get the type of the result, looking inside any padding and
left-justified modular types. Then get the value in that type. */ justified modular types. Then get the value in that type. */
gnu_type = gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_type = gnu_result_type = get_unpadded_type (Etype (gnat_node));
if (TREE_CODE (gnu_type) == RECORD_TYPE if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type)) && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
gnu_type = TREE_TYPE (TYPE_FIELDS (gnu_type)); gnu_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
gnu_result = UI_To_gnu (Intval (gnat_node), gnu_type); gnu_result = UI_To_gnu (Intval (gnat_node), gnu_type);
...@@ -4102,7 +4101,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4102,7 +4101,7 @@ gnat_to_gnu (Node_Id gnat_node)
&& (CONTAINS_PLACEHOLDER_P && (CONTAINS_PLACEHOLDER_P
(TYPE_SIZE (TREE_TYPE (gnu_result)))))) (TYPE_SIZE (TREE_TYPE (gnu_result))))))
&& !(TREE_CODE (gnu_result_type) == RECORD_TYPE && !(TREE_CODE (gnu_result_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_result_type)))) && TYPE_JUSTIFIED_MODULAR_P (gnu_result_type))))
{ {
/* In this case remove padding only if the inner object is of /* In this case remove padding only if the inner object is of
self-referential size: in that case it must be an object of self-referential size: in that case it must be an object of
...@@ -4521,7 +4520,7 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED) ...@@ -4521,7 +4520,7 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED)
return GS_ALL_DONE; return GS_ALL_DONE;
} }
return GS_UNHANDLED; return GS_UNHANDLED;
case COMPONENT_REF: case COMPONENT_REF:
/* We have a kludge here. If the FIELD_DECL is from a fat pointer and is /* We have a kludge here. If the FIELD_DECL is from a fat pointer and is
from an early dummy type, replace it with the proper FIELD_DECL. */ from an early dummy type, replace it with the proper FIELD_DECL. */
...@@ -5062,7 +5061,7 @@ emit_index_check (tree gnu_array_object, ...@@ -5062,7 +5061,7 @@ emit_index_check (tree gnu_array_object,
/* GNU_COND contains the condition corresponding to an access, discriminant or /* GNU_COND contains the condition corresponding to an access, discriminant or
range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR if range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR if
GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true. GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
REASON is the code that says why the exception was raised. */ REASON is the code that says why the exception was raised. */
static tree static tree
......
gcc/ada/utils.c
...@@ -2092,7 +2092,7 @@ build_template (tree template_type, tree array_type, tree expr) ...@@ -2092,7 +2092,7 @@ build_template (tree template_type, tree array_type, tree expr)
if (TREE_CODE (array_type) == RECORD_TYPE if (TREE_CODE (array_type) == RECORD_TYPE
&& (TYPE_IS_PADDING_P (array_type) && (TYPE_IS_PADDING_P (array_type)
|| TYPE_LEFT_JUSTIFIED_MODULAR_P (array_type))) || TYPE_JUSTIFIED_MODULAR_P (array_type)))
array_type = TREE_TYPE (TYPE_FIELDS (array_type)); array_type = TREE_TYPE (TYPE_FIELDS (array_type));
if (TREE_CODE (array_type) == ARRAY_TYPE if (TREE_CODE (array_type) == ARRAY_TYPE
...@@ -2801,10 +2801,10 @@ convert (tree type, tree expr) ...@@ -2801,10 +2801,10 @@ convert (tree type, tree expr)
expr)), expr)),
TYPE_MIN_VALUE (etype)))); TYPE_MIN_VALUE (etype))));
/* If the input is a left-justified modular type, we need to extract /* If the input is a justified modular type, we need to extract
the actual object before converting it to any other type with the the actual object before converting it to any other type with the
exception of an unconstrained array. */ exception of an unconstrained array. */
if (ecode == RECORD_TYPE && TYPE_LEFT_JUSTIFIED_MODULAR_P (etype) if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
&& code != UNCONSTRAINED_ARRAY_TYPE) && code != UNCONSTRAINED_ARRAY_TYPE)
return convert (type, build_component_ref (expr, NULL_TREE, return convert (type, build_component_ref (expr, NULL_TREE,
TYPE_FIELDS (etype), false)); TYPE_FIELDS (etype), false));
...@@ -2979,7 +2979,7 @@ convert (tree type, tree expr) ...@@ -2979,7 +2979,7 @@ convert (tree type, tree expr)
return fold (convert_to_real (type, expr)); return fold (convert_to_real (type, expr));
case RECORD_TYPE: case RECORD_TYPE:
if (TYPE_LEFT_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype)) if (TYPE_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype))
return return
gnat_build_constructor gnat_build_constructor
(type, tree_cons (TYPE_FIELDS (type), (type, tree_cons (TYPE_FIELDS (type),
...@@ -3002,7 +3002,7 @@ convert (tree type, tree expr) ...@@ -3002,7 +3002,7 @@ convert (tree type, tree expr)
if (TREE_TYPE (tem) == etype) if (TREE_TYPE (tem) == etype)
return build1 (CONVERT_EXPR, type, expr); return build1 (CONVERT_EXPR, type, expr);
else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
&& (TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (tem)) && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
|| TYPE_IS_PADDING_P (TREE_TYPE (tem))) || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
&& TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype) && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
return build1 (CONVERT_EXPR, type, return build1 (CONVERT_EXPR, type,
...@@ -3015,12 +3015,12 @@ convert (tree type, tree expr) ...@@ -3015,12 +3015,12 @@ convert (tree type, tree expr)
/* If EXPR is a constrained array, take its address, convert it to a /* If EXPR is a constrained array, take its address, convert it to a
fat pointer, and then dereference it. Likewise if EXPR is a fat pointer, and then dereference it. Likewise if EXPR is a
record containing both a template and a constrained array. record containing both a template and a constrained array.
Note that a record representing a left justified modular type Note that a record representing a justified modular type
always represents a packed constrained array. */ always represents a packed constrained array. */
if (ecode == ARRAY_TYPE if (ecode == ARRAY_TYPE
|| (ecode == INTEGER_TYPE && TYPE_HAS_ACTUAL_BOUNDS_P (etype)) || (ecode == INTEGER_TYPE && TYPE_HAS_ACTUAL_BOUNDS_P (etype))
|| (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype)) || (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype))
|| (ecode == RECORD_TYPE && TYPE_LEFT_JUSTIFIED_MODULAR_P (etype))) || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)))
return return
build_unary_op build_unary_op
(INDIRECT_REF, NULL_TREE, (INDIRECT_REF, NULL_TREE,
...@@ -3048,7 +3048,7 @@ convert (tree type, tree expr) ...@@ -3048,7 +3048,7 @@ convert (tree type, tree expr)
} }
/* Remove all conversions that are done in EXP. This includes converting /* Remove all conversions that are done in EXP. This includes converting
from a padded type or to a left-justified modular type. If TRUE_ADDRESS from a padded type or to a justified modular type. If TRUE_ADDRESS
is true, always return the address of the containing object even if is true, always return the address of the containing object even if
the address is not bit-aligned. */ the address is not bit-aligned. */
...@@ -3060,7 +3060,7 @@ remove_conversions (tree exp, bool true_address) ...@@ -3060,7 +3060,7 @@ remove_conversions (tree exp, bool true_address)
case CONSTRUCTOR: case CONSTRUCTOR:
if (true_address if (true_address
&& TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (exp))) && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
return remove_conversions (TREE_VALUE (CONSTRUCTOR_ELTS (exp)), true); return remove_conversions (TREE_VALUE (CONSTRUCTOR_ELTS (exp)), true);
break; break;
...@@ -3156,13 +3156,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -3156,13 +3156,13 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
&& TYPE_VAX_FLOATING_POINT_P (type))) && TYPE_VAX_FLOATING_POINT_P (type)))
|| (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type)) || (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type))
|| (TREE_CODE (type) == RECORD_TYPE || (TREE_CODE (type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (type))) && TYPE_JUSTIFIED_MODULAR_P (type)))
&& ((INTEGRAL_TYPE_P (etype) && ((INTEGRAL_TYPE_P (etype)
&& !(TREE_CODE (etype) == INTEGER_TYPE && !(TREE_CODE (etype) == INTEGER_TYPE
&& TYPE_VAX_FLOATING_POINT_P (etype))) && TYPE_VAX_FLOATING_POINT_P (etype)))
|| (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype)) || (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype))
|| (TREE_CODE (etype) == RECORD_TYPE || (TREE_CODE (etype) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (etype)))) && TYPE_JUSTIFIED_MODULAR_P (etype))))
|| TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
{ {
tree rtype = type; tree rtype = type;
......
gcc/ada/utils2.c
...@@ -112,7 +112,7 @@ tree ...@@ -112,7 +112,7 @@ tree
get_base_type (tree type) get_base_type (tree type)
{ {
if (TREE_CODE (type) == RECORD_TYPE if (TREE_CODE (type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (type)) && TYPE_JUSTIFIED_MODULAR_P (type))
type = TREE_TYPE (TYPE_FIELDS (type)); type = TREE_TYPE (TYPE_FIELDS (type));
while (TREE_TYPE (type) while (TREE_TYPE (type)
...@@ -601,7 +601,7 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -601,7 +601,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
if (operation_type if (operation_type
&& TREE_CODE (operation_type) == RECORD_TYPE && TREE_CODE (operation_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (operation_type)) && TYPE_JUSTIFIED_MODULAR_P (operation_type))
operation_type = TREE_TYPE (TYPE_FIELDS (operation_type)); operation_type = TREE_TYPE (TYPE_FIELDS (operation_type));
if (operation_type if (operation_type
...@@ -631,9 +631,9 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -631,9 +631,9 @@ build_binary_op (enum tree_code op_code, tree result_type,
|| POINTER_TYPE_P (TREE_TYPE || POINTER_TYPE_P (TREE_TYPE
(TREE_OPERAND (left_operand, 0))))) (TREE_OPERAND (left_operand, 0)))))
|| (((TREE_CODE (left_type) == RECORD_TYPE || (((TREE_CODE (left_type) == RECORD_TYPE
/* Don't remove conversions to left-justified modular /* Don't remove conversions to justified modular
types. */ types. */
&& !TYPE_LEFT_JUSTIFIED_MODULAR_P (left_type)) && !TYPE_JUSTIFIED_MODULAR_P (left_type))
|| TREE_CODE (left_type) == ARRAY_TYPE) || TREE_CODE (left_type) == ARRAY_TYPE)
&& ((TREE_CODE (TREE_TYPE && ((TREE_CODE (TREE_TYPE
(TREE_OPERAND (left_operand, 0))) (TREE_OPERAND (left_operand, 0)))
...@@ -661,13 +661,13 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -661,13 +661,13 @@ build_binary_op (enum tree_code op_code, tree result_type,
type, which we must not remove. */ type, which we must not remove. */
while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR
&& ((TREE_CODE (right_type) == RECORD_TYPE && ((TREE_CODE (right_type) == RECORD_TYPE
&& !TYPE_LEFT_JUSTIFIED_MODULAR_P (right_type) && !TYPE_JUSTIFIED_MODULAR_P (right_type)
&& !TYPE_ALIGN_OK (right_type) && !TYPE_ALIGN_OK (right_type)
&& !TYPE_IS_FAT_POINTER_P (right_type)) && !TYPE_IS_FAT_POINTER_P (right_type))
|| TREE_CODE (right_type) == ARRAY_TYPE) || TREE_CODE (right_type) == ARRAY_TYPE)
&& (((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0))) && (((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== RECORD_TYPE) == RECORD_TYPE)
&& !(TYPE_LEFT_JUSTIFIED_MODULAR_P && !(TYPE_JUSTIFIED_MODULAR_P
(TREE_TYPE (TREE_OPERAND (right_operand, 0)))) (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
&& !(TYPE_ALIGN_OK && !(TYPE_ALIGN_OK
(TREE_TYPE (TREE_OPERAND (right_operand, 0)))) (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
...@@ -803,10 +803,10 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -803,10 +803,10 @@ build_binary_op (enum tree_code op_code, tree result_type,
TREE_OPERAND (right_operand, 0)), TREE_OPERAND (right_operand, 0)),
integer_zero_node); integer_zero_node);
/* If either object is a left-justified modular types, get the /* If either object is a justified modular types, get the
fields from within. */ fields from within. */
if (TREE_CODE (left_type) == RECORD_TYPE if (TREE_CODE (left_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (left_type)) && TYPE_JUSTIFIED_MODULAR_P (left_type))
{ {
left_operand = convert (TREE_TYPE (TYPE_FIELDS (left_type)), left_operand = convert (TREE_TYPE (TYPE_FIELDS (left_type)),
left_operand); left_operand);
...@@ -815,7 +815,7 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -815,7 +815,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
} }
if (TREE_CODE (right_type) == RECORD_TYPE if (TREE_CODE (right_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (right_type)) && TYPE_JUSTIFIED_MODULAR_P (right_type))
{ {
right_operand = convert (TREE_TYPE (TYPE_FIELDS (right_type)), right_operand = convert (TREE_TYPE (TYPE_FIELDS (right_type)),
right_operand); right_operand);
...@@ -1039,7 +1039,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) ...@@ -1039,7 +1039,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
if (operation_type if (operation_type
&& TREE_CODE (operation_type) == RECORD_TYPE && TREE_CODE (operation_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (operation_type)) && TYPE_JUSTIFIED_MODULAR_P (operation_type))
operation_type = TREE_TYPE (TYPE_FIELDS (operation_type)); operation_type = TREE_TYPE (TYPE_FIELDS (operation_type));
if (operation_type if (operation_type
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment