-e Stop after expanding syntax/macro
-t Stop after translating into GHIL
-c Stop after generating GLIL
- -l Stop before linking
- -o Compile into bytecode
-O Enable optimization
-D Add debug information"
(let ((x (apply repl-compile repl form opts)))
(cond ((null? opts)
- (puts x))
- ((memq :l opts)
(disassemble-bytecode x))
((memq :c opts)
(pprint-glil x))
- (else
- (puts x)))))
+ (else (puts x)))))
(define (compile-file repl file . opts)
"compile-file [options] FILE
(define-structure (venv parent nexts closure?))
(define-structure (vmod id))
(define-structure (vlink module name))
-(define-structure (bytespec nargs nrest nlocs bytes objs))
+(define-structure (bytespec nargs nrest nlocs nexts bytes objs))
\f
;;;
(error "Unknown instruction:" inst)))))
;;
;; main
- (if (> nexts 0) (push-code! `(external ,nexts)))
(for-each generate-code body)
(let ((bytes (apply string-append (stack-finalize (reverse! stack))))
(objs (map car (reverse! object-alist))))
- (make-bytespec nargs nrest nlocs bytes objs))))))
+ (make-bytespec nargs nrest nlocs nexts bytes objs))))))
(define (stack-finalize stack)
(let loop ((list '()) (stack stack) (addr 0))
(let ((nargs (bytespec-nargs x))
(nrest (bytespec-nrest x))
(nlocs (bytespec-nlocs x))
+ (nexts (bytespec-nexts x))
(bytes (bytespec-bytes x))
(objs (bytespec-objs x)))
;; dump parameters
- (if (and (< nargs 4) (< nlocs 16))
- (push-code! (object->code (+ (* nargs 32) (* nrest 16) nlocs)))
- (begin
- (push-code! (object->code nargs))
- (push-code! (object->code nrest))
- (push-code! (object->code nlocs))
- (push-code! (object->code #f))))
+ (cond ((and (< nargs 4) (< nlocs 8) (< nexts 4))
+ ;; 8-bit representation
+ (let ((x (+ (* nargs 64) (* nrest 32) (* nlocs 4) nexts)))
+ (push-code! `(make-int8 ,x))))
+ ((and (< nargs 16) (< nlocs 128) (< nexts 16))
+ ;; 16-bit representation
+ (let ((x (+ (* nargs 4096) (* nrest 2048) (* nlocs 16) nexts)))
+ (push-code! `(make-int16 ,(quotient x 256) ,(modulo x 256)))))
+ (else
+ ;; Other cases
+ (push-code! (object->code nargs))
+ (push-code! (object->code nrest))
+ (push-code! (object->code nlocs))
+ (push-code! (object->code nexts))
+ (push-code! (object->code #f))))
;; dump object table
(cond ((not (null? objs))
(for-each dump! objs)
p->nargs = 0;
p->nrest = 0;
p->nlocs = 0;
+ p->nexts = 0;
p->meta = SCM_EOL;
p->objs = zero_vector;
p->external = SCM_EOL;
p->holder = holder;
/* If nobody holds bytecode's address, then allocate a new memory */
- if (SCM_FALSEP (p->holder))
+ if (SCM_FALSEP (holder))
p->base = SCM_MUST_MALLOC (size);
else
p->base = addr;
#undef FUNC_NAME
SCM
-scm_c_make_vclosure (SCM program, SCM external)
+scm_c_make_closure (SCM program, SCM external)
{
struct scm_program *p;
struct scm_program *q = SCM_PROGRAM_DATA (program);
p->nargs = q->nargs;
p->nrest = q->nrest;
p->nlocs = q->nlocs;
+ p->nexts = q->nexts;
p->meta = q->meta;
p->objs = q->objs;
p->external = external;
struct scm_program {
size_t size; /* the size of the program */
unsigned char nargs; /* the number of arguments */
- unsigned char nrest; /* have a rest argument or not */
- unsigned short nlocs; /* the number of local variables */
+ unsigned char nrest; /* the number of rest argument (0 or 1) */
+ unsigned char nlocs; /* the number of local variables */
+ unsigned char nexts; /* the number of external variables */
scm_byte_t *base; /* program base address */
SCM meta; /* meta information */
SCM objs; /* constant objects */
#define SCM_PROGRAM_NARGS(x) (SCM_PROGRAM_DATA (x)->nargs)
#define SCM_PROGRAM_NREST(x) (SCM_PROGRAM_DATA (x)->nrest)
#define SCM_PROGRAM_NLOCS(x) (SCM_PROGRAM_DATA (x)->nlocs)
+#define SCM_PROGRAM_NEXTS(x) (SCM_PROGRAM_DATA (x)->nexts)
#define SCM_PROGRAM_BASE(x) (SCM_PROGRAM_DATA (x)->base)
#define SCM_PROGRAM_META(x) (SCM_PROGRAM_DATA (x)->meta)
#define SCM_PROGRAM_OBJS(x) (SCM_PROGRAM_DATA (x)->objs)
#define SCM_PROGRAM_HOLDER(x) (SCM_PROGRAM_DATA (x)->holder)
extern SCM scm_c_make_program (void *addr, size_t size, SCM holder);
-extern SCM scm_c_make_vclosure (SCM program, SCM external);
+extern SCM scm_c_make_closure (SCM program, SCM external);
extern void scm_init_programs (void);
#define SCM_VM_CONT_P(OBJ) SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
-#define SCM_VM_CONT_VMP(CONT) ((struct scm_vm *) SCM_CELL_WORD_1 (CONT))
+#define SCM_VM_CONT_VP(CONT) ((struct scm_vm *) SCM_CELL_WORD_1 (CONT))
static SCM
-capture_vm_cont (struct scm_vm *vmp)
+capture_vm_cont (struct scm_vm *vp)
{
struct scm_vm *p = scm_must_malloc (sizeof (*p), "capture_vm_cont");
- p->stack_size = vmp->stack_limit - vmp->sp;
+ p->stack_size = vp->stack_limit - vp->sp;
p->stack_base = scm_must_malloc (p->stack_size * sizeof (SCM),
"capture_vm_cont");
p->stack_limit = p->stack_base + p->stack_size - 2;
- p->ip = vmp->ip;
- p->sp = (SCM *) (vmp->stack_limit - vmp->sp);
- p->fp = (SCM *) (vmp->stack_limit - vmp->fp);
- memcpy (p->stack_base, vmp->sp + 1, vmp->stack_size * sizeof (SCM));
+ p->ip = vp->ip;
+ p->sp = (SCM *) (vp->stack_limit - vp->sp);
+ p->fp = (SCM *) (vp->stack_limit - vp->fp);
+ memcpy (p->stack_base, vp->sp + 1, vp->stack_size * sizeof (SCM));
SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
}
static void
-reinstate_vm_cont (struct scm_vm *vmp, SCM cont)
+reinstate_vm_cont (struct scm_vm *vp, SCM cont)
{
- struct scm_vm *p = SCM_VM_CONT_VMP (cont);
- if (vmp->stack_size < p->stack_size)
+ struct scm_vm *p = SCM_VM_CONT_VP (cont);
+ if (vp->stack_size < p->stack_size)
{
/* puts ("FIXME: Need to expand"); */
abort ();
}
- vmp->ip = p->ip;
- vmp->sp = vmp->stack_limit - (int) p->sp;
- vmp->fp = vmp->stack_limit - (int) p->fp;
- memcpy (vmp->sp + 1, p->stack_base, p->stack_size * sizeof (SCM));
+ vp->ip = p->ip;
+ vp->sp = vp->stack_limit - (int) p->sp;
+ vp->fp = vp->stack_limit - (int) p->fp;
+ memcpy (vp->sp + 1, p->stack_base, p->stack_size * sizeof (SCM));
}
static SCM
vm_cont_mark (SCM obj)
{
SCM *p;
- struct scm_vm *vmp = SCM_VM_CONT_VMP (obj);
- for (p = vmp->stack_base; p <= vmp->stack_limit; p++)
+ struct scm_vm *vp = SCM_VM_CONT_VP (obj);
+ for (p = vp->stack_base; p <= vp->stack_limit; p++)
if (SCM_NIMP (*p))
scm_gc_mark (*p);
return SCM_BOOL_F;
static scm_sizet
vm_cont_free (SCM obj)
{
- struct scm_vm *p = SCM_VM_CONT_VMP (obj);
+ struct scm_vm *p = SCM_VM_CONT_VP (obj);
int size = sizeof (struct scm_vm) + p->stack_size * sizeof (SCM);
scm_must_free (p->stack_base);
scm_must_free (p);
#define FUNC_NAME "make_vm"
{
int i;
- struct scm_vm *vmp = SCM_MUST_MALLOC (sizeof (struct scm_vm));
- vmp->stack_size = VM_DEFAULT_STACK_SIZE;
- vmp->stack_base = SCM_MUST_MALLOC (vmp->stack_size * sizeof (SCM));
- vmp->stack_limit = vmp->stack_base + vmp->stack_size - 1;
- vmp->ip = NULL;
- vmp->sp = vmp->stack_limit;
- vmp->fp = NULL;
- vmp->cons = 0;
- vmp->time = 0;
- vmp->clock = 0;
- vmp->options = SCM_EOL;
+ struct scm_vm *vp = SCM_MUST_MALLOC (sizeof (struct scm_vm));
+ vp->stack_size = VM_DEFAULT_STACK_SIZE;
+ vp->stack_base = SCM_MUST_MALLOC (vp->stack_size * sizeof (SCM));
+ vp->stack_limit = vp->stack_base + vp->stack_size - 1;
+ vp->ip = NULL;
+ vp->sp = vp->stack_limit;
+ vp->fp = NULL;
+ vp->cons = 0;
+ vp->time = 0;
+ vp->clock = 0;
+ vp->options = SCM_EOL;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
- vmp->hooks[i] = SCM_BOOL_F;
- SCM_RETURN_NEWSMOB (scm_tc16_vm, vmp);
+ vp->hooks[i] = SCM_BOOL_F;
+ SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
}
#undef FUNC_NAME
{
int i;
SCM *sp, *fp;
- struct scm_vm *vmp = SCM_VM_DATA (obj);
+ struct scm_vm *vp = SCM_VM_DATA (obj);
/* Mark the stack */
- sp = vmp->sp;
- fp = vmp->fp;
+ sp = vp->sp;
+ fp = vp->fp;
while (fp)
{
SCM *upper = SCM_VM_FRAME_UPPER_ADDRESS (fp);
/* Mark the options */
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
- scm_gc_mark (vmp->hooks[i]);
- return vmp->options;
+ scm_gc_mark (vp->hooks[i]);
+ return vp->options;
}
static scm_sizet
vm_free (SCM obj)
{
- struct scm_vm *vmp = SCM_VM_DATA (obj);
- int size = (sizeof (struct scm_vm) + vmp->stack_size * sizeof (SCM));
- scm_must_free (vmp->stack_base);
- scm_must_free (vmp);
+ struct scm_vm *vp = SCM_VM_DATA (obj);
+ int size = (sizeof (struct scm_vm) + vp->stack_size * sizeof (SCM));
+ scm_must_free (vp->stack_base);
+ scm_must_free (vp);
return size;
}
#define VM_DEFINE_HOOK(n) \
{ \
- struct scm_vm *vmp; \
+ struct scm_vm *vp; \
SCM_VALIDATE_VM (1, vm); \
- vmp = SCM_VM_DATA (vm); \
- if (SCM_FALSEP (vmp->hooks[n])) \
- vmp->hooks[n] = scm_make_hook (SCM_MAKINUM (1)); \
- return vmp->hooks[n]; \
+ vp = SCM_VM_DATA (vm); \
+ if (SCM_FALSEP (vp->hooks[n])) \
+ vp->hooks[n] = scm_make_hook (SCM_MAKINUM (1)); \
+ return vp->hooks[n]; \
}
SCM_DEFINE (scm_vm_boot_hook, "vm-boot-hook", 1, 0, 0,
*/
/*
- | | <- fp + bp->nargs + bp->nlocs
- +------------------+
+ | | <- fp + bp->nlocs + bp->nargs
+ +------------------+ = SCM_VM_FRAME_UPPER_ADDRESS (fp)
| Argument 1 |
- | Argument 2 |
+ | Argument 2 | <- fp + bp->nlocs
| Local variable 1 |
| Local varialbe 2 | <- fp
| Program |
| Dynamic link |
| Return address | <- fp - SCM_VM_FRAME_DATA_SIZE
- +------------------+
+ +------------------+ = SCM_VM_FRAME_LOWER_ADDRESS (fp)
| |
*/
register SCM *fp FP_REG; /* frame pointer */
/* Cache variables */
- struct scm_vm *vmp = SCM_VM_DATA (vm);/* VM data pointer */
+ struct scm_vm *vp = SCM_VM_DATA (vm); /* VM data pointer */
struct scm_program *bp = NULL; /* program base pointer */
SCM external; /* external environment */
SCM *objects = NULL; /* constant objects */
- SCM *stack_base = vmp->stack_base; /* stack base address */
- SCM *stack_limit = vmp->stack_limit; /* stack limit address */
+ SCM *stack_base = vp->stack_base; /* stack base address */
+ SCM *stack_limit = vp->stack_limit; /* stack limit address */
/* Internal variables */
int nargs = 0;
- long run_time = scm_c_get_internal_run_time ();
+ long start_time = scm_c_get_internal_run_time ();
// SCM dynwinds = SCM_EOL;
SCM err_msg;
SCM err_args;
};
#endif
- /* Bootcode */
- scm_byte_t code[3] = {scm_op_call, 0, scm_op_halt};
- SCM bootcode = scm_c_make_program (code, 3, SCM_BOOL_T);
- code[1] = scm_ilength (args);
-
- /* Initial frame */
- bp = SCM_PROGRAM_DATA (bootcode);
- CACHE ();
- NEW_FRAME ();
-
- /* Initial arguments */
- for (; !SCM_NULLP (args); args = SCM_CDR (args))
- PUSH (SCM_CAR (args));
- PUSH (program);
+ /* Initialization */
+ {
+ /* Bootcode */
+ scm_byte_t bytes[3] = {scm_op_call, 0, scm_op_halt};
+ SCM bootcode = scm_c_make_program (bytes, 3, SCM_BOOL_T);
+ bytes[1] = scm_ilength (args);
+
+ /* Initial frame */
+ CACHE_REGISTER ();
+ CACHE_PROGRAM (bootcode);
+ NEW_FRAME ();
+
+ /* Initial arguments */
+ for (; !SCM_NULLP (args); args = SCM_CDR (args))
+ PUSH (SCM_CAR (args));
+ PUSH (program);
+ }
/* Let's go! */
BOOT_HOOK ();
/* This file is included in vm_engine.c */
/*
- * VM Options
+ * Options
*/
-#define VM_OPTION(regular,debug) debug
-
-#define VM_USE_HOOKS VM_OPTION (0, 1) /* Various hooks */
-#define VM_USE_CLOCK VM_OPTION (0, 1) /* Bogos clock */
-#define VM_CHECK_IP VM_OPTION (0, 0) /* Check IP */
+#define VM_USE_HOOKS 1 /* Various hooks */
+#define VM_USE_CLOCK 1 /* Bogoclock */
\f
/*
\f
/*
- * Hooks
+ * Cache/Sync
*/
-#undef RUN_HOOK
-#if VM_USE_HOOKS
-#define RUN_HOOK(h) \
+#define CACHE_REGISTER() \
{ \
- if (!SCM_FALSEP (h)) \
- { \
- SYNC (); \
- scm_c_run_hook (h, hook_args); \
- } \
+ ip = vp->ip; \
+ sp = vp->sp; \
+ fp = vp->fp; \
}
-#else
-#define RUN_HOOK(h)
-#endif
-
-#define BOOT_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_BOOT_HOOK])
-#define HALT_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_HALT_HOOK])
-#define NEXT_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_NEXT_HOOK])
-#define ENTER_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_ENTER_HOOK])
-#define APPLY_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_APPLY_HOOK])
-#define EXIT_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_EXIT_HOOK])
-#define RETURN_HOOK() RUN_HOOK (vmp->hooks[SCM_VM_RETURN_HOOK])
-\f
-/*
- * Basic operations
- */
-
-#define CACHE() \
+#define SYNC_REGISTER() \
{ \
- ip = vmp->ip; \
- sp = vmp->sp; \
- fp = vmp->fp; \
+ vp->ip = ip; \
+ vp->sp = sp; \
+ vp->fp = fp; \
}
-#define SYNC() \
+#define CACHE_PROGRAM(program) \
{ \
- vmp->ip = ip; \
- vmp->sp = sp; \
- vmp->fp = fp; \
+ bp = SCM_PROGRAM_DATA (program); \
+ objects = SCM_VELTS (bp->objs); \
+ external = bp->external; \
}
-#define SYNC_TIME() \
-{ \
- long cur_time = scm_c_get_internal_run_time (); \
- vmp->time += cur_time - run_time; \
- run_time = cur_time; \
+#define SYNC_BEFORE_GC() \
+{ \
+ SYNC_REGISTER (); \
}
#define SYNC_ALL() \
{ \
- SYNC (); \
- SYNC_TIME (); \
+ SYNC_REGISTER (); \
}
\f
+/*
+ * Hooks
+ */
+
+#undef RUN_HOOK
+#if VM_USE_HOOKS
+#define RUN_HOOK(h) \
+{ \
+ if (!SCM_FALSEP (h)) \
+ { \
+ SYNC_BEFORE_GC (); \
+ scm_c_run_hook (h, hook_args); \
+ } \
+}
+#else
+#define RUN_HOOK(h)
+#endif
+
+#define BOOT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_BOOT_HOOK])
+#define HALT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_HALT_HOOK])
+#define NEXT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_NEXT_HOOK])
+#define ENTER_HOOK() RUN_HOOK (vp->hooks[SCM_VM_ENTER_HOOK])
+#define APPLY_HOOK() RUN_HOOK (vp->hooks[SCM_VM_APPLY_HOOK])
+#define EXIT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_EXIT_HOOK])
+#define RETURN_HOOK() RUN_HOOK (vp->hooks[SCM_VM_RETURN_HOOK])
+
+\f
/*
* Stack operation
*/
#define CONS(x,y,z) \
{ \
SCM cell; \
- SYNC () \
+ SYNC_BEFORE_GC (); \
SCM_NEWCELL (cell); \
SCM_SET_CELL_OBJECT_0 (cell, y); \
SCM_SET_CELL_OBJECT_1 (cell, z); \
#undef CLOCK
#if VM_USE_CLOCK
-#define CLOCK(n) vmp->clock += n
+#define CLOCK(n) vp->clock += n
#else
#define CLOCK(n)
#endif
-#undef NEXT_CHECK
-#if VM_CHECK_IP
-#define NEXT_CHECK() \
-{ \
- scm_byte_t *base = bp->base; \
- if (ip < base || ip >= base + bp->size) \
- goto vm_error_invalid_address; \
-}
-#else
-#define NEXT_CHECK()
-#endif
-
#undef NEXT_JUMP
#ifdef HAVE_LABELS_AS_VALUES
#define NEXT_JUMP() goto *jump_table[FETCH ()]
#define NEXT \
{ \
CLOCK (1); \
- NEXT_CHECK (); \
NEXT_HOOK (); \
NEXT_JUMP (); \
}
} \
}
-#define INIT_VARIABLES() \
-{ \
- int i; \
- for (i = 0; i < bp->nlocs; i++) \
- SCM_VM_FRAME_VARIABLE (fp, i) = SCM_UNDEFINED; \
-}
-
-#define CACHE_PROGRAM() \
- bp = SCM_PROGRAM_DATA (program); \
- objects = SCM_VELTS (bp->objs); \
- external = bp->external;
-
/*
Local Variables:
c-file-style: "gnu"
if (SCM_INUMP (x))
{
int i = SCM_INUM (x);
- SCM_PROGRAM_NARGS (prog) = i >> 5; /* 6-5 bits */
- SCM_PROGRAM_NREST (prog) = (i >> 4) & 1; /* 4 bit */
- SCM_PROGRAM_NLOCS (prog) = i & 15; /* 3-0 bits */
+ if (-128 <= i && i <= 127)
+ {
+ /* 8-bit representation */
+ SCM_PROGRAM_NARGS (prog) = (i >> 6) & 0x03; /* 7-6 bits */
+ SCM_PROGRAM_NREST (prog) = (i >> 5) & 0x01; /* 5 bit */
+ SCM_PROGRAM_NLOCS (prog) = (i >> 2) & 0x07; /* 4-2 bits */
+ SCM_PROGRAM_NEXTS (prog) = i & 0x03; /* 1-0 bits */
+ }
+ else
+ {
+ /* 16-bit representation */
+ SCM_PROGRAM_NARGS (prog) = (i >> 12) & 0x07; /* 15-12 bits */
+ SCM_PROGRAM_NREST (prog) = (i >> 11) & 0x01; /* 11 bit */
+ SCM_PROGRAM_NLOCS (prog) = (i >> 4) & 0x7f; /* 10-4 bits */
+ SCM_PROGRAM_NEXTS (prog) = i & 0x07; /* 3-0 bits */
+ }
}
else
{
- SCM_PROGRAM_NARGS (prog) = SCM_INUM (sp[3]);
- SCM_PROGRAM_NREST (prog) = SCM_INUM (sp[2]);
- SCM_PROGRAM_NLOCS (prog) = SCM_INUM (sp[1]);
- sp += 3;
+ /* Other cases */
+ SCM_PROGRAM_NARGS (prog) = SCM_INUM (sp[4]);
+ SCM_PROGRAM_NREST (prog) = SCM_INUM (sp[3]);
+ SCM_PROGRAM_NLOCS (prog) = SCM_INUM (sp[2]);
+ SCM_PROGRAM_NEXTS (prog) = SCM_INUM (sp[1]);
+ sp += 4;
}
*sp = prog;
VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
{
SCM ret = *sp;
+ vp->time += scm_c_get_internal_run_time () - start_time;
HALT_HOOK ();
FREE_FRAME ();
SYNC_ALL ();
#define VARIABLE_REF(v) SCM_CDR (v)
#define VARIABLE_SET(v,o) SCM_SETCDR (v, o)
-VM_DEFINE_INSTRUCTION (external, "external", 1, 0, 0)
-{
- int n = FETCH ();
- while (n-- > 0)
- CONS (external, SCM_UNDEFINED, external);
- NEXT;
-}
-
/* ref */
VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1)
VM_DEFINE_INSTRUCTION (make_closure, "make-closure", 0, 1, 1)
{
- SYNC ();
- *sp = scm_c_make_vclosure (*sp, external);
+ SYNC_BEFORE_GC ();
+ *sp = scm_c_make_closure (*sp, external);
NEXT;
}
*/
if (SCM_PROGRAM_P (program))
{
- CACHE_PROGRAM ();
+ int i;
+ vm_call_program:
+ CACHE_PROGRAM (program);
INIT_ARGS ();
NEW_FRAME ();
- INIT_VARIABLES ();
+
+ /* Init local variables */
+ for (i = 0; i < bp->nlocs; i++)
+ LOCAL_SET (i, SCM_UNDEFINED);
+
+ /* Create external variables */
+ for (i = 0; i < bp->nexts; i++)
+ CONS (external, SCM_UNDEFINED, external);
+
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
/* Reinstate the continuation */
EXIT_HOOK ();
- reinstate_vm_cont (vmp, program);
- CACHE ();
+ reinstate_vm_cont (vp, program);
+ CACHE_REGISTER ();
/* We don't need to set the return value here
because it is already on the top of the stack. */
NEXT;
if (SCM_PROGRAM_P (program))
{
int i;
- int n = SCM_VM_FRAME_LOWER_ADDRESS (fp) - sp;
SCM *base = sp;
/* Exit the current frame */
FREE_FRAME ();
/* Move arguments */
- sp -= n;
- for (i = 0; i < n; i++)
+ sp -= nargs;
+ for (i = 0; i < nargs; i++)
sp[i] = base[i];
/* Call the program */
- goto vm_call;
+ goto vm_call_program;
}
/*
* Function call
VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1)
{
- SYNC ();
- PUSH (capture_vm_cont (vmp));
+ SYNC_BEFORE_GC ();
+ PUSH (capture_vm_cont (vp));
POP (program);
nargs = 1;
goto vm_call;
/* Cache the last program */
program = SCM_VM_FRAME_PROGRAM (fp);
- CACHE_PROGRAM ();
+ CACHE_PROGRAM (program);
PUSH (ret);
NEXT;
}
HCoop / bpt / guile.git / commitdiff