Commit 87668878 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Add GNAT_DECL local variable and use it throughout.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Add GNAT_DECL local
	variable and use it throughout.
	<E_Variable>: If the nominal subtype of the object is unconstrained,
	compute the Ada size separately and put in on the padding type if the
	size is not fixed.
	<E_Record_Type>: Minor tweak.
	* gcc-interface/misc.c (gnat_type_max_size): Rename max_size_unit
	into max_size_unit throughout.

From-SVN: r262498
parent 56b8aa0c
2018-07-07 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Add GNAT_DECL local
variable and use it throughout.
<E_Variable>: If the nominal subtype of the object is unconstrained,
compute the Ada size separately and put in on the padding type if the
size is not fixed.
<E_Record_Type>: Minor tweak.
* gcc-interface/misc.c (gnat_type_max_size): Rename max_size_unit
into max_size_unit throughout.
2018-07-07 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (add_decl_expr): Adjust prototype.
* gcc-interface/decl.c (gnat_to_gnu_entity): Remove useless test.
* gcc-interface/trans.c (add_stmt_with_node): Remove exceptions.
......
......@@ -273,7 +273,9 @@ static bool intrin_profiles_compatible_p (intrin_binding_t *);
tree
gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
{
/* Contains the kind of the input GNAT node. */
/* The construct that declared the entity. */
const Node_Id gnat_decl = Declaration_Node (gnat_entity);
/* The kind of the entity. */
const Entity_Kind kind = Ekind (gnat_entity);
/* True if this is a type. */
const bool is_type = IN (kind, Type_Kind);
......@@ -578,7 +580,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
if (definition
&& !gnu_expr
&& No (Address_Clause (gnat_entity))
&& !No_Initialization (Declaration_Node (gnat_entity))
&& !No_Initialization (gnat_decl)
&& No (Renamed_Object (gnat_entity)))
{
gnu_decl = error_mark_node;
......@@ -611,9 +613,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
may contain N_Expression_With_Actions nodes and thus declarations of
objects from other units that we need to discard. */
if (!definition
&& !No_Initialization (Declaration_Node (gnat_entity))
&& !No_Initialization (gnat_decl)
&& !Is_Dispatch_Table_Entity (gnat_entity)
&& Present (gnat_temp = Expression (Declaration_Node (gnat_entity)))
&& Present (gnat_temp = Expression (gnat_decl))
&& Nkind (gnat_temp) != N_Allocator
&& (!type_annotate_only || Compile_Time_Known_Value (gnat_temp)))
gnu_expr = gnat_to_gnu_external (gnat_temp);
......@@ -634,9 +636,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& !(kind == E_Variable
&& Present (Linker_Section_Pragma (gnat_entity)))
&& !Treat_As_Volatile (gnat_entity)
&& (((Nkind (Declaration_Node (gnat_entity))
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
&& (((Nkind (gnat_decl) == N_Object_Declaration)
&& Present (Expression (gnat_decl)))
|| Present (Renamed_Object (gnat_entity))
|| imported_p));
bool inner_const_flag = const_flag;
......@@ -650,7 +651,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
bool used_by_ref = false;
tree gnu_ext_name = NULL_TREE;
tree renamed_obj = NULL_TREE;
tree gnu_object_size;
tree gnu_ada_size = NULL_TREE;
/* We need to translate the renamed object even though we are only
referencing the renaming. But it may contain a call for which
......@@ -755,8 +756,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
{
if (gnu_expr && kind == E_Constant)
{
tree size = TYPE_SIZE (TREE_TYPE (gnu_expr));
if (CONTAINS_PLACEHOLDER_P (size))
gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr));
gnu_ada_size = TYPE_ADA_SIZE (TREE_TYPE (gnu_expr));
if (CONTAINS_PLACEHOLDER_P (gnu_size))
{
/* If the initializing expression is itself a constant,
despite having a nominal type with self-referential
......@@ -768,27 +770,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& (TREE_READONLY (TREE_OPERAND (gnu_expr, 0))
|| DECL_READONLY_ONCE_ELAB
(TREE_OPERAND (gnu_expr, 0))))
gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0));
{
gnu_size = DECL_SIZE (TREE_OPERAND (gnu_expr, 0));
gnu_ada_size = gnu_size;
}
else
gnu_size
= SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, gnu_expr);
{
gnu_size
= SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_size,
gnu_expr);
gnu_ada_size
= SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_ada_size,
gnu_expr);
}
}
else
gnu_size = size;
}
/* We may have no GNU_EXPR because No_Initialization is
set even though there's an Expression. */
else if (kind == E_Constant
&& (Nkind (Declaration_Node (gnat_entity))
== N_Object_Declaration)
&& Present (Expression (Declaration_Node (gnat_entity))))
gnu_size
= TYPE_SIZE (gnat_to_gnu_type
(Etype
(Expression (Declaration_Node (gnat_entity)))));
&& Nkind (gnat_decl) == N_Object_Declaration
&& Present (Expression (gnat_decl)))
{
tree gnu_expr_type
= gnat_to_gnu_type (Etype (Expression (gnat_decl)));
gnu_size = TYPE_SIZE (gnu_expr_type);
gnu_ada_size = TYPE_ADA_SIZE (gnu_expr_type);
}
else
{
gnu_size = max_size (TYPE_SIZE (gnu_type), true);
/* We can be called on unconstrained arrays in this mode. */
if (!type_annotate_only)
gnu_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
mutable_p = true;
}
......@@ -904,7 +917,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* Make a new type with the desired size and alignment, if needed.
But do not take into account alignment promotions to compute the
size of the object. */
gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
tree gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
if (gnu_size || align > 0)
{
tree orig_type = gnu_type;
......@@ -912,6 +925,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
false, false, definition, true);
/* If the nominal subtype of the object is unconstrained and its
size is not fixed, compute the Ada size from the Ada size of
the subtype and/or the expression; this will make it possible
for gnat_type_max_size to easily compute a maximum size. */
if (gnu_ada_size && gnu_size && !TREE_CONSTANT (gnu_size))
SET_TYPE_ADA_SIZE (gnu_type, gnu_ada_size);
/* If a padding record was made, declare it now since it will
never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */
......@@ -2941,23 +2961,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
the tree. */
case E_Record_Type:
if (Has_Complex_Representation (gnat_entity))
{
gnu_type
= build_complex_type
(get_unpadded_type
(Etype (Defining_Entity
(First (Component_Items
(Component_List
(Type_Definition
(Declaration_Node (gnat_entity)))))))));
{
Node_Id record_definition = Type_Definition (gnat_decl);
break;
}
if (Has_Complex_Representation (gnat_entity))
{
const Node_Id first_component
= First (Component_Items (Component_List (record_definition)));
tree gnu_component_type
= get_unpadded_type (Etype (Defining_Entity (first_component)));
gnu_type = build_complex_type (gnu_component_type);
break;
}
{
Node_Id full_definition = Declaration_Node (gnat_entity);
Node_Id record_definition = Type_Definition (full_definition);
Node_Id gnat_constr;
Entity_Id gnat_field, gnat_parent_type;
tree gnu_field, gnu_field_list = NULL_TREE;
......
......@@ -736,25 +736,25 @@ gnat_type_max_size (const_tree gnu_type)
/* First see what we can get from TYPE_SIZE_UNIT, which might not
be constant even for simple expressions if it has already been
elaborated and possibly replaced by a VAR_DECL. */
tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
/* If we don't have a constant, try to look at attributes which should have
stayed untouched. */
if (!tree_fits_uhwi_p (max_unitsize))
if (!tree_fits_uhwi_p (max_size_unit))
{
/* For record types, see what we can get from TYPE_ADA_SIZE. */
if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
&& TYPE_ADA_SIZE (gnu_type))
{
tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
/* If we have succeeded in finding a constant, round it up to the
type's alignment and return the result in units. */
if (tree_fits_uhwi_p (max_adasize))
max_unitsize
if (tree_fits_uhwi_p (max_ada_size))
max_size_unit
= size_binop (CEIL_DIV_EXPR,
round_up (max_adasize, TYPE_ALIGN (gnu_type)),
round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
bitsize_unit_node);
}
......@@ -784,7 +784,7 @@ gnat_type_max_size (const_tree gnu_type)
= fold_build2 (PLUS_EXPR, ctype,
fold_build2 (MINUS_EXPR, ctype, hb, lb),
build_int_cst (ctype, 1));
max_unitsize
max_size_unit
= fold_build2 (MULT_EXPR, sizetype,
fold_convert (sizetype, length),
TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
......@@ -793,7 +793,7 @@ gnat_type_max_size (const_tree gnu_type)
}
}
return max_unitsize;
return max_size_unit;
}
static tree get_array_bit_stride (tree);
......
2018-07-07 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/stack_usage6.adb: New test.
* gnat.dg/stack_usage6_pkg.ads: New helper.
2018-07-07 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/pure_function3a.adb: New test.
* gnat.dg/pure_function3b.adb: Likewise.
* gnat.dg/pure_function3c.adb: Likewise.
......
-- { dg-do compile }
-- { dg-options "-Wstack-usage=512" }
with Stack_Usage6_Pkg; use Stack_Usage6_Pkg;
procedure Stack_Usage6 (I : Index_Type) is
R : constant Rec := A (I);
begin
if R.D then
raise Program_Error;
end if;
end;
package Stack_Usage6_Pkg is
type Rec (D : Boolean := False) is record
case D is
when False =>
Foo : Integer;
Bar : Integer;
when True =>
null;
end case;
end record;
type Index_Type is new Integer range 0 .. 5;
type Arr is array (Index_Type) of Rec;
A : Arr;
end Stack_Usage6_Pkg;
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