mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 14:50:19 +02:00
vm support for display closures
* 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:
parent
a5cfddd560
commit
8d90b35656
3 changed files with 130 additions and 1 deletions
|
@ -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 ();
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue