* New file gc-segment-table.c: hold code for the segment table.
* Remove data that might be out of date; remove
scm_i_adjust_min_yield(). We don't store min_yields, since they
are only accurate at one point in time (when the sweep finishes).
We decide the min yield at that point from min_yield_fraction and
freelist->collected / freelist->swept
* Introduce scm_i_gc_heap_size_delta() replacing
scm_i_gc_grow_heap_p().
* Remove foo_1 fields containing penultimate results.
* After GC, count mark bit vector to discover number of live
objects. This simplifies hairy updates.
* Many formatting and layout cleanups.
* Fix in scm_i_sweep_card(): return the length of free_list returned,
rather than number of deleted objects.
* For mtrigger GCs: do not also run a full sweep after the gc() call, as
this is inconsistent with lazy sweeping.
* Remove scm_i_make_initial_segment().
* Use calloc in scm_i_make_empty_heap_segment() to save on
initialization code.
* New function scm_i_sweep_for_freelist() which sweeps, with proper
statistic variable updates.
* New segments are conceptually blocks with 100% reclaimable cells.
* Remove some useless constants/comments: SCM_HEAP_SIZE,
SCM_INIT_HEAP_SIZE, SCM_EXPHEAP, SCM_HEAP_SEG_SIZE
* Do not increment scm_cells_allocated() from the
scm_[double]cell(). This would be a race condition.
* Move some deprecation checks in separate functions to not distract
from main code flow.
deprecated.c discouraged.c dynwind.c eq.c error.c \
eval.c evalext.c extensions.c feature.c fluids.c fports.c \
futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c \
- gc-freelist.c gc_os_dep.c gdbint.c gettext.c \
+ gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c \
gh_data.c gh_eval.c gh_funcs.c \
gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \
guardians.c hash.c hashtab.c hooks.c init.c inline.c \
dynl.x dynwind.x eq.x error.x eval.x evalext.x \
extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x \
gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x \
- gsubr.x guardians.x \
+ gsubr.x guardians.x gc-segment-table.x \
hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \
list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \
objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \
deprecated.doc discouraged.doc dynl.doc dynwind.doc \
eq.doc error.doc eval.doc evalext.doc \
extensions.doc feature.doc fluids.doc fports.doc futures.doc \
- gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
- gc-malloc.doc gc-card.doc gettext.doc \
+ gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \
+ gc-malloc.doc gc-card.doc gettext.doc gc-segment-table.doc \
guardians.doc hash.doc hashtab.doc \
hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \
list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
-
+#include <assert.h>
#include <stdio.h>
#include <gmp.h>
#include "libguile/_scm.h"
+#include "libguile/async.h"
+#include "libguile/deprecation.h"
#include "libguile/eval.h"
+#include "libguile/gc.h"
+#include "libguile/hashtab.h"
#include "libguile/numbers.h"
-#include "libguile/stime.h"
-#include "libguile/stackchk.h"
-#include "libguile/struct.h"
-#include "libguile/smob.h"
-#include "libguile/unif.h"
-#include "libguile/async.h"
#include "libguile/ports.h"
+#include "libguile/private-gc.h"
#include "libguile/root.h"
+#include "libguile/smob.h"
+#include "libguile/srfi-4.h"
+#include "libguile/stackchk.h"
+#include "libguile/stime.h"
#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/weaks.h"
-#include "libguile/hashtab.h"
+#include "libguile/struct.h"
#include "libguile/tags.h"
-#include "libguile/private-gc.h"
+#include "libguile/unif.h"
#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/gc.h"
-#include "libguile/srfi-4.h"
+#include "libguile/vectors.h"
+#include "libguile/weaks.h"
#include "libguile/private-gc.h"
*/
SCM scm_i_structs_to_free;
-
/*
Init all the free cells in CARD, prepending to *FREE_LIST.
- Return: number of free cells found in this card.
+ Return: FREE_COUNT, the number of cells collected. This is
+ typically the length of the *FREE_LIST, but for some special cases,
+ we do not actually free the cell. To make the numbers match up, we
+ do increase the FREE_COUNT.
It would be cleaner to have a separate function sweep_value(), but
that is too slow (functions with switch statements can't be
inlined).
-
-
-
NOTE:
- This function is quite efficient. However, for many types of cells,
- allocation and a de-allocation involves calling malloc() and
- free().
-
- This is costly for small objects (due to malloc/free overhead.)
- (should measure this).
+ For many types of cells, allocation and a de-allocation involves
+ calling malloc() and free(). This is costly for small objects (due
+ to malloc/free overhead.) (should measure this).
It might also be bad for threads: if several threads are allocating
strings concurrently, then mallocs for both threads may have to
--hwn.
*/
int
-scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
+scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
#define FUNC_NAME "sweep_card"
{
- scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
- scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
+ scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(card);
+ scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
+ scm_t_cell *p = card;
int span = seg->span;
- int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
- int free_count = 0;
-
+ int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
+ int free_count = 0;
+
/*
I tried something fancy with shifting by one bit every word from
the bitvec in turn, but it wasn't any faster, but quite a bit
SCM scmptr = PTR2SCM (p);
if (SCM_C_BVEC_GET (bitvec, offset))
continue;
-
+ free_count++;
switch (SCM_TYP7 (scmptr))
{
case scm_tcs_struct:
/* Keep "revealed" ports alive. */
if (scm_revealed_count (scmptr) > 0)
continue;
-
+
/* Yes, I really do mean scm_ptobs[k].free */
/* rather than ftobs[k].close. .close */
/* is for explicit CLOSE-PORT by user */
switch SCM_TYP16 (scmptr)
{
case scm_tc_free_cell:
- free_count --;
break;
default:
{
SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
*free_list = scmptr;
- free_count ++;
}
-
+
return free_count;
}
#undef FUNC_NAME
Like sweep, but no complicated logic to do the sweeping.
*/
int
-scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
- scm_t_heap_segment*seg)
+scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list,
+ scm_t_heap_segment *seg)
{
int span = seg->span;
scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
scm_t_cell *p = end - span;
-
- scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1];
+ int collected = 0;
+ scm_t_c_bvec_long *bvec_ptr = (scm_t_c_bvec_long*) seg->bounds[1];
int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
- bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
+ bvec_ptr += idx * SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
SCM_GC_SET_CELL_BVEC (card, bvec_ptr);
/*
SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
*free_list = scmptr;
+ collected ++;
}
- return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
+ return collected;
+}
+
+/*
+ Classic MIT Hack, see e.g. http://www.tekpool.com/?cat=9
+ */
+int scm_i_uint_bit_count(unsigned int u)
+{
+ unsigned int u_count = u
+ - ((u >> 1) & 033333333333)
+ - ((u >> 2) & 011111111111);
+ return
+ ((u_count + (u_count >> 3))
+ & 030707070707) % 63;
}
+/*
+ Amount of cells marked in this cell, measured in 1-cells.
+ */
+int
+scm_i_card_marked_count (scm_t_cell *card, int span)
+{
+ scm_t_c_bvec_long* bvec = SCM_GC_CARD_BVEC (card);
+ scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
+
+ int count = 0;
+ while (bvec < bvec_end) {
+ count += scm_i_uint_bit_count(*bvec);
+ bvec ++;
+ }
+ return count * span;
+}
void
scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg)
#endif /* defined (GUILE_DEBUG) */
#endif /* deprecated */
-/* Adjust FREELIST variables to decide wether or not to allocate more heap in
- the next GC run based on SWEEP_STATS on SWEEP_STATS_1 (statistics
- collected after the two last full GC). */
-void
-scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist,
- scm_t_sweep_statistics sweep_stats,
- scm_t_sweep_statistics sweep_stats_1)
-{
- /* min yield is adjusted upwards so that next predicted total yield
- * (allocated cells actually freed by GC) becomes
- * `min_yield_fraction' of total heap size. Note, however, that
- * the absolute value of min_yield will correspond to `collected'
- * on one master (the one which currently is triggering GC).
- *
- * The reason why we look at total yield instead of cells collected
- * on one list is that we want to take other freelists into account.
- * On this freelist, we know that (local) yield = collected cells,
- * but that's probably not the case on the other lists.
- *
- * (We might consider computing a better prediction, for example
- * by computing an average over multiple GC:s.)
- */
- if (freelist->min_yield_fraction)
- {
- /* Pick largest of last two yields. */
- long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
- - (long) SCM_MAX (sweep_stats.collected,
- sweep_stats_1.collected));
-#ifdef DEBUGINFO
- fprintf (stderr, " after GC = %lu, delta = %ld\n",
- (unsigned long) scm_cells_allocated,
- (long) delta);
-#endif
- if (delta > 0)
- freelist->min_yield += delta;
- }
-}
-
-
static void
scm_init_freelist (scm_t_cell_type_statistics *freelist,
- int span,
- int min_yield)
+ int span,
+ int min_yield_percentage)
{
- if (min_yield < 1)
- min_yield = 1;
- if (min_yield > 99)
- min_yield = 99;
+ if (min_yield_percentage < 1)
+ min_yield_percentage = 1;
+ if (min_yield_percentage > 99)
+ min_yield_percentage = 99;
freelist->heap_segment_idx = -1;
- freelist->min_yield = 0;
- freelist->min_yield_fraction = min_yield;
+ freelist->min_yield_fraction = min_yield_percentage / 100.0;
freelist->span = span;
+ freelist->swept = 0;
freelist->collected = 0;
- freelist->collected_1 = 0;
- freelist->heap_size = 0;
+ freelist->heap_total_cells = 0;
}
#if (SCM_ENABLE_DEPRECATED == 1)
- size_t scm_default_init_heap_size_1;
- int scm_default_min_yield_1;
- size_t scm_default_init_heap_size_2;
- int scm_default_min_yield_2;
- size_t scm_default_max_segment_size;
+size_t scm_default_init_heap_size_1;
+int scm_default_min_yield_1;
+size_t scm_default_init_heap_size_2;
+int scm_default_min_yield_2;
+size_t scm_default_max_segment_size;
+
+static void
+check_deprecated_heap_vars (void) {
+ if (scm_default_init_heap_size_1 ||
+ scm_default_min_yield_1||
+ scm_default_init_heap_size_2||
+ scm_default_min_yield_2||
+ scm_default_max_segment_size)
+ {
+ scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
+ }
+}
+#else
+static void check_deprecated_heap_vars (void) { }
#endif
void
scm_gc_init_freelist (void)
{
+ const char *error_message =
+ "Could not allocate initial heap of %uld.\n"
+ "Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n";
+
int init_heap_size_1
= scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1);
int init_heap_size_2
if (scm_max_segment_size <= 0)
scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE;
-
- scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist);
- scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2);
-
-#if (SCM_ENABLE_DEPRECATED == 1)
- if ( scm_default_init_heap_size_1 ||
- scm_default_min_yield_1||
- scm_default_init_heap_size_2||
- scm_default_min_yield_2||
- scm_default_max_segment_size)
- {
- scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
- }
-#endif
+
+ if (scm_i_get_new_heap_segment (&scm_i_master_freelist,
+ init_heap_size_1, return_on_error) == -1) {
+ fprintf (stderr, error_message, init_heap_size_1, 1);
+ abort();
+ }
+ if (scm_i_get_new_heap_segment (&scm_i_master_freelist2,
+ init_heap_size_2, return_on_error) == -1) {
+ fprintf (stderr, error_message, init_heap_size_2, 2);
+ abort();
+ }
+
+ check_deprecated_heap_vars();
}
+
void
scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist)
{
- freelist->collected_1 = freelist->collected;
freelist->collected = 0;
-
+ freelist->swept = 0;
/*
at the end we simply start with the lowest segment again.
*/
freelist->heap_segment_idx = -1;
}
-int
-scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist)
+
+/*
+ Returns how many more cells we should allocate according to our
+ policy. May return negative if we don't need to allocate more.
+
+
+ The new yield should at least equal gc fraction of new heap size, i.e.
+
+ c + dh > f * (h + dh)
+
+ c : collected
+ f : min yield fraction
+ h : heap size
+ dh : size of new heap segment
+
+ this gives dh > (f * h - c) / (1 - f).
+*/
+float
+scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist)
{
- return SCM_MAX (freelist->collected, freelist->collected_1)
- < freelist->min_yield;
+ float f = freelist->min_yield_fraction;
+ float collected = freelist->collected;
+ float swept = freelist->swept;
+ float delta = ((f * swept - collected) / (1.0 - f));
+
+ assert(freelist->heap_total_cells >= freelist->collected);
+ assert(freelist->swept == freelist->heap_total_cells);
+ assert(swept >= collected);
+
+ return delta;
}
{
scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
SCM_DEFAULT_INIT_MALLOC_LIMIT);
- scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
- SCM_DEFAULT_MALLOC_MINYIELD);
+ scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
+ SCM_DEFAULT_MALLOC_MINYIELD);
if (scm_i_minyield_malloc >= 100)
scm_i_minyield_malloc = 99;
scm_realloc (void *mem, size_t size)
{
void *ptr;
- scm_t_sweep_statistics sweep_stats;
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
- scm_i_sweep_all_segments ("realloc", &sweep_stats);
+ // We don't want these sweep statistics to influence results for
+ // cell GC, so we don't collect statistics.
+ scm_i_sweep_all_segments ("realloc", NULL);
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
}
scm_i_gc ("realloc");
- scm_i_sweep_all_segments ("realloc", &sweep_stats);
+ scm_i_sweep_all_segments ("realloc", NULL);
scm_gc_running_p = 0;
scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
{
unsigned long prev_alloced;
float yield;
- scm_t_sweep_statistics sweep_stats;
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
- prev_alloced = mallocated;
+ prev_alloced = mallocated;
+
+ /* The GC will finish the pending sweep. For that reason, we
+ don't execute a complete sweep after GC, although that might
+ free some more memory.
+ */
scm_i_gc (what);
- scm_i_sweep_all_segments ("mtrigger", &sweep_stats);
yield = (((float) prev_alloced - (float) scm_mallocated)
/ (float) prev_alloced);
- scm_gc_malloc_yield_percentage = (int) (100 * yield);
+ scm_gc_malloc_yield_percentage = (int) (100 * yield);
#ifdef DEBUGINFO
fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d",
if (no_overflow_trigger >= (float) ULONG_MAX)
scm_mtrigger = ULONG_MAX;
else
- scm_mtrigger = (unsigned long) no_overflow_trigger;
+ scm_mtrigger = (unsigned long) no_overflow_trigger;
#ifdef DEBUGINFO
fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n",
Should prefetch objects before marking, i.e. if marking a cell, we
should prefetch the car, and then mark the cdr. This will improve CPU
-cache misses, because the car is more likely to be in core when we
+cache misses, because the car is more likely to be in cache when we
finish the cdr.
See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing
}
}
- if (SCM_GC_MARK_P (ptr))
- {
+ if (SCM_GC_MARK_P (ptr))
return;
- }
SCM_SET_GC_MARK (ptr);
#undef FUNC_NAME
-
-
/* Mark a region conservatively */
void
scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
--- /dev/null
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 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
+ */
+
+#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"
+
+
+/*
+ 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;
+static scm_t_cell *lowest_cell;
+static scm_t_cell *highest_cell;
+
+
+/*
+ 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++;
+
+ /*
+ We insert a new entry; if that happens to be before the
+ "current" segment of a freelist, we must move the freelist index
+ as well.
+ */
+ if (scm_i_master_freelist.heap_segment_idx >= i)
+ scm_i_master_freelist.heap_segment_idx ++;
+ if (scm_i_master_freelist2.heap_segment_idx >= i)
+ scm_i_master_freelist2.heap_segment_idx ++;
+
+ 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;
+ }
+}
+
+
+/*
+ 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
+*/
+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 int i = 0;
+ unsigned 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 (!SCM_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;
+ }
+ }
+}
+
+
+int
+scm_i_marked_count (void)
+{
+ int i = 0;
+ int c = 0;
+ for (; i < scm_i_heap_segment_table_size; i++)
+ {
+ c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]);
+ }
+ return c;
+}
+
+
+SCM
+scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist,
+ scm_t_sweep_statistics *sweep_stats)
+{
+ int i = freelist->heap_segment_idx;
+ SCM collected = SCM_EOL;
+
+ if (i == -1) /* huh? --hwn */
+ i++;
+
+ for (;
+ i < scm_i_heap_segment_table_size; i++)
+ {
+ if (scm_i_heap_segment_table[i]->freelist != freelist)
+ continue;
+
+ collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
+ sweep_stats,
+ DEFAULT_SWEEP_AMOUNT);
+
+ if (collected != SCM_EOL) /* Don't increment i */
+ break;
+ }
+
+ freelist->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];
+ }
+}
+
+
+
+
+/*
+ Return a hashtab with counts of live objects, with tags as keys.
+ */
+SCM
+scm_i_all_segments_statistics (SCM tab)
+{
+ int i = 0;
+ for (; i < scm_i_heap_segment_table_size; i++)
+ {
+ scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
+ scm_i_heap_segment_statistics (seg, tab);
+ }
+
+ return tab;
+}
+
+
+unsigned long*
+scm_i_segment_table_info(int* size)
+{
+ *size = scm_i_heap_segment_table_size;
+ unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2);
+ int i;
+ if (!bounds)
+ abort();
+ for (i = *size; i-- > 0; )
+ {
+ bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
+ bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
+ }
+ return bounds;
+}
+
+
+void
+scm_i_sweep_all_segments (char const *reason,
+ scm_t_sweep_statistics *sweep_stats)
+{
+ unsigned i= 0;
+ for (i = 0; i < scm_i_heap_segment_table_size; i++)
+ {
+ scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats);
+ }
+}
+
+
+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]);
+ }
+}
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 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
- */
-
-#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"
-
-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;
-}
-
-
-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;
- }
-}
-
-/*
- 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 calloc 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];
-
- /*
- 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_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);
-}
-
-/* Sweep cards from SEG until we've gathered THRESHOLD cells. On return,
- SWEEP_STATS 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)
-{
- SCM cells = SCM_EOL;
- int threshold = 512;
- 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 ++;
- }
-
- sweep_stats->swept = cards_swept * seg->span
- * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
-
- if (!seg->first_time)
- {
- /* scm_cells_allocated -= collected * seg->span; */
- sweep_stats->collected = collected * seg->span;
- }
- else
- sweep_stats->collected = 0;
-
- 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_sweep_statistics *sweep_stats)
-{
- scm_t_sweep_statistics sweep;
- scm_t_cell * p = seg->next_free_card;
-
- scm_i_sweep_statistics_init (sweep_stats);
-
- scm_i_sweep_statistics_init (&sweep);
- while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL)
- {
- scm_i_sweep_statistics_sum (sweep_stats, sweep);
- scm_i_sweep_statistics_init (&sweep);
- }
-
- seg->next_free_card =p;
-}
-
-void
-scm_i_sweep_all_segments (char const *reason,
- scm_t_sweep_statistics *sweep_stats)
-{
- unsigned i= 0;
-
- scm_i_sweep_statistics_init (sweep_stats);
- for (i = 0; i < scm_i_heap_segment_table_size; i++)
- {
- scm_t_sweep_statistics sweep;
-
- scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep);
- scm_i_sweep_statistics_sum (sweep_stats, sweep);
- }
-}
-
-
-/*
- 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++;
-
- /*
- We insert a new entry; if that happens to be before the
- "current" segment of a freelist, we must move the freelist index
- as well.
- */
- if (scm_i_master_freelist.heap_segment_idx >= i)
- scm_i_master_freelist.heap_segment_idx ++;
- if (scm_i_master_freelist2.heap_segment_idx >= i)
- scm_i_master_freelist2.heap_segment_idx ++;
-
- 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,
- scm_t_sweep_statistics *sweep_stats)
-{
- int i = fl->heap_segment_idx;
- SCM collected = SCM_EOL;
-
- scm_i_sweep_statistics_init (sweep_stats);
- if (i == -1)
- i++;
-
- for (;
- i < scm_i_heap_segment_table_size; i++)
- {
- scm_t_sweep_statistics sweep;
-
- if (scm_i_heap_segment_table[i]->freelist != fl)
- continue;
-
- scm_i_sweep_statistics_init (&sweep);
- collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
- &sweep);
-
- scm_i_sweep_statistics_sum (sweep_stats, sweep);
-
- 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];
- }
-}
-
-/*
- Return a hashtab with counts of live objects, with tags as keys.
- */
-
-
-SCM
-scm_i_all_segments_statistics (SCM tab)
-{
- int i = 0;
- for (; i < scm_i_heap_segment_table_size; i++)
- {
- scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
- scm_i_heap_segment_statistics (seg, tab);
- }
-
- return tab;
-}
-
-/*
- 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 (!SCM_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. SWEEP_STATS should contain
- global GC sweep statistics collected since the last full GC. */
-int
-scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
- scm_t_sweep_statistics sweep_stats,
- policy_on_error error_policy)
-{
- size_t len;
-
- {
- /* 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)
- */
- float f = freelist->min_yield_fraction / 100.0;
- float h = SCM_HEAP_SIZE;
- float min_cells = (f * h - sweep_stats.collected) / (1.0 - 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
-
- if (len < min_cells)
- len = (unsigned long) min_cells;
-
- len *= sizeof (scm_t_cell);
- /* force new sampling */
- freelist->collected = LONG_MAX;
- }
-
- if (len > scm_max_segment_size)
- len = scm_max_segment_size;
-
- 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 (int init_heap_size, scm_t_cell_type_statistics *freelist)
-{
- scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
-
- if (init_heap_size < 1)
- {
- init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1;
- }
-
- 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 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
+ */
+
+#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"
+
+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;
+
+ {
+ 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 += scm_i_uint_bit_count(*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;
+}
+
unsigned long scm_mallocated = 0;
/* Global GC sweep statistics since the last full GC. */
-static scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
-static scm_t_sweep_statistics scm_i_gc_sweep_stats_1 = { 0, 0 };
+scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
/* Total count of cells marked/swept. */
static double scm_gc_cells_marked_acc = 0.;
static double scm_gc_cells_allocated_acc = 0.;
static unsigned long scm_gc_time_taken = 0;
-static unsigned long t_before_gc;
static unsigned long scm_gc_mark_time_taken = 0;
static unsigned long scm_gc_times = 0;
SCM_SYMBOL (sym_cells_swept, "cells-swept");
SCM_SYMBOL (sym_malloc_yield, "malloc-yield");
SCM_SYMBOL (sym_cell_yield, "cell-yield");
-SCM_SYMBOL (sym_min_cell_yield, "min-cell-yield");
-SCM_SYMBOL (sym_min_double_cell_yield, "min-double-cell-yield");
SCM_SYMBOL (sym_protected_objects, "protected-objects");
SCM_SYMBOL (sym_total_cells_allocated, "total-cells-allocated");
unsigned long int local_scm_gc_times;
unsigned long int local_scm_gc_mark_time_taken;
unsigned long int local_protected_obj_count;
- unsigned long int local_min_cell_yield;
- unsigned long int local_min_double_cell_yield;
double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked;
double local_scm_total_cells_allocated;
SCM answer;
unsigned long *bounds = 0;
- int table_size = scm_i_heap_segment_table_size;
+ int table_size = 0;
SCM_CRITICAL_SECTION_START;
- /*
- temporarily store the numbers, so as not to cause GC.
- */
- bounds = malloc (sizeof (unsigned long) * table_size * 2);
- if (!bounds)
- abort();
- for (i = table_size; i--; )
- {
- bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
- bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
- }
-
+ bounds = scm_i_segment_table_info (&table_size);
/* Below, we cons to produce the resulting list. We want a snapshot of
* the heap situation before consing.
*/
local_scm_mtrigger = scm_mtrigger;
local_scm_mallocated = scm_mallocated;
- local_scm_heap_size = SCM_HEAP_SIZE;
+ local_scm_heap_size =
+ (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
- local_scm_cells_allocated = scm_cells_allocated;
- local_min_cell_yield = scm_i_master_freelist.min_yield;
- local_min_double_cell_yield = scm_i_master_freelist2.min_yield;
+ local_scm_cells_allocated =
+ scm_cells_allocated + scm_i_gc_sweep_stats.collected;
local_scm_gc_time_taken = scm_gc_time_taken;
local_scm_gc_mark_time_taken = scm_gc_mark_time_taken;
local_scm_gc_times = scm_gc_times;
local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage;
- local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage;
+ local_scm_gc_cell_yield_percentage = scm_gc_cell_yield_percentage;
local_protected_obj_count = protected_obj_count;
local_scm_gc_cells_swept =
(double) scm_gc_cells_swept_acc
-(double) scm_i_gc_sweep_stats.collected;
local_scm_total_cells_allocated = scm_gc_cells_allocated_acc
- + (double) (scm_cells_allocated - scm_last_cells_allocated);
+ + (double) scm_i_gc_sweep_stats.collected;
for (i = table_size; i--;)
{
scm_from_ulong (bounds[2*i+1])),
heap_segs);
}
+
/* njrev: can any of these scm_cons's or scm_list_n signal a memory
error? If so we need a frame here. */
answer =
scm_from_long (local_scm_gc_cell_yield_percentage)),
scm_cons (sym_protected_objects,
scm_from_ulong (local_protected_obj_count)),
- scm_cons (sym_min_cell_yield,
- scm_from_ulong (local_min_cell_yield)),
- scm_cons (sym_min_double_cell_yield,
- scm_from_ulong (local_min_double_cell_yield)),
scm_cons (sym_heap_segments, heap_segs),
SCM_UNDEFINED);
SCM_CRITICAL_SECTION_END;
}
#undef FUNC_NAME
-/* Update the global sweeping/collection statistics by adding SWEEP_STATS to
- SCM_I_GC_SWEEP_STATS and updating related variables. */
-static inline void
-gc_update_stats (scm_t_sweep_statistics sweep_stats)
+/*
+ Update nice-to-know-statistics.
+ */
+static void
+gc_end_stats ()
{
/* CELLS SWEPT is another word for the number of cells that were examined
during GC. YIELD is the number that we cleaned out. MARKED is the number
that weren't cleaned. */
-
- scm_gc_cell_yield_percentage = (sweep_stats.collected * 100) / SCM_HEAP_SIZE;
-
- scm_i_sweep_statistics_sum (&scm_i_gc_sweep_stats, sweep_stats);
-
- if ((scm_i_gc_sweep_stats.collected > scm_i_gc_sweep_stats.swept)
- || (scm_cells_allocated < sweep_stats.collected))
- {
- printf ("internal GC error, please report to `"
- PACKAGE_BUGREPORT "'\n");
- abort ();
- }
+ scm_gc_cell_yield_percentage = (scm_i_gc_sweep_stats.collected * 100) /
+ (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells);
scm_gc_cells_allocated_acc +=
- (double) (scm_cells_allocated - scm_last_cells_allocated);
-
- scm_cells_allocated -= sweep_stats.collected;
- scm_last_cells_allocated = scm_cells_allocated;
-}
-
-static void
-gc_start_stats (const char *what SCM_UNUSED)
-{
- t_before_gc = scm_c_get_internal_run_time ();
-
- scm_gc_malloc_collected = 0;
-}
-
-static void
-gc_end_stats (scm_t_sweep_statistics sweep_stats)
-{
- unsigned long t = scm_c_get_internal_run_time ();
-
- scm_gc_time_taken += (t - t_before_gc);
-
- /* Reset the number of cells swept/collected since the last full GC. */
- scm_i_gc_sweep_stats_1 = scm_i_gc_sweep_stats;
- scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
-
- gc_update_stats (sweep_stats);
-
- scm_gc_cells_marked_acc += (double) scm_i_gc_sweep_stats.swept
- - (double) scm_i_gc_sweep_stats.collected;
+ (double) scm_i_gc_sweep_stats.collected;
+ scm_gc_cells_marked_acc += (double) scm_cells_allocated;
scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept;
++scm_gc_times;
}
-
SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
(SCM obj),
"Return an integer that for the lifetime of @var{obj} is uniquely\n"
{
SCM cell;
int did_gc = 0;
- scm_t_sweep_statistics sweep_stats;
scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_gc_running_p = 1;
-
- *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
- gc_update_stats (sweep_stats);
-
- if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist))
+
+ *free_cells = scm_i_sweep_for_freelist (freelist);
+ if (*free_cells == SCM_EOL)
{
- freelist->heap_segment_idx =
- scm_i_get_new_heap_segment (freelist,
- scm_i_gc_sweep_stats,
- abort_on_error);
+ float delta = scm_i_gc_heap_size_delta (freelist);
+ if (delta > 0.0)
+ {
+ size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
+ freelist->heap_segment_idx =
+ scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
- *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
- gc_update_stats (sweep_stats);
+ *free_cells = scm_i_sweep_for_freelist (freelist);
+ }
}
-
+
if (*free_cells == SCM_EOL)
{
- /*
- with the advent of lazy sweep, GC yield is only known just
- before doing the GC.
- */
- scm_i_adjust_min_yield (freelist,
- scm_i_gc_sweep_stats,
- scm_i_gc_sweep_stats_1);
-
/*
out of fresh cells. Try to get some new ones.
*/
+ char reason[] = "0-cells";
+ reason[0] += freelist->span;
+
did_gc = 1;
- scm_i_gc ("cells");
+ scm_i_gc (reason);
- *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
- gc_update_stats (sweep_stats);
+ *free_cells = scm_i_sweep_for_freelist (freelist);
}
if (*free_cells == SCM_EOL)
{
/*
failed getting new cells. Get new juice or die.
- */
+ */
+ float delta = scm_i_gc_heap_size_delta (freelist);
+ assert (delta > 0.0);
+ size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
freelist->heap_segment_idx =
- scm_i_get_new_heap_segment (freelist,
- scm_i_gc_sweep_stats,
- abort_on_error);
+ scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
- *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats);
- gc_update_stats (sweep_stats);
+ *free_cells = scm_i_sweep_for_freelist (freelist);
}
if (*free_cells == SCM_EOL)
scm_t_c_hook scm_after_sweep_c_hook;
scm_t_c_hook scm_after_gc_c_hook;
+static void
+scm_check_deprecated_memory_return()
+{
+ if (scm_mallocated < scm_i_deprecated_memory_return)
+ {
+ /* The byte count of allocated objects has underflowed. This is
+ probably because you forgot to report the sizes of objects you
+ have allocated, by calling scm_done_malloc or some such. When
+ the GC freed them, it subtracted their size from
+ scm_mallocated, which underflowed. */
+ fprintf (stderr,
+ "scm_gc_sweep: Byte count of allocated objects has underflowed.\n"
+ "This is probably because the GC hasn't been correctly informed\n"
+ "about object sizes\n");
+ abort ();
+ }
+ scm_mallocated -= scm_i_deprecated_memory_return;
+ scm_i_deprecated_memory_return = 0;
+}
+
/* Must be called while holding scm_i_sweep_mutex.
- */
+ This function is fairly long, but it touches various global
+ variables. To not obscure the side effects on global variables,
+ this function has not been split up.
+ */
void
scm_i_gc (const char *what)
{
- scm_t_sweep_statistics sweep_stats;
-
+ unsigned long t_before_gc = 0;
+
scm_i_thread_put_to_sleep ();
-
+
scm_c_hook_run (&scm_before_gc_c_hook, 0);
#ifdef DEBUGINFO
fprintf (stderr,"gc reason %s\n", what);
-
fprintf (stderr,
scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
? "*"
: (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
#endif
- gc_start_stats (what);
+ t_before_gc = scm_c_get_internal_run_time ();
+ scm_gc_malloc_collected = 0;
/*
Set freelists to NULL so scm_cons() always triggers gc, causing
Let's finish the sweep. The conservative GC might point into the
garbage, and marking that would create a mess.
*/
- scm_i_sweep_all_segments ("GC", &sweep_stats);
+ scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats);
+ scm_check_deprecated_memory_return();
- /* Invariant: the number of cells collected (i.e., freed) must always be
- lower than or equal to the number of cells "swept" (i.e., visited). */
- assert (sweep_stats.collected <= sweep_stats.swept);
-
- if (scm_mallocated < scm_i_deprecated_memory_return)
- {
- /* The byte count of allocated objects has underflowed. This is
- probably because you forgot to report the sizes of objects you
- have allocated, by calling scm_done_malloc or some such. When
- the GC freed them, it subtracted their size from
- scm_mallocated, which underflowed. */
- fprintf (stderr,
- "scm_gc_sweep: Byte count of allocated objects has underflowed.\n"
- "This is probably because the GC hasn't been correctly informed\n"
- "about object sizes\n");
- abort ();
- }
- scm_mallocated -= scm_i_deprecated_memory_return;
+ /* Sanity check our numbers. */
+ assert (scm_cells_allocated == scm_i_marked_count ());
+ assert (scm_i_gc_sweep_stats.swept
+ == (scm_i_master_freelist.heap_total_cells
+ + scm_i_master_freelist2.heap_total_cells));
+ assert (scm_i_gc_sweep_stats.collected + scm_cells_allocated
+ == scm_i_gc_sweep_stats.swept);
-
/* Mark */
-
scm_c_hook_run (&scm_before_mark_c_hook, 0);
+
scm_mark_all ();
scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
+ scm_cells_allocated = scm_i_marked_count ();
+
/* Sweep
TODO: the after_sweep hook should probably be moved to just before
distinct classes of hook functions since this can prevent some
bad interference when several modules adds gc hooks.
*/
-
scm_c_hook_run (&scm_before_sweep_c_hook, 0);
- scm_gc_sweep ();
+
+ /*
+ Nothing here: lazy sweeping.
+ */
+ scm_i_reset_segments ();
+
+ *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+ *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
+
+ /* Invalidate the freelists of other threads. */
+ scm_i_thread_invalidate_freelists ();
+ assert(scm_cells_allocated == scm_i_marked_count ());
+
scm_c_hook_run (&scm_after_sweep_c_hook, 0);
- gc_end_stats (sweep_stats);
+ gc_end_stats ();
+ assert(scm_cells_allocated == scm_i_marked_count ());
+ scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
+ scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
+ scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
+
+ /* Arguably, this statistic is fairly useless: marking will dominate
+ the time taken.
+ */
+ scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
+ assert(scm_cells_allocated == scm_i_marked_count ());
scm_i_thread_wake_up ();
-
/*
For debugging purposes, you could do
scm_i_sweep_all_segments("debug"), but then the remains of the
scm_gc_init_freelist();
scm_gc_init_malloc ();
- j = SCM_HEAP_SEG_SIZE;
-
#if 0
/* We can't have a cleanup handler since we have no thread to run it
in. */
scm_gc_sweep (void)
#define FUNC_NAME "scm_gc_sweep"
{
- scm_i_deprecated_memory_return = 0;
-
- scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
- scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
-
- /*
- NOTHING HERE: LAZY SWEEPING !
- */
- scm_i_reset_segments ();
-
- *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
- *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-
- /* Invalidate the freelists of other threads. */
- scm_i_thread_invalidate_freelists ();
}
#undef FUNC_NAME
SCM_API unsigned long scm_mallocated;
SCM_API unsigned long scm_mtrigger;
-
-
SCM_API SCM scm_after_gc_hook;
SCM_API scm_t_c_hook scm_before_gc_c_hook;
*freelist = SCM_FREE_CELL_CDR (*freelist);
}
- /*
- We update scm_cells_allocated from this function. If we don't
- update this explicitly, we will have to walk a freelist somewhere
- later on, which seems a lot more expensive.
- */
- scm_cells_allocated += 1;
-
#if (SCM_DEBUG_CELL_ACCESSES == 1)
if (scm_debug_cell_accesses_p)
{
threading. What if another thread is doing GC at this point
... ?
*/
-
#endif
*freelist = SCM_FREE_CELL_CDR (*freelist);
}
- scm_cells_allocated += 2;
-
/* Initialize the type slot last so that the cell is ignored by the
GC until it is completely initialized. This is only relevant
when the GC can actually run during this code, which it can't
#define SCM_DEFAULT_MIN_YIELD_1 40
#define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024
+/*
+ How many cells to collect during one sweep call. This is the pool
+ size of each thread.
+ */
+#define DEFAULT_SWEEP_AMOUNT 512
+
/* The following value may seem large, but note that if we get to GC at
* all, this means that we have a numerically intensive application
*/
#define SCM_GC_IN_CARD_HEADERP(x) \
(scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS
-
+int scm_i_uint_bit_count (unsigned int u);
int scm_getenv_int (const char *var, int def);
typedef enum { return_on_error, abort_on_error } policy_on_error;
-/* gc-freelist*/
+/* gc-freelist */
/*
FREELIST:
A struct holding GC statistics on a particular type of cells.
+
+ Counts in cells are mainly for heap statistics, and for
+ double-cells, they are still measured in single-cell units.
*/
typedef struct scm_t_cell_type_statistics {
/*
*/
int heap_segment_idx;
- /* minimum yield on this list in order not to grow the heap
- */
- long min_yield;
-
- /* defines min_yield as percent of total heap size
+ /* defines min_yield as fraction of total heap size
*/
- int min_yield_fraction;
+ float min_yield_fraction;
/* number of cells per object on this list */
int span;
- /* number of collected cells during last GC */
+ /* number of collected cells during last GC. */
unsigned long collected;
- /* number of collected cells during penultimate GC */
- unsigned long collected_1;
-
- /* total number of cells in heap segments
- * belonging to this list.
- */
- unsigned long heap_size;
-
+ unsigned long swept;
+ /*
+ Total number of cells in heap segments belonging to this list.
+ */
+ unsigned long heap_total_cells;
} scm_t_cell_type_statistics;
unsigned swept;
/* Number of cells collected during the sweep operation. This number must
- alsways be lower than or equal to SWEPT. */
+ always be lower than or equal to SWEPT. */
unsigned collected;
} scm_t_sweep_statistics;
-#define scm_i_sweep_statistics_init(_stats) \
- do \
- { \
- (_stats)->swept = (_stats)->collected = 0; \
- } \
- while (0)
-
-#define scm_i_sweep_statistics_sum(_sum, _addition) \
- do \
- { \
- (_sum)->swept += (_addition).swept; \
- (_sum)->collected += (_addition).collected; \
- } \
- while (0)
+SCM_INTERNAL scm_t_sweep_statistics scm_i_gc_sweep_stats;
\f
extern scm_t_cell_type_statistics scm_i_master_freelist;
scm_t_sweep_statistics sweep_stats_1);
SCM_INTERNAL
void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist);
-SCM_INTERNAL
-int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist);
-
-
-#define SCM_HEAP_SIZE \
- (scm_i_master_freelist.heap_size + scm_i_master_freelist2.heap_size)
+SCM_INTERNAL float
+scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist);
#define SCM_MAX(A, B) ((A) > (B) ? (A) : (B))
(not that we do that, but anyway.)
*/
+ void *malloced;
- void* malloced;
-
- scm_t_cell * next_free_card;
+ scm_t_cell *next_free_card;
/* address of the head-of-freelist pointer for this segment's cells.
All segments usually point to the same one, scm_i_freelist. */
/* number of cells per object in this segment */
int span;
-
/*
Is this the first time that the cells are accessed?
*/
int first_time;
-
} scm_t_heap_segment;
-
-
/*
A table of segment records is kept that records the upper and
lower extents of the segment; this is used during the conservative
scm_t_heap_segment*);
SCM_INTERNAL int scm_i_sweep_card (scm_t_cell *card, SCM *free_list,
scm_t_heap_segment *);
+SCM_INTERNAL int scm_i_card_marked_count (scm_t_cell *card, int span);
SCM_INTERNAL void scm_i_card_statistics (scm_t_cell *p, SCM hashtab,
scm_t_heap_segment *seg);
SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
SCM_INTERNAL int scm_i_initialize_heap_segment_data (scm_t_heap_segment *seg,
size_t requested);
+
+SCM_INTERNAL int scm_i_segment_cells_per_card (scm_t_heap_segment *seg);
+SCM_INTERNAL int scm_i_segment_card_number (scm_t_heap_segment *seg,
+ scm_t_cell *card);
SCM_INTERNAL int scm_i_segment_card_count (scm_t_heap_segment *seg);
SCM_INTERNAL int scm_i_segment_cell_count (scm_t_heap_segment *seg);
-
+SCM_INTERNAL int scm_i_heap_segment_marked_count (scm_t_heap_segment *seg);
+
SCM_INTERNAL void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg);
SCM_INTERNAL scm_t_heap_segment *
scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*);
+SCM_INTERNAL SCM scm_i_sweep_for_freelist (scm_t_cell_type_statistics *seg);
SCM_INTERNAL SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg,
- scm_t_sweep_statistics *sweep_stats);
+ scm_t_sweep_statistics *sweep_stats,
+ int threshold);
SCM_INTERNAL void scm_i_sweep_segment (scm_t_heap_segment *seg,
scm_t_sweep_statistics *sweep_stats);
SCM_INTERNAL int scm_i_insert_segment (scm_t_heap_segment *seg);
-SCM_INTERNAL long int scm_i_find_heap_segment_containing_object (SCM obj);
-SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *,
- scm_t_sweep_statistics,
+SCM_INTERNAL int scm_i_find_heap_segment_containing_object (SCM obj);
+SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
+ size_t length,
policy_on_error);
+SCM_INTERNAL int scm_i_marked_count (void);
SCM_INTERNAL void scm_i_clear_mark_space (void);
SCM_INTERNAL void scm_i_sweep_segments (void);
SCM_INTERNAL SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
SCM_INTERNAL void scm_i_sweep_all_segments (char const *reason,
scm_t_sweep_statistics *sweep_stats);
SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab);
-SCM_INTERNAL void scm_i_make_initial_segment (int init_heap_size,
- scm_t_cell_type_statistics *fl);
+SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size);
extern long int scm_i_deprecated_memory_return;
HCoop / bpt / guile.git / commitdiff