post_error ("Storage_Error will be raised at run-time?",
gnat_entity);
- gnu_expr = build_allocator (gnu_alloc_type, gnu_expr,
- gnu_type, 0, 0, gnat_entity);
+ gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
+ 0, 0, gnat_entity, false);
}
else
{
if (list_length (gnu_return_list) == 1)
gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
-#ifdef _WIN32
+#ifdef TARGET_DLLIMPORT_DECL_ATTRIBUTES
if (Convention (gnat_entity) == Convention_Stdcall)
{
struct attrib *attr
{
tree gnu_field_id = get_entity_name (gnat_field);
tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
- tree gnu_orig_field_type = gnu_field_type;
tree gnu_pos = 0;
tree gnu_size = 0;
tree gnu_field;
gnat_field, FIELD_DECL, false, true);
/* If we are packing this record, have a specified size that's smaller than
- that of the field type, or a position is specified, and the field type
- is also a record that's BLKmode and with a small constant size, see if
- we can get a better form of the type that allows more packing. If we
- can, show a size was specified for it if there wasn't one so we know to
- make this a bitfield and avoid making things wider. */
+ that of the field type, or a position is specified, and the field type is
+ also a record that's BLKmode and with a small constant size, see if we
+ can get a better form of the type that allows more packing. If we can,
+ show a size was specified for it if there wasn't one so we know to make
+ this a bitfield and avoid making things wider. */
if (TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_MODE (gnu_field_type) == BLKmode
&& host_integerp (TYPE_SIZE (gnu_field_type), 1)
&& compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
&& (packed == 1
- || (gnu_size && tree_int_cst_lt (gnu_size,
- TYPE_SIZE (gnu_field_type)))
+ || (gnu_size
+ && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)))
|| Present (Component_Clause (gnat_field))))
{
- gnu_field_type = make_packable_type (gnu_field_type);
-
- if (gnu_field_type != gnu_orig_field_type && !gnu_size)
- gnu_size = rm_size (gnu_field_type);
+ /* See what the alternate type and size would be. */
+ tree gnu_packable_type = make_packable_type (gnu_field_type);
+
+ /* Compute whether we should avoid the substitution. */
+ int reject =
+ /* There is no point subtituting if there is no change. */
+ (gnu_packable_type == gnu_field_type
+ ||
+ /* The size of an aliased field must be an exact multiple of the
+ type's alignment, which the substitution might increase. Reject
+ substitutions that would so invalidate a component clause when the
+ specified position is byte aligned, as the change would have no
+ real benefit from the packing standpoint anyway. */
+ (Is_Aliased (gnat_field)
+ && Present (Component_Clause (gnat_field))
+ && UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0
+ && tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0)
+ );
+
+ /* Substitute unless told otherwise. */
+ if (!reject)
+ {
+ gnu_field_type = gnu_packable_type;
+
+ if (gnu_size == 0)
+ gnu_size = rm_size (gnu_field_type);
+ }
}
/* If we are packing the record and the field is BLKmode, round the
int i;
int size;
- /* If back annotation is suppressed by the front end, return No_Uint */
- if (!Back_Annotate_Rep_Info)
- return No_Uint;
-
/* See if we've already saved the value for this node. */
if (EXPR_P (gnu_size) && TREE_COMPLEXITY (gnu_size))
return (Node_Ref_Or_Val) TREE_COMPLEXITY (gnu_size);
Get_External_Name_With_Suffix (gnat_entity, fp);
-#ifdef _WIN32
+#ifdef TARGET_DLLIMPORT_DECL_ATTRIBUTES
/* A variable using the Stdcall convention (meaning we are running
on a Windows box) live in a DLL. Here we adjust its name to use
the jump-table, the _imp__NAME contains the address for the NAME
RESULT_TYPE, which must be some type of pointer. Return the tree.
GNAT_PROC and GNAT_POOL optionally give the procedure to call and
the storage pool to use. GNAT_NODE is used to provide an error
- location for restriction violations messages. */
+ location for restriction violations messages. If IGNORE_INIT_TYPE is
+ true, ignore the type of INIT for the purpose of determining the size;
+ this will cause the maximum size to be allocated if TYPE is of
+ self-referential size. */
extern tree build_allocator (tree type, tree init, tree result_type,
Entity_Id gnat_proc, Entity_Id gnat_pool,
- Node_Id gnat_node);
+ Node_Id gnat_node, bool);
/* Fill in a VMS descriptor for EXPR and return a constructor for it.
GNAT_FORMAL is how we find the descriptor record. */
/* If we are taking 'Address of an unconstrained object, this is the
pointer to the underlying array. */
- gnu_prefix = maybe_unconstrained_array (gnu_prefix);
+ if (attribute == Attr_Address)
+ gnu_prefix = maybe_unconstrained_array (gnu_prefix);
/* ... fall through ... */
tree gnu_copy = gnu_name;
tree gnu_temp;
+ /* For users of Starlet we issue a warning because the
+ interface apparently assumes that by-ref parameters
+ outlive the procedure invocation. The code still
+ will not work as intended, but we cannot do much
+ better since other low-level parts of the back-end
+ would allocate temporaries at will because of the
+ misalignment if we did not do so here. */
+
+ if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+ {
+ post_error
+ ("?possible violation of implicit assumption",
+ gnat_actual);
+ post_error_ne
+ ("?made by pragma Import_Valued_Procedure on &",
+ gnat_actual, Entity (Name (gnat_node)));
+ post_error_ne
+ ("?because of misalignment of &",
+ gnat_actual, gnat_formal);
+ }
+
/* Remove any unpadding on the actual and make a copy. But if
the actual is a justified modular type, first convert
to it. */
{
tree gnu_init = 0;
tree gnu_type;
+ bool ignore_init_type = false;
gnat_temp = Expression (gnat_node);
Entity_Id gnat_desig_type
= Designated_Type (Underlying_Type (Etype (gnat_node)));
+ ignore_init_type = Has_Constrained_Partial_View (gnat_desig_type);
gnu_init = gnat_to_gnu (Expression (gnat_temp));
gnu_init = maybe_unconstrained_array (gnu_init);
gnu_result_type = get_unpadded_type (Etype (gnat_node));
return build_allocator (gnu_type, gnu_init, gnu_result_type,
Procedure_To_Call (gnat_node),
- Storage_Pool (gnat_node), gnat_node);
+ Storage_Pool (gnat_node), gnat_node,
+ ignore_init_type);
}
break;
= build_allocator (TREE_TYPE (gnu_ret_val),
gnu_ret_val,
TREE_TYPE (gnu_subprog_type),
- 0, -1, gnat_node);
+ 0, -1, gnat_node, false);
else
gnu_ret_val
= build_allocator (TREE_TYPE (gnu_ret_val),
TREE_TYPE (gnu_subprog_type),
Procedure_To_Call (gnat_node),
Storage_Pool (gnat_node),
- gnat_node);
+ gnat_node, false);
}
}
}
/* Don't do anything for subprograms that may have been elaborated before
their freeze nodes. This can happen, for example because of an inner call
- in an instance body. */
- if (gnu_old
- && TREE_CODE (gnu_old) == FUNCTION_DECL
- && (Ekind (gnat_entity) == E_Function
+ in an instance body, or a previous compilation of a spec for inlining
+ purposes. */
+ if ((gnu_old
+ && TREE_CODE (gnu_old) == FUNCTION_DECL
+ && (Ekind (gnat_entity) == E_Function
|| Ekind (gnat_entity) == E_Procedure))
+ || (gnu_old
+ && (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
+ && Ekind (gnat_entity) == E_Subprogram_Type)))
return;
/* If we have a non-dummy type old tree, we have nothing to do. Unless
{
gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1);
+ /* Propagate back-annotations from full view to partial view. */
+ if (Unknown_Alignment (gnat_entity))
+ Set_Alignment (gnat_entity, Alignment (Full_View (gnat_entity)));
+
+ if (Unknown_Esize (gnat_entity))
+ Set_Esize (gnat_entity, Esize (Full_View (gnat_entity)));
+
+ if (Unknown_RM_Size (gnat_entity))
+ Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity)));
+
/* The above call may have defined this entity (the simplest example
of this is when we have a private enumeral type since the bounds
will have the public view. */
projects / platform / upstream / gcc.git / commitdiff