* Keep track of the heap segment table size.

* Let the caller of alloc_some_heap determine the behaviour in case of
  malloc failures.  Use this feature in scm_gc_for_newcell.

libguile/ChangeLog

@@ -1,6 +1,28 @@
 2000-07-06  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
-	* gh.g:  Don't include <stdio.h>.  Thanks to Han-Wen Nienhuys for
+	* gc.c (policy_on_error):  Added in order to allow alloc_some_heap
+	to react to malloc failures in a context dependent way.
+
+	(scm_check_freelist):  No need to flush streams before abort().
+
+	(scm_gc_for_newcell):  Try to allocate new memory in three phases:
+	grow heap if preferred, if still no memory available collect
+	garbage, if still no memory available grow heap.
+
+	(heap_segment_table_size):  Added to always reflect the actual
+	size of the heap segment table, because scm_n_heap_segs may differ
+	from the heap segment table size.
+
+	(alloc_some_heap):  In case of malloc failure, react according to
+	the new policy_on_error parameter (either return to caller or
+	abort immediately).  Further, keep heap_segment_table_size up to
+	date.
+
+	(scm_init_storage):  Initialize heap_segment_table_size.
+
+2000-07-06  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* gh.h:  Don't include <stdio.h>.  Thanks to Han-Wen Nienhuys for
 	the hint.
 
 2000-06-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>

libguile/gc.c

@@ -282,7 +282,9 @@ typedef struct scm_heap_seg_data_t
 
 
 static scm_sizet init_heap_seg (SCM_CELLPTR, scm_sizet, scm_freelist_t *);
-static void alloc_some_heap (scm_freelist_t *);
+
+typedef enum { return_on_error, abort_on_error } policy_on_error;
+static void alloc_some_heap (scm_freelist_t *, policy_on_error);
 
 
 
@@ -444,7 +446,6 @@ scm_check_freelist (SCM freelist)
       {
 	fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
 		 scm_newcell_count, i);
-	fflush (stderr);
 	abort ();
       }
 }
@@ -687,6 +688,7 @@ adjust_min_yield (scm_freelist_t *freelist)
     }
 }
 
+
 /* When we get POSIX threads support, the master will be global and
  * common while the freelist will be individual for each thread.
  */
@@ -702,11 +704,19 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
 	{
 	  if (master->grow_heap_p || scm_block_gc)
 	    {
+	      /* In order to reduce gc frequency, try to allocate a new heap
+	       * segment first, even if gc might find some free cells.  If we
+	       * can't obtain a new heap segment, we will try gc later.
+	       */
 	      master->grow_heap_p = 0;
-	      alloc_some_heap (master);
+	      alloc_some_heap (master, return_on_error);
 	    }
-	  else
+	  if (SCM_NULLP (master->clusters))
 	    {
+	      /* The heap was not grown, either because it wasn't scheduled to
+	       * grow, or because there was not enough memory available.  In
+	       * both cases we have to try gc to get some free cells.
+	       */
 #ifdef DEBUGINFO
 	      fprintf (stderr, "allocated = %d, ",
 		       scm_cells_allocated
@@ -717,9 +727,11 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
 	      adjust_min_yield (master);
 	      if (SCM_NULLP (master->clusters))
 		{
-		  /* gc could not free any cells */
+		  /* gc could not free any cells.  Now, we _must_ allocate a
-		  master->grow_heap_p = 0;
+		   * new heap segment, because there is no other possibility
-		  alloc_some_heap (master);
+		   * to provide a new cell for the caller.
+		   */
+		  alloc_some_heap (master, abort_on_error);
 		}
 	    }
 	}
@@ -734,6 +746,7 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
   return cell;
 }
 
+
 #if 0
 /* This is a support routine which can be used to reserve a cluster
  * for some special use, such as debugging.  It won't be useful until
@@ -757,6 +770,7 @@ scm_c_hook_t scm_before_sweep_c_hook;
 scm_c_hook_t scm_after_sweep_c_hook;
 scm_c_hook_t scm_after_gc_c_hook;
 
+
 void
 scm_igc (const char *what)
 {
@@ -1819,6 +1833,7 @@ scm_sizet scm_max_segment_size;
 SCM_CELLPTR scm_heap_org;
 
 scm_heap_seg_data_t * scm_heap_table = 0;
+static unsigned int heap_segment_table_size = 0;
 int scm_n_heap_segs = 0;
 
 /* init_heap_seg
@@ -1946,34 +1961,51 @@ round_to_cluster_size (scm_freelist_t *freelist, scm_sizet len)
 }
 
 static void
-alloc_some_heap (scm_freelist_t *freelist)
+alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
 #define FUNC_NAME "alloc_some_heap"
 {
-  scm_heap_seg_data_t * tmptable;
   SCM_CELLPTR ptr;
   long len;
 
-  /* Critical code sections (such as the garbage collector)
+  if (scm_gc_heap_lock) 
-   * aren't supposed to add heap segments.
+    {
-   */
+      /* Critical code sections (such as the garbage collector) aren't
-  if (scm_gc_heap_lock)
+       * supposed to add heap segments.
-    SCM_MISC_ERROR ("can not grow heap while locked", SCM_EOL);
+       */
+      fprintf (stderr, "alloc_some_heap: Can not extend locked heap.\n");
+      abort ();
+    }
 
-  /* Expand the heap tables to have room for the new segment.
+  if (scm_n_heap_segs == heap_segment_table_size) 
-   * Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg
+    {
-   * only if the allocation of the segment itself succeeds.
+      /* We have to expand the heap segment table to have room for the new
-   */
+       * segment.  Do not yet increment scm_n_heap_segs -- that is done by
-  len = (1 + scm_n_heap_segs) * sizeof (scm_heap_seg_data_t);
+       * init_heap_seg only if the allocation of the segment itself succeeds.
+       */
+      unsigned int new_table_size = scm_n_heap_segs + 1;
+      size_t size = new_table_size * sizeof (scm_heap_seg_data_t);
+      scm_heap_seg_data_t * new_heap_table;
 
-  SCM_SYSCALL (tmptable = ((scm_heap_seg_data_t *)
+      SCM_SYSCALL (new_heap_table = ((scm_heap_seg_data_t *)
-		       realloc ((char *)scm_heap_table, len)));
+				     realloc ((char *)scm_heap_table, size)));
-  if (!tmptable)
+      if (!new_heap_table)
-    /* Dirk:FIXME:: scm_memory_error needs an additional message parameter.
+	{
-     * Here: "could not grow heap segment table".
+	  if (error_policy == abort_on_error)
-     */
+	    {
-    scm_memory_error (FUNC_NAME);
+	      fprintf (stderr, "alloc_some_heap: Could not grow heap segment table.\n");
-  else
+	      abort ();
-    scm_heap_table = tmptable;
+	    }
+	  else
+	    {
+	      return;
+	    }
+	}
+      else
+	{
+	  scm_heap_table = new_heap_table;
+	  heap_segment_table_size = new_table_size;
+	}
+    }
 
 
   /* Pick a size for the new heap segment.
@@ -2034,10 +2066,11 @@ alloc_some_heap (scm_freelist_t *freelist)
       }
   }
 
-  /* Dirk:FIXME:: scm_memory_error needs an additional message parameter.
+  if (error_policy == abort_on_error)
-   * Here: "could not grow heap".
+    {
-   */
+      fprintf (stderr, "alloc_some_heap: Could not grow heap.\n");
-  scm_memory_error (FUNC_NAME);
+      abort ();
+    }
 }
 #undef FUNC_NAME
 
@@ -2289,6 +2322,7 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1,
   scm_mtrigger = SCM_INIT_MALLOC_LIMIT;
   scm_heap_table = ((scm_heap_seg_data_t *)
 		    scm_must_malloc (sizeof (scm_heap_seg_data_t) * 2, "hplims"));
+  heap_segment_table_size = 2;
 
   if (make_initial_segment (init_heap_size_1, &scm_master_freelist) ||
       make_initial_segment (init_heap_size_2, &scm_master_freelist2))