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

vm support for display closures

Browse source 
* libguile/vm-i-system.c (box, empty-box): Boxing values and storing
  them in local variables.
  (local-boxed-ref, local-boxed-set): A combination of local-ref then
  variable-ref/set.
  (make-closure2, closure-ref, closure-boxed-ref, closure-boxed-set):
  New ops. The idea is to migrate Guile over to using flat dispay
  closures. See the paper "Three Implementation Models for Scheme" by
  Kent Dybvig for more details; this is the "stack-based" model.

* libguile/vm-engine.c:
* libguile/vm-engine.h: Add the necessary infrastructure to keep track
  of a "closure" variable, like our "externals" in semantics, but
  minimal, flat, and O(1) in implementation.
This commit is contained in:
Andy Wingo 2009-07-19 19:48:26 +02:00
parent a5cfddd560
commit 8d90b35656
3 changed files with 130 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/vm-engine.c
View file

@ -23,12 +23,14 @@
#define VM_USE_CLOCK 0 /* Bogoclock */
#define VM_CHECK_EXTERNAL 1 /* Check external link */
#define VM_CHECK_OBJECT 1 /* Check object table */
#define VM_CHECK_CLOSURE 1 /* Check closure vars */
#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1
#define VM_CHECK_EXTERNAL 1
#define VM_CHECK_OBJECT 1
#define VM_CHECK_CLOSURE 1
#define VM_PUSH_DEBUG_FRAMES 1
#else
#error unknown debug engine VM_ENGINE
@ -47,7 +49,9 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
SCM external = SCM_EOL; /* external environment */
SCM external = SCM_EOL; /* external environment REMOVEME */
SCM *closure = NULL; /* closure variables */
size_t closure_count = 0; /* length of CLOSURE */
SCM *objects = NULL; /* constant objects */
size_t object_count = 0; /* length of OBJECTS */
SCM *stack_base = vp->stack_base; /* stack base address */
@ -240,6 +244,13 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
goto vm_error;
#endif
#if VM_CHECK_CLOSURE
vm_error_closure:
err_msg = scm_from_locale_string ("VM: Invalid closure variable access");
finish_args = SCM_EOL;
goto vm_error;
#endif
vm_error:
SYNC_ALL ();

30
libguile/vm-engine.h
View file

@ -117,6 +117,16 @@
vp->fp = fp; \
}
/* FIXME */
#define ASSERT_VARIABLE(x) \
do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
} while (0)
#define ASSERT_BOUND_VARIABLE(x) \
do { ASSERT_VARIABLE (x); \
if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED) \
{ SYNC_REGISTER (); abort(); } \
} while (0)
#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
@ -145,6 +155,19 @@
object_count = 0; \
} \
} \
{ \
SCM c = SCM_PROGRAM_EXTERNALS (program); \
if (SCM_I_IS_VECTOR (c)) \
{ \
closure = SCM_I_VECTOR_WELTS (c); \
closure_count = SCM_I_VECTOR_LENGTH (c); \
} \
else \
{ \
closure = NULL; \
closure_count = 0; \
} \
} \
}
#define SYNC_BEFORE_GC() \
@ -178,6 +201,13 @@
#define CHECK_OBJECT(_num)
#endif
#if VM_CHECK_CLOSURE
#define CHECK_CLOSURE(_num) \
do { if (SCM_UNLIKELY ((_num) >= closure_count)) goto vm_error_closure; } while (0)
#else
#define CHECK_CLOSURE(_num)
#endif
/*
* Hooks

88
libguile/vm-i-system.c
View file

@ -248,6 +248,8 @@ VM_DEFINE_INSTRUCTION (22, list_break, "list-break", 0, 0, 0)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
#define CLOSURE_REF(i) closure[i]
/* ref */
VM_DEFINE_INSTRUCTION (23, object_ref, "object-ref", 1, 0, 1)
@ -1150,6 +1152,92 @@ VM_DEFINE_INSTRUCTION (55, truncate_values, "truncate-values", 2, -1, -1)
NEXT;
}
VM_DEFINE_INSTRUCTION (56, box, "box", 1, 1, 0)
{
SCM val;
POP (val);
SYNC_BEFORE_GC ();
LOCAL_SET (FETCH (), scm_cell (scm_tc7_variable, SCM_UNPACK (val)));
NEXT;
}
/* for letrec:
(let ((a *undef*) (b *undef*) ...)
(set! a (lambda () (b ...)))
...)
*/
VM_DEFINE_INSTRUCTION (57, empty_box, "empty-box", 1, 0, 0)
{
SYNC_BEFORE_GC ();
LOCAL_SET (FETCH (),
scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED)));
NEXT;
}
VM_DEFINE_INSTRUCTION (58, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
{
SCM v = LOCAL_REF (FETCH ());
ASSERT_BOUND_VARIABLE (v);
PUSH (VARIABLE_REF (v));
NEXT;
}
VM_DEFINE_INSTRUCTION (59, local_boxed_set, "local-boxed-set", 1, 1, 0)
{
SCM v, val;
v = LOCAL_REF (FETCH ());
POP (val);
ASSERT_VARIABLE (v);
VARIABLE_SET (v, val);
NEXT;
}
VM_DEFINE_INSTRUCTION (60, closure_ref, "closure-ref", 1, 0, 1)
{
scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx);
PUSH (CLOSURE_REF (idx));
NEXT;
}
/* no closure-set -- if a var is assigned, it should be in a box */
VM_DEFINE_INSTRUCTION (61, closure_boxed_ref, "closure-boxed-ref", 1, 0, 1)
{
SCM v;
scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx);
v = CLOSURE_REF (idx);
ASSERT_BOUND_VARIABLE (v);
PUSH (VARIABLE_REF (v));
NEXT;
}
VM_DEFINE_INSTRUCTION (62, closure_boxed_set, "closure-boxed-set", 1, 1, 0)
{
SCM v, val;
scm_t_uint8 idx = FETCH ();
POP (val);
CHECK_CLOSURE (idx);
v = CLOSURE_REF (idx);
ASSERT_BOUND_VARIABLE (v);
VARIABLE_SET (v, val);
NEXT;
}
VM_DEFINE_INSTRUCTION (63, make_closure2, "make-closure2", 0, 2, 1)
{
SCM vect;
POP (vect);
SYNC_BEFORE_GC ();
/* fixme underflow */
SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp),
SCM_PROGRAM_OBJTABLE (*sp), vect);
NEXT;
}
/*
(defun renumber-ops ()
"start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"