/* This file is included in vm.c multiple times. */
-/* Virtual Machine
-
- This file contains two virtual machines. First, the old one -- the
- one that is currently used, and corresponds to Guile 2.0. It's a
- stack machine, meaning that most instructions pop their operands from
- the top of the stack, and push results there too.
-
- Following it is the new virtual machine. It's a register machine,
- meaning that intructions address their operands by index, and store
- results in indexed slots as well. Those slots are on the stack.
- It's somewhat confusing to call it a register machine, given that the
- values are on the stack. Perhaps it needs a new name.
+#define UNPACK_8_8_8(op,a,b,c) \
+ do \
+ { \
+ a = (op >> 8) & 0xff; \
+ b = (op >> 16) & 0xff; \
+ c = op >> 24; \
+ } \
+ while (0)
- Anyway, things are in a transitional state. We're going to try to
- avoid munging the old VM very much while we flesh out the new one.
- We're also going to try to make them interoperable, as much as
- possible -- to have the old VM be able to call procedures for the new
- VM, and vice versa. This should ease the bootstrapping process. */
+#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)
-/* The old VM. */
-static SCM VM_NAME (SCM, SCM, SCM*, int);
-/* The new VM. */
-static SCM RTL_VM_NAME (SCM, SCM, SCM*, size_t);
+#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)
-#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
/* 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
#ifndef IP_REG
# define IP_REG
#endif
-#ifndef SP_REG
-# define SP_REG
-#endif
#ifndef FP_REG
# define FP_REG
#endif
# 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 ())
-\f
-
-/* Cache the VM's instruction, stack, and frame pointer in local variables. */
-#define CACHE_REGISTER() \
-{ \
- ip = vp->ip; \
- sp = vp->sp; \
- fp = vp->fp; \
-}
-
-/* Update the registers in VP, a pointer to the current VM. This must be done
- at least before any GC invocation so that `vp->sp' is up-to-date and the
- whole stack gets marked. */
-#define SYNC_REGISTER() \
-{ \
- vp->ip = ip; \
- vp->sp = sp; \
- vp->fp = fp; \
-}
-
-/* FIXME */
-#define ASSERT_VARIABLE(x) \
- VM_ASSERT (SCM_VARIABLEP (x), abort())
-#define ASSERT_BOUND_VARIABLE(x) \
- VM_ASSERT (SCM_VARIABLEP (x) \
- && !scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED), \
- abort())
-
-#ifdef VM_ENABLE_PARANOID_ASSERTIONS
-#define CHECK_IP() \
- do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
-#define ASSERT_ALIGNED_PROCEDURE() \
- do { if ((scm_t_bits)bp % 8) abort (); } while (0)
-#define ASSERT_BOUND(x) \
- VM_ASSERT (!scm_is_eq ((x), SCM_UNDEFINED), abort())
-#else
-#define CHECK_IP()
-#define ASSERT_ALIGNED_PROCEDURE()
-#define ASSERT_BOUND(x)
-#endif
-
-/* Cache the object table and free variables. */
-#define CACHE_PROGRAM() \
-{ \
- if (bp != SCM_PROGRAM_DATA (program)) { \
- bp = SCM_PROGRAM_DATA (program); \
- ASSERT_ALIGNED_PROCEDURE (); \
- if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
- objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
- } else { \
- objects = NULL; \
- } \
- } \
-}
-
-#define SYNC_BEFORE_GC() \
-{ \
- SYNC_REGISTER (); \
-}
-
-#define SYNC_ALL() \
-{ \
- SYNC_REGISTER (); \
-}
-
-\f
-/*
- * Error check
- */
-
-/* Accesses to a program's object table. */
-#define CHECK_OBJECT(_num)
-#define CHECK_FREE_VARIABLE(_num)
-
-\f
-/*
- * Stack operation
- */
-
-#ifdef VM_ENABLE_STACK_NULLING
-# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
-# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
-# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
-/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
- inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
- that continuation doesn't have a chance to run. It's not important on a
- semantic level, but it does mess up our stack nulling -- so this macro is to
- fix that. */
-# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
-#else
-# define CHECK_STACK_LEAKN(_n)
-# define CHECK_STACK_LEAK()
-# define NULLSTACK(_n)
-# define NULLSTACK_FOR_NONLOCAL_EXIT()
-#endif
-
-/* For this check, we don't use VM_ASSERT, because that leads to a
- per-site SYNC_ALL, which is too much code growth. The real problem
- of course is having to check for overflow all the time... */
-#define CHECK_OVERFLOW() \
- do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
-
-#ifdef VM_CHECK_UNDERFLOW
-#define PRE_CHECK_UNDERFLOW(N) \
- VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
-#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
-#else
-#define PRE_CHECK_UNDERFLOW(N) /* nop */
-#define CHECK_UNDERFLOW() /* nop */
-#endif
-
-
-#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
-#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
-#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
-#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
-#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
-#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } while (0)
-
-/* Pop the N objects on top of the stack and push a list that contains
- them. */
-#define POP_LIST(n) \
-do \
-{ \
- int i; \
- SCM l = SCM_EOL, x; \
- SYNC_BEFORE_GC (); \
- for (i = n; i; i--) \
- { \
- POP (x); \
- l = scm_cons (x, l); \
- } \
- PUSH (l); \
-} while (0)
-
-/* The opposite: push all of the elements in L onto the list. */
-#define PUSH_LIST(l, NILP) \
-do \
-{ \
- for (; scm_is_pair (l); l = SCM_CDR (l)) \
- PUSH (SCM_CAR (l)); \
- VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
-} while (0)
-
-\f
-/*
- * Instruction operation
- */
-
-#define FETCH() (*ip++)
-#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
-
-#undef NEXT_JUMP
-#ifdef HAVE_LABELS_AS_VALUES
-# define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
-#else
-# define NEXT_JUMP() goto vm_start
-#endif
-
-#define NEXT \
-{ \
- NEXT_HOOK (); \
- CHECK_STACK_LEAK (); \
- NEXT_JUMP (); \
-}
-
-\f
-/* See frames.h for the layout of stack frames */
-/* When this is called, bp points to the new program data,
- and the arguments are already on the stack */
-#define DROP_FRAME() \
- { \
- sp -= 3; \
- NULLSTACK (3); \
- CHECK_UNDERFLOW (); \
- }
-
-
-static SCM
-VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
-{
- /* VM registers */
- register scm_t_uint8 *ip IP_REG; /* instruction pointer */
- register SCM *sp SP_REG; /* stack pointer */
- register SCM *fp FP_REG; /* frame pointer */
- struct scm_vm *vp = SCM_VM_DATA (vm);
-
- /* Cache variables */
- struct scm_objcode *bp = NULL; /* program base pointer */
- SCM *objects = NULL; /* constant objects */
- SCM *stack_limit = vp->stack_limit; /* stack limit address */
-
- scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
-
- /* Internal variables */
- int nvalues = 0;
- scm_i_jmp_buf registers; /* used for prompts */
-
-#ifdef HAVE_LABELS_AS_VALUES
- static const void **jump_table_pointer = NULL;
-#endif
-
-#ifdef HAVE_LABELS_AS_VALUES
- register const void **jump_table JT_REG;
-
- if (SCM_UNLIKELY (!jump_table_pointer))
- {
- int i;
- jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*));
- for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
- jump_table_pointer[i] = &&vm_error_bad_instruction;
-#define VM_INSTRUCTION_TO_LABEL 1
-#define jump_table jump_table_pointer
-#include <libguile/vm-expand.h>
-#include <libguile/vm-i-system.i>
-#include <libguile/vm-i-scheme.i>
-#include <libguile/vm-i-loader.i>
-#undef jump_table
-#undef VM_INSTRUCTION_TO_LABEL
- }
-
- /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
- load instruction at each instruction dispatch. */
- jump_table = jump_table_pointer;
-#endif
-
- if (SCM_I_SETJMP (registers))
- {
- /* Non-local return. Cache the VM registers back from the vp, and
- go to the handler.
-
- Note, at this point, we must assume that any variable local to
- vm_engine that can be assigned *has* been assigned. So we need to pull
- all our state back from the ip/fp/sp.
- */
- CACHE_REGISTER ();
- program = SCM_FRAME_PROGRAM (fp);
- CACHE_PROGRAM ();
- /* The stack contains the values returned to this continuation,
- along with a number-of-values marker -- like an MV return. */
- ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp));
- NEXT;
- }
-
- CACHE_REGISTER ();
-
- /* Since it's possible to receive the arguments on the stack itself,
- and indeed the RTL VM invokes us that way, shuffle up the
- arguments first. */
- VM_ASSERT (sp + 8 + nargs < stack_limit, vm_error_too_many_args (nargs));
- {
- int i;
- for (i = nargs - 1; i >= 0; i--)
- sp[9 + i] = argv[i];
- }
-
- /* Initial frame */
- PUSH (SCM_PACK (fp)); /* dynamic link */
- PUSH (SCM_PACK (0)); /* mvra */
- PUSH (SCM_PACK (ip)); /* ra */
- PUSH (boot_continuation);
- fp = sp + 1;
- ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation));
-
- /* MV-call frame, function & arguments */
- PUSH (SCM_PACK (fp)); /* dynamic link */
- PUSH (SCM_PACK (ip + 1)); /* mvra */
- PUSH (SCM_PACK (ip)); /* ra */
- PUSH (program);
- fp = sp + 1;
- sp += nargs;
-
- PUSH_CONTINUATION_HOOK ();
-
- apply:
- program = fp[-1];
- if (!SCM_PROGRAM_P (program))
- {
- if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program))
- fp[-1] = SCM_STRUCT_PROCEDURE (program);
- else if (SCM_HAS_TYP7 (program, scm_tc7_rtl_program))
- {
- SCM ret;
- SYNC_ALL ();
-
- ret = RTL_VM_NAME (vm, program, fp, sp - fp + 1);
-
- NULLSTACK_FOR_NONLOCAL_EXIT ();
-
- if (SCM_UNLIKELY (SCM_VALUESP (ret)))
- {
- /* multiple values returned to continuation */
- ret = scm_struct_ref (ret, SCM_INUM0);
- nvalues = scm_ilength (ret);
- PUSH_LIST (ret, scm_is_null);
- goto vm_return_values;
- }
- else
- {
- PUSH (ret);
- goto vm_return;
- }
- }
- else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
- && SCM_SMOB_APPLICABLE_P (program))
- {
- /* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */
- int i;
- PUSH (SCM_BOOL_F);
- for (i = sp - fp; i >= 0; i--)
- fp[i] = fp[i - 1];
- fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline;
- }
- else
- {
- SYNC_ALL();
- vm_error_wrong_type_apply (program);
- }
- goto apply;
- }
-
- CACHE_PROGRAM ();
- ip = SCM_C_OBJCODE_BASE (bp);
-
- APPLY_HOOK ();
-
- /* Let's go! */
- NEXT;
-
-#ifndef HAVE_LABELS_AS_VALUES
- vm_start:
- switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) {
-#endif
-
-#include "vm-expand.h"
-#include "vm-i-system.c"
-#include "vm-i-scheme.c"
-#include "vm-i-loader.c"
-
-#ifndef HAVE_LABELS_AS_VALUES
- default:
- goto vm_error_bad_instruction;
- }
-#endif
-
- abort (); /* never reached */
-
- vm_error_bad_instruction:
- vm_error_bad_instruction (ip[-1]);
- abort (); /* never reached */
-
- handle_overflow:
- SYNC_ALL ();
- vm_error_stack_overflow (vp);
- abort (); /* never reached */
-}
-
-#undef ALIGNED_P
-#undef CACHE_REGISTER
-#undef CHECK_OVERFLOW
-#undef FUNC2
-#undef INIT
-#undef INUM_MAX
-#undef INUM_MIN
-#undef INUM_STEP
-#undef jump_table
-#undef LOCAL_REF
-#undef LOCAL_SET
-#undef NEXT
-#undef NEXT_JUMP
-#undef REL
-#undef RETURN
-#undef RETURN_ONE_VALUE
-#undef RETURN_VALUE_LIST
-#undef SYNC_ALL
-#undef SYNC_BEFORE_GC
-#undef SYNC_IP
-#undef SYNC_REGISTER
-#undef VARIABLE_BOUNDP
-#undef VARIABLE_REF
-#undef VARIABLE_SET
-#undef VM_DEFINE_OP
-#undef VM_INSTRUCTION_TO_LABEL
-
-
-\f
-
/* Virtual Machine
This is Guile's new virtual machine. When I say "new", I mean
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
- 3 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 + 4); \
+ 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; \
- sp[2] = SCM_BOOL_F; \
+ old_fp[-1] = SCM_BOOL_F; \
+ old_fp[-2] = SCM_BOOL_F; \
/* Leave proc. */ \
- sp[4] = val; \
- vp->sp = sp + 4; \
- 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] = rtl_apply; \
- fp[0] = rtl_values; \
- fp[1] = vals; \
+ fp[0] = vm_builtin_apply; \
+ fp[1] = vm_builtin_values; \
+ fp[2] = vals; \
RESET_FRAME (3); \
- ip = (scm_t_uint32 *) rtl_apply_code; \
+ ip = (scm_t_uint32 *) vm_builtin_apply_code; \
goto op_tail_apply; \
} while (0)
#define BR_NARGS(rel) \
- scm_t_uint16 expected; \
- SCM_UNPACK_RTL_24 (op, expected); \
+ scm_t_uint32 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: 4 words for the boot
- continuation, 4 + nargs for the procedure application, and 4 for
+ /* 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 + 4 + 4 + nargs_ + 4);
+ 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
{
int i;
for (i = nargs_ - 1; i >= 0; i--)
- base[8 + i] = argv[i];
+ base[6 + i] = argv[i];
}
/* Initial frame, saving previous fp and ip, with the boot
continuation. */
base[0] = SCM_PACK (fp); /* dynamic link */
- base[1] = SCM_PACK (0); /* the boot continuation does not return to scheme */
- base[2] = SCM_PACK (ip); /* ra */
- base[3] = rtl_boot_continuation;
- fp = &base[4];
- ip = (scm_t_uint32 *) rtl_boot_continuation_code;
+ base[1] = SCM_PACK (ip); /* ra */
+ base[2] = vm_boot_continuation;
+ fp = &base[2];
+ ip = (scm_t_uint32 *) vm_boot_continuation_code;
/* MV-call frame, function & arguments */
- base[4] = SCM_PACK (fp); /* dynamic link */
- base[5] = SCM_PACK (ip); /* in RTL programs, MVRA same as RA */
- base[6] = SCM_PACK (ip); /* ra */
- base[7] = program;
- fp = vp->fp = &base[8];
+ base[3] = SCM_PACK (fp); /* dynamic link */
+ base[4] = SCM_PACK (ip); /* ra */
+ base[5] = program;
+ 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))
continue;
}
-#if 0
SYNC_IP();
vm_error_wrong_type_apply (proc);
-#else
- {
- SCM ret;
- SYNC_ALL ();
-
- ret = VM_NAME (vm, fp[-1], fp, FRAME_LOCALS_COUNT () - 1);
-
- if (SCM_UNLIKELY (SCM_VALUESP (ret)))
- RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
- else
- RETURN_ONE_VALUE (ret);
- }
-#endif
}
/* 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() - 5;
- SCM ret;
+ /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
- /* Boot closure in r0, empty frame in r1/r2/r3, proc in r4, values from r5. */
+ scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
+ SCM ret;
if (nvals == 1)
- ret = LOCAL_REF (5);
+ ret = LOCAL_REF (4);
else
{
scm_t_uint32 n;
ret = SCM_EOL;
SYNC_BEFORE_GC();
for (n = nvals; n > 0; n--)
- ret = scm_cons (LOCAL_REF (5 + n - 1), ret);
+ ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
ret = scm_values (ret);
}
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_MV_RETURN_ADDRESS (fp, ip + 2);
- 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);
}
/* tail-call nlocals:24
*
* Tail-call a procedure. Requires that the procedure and all of the
- * arguments have already been shuffled into position.
+ * arguments have already been shuffled into position. Will reset the
+ * frame to NLOCALS.
*/
VM_DEFINE_OP (2, tail_call, "tail-call", OP1 (U8_U24))
{
scm_t_uint32 nlocals;
- SCM_UNPACK_RTL_24 (op, nlocals);
+ UNPACK_24 (op, nlocals);
VM_HANDLE_INTERRUPTS;
RESET_FRAME (nlocals);
+
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);
+ }
+
+ /* tail-call/shuffle from:24
+ *
+ * Tail-call a procedure. The procedure should already be set to slot
+ * 0. The rest of the args are taken from the frame, starting at
+ * FROM, shuffled down to start at slot 0. This is part of the
+ * implementation of the call-with-values builtin.
+ */
+ VM_DEFINE_OP (3, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24))
+ {
+ scm_t_uint32 n, from, nlocals;
+
+ UNPACK_24 (op, from);
+
+ VM_HANDLE_INTERRUPTS;
+
+ VM_ASSERT (from > 0, abort ());
+ nlocals = FRAME_LOCALS_COUNT ();
+
+ for (n = 0; from + n < nlocals; n++)
+ LOCAL_SET (n + 1, LOCAL_REF (from + n));
+
+ RESET_FRAME (n + 1);
+
+ APPLY_HOOK ();
+
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ goto apply;
+
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
* PROC, asserting that the call actually returned at least one
* value. Afterwards, resets the frame to NLOCALS locals.
*/
- VM_DEFINE_OP (3, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
+ VM_DEFINE_OP (4, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
{
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);
* return values equals NVALUES exactly. After receive-values has
* run, the values can be copied down via `mov'.
*/
- VM_DEFINE_OP (4, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
+ 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 ());
else
- VM_ASSERT (FRAME_LOCALS_COUNT () == proc + nvalues,
+ VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues,
vm_error_wrong_number_of_values (nvalues));
NEXT (2);
}
*
* Return a value.
*/
- VM_DEFINE_OP (5, return, "return", OP1 (U8_U24))
+ 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));
}
* shuffled down to a contiguous array starting at slot 1.
* We also expect the frame has already been reset.
*/
- VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_X24))
+ 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_MV_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;
- base[-4] = 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);
}
* calling frame. This instruction is part of the trampolines
* created in gsubr.c, and is not generated by the compiler.
*/
- VM_DEFINE_OP (7, subr_call, "subr-call", OP1 (U8_U24))
+ VM_DEFINE_OP (8, subr_call, "subr-call", OP1 (U8_U24))
{
scm_t_uint32 ptr_idx;
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 ();
* part of the trampolines created by the FFI, and is not generated by
* the compiler.
*/
- VM_DEFINE_OP (8, foreign_call, "foreign-call", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (9, foreign_call, "foreign-call", OP1 (U8_U12_U12))
{
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 ();
* the implementation of undelimited continuations, and is not
* generated by the compiler.
*/
- VM_DEFINE_OP (9, continuation_call, "continuation-call", OP1 (U8_U24))
+ VM_DEFINE_OP (10, continuation_call, "continuation-call", OP1 (U8_U24))
{
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 */
* instruction is part of the implementation of partial continuations,
* and is not generated by the compiler.
*/
- VM_DEFINE_OP (10, compose_continuation, "compose-continuation", OP1 (U8_U24))
+ VM_DEFINE_OP (11, compose_continuation, "compose-continuation", OP1 (U8_U24))
{
SCM vmcont;
scm_t_uint32 cont_idx;
- SCM_UNPACK_RTL_24 (op, cont_idx);
- vmcont = LOCAL_REF (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 ();
* arguments. This instruction is part of the implementation of
* `apply', and is not generated by the compiler.
*/
- VM_DEFINE_OP (11, tail_apply, "tail-apply", OP1 (U8_X24))
+ VM_DEFINE_OP (12, tail_apply, "tail-apply", OP1 (U8_X24))
{
int i, list_idx, list_len, nlocals;
SCM list;
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);
}
* local slot 1 to it. This instruction is part of the implementation
* of `call/cc', and is not generated by the compiler.
*/
- VM_DEFINE_OP (12, call_cc, "call/cc", OP1 (U8_X24))
+ VM_DEFINE_OP (13, call_cc, "call/cc", OP1 (U8_X24))
{
SCM vm_cont, cont;
scm_t_dynstack *dynstack;
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),
- SCM_FRAME_MV_RETURN_ADDRESS (fp),
dynstack,
0);
/* FIXME: Seems silly to capture the registers here, when they are
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);
}
}
+ /* abort _:24
+ *
+ * Abort to a prompt handler. The tag is expected in r1, and the rest
+ * of the values in the frame are returned to the prompt handler.
+ * This corresponds to a tail application of abort-to-prompt.
+ */
+ VM_DEFINE_OP (14, abort, "abort", OP1 (U8_X24))
+ {
+ scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
+
+ ASSERT (nlocals >= 2);
+ /* FIXME: Really we should capture the caller's registers. Until
+ then, manually advance the IP so that when the prompt resumes,
+ it continues with the next instruction. */
+ ip++;
+ SYNC_IP ();
+ vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
+ SCM_EOL, LOCAL_ADDRESS (0), ®isters);
+
+ /* vm_abort should not return */
+ abort ();
+ }
+
+ /* builtin-ref dst:12 idx:12
+ *
+ * Load a builtin stub by index into DST.
+ */
+ VM_DEFINE_OP (15, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
+ {
+ scm_t_uint16 dst, idx;
+
+ UNPACK_12_12 (op, dst, idx);
+ LOCAL_SET (dst, scm_vm_builtin_ref (idx));
+
+ NEXT (1);
+ }
+
\f
* than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
* the current instruction pointer.
*/
- VM_DEFINE_OP (13, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (16, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
{
BR_NARGS (!=);
}
- VM_DEFINE_OP (14, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (17, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
{
BR_NARGS (<);
}
- VM_DEFINE_OP (15, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (18, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
{
BR_NARGS (>);
}
* If the number of actual arguments is not ==, >=, or <= EXPECTED,
* respectively, signal an error.
*/
- VM_DEFINE_OP (16, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
+ 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 (17, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
+ 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 (18, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
+ 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);
* setting them all to SCM_UNDEFINED, except those nargs values that
* were passed as arguments and procedure.
*/
- VM_DEFINE_OP (19, alloc_frame, "alloc-frame", OP1 (U8_U24))
+ 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);
* Used to reset the frame size to something less than the size that
* was previously set via alloc-frame.
*/
- VM_DEFINE_OP (20, reset_frame, "reset-frame", OP1 (U8_U24))
+ 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);
}
* Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
* number of locals reserved is EXPECTED + NLOCALS.
*/
- VM_DEFINE_OP (21, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
+ 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);
NEXT (1);
}
+ /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
+ *
+ * Find the first positional argument after NREQ. If it is greater
+ * than NPOS, jump to OFFSET.
+ *
+ * This instruction is only emitted for functions with multiple
+ * clauses, and an earlier clause has keywords and no rest arguments.
+ * See "Case-lambda" in the manual, for more on how case-lambda
+ * chooses the clause to apply.
+ */
+ VM_DEFINE_OP (25, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24))
+ {
+ scm_t_uint32 nreq, npos;
+
+ UNPACK_24 (op, nreq);
+ UNPACK_24 (ip[1], npos);
+
+ /* We can only have too many positionals if there are more
+ arguments than NPOS. */
+ if (FRAME_LOCALS_COUNT() > npos)
+ {
+ scm_t_uint32 n;
+ for (n = nreq; n < npos; n++)
+ if (scm_is_keyword (LOCAL_REF (n)))
+ break;
+ if (n == npos && !scm_is_keyword (LOCAL_REF (n)))
+ {
+ scm_t_int32 offset = ip[2];
+ offset >>= 8; /* Sign-extending shift. */
+ NEXT (offset);
+ }
+ }
+ NEXT (3);
+ }
+
/* bind-kwargs nreq:24 allow-other-keys:1 has-rest:1 _:6 nreq-and-opt:24
* _:8 ntotal:24 kw-offset:32
*
*
* A macro-mega-instruction.
*/
- VM_DEFINE_OP (22, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
+ VM_DEFINE_OP (26, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
{
scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
scm_t_int32 kw_offset;
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());
* Collect any arguments at or above DST into a list, and store that
* list at DST.
*/
- VM_DEFINE_OP (23, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
+ VM_DEFINE_OP (27, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
{
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)
* Add OFFSET, a signed 24-bit number, to the current instruction
* pointer.
*/
- VM_DEFINE_OP (24, br, "br", OP1 (U8_L24))
+ VM_DEFINE_OP (28, br, "br", OP1 (U8_L24))
{
scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */
* If the value in TEST is true for the purposes of Scheme, add
* OFFSET, a signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (25, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (29, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, scm_is_true (x));
}
* If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
* signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (26, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (30, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, scm_is_null (x));
}
* If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
* number, to the current instruction pointer.
*/
- VM_DEFINE_OP (27, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (31, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, scm_is_lisp_false (x));
}
* If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
* to the current instruction pointer.
*/
- VM_DEFINE_OP (28, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (32, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, scm_is_pair (x));
}
* If the value in TEST is a struct, add OFFSET, a signed 24-bit
* number, to the current instruction pointer.
*/
- VM_DEFINE_OP (29, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (33, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, SCM_STRUCTP (x));
}
* If the value in TEST is a char, add OFFSET, a signed 24-bit number,
* to the current instruction pointer.
*/
- VM_DEFINE_OP (30, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
+ VM_DEFINE_OP (34, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
{
BR_UNARY (x, SCM_CHARP (x));
}
* If the value in TEST has the TC7 given in the second word, add
* OFFSET, a signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (31, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
+ VM_DEFINE_OP (35, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
{
BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
}
* If the value in A is eq? to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (32, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (36, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_BINARY (x, y, scm_is_eq (x, y));
}
* If the value in A is eqv? to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (33, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (37, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_BINARY (x, y,
scm_is_eq (x, y)
* 24-bit number, to the current instruction pointer.
*/
// FIXME: should sync_ip before calling out?
- VM_DEFINE_OP (34, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (38, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_BINARY (x, y,
scm_is_eq (x, y)
* If the value in A is = to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (35, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (39, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_ARITHMETIC (==, scm_num_eq_p);
}
* If the value in A is < to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (36, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (40, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_ARITHMETIC (<, scm_less_p);
}
* If the value in A is <= to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (37, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
+ VM_DEFINE_OP (41, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
{
BR_ARITHMETIC (<=, scm_leq_p);
}
*
* Copy a value from one local slot to another.
*/
- VM_DEFINE_OP (38, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (42, mov, "mov", OP1 (U8_U12_U12) | OP_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);
*
* Copy a value from one local slot to another.
*/
- VM_DEFINE_OP (39, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
+ VM_DEFINE_OP (43, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
{
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);
*
* Create a new variable holding SRC, and place it in DST.
*/
- VM_DEFINE_OP (40, box, "box", OP1 (U8_U12_U12) | OP_DST)
+ 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);
}
* Unpack the variable at SRC into DST, asserting that the variable is
* actually bound.
*/
- VM_DEFINE_OP (41, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (45, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
{
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));
*
* Set the contents of the variable at DST to SET.
*/
- VM_DEFINE_OP (42, box_set, "box-set!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (46, box_set, "box-set!", OP1 (U8_U12_U12))
{
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));
* signed 32-bit integer. Space for NFREE free variables will be
* allocated.
*/
- VM_DEFINE_OP (43, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
+ VM_DEFINE_OP (47, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
{
scm_t_uint32 dst, nfree, n;
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);
}
*
* Load free variable IDX from the closure SRC into local slot DST.
*/
- VM_DEFINE_OP (44, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
+ VM_DEFINE_OP (48, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
{
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);
}
*
* Set free variable IDX from the closure DST to SRC.
*/
- VM_DEFINE_OP (45, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
+ VM_DEFINE_OP (49, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
{
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);
}
* Make an immediate whose low bits are LOW-BITS, and whose top bits are
* 0.
*/
- VM_DEFINE_OP (46, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
+ VM_DEFINE_OP (50, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
{
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);
}
* Make an immediate whose low bits are LOW-BITS, and whose top bits are
* 0.
*/
- VM_DEFINE_OP (47, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
+ VM_DEFINE_OP (51, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
{
- scm_t_uint8 dst;
+ 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);
*
* Make an immediate with HIGH-BITS and LOW-BITS.
*/
- VM_DEFINE_OP (48, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
+ VM_DEFINE_OP (52, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
{
- scm_t_uint8 dst;
+ 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;
* Whether the object is mutable or immutable depends on where it was
* allocated by the compiler, and loaded by the loader.
*/
- VM_DEFINE_OP (49, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
+ VM_DEFINE_OP (53, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 offset;
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;
* that the compiler is unable to statically allocate, like symbols.
* These values would be initialized when the object file loads.
*/
- VM_DEFINE_OP (50, static_ref, "static-ref", OP2 (U8_U24, S32))
+ VM_DEFINE_OP (54, static_ref, "static-ref", OP2 (U8_U24, S32))
{
scm_t_uint32 dst;
scm_t_int32 offset;
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;
* Store a SCM value into memory, OFFSET 32-bit words away from the
* current instruction pointer. OFFSET is a signed value.
*/
- VM_DEFINE_OP (51, static_set, "static-set!", OP2 (U8_U24, LO32))
+ VM_DEFINE_OP (55, static_set, "static-set!", OP2 (U8_U24, LO32))
{
scm_t_uint32 src;
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());
NEXT (2);
}
- /* link-procedure! src:24 offset:32
+ /* static-patch! _:24 dst-offset:32 src-offset:32
*
- * Set the code pointer of the procedure in SRC to point OFFSET 32-bit
- * words away from the current instruction pointer. OFFSET is a
- * signed value.
+ * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
+ * are signed 32-bit values, indicating a memory address as a number
+ * of 32-bit words away from the current instruction pointer.
*/
- VM_DEFINE_OP (52, link_procedure, "link-procedure!", OP2 (U8_U24, L32))
+ VM_DEFINE_OP (56, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32))
{
- scm_t_uint32 src;
- scm_t_int32 offset;
- scm_t_uint32* loc;
+ scm_t_int32 dst_offset, src_offset;
+ void *src;
+ void** dst_loc;
- SCM_UNPACK_RTL_24 (op, src);
- offset = ip[1];
- loc = ip + offset;
+ dst_offset = ip[1];
+ src_offset = ip[2];
- SCM_SET_CELL_WORD_1 (LOCAL_REF (src), (scm_t_bits) loc);
+ dst_loc = (void **) (ip + dst_offset);
+ src = ip + src_offset;
+ VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
- NEXT (2);
+ *dst_loc = src;
+
+ NEXT (3);
}
\f
*
* Store the current module in DST.
*/
- VM_DEFINE_OP (53, current_module, "current-module", OP1 (U8_U24) | OP_DST)
+ VM_DEFINE_OP (57, current_module, "current-module", OP1 (U8_U24) | OP_DST)
{
scm_t_uint32 dst;
- SCM_UNPACK_RTL_24 (op, dst);
+ UNPACK_24 (op, dst);
SYNC_IP ();
LOCAL_SET (dst, scm_current_module ());
* Resolve SYM in the current module, and place the resulting variable
* in DST.
*/
- VM_DEFINE_OP (54, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
+ VM_DEFINE_OP (58, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
{
scm_t_uint32 dst;
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);
}
- /* define sym:12 val:12
+ /* define! sym:12 val:12
*
* Look up a binding for SYM in the current module, creating it if
* necessary. Set its value to VAL.
*/
- VM_DEFINE_OP (55, define, "define", OP1 (U8_U12_U12))
+ 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);
* DST, and caching the resolved variable so that we will hit the cache next
* time.
*/
- VM_DEFINE_OP (56, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
+ VM_DEFINE_OP (60, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
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;
}
* Like toplevel-box, except MOD-OFFSET points at the name of a module
* instead of the module itself.
*/
- VM_DEFINE_OP (57, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
+ VM_DEFINE_OP (61, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
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;
}
* will expect a multiple-value return as if from a call with the
* procedure at PROC-SLOT.
*/
- VM_DEFINE_OP (58, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
+ VM_DEFINE_OP (62, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
{
scm_t_uint32 tag, proc_slot;
scm_t_int32 offset;
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);
}
* the compiler should have inserted checks that they wind and unwind
* procs are thunks, if it could not prove that to be the case.
*/
- VM_DEFINE_OP (59, wind, "wind", OP1 (U8_U12_U12))
+ 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);
}
- /* abort tag:24 _:8 proc:24
- *
- * Return a number of values to a prompt handler. The values are
- * expected in a frame pushed on at PROC.
- */
- VM_DEFINE_OP (60, abort, "abort", OP2 (U8_U24, X8_U24))
-#if 0
- {
- scm_t_uint32 tag, from, nvalues;
- SCM *base;
-
- SCM_UNPACK_RTL_24 (op, tag);
- SCM_UNPACK_RTL_24 (ip[1], from);
- base = (fp - 1) + from + 3;
- nvalues = FRAME_LOCALS_COUNT () - from - 3;
-
- SYNC_IP ();
- vm_abort (vm, LOCAL_REF (tag), base, nvalues, ®isters);
-
- /* vm_abort should not return */
- abort ();
- }
-#else
- abort();
-#endif
-
/* unwind _:24
*
* A normal exit from the dynamic extent of an expression. Pop the top
* entry off of the dynamic stack.
*/
- VM_DEFINE_OP (61, unwind, "unwind", OP1 (U8_X24))
+ VM_DEFINE_OP (64, unwind, "unwind", OP1 (U8_X24))
{
scm_dynstack_pop (¤t_thread->dynstack);
NEXT (1);
* allocated in a continguous range on the stack, starting from
* FLUID-BASE. The values do not have this restriction.
*/
- VM_DEFINE_OP (62, push_fluid, "push-fluid", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (65, push_fluid, "push-fluid", OP1 (U8_U12_U12))
{
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),
* Leave the dynamic extent of a with-fluids expression, restoring the
* fluids to their previous values.
*/
- VM_DEFINE_OP (63, pop_fluid, "pop-fluid", OP1 (U8_X24))
+ VM_DEFINE_OP (66, pop_fluid, "pop-fluid", OP1 (U8_X24))
{
/* This function must not allocate. */
scm_dynstack_unwind_fluid (¤t_thread->dynstack,
*
* Reference the fluid in SRC, and place the value in DST.
*/
- VM_DEFINE_OP (64, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (67, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
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))
*
* Set the value of the fluid in DST to the value in SRC.
*/
- VM_DEFINE_OP (65, fluid_set, "fluid-set", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (68, fluid_set, "fluid-set", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
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))
*
* Store the length of the string in SRC in DST.
*/
- VM_DEFINE_OP (66, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (69, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (str);
if (SCM_LIKELY (scm_is_string (str)))
* Fetch the character at position IDX in the string in SRC, and store
* it in DST.
*/
- VM_DEFINE_OP (67, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (70, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (str, idx);
*
* Parse a string in SRC to a number, and store in DST.
*/
- VM_DEFINE_OP (68, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (71, string_to_number, "string->number", 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_string_to_number (LOCAL_REF (src),
*
* Parse a string in SRC to a symbol, and store in DST.
*/
- VM_DEFINE_OP (69, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (72, string_to_symbol, "string->symbol", 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_string_to_symbol (LOCAL_REF (src)));
NEXT (1);
*
* Make a keyword from the symbol in SRC, and store it in DST.
*/
- VM_DEFINE_OP (70, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
+ 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);
*
* Cons CAR and CDR, and store the result in DST.
*/
- VM_DEFINE_OP (71, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (74, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
RETURN (scm_cons (x, y));
*
* Place the car of SRC in DST.
*/
- VM_DEFINE_OP (72, car, "car", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (75, car, "car", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "car");
*
* Place the cdr of SRC in DST.
*/
- VM_DEFINE_OP (73, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (76, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "cdr");
*
* Set the car of DST to SRC.
*/
- VM_DEFINE_OP (74, set_car, "set-car!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (77, set_car, "set-car!", OP1 (U8_U12_U12))
{
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!");
*
* Set the cdr of DST to SRC.
*/
- VM_DEFINE_OP (75, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (78, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
{
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!");
*
* Add A to B, and place the result in DST.
*/
- VM_DEFINE_OP (76, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (79, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (+, scm_sum);
}
*
* Add 1 to the value in SRC, and place the result in DST.
*/
- VM_DEFINE_OP (77, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (80, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
*
* Subtract B from A, and place the result in DST.
*/
- VM_DEFINE_OP (78, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (81, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (-, scm_difference);
}
*
* Subtract 1 from SRC, and place the result in DST.
*/
- VM_DEFINE_OP (79, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (82, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
*
* Multiply A and B, and place the result in DST.
*/
- VM_DEFINE_OP (80, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (83, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
*
* Divide A by B, and place the result in DST.
*/
- VM_DEFINE_OP (81, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (84, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
*
* Divide A by B, and place the quotient in DST.
*/
- VM_DEFINE_OP (82, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (85, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
*
* Divide A by B, and place the remainder in DST.
*/
- VM_DEFINE_OP (83, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (86, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
*
* Place the modulo of A by B in DST.
*/
- VM_DEFINE_OP (84, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (87, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
*
* Shift A arithmetically by B bits, and place the result in DST.
*/
- VM_DEFINE_OP (85, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (88, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
*
* Place the bitwise AND of A and B into DST.
*/
- VM_DEFINE_OP (86, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (89, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
*
* Place the bitwise inclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (87, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (90, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
*
* Place the bitwise exclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (88, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (91, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
RETURN (scm_logxor (x, y));
}
+ /* make-vector/immediate dst:8 length:8 init:8
+ *
+ * Make a short vector of known size and write it to DST. The vector
+ * will have space for LENGTH slots, an immediate value. They will be
+ * filled with the value in slot INIT.
+ */
+ VM_DEFINE_OP (92, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
+ {
+ scm_t_uint8 dst, init;
+ scm_t_int32 length, n;
+ SCM val, vector;
+
+ UNPACK_8_8_8 (op, dst, length, init);
+
+ val = LOCAL_REF (init);
+ vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
+ for (n = 0; n < length; n++)
+ SCM_SIMPLE_VECTOR_SET (vector, n, val);
+ LOCAL_SET (dst, vector);
+ NEXT (1);
+ }
+
/* vector-length dst:12 src:12
*
* Store the length of the vector in SRC in DST.
*/
- VM_DEFINE_OP (89, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (93, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (vect);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
* Fetch the item at position IDX in the vector in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (90, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (94, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (vect, idx);
}
}
- /* constant-vector-ref dst:8 src:8 idx:8
+ /* vector-ref/immediate dst:8 src:8 idx:8
*
* Fill DST with the item IDX elements into the vector at SRC. Useful
* for building data types using vectors.
*/
- VM_DEFINE_OP (91, constant_vector_ref, "constant-vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (95, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
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)))
*
* Store SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (92, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (96, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx_var, src;
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);
NEXT (1);
}
+ /* vector-set!/immediate dst:8 idx:8 src:8
+ *
+ * Store SRC into the vector DST at index IDX. Here IDX is an
+ * immediate value.
+ */
+ VM_DEFINE_OP (97, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
+ {
+ scm_t_uint8 dst, idx, src;
+ SCM vect, val;
+
+ UNPACK_8_8_8 (op, dst, idx, src);
+ vect = LOCAL_REF (dst);
+ val = LOCAL_REF (src);
+
+ if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
+ && idx < SCM_I_VECTOR_LENGTH (vect)))
+ SCM_I_VECTOR_WELTS (vect)[idx] = val;
+ else
+ {
+ SYNC_IP ();
+ scm_vector_set_x (vect, scm_from_uint8 (idx), val);
+ }
+ NEXT (1);
+ }
+
\f
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (93, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (98, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
VM_VALIDATE_STRUCT (obj, "struct_vtable");
RETURN (SCM_STRUCT_VTABLE (obj));
}
- /* allocate-struct dst:8 vtable:8 nfields:8
+ /* allocate-struct/immediate dst:8 vtable:8 nfields:8
*
* Allocate a new struct with VTABLE, and place it in DST. The struct
* will be constructed with space for NFIELDS fields, which should
* correspond to the field count of the VTABLE.
*/
- VM_DEFINE_OP (94, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (99, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
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));
NEXT (1);
}
- /* struct-ref dst:8 src:8 idx:8
+ /* struct-ref/immediate dst:8 src:8 idx:8
*
* Fetch the item at slot IDX in the struct in SRC, and store it
- * in DST.
+ * in DST. IDX is an immediate unsigned 8-bit value.
*/
- VM_DEFINE_OP (95, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (100, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
- ARGS2 (obj, pos);
+ scm_t_uint8 dst, src, idx;
+ SCM obj;
+
+ UNPACK_8_8_8 (op, dst, src, idx);
+
+ obj = LOCAL_REF (src);
if (SCM_LIKELY (SCM_STRUCTP (obj)
&& SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
SCM_VTABLE_FLAG_SIMPLE)
- && SCM_I_INUMP (pos)))
- {
- SCM vtable;
- scm_t_bits index, len;
-
- /* True, an inum is a signed value, but cast to unsigned it will
- certainly be more than the length, so we will fall through if
- index is negative. */
- index = SCM_I_INUM (pos);
- vtable = SCM_STRUCT_VTABLE (obj);
- len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
-
- if (SCM_LIKELY (index < len))
- {
- scm_t_bits *data = SCM_STRUCT_DATA (obj);
- RETURN (SCM_PACK (data[index]));
- }
- }
+ && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
+ scm_vtable_index_size)))
+ RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
SYNC_IP ();
- RETURN (scm_struct_ref (obj, pos));
+ RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
}
- /* struct-set! dst:8 idx:8 src:8
+ /* struct-set!/immediate dst:8 idx:8 src:8
*
- * Store SRC into the struct DST at slot IDX.
+ * Store SRC into the struct DST at slot IDX. IDX is an immediate
+ * unsigned 8-bit value.
*/
- VM_DEFINE_OP (96, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (101, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
- SCM obj, pos, val;
-
- SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
+ SCM obj, val;
+
+ UNPACK_8_8_8 (op, dst, idx, src);
+
obj = LOCAL_REF (dst);
- pos = LOCAL_REF (idx);
val = LOCAL_REF (src);
-
+
if (SCM_LIKELY (SCM_STRUCTP (obj)
&& SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
SCM_VTABLE_FLAG_SIMPLE)
&& SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
SCM_VTABLE_FLAG_SIMPLE_RW)
- && SCM_I_INUMP (pos)))
+ && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
+ scm_vtable_index_size)))
{
- SCM vtable;
- scm_t_bits index, len;
-
- /* See above regarding index being >= 0. */
- index = SCM_I_INUM (pos);
- vtable = SCM_STRUCT_VTABLE (obj);
- len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- if (SCM_LIKELY (index < len))
- {
- scm_t_bits *data = SCM_STRUCT_DATA (obj);
- data[index] = SCM_UNPACK (val);
- NEXT (1);
- }
+ SCM_STRUCT_SLOT_SET (obj, idx, val);
+ NEXT (1);
}
SYNC_IP ();
- scm_struct_set_x (obj, pos, val);
+ scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
NEXT (1);
}
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (97, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (102, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
if (SCM_INSTANCEP (obj))
* DST. Unlike struct-ref, IDX is an 8-bit immediate value, not an
* index into the stack.
*/
- VM_DEFINE_OP (98, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ 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);
* Store SRC into slot IDX of the struct in DST. Unlike struct-set!,
* IDX is an 8-bit immediate value, not an index into the stack.
*/
- VM_DEFINE_OP (99, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
+ 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);
}
* from the instruction pointer, and store into DST. LEN is a byte
* length. OFFSET is signed.
*/
- VM_DEFINE_OP (100, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
+ VM_DEFINE_OP (105, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
{
scm_t_uint8 dst, type, shape;
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 ();
*
* Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
*/
- VM_DEFINE_OP (101, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
+ 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)));
RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
} while (0)
- VM_DEFINE_OP (102, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (107, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
- VM_DEFINE_OP (103, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (108, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s8, s8, int8, 1);
- VM_DEFINE_OP (104, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (109, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
- VM_DEFINE_OP (105, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (110, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
- VM_DEFINE_OP (106, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (111, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
#else
BV_INT_REF (u32, uint32, 4);
#endif
- VM_DEFINE_OP (107, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (112, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
#else
BV_INT_REF (s32, int32, 4);
#endif
- VM_DEFINE_OP (108, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (113, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (u64, uint64, 8);
- VM_DEFINE_OP (109, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (114, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (s64, int64, 8);
- VM_DEFINE_OP (110, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (115, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f32, ieee_single, float, 4);
- VM_DEFINE_OP (111, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (116, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f64, ieee_double, double, 8);
/* bv-u8-set! dst:8 idx:8 src:8
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); \
- VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
+ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
i = SCM_I_INUM (scm_idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
\
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); \
- VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
+ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
i = SCM_I_INUM (scm_idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
\
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); \
- VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
+ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
i = SCM_I_INUM (scm_idx); \
float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
\
NEXT (1); \
} while (0)
- VM_DEFINE_OP (112, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (117, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
- VM_DEFINE_OP (113, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (118, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
- VM_DEFINE_OP (114, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (119, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
- VM_DEFINE_OP (115, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (120, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
- VM_DEFINE_OP (116, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (121, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
#else
BV_INT_SET (u32, uint32, 4);
#endif
- VM_DEFINE_OP (117, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (122, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
#else
BV_INT_SET (s32, int32, 4);
#endif
- VM_DEFINE_OP (118, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (123, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (u64, uint64, 8);
- VM_DEFINE_OP (119, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (124, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (s64, int64, 8);
- VM_DEFINE_OP (120, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (125, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f32, ieee_single, float, 4);
- VM_DEFINE_OP (121, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (126, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f64, ieee_double, double, 8);
END_DISPATCH_SWITCH;
#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
HCoop / bpt / guile.git / blobdiff