OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (elaborate_expression, [...]): Arguments now bool instead of int. 

* decl.c (elaborate_expression, elaborate_expression_1): Arguments
	now bool instead of int.
	(gnat_to_gnu_entity, elaborate_expression_1): New arg to COMPONENT_REF.
	* trans.c (gnu_switch_label_stack): New function.
	(gnat_to_gnu, N_Object_Renaming_Declaration): Result is what the
	elaboration of renamed entity returns.
	(gnat_to_gnu, case N_Case_Statement): Add branches to end label.
	(add_decl_stmt): Don't add TYPE_DECL for UNCONSTRAINED_ARRAY_TYPE.
	(gnat_gimplify_stmt): Use alloc_stmt_list, not build_empty_stmt.
	(gnat_gimplify_stmt, case DECL_STMT): gimplify DECL_SIZE and
	DECL_SIZE_UNIT and simplify variable-sized case.
	(gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Deleted.
	Callers changes to call gimplify_type_sizes and gimplify_one_sizepos.
	(gnat_stabilize_reference): Add arg to COMPONENT_REF.
	(build_unit_elab): Disable for now.
	* utils.c (mark_visited): New function.
	(pushdecl): Walk tree to call it for global decl.
	(update_pointer_to): Update all variants of pointer and ref types.
	Add arg to COMPONENT_REF.
	(convert): Likewise.
	Move check for converting between variants lower down.
	* utils2.c (build_simple_component_ref): Add arg to COMPONENT_REF.
	(build_allocator): Don't force type of MODIFY_EXPR.
	(gnat_mark_addressable, case VAR_DECL): Unconditionally call
	put_var_into_stack.

From-SVN: r83410
This commit is contained in:
Richard Kenner 2004-06-20 11:19:47 +00:00 committed by Richard Kenner
parent 543a0daa84
commit c0e3aa48e5
5 changed files with 170 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2004-06-20 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* decl.c (elaborate_expression, elaborate_expression_1): Arguments
now bool instead of int.
(gnat_to_gnu_entity, elaborate_expression_1): New arg to COMPONENT_REF.
* trans.c (gnu_switch_label_stack): New function.
(gnat_to_gnu, N_Object_Renaming_Declaration): Result is what the
elaboration of renamed entity returns.
(gnat_to_gnu, case N_Case_Statement): Add branches to end label.
(add_decl_stmt): Don't add TYPE_DECL for UNCONSTRAINED_ARRAY_TYPE.
(gnat_gimplify_stmt): Use alloc_stmt_list, not build_empty_stmt.
(gnat_gimplify_stmt, case DECL_STMT): gimplify DECL_SIZE and
DECL_SIZE_UNIT and simplify variable-sized case.
(gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Deleted.
Callers changes to call gimplify_type_sizes and gimplify_one_sizepos.
(gnat_stabilize_reference): Add arg to COMPONENT_REF.
(build_unit_elab): Disable for now.
* utils.c (mark_visited): New function.
(pushdecl): Walk tree to call it for global decl.
(update_pointer_to): Update all variants of pointer and ref types.
Add arg to COMPONENT_REF.
(convert): Likewise.
Move check for converting between variants lower down.
* utils2.c (build_simple_component_ref): Add arg to COMPONENT_REF.
(build_allocator): Don't force type of MODIFY_EXPR.
(gnat_mark_addressable, case VAR_DECL): Unconditionally call
put_var_into_stack.
2004-06-14 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.

45
gcc/ada/decl.c
View File

@ -84,9 +84,10 @@ static void copy_alias_set (tree, tree);
static tree substitution_list (Entity_Id, Entity_Id, tree, int);
static int allocatable_size_p (tree, int);
static struct attrib *build_attr_list (Entity_Id);
static tree elaborate_expression (Node_Id, Entity_Id, tree, int, int, int);
static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
static int is_variable_size (tree);
static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree, int, int);
static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
bool, bool);
static tree make_packable_type (tree);
static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *,
int, int, int);
@ -1487,7 +1488,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
fields once we build them. */
tem = build (COMPONENT_REF, gnu_ptr_template,
build (PLACEHOLDER_EXPR, gnu_fat_type),
TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
gnu_template_reference
= build_unary_op (INDIRECT_REF, gnu_template_type, tem);
TREE_READONLY (gnu_template_reference) = 1;
@ -1532,9 +1533,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* We can't use build_component_ref here since the template
type isn't complete yet. */
gnu_min = build (COMPONENT_REF, gnu_ind_subtype,
gnu_template_reference, gnu_min_field);
gnu_template_reference, gnu_min_field, NULL_TREE);
gnu_max = build (COMPONENT_REF, gnu_ind_subtype,
gnu_template_reference, gnu_max_field);
gnu_template_reference, gnu_max_field, NULL_TREE);
TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
/* Make a range type with the new ranges, but using
@ -2331,7 +2332,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_get_parent = build (COMPONENT_REF, void_type_node,
build (PLACEHOLDER_EXPR, gnu_type),
build_decl (FIELD_DECL, NULL_TREE,
NULL_TREE));
NULL_TREE),
NULL_TREE);
if (Has_Discriminants (gnat_entity))
for (gnat_field = First_Stored_Discriminant (gnat_entity);
@ -2345,7 +2347,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_get_parent,
gnat_to_gnu_entity (Corresponding_Discriminant
(gnat_field),
NULL_TREE, 0)),
NULL_TREE, 0),
NULL_TREE),
1);
gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_entity));
@ -2387,7 +2390,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
build (COMPONENT_REF, TREE_TYPE (gnu_field),
build (PLACEHOLDER_EXPR,
DECL_CONTEXT (gnu_field)),
gnu_field),
gnu_field, NULL_TREE),
1);
TREE_CHAIN (gnu_field) = gnu_field_list;
@ -4453,12 +4456,9 @@ maybe_variable (tree gnu_operand)
purposes even if it isn't needed for code generation. */
static tree
elaborate_expression (Node_Id gnat_expr,
Entity_Id gnat_entity,
tree gnu_name,
int definition,
int need_value,
int need_debug)
elaborate_expression (Node_Id gnat_expr, Entity_Id gnat_entity,
tree gnu_name, bool definition, bool need_value,
bool need_debug)
{
tree gnu_expr;
@ -4480,10 +4480,8 @@ elaborate_expression (Node_Id gnat_expr,
= elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
gnu_name, definition, need_debug);
/* Save the expression in case we try to elaborate this entity again.
Since this is not a DECL, don't check it. If this is a constant,
don't save it since GNAT_EXPR might be used more than once. Also,
don't save if it's a discriminant. */
/* Save the expression in case we try to elaborate this entity again. Since
this is not a DECL, don't check it. Don't save if it's a discriminant. */
if (! CONTAINS_PLACEHOLDER_P (gnu_expr))
save_gnu_tree (gnat_expr, gnu_expr, 1);
@ -4493,12 +4491,9 @@ elaborate_expression (Node_Id gnat_expr,
/* Similar, but take a GNU expression. */
static tree
elaborate_expression_1 (Node_Id gnat_expr,
Entity_Id gnat_entity,
tree gnu_expr,
tree gnu_name,
int definition,
int need_debug)
elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
tree gnu_expr, tree gnu_name, bool definition,
bool need_debug)
{
tree gnu_decl = 0;
/* Strip any conversions to see if the expression is a readonly variable.
@ -4517,7 +4512,7 @@ elaborate_expression_1 (Node_Id gnat_expr,
if (TREE_CODE (gnu_expr) == FIELD_DECL)
gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr),
build (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
gnu_expr);
gnu_expr, NULL_TREE);
/* If GNU_EXPR is neither a placeholder nor a constant, nor a variable
that is a constant, make a variable that is initialized to contain the

156
gcc/ada/trans.c
View File

@ -109,6 +109,10 @@ static GTY(()) tree gnu_return_label_stack;
TREE_VALUE of each entry is the label of the corresponding LOOP_STMT. */
static GTY(()) tree gnu_loop_label_stack;
/* List of TREE_LIST nodes representing labels for switch statements.
TREE_VALUE of each entry is the label at the end of the switch. */
static GTY(()) tree gnu_switch_label_stack;
/* List of TREE_LIST nodes containing pending elaborations lists.
used to prevent the elaborations being reclaimed by GC. */
static GTY(()) tree gnu_pending_elaboration_lists;
@ -746,18 +750,21 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Object_Renaming_Declaration:
gnat_temp = Defining_Entity (gnat_node);
gnu_result = alloc_stmt_list ();
/* Don't do anything if this renaming is handled by the front end.
or if we are just annotating types and this object has a
composite or task type, don't elaborate it. */
/* Don't do anything if this renaming is handled by the front end. or if
we are just annotating types and this object has a composite or task
type, don't elaborate it. We return the result in case it has any
SAVE_EXPRs in it that need to be evaluated here. */
if (! Is_Renaming_Of_Object (gnat_temp)
&& ! (type_annotate_only
&& (Is_Array_Type (Etype (gnat_temp))
|| Is_Record_Type (Etype (gnat_temp))
|| Is_Concurrent_Type (Etype (gnat_temp)))))
gnat_to_gnu_entity (gnat_temp,
gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
gnu_result
= gnat_to_gnu_entity (gnat_temp,
gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
else
gnu_result = alloc_stmt_list ();
break;
case N_Implicit_Label_Declaration:
@ -2053,6 +2060,8 @@ gnat_to_gnu (Node_Id gnat_node)
/* We build a SWITCH_EXPR that contains the code with interspersed
CASE_LABEL_EXPRs for each label. */
push_stack (&gnu_switch_label_stack, NULL_TREE,
create_artificial_label ());
start_stmt_group ();
for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
Present (gnat_when);
@ -2121,10 +2130,17 @@ gnat_to_gnu (Node_Id gnat_node)
we want them to be local to this set of statements instead of
the block containing the Case statement. */
add_stmt (build_stmt_group (Statements (gnat_when), true));
add_stmt (build1 (GOTO_EXPR, void_type_node,
TREE_VALUE (gnu_switch_label_stack)));
}
/* Now emit a definition of the label all the cases branched to. */
add_stmt (build1 (LABEL_EXPR, void_type_node,
TREE_VALUE (gnu_switch_label_stack)));
gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
end_stmt_group (), NULL_TREE);
pop_stack (&gnu_switch_label_stack);
break;
}
@ -4051,8 +4067,11 @@ add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity)
{
/* If this is a variable that Gigi is to ignore, we may have been given
an ERROR_MARK. So test for it. We also might have been given a
reference for a renaming. So only do something for a decl. */
if (!DECL_P (gnu_decl))
reference for a renaming. So only do something for a decl. Also
ignore a TYPE_DECL for an UNCONSTRAINED_ARRAY_TYPE. */
if (!DECL_P (gnu_decl)
|| (TREE_CODE (gnu_decl) == TYPE_DECL
&& TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
return;
add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl),
@ -4254,7 +4273,7 @@ gnat_gimplify_stmt (tree *stmt_p)
return GS_OK;
case USE_STMT:
*stmt_p = build_empty_stmt ();
*stmt_p = alloc_stmt_list ();
return GS_ALL_DONE;
case DECL_STMT:
@ -4262,31 +4281,33 @@ gnat_gimplify_stmt (tree *stmt_p)
tree var = DECL_STMT_VAR (stmt);
if (TREE_CODE (var) == TYPE_DECL)
*stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (var));
else if (TREE_CODE (var) == VAR_DECL && !DECL_EXTERNAL (var)
&& !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
*stmt_p = gimplify_type_sizes (TREE_TYPE (var));
else if (TREE_CODE (var) == VAR_DECL)
{
tree pt_type = build_pointer_type (TREE_TYPE (var));
tree size, pre = NULL_TREE, post = NULL_TREE;
/* This is a variable-sized decl. Simplify its size and mark it
for deferred expansion. Note that mudflap depends on the format
of the emitted code: see mx_register_decls. */
*stmt_p = NULL_TREE;
size = get_initialized_tmp_var (DECL_SIZE_UNIT (var), &pre, &post);
DECL_DEFER_OUTPUT (var) = 1;
append_to_statement_list (pre, stmt_p);
append_to_statement_list
(build_function_call_expr
(implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
tree_cons (NULL_TREE,
build1 (ADDR_EXPR, pt_type, var),
tree_cons (NULL_TREE, size, NULL_TREE))),
stmt_p);
append_to_statement_list (post, stmt_p);
gimplify_one_sizepos (&DECL_SIZE (var), stmt_p);
gimplify_one_sizepos (&DECL_SIZE_UNIT (var), stmt_p);
if (!DECL_EXTERNAL (var) && !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
{
DECL_DEFER_OUTPUT (var) = 1;
append_to_statement_list
(build_function_call_expr
(implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
tree_cons (NULL_TREE,
build1 (ADDR_EXPR,
build_pointer_type (TREE_TYPE (var)),
var),
tree_cons (NULL_TREE, DECL_SIZE_UNIT (var),
NULL_TREE))),
stmt_p);
}
if (*stmt_p == NULL_TREE)
*stmt_p = alloc_stmt_list ();
}
else
*stmt_p = build_empty_stmt ();
*stmt_p = alloc_stmt_list ();
return GS_ALL_DONE;
}
@ -4352,76 +4373,6 @@ gnat_gimplify_stmt (tree *stmt_p)
abort ();
}
}
/* Look through GNU_TYPE for variable-sized objects and gimplify each such
size that we find. Return a STATEMENT_LIST containing the result. */
static tree
gnat_gimplify_type_sizes (tree gnu_type)
{
tree gnu_stmts = NULL_TREE;
tree gnu_field;
switch (TREE_CODE (gnu_type))
{
case ERROR_MARK:
case UNCONSTRAINED_ARRAY_TYPE:
return alloc_stmt_list ();
case INTEGER_TYPE:
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
case CHAR_TYPE:
case REAL_TYPE:
gnat_gimplify_one_sizepos (&TYPE_MIN_VALUE (gnu_type), &gnu_stmts);
gnat_gimplify_one_sizepos (&TYPE_MAX_VALUE (gnu_type), &gnu_stmts);
break;
case RECORD_TYPE:
case UNION_TYPE:
case QUAL_UNION_TYPE:
for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field;
gnu_field = TREE_CHAIN (gnu_field))
if (TREE_CODE (gnu_field) == FIELD_DECL)
gnat_gimplify_one_sizepos (&DECL_FIELD_OFFSET (gnu_field),
&gnu_stmts);
break;
default:
break;
}
gnat_gimplify_one_sizepos (&TYPE_SIZE (gnu_type), &gnu_stmts);
gnat_gimplify_one_sizepos (&TYPE_SIZE_UNIT (gnu_type), &gnu_stmts);
if (!gnu_stmts)
gnu_stmts = alloc_stmt_list ();
return gnu_stmts;
}
/* Subroutine of the above to gimplify one size or position, *GNU_EXPR_P.
We add any required statements to GNU_STMT_P. */
static void
gnat_gimplify_one_sizepos (tree *gnu_expr_p, tree *gnu_stmt_p)
{
tree gnu_pre = NULL_TREE, gnu_post = NULL_TREE;
/* We don't do anything if the value isn't there, is constant, or
contains a PLACEHOLDER_EXPR. */
if (*gnu_expr_p == NULL_TREE
|| TREE_CONSTANT (*gnu_expr_p)
|| CONTAINS_PLACEHOLDER_P (*gnu_expr_p))
return;
gimplify_expr (gnu_expr_p, &gnu_pre, &gnu_post, is_gimple_val, fb_rvalue);
if (gnu_pre)
append_to_statement_list (gnu_pre, gnu_stmt_p);
if (gnu_post)
append_to_statement_list (gnu_post, gnu_stmt_p);
}
/* Generate the RTL for the body of GNU_DECL. If NESTED_P is nonzero,
then we are already in the process of generating RTL for another
@ -5472,7 +5423,7 @@ gnat_stabilize_reference (tree ref, int force)
result = build (COMPONENT_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0),
force),
TREE_OPERAND (ref, 1));
TREE_OPERAND (ref, 1), NULL_TREE);
break;
case BIT_FIELD_REF:
@ -5592,6 +5543,9 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
rtx insn;
int result = 1;
/* ??? For now, force nothing to do. */
gnu_elab_list = 0;
/* If we have nothing to do, return. */
if (gnu_elab_list == 0)
return 1;

92
gcc/ada/utils.c
View File

@ -133,6 +133,7 @@ struct language_function GTY(())
int unused;
};
static tree mark_visited (tree *, int *, void *);
static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void);
static tree merge_sizes (tree, tree, tree, int, int);
@ -338,6 +339,21 @@ block_has_vars ()
return BLOCK_VARS (current_binding_level->block) != 0;
}
/* Utility function to mark nodes with TREE_VISITED. Called from walk_tree.
We use this to indicate all variable sizes and positions in global types
may not be shared by any subprogram. */
static tree
mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
if (TREE_VISITED (*tp))
*walk_subtrees = 0;
else
TREE_VISITED (*tp) = 1;
return NULL_TREE;
}
/* Records a ..._DECL node DECL as belonging to the current lexical scope.
Returns the ..._DECL node. */
@ -345,9 +361,13 @@ tree
pushdecl (tree decl)
{
/* If at top level, there is no context. But PARM_DECLs always go in the
level of its function. */
level of its function. Also, at toplevel we must protect all trees
that are part of sizes and positions. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
DECL_CONTEXT (decl) = 0;
{
DECL_CONTEXT (decl) = 0;
walk_tree (&decl, mark_visited, NULL, NULL);
}
else
DECL_CONTEXT (decl) = current_function_decl;
@ -1261,11 +1281,8 @@ create_index_type (tree min, tree max, tree index)
information about this type. */
tree
create_type_decl (tree type_name,
tree type,
struct attrib *attr_list,
int artificial_p,
int debug_info_p)
create_type_decl (tree type_name, tree type, struct attrib *attr_list,
int artificial_p, int debug_info_p)
{
tree type_decl = build_decl (TYPE_DECL, type_name, type);
enum tree_code code = TREE_CODE (type);
@ -1929,7 +1946,7 @@ gnat_gimplify_function (tree fndecl)
so that items like VLA sizes are expanded properly in the context of the
correct function. */
cgn = cgraph_node (fndecl);
for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
gnat_gimplify_function (cgn->decl);
}
@ -2615,6 +2632,7 @@ update_pointer_to (tree old_type, tree new_type)
{
tree ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type);
tree ptr1, ref1;
tree type;
/* If this is the main variant, process all the other variants first. */
@ -2662,26 +2680,30 @@ update_pointer_to (tree old_type, tree new_type)
TYPE_REFERENCE_TO (new_type) = ref;
for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
{
TREE_TYPE (ptr) = new_type;
for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
ptr1 = TYPE_NEXT_VARIANT (ptr1))
{
TREE_TYPE (ptr1) = new_type;
if (TYPE_NAME (ptr) != 0
&& TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ptr), NULL,
global_bindings_p (), 0);
}
if (TYPE_NAME (ptr1) != 0
&& TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ptr1), NULL,
global_bindings_p (), 0);
}
for (; ref; ref = TYPE_NEXT_PTR_TO (ref))
{
TREE_TYPE (ref) = new_type;
for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
ref1 = TYPE_NEXT_VARIANT (ref1))
{
TREE_TYPE (ref1) = new_type;
if (TYPE_NAME (ref) != 0
&& TREE_CODE (TYPE_NAME (ref)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ref), NULL,
global_bindings_p (), 0);
}
if (TYPE_NAME (ref1) != 0
&& TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ref1), NULL,
global_bindings_p (), 0);
}
}
/* Now deal with the unconstrained array case. In this case the "pointer"
@ -2711,7 +2733,7 @@ update_pointer_to (tree old_type, tree new_type)
ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr)));
new_ref = build (COMPONENT_REF, ptr_temp_type,
build (PLACEHOLDER_EXPR, ptr),
TREE_CHAIN (TYPE_FIELDS (ptr)));
TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
update_pointer_to
(TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
@ -2854,11 +2876,6 @@ convert (tree type, tree expr)
/* If EXPR is already the right type, we are done. */
if (type == etype)
return expr;
/* If we're converting between two aggregate types that have the same main
variant, just make a VIEW_CONVER_EXPR. */
else if (AGGREGATE_TYPE_P (type)
&& TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
return build1 (VIEW_CONVERT_EXPR, type, expr);
/* If the input type has padding, remove it by doing a component reference
to the field. If the output type has padding, make a constructor
@ -2995,7 +3012,7 @@ convert (tree type, tree expr)
&& operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0)
&& get_alias_set (type) == get_alias_set (etype))
return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0),
TREE_OPERAND (expr, 1));
TREE_OPERAND (expr, 1), NULL_TREE);
break;
@ -3043,9 +3060,16 @@ convert (tree type, tree expr)
if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
|| (code == INTEGER_CST && ecode == INTEGER_CST
&& (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
/* If we're converting between two aggregate types that have the same main
variant, just make a VIEW_CONVER_EXPR. */
else if (AGGREGATE_TYPE_P (type)
&& TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
return build1 (VIEW_CONVERT_EXPR, type, expr);
/* 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
&& (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
return fold (build1 (NOP_EXPR, type, expr));
switch (code)

32
gcc/ada/utils2.c
View File

@ -1535,10 +1535,8 @@ gnat_build_constructor (tree type, tree list)
actual record and know how to look for fields in variant parts. */
static tree
build_simple_component_ref (tree record_variable,
tree component,
tree field,
int no_fold_p)
build_simple_component_ref (tree record_variable, tree component,
tree field, int no_fold_p)
{
tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable));
tree ref;
@ -1610,7 +1608,8 @@ build_simple_component_ref (tree record_variable,
/* It would be nice to call "fold" here, but that can lose a type
we need to tag a PLACEHOLDER_EXPR with, so we can't do it. */
ref = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field);
ref = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
NULL_TREE);
if (TREE_READONLY (record_variable) || TREE_READONLY (field))
TREE_READONLY (ref) = 1;
@ -1625,10 +1624,8 @@ build_simple_component_ref (tree record_variable,
reference could not be found. */
tree
build_component_ref (tree record_variable,
tree component,
tree field,
int no_fold_p)
build_component_ref (tree record_variable, tree component,
tree field, int no_fold_p)
{
tree ref = build_simple_component_ref (record_variable, component, field,
no_fold_p);
@ -1930,7 +1927,7 @@ build_allocator (tree type,
result
= build (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
(MODIFY_EXPR, TREE_TYPE (TREE_TYPE (result)),
(MODIFY_EXPR, NULL_TREE,
build_unary_op (INDIRECT_REF, TREE_TYPE (TREE_TYPE (result)),
result),
init),
@ -1993,19 +1990,8 @@ gnat_mark_addressable (tree expr_node)
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
/* If we have already made a REG for this decl, we must put it
directly into the stack. Likewise for a MEM whose address is a
pseudo. Otherwise, set a flag to mark us to do it later. */
if (DECL_RTL_SET_P (expr_node)
&& (GET_CODE (DECL_RTL (expr_node)) == REG
|| (GET_CODE (DECL_RTL (expr_node)) == MEM
&& GET_CODE (XEXP (DECL_RTL (expr_node), 0)) == REG
&& (REGNO (XEXP (DECL_RTL (expr_node), 0))
> LAST_VIRTUAL_REGISTER))))
put_var_into_stack (expr_node, 1);
else
TREE_ADDRESSABLE (expr_node) = 1;
put_var_into_stack (expr_node, 1);
TREE_ADDRESSABLE (expr_node) = 1;
return true;
case FUNCTION_DECL: