/* This file is included in vm.c multiple times. */
-#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
-# define VM_USE_HOOKS 0 /* Various hooks */
-#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
-# define VM_USE_HOOKS 1
-#else
-# error unknown debug engine VM_ENGINE
-#endif
+#define UNPACK_8_8_8(op,a,b,c) \
+ do \
+ { \
+ a = (op >> 8) & 0xff; \
+ b = (op >> 16) & 0xff; \
+ c = op >> 24; \
+ } \
+ while (0)
+
+#define UNPACK_8_16(op,a,b) \
+ do \
+ { \
+ a = (op >> 8) & 0xff; \
+ b = op >> 16; \
+ } \
+ while (0)
+
+#define UNPACK_16_8(op,a,b) \
+ do \
+ { \
+ a = (op >> 8) & 0xffff; \
+ b = op >> 24; \
+ } \
+ while (0)
+
+#define UNPACK_12_12(op,a,b) \
+ do \
+ { \
+ a = (op >> 8) & 0xfff; \
+ b = op >> 20; \
+ } \
+ while (0)
+
+#define UNPACK_24(op,a) \
+ do \
+ { \
+ a = op >> 8; \
+ } \
+ while (0)
+
/* Assign some registers by hand. There used to be a bigger list here,
but it was never tested, and in the case of x86-32, was a source of
# define JT_REG
#endif
-#define VM_ASSERT(condition, handler) \
- do { \
- if (SCM_UNLIKELY (!(condition))) \
- { \
- SYNC_ALL(); \
- handler; \
- } \
+#define VM_ASSERT(condition, handler) \
+ do { \
+ if (SCM_UNLIKELY (!(condition))) \
+ { \
+ SYNC_ALL(); \
+ handler; \
+ } \
} while (0)
#ifdef VM_ENABLE_ASSERTIONS
#endif
#if VM_USE_HOOKS
-#define RUN_HOOK(h, args, n) \
+#define RUN_HOOK(exp) \
do { \
if (SCM_UNLIKELY (vp->trace_level > 0)) \
{ \
SYNC_REGISTER (); \
- vm_dispatch_hook (vm, h, args, n); \
+ exp; \
} \
} while (0)
#else
-#define RUN_HOOK(h, args, n)
+#define RUN_HOOK(exp)
#endif
-#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0)
+#define RUN_HOOK0(h) RUN_HOOK (vm_dispatch_##h##_hook (vp))
+#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vp, arg))
#define APPLY_HOOK() \
- RUN_HOOK0 (SCM_VM_APPLY_HOOK)
+ RUN_HOOK0 (apply)
#define PUSH_CONTINUATION_HOOK() \
- RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
-#define POP_CONTINUATION_HOOK(vals, n) \
- RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n)
+ RUN_HOOK0 (push_continuation)
+#define POP_CONTINUATION_HOOK(old_fp) \
+ RUN_HOOK1 (pop_continuation, old_fp)
#define NEXT_HOOK() \
- RUN_HOOK0 (SCM_VM_NEXT_HOOK)
-#define ABORT_CONTINUATION_HOOK(vals, n) \
- RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n)
-#define RESTORE_CONTINUATION_HOOK() \
- RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
+ RUN_HOOK0 (next)
+#define ABORT_CONTINUATION_HOOK() \
+ RUN_HOOK0 (abort)
+#define RESTORE_CONTINUATION_HOOK() \
+ RUN_HOOK0 (restore_continuation)
#define VM_HANDLE_INTERRUPTS \
SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
exception. */
#define SYNC_IP() \
- vp->ip = (scm_t_uint8 *) (ip)
+ vp->ip = (ip)
#define SYNC_REGISTER() \
SYNC_IP()
#define SYNC_ALL() /* FP already saved */ \
SYNC_IP()
-#define CHECK_OVERFLOW(sp) \
- do { \
- if (SCM_UNLIKELY ((sp) >= stack_limit)) \
- vm_error_stack_overflow (vp); \
+/* After advancing vp->sp, but before writing any stack slots, check
+ that it is actually in bounds. If it is not in bounds, currently we
+ signal an error. In the future we may expand the stack instead,
+ possibly by moving it elsewhere, therefore no pointer into the stack
+ besides FP is valid across a CHECK_OVERFLOW call. Be careful! */
+#define CHECK_OVERFLOW() \
+ do { \
+ if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
+ { \
+ vm_error_stack_overflow (vp); \
+ CACHE_REGISTER(); \
+ } \
} while (0)
/* Reserve stack space for a frame. Will check that there is sufficient
- stack space for N locals, including the procedure, in addition to
- 2 words to set up the next frame. Invoke after preparing the new
- frame and setting the fp and ip. */
+ stack space for N locals, including the procedure. Invoke after
+ preparing the new frame and setting the fp and ip. */
#define ALLOC_FRAME(n) \
do { \
- SCM *new_sp = vp->sp = fp - 1 + n - 1; \
- CHECK_OVERFLOW (new_sp + 3); \
+ vp->sp = LOCAL_ADDRESS (n - 1); \
+ CHECK_OVERFLOW (); \
} while (0)
/* Reset the current frame to hold N locals. Used when we know that no
stack expansion is needed. */
#define RESET_FRAME(n) \
do { \
- vp->sp = fp - 2 + n; \
+ vp->sp = LOCAL_ADDRESS (n - 1); \
} while (0)
-/* Compute the number of locals in the frame. This is equal to the
- number of actual arguments when a function is first called, plus
- one for the function. */
-#define FRAME_LOCALS_COUNT() \
- (vp->sp + 1 - (fp - 1))
+/* Compute the number of locals in the frame. At a call, this is equal
+ to the number of actual arguments when a function is first called,
+ plus one for the function. */
+#define FRAME_LOCALS_COUNT_FROM(slot) \
+ (vp->sp + 1 - LOCAL_ADDRESS (slot))
+#define FRAME_LOCALS_COUNT() \
+ FRAME_LOCALS_COUNT_FROM (0)
/* Restore registers after returning from a frame. */
#define RESTORE_FRAME() \
case opcode:
#endif
-#define LOCAL_REF(i) SCM_FRAME_VARIABLE ((fp - 1), i)
-#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE ((fp - 1), i) = o
+#define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
+#define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
+#define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define RETURN_ONE_VALUE(ret) \
do { \
SCM val = ret; \
- SCM *sp = SCM_FRAME_LOWER_ADDRESS (fp); \
+ SCM *old_fp = fp; \
VM_HANDLE_INTERRUPTS; \
- ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \
+ ip = SCM_FRAME_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \
- sp[0] = SCM_BOOL_F; \
- sp[1] = SCM_BOOL_F; \
+ old_fp[-1] = SCM_BOOL_F; \
+ old_fp[-2] = SCM_BOOL_F; \
/* Leave proc. */ \
- sp[3] = val; \
- vp->sp = sp + 3; \
- POP_CONTINUATION_HOOK (sp, 1); \
+ SCM_FRAME_LOCAL (old_fp, 1) = val; \
+ vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
+ POP_CONTINUATION_HOOK (old_fp); \
NEXT (0); \
} while (0)
do { \
SCM vals = vals_; \
VM_HANDLE_INTERRUPTS; \
- fp[-1] = vm_builtin_apply; \
- fp[0] = vm_builtin_values; \
- fp[1] = vals; \
+ fp[0] = vm_builtin_apply; \
+ fp[1] = vm_builtin_values; \
+ fp[2] = vals; \
RESET_FRAME (3); \
ip = (scm_t_uint32 *) vm_builtin_apply_code; \
goto op_tail_apply; \
#define BR_NARGS(rel) \
scm_t_uint32 expected; \
- SCM_UNPACK_RTL_24 (op, expected); \
+ UNPACK_24 (op, expected); \
if (FRAME_LOCALS_COUNT() rel expected) \
{ \
scm_t_int32 offset = ip[1]; \
#define BR_UNARY(x, exp) \
scm_t_uint32 test; \
SCM x; \
- SCM_UNPACK_RTL_24 (op, test); \
+ UNPACK_24 (op, test); \
x = LOCAL_REF (test); \
if ((ip[1] & 0x1) ? !(exp) : (exp)) \
{ \
#define BR_BINARY(x, y, exp) \
scm_t_uint16 a, b; \
SCM x, y; \
- SCM_UNPACK_RTL_12_12 (op, a, b); \
+ UNPACK_12_12 (op, a, b); \
x = LOCAL_REF (a); \
y = LOCAL_REF (b); \
if ((ip[1] & 0x1) ? !(exp) : (exp)) \
{ \
scm_t_uint16 a, b; \
SCM x, y; \
- SCM_UNPACK_RTL_12_12 (op, a, b); \
+ UNPACK_12_12 (op, a, b); \
x = LOCAL_REF (a); \
y = LOCAL_REF (b); \
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
#define ARGS1(a1) \
scm_t_uint16 dst, src; \
SCM a1; \
- SCM_UNPACK_RTL_12_12 (op, dst, src); \
+ UNPACK_12_12 (op, dst, src); \
a1 = LOCAL_REF (src)
#define ARGS2(a1, a2) \
scm_t_uint8 dst, src1, src2; \
SCM a1, a2; \
- SCM_UNPACK_RTL_8_8_8 (op, dst, src1, src2); \
+ UNPACK_8_8_8 (op, dst, src1, src2); \
a1 = LOCAL_REF (src1); \
a2 = LOCAL_REF (src2)
#define RETURN(x) \
((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
static SCM
-RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
+VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, size_t nargs_)
{
/* Instruction pointer: A pointer to the opcode that is currently
running. */
register scm_t_uint32 op;
/* Cached variables. */
- struct scm_vm *vp = SCM_VM_DATA (vm);
- SCM *stack_limit = vp->stack_limit; /* stack limit address */
scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
scm_i_jmp_buf registers; /* used for prompts */
to pull all our state back from the ip/fp/sp.
*/
CACHE_REGISTER ();
- ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1);
+ ABORT_CONTINUATION_HOOK ();
NEXT (0);
}
/* Initialization */
{
SCM *base;
+ ptrdiff_t base_frame_size;
/* Check that we have enough space: 3 words for the boot
continuation, 3 + nargs for the procedure application, and 3 for
setting up a new frame. */
- base = vp->sp + 1;
- CHECK_OVERFLOW (vp->sp + 3 + 3 + nargs_ + 3);
+ base_frame_size = 3 + 3 + nargs_ + 3;
+ vp->sp += base_frame_size;
+ CHECK_OVERFLOW ();
+ base = vp->sp + 1 - base_frame_size;
/* Since it's possible to receive the arguments on the stack itself,
and indeed the regular VM invokes us that way, shuffle up the
continuation. */
base[0] = SCM_PACK (fp); /* dynamic link */
base[1] = SCM_PACK (ip); /* ra */
- base[2] = rtl_boot_continuation;
- fp = &base[3];
- ip = (scm_t_uint32 *) rtl_boot_continuation_code;
+ base[2] = vm_boot_continuation;
+ fp = &base[2];
+ ip = (scm_t_uint32 *) vm_boot_continuation_code;
/* MV-call frame, function & arguments */
base[3] = SCM_PACK (fp); /* dynamic link */
base[4] = SCM_PACK (ip); /* ra */
base[5] = program;
- fp = vp->fp = &base[6];
+ fp = vp->fp = &base[5];
RESET_FRAME (nargs_ + 1);
}
apply:
- while (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
+ while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
{
SCM proc = SCM_FRAME_PROGRAM (fp);
if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
{
- fp[-1] = SCM_STRUCT_PROCEDURE (proc);
+ LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
continue;
}
if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
}
/* Let's go! */
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
BEGIN_DISPATCH_SWITCH;
*/
VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
{
- scm_t_uint32 nvals = FRAME_LOCALS_COUNT() - 4;
- SCM ret;
-
/* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
+ scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
+ SCM ret;
+
if (nvals == 1)
ret = LOCAL_REF (4);
else
}
vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
- vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+ vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
return ret;
scm_t_uint32 proc, nlocals;
SCM *old_fp = fp;
- SCM_UNPACK_RTL_24 (op, proc);
- SCM_UNPACK_RTL_24 (ip[1], nlocals);
+ UNPACK_24 (op, proc);
+ UNPACK_24 (ip[1], nlocals);
VM_HANDLE_INTERRUPTS;
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
- SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 2);
+ SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
RESET_FRAME (nlocals);
PUSH_CONTINUATION_HOOK ();
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
{
scm_t_uint32 nlocals;
- SCM_UNPACK_RTL_24 (op, nlocals);
+ UNPACK_24 (op, nlocals);
VM_HANDLE_INTERRUPTS;
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
{
scm_t_uint32 n, from, nlocals;
- SCM_UNPACK_RTL_24 (op, from);
+ UNPACK_24 (op, from);
VM_HANDLE_INTERRUPTS;
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
{
scm_t_uint16 dst, proc;
scm_t_uint32 nlocals;
- SCM_UNPACK_RTL_12_12 (op, dst, proc);
- SCM_UNPACK_RTL_24 (ip[1], nlocals);
+ UNPACK_12_12 (op, dst, proc);
+ UNPACK_24 (ip[1], nlocals);
VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ());
LOCAL_SET (dst, LOCAL_REF (proc + 1));
RESET_FRAME (nlocals);
VM_DEFINE_OP (5, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
{
scm_t_uint32 proc, nvalues;
- SCM_UNPACK_RTL_24 (op, proc);
- SCM_UNPACK_RTL_24 (ip[1], nvalues);
+ UNPACK_24 (op, proc);
+ UNPACK_24 (ip[1], nvalues);
if (ip[1] & 0x1)
VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
vm_error_not_enough_values ());
VM_DEFINE_OP (6, return, "return", OP1 (U8_U24))
{
scm_t_uint32 src;
- SCM_UNPACK_RTL_24 (op, src);
+ UNPACK_24 (op, src);
RETURN_ONE_VALUE (LOCAL_REF (src));
}
*/
VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
{
- scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT();
- SCM *base = fp;
+ SCM *old_fp = fp;
VM_HANDLE_INTERRUPTS;
- ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp);
+ ip = SCM_FRAME_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Clear stack frame. */
- base[-2] = SCM_BOOL_F;
- base[-3] = SCM_BOOL_F;
+ old_fp[-1] = SCM_BOOL_F;
+ old_fp[-2] = SCM_BOOL_F;
- POP_CONTINUATION_HOOK (base, nvalues);
+ POP_CONTINUATION_HOOK (old_fp);
NEXT (0);
}
SCM pointer, ret;
SCM (*subr)();
- SCM_UNPACK_RTL_24 (op, ptr_idx);
+ UNPACK_24 (op, ptr_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
subr = SCM_POINTER_VALUE (pointer);
VM_HANDLE_INTERRUPTS;
SYNC_IP ();
- switch (FRAME_LOCALS_COUNT () - 1)
+ switch (FRAME_LOCALS_COUNT_FROM (1))
{
case 0:
ret = subr ();
break;
case 1:
- ret = subr (fp[0]);
+ ret = subr (fp[1]);
break;
case 2:
- ret = subr (fp[0], fp[1]);
+ ret = subr (fp[1], fp[2]);
break;
case 3:
- ret = subr (fp[0], fp[1], fp[2]);
+ ret = subr (fp[1], fp[2], fp[3]);
break;
case 4:
- ret = subr (fp[0], fp[1], fp[2], fp[3]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4]);
break;
case 5:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
break;
case 6:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
break;
case 7:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
break;
case 8:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
break;
case 9:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
break;
case 10:
- ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
+ ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9], fp[10]);
break;
default:
abort ();
scm_t_uint16 cif_idx, ptr_idx;
SCM closure, cif, pointer, ret;
- SCM_UNPACK_RTL_12_12 (op, cif_idx, ptr_idx);
+ UNPACK_12_12 (op, cif_idx, ptr_idx);
closure = LOCAL_REF (0);
- cif = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
+ cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
SYNC_IP ();
VM_HANDLE_INTERRUPTS;
// FIXME: separate args
- ret = scm_i_foreign_call (scm_cons (cif, pointer), fp);
+ ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
// NULLSTACK_FOR_NONLOCAL_EXIT ();
SCM contregs;
scm_t_uint32 contregs_idx;
- SCM_UNPACK_RTL_24 (op, contregs_idx);
+ UNPACK_24 (op, contregs_idx);
contregs =
- SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
+ SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
SYNC_IP ();
scm_i_check_continuation (contregs);
- vm_return_to_continuation (scm_i_contregs_vm (contregs),
+ vm_return_to_continuation (scm_i_contregs_vp (contregs),
scm_i_contregs_vm_cont (contregs),
- FRAME_LOCALS_COUNT () - 1, fp);
+ FRAME_LOCALS_COUNT_FROM (1),
+ LOCAL_ADDRESS (1));
scm_i_reinstate_continuation (contregs);
/* no NEXT */
SCM vmcont;
scm_t_uint32 cont_idx;
- SCM_UNPACK_RTL_24 (op, cont_idx);
- vmcont = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
+ UNPACK_24 (op, cont_idx);
+ vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
SYNC_IP ();
VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
vm_error_continuation_not_rewindable (vmcont));
- vm_reinstate_partial_continuation (vm, vmcont, FRAME_LOCALS_COUNT () - 1, fp,
+ vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
+ LOCAL_ADDRESS (1),
¤t_thread->dynstack,
®isters);
CACHE_REGISTER ();
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
dynstack = scm_dynstack_capture_all (¤t_thread->dynstack);
vm_cont = scm_i_vm_capture_stack (vp->stack_base,
SCM_FRAME_DYNAMIC_LINK (fp),
- SCM_FRAME_LOWER_ADDRESS (fp) - 1,
+ SCM_FRAME_PREVIOUS_SP (fp),
SCM_FRAME_RETURN_ADDRESS (fp),
dynstack,
0);
copying out to the heap; and likewise, the setjmp(®isters)
code already has the non-local return handler. But oh
well! */
- cont = scm_i_make_continuation (&first, vm, vm_cont);
+ cont = scm_i_make_continuation (&first, vp, vm_cont);
if (first)
{
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
else
{
CACHE_REGISTER ();
- ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1);
+ ABORT_CONTINUATION_HOOK ();
NEXT (0);
}
}
it continues with the next instruction. */
ip++;
SYNC_IP ();
- vm_abort (vm, LOCAL_REF (1), nlocals - 2, &LOCAL_REF (2),
- SCM_EOL, &LOCAL_REF (0), ®isters);
+ vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
+ SCM_EOL, LOCAL_ADDRESS (0), ®isters);
/* vm_abort should not return */
abort ();
{
scm_t_uint16 dst, idx;
- SCM_UNPACK_RTL_12_12 (op, dst, idx);
+ UNPACK_12_12 (op, dst, idx);
LOCAL_SET (dst, scm_vm_builtin_ref (idx));
NEXT (1);
VM_DEFINE_OP (19, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
{
scm_t_uint32 expected;
- SCM_UNPACK_RTL_24 (op, expected);
+ UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
NEXT (1);
VM_DEFINE_OP (20, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
{
scm_t_uint32 expected;
- SCM_UNPACK_RTL_24 (op, expected);
+ UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
NEXT (1);
VM_DEFINE_OP (21, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
{
scm_t_uint32 expected;
- SCM_UNPACK_RTL_24 (op, expected);
+ UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
NEXT (1);
VM_DEFINE_OP (22, alloc_frame, "alloc-frame", OP1 (U8_U24))
{
scm_t_uint32 nlocals, nargs;
- SCM_UNPACK_RTL_24 (op, nlocals);
+ UNPACK_24 (op, nlocals);
nargs = FRAME_LOCALS_COUNT ();
ALLOC_FRAME (nlocals);
VM_DEFINE_OP (23, reset_frame, "reset-frame", OP1 (U8_U24))
{
scm_t_uint32 nlocals;
- SCM_UNPACK_RTL_24 (op, nlocals);
+ UNPACK_24 (op, nlocals);
RESET_FRAME (nlocals);
NEXT (1);
}
VM_DEFINE_OP (24, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
{
scm_t_uint16 expected, nlocals;
- SCM_UNPACK_RTL_12_12 (op, expected, nlocals);
+ UNPACK_12_12 (op, expected, nlocals);
VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
ALLOC_FRAME (expected + nlocals);
{
scm_t_uint32 nreq, npos;
- SCM_UNPACK_RTL_24 (op, nreq);
- SCM_UNPACK_RTL_24 (ip[1], npos);
+ UNPACK_24 (op, nreq);
+ UNPACK_24 (ip[1], npos);
/* We can only have too many positionals if there are more
arguments than NPOS. */
SCM kw;
char allow_other_keys, has_rest;
- SCM_UNPACK_RTL_24 (op, nreq);
+ UNPACK_24 (op, nreq);
allow_other_keys = ip[1] & 0x1;
has_rest = ip[1] & 0x2;
- SCM_UNPACK_RTL_24 (ip[1], nreq_and_opt);
- SCM_UNPACK_RTL_24 (ip[2], ntotal);
+ UNPACK_24 (ip[1], nreq_and_opt);
+ UNPACK_24 (ip[2], ntotal);
kw_offset = ip[3];
kw_bits = (scm_t_bits) (ip + kw_offset);
VM_ASSERT (!(kw_bits & 0x7), abort());
scm_t_uint32 dst, nargs;
SCM rest = SCM_EOL;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
nargs = FRAME_LOCALS_COUNT ();
if (nargs <= dst)
scm_t_uint16 dst;
scm_t_uint16 src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
LOCAL_SET (dst, LOCAL_REF (src));
NEXT (1);
scm_t_uint32 dst;
scm_t_uint32 src;
- SCM_UNPACK_RTL_24 (op, dst);
- SCM_UNPACK_RTL_24 (ip[1], src);
+ UNPACK_24 (op, dst);
+ UNPACK_24 (ip[1], src);
LOCAL_SET (dst, LOCAL_REF (src));
NEXT (2);
VM_DEFINE_OP (44, box, "box", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF (src))));
NEXT (1);
}
{
scm_t_uint16 dst, src;
SCM var;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
var = LOCAL_REF (src);
VM_ASSERT (SCM_VARIABLEP (var),
vm_error_not_a_variable ("variable-ref", var));
{
scm_t_uint16 dst, src;
SCM var;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
var = LOCAL_REF (dst);
VM_ASSERT (SCM_VARIABLEP (var),
vm_error_not_a_variable ("variable-set!", var));
scm_t_int32 offset;
SCM closure;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
offset = ip[1];
- SCM_UNPACK_RTL_24 (ip[2], nfree);
+ UNPACK_24 (ip[2], nfree);
// FIXME: Assert range of nfree?
- closure = scm_words (scm_tc7_rtl_program | (nfree << 16), nfree + 2);
+ closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
SCM_SET_CELL_WORD_1 (closure, ip + offset);
// FIXME: Elide these initializations?
for (n = 0; n < nfree; n++)
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
+ SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
LOCAL_SET (dst, closure);
NEXT (3);
}
{
scm_t_uint16 dst, src;
scm_t_uint32 idx;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
- SCM_UNPACK_RTL_24 (ip[1], idx);
+ UNPACK_12_12 (op, dst, src);
+ UNPACK_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- LOCAL_SET (dst, SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
+ LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
NEXT (2);
}
{
scm_t_uint16 dst, src;
scm_t_uint32 idx;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
- SCM_UNPACK_RTL_24 (ip[1], idx);
+ UNPACK_12_12 (op, dst, src);
+ UNPACK_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
+ SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
NEXT (2);
}
scm_t_uint8 dst;
scm_t_bits val;
- SCM_UNPACK_RTL_8_16 (op, dst, val);
+ UNPACK_8_16 (op, dst, val);
LOCAL_SET (dst, SCM_PACK (val));
NEXT (1);
}
scm_t_uint32 dst;
scm_t_bits val;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
val = ip[1];
LOCAL_SET (dst, SCM_PACK (val));
NEXT (2);
scm_t_uint32 dst;
scm_t_bits val;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
#if SIZEOF_SCM_T_BITS > 4
val = ip[1];
val <<= 32;
scm_t_uint32* loc;
scm_t_bits unpacked;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
offset = ip[1];
loc = ip + offset;
unpacked = (scm_t_bits) loc;
scm_t_uint32* loc;
scm_t_uintptr loc_bits;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
offset = ip[1];
loc = ip + offset;
loc_bits = (scm_t_uintptr) loc;
scm_t_int32 offset;
scm_t_uint32* loc;
- SCM_UNPACK_RTL_24 (op, src);
+ UNPACK_24 (op, src);
offset = ip[1];
loc = ip + offset;
VM_ASSERT (ALIGNED_P (loc, SCM), abort());
{
scm_t_uint32 dst;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
SYNC_IP ();
LOCAL_SET (dst, scm_current_module ());
scm_t_uint32 sym;
SCM var;
- SCM_UNPACK_RTL_24 (op, dst);
- SCM_UNPACK_RTL_24 (ip[1], sym);
+ UNPACK_24 (op, dst);
+ UNPACK_24 (ip[1], sym);
SYNC_IP ();
var = scm_lookup (LOCAL_REF (sym));
if (ip[1] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var),
- vm_error_unbound (fp[-1], LOCAL_REF (sym)));
+ vm_error_unbound (fp[0], LOCAL_REF (sym)));
LOCAL_SET (dst, var);
NEXT (2);
VM_DEFINE_OP (59, define, "define!", OP1 (U8_U12_U12))
{
scm_t_uint16 sym, val;
- SCM_UNPACK_RTL_12_12 (op, sym, val);
+ UNPACK_12_12 (op, sym, val);
SYNC_IP ();
scm_define (LOCAL_REF (sym), LOCAL_REF (val));
NEXT (1);
SCM *var_loc;
SCM var;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
var_offset = ip[1];
var_loc_u32 = ip + var_offset;
VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
var = scm_module_lookup (mod, sym);
if (ip[4] & 0x1)
- VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
*var_loc = var;
}
SCM *var_loc;
SCM var;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
var_offset = ip[1];
var_loc_u32 = ip + var_offset;
VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
var = scm_private_lookup (SCM_CDR (modname), sym);
if (ip[4] & 0x1)
- VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
*var_loc = var;
}
scm_t_uint8 escape_only_p;
scm_t_dynstack_prompt_flags flags;
- SCM_UNPACK_RTL_24 (op, tag);
+ UNPACK_24 (op, tag);
escape_only_p = ip[1] & 0x1;
- SCM_UNPACK_RTL_24 (ip[1], proc_slot);
+ UNPACK_24 (ip[1], proc_slot);
offset = ip[2];
offset >>= 8; /* Sign extension */
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
scm_dynstack_push_prompt (¤t_thread->dynstack, flags,
LOCAL_REF (tag),
- fp,
- &LOCAL_REF (proc_slot),
- (scm_t_uint8 *)(ip + offset),
+ fp - vp->stack_base,
+ LOCAL_ADDRESS (proc_slot) - vp->stack_base,
+ ip + offset,
®isters);
NEXT (3);
}
VM_DEFINE_OP (63, wind, "wind", OP1 (U8_U12_U12))
{
scm_t_uint16 winder, unwinder;
- SCM_UNPACK_RTL_12_12 (op, winder, unwinder);
+ UNPACK_12_12 (op, winder, unwinder);
scm_dynstack_push_dynwind (¤t_thread->dynstack,
LOCAL_REF (winder), LOCAL_REF (unwinder));
NEXT (1);
{
scm_t_uint32 fluid, value;
- SCM_UNPACK_RTL_12_12 (op, fluid, value);
+ UNPACK_12_12 (op, fluid, value);
scm_dynstack_push_fluid (¤t_thread->dynstack,
LOCAL_REF (fluid), LOCAL_REF (value),
size_t num;
SCM fluid, fluids;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
fluid = LOCAL_REF (src);
fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
size_t num;
SCM fluid, fluids;
- SCM_UNPACK_RTL_12_12 (op, a, b);
+ UNPACK_12_12 (op, a, b);
fluid = LOCAL_REF (a);
fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
{
scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
SYNC_IP ();
LOCAL_SET (dst,
scm_string_to_number (LOCAL_REF (src),
{
scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
SYNC_IP ();
LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
NEXT (1);
VM_DEFINE_OP (73, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
- SCM_UNPACK_RTL_12_12 (op, dst, src);
+ UNPACK_12_12 (op, dst, src);
SYNC_IP ();
LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
NEXT (1);
{
scm_t_uint16 a, b;
SCM x, y;
- SCM_UNPACK_RTL_12_12 (op, a, b);
+ UNPACK_12_12 (op, a, b);
x = LOCAL_REF (a);
y = LOCAL_REF (b);
VM_VALIDATE_PAIR (x, "set-car!");
{
scm_t_uint16 a, b;
SCM x, y;
- SCM_UNPACK_RTL_12_12 (op, a, b);
+ UNPACK_12_12 (op, a, b);
x = LOCAL_REF (a);
y = LOCAL_REF (b);
VM_VALIDATE_PAIR (x, "set-car!");
scm_t_int32 length, n;
SCM val, vector;
- SCM_UNPACK_RTL_8_8_8 (op, dst, length, init);
+ UNPACK_8_8_8 (op, dst, length, init);
val = LOCAL_REF (init);
vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
scm_t_uint8 dst, src, idx;
SCM v;
- SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
+ UNPACK_8_8_8 (op, dst, src, idx);
v = LOCAL_REF (src);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
&& idx < SCM_I_VECTOR_LENGTH (v)))
SCM vect, idx, val;
scm_t_signed_bits i = 0;
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx_var, src);
+ UNPACK_8_8_8 (op, dst, idx_var, src);
vect = LOCAL_REF (dst);
idx = LOCAL_REF (idx_var);
val = LOCAL_REF (src);
scm_t_uint8 dst, idx, src;
SCM vect, val;
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
+ UNPACK_8_8_8 (op, dst, idx, src);
vect = LOCAL_REF (dst);
val = LOCAL_REF (src);
scm_t_uint8 dst, vtable, nfields;
SCM ret;
- SCM_UNPACK_RTL_8_8_8 (op, dst, vtable, nfields);
+ UNPACK_8_8_8 (op, dst, vtable, nfields);
SYNC_IP ();
ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
scm_t_uint8 dst, src, idx;
SCM obj;
- SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
+ UNPACK_8_8_8 (op, dst, src, idx);
obj = LOCAL_REF (src);
scm_t_uint8 dst, idx, src;
SCM obj, val;
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
+ UNPACK_8_8_8 (op, dst, idx, src);
obj = LOCAL_REF (dst);
val = LOCAL_REF (src);
VM_DEFINE_OP (103, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
- SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
+ UNPACK_8_8_8 (op, dst, src, idx);
LOCAL_SET (dst,
SCM_PACK (SCM_STRUCT_DATA (LOCAL_REF (src))[idx]));
NEXT (1);
VM_DEFINE_OP (104, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
+ UNPACK_8_8_8 (op, dst, idx, src);
SCM_STRUCT_DATA (LOCAL_REF (dst))[idx] = SCM_UNPACK (LOCAL_REF (src));
NEXT (1);
}
scm_t_int32 offset;
scm_t_uint32 len;
- SCM_UNPACK_RTL_8_8_8 (op, dst, type, shape);
+ UNPACK_8_8_8 (op, dst, type, shape);
offset = ip[1];
len = ip[2];
SYNC_IP ();
VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, type, fill, bounds;
- SCM_UNPACK_RTL_12_12 (op, dst, type);
- SCM_UNPACK_RTL_12_12 (ip[1], fill, bounds);
+ UNPACK_12_12 (op, dst, type);
+ UNPACK_12_12 (ip[1], fill, bounds);
SYNC_IP ();
LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
LOCAL_REF (bounds)));
SCM bv, scm_idx, val; \
scm_t_ ## type *int_ptr; \
\
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \
+ UNPACK_8_8_8 (op, dst, idx, src); \
bv = LOCAL_REF (dst); \
scm_idx = LOCAL_REF (idx); \
val = LOCAL_REF (src); \
SCM bv, scm_idx, val; \
scm_t_ ## type *int_ptr; \
\
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \
+ UNPACK_8_8_8 (op, dst, idx, src); \
bv = LOCAL_REF (dst); \
scm_idx = LOCAL_REF (idx); \
val = LOCAL_REF (src); \
SCM bv, scm_idx, val; \
type *float_ptr; \
\
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \
+ UNPACK_8_8_8 (op, dst, idx, src); \
bv = LOCAL_REF (dst); \
scm_idx = LOCAL_REF (idx); \
val = LOCAL_REF (src); \
#undef RETURN_VALUE_LIST
#undef RUN_HOOK
#undef RUN_HOOK0
+#undef RUN_HOOK1
#undef SYNC_ALL
#undef SYNC_BEFORE_GC
#undef SYNC_IP
#undef SYNC_REGISTER
+#undef UNPACK_8_8_8
+#undef UNPACK_8_16
+#undef UNPACK_16_8
+#undef UNPACK_12_12
+#undef UNPACK_24
#undef VARIABLE_BOUNDP
#undef VARIABLE_REF
#undef VARIABLE_SET