summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-08-20 01:56:47 +0200
committerLudovic Courtès <ludo@gnu.org>2009-08-20 01:56:47 +0200
commite3eb628d889b8cb9821a274e41b72f9751b6ee0a (patch)
tree9c73410ce16ac53efb2be34dcdbda922f22314b5
parent75d315e1fbb0da6af8c48d17fd5b2a7a759fe849 (diff)
downloadguile-e3eb628d889b8cb9821a274e41b72f9751b6ee0a.tar.gz
Implement precise marking of the VM stack.
Suggested by Andy Wingo. * libguile/vm.c (VM_ENABLE_PRECISE_STACK_GC_SCAN): New macro. (vm_stack_gc_kind): New variable. (make_vm)[VM_ENABLE_PRECISE_STACK_GC_SCAN]: Use `GC_generic_malloc ()' to allocate the stack. (vm_stack_mark): New function. (scm_bootstrap_vm)[VM_ENABLE_PRECISE_STACK_GC_SCAN]: Initialize `vm_stack_gc_kind'.
-rw-r--r--libguile/vm.c75
1 files changed, 75 insertions, 0 deletions
diff --git a/libguile/vm.c b/libguile/vm.c
index 4aa27104a..292092428 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -23,6 +23,11 @@
#include <stdlib.h>
#include <alloca.h>
#include <string.h>
+#include <assert.h>
+
+#include "libguile/boehm-gc.h"
+#include <gc/gc_mark.h>
+
#include "_scm.h"
#include "vm-bootstrap.h"
#include "frames.h"
@@ -56,6 +61,13 @@
#define VM_ENABLE_ASSERTIONS
#endif
+/* When defined, arrange so that the GC doesn't scan the VM stack beyond its
+ current SP. This should help avoid excess data retention. See
+ http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/3001
+ for a discussion. */
+#define VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+
/*
* VM Continuation
@@ -281,6 +293,13 @@ static const scm_t_vm_engine vm_engines[] =
scm_t_bits scm_tc16_vm;
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+/* The GC "kind" for the VM stack. */
+static int vm_stack_gc_kind;
+
+#endif
+
static SCM
make_vm (void)
#define FUNC_NAME "make_vm"
@@ -293,8 +312,21 @@ make_vm (void)
struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
vp->stack_size = VM_DEFAULT_STACK_SIZE;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+ vp->stack_base = GC_generic_malloc (vp->stack_size * sizeof (SCM),
+ vm_stack_gc_kind);
+
+ /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
+ top is. */
+ *vp->stack_base = PTR2SCM (vp);
+ vp->stack_base++;
+ vp->stack_size--;
+#else
vp->stack_base = scm_gc_malloc (vp->stack_size * sizeof (SCM),
"stack-base");
+#endif
+
#ifdef VM_ENABLE_STACK_NULLING
memset (vp->stack_base, 0, vp->stack_size * sizeof (SCM));
#endif
@@ -313,6 +345,41 @@ make_vm (void)
}
#undef FUNC_NAME
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+/* Mark the VM stack region between its base and its current top. */
+static struct GC_ms_entry *
+vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
+ struct GC_ms_entry *mark_stack_limit, GC_word env)
+{
+ GC_word *word;
+ const struct scm_vm *vm;
+
+ /* The first word of the VM stack should contain a pointer to the
+ corresponding VM. */
+ vm = * ((struct scm_vm **) addr);
+
+ if (vm->stack_base == NULL)
+ /* ADDR must be a pointer to a free-list element, which we must ignore
+ (see warning in <gc/gc_mark.h>). */
+ return mark_stack_ptr;
+
+ /* Sanity checks. */
+ assert ((SCM *) addr == vm->stack_base - 1);
+ assert (vm->sp >= (SCM *) addr);
+ assert (vm->stack_limit - vm->stack_base == vm->stack_size);
+
+ for (word = (GC_word *) vm->stack_base; word <= (GC_word *) vm->sp; word++)
+ mark_stack_ptr = GC_MARK_AND_PUSH ((* (GC_word **) word),
+ mark_stack_ptr, mark_stack_limit,
+ NULL);
+
+ return mark_stack_ptr;
+}
+
+#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
+
+
SCM
scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
{
@@ -595,6 +662,14 @@ scm_bootstrap_vm (void)
(scm_t_extension_init_func)scm_init_vm, NULL);
strappage = 1;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+ vm_stack_gc_kind =
+ GC_new_kind (GC_new_free_list (),
+ GC_MAKE_PROC (GC_new_proc (vm_stack_mark), 0),
+ 0, 1);
+
+#endif
}
void