[gfortran] Remove push/pop_context.

[Paul Brook <paul at nowt dot org>]

Attached patch implements the remaining changes neccessary to make all 
memory management explicit. This allows us to remove the push_context/
pop_context pair around each procedure, significantly reducing function 
call overhead in many cases.

Tested on i686-linux.
Applied to tree-ssa branch.

Paul

2003-11-30  Paul Brook  <paul@nowt.org>

	* trans-array.c (gfc_trans_g77_array): Make non-static.
	(gfc_trans_assumed_size): Remove.
	(gfc_trans_dummy_array_bias): Explicitly free temporary.
	* trans-array.h (gfc_trans_g77_array): Add prototype.
	(gfc_trans_assumed_size): Remove.
	* trans-decls.c (gfor_fndecl_push_context): Remove.
	(gfor_fndecl_pop_context): Remove.
	(gfc_build_function)decls): Don't create them.
	(gfc_trans_deferred_vars): Update to match. Remove dead	code.
	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Free temp.
libgfortran
	* runtime/memory.c (push_context): Remove.
	(pop_context): Remove.
	* libgfortran.h: Remove prototypes.

diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-array.c gcc/gcc/fortran/trans-array.c
--- clean/tree-ssa/gcc/fortran/trans-array.c	2003-11-30 15:51:52.000000000 +0000
+++ gcc/gcc/fortran/trans-array.c	2003-11-30 16:01:08.000000000 +0000
@@ -2952,7 +2952,7 @@ gfc_trans_auto_array_allocation (tree de
 
 /* Generate entry and exit code for g77 calling convention arrays.  */
 
-static tree
+tree
 gfc_trans_g77_array (gfc_symbol * sym, tree body)
 {
   tree parm;
@@ -2999,86 +2999,6 @@ gfc_trans_g77_array (gfc_symbol * sym, t
 }
 
 
-/* Generate entry and exit code for assumed size arrays.  */
-
-tree
-gfc_trans_assumed_size (gfc_symbol * sym, tree body)
-{
-  tree parm;
-  tree tmpdesc;
-  tree type;
-  tree size;
-  locus loc;
-  tree offset;
-  tree args;
-  tree tmp;
-  tree stmt;
-  stmtblock_t block;
-
-  tmpdesc = sym->backend_decl;
-  if (TREE_CODE (tmpdesc) == PARM_DECL)
-    return gfc_trans_g77_array (sym, body);
-
-  gfc_get_backend_locus (&loc);
-  gfc_set_backend_locus (&sym->declared_at);
-
-  /* Descriptor type.  */
-  type = TREE_TYPE (tmpdesc);
-  assert (GFC_ARRAY_TYPE_P (type));
-  parm = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
-
-  gfc_start_block (&block);
-
-  /* Evaluate the bounds of the array.  */
-  size = gfc_trans_array_bounds (type, sym, &offset, &block);
-
-  /* The actual argument descriptor.  */
-  args = gfc_chainon_list (NULL_TREE, parm);
-
-  /* Library call to pack the array.  */
-  tmp = gfor_fndecl_in_pack;
-  tmp = gfc_build_function_call (tmp, args);
-  gfc_add_modify_expr (&block, tmpdesc, tmp);
-
-  /* Set the base pointer.  */
-  tmp = tmpdesc;
-  if (!integer_zerop (offset))
-    {
-      tmp = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (tmp)), tmp);
-      tmp = build (ARRAY_REF, TREE_TYPE (TREE_TYPE (tmp)), tmp, offset);
-      tmp = build1 (ADDR_EXPR, TREE_TYPE (tmpdesc), tmp);
-    }
-  gfc_add_modify_expr (&block, GFC_TYPE_ARRAY_OFFSET (type), tmp);
-
-  tmp = gfc_finish_block (&block);
-
-  gfc_set_backend_locus (&loc);
-
-  gfc_start_block (&block);
-  /* Add the initialization code to the start of the function.  */
-  gfc_add_expr_to_block (&block, tmp);
-  gfc_add_expr_to_block (&block, body);
-
-  if (sym->attr.intent != INTENT_IN)
-    {
-      /* Copy the data back if it was repacked.  */
-      args = gfc_chainon_list (NULL_TREE, parm);
-      args = gfc_chainon_list (args, tmpdesc);
-      tmp = gfor_fndecl_in_unpack;
-      stmt = gfc_build_function_call (tmp, args);
-
-      tmp = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (parm)), parm);
-      tmp = gfc_conv_descriptor_data (tmp);
-      tmp = build (NE_EXPR, boolean_type_node, tmp, tmpdesc);
-      tmp = build_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
-      gfc_add_expr_to_block (&block, tmp);
-    }
-  /* We don't need to free any memory allocated by internal_pack as it will
-     be freed at the end of the function by pop_context.  */
-  return gfc_finish_block (&block);
-}
-
-
 /* Modify the descriptor of an array parameter so that it has the
    correct lower bound.  Also move the upper bound accordingly.
    If the array is not packed, it will be copied into a temporary.
@@ -3098,6 +3018,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
   tree offset;
   locus loc;
   stmtblock_t block;
+  stmtblock_t cleanup;
   tree lbound;
   tree ubound;
   tree dubound;
@@ -3329,13 +3250,27 @@ gfc_trans_dummy_array_bias (gfc_symbol *
   gfc_add_expr_to_block (&block, body);
 
   /* Cleanup code.  */
-  if (!(no_repack || sym->attr.intent == INTENT_IN))
+  if (!no_repack)
     {
-      /* Copy the data back if it was repacked.  */
-      tmp = gfc_chainon_list (NULL_TREE, dumdesc);
-      tmp = gfc_chainon_list (tmp, tmpdesc);
-      stmt = gfc_build_function_call (gfor_fndecl_in_unpack, tmp);
+      gfc_start_block (&cleanup);
+      
+      if (sym->attr.intent != INTENT_IN)
+	{
+	  /* Copy the data back.  */
+	  tmp = gfc_chainon_list (NULL_TREE, dumdesc);
+	  tmp = gfc_chainon_list (tmp, tmpdesc);
+	  tmp = gfc_build_function_call (gfor_fndecl_in_unpack, tmp);
+	  gfc_add_expr_to_block (&cleanup, tmp);
+	}
+
+      /* Free the temporary.  */
+      tmp = gfc_chainon_list (NULL_TREE, tmpdesc);
+      tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp);
+      gfc_add_expr_to_block (&cleanup, tmp);
 
+      stmt = gfc_finish_block (&cleanup);
+	
+      /* Only do the cleanup if the array was repacked.  */
       tmp = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (dumdesc)), dumdesc);
       tmp = gfc_conv_descriptor_data (tmp);
       tmp = build (NE_EXPR, boolean_type_node, tmp, tmpdesc);
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-array.h gcc/gcc/fortran/trans-array.h
--- clean/tree-ssa/gcc/fortran/trans-array.h	2003-11-27 19:17:10.000000000 +0000
+++ gcc/gcc/fortran/trans-array.h	2003-11-29 22:56:39.000000000 +0000
@@ -35,8 +35,8 @@ tree gfc_trans_allocate_temp_array (gfc_
 tree gfc_trans_auto_array_allocation (tree, gfc_symbol *, tree);
 /* Generate entry and exit code for dummy array parameters.  */
 tree gfc_trans_dummy_array_bias (gfc_symbol *, tree, tree);
-/* Generate entry and exit code for assumed size arrays.  */
-tree gfc_trans_assumed_size (gfc_symbol *, tree);
+/* Generate entry and exit code for g77 calling convention arrays.  */
+tree gfc_trans_g77_array (gfc_symbol *, tree);
 /* Add initialisation for deferred arrays.  */
 tree gfc_trans_deferred_array (gfc_symbol *, tree);
 /* Generate an initializer for a static pointer or allocatable array.  */
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-decl.c gcc/gcc/fortran/trans-decl.c
--- clean/tree-ssa/gcc/fortran/trans-decl.c	2003-11-28 16:15:23.000000000 +0000
+++ gcc/gcc/fortran/trans-decl.c	2003-11-30 17:01:34.000000000 +0000
@@ -73,8 +73,6 @@ tree gfc_static_ctors;
 
 /* Function declarations for builtin library functions.  */
 
-tree gfor_fndecl_push_context;
-tree gfor_fndecl_pop_context;
 tree gfor_fndecl_internal_malloc;
 tree gfor_fndecl_internal_malloc64;
 tree gfor_fndecl_internal_free;
@@ -1428,14 +1426,6 @@ gfc_build_builtin_function_decls (void)
     gfc_build_library_function_decl (get_identifier (PREFIX("internal_free")),
 				     void_type_node, 1, pvoid_type_node);
 
-  gfor_fndecl_push_context =
-    gfc_build_library_function_decl (get_identifier (PREFIX("push_context")),
-				     void_type_node, 0);
-
-  gfor_fndecl_pop_context =
-    gfc_build_library_function_decl (get_identifier (PREFIX("pop_context")),
-				     void_type_node, 0);
-
   gfor_fndecl_allocate =
     gfc_build_library_function_decl (get_identifier (PREFIX("allocate")),
 				     void_type_node, 2, ppvoid_type_node,
@@ -1553,7 +1543,6 @@ static tree
 gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 {
   tree tmp;
-  stmtblock_t block;
   locus loc;
   gfc_symbol *sym;
 
@@ -1600,7 +1589,6 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 		{
 		  gfc_get_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
-		  gfc_init_block (&block);
 		  fnbody = gfc_trans_auto_array_allocation (sym->backend_decl,
 		      sym, fnbody);
 		  gfc_set_backend_locus (&loc);
@@ -1611,7 +1599,9 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 	      /* Must be a dummy parameter.  */
 	      assert (sym->attr.dummy);
 
-              fnbody = gfc_trans_assumed_size (sym, fnbody);
+	      /* We should always pass assumed size arrays the g77 way.  */
+	      assert (TREE_CODE (sym->backend_decl) == PARM_DECL);
+	      fnbody = gfc_trans_g77_array (sym, fnbody);
               break;
 
 	    case AS_ASSUMED_SHAPE:
@@ -1641,17 +1631,7 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 	abort ();
     }
 
-  gfc_init_block (&block);
-  /* Build a call to library function PREFIX(push_context) ().  */
-  tmp = gfc_build_function_call (gfor_fndecl_push_context, NULL_TREE);
-  gfc_add_expr_to_block (&block, tmp);
-
-  gfc_add_expr_to_block (&block, fnbody);
-  /* Build a call to PREFIX(pop_context ()).  */
-  tmp = gfc_build_function_call (gfor_fndecl_pop_context, NULL_TREE);
-  gfc_add_expr_to_block (&block, tmp);
-
-  return gfc_finish_block (&block);
+  return fnbody;
 }
 
 static void
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-stmt.c gcc/gcc/fortran/trans-stmt.c
--- clean/tree-ssa/gcc/fortran/trans-stmt.c	2003-11-28 16:15:23.000000000 +0000
+++ gcc/gcc/fortran/trans-stmt.c	2003-11-30 16:48:13.000000000 +0000
@@ -1982,6 +1982,13 @@ gfc_trans_pointer_assign_need_temp (gfc_
       tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1, 1);
       gfc_add_expr_to_block (block, tmp);
     }
+  /* Free the temporary.  */
+  if (ptemp1)
+    {
+      tmp = gfc_chainon_list (NULL_TREE, ptemp1);
+      tmp = gfc_build_function_call (gfor_fndecl_internal_free, tmp);
+      gfc_add_expr_to_block (block, tmp);
+    }
 }
 
 
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans.h gcc/gcc/fortran/trans.h
--- clean/tree-ssa/gcc/fortran/trans.h	2003-11-28 16:15:23.000000000 +0000
+++ gcc/gcc/fortran/trans.h	2003-11-30 17:01:12.000000000 +0000
@@ -407,8 +407,6 @@ tree getdecls (void);
 tree gfc_truthvalue_conversion (tree);
 
 /* Runtime library function decls.  */
-extern GTY(()) tree gfor_fndecl_push_context;
-extern GTY(()) tree gfor_fndecl_pop_context;
 extern GTY(()) tree gfor_fndecl_internal_malloc;
 extern GTY(()) tree gfor_fndecl_internal_malloc64;
 extern GTY(()) tree gfor_fndecl_internal_free;
diff -urpxCVS clean/tree-ssa/libgfortran/libgfortran.h gcc/libgfortran/libgfortran.h
--- clean/tree-ssa/libgfortran/libgfortran.h	2003-11-27 19:17:10.000000000 +0000
+++ gcc/libgfortran/libgfortran.h	2003-11-30 17:05:27.000000000 +0000
@@ -314,12 +314,6 @@ void *internal_malloc64 (GFC_INTEGER_8);
 #define internal_free	prefix(internal_free)
 void internal_free (void *);
 
-#define push_context	prefix(push_context)
-void push_context (void);
-
-#define pop_context	prefix(pop_context)
-void pop_context (void);
-
 #define allocate	prefix(allocate)
 void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
 
diff -urpxCVS clean/tree-ssa/libgfortran/runtime/memory.c gcc/libgfortran/runtime/memory.c
--- clean/tree-ssa/libgfortran/runtime/memory.c	2003-11-29 13:10:22.000000000 +0000
+++ gcc/libgfortran/runtime/memory.c	2003-11-30 17:06:32.000000000 +0000
@@ -187,8 +187,7 @@ internal_malloc64 (GFC_INTEGER_8 size)
 
 /* Free internally allocated memory.  Pointer is NULLified.  Also used to
    free user allocated memory.  */
-/* TODO: keep a list of previously allocated blocks and reuse them.  Defer
-   allocation until pop_context.  */
+/* TODO: keep a list of previously allocated blocks and reuse them.  */
 
 void
 internal_free (void *mem)
@@ -214,41 +213,6 @@ internal_free (void *mem)
 }
 
 
-/* Set a marker on the current tail of the list of internally
-   allocated memory blocks.  */
-
-void
-push_context (void)
-{
-  /* Make this a counter rather than a flag otherwise bad things
-     happen if we call push_context twice.  */
-  mem_root.prev->marker++;
-}
-
-
-/* Free everything since the last marker.  */
-void
-pop_context (void)
-{
-  malloc_t *m;
-
-  while (mem_root.prev->marker == 0)
-    {
-      m = mem_root.prev;
-      /* Unlink from the chain.  */
-      mem_root.prev = m->prev;
-      m->prev->next = m->next;
-
-      if (m == &mem_root)
-	runtime_error ("Internal: Unbalanced memory contexts");
-
-      free (m);
-    }
-
-  mem_root.prev->marker--;
-}
-
-
 /* User-allocate, one call for each member of the alloc-list of an
    ALLOCATE statement. */