trans.c (gigi): Do not start statement group.
* gcc-interface/trans.c (gigi): Do not start statement group. (Compilation_Unit_to_gnu): Set current_function_decl to NULL. Start statement group and push binding level here... (gnat_to_gnu) <N_Compilation_Unit>: ...and not here. Do not push fake contexts at top level. Remove redundant code. (call_to_gnu): Rename a local variable and constify another. * gcc-interface/utils.c (gnat_pushlevel): Fix formatting nits. (set_current_block_context): Set it as the group's block. (gnat_init_decl_processing): Delete unrelated init code. (end_subprog_body): Use NULL_TREE. From-SVN: r158370
This commit is contained in:
parent
932c865054
commit
a09d56d8c7
|
@ -1,3 +1,16 @@
|
||||||
|
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
|
* gcc-interface/trans.c (gigi): Do not start statement group.
|
||||||
|
(Compilation_Unit_to_gnu): Set current_function_decl to NULL.
|
||||||
|
Start statement group and push binding level here...
|
||||||
|
(gnat_to_gnu) <N_Compilation_Unit>: ...and not here.
|
||||||
|
Do not push fake contexts at top level. Remove redundant code.
|
||||||
|
(call_to_gnu): Rename a local variable and constify another.
|
||||||
|
* gcc-interface/utils.c (gnat_pushlevel): Fix formatting nits.
|
||||||
|
(set_current_block_context): Set it as the group's block.
|
||||||
|
(gnat_init_decl_processing): Delete unrelated init code.
|
||||||
|
(end_subprog_body): Use NULL_TREE.
|
||||||
|
|
||||||
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gcc-interface/trans.c (call_to_gnu): Do not unnecessarily force
|
* gcc-interface/trans.c (call_to_gnu): Do not unnecessarily force
|
||||||
|
|
|
@ -620,7 +620,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
|
||||||
gnat_init_gcc_eh ();
|
gnat_init_gcc_eh ();
|
||||||
|
|
||||||
/* Now translate the compilation unit proper. */
|
/* Now translate the compilation unit proper. */
|
||||||
start_stmt_group ();
|
|
||||||
Compilation_Unit_to_gnu (gnat_root);
|
Compilation_Unit_to_gnu (gnat_root);
|
||||||
|
|
||||||
/* Finally see if we have any elaboration procedures to deal with. */
|
/* Finally see if we have any elaboration procedures to deal with. */
|
||||||
|
@ -2849,8 +2848,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||||
{
|
{
|
||||||
/* List of FIELD_DECLs associated with the PARM_DECLs of the copy
|
/* List of FIELD_DECLs associated with the PARM_DECLs of the copy
|
||||||
in copy out parameters. */
|
in copy out parameters. */
|
||||||
tree scalar_return_list = TYPE_CI_CO_LIST (gnu_subprog_type);
|
tree gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
|
||||||
int length = list_length (scalar_return_list);
|
const int length = list_length (gnu_cico_list);
|
||||||
|
|
||||||
if (length > 1)
|
if (length > 1)
|
||||||
{
|
{
|
||||||
|
@ -2888,8 +2887,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||||
= length == 1
|
= length == 1
|
||||||
? gnu_call
|
? gnu_call
|
||||||
: build_component_ref (gnu_call, NULL_TREE,
|
: build_component_ref (gnu_call, NULL_TREE,
|
||||||
TREE_PURPOSE (scalar_return_list),
|
TREE_PURPOSE (gnu_cico_list), false);
|
||||||
false);
|
|
||||||
|
|
||||||
/* If the actual is a conversion, get the inner expression, which
|
/* If the actual is a conversion, get the inner expression, which
|
||||||
will be the real destination, and convert the result to the
|
will be the real destination, and convert the result to the
|
||||||
|
@ -2952,7 +2950,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||||
gnu_actual, gnu_result);
|
gnu_actual, gnu_result);
|
||||||
set_expr_location_from_node (gnu_result, gnat_node);
|
set_expr_location_from_node (gnu_result, gnat_node);
|
||||||
append_to_statement_list (gnu_result, &gnu_before_list);
|
append_to_statement_list (gnu_result, &gnu_before_list);
|
||||||
scalar_return_list = TREE_CHAIN (scalar_return_list);
|
gnu_cico_list = TREE_CHAIN (gnu_cico_list);
|
||||||
gnu_name_list = TREE_CHAIN (gnu_name_list);
|
gnu_name_list = TREE_CHAIN (gnu_name_list);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -3378,7 +3376,10 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
|
||||||
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
|
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
|
||||||
allocate_struct_function (gnu_elab_proc_decl, false);
|
allocate_struct_function (gnu_elab_proc_decl, false);
|
||||||
Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
|
Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
|
||||||
|
current_function_decl = NULL_TREE;
|
||||||
set_cfun (NULL);
|
set_cfun (NULL);
|
||||||
|
start_stmt_group ();
|
||||||
|
gnat_pushlevel ();
|
||||||
|
|
||||||
/* For a body, first process the spec if there is one. */
|
/* For a body, first process the spec if there is one. */
|
||||||
if (Nkind (Unit (gnat_node)) == N_Package_Body
|
if (Nkind (Unit (gnat_node)) == N_Package_Body
|
||||||
|
@ -3508,7 +3509,6 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||||
N_Raise_Constraint_Error));
|
N_Raise_Constraint_Error));
|
||||||
|
|
||||||
if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
|
if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
|
||||||
&& !IN (kind, N_SCIL_Node)
|
|
||||||
&& kind != N_Null_Statement)
|
&& kind != N_Null_Statement)
|
||||||
|| kind == N_Procedure_Call_Statement
|
|| kind == N_Procedure_Call_Statement
|
||||||
|| kind == N_Label
|
|| kind == N_Label
|
||||||
|
@ -3517,13 +3517,10 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||||
|| (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
|
|| (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
|
||||||
{
|
{
|
||||||
/* If this is a statement and we are at top level, it must be part of
|
/* If this is a statement and we are at top level, it must be part of
|
||||||
the elaboration procedure, so mark us as being in that procedure
|
the elaboration procedure, so mark us as being in that procedure. */
|
||||||
and push our context. */
|
|
||||||
if (!current_function_decl)
|
if (!current_function_decl)
|
||||||
{
|
{
|
||||||
current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
|
current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
|
||||||
start_stmt_group ();
|
|
||||||
gnat_pushlevel ();
|
|
||||||
went_into_elab_proc = true;
|
went_into_elab_proc = true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -4866,12 +4863,7 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||||
/*********************************************************/
|
/*********************************************************/
|
||||||
|
|
||||||
case N_Compilation_Unit:
|
case N_Compilation_Unit:
|
||||||
|
/* This is not called for the main unit on which gigi is invoked. */
|
||||||
/* This is not called for the main unit, which is handled in function
|
|
||||||
gigi above. */
|
|
||||||
start_stmt_group ();
|
|
||||||
gnat_pushlevel ();
|
|
||||||
|
|
||||||
Compilation_Unit_to_gnu (gnat_node);
|
Compilation_Unit_to_gnu (gnat_node);
|
||||||
gnu_result = alloc_stmt_list ();
|
gnu_result = alloc_stmt_list ();
|
||||||
break;
|
break;
|
||||||
|
@ -5298,35 +5290,16 @@ gnat_to_gnu (Node_Id gnat_node)
|
||||||
gnu_result = alloc_stmt_list ();
|
gnu_result = alloc_stmt_list ();
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case N_SCIL_Dispatch_Table_Object_Init:
|
|
||||||
case N_SCIL_Dispatch_Table_Tag_Init:
|
|
||||||
case N_SCIL_Dispatching_Call:
|
|
||||||
case N_SCIL_Membership_Test:
|
|
||||||
case N_SCIL_Tag_Init:
|
|
||||||
/* SCIL nodes require no processing for GCC. */
|
|
||||||
gnu_result = alloc_stmt_list ();
|
|
||||||
break;
|
|
||||||
|
|
||||||
case N_Raise_Statement:
|
|
||||||
case N_Function_Specification:
|
|
||||||
case N_Procedure_Specification:
|
|
||||||
case N_Op_Concat:
|
|
||||||
case N_Component_Association:
|
|
||||||
case N_Task_Body:
|
|
||||||
default:
|
default:
|
||||||
gcc_assert (type_annotate_only);
|
/* SCIL nodes require no processing for GCC. Other nodes should only
|
||||||
|
be present when annotating types. */
|
||||||
|
gcc_assert (IN (kind, N_SCIL_Node) || type_annotate_only);
|
||||||
gnu_result = alloc_stmt_list ();
|
gnu_result = alloc_stmt_list ();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* If we pushed our level as part of processing the elaboration routine,
|
/* If we pushed the processing of the elaboration routine, pop it back. */
|
||||||
pop it back now. */
|
|
||||||
if (went_into_elab_proc)
|
if (went_into_elab_proc)
|
||||||
{
|
current_function_decl = NULL_TREE;
|
||||||
add_stmt (gnu_result);
|
|
||||||
gnat_poplevel ();
|
|
||||||
gnu_result = end_stmt_group ();
|
|
||||||
current_function_decl = NULL_TREE;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Set the location information on the result if it is a real expression.
|
/* Set the location information on the result if it is a real expression.
|
||||||
References can be reused for multiple GNAT nodes and they would get
|
References can be reused for multiple GNAT nodes and they would get
|
||||||
|
|
|
@ -310,7 +310,7 @@ global_bindings_p (void)
|
||||||
return ((force_global || !current_function_decl) ? -1 : 0);
|
return ((force_global || !current_function_decl) ? -1 : 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Enter a new binding level. */
|
/* Enter a new binding level. */
|
||||||
|
|
||||||
void
|
void
|
||||||
gnat_pushlevel (void)
|
gnat_pushlevel (void)
|
||||||
|
@ -342,11 +342,11 @@ gnat_pushlevel (void)
|
||||||
if (current_binding_level)
|
if (current_binding_level)
|
||||||
BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
|
BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
|
||||||
|
|
||||||
BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
|
BLOCK_VARS (newlevel->block) = NULL_TREE;
|
||||||
|
BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
|
||||||
TREE_USED (newlevel->block) = 1;
|
TREE_USED (newlevel->block) = 1;
|
||||||
|
|
||||||
/* Add this level to the front of the chain (stack) of levels that are
|
/* Add this level to the front of the chain (stack) of active levels. */
|
||||||
active. */
|
|
||||||
newlevel->chain = current_binding_level;
|
newlevel->chain = current_binding_level;
|
||||||
newlevel->jmpbuf_decl = NULL_TREE;
|
newlevel->jmpbuf_decl = NULL_TREE;
|
||||||
current_binding_level = newlevel;
|
current_binding_level = newlevel;
|
||||||
|
@ -360,6 +360,7 @@ set_current_block_context (tree fndecl)
|
||||||
{
|
{
|
||||||
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
|
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
|
||||||
DECL_INITIAL (fndecl) = current_binding_level->block;
|
DECL_INITIAL (fndecl) = current_binding_level->block;
|
||||||
|
set_block_for_group (current_binding_level->block);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Set the jmpbuf_decl for the current binding level to DECL. */
|
/* Set the jmpbuf_decl for the current binding level to DECL. */
|
||||||
|
@ -378,7 +379,7 @@ get_block_jmpbuf_decl (void)
|
||||||
return current_binding_level->jmpbuf_decl;
|
return current_binding_level->jmpbuf_decl;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Exit a binding level. Set any BLOCK into the current code group. */
|
/* Exit a binding level. Set any BLOCK into the current code group. */
|
||||||
|
|
||||||
void
|
void
|
||||||
gnat_poplevel (void)
|
gnat_poplevel (void)
|
||||||
|
@ -391,7 +392,7 @@ gnat_poplevel (void)
|
||||||
|
|
||||||
/* If this is a function-level BLOCK don't do anything. Otherwise, if there
|
/* If this is a function-level BLOCK don't do anything. Otherwise, if there
|
||||||
are no variables free the block and merge its subblocks into those of its
|
are no variables free the block and merge its subblocks into those of its
|
||||||
parent block. Otherwise, add it to the list of its parent. */
|
parent block. Otherwise, add it to the list of its parent. */
|
||||||
if (TREE_CODE (BLOCK_SUPERCONTEXT (block)) == FUNCTION_DECL)
|
if (TREE_CODE (BLOCK_SUPERCONTEXT (block)) == FUNCTION_DECL)
|
||||||
;
|
;
|
||||||
else if (BLOCK_VARS (block) == NULL_TREE)
|
else if (BLOCK_VARS (block) == NULL_TREE)
|
||||||
|
@ -518,12 +519,6 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
|
||||||
void
|
void
|
||||||
gnat_init_decl_processing (void)
|
gnat_init_decl_processing (void)
|
||||||
{
|
{
|
||||||
/* Make the binding_level structure for global names. */
|
|
||||||
current_function_decl = 0;
|
|
||||||
current_binding_level = 0;
|
|
||||||
free_binding_level = 0;
|
|
||||||
gnat_pushlevel ();
|
|
||||||
|
|
||||||
build_common_tree_nodes (true, true);
|
build_common_tree_nodes (true, true);
|
||||||
|
|
||||||
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
|
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
|
||||||
|
@ -1894,6 +1889,7 @@ begin_subprog_body (tree subprog_decl)
|
||||||
/* Enter a new binding level and show that all the parameters belong to
|
/* Enter a new binding level and show that all the parameters belong to
|
||||||
this function. */
|
this function. */
|
||||||
gnat_pushlevel ();
|
gnat_pushlevel ();
|
||||||
|
|
||||||
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
|
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
|
||||||
param_decl = TREE_CHAIN (param_decl))
|
param_decl = TREE_CHAIN (param_decl))
|
||||||
DECL_CONTEXT (param_decl) = subprog_decl;
|
DECL_CONTEXT (param_decl) = subprog_decl;
|
||||||
|
@ -1915,7 +1911,7 @@ end_subprog_body (tree body)
|
||||||
|
|
||||||
/* Mark the BLOCK for this level as being for this function and pop the
|
/* Mark the BLOCK for this level as being for this function and pop the
|
||||||
level. Since the vars in it are the parameters, clear them. */
|
level. Since the vars in it are the parameters, clear them. */
|
||||||
BLOCK_VARS (current_binding_level->block) = 0;
|
BLOCK_VARS (current_binding_level->block) = NULL_TREE;
|
||||||
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
|
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
|
||||||
DECL_INITIAL (fndecl) = current_binding_level->block;
|
DECL_INITIAL (fndecl) = current_binding_level->block;
|
||||||
gnat_poplevel ();
|
gnat_poplevel ();
|
||||||
|
|
Loading…
Reference in New Issue