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> 2004-06-14 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation. * 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 tree substitution_list (Entity_Id, Entity_Id, tree, int);
static int allocatable_size_p (tree, int); static int allocatable_size_p (tree, int);
static struct attrib *build_attr_list (Entity_Id); 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 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 make_packable_type (tree);
static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *, static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *,
int, int, int); 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. */ fields once we build them. */
tem = build (COMPONENT_REF, gnu_ptr_template, tem = build (COMPONENT_REF, gnu_ptr_template,
build (PLACEHOLDER_EXPR, gnu_fat_type), 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 gnu_template_reference
= build_unary_op (INDIRECT_REF, gnu_template_type, tem); = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
TREE_READONLY (gnu_template_reference) = 1; 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 /* We can't use build_component_ref here since the template
type isn't complete yet. */ type isn't complete yet. */
gnu_min = build (COMPONENT_REF, gnu_ind_subtype, 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_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; TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
/* Make a range type with the new ranges, but using /* 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, gnu_get_parent = build (COMPONENT_REF, void_type_node,
build (PLACEHOLDER_EXPR, gnu_type), build (PLACEHOLDER_EXPR, gnu_type),
build_decl (FIELD_DECL, NULL_TREE, build_decl (FIELD_DECL, NULL_TREE,
NULL_TREE)); NULL_TREE),
NULL_TREE);
if (Has_Discriminants (gnat_entity)) if (Has_Discriminants (gnat_entity))
for (gnat_field = First_Stored_Discriminant (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, gnu_get_parent,
gnat_to_gnu_entity (Corresponding_Discriminant gnat_to_gnu_entity (Corresponding_Discriminant
(gnat_field), (gnat_field),
NULL_TREE, 0)), NULL_TREE, 0),
NULL_TREE),
1); 1);
gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_entity)); 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 (COMPONENT_REF, TREE_TYPE (gnu_field),
build (PLACEHOLDER_EXPR, build (PLACEHOLDER_EXPR,
DECL_CONTEXT (gnu_field)), DECL_CONTEXT (gnu_field)),
gnu_field), gnu_field, NULL_TREE),
1); 1);
TREE_CHAIN (gnu_field) = gnu_field_list; 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. */ purposes even if it isn't needed for code generation. */
static tree static tree
elaborate_expression (Node_Id gnat_expr, elaborate_expression (Node_Id gnat_expr, Entity_Id gnat_entity,
Entity_Id gnat_entity, tree gnu_name, bool definition, bool need_value,
tree gnu_name, bool need_debug)
int definition,
int need_value,
int need_debug)
{ {
tree gnu_expr; 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), = elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
gnu_name, definition, need_debug); gnu_name, definition, need_debug);
/* Save the expression in case we try to elaborate this entity again. /* Save the expression in case we try to elaborate this entity again. Since
Since this is not a DECL, don't check it. If this is a constant, this is not a DECL, don't check it. Don't save if it's a discriminant. */
don't save it since GNAT_EXPR might be used more than once. Also,
don't save if it's a discriminant. */
if (! CONTAINS_PLACEHOLDER_P (gnu_expr)) if (! CONTAINS_PLACEHOLDER_P (gnu_expr))
save_gnu_tree (gnat_expr, gnu_expr, 1); save_gnu_tree (gnat_expr, gnu_expr, 1);
@ -4493,12 +4491,9 @@ elaborate_expression (Node_Id gnat_expr,
/* Similar, but take a GNU expression. */ /* Similar, but take a GNU expression. */
static tree static tree
elaborate_expression_1 (Node_Id gnat_expr, elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
Entity_Id gnat_entity, tree gnu_expr, tree gnu_name, bool definition,
tree gnu_expr, bool need_debug)
tree gnu_name,
int definition,
int need_debug)
{ {
tree gnu_decl = 0; tree gnu_decl = 0;
/* Strip any conversions to see if the expression is a readonly variable. /* 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) if (TREE_CODE (gnu_expr) == FIELD_DECL)
gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr), gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr),
build (PLACEHOLDER_EXPR, DECL_CONTEXT (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 /* 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 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. */ TREE_VALUE of each entry is the label of the corresponding LOOP_STMT. */
static GTY(()) tree gnu_loop_label_stack; 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. /* List of TREE_LIST nodes containing pending elaborations lists.
used to prevent the elaborations being reclaimed by GC. */ used to prevent the elaborations being reclaimed by GC. */
static GTY(()) tree gnu_pending_elaboration_lists; static GTY(()) tree gnu_pending_elaboration_lists;
@ -746,18 +750,21 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Object_Renaming_Declaration: case N_Object_Renaming_Declaration:
gnat_temp = Defining_Entity (gnat_node); gnat_temp = Defining_Entity (gnat_node);
gnu_result = alloc_stmt_list ();
/* Don't do anything if this renaming is handled by the front end. /* Don't do anything if this renaming is handled by the front end. or if
or if we are just annotating types and this object has a we are just annotating types and this object has a composite or task
composite or task type, don't elaborate it. */ 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) if (! Is_Renaming_Of_Object (gnat_temp)
&& ! (type_annotate_only && ! (type_annotate_only
&& (Is_Array_Type (Etype (gnat_temp)) && (Is_Array_Type (Etype (gnat_temp))
|| Is_Record_Type (Etype (gnat_temp)) || Is_Record_Type (Etype (gnat_temp))
|| Is_Concurrent_Type (Etype (gnat_temp))))) || Is_Concurrent_Type (Etype (gnat_temp)))))
gnat_to_gnu_entity (gnat_temp, gnu_result
gnat_to_gnu (Renamed_Object (gnat_temp)), 1); = gnat_to_gnu_entity (gnat_temp,
gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
else
gnu_result = alloc_stmt_list ();
break; break;
case N_Implicit_Label_Declaration: 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 /* We build a SWITCH_EXPR that contains the code with interspersed
CASE_LABEL_EXPRs for each label. */ CASE_LABEL_EXPRs for each label. */
push_stack (&gnu_switch_label_stack, NULL_TREE,
create_artificial_label ());
start_stmt_group (); start_stmt_group ();
for (gnat_when = First_Non_Pragma (Alternatives (gnat_node)); for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
Present (gnat_when); 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 we want them to be local to this set of statements instead of
the block containing the Case statement. */ the block containing the Case statement. */
add_stmt (build_stmt_group (Statements (gnat_when), true)); 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, gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
end_stmt_group (), NULL_TREE); end_stmt_group (), NULL_TREE);
pop_stack (&gnu_switch_label_stack);
break; 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 /* 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 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. */ reference for a renaming. So only do something for a decl. Also
if (!DECL_P (gnu_decl)) 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; return;
add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl), 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; return GS_OK;
case USE_STMT: case USE_STMT:
*stmt_p = build_empty_stmt (); *stmt_p = alloc_stmt_list ();
return GS_ALL_DONE; return GS_ALL_DONE;
case DECL_STMT: case DECL_STMT:
@ -4262,31 +4281,33 @@ gnat_gimplify_stmt (tree *stmt_p)
tree var = DECL_STMT_VAR (stmt); tree var = DECL_STMT_VAR (stmt);
if (TREE_CODE (var) == TYPE_DECL) if (TREE_CODE (var) == TYPE_DECL)
*stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (var)); *stmt_p = gimplify_type_sizes (TREE_TYPE (var));
else if (TREE_CODE (var) == VAR_DECL && !DECL_EXTERNAL (var) else if (TREE_CODE (var) == VAR_DECL)
&& !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
{ {
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; *stmt_p = NULL_TREE;
size = get_initialized_tmp_var (DECL_SIZE_UNIT (var), &pre, &post); gimplify_one_sizepos (&DECL_SIZE (var), stmt_p);
DECL_DEFER_OUTPUT (var) = 1; gimplify_one_sizepos (&DECL_SIZE_UNIT (var), stmt_p);
append_to_statement_list (pre, stmt_p);
append_to_statement_list if (!DECL_EXTERNAL (var) && !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
(build_function_call_expr {
(implicit_built_in_decls[BUILT_IN_STACK_ALLOC], DECL_DEFER_OUTPUT (var) = 1;
tree_cons (NULL_TREE, append_to_statement_list
build1 (ADDR_EXPR, pt_type, var), (build_function_call_expr
tree_cons (NULL_TREE, size, NULL_TREE))), (implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
stmt_p); tree_cons (NULL_TREE,
append_to_statement_list (post, stmt_p); 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 else
*stmt_p = build_empty_stmt (); *stmt_p = alloc_stmt_list ();
return GS_ALL_DONE; return GS_ALL_DONE;
} }
@ -4352,76 +4373,6 @@ gnat_gimplify_stmt (tree *stmt_p)
abort (); 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, /* 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 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, result = build (COMPONENT_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), gnat_stabilize_reference (TREE_OPERAND (ref, 0),
force), force),
TREE_OPERAND (ref, 1)); TREE_OPERAND (ref, 1), NULL_TREE);
break; break;
case BIT_FIELD_REF: case BIT_FIELD_REF:
@ -5592,6 +5543,9 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
rtx insn; rtx insn;
int result = 1; int result = 1;
/* ??? For now, force nothing to do. */
gnu_elab_list = 0;
/* If we have nothing to do, return. */ /* If we have nothing to do, return. */
if (gnu_elab_list == 0) if (gnu_elab_list == 0)
return 1; return 1;

92
gcc/ada/utils.c
View File

@ -133,6 +133,7 @@ struct language_function GTY(())
int unused; int unused;
}; };
static tree mark_visited (tree *, int *, void *);
static void gnat_define_builtin (const char *, tree, int, const char *, bool); static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void); static void gnat_install_builtins (void);
static tree merge_sizes (tree, tree, tree, int, int); static tree merge_sizes (tree, tree, tree, int, int);
@ -338,6 +339,21 @@ block_has_vars ()
return BLOCK_VARS (current_binding_level->block) != 0; 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. /* Records a ..._DECL node DECL as belonging to the current lexical scope.
Returns the ..._DECL node. */ Returns the ..._DECL node. */
@ -345,9 +361,13 @@ tree
pushdecl (tree decl) pushdecl (tree decl)
{ {
/* If at top level, there is no context. But PARM_DECLs always go in the /* 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) 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 else
DECL_CONTEXT (decl) = current_function_decl; DECL_CONTEXT (decl) = current_function_decl;
@ -1261,11 +1281,8 @@ create_index_type (tree min, tree max, tree index)
information about this type. */ information about this type. */
tree tree
create_type_decl (tree type_name, create_type_decl (tree type_name, tree type, struct attrib *attr_list,
tree type, int artificial_p, int debug_info_p)
struct attrib *attr_list,
int artificial_p,
int debug_info_p)
{ {
tree type_decl = build_decl (TYPE_DECL, type_name, type); tree type_decl = build_decl (TYPE_DECL, type_name, type);
enum tree_code code = TREE_CODE (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 so that items like VLA sizes are expanded properly in the context of the
correct function. */ correct function. */
cgn = cgraph_node (fndecl); 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); 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 ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type); tree ref = TYPE_REFERENCE_TO (old_type);
tree ptr1, ref1;
tree type; tree type;
/* If this is the main variant, process all the other variants first. */ /* 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; TYPE_REFERENCE_TO (new_type) = ref;
for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr)) for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
{ for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
TREE_TYPE (ptr) = new_type; ptr1 = TYPE_NEXT_VARIANT (ptr1))
{
TREE_TYPE (ptr1) = new_type;
if (TYPE_NAME (ptr) != 0 if (TYPE_NAME (ptr1) != 0
&& TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL && TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE) && TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ptr), NULL, rest_of_decl_compilation (TYPE_NAME (ptr1), NULL,
global_bindings_p (), 0); global_bindings_p (), 0);
} }
for (; ref; ref = TYPE_NEXT_PTR_TO (ref)) for (; ref; ref = TYPE_NEXT_PTR_TO (ref))
{ for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
TREE_TYPE (ref) = new_type; ref1 = TYPE_NEXT_VARIANT (ref1))
{
TREE_TYPE (ref1) = new_type;
if (TYPE_NAME (ref) != 0 if (TYPE_NAME (ref1) != 0
&& TREE_CODE (TYPE_NAME (ref)) == TYPE_DECL && TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL
&& TREE_CODE (new_type) != ENUMERAL_TYPE) && TREE_CODE (new_type) != ENUMERAL_TYPE)
rest_of_decl_compilation (TYPE_NAME (ref), NULL, rest_of_decl_compilation (TYPE_NAME (ref1), NULL,
global_bindings_p (), 0); global_bindings_p (), 0);
} }
} }
/* Now deal with the unconstrained array case. In this case the "pointer" /* 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))); ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr)));
new_ref = build (COMPONENT_REF, ptr_temp_type, new_ref = build (COMPONENT_REF, ptr_temp_type,
build (PLACEHOLDER_EXPR, ptr), build (PLACEHOLDER_EXPR, ptr),
TREE_CHAIN (TYPE_FIELDS (ptr))); TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
update_pointer_to update_pointer_to
(TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))), (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 EXPR is already the right type, we are done. */
if (type == etype) if (type == etype)
return expr; 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 /* 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 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) && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0)
&& get_alias_set (type) == get_alias_set (etype)) && get_alias_set (type) == get_alias_set (etype))
return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0), return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0),
TREE_OPERAND (expr, 1)); TREE_OPERAND (expr, 1), NULL_TREE);
break; break;
@ -3043,9 +3060,16 @@ convert (tree type, tree expr)
if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype)) if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr); return convert_to_fat_pointer (type, expr);
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype) /* If we're converting between two aggregate types that have the same main
|| (code == INTEGER_CST && ecode == INTEGER_CST variant, just make a VIEW_CONVER_EXPR. */
&& (type == TREE_TYPE (etype) || etype == TREE_TYPE (type)))) 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)); return fold (build1 (NOP_EXPR, type, expr));
switch (code) 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. */ actual record and know how to look for fields in variant parts. */
static tree static tree
build_simple_component_ref (tree record_variable, build_simple_component_ref (tree record_variable, tree component,
tree component, tree field, int no_fold_p)
tree field,
int no_fold_p)
{ {
tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable)); tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable));
tree ref; 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 /* 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. */ 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)) if (TREE_READONLY (record_variable) || TREE_READONLY (field))
TREE_READONLY (ref) = 1; TREE_READONLY (ref) = 1;
@ -1625,10 +1624,8 @@ build_simple_component_ref (tree record_variable,
reference could not be found. */ reference could not be found. */
tree tree
build_component_ref (tree record_variable, build_component_ref (tree record_variable, tree component,
tree component, tree field, int no_fold_p)
tree field,
int no_fold_p)
{ {
tree ref = build_simple_component_ref (record_variable, component, field, tree ref = build_simple_component_ref (record_variable, component, field,
no_fold_p); no_fold_p);
@ -1930,7 +1927,7 @@ build_allocator (tree type,
result result
= build (COMPOUND_EXPR, TREE_TYPE (result), = build (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op build_binary_op
(MODIFY_EXPR, TREE_TYPE (TREE_TYPE (result)), (MODIFY_EXPR, NULL_TREE,
build_unary_op (INDIRECT_REF, TREE_TYPE (TREE_TYPE (result)), build_unary_op (INDIRECT_REF, TREE_TYPE (TREE_TYPE (result)),
result), result),
init), init),
@ -1993,19 +1990,8 @@ gnat_mark_addressable (tree expr_node)
case VAR_DECL: case VAR_DECL:
case PARM_DECL: case PARM_DECL:
case RESULT_DECL: case RESULT_DECL:
/* If we have already made a REG for this decl, we must put it put_var_into_stack (expr_node, 1);
directly into the stack. Likewise for a MEM whose address is a TREE_ADDRESSABLE (expr_node) = 1;
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;
return true; return true;
case FUNCTION_DECL: case FUNCTION_DECL: