OSDN Git Service

* gcc-interface/trans.c (gigi): Do not start statement group.
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 15 Apr 2010 10:38:36 +0000 (10:38 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 01:02:13 +0000 (10:02 +0900)
(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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158370 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c

index 3796319..7c97b6c 100644 (file)
@@ -1,5 +1,18 @@
 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.
 
index adaa7ee..f11fa5b 100644 (file)
@@ -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
index 335941a..cd868a8 100644 (file)
@@ -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 ();