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>
+
* gcc-interface/trans.c (call_to_gnu): Do not unnecessarily force
side-effects of actual parameters before the call.
gnat_init_gcc_eh ();
/* Now translate the compilation unit proper. */
- start_stmt_group ();
Compilation_Unit_to_gnu (gnat_root);
/* Finally see if we have any elaboration procedures to deal with. */
{
/* List of FIELD_DECLs associated with the PARM_DECLs of the copy
in copy out parameters. */
- tree scalar_return_list = TYPE_CI_CO_LIST (gnu_subprog_type);
- int length = list_length (scalar_return_list);
+ tree gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
+ const int length = list_length (gnu_cico_list);
if (length > 1)
{
= length == 1
? gnu_call
: build_component_ref (gnu_call, NULL_TREE,
- TREE_PURPOSE (scalar_return_list),
- false);
+ TREE_PURPOSE (gnu_cico_list), false);
/* If the actual is a conversion, get the inner expression, which
will be the real destination, and convert the result to the
gnu_actual, gnu_result);
set_expr_location_from_node (gnu_result, gnat_node);
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);
}
}
DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
allocate_struct_function (gnu_elab_proc_decl, false);
Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
+ current_function_decl = NULL_TREE;
set_cfun (NULL);
+ start_stmt_group ();
+ gnat_pushlevel ();
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
N_Raise_Constraint_Error));
if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
- && !IN (kind, N_SCIL_Node)
&& kind != N_Null_Statement)
|| kind == N_Procedure_Call_Statement
|| kind == N_Label
|| (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
- the elaboration procedure, so mark us as being in that procedure
- and push our context. */
+ the elaboration procedure, so mark us as being in that procedure. */
if (!current_function_decl)
{
current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
- start_stmt_group ();
- gnat_pushlevel ();
went_into_elab_proc = true;
}
/*********************************************************/
case N_Compilation_Unit:
-
- /* This is not called for the main unit, which is handled in function
- gigi above. */
- start_stmt_group ();
- gnat_pushlevel ();
-
+ /* This is not called for the main unit on which gigi is invoked. */
Compilation_Unit_to_gnu (gnat_node);
gnu_result = alloc_stmt_list ();
break;
gnu_result = alloc_stmt_list ();
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:
- 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 ();
}
- /* If we pushed our level as part of processing the elaboration routine,
- pop it back now. */
+ /* If we pushed the processing of the elaboration routine, pop it back. */
if (went_into_elab_proc)
- {
- add_stmt (gnu_result);
- gnat_poplevel ();
- gnu_result = end_stmt_group ();
- current_function_decl = NULL_TREE;
- }
+ current_function_decl = NULL_TREE;
/* 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
return ((force_global || !current_function_decl) ? -1 : 0);
}
-/* Enter a new binding level. */
+/* Enter a new binding level. */
void
gnat_pushlevel (void)
if (current_binding_level)
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;
- /* Add this level to the front of the chain (stack) of levels that are
- active. */
+ /* Add this level to the front of the chain (stack) of active levels. */
newlevel->chain = current_binding_level;
newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel;
{
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
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. */
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
gnat_poplevel (void)
/* 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
- 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)
;
else if (BLOCK_VARS (block) == NULL_TREE)
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);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
+
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
/* 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. */
- BLOCK_VARS (current_binding_level->block) = 0;
+ BLOCK_VARS (current_binding_level->block) = NULL_TREE;
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (fndecl) = current_binding_level->block;
gnat_poplevel ();
OSDN Git Service
