diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-08-20 01:56:47 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-08-20 01:56:47 +0200 |
commit | e3eb628d889b8cb9821a274e41b72f9751b6ee0a (patch) | |
tree | 9c73410ce16ac53efb2be34dcdbda922f22314b5 /libguile/vm.c | |
parent | 75d315e1fbb0da6af8c48d17fd5b2a7a759fe849 (diff) | |
download | guile-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'.
Diffstat (limited to 'libguile/vm.c')
-rw-r--r-- | libguile/vm.c | 75 |
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 |