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> 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/gigi.h (add_decl_expr): Adjust prototype.
* gcc-interface/decl.c (gnat_to_gnu_entity): Remove useless test. * gcc-interface/decl.c (gnat_to_gnu_entity): Remove useless test.
* gcc-interface/trans.c (add_stmt_with_node): Remove exceptions. * gcc-interface/trans.c (add_stmt_with_node): Remove exceptions.
......
...@@ -273,7 +273,9 @@ static bool intrin_profiles_compatible_p (intrin_binding_t *); ...@@ -273,7 +273,9 @@ static bool intrin_profiles_compatible_p (intrin_binding_t *);
tree tree
gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) 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); const Entity_Kind kind = Ekind (gnat_entity);
/* True if this is a type. */ /* True if this is a type. */
const bool is_type = IN (kind, Type_Kind); 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) ...@@ -578,7 +580,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
if (definition if (definition
&& !gnu_expr && !gnu_expr
&& No (Address_Clause (gnat_entity)) && No (Address_Clause (gnat_entity))
&& !No_Initialization (Declaration_Node (gnat_entity)) && !No_Initialization (gnat_decl)
&& No (Renamed_Object (gnat_entity))) && No (Renamed_Object (gnat_entity)))
{ {
gnu_decl = error_mark_node; gnu_decl = error_mark_node;
...@@ -611,9 +613,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -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 may contain N_Expression_With_Actions nodes and thus declarations of
objects from other units that we need to discard. */ objects from other units that we need to discard. */
if (!definition if (!definition
&& !No_Initialization (Declaration_Node (gnat_entity)) && !No_Initialization (gnat_decl)
&& !Is_Dispatch_Table_Entity (gnat_entity) && !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 && Nkind (gnat_temp) != N_Allocator
&& (!type_annotate_only || Compile_Time_Known_Value (gnat_temp))) && (!type_annotate_only || Compile_Time_Known_Value (gnat_temp)))
gnu_expr = gnat_to_gnu_external (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) ...@@ -634,9 +636,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& !(kind == E_Variable && !(kind == E_Variable
&& Present (Linker_Section_Pragma (gnat_entity))) && Present (Linker_Section_Pragma (gnat_entity)))
&& !Treat_As_Volatile (gnat_entity) && !Treat_As_Volatile (gnat_entity)
&& (((Nkind (Declaration_Node (gnat_entity)) && (((Nkind (gnat_decl) == N_Object_Declaration)
== N_Object_Declaration) && Present (Expression (gnat_decl)))
&& Present (Expression (Declaration_Node (gnat_entity))))
|| Present (Renamed_Object (gnat_entity)) || Present (Renamed_Object (gnat_entity))
|| imported_p)); || imported_p));
bool inner_const_flag = const_flag; bool inner_const_flag = const_flag;
...@@ -650,7 +651,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -650,7 +651,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
bool used_by_ref = false; bool used_by_ref = false;
tree gnu_ext_name = NULL_TREE; tree gnu_ext_name = NULL_TREE;
tree renamed_obj = 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 /* We need to translate the renamed object even though we are only
referencing the renaming. But it may contain a call for which 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) ...@@ -755,8 +756,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
{ {
if (gnu_expr && kind == E_Constant) if (gnu_expr && kind == E_Constant)
{ {
tree size = TYPE_SIZE (TREE_TYPE (gnu_expr)); gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr));
if (CONTAINS_PLACEHOLDER_P (size)) gnu_ada_size = TYPE_ADA_SIZE (TREE_TYPE (gnu_expr));
if (CONTAINS_PLACEHOLDER_P (gnu_size))
{ {
/* If the initializing expression is itself a constant, /* If the initializing expression is itself a constant,
despite having a nominal type with self-referential 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) ...@@ -768,27 +770,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& (TREE_READONLY (TREE_OPERAND (gnu_expr, 0)) && (TREE_READONLY (TREE_OPERAND (gnu_expr, 0))
|| DECL_READONLY_ONCE_ELAB || DECL_READONLY_ONCE_ELAB
(TREE_OPERAND (gnu_expr, 0)))) (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 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 /* We may have no GNU_EXPR because No_Initialization is
set even though there's an Expression. */ set even though there's an Expression. */
else if (kind == E_Constant else if (kind == E_Constant
&& (Nkind (Declaration_Node (gnat_entity)) && Nkind (gnat_decl) == N_Object_Declaration
== N_Object_Declaration) && Present (Expression (gnat_decl)))
&& Present (Expression (Declaration_Node (gnat_entity)))) {
gnu_size tree gnu_expr_type
= TYPE_SIZE (gnat_to_gnu_type = gnat_to_gnu_type (Etype (Expression (gnat_decl)));
(Etype gnu_size = TYPE_SIZE (gnu_expr_type);
(Expression (Declaration_Node (gnat_entity))))); gnu_ada_size = TYPE_ADA_SIZE (gnu_expr_type);
}
else else
{ {
gnu_size = max_size (TYPE_SIZE (gnu_type), true); 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; mutable_p = true;
} }
...@@ -904,7 +917,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -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. /* Make a new type with the desired size and alignment, if needed.
But do not take into account alignment promotions to compute the But do not take into account alignment promotions to compute the
size of the object. */ 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) if (gnu_size || align > 0)
{ {
tree orig_type = gnu_type; tree orig_type = gnu_type;
...@@ -912,6 +925,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -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, gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
false, false, definition, true); 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 /* If a padding record was made, declare it now since it will
never be declared otherwise. This is necessary to ensure never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */ that its subtrees are properly marked. */
...@@ -2941,23 +2961,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -2941,23 +2961,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
the tree. */ the tree. */
case E_Record_Type: case E_Record_Type:
if (Has_Complex_Representation (gnat_entity)) {
{ Node_Id record_definition = Type_Definition (gnat_decl);
gnu_type
= build_complex_type
(get_unpadded_type
(Etype (Defining_Entity
(First (Component_Items
(Component_List
(Type_Definition
(Declaration_Node (gnat_entity)))))))));
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; Node_Id gnat_constr;
Entity_Id gnat_field, gnat_parent_type; Entity_Id gnat_field, gnat_parent_type;
tree gnu_field, gnu_field_list = NULL_TREE; tree gnu_field, gnu_field_list = NULL_TREE;
......
...@@ -736,25 +736,25 @@ gnat_type_max_size (const_tree gnu_type) ...@@ -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 /* First see what we can get from TYPE_SIZE_UNIT, which might not
be constant even for simple expressions if it has already been be constant even for simple expressions if it has already been
elaborated and possibly replaced by a VAR_DECL. */ 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 /* If we don't have a constant, try to look at attributes which should have
stayed untouched. */ 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. */ /* For record types, see what we can get from TYPE_ADA_SIZE. */
if (RECORD_OR_UNION_TYPE_P (gnu_type) if (RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type)
&& TYPE_ADA_SIZE (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 /* If we have succeeded in finding a constant, round it up to the
type's alignment and return the result in units. */ type's alignment and return the result in units. */
if (tree_fits_uhwi_p (max_adasize)) if (tree_fits_uhwi_p (max_ada_size))
max_unitsize max_size_unit
= size_binop (CEIL_DIV_EXPR, = 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); bitsize_unit_node);
} }
...@@ -784,7 +784,7 @@ gnat_type_max_size (const_tree gnu_type) ...@@ -784,7 +784,7 @@ gnat_type_max_size (const_tree gnu_type)
= fold_build2 (PLUS_EXPR, ctype, = fold_build2 (PLUS_EXPR, ctype,
fold_build2 (MINUS_EXPR, ctype, hb, lb), fold_build2 (MINUS_EXPR, ctype, hb, lb),
build_int_cst (ctype, 1)); build_int_cst (ctype, 1));
max_unitsize max_size_unit
= fold_build2 (MULT_EXPR, sizetype, = fold_build2 (MULT_EXPR, sizetype,
fold_convert (sizetype, length), fold_convert (sizetype, length),
TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))); TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
...@@ -793,7 +793,7 @@ gnat_type_max_size (const_tree 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); static tree get_array_bit_stride (tree);
......
2018-07-07 Eric Botcazou <ebotcazou@adacore.com> 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_function3a.adb: New test.
* gnat.dg/pure_function3b.adb: Likewise. * gnat.dg/pure_function3b.adb: Likewise.
* gnat.dg/pure_function3c.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