Revert "(scm_shell_usage): Note need for subscription to bug-guile@gnu.org."
[bpt/guile.git] / libguile / gc-segment.c
dissimilarity index 83%
index e459291..4f98cbc 100644 (file)
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
-
-#include <assert.h> 
-#include <stdio.h>
-#include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/pairs.h"
-#include "libguile/gc.h"
-#include "libguile/private-gc.h"
-
-
-
-#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \
-    ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS)
-#define SCM_GC_IN_CARD_HEADERP(x) \
-  (scm_t_cell *) (x) <  SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS
-
-
-size_t scm_max_segment_size;
-
-scm_t_heap_segment *
-scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
-{
-  scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));
-
-  if (!shs)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
-      abort ();
-    }
-  
-  shs->bounds[0] = NULL;
-  shs->bounds[1] = NULL;
-  shs->malloced = NULL;
-  shs->span = fl->span;
-  shs->freelist  = fl;
-  shs->next_free_card = NULL;
-  
-  return shs;
-}
-
-
-/*
-  Fill SEGMENT with memory both for data and mark bits.
-
-  RETURN:  1 on success, 0 failure  
- */
-int 
-scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
-{
-  /*
-    round upwards
-   */
-  int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
-  int card_count =1 + (requested / sizeof (scm_t_cell)) /  card_data_cell_count; 
-
-  /*
-    one card extra due to alignment
-  */
-  size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
-    + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
-    ;
-  scm_t_c_bvec_long * bvec_ptr = 0;
-  scm_t_cell *  memory = 0;
-
-  /*
-    We use malloc to alloc the heap. On GNU libc this is 
-    equivalent to mmapping /dev/zero
-   */
-  SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));
-
-  if (memory == NULL)
-    return 0;
-
-  segment->malloced = memory;
-  segment->bounds[0] = SCM_GC_CARD_UP (memory);
-  segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
-
-  segment->freelist->heap_size += scm_i_segment_cell_count (segment);
-  
-  bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];
-
-
-  {
-    scm_t_cell *  ptr  = segment->bounds [0];
-
-    for (;
-        ptr < segment->bounds[1]; ptr += SCM_GC_CARD_N_CELLS)
-      {
-       SCM_GC_CELL_BVEC (ptr) = bvec_ptr;
-       if (segment->span == 2) 
-         SCM_GC_SET_CARD_DOUBLECELL (ptr);
-       bvec_ptr += SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
-
-       /*
-         Don't init the mem. This is handled by lazy sweeping.
-        */
-      }
-  }
-
-  segment->next_free_card = segment->bounds[0];
-  segment->first_time = 1;
-  return 1;
-}
-
-int
-scm_i_segment_card_count (scm_t_heap_segment * seg)
-{
-  return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
-}
-
-/*
-  Return the number of available single-cell data cells. 
- */
-int
-scm_i_segment_cell_count (scm_t_heap_segment * seg)
-{
-  return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
-    + ((seg->span == 2) ? -1 : 0);
-}
-
-void
-scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
-{
-  scm_t_cell *  markspace = seg->bounds[1];
-
-  memset (markspace, 0x00,
-         scm_i_segment_card_count (seg) *  SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
-}
-
-/*
-  RETURN:
-
-  Freelist. 
-*/
-SCM
-scm_i_sweep_some_cards (scm_t_heap_segment *seg)
-{
-  SCM cells = SCM_EOL;
-  int threshold = 512;
-  int collected = 0;
-  int (*sweeper) (scm_t_cell *, SCM *, int )
-    = (seg->first_time) ? &scm_init_card_freelist : &scm_i_sweep_card;
-
-  scm_t_cell * next_free = seg->next_free_card;
-  int cards_swept = 0;
-  
-  while (collected < threshold && next_free < seg->bounds[1])
-    {
-      collected += (*sweeper) (next_free, &cells, seg->span);
-      next_free += SCM_GC_CARD_N_CELLS;
-      cards_swept ++;
-    }
-
-  scm_gc_cells_swept +=  cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
-  scm_gc_cells_collected += collected * seg->span;
-
-  if (!seg->first_time)
-    scm_cells_allocated -= collected * seg->span;
-  
-  seg->freelist->collected += collected  * seg->span;
-  
-
-  if(next_free == seg->bounds[1])
-    {
-      seg->first_time = 0;
-    }
-
-  seg->next_free_card = next_free;
-  return cells;
-}
-
-
-/*
-  Force a sweep of this entire segment. This doesn't modify sweep
-  statistics, it just frees the memory pointed to by to-be-swept
-  cells.
-
-  Implementation is slightly ugh.
-
-  FIXME: if you do scm_i_sweep_segment(), and then allocate from this
-  segment again, the statistics are off.
- */
-void
-scm_i_sweep_segment (scm_t_heap_segment * seg)
-{
-  scm_t_cell * p = seg->next_free_card;
-  int yield = scm_gc_cells_collected;
-  int coll = seg->freelist->collected;
-  unsigned long alloc = scm_cells_allocated ;
-  
-  while (scm_i_sweep_some_cards (seg) != SCM_EOL)
-    ;
-
-  scm_gc_cells_collected = yield;
-  scm_cells_allocated = alloc;
-  seg->freelist->collected = coll; 
-  
-  seg->next_free_card =p;
-}
-
-void
-scm_i_sweep_all_segments (char const  *reason)
-{
-  int i= 0; 
-
-  for (i = 0; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_sweep_segment (scm_i_heap_segment_table[i]);
-    }
-}
-
-
-/*
-  Heap segment table.
-
-  The table is sorted by the address of the data itself. This makes
-  for easy lookups. This is not portable: according to ANSI C,
-  pointers can only be compared within the same object (i.e. the same
-  block of malloced memory.). For machines with weird architectures,
-  this should be revised.
-  
-  (Apparently, for this reason 1.6 and earlier had macros for pointer
-  comparison. )
-  
-  perhaps it is worthwhile to remove the 2nd level of indirection in
-  the table, but this certainly makes for cleaner code.
-*/
-scm_t_heap_segment ** scm_i_heap_segment_table;
-size_t scm_i_heap_segment_table_size;
-scm_t_cell *lowest_cell;
-scm_t_cell *highest_cell; 
-
-
-void
-scm_i_clear_mark_space (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
-    }
-}
-
-
-/*
-  RETURN: index of inserted segment.
- */
-int
-scm_i_insert_segment (scm_t_heap_segment * seg)
-{
-  size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
-  SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
-                              realloc ((char *)scm_i_heap_segment_table, size)));
-
-  /*
-    We can't alloc 4 more bytes. This is hopeless.
-   */
-  if (!scm_i_heap_segment_table)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
-      abort ();
-    }
-
-  if (!lowest_cell)
-    {
-      lowest_cell = seg->bounds[0];
-      highest_cell = seg->bounds[1];
-    }
-  else
-    {
-      lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
-      highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
-    }
-
-  
-  {
-    int i = 0;
-    int j = 0;
-
-    while (i < scm_i_heap_segment_table_size
-          && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
-      i++;
-    for (j = scm_i_heap_segment_table_size; j > i; --j)
-      scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
-
-    scm_i_heap_segment_table [i] = seg;
-    scm_i_heap_segment_table_size ++;
-
-    return i;
-  }
-}
-
-SCM
-scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl)
-{
-  int i = fl->heap_segment_idx;
-  SCM collected =SCM_EOL;
-  
-  if (i == -1)
-    i++;
-  
-  for (;
-       i < scm_i_heap_segment_table_size; i++)
-    {
-      if (scm_i_heap_segment_table[i]->freelist != fl)
-       continue;
-      
-      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i]);
-
-
-      if (collected != SCM_EOL)       /* Don't increment i */
-       break;
-    }
-
-  fl->heap_segment_idx = i;
-  
-  return collected;
-}
-
-
-
-
-void
-scm_i_reset_segments (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
-      seg->next_free_card = seg->bounds[0];
-    }
-}
-
-
-/*
-  Determine whether the given value does actually represent a cell in
-  some heap segment.  If this is the case, the number of the heap
-  segment is returned.  Otherwise, -1 is returned.  Binary search is
-  used to determine the heap segment that contains the cell.
-
-
-  I think this function is too long to be inlined. --hwn
-*/
-long int
-scm_i_find_heap_segment_containing_object (SCM obj)
-{
-  if (!CELL_P (obj))
-    return -1;
-
-  if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
-    return -1;
-
-  
-    {
-      scm_t_cell *  ptr = SCM2PTR (obj);
-      unsigned long int i = 0;
-      unsigned long int j = scm_i_heap_segment_table_size - 1;
-
-      if (ptr < scm_i_heap_segment_table[i]->bounds[0])
-       return -1;
-      else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-       return -1;
-      else
-       {
-         while (i < j)
-           {
-             if (ptr < scm_i_heap_segment_table[i]->bounds[1])
-               {
-                 break;
-               }
-             else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
-               {
-                 i = j;
-                 break;
-               }
-             else
-               {
-                 unsigned long int k = (i + j) / 2;
-
-                 if (k == i)
-                   return -1;
-                 else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
-                   {
-                     j = k;
-                     ++i;
-                     if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
-                       return -1;
-                   }
-                 else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
-                   {
-                     i = k;
-                     --j;
-                     if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-                       return -1;
-                   }
-               }
-           }
-
-         if (!DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
-           return -1;
-         else if (SCM_GC_IN_CARD_HEADERP (ptr))
-           return -1;
-         else
-           return i;
-       }
-    }
-}
-
-
-/*
-  Important entry point: try to grab some memory, and make it into a
-  segment.
-
-  RETURN: the index of the segment.
- */
-int 
-scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_error error_policy)
-{
-  size_t len;
-
-  if (scm_gc_heap_lock)
-    {
-      /* Critical code sections (such as the garbage collector) aren't
-       * supposed to add heap segments.
-       */
-      fprintf (stderr, "scm_i_get_new_heap_segment: Can not extend locked heap.\n");
-      abort ();
-    }
-
-
-  /* Pick a size for the new heap segment.
-   * The rule for picking the size of a segment is explained in
-   * gc.h
-   */
-  {
-    /* Assure that the new segment is predicted to be large enough.
-     *
-     * New yield should at least equal GC fraction of new heap size, i.e.
-     *
-     *   y + dh > f * (h + dh)
-     *
-     *    y : yield
-     *    f : min yield fraction
-     *    h : heap size
-     *   dh : size of new heap segment
-     *
-     * This gives dh > (f * h - y) / (1 - f)
-     */
-
-    /*
-      where is is this explanation supposed to be?  --hwn
-     */
-    int f = freelist->min_yield_fraction;
-    unsigned long h = SCM_HEAP_SIZE;
-    size_t min_cells = (f * h - 100 * (long) scm_gc_cells_collected) / (99 - f);
-
-    /* Make heap grow with factor 1.5 */
-    len =  freelist->heap_size / 2;
-#ifdef DEBUGINFO
-    fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
-#endif
-
-    /*
-      Original code adds freelist->cluster_size here.
-     */
-    if (len < min_cells)
-      len = min_cells;  
-    len *= sizeof (scm_t_cell);
-    /* force new sampling */
-    freelist->collected = LONG_MAX;
-  }
-
-  if (len > SCM_MIN_HEAP_SEG_SIZE)
-    len = SCM_MIN_HEAP_SEG_SIZE;
-
-  {
-    scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
-
-    /* Allocate with decaying ambition. */
-    while (len >= SCM_MIN_HEAP_SEG_SIZE)
-      {
-       if (scm_i_initialize_heap_segment_data (seg, len))
-         {
-           return scm_i_insert_segment (seg);
-         }
-       
-       len /= 2;
-      }
-  }
-
-  if (error_policy == abort_on_error)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
-      abort ();
-    }
-  return -1;
-}
-
-
-
-void
-scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist)
-{
-  scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
-  if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
-    {
-      freelist->heap_segment_idx = scm_i_insert_segment (seg);
-    }
-
-  /*
-    Why the fuck  try twice? --hwn
-   */
-  if (!seg->malloced)
-    {
-      scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
-    }
-
-  if (freelist->min_yield_fraction)
-    freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
-                           / 100);
-}
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h> 
+#include <stdio.h>
+#include <string.h>
+
+#include <count-one-bits.h>
+
+#include "libguile/_scm.h"
+#include "libguile/pairs.h"
+#include "libguile/gc.h"
+#include "libguile/private-gc.h"
+
+size_t scm_max_segment_size;
+
+/* Important entry point: try to grab some memory, and make it into a
+   segment; return the index of the segment.  SWEEP_STATS should contain
+   global GC sweep statistics collected since the last full GC.
+
+   Returns the index of the segment.  If error_policy !=
+   abort_on_error, we return -1 on failure.
+*/
+int
+scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
+                           size_t len,
+                           policy_on_error error_policy)
+{
+  if (len > scm_max_segment_size)
+    len = scm_max_segment_size;
+
+  if (len < SCM_MIN_HEAP_SEG_SIZE)
+    len = SCM_MIN_HEAP_SEG_SIZE;
+
+  /* todo: consider having a more flexible lower bound. */
+  {
+    scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist);
+
+    /* Allocate with decaying ambition. */
+    while (len >= SCM_MIN_HEAP_SEG_SIZE)
+      {
+       if (scm_i_initialize_heap_segment_data (seg, len))
+         return scm_i_insert_segment (seg);
+       
+       len /= 2;
+      }
+  }
+
+  if (error_policy == abort_on_error)
+    {
+      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
+      abort ();
+    }
+  return -1;
+}
+
+
+scm_t_heap_segment *
+scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
+{
+  scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment));
+
+  if (!shs)
+    {
+      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
+      abort ();
+    }
+  
+  shs->span = fl->span;
+  shs->freelist  = fl;
+  
+  return shs;
+}
+
+void
+scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
+{
+  scm_t_cell *p = seg->bounds[0];
+  while (p <  seg->bounds[1])
+    {
+      scm_i_card_statistics (p, tab, seg); 
+      p += SCM_GC_CARD_N_CELLS;
+    }
+}
+
+/*
+  count number of marked bits, so we know how much cells are live.
+ */
+int
+scm_i_heap_segment_marked_count (scm_t_heap_segment *seg)
+{
+  scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1];
+  scm_t_c_bvec_long *bvec_end =
+    (bvec +
+     scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
+  
+  int count = 0;
+  while (bvec < bvec_end)
+    {
+      count += count_one_bits_l (*bvec);
+      bvec ++;
+    }
+  return count * seg->span;
+}
+
+int
+scm_i_segment_card_number (scm_t_heap_segment *seg,
+                          scm_t_cell *card)
+{
+  return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
+}
+
+/*
+  Fill SEGMENT with memory both for data and mark bits.
+
+  RETURN: 1 on success, 0 failure  
+ */
+int 
+scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested)
+{
+  /*
+    round upwards
+   */
+  int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
+  int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; 
+
+  /*
+    one card extra due to alignment
+  */
+  size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD
+    + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG;
+  scm_t_cell *memory = 0;
+
+  /*
+    We use calloc to alloc the heap, so it is nicely initialized.
+   */
+  SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed));
+
+  if (memory == NULL)
+    return 0;
+
+  segment->malloced = memory;
+  segment->bounds[0] = SCM_GC_CARD_UP (memory);
+  segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
+  segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment);
+
+  /*
+    Don't init the mem or the bitvector. This is handled by lazy
+    sweeping.
+  */
+  segment->next_free_card = segment->bounds[0];
+  segment->first_time = 1;
+  return 1;
+}
+
+int
+scm_i_segment_card_count (scm_t_heap_segment *seg)
+{
+  return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
+}
+
+/*
+  Return the number of available single-cell data cells. 
+ */
+int
+scm_i_segment_cell_count (scm_t_heap_segment *seg)
+{
+  return scm_i_segment_card_count (seg)
+    * scm_i_segment_cells_per_card (seg);
+}
+
+int
+scm_i_segment_cells_per_card (scm_t_heap_segment *seg)
+{
+  return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS
+         + ((seg->span == 2) ? -1 : 0));
+}
+
+void
+scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
+{
+  scm_t_cell *markspace = seg->bounds[1];
+
+  memset (markspace, 0x00,
+         scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
+}
+
+
+/*
+  Force a sweep of this entire segment.
+ */
+void
+scm_i_sweep_segment (scm_t_heap_segment *seg,
+                    scm_t_sweep_statistics *sweep_stats)
+{
+  int infinity = 1 << 30;
+  scm_t_cell *remember = seg->next_free_card;  
+  while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL)
+    ;
+  seg->next_free_card = remember;
+}
+
+
+/* Sweep cards from SEG until we've gathered THRESHOLD cells.  On
+   return, SWEEP_STATS, if non-NULL, contains the number of cells that
+   have been visited and collected.  A freelist is returned,
+   potentially empty.  */
+SCM
+scm_i_sweep_some_cards (scm_t_heap_segment *seg,
+                       scm_t_sweep_statistics *sweep_stats,
+                       int threshold)
+{
+  SCM cells = SCM_EOL;
+  int collected = 0;
+  int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *)
+    = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
+
+  scm_t_cell *next_free = seg->next_free_card;
+  int cards_swept = 0;
+  while (collected < threshold && next_free < seg->bounds[1])
+    {
+      collected += (*sweeper) (next_free, &cells, seg);
+      next_free += SCM_GC_CARD_N_CELLS;
+      cards_swept ++;
+    }
+
+  if (sweep_stats != NULL)
+    {
+      int swept = cards_swept 
+       * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
+          - seg->span + 1);
+      int collected_cells = collected * seg->span;
+      sweep_stats->swept += swept;
+      sweep_stats->collected += collected_cells;
+    }
+  
+  if (next_free == seg->bounds[1])
+    {
+      seg->first_time = 0;
+    }
+
+  seg->next_free_card = next_free;
+  return cells;
+}
+
+
+
+SCM
+scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist)
+{
+  scm_t_sweep_statistics stats = { 0 };
+  SCM result = scm_i_sweep_some_segments (freelist, &stats);
+
+  scm_i_gc_sweep_stats.collected += stats.collected;
+  scm_i_gc_sweep_stats.swept += stats.swept;
+
+  freelist->collected += stats.collected;
+  freelist->swept += stats.swept; 
+  return result;
+}
+