From a09d56d8c7cf30531965eb461d0e58adcb7d72d9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 15 Apr 2010 10:38:36 +0000 Subject: [PATCH] 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) : ...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 --- gcc/ada/ChangeLog | 13 +++++++++ gcc/ada/gcc-interface/trans.c | 55 +++++++++-------------------------- gcc/ada/gcc-interface/utils.c | 22 ++++++-------- 3 files changed, 36 insertions(+), 54 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 379631922ec..7c97b6c65a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2010-04-15 Eric Botcazou + + * 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) : ...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 * gcc-interface/trans.c (call_to_gnu): Do not unnecessarily force diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index adaa7ee53c9..f11fa5b5bab 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -620,7 +620,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, 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. */ @@ -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 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) { @@ -2888,8 +2887,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) = 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 @@ -2952,7 +2950,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) 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); } } @@ -3378,7 +3376,10 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) 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 @@ -3508,7 +3509,6 @@ gnat_to_gnu (Node_Id gnat_node) 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 @@ -3517,13 +3517,10 @@ gnat_to_gnu (Node_Id gnat_node) || (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; } @@ -4866,12 +4863,7 @@ gnat_to_gnu (Node_Id gnat_node) /*********************************************************/ 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; @@ -5298,35 +5290,16 @@ gnat_to_gnu (Node_Id gnat_node) 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 diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 335941a2e0c..cd868a8c479 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -310,7 +310,7 @@ global_bindings_p (void) return ((force_global || !current_function_decl) ? -1 : 0); } -/* Enter a new binding level. */ +/* Enter a new binding level. */ void gnat_pushlevel (void) @@ -342,11 +342,11 @@ 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; @@ -360,6 +360,7 @@ set_current_block_context (tree fndecl) { 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. */ @@ -378,7 +379,7 @@ get_block_jmpbuf_decl (void) 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) @@ -391,7 +392,7 @@ 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) @@ -518,12 +519,6 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) 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 @@ -1894,6 +1889,7 @@ begin_subprog_body (tree subprog_decl) /* 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; @@ -1915,7 +1911,7 @@ end_subprog_body (tree body) /* 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 ();