TYPE_DUMMY_P (gnu_type) = 1;
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
- if (AGGREGATE_TYPE_P (gnu_type))
- TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type);
+ if (Is_By_Reference_Type (gnat_type))
+ TREE_ADDRESSABLE (gnu_type) = 1;
SET_DUMMY_NODE (gnat_underlying, gnu_type);
return ((force_global || !current_function_decl) ? -1 : 0);
}
-/* Enter a new binding level. */
+/* Enter a new binding level. */
void
gnat_pushlevel (void)
if (current_binding_level)
BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
- BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
+ BLOCK_VARS (newlevel->block) = NULL_TREE;
+ BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
TREE_USED (newlevel->block) = 1;
- /* Add this level to the front of the chain (stack) of levels that are
- active. */
+ /* Add this level to the front of the chain (stack) of active levels. */
newlevel->chain = current_binding_level;
newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel;
{
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (fndecl) = current_binding_level->block;
+ set_block_for_group (current_binding_level->block);
}
/* Set the jmpbuf_decl for the current binding level to DECL. */
return current_binding_level->jmpbuf_decl;
}
-/* Exit a binding level. Set any BLOCK into the current code group. */
+/* Exit a binding level. Set any BLOCK into the current code group. */
void
gnat_poplevel (void)
/* If this is a function-level BLOCK don't do anything. Otherwise, if there
are no variables free the block and merge its subblocks into those of its
- parent block. Otherwise, add it to the list of its parent. */
+ parent block. Otherwise, add it to the list of its parent. */
if (TREE_CODE (BLOCK_SUPERCONTEXT (block)) == FUNCTION_DECL)
;
else if (BLOCK_VARS (block) == NULL_TREE)
void
gnat_init_decl_processing (void)
{
- /* Make the binding_level structure for global names. */
- current_function_decl = 0;
- current_binding_level = 0;
- free_binding_level = 0;
- gnat_pushlevel ();
-
build_common_tree_nodes (true, true);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
+
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
/* Mark the BLOCK for this level as being for this function and pop the
level. Since the vars in it are the parameters, clear them. */
- BLOCK_VARS (current_binding_level->block) = 0;
+ BLOCK_VARS (current_binding_level->block) = NULL_TREE;
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (fndecl) = current_binding_level->block;
gnat_poplevel ();
tree
convert (tree type, tree expr)
{
- enum tree_code code = TREE_CODE (type);
tree etype = TREE_TYPE (expr);
enum tree_code ecode = TREE_CODE (etype);
+ enum tree_code code = TREE_CODE (type);
- /* If EXPR is already the right type, we are done. */
- if (type == etype)
+ /* If the expression is already of the right type, we are done. */
+ if (etype == type)
return expr;
/* If both input and output have padding and are of variable size, do this
/* If the inner type is of self-referential size and the expression type
is a record, do this as an unchecked conversion. But first pad the
expression if possible to have the same size on both sides. */
- if (TREE_CODE (etype) == RECORD_TYPE
+ if (ecode == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
{
if (TREE_CONSTANT (TYPE_SIZE (etype)))
final conversion as an unchecked conversion, again to avoid the need
for some variable-sized temporaries. If valid, this conversion is
very likely purely technical and without real effects. */
- if (TREE_CODE (etype) == ARRAY_TYPE
+ if (ecode == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
&& !TREE_CONSTANT (TYPE_SIZE (etype))
&& !TREE_CONSTANT (TYPE_SIZE (type)))
return expr;
}
- /* Likewise for a conversion between original and packable version, but
- we have to work harder in order to preserve type consistency. */
+ /* Likewise for a conversion between original and packable version, or
+ conversion between types of the same size and with the same list of
+ fields, but we have to work harder to preserve type consistency. */
if (code == ecode
&& code == RECORD_TYPE
- && TYPE_NAME (type) == TYPE_NAME (etype))
+ && (TYPE_NAME (type) == TYPE_NAME (etype)
+ || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype))))
+
{
VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
{
- constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
- /* We expect only simple constructors. Otherwise, punt. */
- if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield)))
+ constructor_elt *elt;
+ /* We expect only simple constructors. */
+ if (!SAME_FIELD_P (index, efield))
break;
+ /* The field must be the same. */
+ if (!SAME_FIELD_P (efield, field))
+ break;
+ elt = VEC_quick_push (constructor_elt, v, NULL);
elt->index = field;
elt->value = convert (TREE_TYPE (field), value);
}
break;
- case INDIRECT_REF:
- /* If both types are record types, just convert the pointer and
- make a new INDIRECT_REF.
-
- ??? Disable this for now since it causes problems with the
- code in build_binary_op for MODIFY_EXPR which wants to
- strip off conversions. But that code really is a mess and
- we need to do this a much better way some time. */
- if (0
- && (TREE_CODE (type) == RECORD_TYPE
- || TREE_CODE (type) == UNION_TYPE)
- && (TREE_CODE (etype) == RECORD_TYPE
- || TREE_CODE (etype) == UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
- return build_unary_op (INDIRECT_REF, NULL_TREE,
- convert (build_pointer_type (type),
- TREE_OPERAND (expr, 0)));
- break;
-
default:
break;
}
etype)))
return build1 (VIEW_CONVERT_EXPR, type, expr);
+ /* If we are converting between tagged types, try to upcast properly. */
+ else if (ecode == RECORD_TYPE && code == RECORD_TYPE
+ && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type))
+ {
+ tree child_etype = etype;
+ do {
+ tree field = TYPE_FIELDS (child_etype);
+ if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type)
+ return build_component_ref (expr, NULL_TREE, field, false);
+ child_etype = TREE_TYPE (field);
+ } while (TREE_CODE (child_etype) == RECORD_TYPE);
+ }
+
/* In all other cases of related types, make a NOP_EXPR. */
else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
|| (code == INTEGER_CST && ecode == INTEGER_CST
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);
- /* If the expression is already the right type, we are done. */
+ /* If the expression is already of the right type, we are done. */
if (etype == type)
return expr;
/* If both types types are integral just do a normal conversion.
Likewise for a conversion to an unconstrained array. */
if ((((INTEGRAL_TYPE_P (type)
- && !(TREE_CODE (type) == INTEGER_TYPE
- && TYPE_VAX_FLOATING_POINT_P (type)))
+ && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type)))
|| (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type))
- || (TREE_CODE (type) == RECORD_TYPE
- && TYPE_JUSTIFIED_MODULAR_P (type)))
+ || (code == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (type)))
&& ((INTEGRAL_TYPE_P (etype)
- && !(TREE_CODE (etype) == INTEGER_TYPE
- && TYPE_VAX_FLOATING_POINT_P (etype)))
+ && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype)))
|| (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype))
- || (TREE_CODE (etype) == RECORD_TYPE
- && TYPE_JUSTIFIED_MODULAR_P (etype))))
- || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype))))
+ || code == UNCONSTRAINED_ARRAY_TYPE)
{
- if (TREE_CODE (etype) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (etype))
+ if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
{
tree ntype = copy_type (etype);
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
expr = build1 (NOP_EXPR, ntype, expr);
}
- if (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
+ if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
{
tree rtype = copy_type (type);
TYPE_BIASED_REPRESENTATION_P (rtype) = 0;
/* We have a special case when we are converting between two unconstrained
array types. In that case, take the address, convert the fat pointer
types, and dereference. */
- else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
- && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ else if (ecode == code && code == UNCONSTRAINED_ARRAY_TYPE)
expr = build_unary_op (INDIRECT_REF, NULL_TREE,
build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type),
build_unary_op (ADDR_EXPR, NULL_TREE,
/* Another special case is when we are converting to a vector type from its
representative array type; this a regular conversion. */
- else if (TREE_CODE (type) == VECTOR_TYPE
- && TREE_CODE (etype) == ARRAY_TYPE
+ else if (code == VECTOR_TYPE
+ && ecode == ARRAY_TYPE
&& gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
etype))
expr = convert (type, expr);
{
expr = maybe_unconstrained_array (expr);
etype = TREE_TYPE (expr);
+ ecode = TREE_CODE (etype);
if (can_fold_for_view_convert_p (expr))
expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
else
is a biased type or if both the input and output are unsigned. */
if (!notrunc_p
&& INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
- && !(TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
+ && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
&& 0 != compare_tree_int (TYPE_RM_SIZE (type),
GET_MODE_BITSIZE (TYPE_MODE (type)))
&& !(INTEGRAL_TYPE_P (etype)
0))
&& !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype)))
{
- tree base_type = gnat_type_for_mode (TYPE_MODE (type),
- TYPE_UNSIGNED (type));
+ tree base_type
+ = gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type));
tree shift_expr
= convert (base_type,
size_binop (MINUS_EXPR,
OSDN Git Service
