trans.c (gnat_pushdecl): Do not do anything special for PARM_DECLs.

	* gcc-interface/trans.c (gnat_pushdecl): Do not do anything special
	for PARM_DECLs.
	(end_subprog_body): If the body is a BIND_EXPR, make its associated
	block the top-level one.
	(build_function_stub): Build a statement group for the whole function.
	* gcc-interface/utils.c (Subprogram_Body_to_gnu): If copy-in/copy-out
	is used, create the enclosing block early and process first the OUT
	parameters.

From-SVN: r164422

gcc/ada/ChangeLog

 2010-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/trans.c (gnat_pushdecl): Do not do anything special
+	for PARM_DECLs.
+	(end_subprog_body): If the body is a BIND_EXPR, make its associated
+	block the top-level one.
+	(build_function_stub): Build a statement group for the whole function.
+	* gcc-interface/utils.c (Subprogram_Body_to_gnu): If copy-in/copy-out
+	is used, create the enclosing block early and process first the OUT
+	parameters.
+
+2010-09-19  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Type>: Do
 	not generate debug info for individual enumerators.
 

gcc/ada/gcc-interface/trans.c

@@ -2455,40 +2455,48 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
   begin_subprog_body (gnu_subprog_decl);
 
-  /* If there are Out parameters, we need to ensure that the return statement
-     properly copies them out.  We do this by making a new block and converting
-     any inner return into a goto to a label at the end of the block.  */
+  /* If there are In Out or Out parameters, we need to ensure that the return
+     statement properly copies them out.  We do this by making a new block and
+     converting any return into a goto to a label at the end of the block.  */
   gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-  VEC_safe_push (tree, gc, gnu_return_label_stack,
-		 gnu_cico_list
-		 ? create_artificial_label (input_location)
-		 : NULL_TREE);
+  if (gnu_cico_list)
+    {
+      VEC_safe_push (tree, gc, gnu_return_label_stack,
+		     create_artificial_label (input_location));
+
+      start_stmt_group ();
+      gnat_pushlevel ();
+
+      /* See whether there are parameters for which we don't have a GCC tree
+	 yet.  These must be Out parameters.  Make a VAR_DECL for them and
+	 put it into TYPE_CI_CO_LIST, which must contain an empty entry too.
+	 We can match up the entries because TYPE_CI_CO_LIST is in the order
+	 of the parameters.  */
+      for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
+	   Present (gnat_param);
+	   gnat_param = Next_Formal_With_Extras (gnat_param))
+	if (!present_gnu_tree (gnat_param))
+	  {
+	    tree gnu_cico_entry = gnu_cico_list;
+
+	    /* Skip any entries that have been already filled in; they must
+	       correspond to In Out parameters.  */
+	    while (gnu_cico_entry && TREE_VALUE (gnu_cico_entry))
+	      gnu_cico_entry = TREE_CHAIN (gnu_cico_entry);
+
+	    /* Do any needed references for padded types.  */
+	    TREE_VALUE (gnu_cico_entry)
+	      = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)),
+			 gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
+	  }
+    }
+  else
+    VEC_safe_push (tree, gc, gnu_return_label_stack, NULL_TREE);
 
   /* Get a tree corresponding to the code for the subprogram.  */
   start_stmt_group ();
   gnat_pushlevel ();
 
-  /* See if there are any parameters for which we don't yet have GCC entities.
-     These must be for Out parameters for which we will be making VAR_DECL
-     nodes here.  Fill them in to TYPE_CI_CO_LIST, which must contain the empty
-     entry as well.  We can match up the entries because TYPE_CI_CO_LIST is in
-     the order of the parameters.  */
-  for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
-       Present (gnat_param);
-       gnat_param = Next_Formal_With_Extras (gnat_param))
-    if (!present_gnu_tree (gnat_param))
-      {
-	/* Skip any entries that have been already filled in; they must
-	   correspond to In Out parameters.  */
-	while (gnu_cico_list && TREE_VALUE (gnu_cico_list))
-	  gnu_cico_list = TREE_CHAIN (gnu_cico_list);
-
-	/* Do any needed references for padded types.  */
-	TREE_VALUE (gnu_cico_list)
-	  = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)),
-		     gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
-      }
-
   /* On VMS, establish our condition handler to possibly turn a condition into
      the corresponding exception if the subprogram has a foreign convention or
      is exported.
@@ -2513,6 +2521,40 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
   gnat_poplevel ();
   gnu_result = end_stmt_group ();
 
+  /* If we are dealing with a return from an Ada procedure with parameters
+     passed by copy-in/copy-out, we need to return a record containing the
+     final values of these parameters.  If the list contains only one entry,
+     return just that entry though.
+
+     For a full description of the copy-in/copy-out parameter mechanism, see
+     the part of the gnat_to_gnu_entity routine dealing with the translation
+     of subprograms.
+
+     We need to make a block that contains the definition of that label and
+     the copying of the return value.  It first contains the function, then
+     the label and copy statement.  */
+  if (gnu_cico_list)
+    {
+      tree gnu_retval;
+
+      add_stmt (gnu_result);
+      add_stmt (build1 (LABEL_EXPR, void_type_node,
+			VEC_last (tree, gnu_return_label_stack)));
+
+      if (list_length (gnu_cico_list) == 1)
+	gnu_retval = TREE_VALUE (gnu_cico_list);
+      else
+	gnu_retval = build_constructor_from_list (TREE_TYPE (gnu_subprog_type),
+						  gnu_cico_list);
+
+      add_stmt_with_node (build_return_expr (gnu_result_decl, gnu_retval),
+			  End_Label (Handled_Statement_Sequence (gnat_node)));
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
+    }
+
+  VEC_pop (tree, gnu_return_label_stack);
+
   /* If we populated the parameter attributes cache, we need to make sure
      that the cached expressions are evaluated on all possible paths.  */
   cache = DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language->parm_attr_cache;
@@ -2537,43 +2579,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
       gnu_result = end_stmt_group ();
     }
 
-    /* If we are dealing with a return from an Ada procedure with parameters
-       passed by copy-in/copy-out, we need to return a record containing the
-       final values of these parameters.  If the list contains only one entry,
-       return just that entry though.
-
-       For a full description of the copy-in/copy-out parameter mechanism, see
-       the part of the gnat_to_gnu_entity routine dealing with the translation
-       of subprograms.
-
-       We need to make a block that contains the definition of that label and
-       the copying of the return value.  It first contains the function, then
-       the label and copy statement.  */
-  if (VEC_last (tree, gnu_return_label_stack))
-    {
-      tree gnu_retval;
-
-      start_stmt_group ();
-      gnat_pushlevel ();
-      add_stmt (gnu_result);
-      add_stmt (build1 (LABEL_EXPR, void_type_node,
-			VEC_last (tree, gnu_return_label_stack)));
-
-      gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-      if (list_length (gnu_cico_list) == 1)
-	gnu_retval = TREE_VALUE (gnu_cico_list);
-      else
-	gnu_retval = build_constructor_from_list (TREE_TYPE (gnu_subprog_type),
-						  gnu_cico_list);
-
-      add_stmt_with_node (build_return_expr (gnu_result_decl, gnu_retval),
-			  End_Label (Handled_Statement_Sequence (gnat_node)));
-      gnat_poplevel ();
-      gnu_result = end_stmt_group ();
-    }
-
-  VEC_pop (tree, gnu_return_label_stack);
-
   /* Set the end location.  */
   Sloc_to_locus
     ((Present (End_Label (Handled_Statement_Sequence (gnat_node)))

gcc/ada/gcc-interface/utils.c

@@ -473,14 +473,8 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 	}
       else if (!DECL_EXTERNAL (decl))
 	{
-	  tree block;
-	  /* Fake PARM_DECLs go into the topmost block of the function.  */
-	  if (TREE_CODE (decl) == PARM_DECL)
-	    block = BLOCK_SUPERCONTEXT (current_binding_level->block);
-	  else
-	    block = current_binding_level->block;
-	  DECL_CHAIN (decl) = BLOCK_VARS (block);
-	  BLOCK_VARS (block) = decl;
+	  DECL_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
+	  BLOCK_VARS (current_binding_level->block) = decl;
 	}
     }
 
@@ -1907,6 +1901,13 @@ end_subprog_body (tree body)
   /* Mark the RESULT_DECL as being in this subprogram. */
   DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
 
+  /* The body should be a BIND_EXPR whose BLOCK is the top-level one.  */
+  if (TREE_CODE (body) == BIND_EXPR)
+    {
+      BLOCK_SUPERCONTEXT (BIND_EXPR_BLOCK (body)) = fndecl;
+      DECL_INITIAL (fndecl) = BIND_EXPR_BLOCK (body);
+    }
+
   DECL_SAVED_TREE (fndecl) = body;
 
   current_function_decl = DECL_CONTEXT (fndecl);
@@ -3228,15 +3229,18 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
   tree gnu_subprog_type, gnu_subprog_addr, gnu_subprog_call;
   tree gnu_stub_param, gnu_arg_types, gnu_param;
   tree gnu_stub_decl = DECL_FUNCTION_STUB (gnu_subprog);
-  tree gnu_body;
   VEC(tree,gc) *gnu_param_vec = NULL;
 
   gnu_subprog_type = TREE_TYPE (gnu_subprog);
 
+  /* Initialize the information structure for the function.  */
+  allocate_struct_function (gnu_stub_decl, false);
+  set_cfun (NULL);
+
   begin_subprog_body (gnu_stub_decl);
-  gnat_pushlevel ();
 
   start_stmt_group ();
+  gnat_pushlevel ();
 
   /* Loop over the parameters of the stub and translate any of them
      passed by descriptor into a by reference one.  */
@@ -3258,8 +3262,6 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
       VEC_safe_push (tree, gc, gnu_param_vec, gnu_param);
     }
 
-  gnu_body = end_stmt_group ();
-
   /* Invoke the internal subprogram.  */
   gnu_subprog_addr = build1 (ADDR_EXPR, build_pointer_type (gnu_subprog_type),
 			     gnu_subprog);
@@ -3268,16 +3270,13 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
 
   /* Propagate the return value, if any.  */
   if (VOID_TYPE_P (TREE_TYPE (gnu_subprog_type)))
-    append_to_statement_list (gnu_subprog_call, &gnu_body);
+    add_stmt (gnu_subprog_call);
   else
-    append_to_statement_list (build_return_expr (DECL_RESULT (gnu_stub_decl),
-						 gnu_subprog_call),
-			      &gnu_body);
+    add_stmt (build_return_expr (DECL_RESULT (gnu_stub_decl),
+				 gnu_subprog_call));
 
   gnat_poplevel ();
-
-  allocate_struct_function (gnu_stub_decl, false);
-  end_subprog_body (gnu_body);
+  end_subprog_body (end_stmt_group ());
 }
 
 /* Build a type to be used to represent an aliased object whose nominal type