summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--NEWS6
-rw-r--r--doc/ref/scheme-memory.texi17
-rw-r--r--libguile/ChangeLog9
-rw-r--r--libguile/gc-card.c16
-rw-r--r--libguile/gc-mark.c22
-rw-r--r--libguile/gc-segment.c2
-rw-r--r--libguile/gc.c173
-rw-r--r--libguile/gc.h16
-rw-r--r--libguile/inline.c5
-rw-r--r--libguile/inline.h13
-rw-r--r--libguile/private-gc.h3
-rw-r--r--libguile/procs.c2
12 files changed, 179 insertions, 105 deletions
diff --git a/NEWS b/NEWS
index 0734b3bfd..25a081053 100644
--- a/NEWS
+++ b/NEWS
@@ -142,9 +142,9 @@ cause aborts in long running programs.
The new functions are more symmetrical and do not need cooperation
from smob free routines, among other improvements.
-The new functions are scm_malloc, scm_realloc, scm_strdup,
-scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, scm_gc_free,
-scm_gc_register_collectable_memory, and
+The new functions are scm_malloc, scm_realloc, scm_calloc, scm_strdup,
+scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc,
+scm_gc_free, scm_gc_register_collectable_memory, and
scm_gc_unregister_collectable_memory. Refer to the manual for more
details and for upgrading instructions.
diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi
index 8fad86466..ea3f8bfd1 100644
--- a/doc/ref/scheme-memory.texi
+++ b/doc/ref/scheme-memory.texi
@@ -76,6 +76,7 @@ For really specialized needs, take at look at
@code{scm_gc_unregister_collectable_memory}.
@deftypefn {C Function} void *scm_malloc (size_t @var{size})
+@deftypefnx {C Function} void *scm_calloc (size_t @var{size})
Allocate @var{size} bytes of memory and return a pointer to it. When
@var{size} is 0, return @code{NULL}. When not enough memory is
available, signal an error. This function runs the GC to free up some
@@ -85,6 +86,9 @@ The memory is allocated by the libc @code{malloc} function and can be
freed with @code{free}. There is no @code{scm_free} function to go
with @code{scm_malloc} to make it easier to pass memory back and forth
between different modules.
+
+The function @code{scm_calloc} is similar to @code{scm_malloc}, but
+initializes the block of memory to zero as well.
@end deftypefn
@deftypefn {C Function} void *scm_realloc (void *@var{mem}, size_t @var{new_size})
@@ -98,6 +102,9 @@ When not enough memory is available, signal an error. This function
runs the GC to free up some memory when it deems it appropriate.
@end deftypefn
+
+
+
@deftypefn {C Function} void scm_gc_register_collectable_memory (void *@var{mem}, size_t @var{size}, const char *@var{what})
Informs the GC that the memory at @var{mem} of size @var{size} can
potentially be freed during a GC. That is, announce that @var{mem} is
@@ -127,12 +134,14 @@ much less efficiently than it could.
@deftypefn {C Function} void *scm_gc_malloc (size_t @var{size}, const char *@var{what})
@deftypefnx {C Function} void *scm_gc_realloc (void *@var{mem}, size_t @var{old_size}, size_t @var{new_size}, const char *@var{what});
-Like @code{scm_malloc} or @code{scm_realloc}, but also call
-@code{scm_gc_register_collectable_memory}. Note that you need to pass
-the old size of a reallocated memory block as well. See below for a
-motivation.
+@deftypefnx {C Function} void *scm_gc_calloc (size_t @var{size}, const char *@var{what})
+Like @code{scm_malloc}, @code{scm_realloc} or @code{scm_calloc}, but
+also call @code{scm_gc_register_collectable_memory}. Note that you
+need to pass the old size of a reallocated memory block as well. See
+below for a motivation.
@end deftypefn
+
@deftypefn {C Function} void scm_gc_free (void *@var{mem}, size_t @var{size}, const char *@var{what})
Like @code{free}, but also call @code{scm_gc_unregister_collectable_memory}.
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 5835323d0..0bb54712e 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,12 @@
+2002-08-08 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ * gc.h: add scm_debug_cells_gc_interval to public interface
+
+ * gc-card.c ("sweep_card"): set scm_gc_running while sweeping.
+
+ * gc.c (scm_i_expensive_validation_check): separate expensive
+ validation checks from cheap ones.
+
2002-08-06 Han-Wen Nienhuys <hanwen@cs.uu.nl>
* read.c (scm_input_error): new function: give meaningful error
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 6f82488ba..309ac88ab 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -86,12 +86,13 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span)
int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
int free_count = 0;
+ ++ scm_gc_running_p;
+
/*
I tried something fancy with shifting by one bit every word from
the bitvec in turn, but it wasn't any faster, but quite bit
hairier.
*/
-
for (p += offset; p < end; p += span, offset += span)
{
SCM scmptr = PTR2SCM(p);
@@ -273,6 +274,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span)
*free_list = PTR2SCM (p);
free_count ++;
}
+
+ --scm_gc_running_p;
return free_count;
}
#undef FUNC_NAME
@@ -301,6 +304,7 @@ scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span)
}
+
#if 0
/*
These functions are meant to be called from GDB as a debug aid.
@@ -318,6 +322,16 @@ typedef struct scm_t_list_cell_struct {
struct scm_t_list_cell_struct * cdr;
} scm_t_list_cell;
+
+typedef struct scm_t_double_cell
+{
+ scm_t_bits word_0;
+ scm_t_bits word_1;
+ scm_t_bits word_2;
+ scm_t_bits word_3;
+} scm_t_double_cell;
+
+
int
scm_gc_marked_p (SCM obj)
{
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index 466874ad2..d7414d648 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -83,9 +83,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
#include <unistd.h>
#endif
-
-
-
#ifdef __ia64__
# define SCM_MARK_BACKING_STORE() do { \
ucontext_t ctx; \
@@ -101,6 +98,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
# define SCM_MARK_BACKING_STORE()
#endif
+
/*
Entry point for this file.
*/
@@ -108,10 +106,10 @@ void
scm_mark_all (void)
{
long j;
-
+
scm_i_clear_mark_space ();
-
+
#ifndef USE_THREADS
/* Mark objects on the C stack. */
@@ -157,12 +155,14 @@ scm_mark_all (void)
}
}
}
+
/* FIXME: we should have a means to register C functions to be run
* in different phases of GC
*/
scm_mark_subr_table ();
+
#ifndef USE_THREADS
scm_gc_mark (scm_root->handle);
#endif
@@ -171,7 +171,6 @@ scm_mark_all (void)
/* {Mark/Sweep}
*/
-
/*
Mark an object precisely, then recurse.
*/
@@ -182,7 +181,9 @@ scm_gc_mark (SCM ptr)
return ;
if (SCM_GC_MARK_P (ptr))
- return;
+ {
+ return;
+ }
SCM_SET_GC_MARK (ptr);
scm_gc_mark_dependencies (ptr);
@@ -475,9 +476,12 @@ gc_mark_loop:
}
if (SCM_GC_MARK_P (ptr))
+ {
return;
-
+ }
+
SCM_SET_GC_MARK (ptr);
+
goto scm_mark_dependencies_again;
}
@@ -485,6 +489,7 @@ gc_mark_loop:
+
/* Mark a region conservatively */
void
scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
@@ -570,4 +575,3 @@ scm_gc_init_mark(void)
#endif
}
-
diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c
index d3a48f2ab..593aa29a2 100644
--- a/libguile/gc-segment.c
+++ b/libguile/gc-segment.c
@@ -546,6 +546,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro
}
+
void
scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist)
{
@@ -568,4 +569,3 @@ scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *f
freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
/ 100);
}
-
diff --git a/libguile/gc.c b/libguile/gc.c
index 58ede2266..b29138573 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -90,53 +90,87 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
unsigned int scm_gc_running_p = 0;
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-
/* Set this to != 0 if every cell that is accessed shall be checked:
*/
-unsigned int scm_debug_cell_accesses_p = 1;
+int scm_debug_cell_accesses_p = 0;
+int scm_expensive_debug_cell_accesses_p = 0;
/* Set this to 0 if no additional gc's shall be performed, otherwise set it to
* the number of cell accesses after which a gc shall be called.
*/
-static unsigned int debug_cells_gc_interval = 0;
+int scm_debug_cells_gc_interval = 0;
-
-/* Assert that the given object is a valid reference to a valid cell. This
- * test involves to determine whether the object is a cell pointer, whether
- * this pointer actually points into a heap segment and whether the cell
- * pointed to is not a free cell. Further, additional garbage collections may
- * get executed after a user defined number of cell accesses. This helps to
- * find places in the C code where references are dropped for extremely short
- * periods.
+/*
+ Global variable, so you can switch it off at runtime by setting
+ scm_i_cell_validation_already_running.
*/
+int scm_i_cell_validation_already_running ;
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+
+
+/*
+
+ Assert that the given object is a valid reference to a valid cell. This
+ test involves to determine whether the object is a cell pointer, whether
+ this pointer actually points into a heap segment and whether the cell
+ pointed to is not a free cell. Further, additional garbage collections may
+ get executed after a user defined number of cell accesses. This helps to
+ find places in the C code where references are dropped for extremely short
+ periods.
+
+*/
+
void
-scm_assert_cell_valid (SCM cell)
+scm_i_expensive_validation_check (SCM cell)
{
- static unsigned int already_running = 0;
+ if (!scm_in_heap_p (cell))
+ {
+ fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
+ (unsigned long) SCM_UNPACK (cell));
+ abort ();
+ }
+
+ /* If desired, perform additional garbage collections after a user
+ * defined number of cell accesses.
+ */
+ if (scm_debug_cells_gc_interval)
+ {
+ static unsigned int counter = 0;
- if (!already_running)
+ if (counter != 0)
+ {
+ --counter;
+ }
+ else
+ {
+ counter = scm_debug_cells_gc_interval;
+ scm_igc ("scm_assert_cell_valid");
+ }
+ }
+}
+
+void
+scm_assert_cell_valid (SCM cell)
+{
+ if (!scm_i_cell_validation_already_running && scm_debug_cell_accesses_p)
{
- already_running = 1; /* set to avoid recursion */
+ scm_i_cell_validation_already_running = 1; /* set to avoid recursion */
/*
- During GC, no user-code should be run, and the guile core should
- use non-protected accessors.
- */
+ During GC, no user-code should be run, and the guile core
+ should use non-protected accessors.
+ */
if (scm_gc_running_p)
- abort();
+ return;
/*
- Only scm_in_heap_p is wildly expensive.
- */
- if (scm_debug_cell_accesses_p)
- if (!scm_in_heap_p (cell))
- {
- fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
- (unsigned long) SCM_UNPACK (cell));
- abort ();
- }
+ Only scm_in_heap_p and rescanning the heap is wildly
+ expensive.
+ */
+ if (scm_expensive_debug_cell_accesses_p)
+ scm_i_expensive_validation_check (cell);
if (!SCM_GC_MARK_P (cell))
{
@@ -148,54 +182,47 @@ scm_assert_cell_valid (SCM cell)
abort ();
}
-
- /* If desired, perform additional garbage collections after a user
- * defined number of cell accesses.
- */
- if (scm_debug_cell_accesses_p && debug_cells_gc_interval)
- {
- static unsigned int counter = 0;
-
- if (counter != 0)
- {
- --counter;
- }
- else
- {
- counter = debug_cells_gc_interval;
- scm_igc ("scm_assert_cell_valid");
- }
- }
- already_running = 0; /* re-enable */
+ scm_i_cell_validation_already_running = 0; /* re-enable */
}
}
+
SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
(SCM flag),
"If @var{flag} is @code{#f}, cell access checking is disabled.\n"
- "If @var{flag} is @code{#t}, cell access checking is enabled,\n"
+ "If @var{flag} is @code{#t}, cheap cell access checking is enabled,\n"
"but no additional calls to garbage collection are issued.\n"
- "If @var{flag} is a number, cell access checking is enabled,\n"
+ "If @var{flag} is a number, strict cell access checking is enabled,\n"
"with an additional garbage collection after the given\n"
"number of cell accesses.\n"
"This procedure only exists when the compile-time flag\n"
"@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.")
#define FUNC_NAME s_scm_set_debug_cell_accesses_x
{
- if (SCM_FALSEP (flag)) {
- scm_debug_cell_accesses_p = 0;
- } else if (SCM_EQ_P (flag, SCM_BOOL_T)) {
- debug_cells_gc_interval = 0;
- scm_debug_cell_accesses_p = 1;
- } else if (SCM_INUMP (flag)) {
- long int f = SCM_INUM (flag);
- if (f <= 0) SCM_OUT_OF_RANGE (1, flag);
- debug_cells_gc_interval = f;
- scm_debug_cell_accesses_p = 1;
- } else {
- SCM_WRONG_TYPE_ARG (1, flag);
- }
+ if (SCM_FALSEP (flag))
+ {
+ scm_debug_cell_accesses_p = 0;
+ }
+ else if (SCM_EQ_P (flag, SCM_BOOL_T))
+ {
+ scm_debug_cells_gc_interval = 0;
+ scm_debug_cell_accesses_p = 1;
+ scm_expensive_debug_cell_accesses_p = 0;
+ }
+ else if (SCM_INUMP (flag))
+ {
+ long int f = SCM_INUM (flag);
+ if (f <= 0)
+ SCM_OUT_OF_RANGE (1, flag);
+ scm_debug_cells_gc_interval = f;
+ scm_debug_cell_accesses_p = 1;
+ scm_expensive_debug_cell_accesses_p = 1;
+ }
+ else
+ {
+ SCM_WRONG_TYPE_ARG (1, flag);
+ }
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -497,6 +524,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
--scm_ints_disabled;
*free_cells = SCM_FREE_CELL_CDR (cell);
+
+
return cell;
}
@@ -525,7 +554,7 @@ scm_igc (const char *what)
/* During the critical section, only the current thread may run. */
SCM_CRITICAL_SECTION_START;
- if (!scm_stack_base || scm_block_gc)
+ if (!scm_root || !scm_stack_base || scm_block_gc)
{
--scm_gc_running_p;
return;
@@ -585,15 +614,13 @@ scm_igc (const char *what)
SCM_CRITICAL_SECTION_END;
scm_c_hook_run (&scm_after_gc_c_hook, 0);
--scm_gc_running_p;
-}
-
-
-
-
-
-
-
+ /*
+ For debugging purposes, you could do
+ scm_i_sweep_all_segments("debug"), but then the remains of the
+ cell aren't left to analyse.
+ */
+}
/* {GC Protection Helper Functions}
@@ -939,7 +966,7 @@ mark_gc_async (void * hook_data SCM_UNUSED,
* after-gc-hook.
*/
#if (SCM_DEBUG_CELL_ACCESSES == 1)
- if (debug_cells_gc_interval == 0)
+ if (scm_debug_cells_gc_interval == 0)
scm_system_async_mark (gc_async);
#else
scm_system_async_mark (gc_async);
diff --git a/libguile/gc.h b/libguile/gc.h
index 7161e3805..f0f89b7f7 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -218,6 +218,7 @@ typedef unsigned long scm_t_c_bvec_long;
#define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 (x, t)
+
/* Freelists consist of linked cells where the type entry holds the value
* scm_tc_free_cell and the second entry holds a pointer to the next cell of
* the freelist. Due to this structure, freelist cells are not cons cells
@@ -245,7 +246,11 @@ typedef unsigned long scm_t_c_bvec_long;
#if (SCM_DEBUG_CELL_ACCESSES == 1)
-SCM_API unsigned int scm_debug_cell_accesses_p;
+/* Set this to != 0 if every cell that is accessed shall be checked:
+ */
+SCM_API int scm_debug_cell_accesses_p;
+SCM_API int scm_expensive_debug_cell_accesses_p;
+SCM_API int scm_debug_cells_gc_interval ;
#endif
SCM_API int scm_block_gc;
@@ -274,10 +279,11 @@ SCM_API size_t scm_max_segment_size;
Deprecated scm_freelist, scm_master_freelist.
No warning; this is not a user serviceable part.
*/
-SCM_API SCM scm_i_freelist;
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
-SCM_API SCM scm_i_freelist2;
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
+extern SCM scm_i_freelist;
+extern struct scm_t_cell_type_statistics scm_i_master_freelist;
+extern SCM scm_i_freelist2;
+extern struct scm_t_cell_type_statistics scm_i_master_freelist2;
+
SCM_API unsigned long scm_gc_cells_swept;
SCM_API unsigned long scm_gc_cells_collected;
diff --git a/libguile/inline.c b/libguile/inline.c
index 914f309b2..66e348b1c 100644
--- a/libguile/inline.c
+++ b/libguile/inline.c
@@ -39,10 +39,13 @@
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+#include <stdio.h>
#include "libguile/scmconfig.h"
-
+#ifndef HAVE_INLINE
#define HAVE_INLINE
+#endif
+
#define EXTERN_INLINE
#undef SCM_INLINE_H
diff --git a/libguile/inline.h b/libguile/inline.h
index c1df037c3..ea6b51277 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -50,10 +50,6 @@
*/
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-#include <stdio.h>
-#endif
-
#include "libguile/pairs.h"
#include "libguile/gc.h"
@@ -64,8 +60,6 @@ SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
#ifdef HAVE_INLINE
-
-
#ifndef EXTERN_INLINE
#define EXTERN_INLINE extern inline
#endif
@@ -74,6 +68,7 @@ extern unsigned scm_newcell2_count;
extern unsigned scm_newcell_count;
+
EXTERN_INLINE
SCM
scm_cell (scm_t_bits car, scm_t_bits cdr)
@@ -137,6 +132,10 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
#endif
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+ if (scm_expensive_debug_cell_accesses_p )
+ scm_i_expensive_validation_check (z);
+#endif
return z;
}
@@ -201,5 +200,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
return z;
}
+
+
#endif
#endif
diff --git a/libguile/private-gc.h b/libguile/private-gc.h
index 3924e5044..f5acd9450 100644
--- a/libguile/private-gc.h
+++ b/libguile/private-gc.h
@@ -236,5 +236,6 @@ void scm_gc_init_malloc (void);
void scm_gc_init_freelist (void);
void scm_gc_init_segments (void);
void scm_gc_init_mark (void);
-
+
+
#endif
diff --git a/libguile/procs.c b/libguile/procs.c
index 948934de2..7269fa558 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -139,7 +139,7 @@ scm_mark_subr_table ()
long i;
for (i = 0; i < scm_subr_table_size; ++i)
{
- SCM_SET_GC_MARK (scm_subr_table[i].name);
+ scm_gc_mark (scm_subr_table[i].name);
if (scm_subr_table[i].generic && *scm_subr_table[i].generic)
scm_gc_mark (*scm_subr_table[i].generic);
if (SCM_NIMP (scm_subr_table[i].properties))