trans.h (gfc_get_return_label): Removed.

2010-07-21  Daniel Kraft  <d@domob.eu>

	* trans.h (gfc_get_return_label): Removed.
	(gfc_generate_return): New method.
	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
	returning a tree directly.
	* trans-stmt.c (gfc_trans_return): Use `gfc_generate_return'.
	(gfc_trans_block_construct): Update for new interface to
	`gfc_trans_deferred_vars'.
	* trans-decl.c (current_function_return_label): Removed.
	(current_procedure_symbol): New variable.
	(gfc_get_return_label): Removed.
	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
	returning a tree directly.
	(get_proc_result), (gfc_generate_return): New methods.
	(gfc_generate_function_code): Clean up and do init/cleanup here
	also with gfc_wrapped_block.  Remove return-label but rather
	return directly.

From-SVN: r162373

gcc/fortran/ChangeLog

+2010-07-21  Daniel Kraft  <d@domob.eu>
+
+	* trans.h (gfc_get_return_label): Removed.
+	(gfc_generate_return): New method.
+	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
+	returning a tree directly.
+	* trans-stmt.c (gfc_trans_return): Use `gfc_generate_return'.
+	(gfc_trans_block_construct): Update for new interface to
+	`gfc_trans_deferred_vars'.
+	* trans-decl.c (current_function_return_label): Removed.
+	(current_procedure_symbol): New variable.
+	(gfc_get_return_label): Removed.
+	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
+	returning a tree directly.
+	(get_proc_result), (gfc_generate_return): New methods.
+	(gfc_generate_function_code): Clean up and do init/cleanup here
+	also with gfc_wrapped_block.  Remove return-label but rather
+	return directly.
+
 2010-07-19  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/44929

gcc/fortran/trans-decl.c

@@ -55,8 +55,6 @@ along with GCC; see the file COPYING3.  If not see
 static GTY(()) tree current_fake_result_decl;
 static GTY(()) tree parent_fake_result_decl;
 
-static GTY(()) tree current_function_return_label;
-
 
 /* Holds the variable DECLs for the current function.  */
 
@@ -75,6 +73,9 @@ static GTY(()) tree saved_local_decls;
 
 static gfc_namespace *module_namespace;
 
+/* The currently processed procedure symbol.  */
+static gfc_symbol* current_procedure_symbol = NULL;
+
 
 /* List of static constructor functions.  */
 
@@ -237,28 +238,6 @@ gfc_build_label_decl (tree label_id)
 }
 
 
-/* Returns the return label for the current function.  */
-
-tree
-gfc_get_return_label (void)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 10];
-
-  if (current_function_return_label)
-    return current_function_return_label;
-
-  sprintf (name, "__return_%s",
-	   IDENTIFIER_POINTER (DECL_NAME (current_function_decl)));
-
-  current_function_return_label =
-    gfc_build_label_decl (get_identifier (name));
-
-  DECL_ARTIFICIAL (current_function_return_label) = 1;
-
-  return current_function_return_label;
-}
-
-
 /* Set the backend source location of a decl.  */
 
 void
@@ -3089,18 +3068,15 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
     Initialization of ASSIGN statement auxiliary variable.
     Automatic deallocation.  */
 
-tree
-gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
+void
+gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 {
   locus loc;
   gfc_symbol *sym;
   gfc_formal_arglist *f;
   stmtblock_t tmpblock;
-  gfc_wrapped_block try_block;
   bool seen_trans_deferred_array = false;
 
-  gfc_start_wrapped_block (&try_block, fnbody);
-
   /* Deal with implicit return variables.  Explicit return variables will
      already have been added.  */
   if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym)
@@ -3122,17 +3098,17 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
       else if (proc_sym->as)
 	{
 	  tree result = TREE_VALUE (current_fake_result_decl);
-	  gfc_trans_dummy_array_bias (proc_sym, result, &try_block);
+	  gfc_trans_dummy_array_bias (proc_sym, result, block);
 
 	  /* An automatic character length, pointer array result.  */
 	  if (proc_sym->ts.type == BT_CHARACTER
 		&& TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
-	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block);
+	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
 	}
       else if (proc_sym->ts.type == BT_CHARACTER)
 	{
 	  if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
-	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block);
+	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
 	}
       else
 	gcc_assert (gfc_option.flag_f2c
@@ -3142,7 +3118,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
   /* Initialize the INTENT(OUT) derived type dummy arguments.  This
      should be done here so that the offsets and lbounds of arrays
      are available.  */
-  init_intent_out_dt (proc_sym, &try_block);
+  init_intent_out_dt (proc_sym, block);
 
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
@@ -3154,7 +3130,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	    {
 	    case AS_EXPLICIT:
 	      if (sym->attr.dummy || sym->attr.result)
-		gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block);
+		gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
 	      else if (sym->attr.pointer || sym->attr.allocatable)
 		{
 		  if (TREE_STATIC (sym->backend_decl))
@@ -3162,7 +3138,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 		  else
 		    {
 		      seen_trans_deferred_array = true;
-		      gfc_trans_deferred_array (sym, &try_block);
+		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
 	      else
@@ -3170,7 +3146,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 		  if (sym_has_alloc_comp)
 		    {
 		      seen_trans_deferred_array = true;
-		      gfc_trans_deferred_array (sym, &try_block);
+		      gfc_trans_deferred_array (sym, block);
 		    }
 		  else if (sym->ts.type == BT_DERIVED
 			     && sym->value
@@ -3179,7 +3155,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 		    {
 		      gfc_start_block (&tmpblock);
 		      gfc_init_default_dt (sym, &tmpblock, false);
-		      gfc_add_init_cleanup (&try_block,
+		      gfc_add_init_cleanup (block,
 					    gfc_finish_block (&tmpblock),
 					    NULL_TREE);
 		    }
@@ -3187,7 +3163,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 		  gfc_get_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
 		  gfc_trans_auto_array_allocation (sym->backend_decl,
-						   sym, &try_block);
+						   sym, block);
 		  gfc_set_backend_locus (&loc);
 		}
 	      break;
@@ -3198,26 +3174,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 
 	      /* We should always pass assumed size arrays the g77 way.  */
 	      if (sym->attr.dummy)
-		gfc_trans_g77_array (sym, &try_block);
+		gfc_trans_g77_array (sym, block);
 	      break;
 
 	    case AS_ASSUMED_SHAPE:
 	      /* Must be a dummy parameter.  */
 	      gcc_assert (sym->attr.dummy);
 
-	      gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block);
+	      gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
 	      break;
 
 	    case AS_DEFERRED:
 	      seen_trans_deferred_array = true;
-	      gfc_trans_deferred_array (sym, &try_block);
+	      gfc_trans_deferred_array (sym, block);
 	      break;
 
 	    default:
 	      gcc_unreachable ();
 	    }
 	  if (sym_has_alloc_comp && !seen_trans_deferred_array)
-	    gfc_trans_deferred_array (sym, &try_block);
+	    gfc_trans_deferred_array (sym, block);
 	}
       else if (sym->attr.allocatable
 	       || (sym->ts.type == BT_CLASS
@@ -3253,26 +3229,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	      if (!sym->attr.result)
 		tmp = gfc_deallocate_with_status (se.expr, NULL_TREE,
 						  true, NULL);
-	      gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), tmp);
+	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
 	    }
 	}
       else if (sym_has_alloc_comp)
-	gfc_trans_deferred_array (sym, &try_block);
+	gfc_trans_deferred_array (sym, block);
       else if (sym->ts.type == BT_CHARACTER)
 	{
 	  gfc_get_backend_locus (&loc);
 	  gfc_set_backend_locus (&sym->declared_at);
 	  if (sym->attr.dummy || sym->attr.result)
-	    gfc_trans_dummy_character (sym, sym->ts.u.cl, &try_block);
+	    gfc_trans_dummy_character (sym, sym->ts.u.cl, block);
 	  else
-	    gfc_trans_auto_character_variable (sym, &try_block);
+	    gfc_trans_auto_character_variable (sym, block);
 	  gfc_set_backend_locus (&loc);
 	}
       else if (sym->attr.assign)
 	{
 	  gfc_get_backend_locus (&loc);
 	  gfc_set_backend_locus (&sym->declared_at);
-	  gfc_trans_assign_aux_var (sym, &try_block);
+	  gfc_trans_assign_aux_var (sym, block);
 	  gfc_set_backend_locus (&loc);
 	}
       else if (sym->ts.type == BT_DERIVED
@@ -3282,7 +3258,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	{
 	  gfc_start_block (&tmpblock);
 	  gfc_init_default_dt (sym, &tmpblock, false);
-	  gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock),
+	  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
 				NULL_TREE);
 	}
       else
@@ -3309,9 +3285,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	gfc_trans_vla_type_sizes (proc_sym, &tmpblock);
     }
 
-  gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), NULL_TREE);
-
-  return gfc_finish_wrapped_block (&try_block);
+  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE);
 }
 
 static GTY ((param_is (struct module_htab_entry))) htab_t module_htab;
@@ -4309,6 +4283,56 @@ create_main_function (tree fndecl)
 }
 
 
+/* Get the result expression for a procedure.  */
+
+static tree
+get_proc_result (gfc_symbol* sym)
+{
+  if (sym->attr.subroutine || sym == sym->result)
+    {
+      if (current_fake_result_decl != NULL)
+	return TREE_VALUE (current_fake_result_decl);
+
+      return NULL_TREE;
+    }
+
+  return sym->result->backend_decl;
+}
+
+
+/* Generate an appropriate return-statement for a procedure.  */
+
+tree
+gfc_generate_return (void)
+{
+  gfc_symbol* sym;
+  tree result;
+  tree fndecl;
+
+  sym = current_procedure_symbol;
+  fndecl = sym->backend_decl;
+
+  if (TREE_TYPE (DECL_RESULT (fndecl)) == void_type_node)
+    result = NULL_TREE;
+  else
+    {
+      result = get_proc_result (sym);
+
+      /* Set the return value to the dummy result variable.  The
+	 types may be different for scalar default REAL functions
+	 with -ff2c, therefore we have to convert.  */
+      if (result != NULL_TREE)
+	{
+	  result = convert (TREE_TYPE (DECL_RESULT (fndecl)), result);
+	  result = fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				DECL_RESULT (fndecl), result);
+	}
+    }
+
+  return build1_v (RETURN_EXPR, result);
+}
+
+
 /* Generate code for a function.  */
 
 void
@@ -4318,16 +4342,18 @@ gfc_generate_function_code (gfc_namespace * ns)
   tree old_context;
   tree decl;
   tree tmp;
-  tree tmp2;
-  stmtblock_t block;
+  stmtblock_t init, cleanup;
   stmtblock_t body;
-  tree result;
+  gfc_wrapped_block try_block;
   tree recurcheckvar = NULL_TREE;
   gfc_symbol *sym;
+  gfc_symbol *previous_procedure_symbol;
   int rank;
   bool is_recursive;
 
   sym = ns->proc_name;
+  previous_procedure_symbol = current_procedure_symbol;
+  current_procedure_symbol = sym;
 
   /* Check that the frontend isn't still using this.  */
   gcc_assert (sym->tlink == NULL);
@@ -4349,7 +4375,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   trans_function_start (sym);
 
-  gfc_init_block (&block);
+  gfc_init_block (&init);
 
   if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
     {
@@ -4388,34 +4414,32 @@ gfc_generate_function_code (gfc_namespace * ns)
   else
     current_fake_result_decl = NULL_TREE;
 
-  current_function_return_label = NULL;
+  is_recursive = sym->attr.recursive
+		 || (sym->attr.entry_master
+		     && sym->ns->entries->sym->attr.recursive);
+  if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+	&& !is_recursive
+	&& !gfc_option.flag_recursive)
+    {
+      char * msg;
+
+      asprintf (&msg, "Recursive call to nonrecursive procedure '%s'",
+		sym->name);
+      recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive");
+      TREE_STATIC (recurcheckvar) = 1;
+      DECL_INITIAL (recurcheckvar) = boolean_false_node;
+      gfc_add_expr_to_block (&init, recurcheckvar);
+      gfc_trans_runtime_check (true, false, recurcheckvar, &init,
+			       &sym->declared_at, msg);
+      gfc_add_modify (&init, recurcheckvar, boolean_true_node);
+      gfc_free (msg);
+    }
 
   /* Now generate the code for the body of this function.  */
   gfc_init_block (&body);
 
-   is_recursive = sym->attr.recursive
-		  || (sym->attr.entry_master
-		      && sym->ns->entries->sym->attr.recursive);
-   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
-	  && !is_recursive
-	  && !gfc_option.flag_recursive)
-     {
-       char * msg;
-
-       asprintf (&msg, "Recursive call to nonrecursive procedure '%s'",
-		 sym->name);
-       recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive");
-       TREE_STATIC (recurcheckvar) = 1;
-       DECL_INITIAL (recurcheckvar) = boolean_false_node;
-       gfc_add_expr_to_block (&block, recurcheckvar);
-       gfc_trans_runtime_check (true, false, recurcheckvar, &block,
-				&sym->declared_at, msg);
-       gfc_add_modify (&block, recurcheckvar, boolean_true_node);
-       gfc_free (msg);
-    }
-
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
-        && sym->attr.subroutine)
+	&& sym->attr.subroutine)
     {
       tree alternate_return;
       alternate_return = gfc_get_fake_result_decl (sym, 0);
@@ -4438,29 +4462,9 @@ gfc_generate_function_code (gfc_namespace * ns)
   tmp = gfc_trans_code (ns->code);
   gfc_add_expr_to_block (&body, tmp);
 
-  /* Add a return label if needed.  */
-  if (current_function_return_label)
-    {
-      tmp = build1_v (LABEL_EXPR, current_function_return_label);
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  tmp = gfc_finish_block (&body);
-  /* Add code to create and cleanup arrays.  */
-  tmp = gfc_trans_deferred_vars (sym, tmp);
-
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
-      if (sym->attr.subroutine || sym == sym->result)
-	{
-	  if (current_fake_result_decl != NULL)
-	    result = TREE_VALUE (current_fake_result_decl);
-	  else
-	    result = NULL_TREE;
-	  current_fake_result_decl = NULL_TREE;
-	}
-      else
-	result = sym->result->backend_decl;
+      tree result = get_proc_result (sym);
 
       if (result != NULL_TREE
 	    && sym->attr.function
@@ -4470,24 +4474,12 @@ gfc_generate_function_code (gfc_namespace * ns)
 	      && sym->ts.u.derived->attr.alloc_comp)
 	    {
 	      rank = sym->as ? sym->as->rank : 0;
-	      tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
-	      gfc_add_expr_to_block (&block, tmp2);
+	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+	      gfc_add_expr_to_block (&init, tmp);
 	    }
 	  else if (sym->attr.allocatable && sym->attr.dimension == 0)
-	    gfc_add_modify (&block, result, fold_convert (TREE_TYPE (result),
-							  null_pointer_node));
-	}
-
-      gfc_add_expr_to_block (&block, tmp);
-
-      /* Reset recursion-check variable.  */
-      if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
-	     && !is_recursive
-	     && !gfc_option.flag_openmp
-	     && recurcheckvar != NULL_TREE)
-	{
-	  gfc_add_modify (&block, recurcheckvar, boolean_false_node);
-	  recurcheckvar = NULL;
+	    gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
+							 null_pointer_node));
 	}
 
       if (result == NULL_TREE)
@@ -4500,31 +4492,28 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  TREE_NO_WARNING(sym->backend_decl) = 1;
 	}
       else
-	{
-	  /* Set the return value to the dummy result variable.  The
-	     types may be different for scalar default REAL functions
-	     with -ff2c, therefore we have to convert.  */
-	  tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result);
-	  tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp),
-			     DECL_RESULT (fndecl), tmp);
-	  tmp = build1_v (RETURN_EXPR, tmp);
-	  gfc_add_expr_to_block (&block, tmp);
-	}
+	gfc_add_expr_to_block (&body, gfc_generate_return ());
     }
-  else
+
+  gfc_init_block (&cleanup);
+
+  /* Reset recursion-check variable.  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+	 && !is_recursive
+	 && !gfc_option.flag_openmp
+	 && recurcheckvar != NULL_TREE)
     {
-      gfc_add_expr_to_block (&block, tmp);
-      /* Reset recursion-check variable.  */
-      if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
-	     && !is_recursive
-	     && !gfc_option.flag_openmp
-	     && recurcheckvar != NULL_TREE)
-	{
-	  gfc_add_modify (&block, recurcheckvar, boolean_false_node);
-	  recurcheckvar = NULL_TREE;
-	}
+      gfc_add_modify (&cleanup, recurcheckvar, boolean_false_node);
+      recurcheckvar = NULL;
     }
 
+  /* Finish the function body and add init and cleanup code.  */
+  tmp = gfc_finish_block (&body);
+  gfc_start_wrapped_block (&try_block, tmp);
+  /* Add code to create and cleanup arrays.  */
+  gfc_trans_deferred_vars (sym, &try_block);
+  gfc_add_init_cleanup (&try_block, gfc_finish_block (&init),
+			gfc_finish_block (&cleanup));
 
   /* Add all the decls we created during processing.  */
   decl = saved_function_decls;
@@ -4539,7 +4528,7 @@ gfc_generate_function_code (gfc_namespace * ns)
     }
   saved_function_decls = NULL_TREE;
 
-  DECL_SAVED_TREE (fndecl) = gfc_finish_block (&block);
+  DECL_SAVED_TREE (fndecl) = gfc_finish_wrapped_block (&try_block);
   decl = getdecls ();
 
   /* Finish off this function and send it for code generation.  */
@@ -4590,6 +4579,8 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   if (sym->attr.is_main_program)
     create_main_function (fndecl);
+
+  current_procedure_symbol = previous_procedure_symbol;
 }
 
 

gcc/fortran/trans-stmt.c

@@ -491,7 +491,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
 /* Translate the RETURN statement.  */
 
 tree
-gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
+gfc_trans_return (gfc_code * code)
 {
   if (code->expr1)
     {
@@ -500,16 +500,16 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
       tree result;
 
       /* If code->expr is not NULL, this return statement must appear
-         in a subroutine and current_fake_result_decl has already
+	 in a subroutine and current_fake_result_decl has already
 	 been generated.  */
 
       result = gfc_get_fake_result_decl (NULL, 0);
       if (!result)
-        {
-          gfc_warning ("An alternate return at %L without a * dummy argument",
-                        &code->expr1->where);
-          return build1_v (GOTO_EXPR, gfc_get_return_label ());
-        }
+	{
+	  gfc_warning ("An alternate return at %L without a * dummy argument",
+			&code->expr1->where);
+	  return gfc_generate_return ();
+	}
 
       /* Start a new block for this statement.  */
       gfc_init_se (&se, NULL);
@@ -521,13 +521,12 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
 			 fold_convert (TREE_TYPE (result), se.expr));
       gfc_add_expr_to_block (&se.pre, tmp);
 
-      tmp = build1_v (GOTO_EXPR, gfc_get_return_label ());
+      tmp = gfc_generate_return ();
       gfc_add_expr_to_block (&se.pre, tmp);
-      gfc_add_block_to_block (&se.pre, &se.post);
       return gfc_finish_block (&se.pre);
     }
-  else
-    return build1_v (GOTO_EXPR, gfc_get_return_label ());
+
+  return gfc_generate_return ();
 }
 
 
@@ -847,8 +846,7 @@ gfc_trans_block_construct (gfc_code* code)
 {
   gfc_namespace* ns;
   gfc_symbol* sym;
-  stmtblock_t body;
-  tree tmp;
+  gfc_wrapped_block body;
 
   ns = code->ext.block.ns;
   gcc_assert (ns);
@@ -858,14 +856,12 @@ gfc_trans_block_construct (gfc_code* code)
   gcc_assert (!sym->tlink);
   sym->tlink = sym;
 
-  gfc_start_block (&body);
   gfc_process_block_locals (ns);
 
-  tmp = gfc_trans_code (ns->code);
-  tmp = gfc_trans_deferred_vars (sym, tmp);
+  gfc_start_wrapped_block (&body, gfc_trans_code (ns->code));
+  gfc_trans_deferred_vars (sym, &body);
 
-  gfc_add_expr_to_block (&body, tmp);
-  return gfc_finish_block (&body);
+  return gfc_finish_wrapped_block (&body);
 }
 
 

gcc/fortran/trans.h

@@ -408,9 +408,6 @@ tree gfc_build_label_decl (tree);
    Do not use if the function has an explicit result variable.  */
 tree gfc_get_fake_result_decl (gfc_symbol *, int);
 
-/* Get the return label for the current function.  */
-tree gfc_get_return_label (void);
-
 /* Add a decl to the binding level for the current function.  */
 void gfc_add_decl_to_function (tree);
 
@@ -456,6 +453,8 @@ void gfc_generate_function_code (gfc_namespace *);
 void gfc_generate_block_data (gfc_namespace *);
 /* Output a decl for a module variable.  */
 void gfc_generate_module_vars (gfc_namespace *);
+/* Get the appropriate return statement for a procedure.  */
+tree gfc_generate_return (void);
 
 struct GTY(()) module_htab_entry {
   const char *name;
@@ -533,7 +532,7 @@ tree gfc_build_library_function_decl_with_spec (tree name, const char *spec,
 void gfc_process_block_locals (gfc_namespace*);
 
 /* Output initialization/clean-up code that was deferred.  */
-tree gfc_trans_deferred_vars (gfc_symbol*, tree);
+void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
 
 /* somewhere! */
 tree pushdecl (tree);