mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 11:34:09 +02:00
Code Activity

Implement precise marking of the VM stack.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2009-08-20 01:56:47 +02:00
parent 75d315e1fb
commit e3eb628d88
1 changed files with 75 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

75
libguile/vm.c
View file

@ -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