diff options
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r-- | libguile/vm-engine.c | 4667 |
1 files changed, 1928 insertions, 2739 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 931017e2d..469a31cea 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1,21 +1,21 @@ -/* Copyright (C) 2001, 2009-2015, 2018, 2019 - * Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 3 of - * the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ +/* Copyright 2001,2009-2015,2017-2019 + Free Software Foundation, Inc. + + This file is part of Guile. + + Guile is free software: you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + Guile is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public + License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with Guile. If not, see + <https://www.gnu.org/licenses/>. */ /* This file is included in vm.c multiple times. */ @@ -37,14 +37,6 @@ } \ 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 \ { \ @@ -60,6 +52,21 @@ } \ while (0) +#define UNPACK_8_24(op,a,b) \ + do \ + { \ + a = op & 0xff; \ + b = op >> 8; \ + } \ + while (0) + +#define UNPACK_16_16(op,a,b) \ + do \ + { \ + a = op & 0xffff; \ + b = op >> 16; \ + } \ + 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 @@ -85,6 +92,8 @@ # define JT_REG #endif +#define VP (&thread->vm) + #define VM_ASSERT(condition, handler) \ do { \ if (SCM_UNLIKELY (!(condition))) \ @@ -101,31 +110,23 @@ #endif #if VM_USE_HOOKS -#define RUN_HOOK(exp) \ - do { \ - if (SCM_UNLIKELY (vp->trace_level > 0)) \ - { \ - SYNC_IP (); \ - exp; \ - CACHE_SP (); \ - } \ +#define RUN_HOOK(h) \ + do { \ + if (SCM_UNLIKELY (VP->h##_hook_enabled)) \ + { \ + SYNC_IP (); \ + invoke_##h##_hook (thread); \ + CACHE_SP (); \ + } \ } while (0) #else -#define RUN_HOOK(exp) +#define RUN_HOOK(h) #endif -#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 (apply) -#define PUSH_CONTINUATION_HOOK() \ - RUN_HOOK0 (push_continuation) -#define POP_CONTINUATION_HOOK(old_fp) \ - RUN_HOOK1 (pop_continuation, old_fp) -#define NEXT_HOOK() \ - RUN_HOOK0 (next) -#define ABORT_CONTINUATION_HOOK() \ - RUN_HOOK0 (abort) +#define APPLY_HOOK() RUN_HOOK (apply) +#define RETURN_HOOK() RUN_HOOK (return) +#define NEXT_HOOK() RUN_HOOK (next) +#define ABORT_HOOK() RUN_HOOK (abort) @@ -138,12 +139,12 @@ the VM. We do the same for SP. The FP is used more by code outside the VM than by the VM itself, we don't bother caching it locally. - Keeping vp->ip in sync with the local IP would be a big lose, as it - is updated so often. Instead of updating vp->ip all the time, we + Keeping VP->ip in sync with the local IP would be a big lose, as it + is updated so often. Instead of updating VP->ip all the time, we call SYNC_IP whenever we would need to know the IP of the top frame. In practice, we need to SYNC_IP whenever we call out of the VM to a function that would like to walk the stack, perhaps as the result of - an exception. On the other hand, we do always keep vp->sp in sync + an exception. On the other hand, we do always keep VP->sp in sync with the local SP. One more thing. We allow the stack to move, when it expands. @@ -151,16 +152,19 @@ code, or otherwise push anything on the stack, you will need to CACHE_SP afterwards to restore the possibly-changed stack pointer. */ -#define SYNC_IP() vp->ip = (ip) +#define SYNC_IP() VP->ip = (ip) -#define CACHE_SP() sp = vp->sp +#define CACHE_SP() sp = VP->sp #define CACHE_REGISTER() \ do { \ - ip = vp->ip; \ + ip = VP->ip; \ CACHE_SP (); \ } while (0) +#define CALL_INTRINSIC(x, args) \ + (((struct scm_vm_intrinsics *) (void*) intrinsics)->x args) + /* Reserve stack space for a frame. Will check that there is sufficient stack space for N locals, including the procedure. Invoke after preparing the new frame and setting the fp and ip. @@ -171,42 +175,43 @@ FP is valid across an ALLOC_FRAME call. Be careful! */ #define ALLOC_FRAME(n) \ do { \ - sp = vp->fp - (n); \ - if (sp < vp->sp_min_since_gc) \ + sp = VP->fp - (n); \ + if (sp < VP->sp_min_since_gc) \ { \ - if (SCM_UNLIKELY (sp < vp->stack_limit)) \ + if (SCM_UNLIKELY (sp < VP->stack_limit)) \ { \ SYNC_IP (); \ - vm_expand_stack (vp, sp); \ + CALL_INTRINSIC (expand_stack, (thread, sp)); \ CACHE_SP (); \ } \ else \ - vp->sp_min_since_gc = vp->sp = sp; \ + VP->sp_min_since_gc = VP->sp = sp; \ } \ else \ - vp->sp = sp; \ + VP->sp = sp; \ } while (0) /* Reset the current frame to hold N locals. Used when we know that no - stack expansion is needed. */ + stack expansion is needed. Note that in some cases this may lower + SP, e.g. after a return but where there are more locals below, but we + know it was preceded by an alloc-frame in that case, so no stack need + be allocated. + + As an optimization, we don't update sp_min_since_gc in this case; the + principal place stacks are expanded is in ALLOC_FRAME. it doesn't + need to strictly be the min since GC, as it's just an optimization to + prevent passing too-large of a range to madvise. */ #define RESET_FRAME(n) \ do { \ - vp->sp = sp = vp->fp - (n); \ - if (sp < vp->sp_min_since_gc) \ - vp->sp_min_since_gc = sp; \ + VP->sp = sp = VP->fp - (n); \ } while (0) /* 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() (vp->fp - sp) +#define FRAME_LOCALS_COUNT() (VP->fp - sp) #define FRAME_LOCALS_COUNT_FROM(slot) (FRAME_LOCALS_COUNT () - slot) -/* Restore registers after returning from a frame. */ -#define RESTORE_FRAME() \ - do { \ - } while (0) - #ifdef HAVE_LABELS_AS_VALUES # define BEGIN_DISPATCH_SWITCH /* */ @@ -243,9 +248,9 @@ case opcode: #endif -#define FP_SLOT(i) SCM_FRAME_SLOT (vp->fp, i) -#define FP_REF(i) SCM_FRAME_LOCAL (vp->fp, i) -#define FP_SET(i,o) SCM_FRAME_LOCAL (vp->fp, i) = o +#define FP_SLOT(i) SCM_FRAME_SLOT (VP->fp, i) +#define FP_REF(i) SCM_FRAME_LOCAL (VP->fp, i) +#define FP_SET(i,o) SCM_FRAME_LOCAL (VP->fp, i) = o #define SP_REF_SLOT(i) (sp[i]) #define SP_SET_SLOT(i,o) (sp[i] = o) @@ -262,197 +267,19 @@ #define SP_REF_S64(i) (sp[i].as_s64) #define SP_SET_S64(i,o) (sp[i].as_s64 = o) -#define VARIABLE_REF(v) SCM_VARIABLE_REF (v) -#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) -#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED)) - -#define BR_NARGS(rel) \ - scm_t_uint32 expected; \ - UNPACK_24 (op, expected); \ - if (FRAME_LOCALS_COUNT() rel expected) \ - { \ - scm_t_int32 offset = ip[1]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (2) - -#define BR_UNARY(x, exp) \ - scm_t_uint32 test; \ - SCM x; \ - UNPACK_24 (op, test); \ - x = SP_REF (test); \ - if ((ip[1] & 0x1) ? !(exp) : (exp)) \ - { \ - scm_t_int32 offset = ip[1]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (2) - -#define BR_BINARY(x, y, exp) \ - scm_t_uint32 a, b; \ - SCM x, y; \ - UNPACK_24 (op, a); \ - UNPACK_24 (ip[1], b); \ - x = SP_REF (a); \ - y = SP_REF (b); \ - if ((ip[2] & 0x1) ? !(exp) : (exp)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3) - -#define BR_ARITHMETIC(crel,srel) \ - { \ - scm_t_uint32 a, b; \ - SCM x, y; \ - UNPACK_24 (op, a); \ - UNPACK_24 (ip[1], b); \ - x = SP_REF (a); \ - y = SP_REF (b); \ - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ - { \ - scm_t_signed_bits x_bits = SCM_UNPACK (x); \ - scm_t_signed_bits y_bits = SCM_UNPACK (y); \ - if ((ip[2] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } \ - else \ - { \ - SCM res; \ - SYNC_IP (); \ - res = srel (x, y); \ - CACHE_SP (); \ - if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } \ - } - -#define BR_U64_ARITHMETIC(crel) \ - { \ - scm_t_uint32 a, b; \ - scm_t_uint64 x, y; \ - UNPACK_24 (op, a); \ - UNPACK_24 (ip[1], b); \ - x = SP_REF_U64 (a); \ - y = SP_REF_U64 (b); \ - if ((ip[2] & 0x1) ? !(x crel y) : (x crel y)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } - -#define BR_F64_ARITHMETIC(crel) \ - { \ - scm_t_uint32 a, b; \ - double x, y; \ - UNPACK_24 (op, a); \ - UNPACK_24 (ip[1], b); \ - x = SP_REF_F64 (a); \ - y = SP_REF_F64 (b); \ - if ((ip[2] & 0x1) ? !(x crel y) : (x crel y)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } - - -#define ARGS1(a1) \ - scm_t_uint16 dst, src; \ - SCM a1; \ - UNPACK_12_12 (op, dst, src); \ - a1 = SP_REF (src) -#define ARGS2(a1, a2) \ - scm_t_uint8 dst, src1, src2; \ - SCM a1, a2; \ - UNPACK_8_8_8 (op, dst, src1, src2); \ - a1 = SP_REF (src1); \ - a2 = SP_REF (src2) -#define RETURN(x) \ - do { SP_SET (dst, x); NEXT (1); } while (0) -#define RETURN_EXP(exp) \ - do { SCM __x; SYNC_IP (); __x = exp; CACHE_SP (); RETURN (__x); } while (0) - -/* The maximum/minimum tagged integers. */ -#define INUM_MAX \ - ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM))) -#define INUM_MIN \ - ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM))) -#define INUM_STEP \ - ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \ - - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0)) - -#define BINARY_INTEGER_OP(CFUNC,SFUNC) \ - { \ - ARGS2 (x, y); \ - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ - { \ - scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \ - if (SCM_FIXABLE (n)) \ - RETURN (SCM_I_MAKINUM (n)); \ - } \ - RETURN_EXP (SFUNC (x, y)); \ - } - -#define VM_VALIDATE(x, pred, proc, what) \ - VM_ASSERT (pred (x), vm_error_not_a_ ## what (proc, x)) - -#define VM_VALIDATE_ATOMIC_BOX(x, proc) \ - VM_VALIDATE (x, scm_is_atomic_box, proc, atomic_box) -#define VM_VALIDATE_BYTEVECTOR(x, proc) \ - VM_VALIDATE (x, SCM_BYTEVECTOR_P, proc, bytevector) -#define VM_VALIDATE_MUTABLE_BYTEVECTOR(obj, proc) \ - VM_VALIDATE (obj, SCM_MUTABLE_BYTEVECTOR_P, proc, mutable_bytevector) -#define VM_VALIDATE_CHAR(x, proc) \ - VM_VALIDATE (x, SCM_CHARP, proc, char) -#define VM_VALIDATE_PAIR(x, proc) \ - VM_VALIDATE (x, scm_is_pair, proc, pair) -#define VM_VALIDATE_MUTABLE_PAIR(x, proc) \ - VM_VALIDATE (x, scm_is_mutable_pair, proc, mutable_pair) -#define VM_VALIDATE_STRING(obj, proc) \ - VM_VALIDATE (obj, scm_is_string, proc, string) -#define VM_VALIDATE_STRUCT(obj, proc) \ - VM_VALIDATE (obj, SCM_STRUCTP, proc, struct) -#define VM_VALIDATE_VARIABLE(obj, proc) \ - VM_VALIDATE (obj, SCM_VARIABLEP, proc, variable) -#define VM_VALIDATE_VECTOR(obj, proc) \ - VM_VALIDATE (obj, SCM_I_IS_VECTOR, proc, vector) -#define VM_VALIDATE_MUTABLE_VECTOR(obj, proc) \ - VM_VALIDATE (obj, SCM_I_IS_MUTABLE_VECTOR, proc, mutable_vector) - -#define VM_VALIDATE_INDEX(u64, size, proc) \ - VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64)) +#define SP_REF_PTR(i) (sp[i].as_ptr) +#define SP_SET_PTR(i,o) (sp[i].as_ptr = o) /* Return true (non-zero) if PTR has suitable alignment for TYPE. */ #define ALIGNED_P(ptr, type) \ - ((scm_t_uintptr) (ptr) % alignof_type (type) == 0) + ((uintptr_t) (ptr) % alignof_type (type) == 0) static SCM -VM_NAME (scm_i_thread *thread, struct scm_vm *vp, - scm_i_jmp_buf *registers, int resume) +VM_NAME (scm_thread *thread) { /* Instruction pointer: A pointer to the opcode that is currently running. */ - register scm_t_uint32 *ip IP_REG; + register uint32_t *ip IP_REG; /* Stack pointer: A pointer to the hot end of the stack, off of which we index arguments and local variables. Pushed at function calls, @@ -460,7 +287,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, register union scm_vm_stack_element *sp FP_REG; /* Current opcode: A cache of *ip. */ - register scm_t_uint32 op; + register uint32_t op; + + void **intrinsics = (void**) &scm_vm_intrinsics; #ifdef HAVE_LABELS_AS_VALUES static const void *jump_table_[256] = { @@ -477,20 +306,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, /* Load VM registers. */ CACHE_REGISTER (); - /* Usually a call to the VM happens on application, with the boot - continuation on the next frame. Sometimes it happens after a - non-local exit however; in that case the VM state is all set up, - and we have but to jump to the next opcode. */ - if (SCM_UNLIKELY (resume)) - NEXT (0); - - if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) - ip = SCM_PROGRAM_CODE (FP_REF (0)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; - - APPLY_HOOK (); - + /* Start processing! */ NEXT (0); BEGIN_DISPATCH_SWITCH; @@ -498,44 +314,131 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, - /* - * Call and return - */ - /* halt _:24 * * Bring the VM to a halt, returning all the values from the stack. */ VM_DEFINE_OP (0, halt, "halt", OP1 (X32)) { - /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */ - - scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4); + size_t frame_size = 3; + /* Empty frame, then values. */ + size_t first_value = frame_size; + uint32_t nvals = FRAME_LOCALS_COUNT_FROM (first_value); + union scm_vm_stack_element *fp; SCM ret; if (nvals == 1) - ret = FP_REF (4); + ret = FP_REF (first_value); else { - scm_t_uint32 n; - ret = SCM_EOL; + uint32_t n; SYNC_IP (); - for (n = nvals; n > 0; n--) - ret = scm_inline_cons (thread, FP_REF (4 + n - 1), ret); - ret = scm_values (ret); + VM_ASSERT (nvals <= (UINTPTR_MAX >> 8), abort ()); + ret = scm_words ((nvals << 8) | scm_tc7_values, nvals + 1); + for (n = 0; n < nvals; n++) + SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (first_value + n)); } - vp->ip = SCM_FRAME_RETURN_ADDRESS (vp->fp); - vp->sp = SCM_FRAME_PREVIOUS_SP (vp->fp); - vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp); + fp = VP->fp; + VP->fp = SCM_FRAME_DYNAMIC_LINK (fp); + VP->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp); + VP->sp = SCM_FRAME_PREVIOUS_SP (fp); return ret; } + /* instrument-entry _:24 data:32 + * + * Increase execution counter for this function and potentially tier + * up to the next JIT level. DATA is an offset to a structure + * recording execution counts and the next-level JIT code + * corresponding to this function. Also run the apply hook. + */ + VM_DEFINE_OP (1, instrument_entry, "instrument-entry", OP2 (X32, N32)) + { +#if ENABLE_JIT + if (!VP->disable_mcode) + { + struct scm_jit_function_data *data; + + int32_t data_offset = ip[1]; + data = (struct scm_jit_function_data *) (ip + data_offset); + + if (data->mcode) + { + SYNC_IP (); + scm_jit_enter_mcode (thread, data->mcode); + CACHE_REGISTER (); + NEXT (0); + } + + if (data->counter >= scm_jit_counter_threshold) + { + const uint8_t *mcode; + + SYNC_IP (); + mcode = scm_jit_compute_mcode (thread, data); + + if (mcode) + { + scm_jit_enter_mcode (thread, mcode); + CACHE_REGISTER (); + NEXT (0); + } + } + else + data->counter += SCM_JIT_COUNTER_ENTRY_INCREMENT; + } +#endif + + APPLY_HOOK (); + + NEXT (2); + } + + /* instrument-loop _:24 data:32 + * + * Increase execution counter for this function and potentially tier + * up to the next JIT level. DATA is an offset to a structure + * recording execution counts and the next-level JIT code + * corresponding to this function. + */ + VM_DEFINE_OP (2, instrument_loop, "instrument-loop", OP2 (X32, N32)) + { +#if ENABLE_JIT + if (!VP->disable_mcode) + { + int32_t data_offset = ip[1]; + struct scm_jit_function_data *data; + + data = (struct scm_jit_function_data *) (ip + data_offset); + + if (data->counter >= scm_jit_counter_threshold) + { + const uint8_t *mcode; + + SYNC_IP (); + mcode = scm_jit_compute_mcode (thread, data); + + if (mcode) + { + scm_jit_enter_mcode (thread, mcode); + CACHE_REGISTER (); + NEXT (0); + } + } + else + data->counter += SCM_JIT_COUNTER_LOOP_INCREMENT; + } +#endif + + NEXT (2); + } + /* call proc:24 _:8 nlocals:24 * * Call a procedure. PROC is the local corresponding to a procedure. - * The two values below PROC will be overwritten by the saved call + * The three values below PROC will be overwritten by the saved call * frame data. The new frame will have space for NLOCALS locals: one * for the procedure, and the rest for the arguments which should * already have been pushed on. @@ -543,32 +446,26 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * When the call returns, execution proceeds with the next * instruction. There may be any number of values on the return * stack; the precise number can be had by subtracting the address of - * PROC from the post-call SP. + * slot PROC-1 from the post-call SP. */ - VM_DEFINE_OP (1, call, "call", OP2 (X8_F24, X8_C24)) + VM_DEFINE_OP (3, call, "call", OP2 (X8_F24, X8_C24)) { - scm_t_uint32 proc, nlocals; + uint32_t proc, nlocals; union scm_vm_stack_element *old_fp, *new_fp; UNPACK_24 (op, proc); UNPACK_24 (ip[1], nlocals); - PUSH_CONTINUATION_HOOK (); - - old_fp = vp->fp; + old_fp = VP->fp; new_fp = SCM_FRAME_SLOT (old_fp, proc - 1); SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp); - SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip + 2); - vp->fp = new_fp; + SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 2); + SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0); + VP->fp = new_fp; RESET_FRAME (nlocals); - - if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) - ip = SCM_PROGRAM_CODE (FP_REF (0)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; - - APPLY_HOOK (); + ip = CALL_INTRINSIC (get_callee_vcode, (thread)); + CACHE_SP (); NEXT (0); } @@ -580,110 +477,90 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * This instruction is just like "call", except that instead of * dereferencing PROC to find the call target, the call target is * known to be at LABEL, a signed 32-bit offset in 32-bit units from - * the current IP. Since PROC is not dereferenced, it may be some - * other representation of the closure. + * the current IP. Since PROC is not used to compute the callee code, + * it may be some other representation of the closure. */ - VM_DEFINE_OP (2, call_label, "call-label", OP3 (X8_F24, X8_C24, L32)) + VM_DEFINE_OP (4, call_label, "call-label", OP3 (X8_F24, X8_C24, L32)) { - scm_t_uint32 proc, nlocals; - scm_t_int32 label; + uint32_t proc, nlocals; + int32_t label; union scm_vm_stack_element *old_fp, *new_fp; UNPACK_24 (op, proc); UNPACK_24 (ip[1], nlocals); label = ip[2]; - PUSH_CONTINUATION_HOOK (); - - old_fp = vp->fp; + old_fp = VP->fp; new_fp = SCM_FRAME_SLOT (old_fp, proc - 1); SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp); - SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip + 3); - vp->fp = new_fp; + SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 3); + SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0); + VP->fp = new_fp; RESET_FRAME (nlocals); ip += label; - APPLY_HOOK (); - NEXT (0); } - /* tail-call nlocals:24 + /* tail-call _:24 * - * Tail-call a procedure. Requires that the procedure and all of the - * arguments have already been shuffled into position. Will reset the - * frame to NLOCALS. + * Tail-call the procedure in slot 0 with the arguments in the current + * stack frame. Requires that the procedure and all of the arguments + * have already been shuffled into position. */ - VM_DEFINE_OP (3, tail_call, "tail-call", OP1 (X8_C24)) + VM_DEFINE_OP (5, tail_call, "tail-call", OP1 (X32)) { - scm_t_uint32 nlocals; - - UNPACK_24 (op, nlocals); - - RESET_FRAME (nlocals); - - if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) - ip = SCM_PROGRAM_CODE (FP_REF (0)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; - - APPLY_HOOK (); - + ip = CALL_INTRINSIC (get_callee_vcode, (thread)); + CACHE_SP (); NEXT (0); } - /* tail-call-label nlocals:24 label:32 + /* tail-call-label _:24 label:32 * * Tail-call a known procedure. As call is to call-label, tail-call * is to tail-call-label. */ - VM_DEFINE_OP (4, tail_call_label, "tail-call-label", OP2 (X8_C24, L32)) + VM_DEFINE_OP (6, tail_call_label, "tail-call-label", OP2 (X32, L32)) { - scm_t_uint32 nlocals; - scm_t_int32 label; + int32_t label; - UNPACK_24 (op, nlocals); label = ip[1]; - RESET_FRAME (nlocals); - ip += label; - APPLY_HOOK (); - NEXT (0); } - /* tail-call/shuffle from:24 + /* return-values _: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. + * Return all values from a call frame. */ - VM_DEFINE_OP (5, tail_call_shuffle, "tail-call/shuffle", OP1 (X8_F24)) + VM_DEFINE_OP (7, return_values, "return-values", OP1 (X32)) { - scm_t_uint32 n, from, nlocals; - - UNPACK_24 (op, from); - - VM_ASSERT (from > 0, abort ()); - nlocals = FRAME_LOCALS_COUNT (); - - for (n = 0; from + n < nlocals; n++) - FP_SET (n + 1, FP_REF (from + n)); + union scm_vm_stack_element *old_fp; + uint8_t *mcode; - RESET_FRAME (n + 1); + RETURN_HOOK (); - if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) - ip = SCM_PROGRAM_CODE (FP_REF (0)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; + old_fp = VP->fp; + VP->fp = SCM_FRAME_DYNAMIC_LINK (old_fp); - APPLY_HOOK (); +#if ENABLE_JIT + if (!VP->disable_mcode) + { + mcode = SCM_FRAME_MACHINE_RETURN_ADDRESS (old_fp); + if (mcode && mcode != scm_jit_return_to_interpreter_trampoline) + { + scm_jit_enter_mcode (thread, mcode); + CACHE_REGISTER (); + NEXT (0); + } + } +#endif + ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (old_fp); NEXT (0); } @@ -693,14 +570,15 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * PROC, asserting that the call actually returned at least one * value. Afterwards, resets the frame to NLOCALS locals. */ - VM_DEFINE_OP (6, receive, "receive", OP2 (X8_F12_F12, X8_C24) | OP_DST) + VM_DEFINE_OP (8, receive, "receive", DOP2 (X8_F12_F12, X8_C24)) { - scm_t_uint16 dst, proc; - scm_t_uint32 nlocals; + uint16_t dst, proc; + uint32_t nlocals; UNPACK_12_12 (op, dst, proc); UNPACK_24 (ip[1], nlocals); - VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ()); - FP_SET (dst, FP_REF (proc + 1)); + VM_ASSERT (FRAME_LOCALS_COUNT () > proc, + CALL_INTRINSIC (error_no_values, ())); + FP_SET (dst, FP_REF (proc)); RESET_FRAME (nlocals); NEXT (2); } @@ -713,416 +591,296 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * return values equals NVALUES exactly. After receive-values has * run, the values can be copied down via `mov'. */ - VM_DEFINE_OP (7, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24)) + VM_DEFINE_OP (9, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24)) { - scm_t_uint32 proc, nvalues; + uint32_t proc, 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_ASSERT (FRAME_LOCALS_COUNT () >= proc + nvalues, + CALL_INTRINSIC (error_not_enough_values, ())); else - VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues, - vm_error_wrong_number_of_values (nvalues)); + VM_ASSERT (FRAME_LOCALS_COUNT () == proc + nvalues, + CALL_INTRINSIC (error_wrong_number_of_values, (nvalues))); NEXT (2); } - VM_DEFINE_OP (8, unused_8, NULL, NOP) - { - vm_error_bad_instruction (op); - abort (); /* never reached */ - } - - /* return-values nlocals:24 + /* assert-nargs-ee expected:24 + * assert-nargs-ge expected:24 + * assert-nargs-le expected:24 * - * Return a number of values from a call frame. This opcode - * corresponds to an application of `values' in tail position. As - * with tail calls, we expect that the values have already been - * shuffled down to a contiguous array starting at slot 1. - * If NLOCALS is not zero, we also reset the frame to hold NLOCALS - * values. + * If the number of actual arguments is not ==, >=, or <= EXPECTED, + * respectively, signal an error. */ - VM_DEFINE_OP (9, return_values, "return-values", OP1 (X8_C24)) + VM_DEFINE_OP (10, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24)) { - union scm_vm_stack_element *old_fp; - scm_t_uint32 nlocals; - - UNPACK_24 (op, nlocals); - if (nlocals) - RESET_FRAME (nlocals); - - old_fp = vp->fp; - ip = SCM_FRAME_RETURN_ADDRESS (vp->fp); - vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp); - - /* Clear stack frame. */ - old_fp[0].as_scm = SCM_BOOL_F; - old_fp[1].as_scm = SCM_BOOL_F; - - POP_CONTINUATION_HOOK (old_fp); - - NEXT (0); + uint32_t expected; + UNPACK_24 (op, expected); + VM_ASSERT (FRAME_LOCALS_COUNT () == expected, + CALL_INTRINSIC (error_wrong_num_args, (thread))); + NEXT (1); + } + VM_DEFINE_OP (11, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24)) + { + uint32_t expected; + UNPACK_24 (op, expected); + VM_ASSERT (FRAME_LOCALS_COUNT () >= expected, + CALL_INTRINSIC (error_wrong_num_args, (thread))); + NEXT (1); + } + VM_DEFINE_OP (12, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24)) + { + uint32_t expected; + UNPACK_24 (op, expected); + VM_ASSERT (FRAME_LOCALS_COUNT () <= expected, + CALL_INTRINSIC (error_wrong_num_args, (thread))); + NEXT (1); } - - - - /* - * Specialized call stubs - */ - - /* subr-call _:24 + /* assert-nargs-ee/locals expected:12 nlocals:12 * - * Call a subr, passing all locals in this frame as arguments. Return - * from the calling frame. This instruction is part of the - * trampolines created in gsubr.c, and is not generated by the - * compiler. + * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The + * number of locals reserved is EXPECTED + NLOCALS. */ - VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X32)) + VM_DEFINE_OP (13, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12)) { - SCM ret; - - SYNC_IP (); - ret = scm_apply_subr (sp, FRAME_LOCALS_COUNT ()); - CACHE_SP (); + uint16_t expected, nlocals; + UNPACK_12_12 (op, expected, nlocals); + VM_ASSERT (FRAME_LOCALS_COUNT () == expected, + CALL_INTRINSIC (error_wrong_num_args, (thread))); + ALLOC_FRAME (expected + nlocals); - if (SCM_UNLIKELY (SCM_VALUESP (ret))) - { - SCM vals = scm_struct_ref (ret, SCM_INUM0); - long len = scm_ilength (vals); - ALLOC_FRAME (1 + len); - while (len--) - { - SP_SET (len, SCM_CAR (vals)); - vals = SCM_CDR (vals); - } - NEXT (1); - } - else - { - ALLOC_FRAME (2); - SP_SET (0, ret); - NEXT (1); - } + NEXT (1); } - /* foreign-call cif-idx:12 ptr-idx:12 + /* arguments<=? expected:24 * - * Call a foreign function. Fetch the CIF and foreign pointer from - * CIF-IDX and PTR-IDX, both free variables. Return from the calling - * frame. Arguments are taken from the stack. This instruction is - * part of the trampolines created by the FFI, and is not generated by - * the compiler. + * Set the LESS_THAN, EQUAL, or NONE comparison result values if the + * number of arguments is respectively less than, equal to, or greater + * than EXPECTED. */ - VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (X8_C12_C12)) + VM_DEFINE_OP (14, check_arguments, "arguments<=?", OP1 (X8_C24)) { - scm_t_uint16 cif_idx, ptr_idx; - int err = 0; - SCM closure, cif, pointer, ret; + uint8_t compare_result; + uint32_t expected; + ptrdiff_t nargs; - UNPACK_12_12 (op, cif_idx, ptr_idx); - - closure = FP_REF (0); - cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx); - pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx); + UNPACK_24 (op, expected); + nargs = FRAME_LOCALS_COUNT (); - SYNC_IP (); - ret = scm_i_foreign_call (cif, pointer, &err, sp); - CACHE_SP (); + if (nargs < (ptrdiff_t) expected) + compare_result = SCM_F_COMPARE_LESS_THAN; + else if (nargs == (ptrdiff_t) expected) + compare_result = SCM_F_COMPARE_EQUAL; + else + compare_result = SCM_F_COMPARE_NONE; - ALLOC_FRAME (3); - SP_SET (1, ret); - SP_SET (0, scm_from_int (err)); + VP->compare_result = compare_result; NEXT (1); } - /* continuation-call contregs:24 + /* positional-arguments<=? nreq:24 _:8 expected:24 * - * Return to a continuation, nonlocally. The arguments to the - * continuation are taken from the stack. CONTREGS is a free variable - * containing the reified continuation. This instruction is part of - * the implementation of undelimited continuations, and is not - * generated by the compiler. + * Set the LESS_THAN, EQUAL, or NONE comparison result values if the + * number of positional arguments is less than, equal to, or greater + * than EXPECTED. The first NREQ arguments are positional arguments, + * as are the subsequent arguments that are not keywords. */ - VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (X8_C24)) + VM_DEFINE_OP (15, check_positional_arguments, "positional-arguments<=?", OP2 (X8_C24, X8_C24)) { - SCM contregs; - scm_t_uint32 contregs_idx; - - UNPACK_24 (op, contregs_idx); + uint8_t compare_result; + uint32_t nreq, expected; + ptrdiff_t nargs, npos; - contregs = - SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx); - - SYNC_IP (); - scm_i_check_continuation (contregs); - vm_return_to_continuation (scm_i_contregs_vp (contregs), - scm_i_contregs_vm_cont (contregs), - FRAME_LOCALS_COUNT_FROM (1), - sp); - scm_i_reinstate_continuation (contregs); + UNPACK_24 (op, nreq); + UNPACK_24 (ip[1], expected); + nargs = FRAME_LOCALS_COUNT (); - /* no NEXT */ - abort (); - } + /* Precondition: at least NREQ arguments. */ + for (npos = nreq; npos < nargs && npos <= expected; npos++) + if (scm_is_keyword (FP_REF (npos))) + break; - /* compose-continuation cont:24 - * - * Compose a partial continuation with the current continuation. The - * arguments to the continuation are taken from the stack. CONT is a - * free variable containing the reified continuation. This - * instruction is part of the implementation of partial continuations, - * and is not generated by the compiler. - */ - VM_DEFINE_OP (13, compose_continuation, "compose-continuation", OP1 (X8_C24)) - { - SCM vmcont; - scm_t_uint32 cont_idx; + if (npos < (ptrdiff_t) expected) + compare_result = SCM_F_COMPARE_LESS_THAN; + else if (npos == (ptrdiff_t) expected) + compare_result = SCM_F_COMPARE_EQUAL; + else + compare_result = SCM_F_COMPARE_NONE; - UNPACK_24 (op, cont_idx); - vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx); + VP->compare_result = compare_result; - SYNC_IP (); - VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont), - vm_error_continuation_not_rewindable (vmcont)); - vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1), - &thread->dynstack, registers); - CACHE_REGISTER (); - NEXT (0); + NEXT (2); } - /* tail-apply _:24 + /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32 + * + * flags := allow-other-keys:1 has-rest:1 _:6 * - * Tail-apply the procedure in local slot 0 to the rest of the - * arguments. This instruction is part of the implementation of - * `apply', and is not generated by the compiler. + * Find the last positional argument, and shuffle all the rest above + * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then + * load the constant at KW-OFFSET words from the current IP, and use it + * to bind keyword arguments. If HAS-REST, collect all shuffled + * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear + * the arguments that we shuffled up. + * + * A macro-mega-instruction. */ - VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (X32)) + VM_DEFINE_OP (16, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32)) { - int i, list_idx, list_len, nlocals; - SCM list; - - nlocals = FRAME_LOCALS_COUNT (); - // At a minimum, there should be apply, f, and the list. - VM_ASSERT (nlocals >= 3, abort ()); - list_idx = nlocals - 1; - list = FP_REF (list_idx); - list_len = scm_ilength (list); - - VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list)); - - nlocals = nlocals - 2 + list_len; - ALLOC_FRAME (nlocals); + uint32_t nreq, nreq_and_opt, ntotal, npositional; + int32_t kw_offset; + scm_t_bits kw_bits; + SCM kw; + uint8_t allow_other_keys, has_rest; - for (i = 1; i < list_idx; i++) - FP_SET (i - 1, FP_REF (i)); + UNPACK_24 (op, nreq); + allow_other_keys = ip[1] & 0x1; + has_rest = ip[1] & 0x2; + 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()); + kw = SCM_PACK (kw_bits); - /* Null out these slots, just in case there are less than 2 elements - in the list. */ - FP_SET (list_idx - 1, SCM_UNDEFINED); - FP_SET (list_idx, SCM_UNDEFINED); + /* Note that if nopt == 0 then npositional = nreq. */ + npositional = CALL_INTRINSIC (compute_kwargs_npositional, + (thread, nreq, nreq_and_opt - nreq)); - for (i = 0; i < list_len; i++, list = SCM_CDR (list)) - FP_SET (list_idx - 1 + i, SCM_CAR (list)); + SYNC_IP (); + CALL_INTRINSIC (bind_kwargs, + (thread, npositional, ntotal, kw, !has_rest, + allow_other_keys)); + CACHE_SP (); - if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) - ip = SCM_PROGRAM_CODE (FP_REF (0)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; + if (has_rest) + FP_SET (nreq_and_opt, CALL_INTRINSIC (cons_rest, (thread, ntotal))); - APPLY_HOOK (); + RESET_FRAME (ntotal); - NEXT (0); + NEXT (4); } - /* call/cc _:24 + /* bind-rest dst:24 * - * Capture the current continuation, and tail-apply the procedure in - * local slot 1 to it. This instruction is part of the implementation - * of `call/cc', and is not generated by the compiler. + * Collect any arguments at or above DST into a list, and store that + * list at DST. */ - VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (X32)) + VM_DEFINE_OP (17, bind_rest, "bind-rest", DOP1 (X8_F24)) { - SCM vm_cont, cont; - scm_t_dynstack *dynstack; - int first; - - SYNC_IP (); - dynstack = scm_dynstack_capture_all (&thread->dynstack); - vm_cont = scm_i_vm_capture_stack (vp->stack_top, - SCM_FRAME_DYNAMIC_LINK (vp->fp), - SCM_FRAME_PREVIOUS_SP (vp->fp), - SCM_FRAME_RETURN_ADDRESS (vp->fp), - dynstack, - 0); - /* FIXME: Seems silly to capture the registers here, when they are - already captured in the registers local, which here we 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, vp, vm_cont); - - if (first) - { - RESET_FRAME (2); - - SP_SET (1, SP_REF (0)); - SP_SET (0, cont); + uint32_t dst, nargs; - if (SCM_LIKELY (SCM_PROGRAM_P (SP_REF (1)))) - ip = SCM_PROGRAM_CODE (SP_REF (1)); - else - ip = (scm_t_uint32 *) vm_apply_non_program_code; - - APPLY_HOOK (); + UNPACK_24 (op, dst); + nargs = FRAME_LOCALS_COUNT (); - NEXT (0); + if (nargs <= dst) + { + VM_ASSERT (nargs == dst, abort ()); + ALLOC_FRAME (dst + 1); + SP_SET (0, SCM_EOL); } else { - CACHE_REGISTER (); - ABORT_CONTINUATION_HOOK (); - NEXT (0); + SYNC_IP (); + SCM rest = CALL_INTRINSIC (cons_rest, (thread, dst)); + RESET_FRAME (dst + 1); + SP_SET (0, rest); } - } - /* 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 (16, abort, "abort", OP1 (X32)) - { - 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, FP_REF (1), nlocals - 2, registers); - - /* vm_abort should not return */ - abort (); + NEXT (1); } - /* builtin-ref dst:12 idx:12 + /* alloc-frame nlocals:24 * - * Load a builtin stub by index into DST. + * Ensure that there is space on the stack for NLOCALS local variables. */ - VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (X8_S12_C12) | OP_DST) + VM_DEFINE_OP (18, alloc_frame, "alloc-frame", OP1 (X8_C24)) { - scm_t_uint16 dst, idx; - - UNPACK_12_12 (op, dst, idx); - SP_SET (dst, scm_vm_builtin_ref (idx)); - + uint32_t nlocals; + UNPACK_24 (op, nlocals); + ALLOC_FRAME (nlocals); NEXT (1); } - - - - /* - * Function prologues - */ - - /* br-if-nargs-ne expected:24 _:8 offset:24 - * br-if-nargs-lt expected:24 _:8 offset:24 - * br-if-nargs-gt expected:24 _:8 offset:24 + /* reset-frame nlocals:24 * - * If the number of actual arguments is not equal, less than, or greater - * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to - * the current instruction pointer. + * Like alloc-frame, but doesn't check that the stack is big enough. + * Used to reset the frame size to something less than the size that + * was previously set via alloc-frame. */ - VM_DEFINE_OP (18, br_if_nargs_ne, "br-if-nargs-ne", OP2 (X8_C24, X8_L24)) - { - BR_NARGS (!=); - } - VM_DEFINE_OP (19, br_if_nargs_lt, "br-if-nargs-lt", OP2 (X8_C24, X8_L24)) - { - BR_NARGS (<); - } - VM_DEFINE_OP (20, br_if_nargs_gt, "br-if-nargs-gt", OP2 (X8_C24, X8_L24)) + VM_DEFINE_OP (19, reset_frame, "reset-frame", OP1 (X8_C24)) { - BR_NARGS (>); + uint32_t nlocals; + UNPACK_24 (op, nlocals); + RESET_FRAME (nlocals); + NEXT (1); } - /* assert-nargs-ee expected:24 - * assert-nargs-ge expected:24 - * assert-nargs-le expected:24 + /* mov dst:12 src:12 * - * If the number of actual arguments is not ==, >=, or <= EXPECTED, - * respectively, signal an error. + * Copy a value from one local slot to another. */ - VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24)) - { - scm_t_uint32 expected; - UNPACK_24 (op, expected); - VM_ASSERT (FRAME_LOCALS_COUNT () == expected, - vm_error_wrong_num_args (FP_REF (0))); - NEXT (1); - } - VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24)) + VM_DEFINE_OP (20, mov, "mov", DOP1 (X8_S12_S12)) { - scm_t_uint32 expected; - UNPACK_24 (op, expected); - VM_ASSERT (FRAME_LOCALS_COUNT () >= expected, - vm_error_wrong_num_args (FP_REF (0))); - NEXT (1); - } - VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24)) - { - scm_t_uint32 expected; - UNPACK_24 (op, expected); - VM_ASSERT (FRAME_LOCALS_COUNT () <= expected, - vm_error_wrong_num_args (FP_REF (0))); + uint16_t dst; + uint16_t src; + + UNPACK_12_12 (op, dst, src); + /* FIXME: The compiler currently emits "mov" for SCM, F64, U64, + and S64 variables. However SCM values are the usual case, and + on a 32-bit machine it might be cheaper to move a SCM than to + move a 64-bit number. */ + SP_SET_SLOT (dst, SP_REF_SLOT (src)); + NEXT (1); } - /* alloc-frame nlocals:24 + /* long-mov dst:24 _:8 src:24 * - * Ensure that there is space on the stack for NLOCALS local variables, - * setting them all to SCM_UNDEFINED, except those nargs values that - * were passed as arguments and procedure. + * Copy a value from one local slot to another. */ - VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (X8_C24)) + VM_DEFINE_OP (21, long_mov, "long-mov", DOP2 (X8_S24, X8_S24)) { - scm_t_uint32 nlocals, nargs; - UNPACK_24 (op, nlocals); + uint32_t dst; + uint32_t src; - nargs = FRAME_LOCALS_COUNT (); - ALLOC_FRAME (nlocals); - while (nlocals-- > nargs) - FP_SET (nlocals, SCM_UNDEFINED); + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], src); + /* FIXME: The compiler currently emits "long-mov" for SCM, F64, + U64, and S64 variables. However SCM values are the usual case, + and on a 32-bit machine it might be cheaper to move a SCM than + to move a 64-bit number. */ + SP_SET_SLOT (dst, SP_REF_SLOT (src)); - NEXT (1); + NEXT (2); } - /* reset-frame nlocals:24 + /* long-fmov dst:24 _:8 src:24 * - * Like alloc-frame, but doesn't check that the stack is big enough. - * Used to reset the frame size to something less than the size that - * was previously set via alloc-frame. + * Copy a value from one local slot to another. Slot indexes are + * relative to the FP. */ - VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (X8_C24)) + VM_DEFINE_OP (22, long_fmov, "long-fmov", DOP2 (X8_F24, X8_F24)) { - scm_t_uint32 nlocals; - UNPACK_24 (op, nlocals); - RESET_FRAME (nlocals); - NEXT (1); + uint32_t dst; + uint32_t src; + + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], src); + FP_SET (dst, FP_REF (src)); + + NEXT (2); } /* push src:24 * * Push SRC onto the stack. */ - VM_DEFINE_OP (26, push, "push", OP1 (X8_S24)) + VM_DEFINE_OP (23, push, "push", OP1 (X8_S24)) { - scm_t_uint32 src; + uint32_t src; union scm_vm_stack_element val; /* FIXME: The compiler currently emits "push" for SCM, F64, U64, @@ -1140,9 +898,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Pop the stack, storing to DST. */ - VM_DEFINE_OP (27, pop, "pop", OP1 (X8_S24) | OP_DST) + VM_DEFINE_OP (24, pop, "pop", DOP1 (X8_S24)) { - scm_t_uint32 dst; + uint32_t dst; union scm_vm_stack_element val; /* FIXME: The compiler currently emits "pop" for SCM, F64, U64, @@ -1151,7 +909,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, move a 64-bit number. */ UNPACK_24 (op, dst); val = SP_REF_SLOT (0); - vp->sp = sp = sp + 1; + VP->sp = sp = sp + 1; SP_SET_SLOT (dst, val); NEXT (1); } @@ -1160,550 +918,744 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Drop some number of values from the stack. */ - VM_DEFINE_OP (28, drop, "drop", OP1 (X8_C24)) + VM_DEFINE_OP (25, drop, "drop", OP1 (X8_C24)) { - scm_t_uint32 count; + uint32_t count; UNPACK_24 (op, count); - vp->sp = sp = sp + count; + VP->sp = sp = sp + count; NEXT (1); } - /* assert-nargs-ee/locals expected:12 nlocals:12 + /* shuffle-down from:12 to:12 * - * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The - * number of locals reserved is EXPECTED + NLOCALS. + * Shuffle down values from FROM to TO, reducing the frame size by + * (FROM-TO) slots. Part of the internal implementation of + * call-with-values, values, and apply. */ - VM_DEFINE_OP (29, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12)) + VM_DEFINE_OP (26, shuffle_down, "shuffle-down", OP1 (X8_F12_F12)) { - scm_t_uint16 expected, nlocals; - UNPACK_12_12 (op, expected, nlocals); - VM_ASSERT (FRAME_LOCALS_COUNT () == expected, - vm_error_wrong_num_args (FP_REF (0))); - ALLOC_FRAME (expected + nlocals); - while (nlocals--) - SP_SET (nlocals, SCM_UNDEFINED); + uint32_t n, from, to, nlocals; + + UNPACK_12_12 (op, from, to); + + VM_ASSERT (from > to, abort ()); + nlocals = FRAME_LOCALS_COUNT (); + + for (n = 0; from + n < nlocals; n++) + FP_SET (to + n, FP_REF (from + n)); + + RESET_FRAME (to + n); NEXT (1); } - /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24 + /* expand-apply-argument _:24 * - * Find the first positional argument after NREQ. If it is greater - * than NPOS, jump to OFFSET. + * Take the last local in a frame and expand it out onto the stack, as + * for the last argument to "apply". + */ + VM_DEFINE_OP (27, expand_apply_argument, "expand-apply-argument", OP1 (X32)) + { + SYNC_IP (); + CALL_INTRINSIC (expand_apply_argument, (thread)); + CACHE_SP (); + + NEXT (1); + } + + /* subr-call idx:24 * - * 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. + * Call a subr, passing all locals in this frame as arguments, and + * storing the results on the stack, ready to be returned. This + * instruction is part of the trampolines created in gsubr.c, and is + * not generated by the compiler. */ - VM_DEFINE_OP (30, br_if_npos_gt, "br-if-npos-gt", OP3 (X8_C24, X8_C24, X8_L24)) + VM_DEFINE_OP (28, subr_call, "subr-call", OP1 (X8_C24)) { - scm_t_uint32 nreq, npos; + SCM ret; + uint32_t idx; - UNPACK_24 (op, nreq); - UNPACK_24 (ip[1], npos); + UNPACK_24 (op, idx); + + SYNC_IP (); + ret = scm_apply_subr (sp, idx, FRAME_LOCALS_COUNT ()); - /* We can only have too many positionals if there are more - arguments than NPOS. */ - if (FRAME_LOCALS_COUNT() > npos) + if (SCM_UNLIKELY (scm_is_values (ret))) { - scm_t_uint32 n; - for (n = nreq; n < npos; n++) - if (scm_is_keyword (FP_REF (n))) - break; - if (n == npos && !scm_is_keyword (FP_REF (n))) - { - scm_t_int32 offset = ip[2]; - offset >>= 8; /* Sign-extending shift. */ - NEXT (offset); - } + CALL_INTRINSIC (unpack_values_object, (thread, ret)); + CACHE_SP (); + NEXT (1); + } + else + { + RESET_FRAME (1); + SP_SET (0, ret); + NEXT (1); } - NEXT (3); } - /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32 - * - * flags := allow-other-keys:1 has-rest:1 _:6 - * - * Find the last positional argument, and shuffle all the rest above - * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then - * load the constant at KW-OFFSET words from the current IP, and use it - * to bind keyword arguments. If HAS-REST, collect all shuffled - * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear - * the arguments that we shuffled up. + /* foreign-call cif-idx:12 ptr-idx:12 * - * A macro-mega-instruction. + * Call a foreign function. Fetch the CIF and foreign pointer from + * the CIF-IDX and PTR-IDX closure slots of the callee. Arguments are + * taken from the stack, and results placed on the stack, ready to be + * returned. This instruction is part of the trampolines created by + * the FFI, and is not generated by the compiler. */ - VM_DEFINE_OP (31, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32)) + VM_DEFINE_OP (29, foreign_call, "foreign-call", OP1 (X8_C12_C12)) { - scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs; - scm_t_int32 kw_offset; - scm_t_bits kw_bits; - SCM kw; - char allow_other_keys, has_rest; + uint16_t cif_idx, ptr_idx; + SCM closure, cif, pointer; - UNPACK_24 (op, nreq); - allow_other_keys = ip[1] & 0x1; - has_rest = ip[1] & 0x2; - 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()); - kw = SCM_PACK (kw_bits); + UNPACK_12_12 (op, cif_idx, ptr_idx); - nargs = FRAME_LOCALS_COUNT (); + closure = FP_REF (0); + cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx); + pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx); - /* look in optionals for first keyword or last positional */ - /* starting after the last required positional arg */ - npositional = nreq; - while (/* while we have args */ - npositional < nargs - /* and we still have positionals to fill */ - && npositional < nreq_and_opt - /* and we haven't reached a keyword yet */ - && !scm_is_keyword (FP_REF (npositional))) - /* bind this optional arg (by leaving it in place) */ - npositional++; - nkw = nargs - npositional; - /* shuffle non-positional arguments above ntotal */ - ALLOC_FRAME (ntotal + nkw); - n = nkw; - while (n--) - FP_SET (ntotal + n, FP_REF (npositional + n)); - /* and fill optionals & keyword args with SCM_UNDEFINED */ - n = npositional; - while (n < ntotal) - FP_SET (n++, SCM_UNDEFINED); - - /* Now bind keywords, in the order given. */ - for (n = 0; n < nkw; n++) - if (scm_is_keyword (FP_REF (ntotal + n))) - { - SCM walk; - for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk)) - if (scm_is_eq (SCM_CAAR (walk), FP_REF (ntotal + n))) - { - SCM si = SCM_CDAR (walk); - if (n + 1 < nkw) - { - FP_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si), - FP_REF (ntotal + n + 1)); - } - else - vm_error_kwargs_missing_value (FP_REF (0), - FP_REF (ntotal + n)); - break; - } - VM_ASSERT (scm_is_pair (walk) || allow_other_keys, - vm_error_kwargs_unrecognized_keyword (FP_REF (0), - FP_REF (ntotal + n))); - n++; - } - else - VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (FP_REF (0), - FP_REF (ntotal + n))); + SYNC_IP (); + CALL_INTRINSIC (foreign_call, (thread, cif, pointer)); + CACHE_SP (); - if (has_rest) - { - SCM rest = SCM_EOL; - n = nkw; - SYNC_IP (); - while (n--) - rest = scm_inline_cons (thread, FP_REF (ntotal + n), rest); - FP_SET (nreq_and_opt, rest); - } + NEXT (1); + } - RESET_FRAME (ntotal); + /* continuation-call contregs:24 + * + * Return to a continuation, nonlocally. The arguments to the + * continuation are taken from the stack. CONTREGS is a free variable + * containing the reified continuation. This instruction is part of + * the implementation of undelimited continuations, and is not + * generated by the compiler. + */ + VM_DEFINE_OP (30, continuation_call, "continuation-call", OP1 (X8_C24)) + { + SCM contregs; + uint32_t contregs_idx; - NEXT (4); + UNPACK_24 (op, contregs_idx); + + contregs = + SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx); + + SYNC_IP (); + CALL_INTRINSIC (reinstate_continuation_x, (thread, contregs)); + + /* no NEXT */ + abort (); } - /* bind-rest dst:24 + /* compose-continuation cont:24 * - * Collect any arguments at or above DST into a list, and store that - * list at DST. + * Compose a partial continuation with the current continuation. The + * arguments to the continuation are taken from the stack. CONT is a + * free variable containing the reified continuation. This + * instruction is part of the implementation of partial continuations, + * and is not generated by the compiler. */ - VM_DEFINE_OP (32, bind_rest, "bind-rest", OP1 (X8_F24) | OP_DST) + VM_DEFINE_OP (31, compose_continuation, "compose-continuation", OP1 (X8_C24)) { - scm_t_uint32 dst, nargs; - SCM rest = SCM_EOL; + SCM vmcont; + uint32_t cont_idx; + uint8_t *mcode; - UNPACK_24 (op, dst); - nargs = FRAME_LOCALS_COUNT (); + UNPACK_24 (op, cont_idx); + vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx); - if (nargs <= dst) + SYNC_IP (); + mcode = CALL_INTRINSIC (compose_continuation, (thread, vmcont)); + +#if ENABLE_JIT + if (mcode && !VP->disable_mcode) { - ALLOC_FRAME (dst + 1); - while (nargs < dst) - FP_SET (nargs++, SCM_UNDEFINED); + scm_jit_enter_mcode (thread, mcode); + CACHE_REGISTER (); + NEXT (0); } else +#endif { - SYNC_IP (); + CACHE_REGISTER (); + NEXT (0); + } + } - while (nargs-- > dst) - { - rest = scm_inline_cons (thread, FP_REF (nargs), rest); - FP_SET (nargs, SCM_UNDEFINED); - } + /* capture-continuation dst:24 + * + * Capture the current continuation. This instruction is part of the + * implementation of `call/cc', and is not generated by the compiler. + */ + VM_DEFINE_OP (32, capture_continuation, "capture-continuation", DOP1 (X8_S24)) + { + uint32_t dst; - RESET_FRAME (dst + 1); - } + UNPACK_24 (op, dst); - FP_SET (dst, rest); + SYNC_IP (); + SP_SET (dst, CALL_INTRINSIC (capture_continuation, (thread))); NEXT (1); } - - - - /* - * Branching instructions - */ - - /* br offset:24 + /* abort _:24 * - * Add OFFSET, a signed 24-bit number, to the current instruction - * pointer. + * 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 (33, br, "br", OP1 (X8_L24)) + VM_DEFINE_OP (33, abort, "abort", OP1 (X32)) { - scm_t_int32 offset = op; - offset >>= 8; /* Sign-extending shift. */ - NEXT (offset); + uint8_t *mcode = NULL; + + /* 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 (); + mcode = CALL_INTRINSIC (abort_to_prompt, (thread, mcode)); + + /* If abort_to_prompt returned, that means there were no + intervening C frames to jump over, so we just continue + directly. */ + + CACHE_REGISTER (); + ABORT_HOOK (); + +#if ENABLE_JIT + if (mcode && !VP->disable_mcode) + { + scm_jit_enter_mcode (thread, mcode); + CACHE_REGISTER (); + } +#endif + + NEXT (0); } - /* br-if-true test:24 invert:1 _:7 offset:24 + /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24 * - * If the value in TEST is true for the purposes of Scheme, add - * OFFSET, a signed 24-bit number, to the current instruction pointer. + * Push a new prompt on the dynamic stack, with a tag from TAG and a + * handler at HANDLER-OFFSET words from the current IP. The handler + * will expect a multiple-value return as if from a call with the + * procedure at PROC-SLOT. */ - VM_DEFINE_OP (34, br_if_true, "br-if-true", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (34, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24)) { - BR_UNARY (x, scm_is_true (x)); + uint32_t tag, proc_slot; + int32_t offset; + uint8_t escape_only_p; + uint8_t *mra = NULL; + + UNPACK_24 (op, tag); + escape_only_p = ip[1] & 0x1; + UNPACK_24 (ip[1], proc_slot); + offset = ip[2]; + offset >>= 8; /* Sign extension */ + + /* Push the prompt onto the dynamic stack. */ + SYNC_IP (); + CALL_INTRINSIC (push_prompt, (thread, escape_only_p, SP_REF (tag), + VP->fp - proc_slot, ip + offset, mra)); + + NEXT (3); } - /* br-if-null test:24 invert:1 _:7 offset:24 + /* builtin-ref dst:12 idx:12 * - * 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. + * Load a builtin stub by index into DST. */ - VM_DEFINE_OP (35, br_if_null, "br-if-null", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (35, builtin_ref, "builtin-ref", DOP1 (X8_S12_C12)) { - BR_UNARY (x, scm_is_null (x)); + uint16_t dst, idx; + + UNPACK_12_12 (op, dst, idx); + SP_SET (dst, scm_vm_builtin_ref (idx)); + + NEXT (1); } - /* br-if-nil test:24 invert:1 _:7 offset:24 + /* throw key:12 args:12 * - * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit - * number, to the current instruction pointer. + * Throw to KEY and ARGS. ARGS should be a list. */ - VM_DEFINE_OP (36, br_if_nil, "br-if-nil", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (36, throw, "throw", OP1 (X8_S12_S12)) { - BR_UNARY (x, scm_is_lisp_false (x)); + uint16_t a, b; + SCM key, args; + + UNPACK_12_12 (op, a, b); + + key = SP_REF (a); + args = SP_REF (b); + + SYNC_IP (); + CALL_INTRINSIC (throw_, (key, args)); + + abort (); /* never reached */ } - /* br-if-pair test:24 invert:1 _:7 offset:24 + /* throw/value val:24 key-subr-and-message:32 * - * If the value in TEST is a pair, add OFFSET, a signed 24-bit number, - * to the current instruction pointer. + * Raise an error, indicating VAL as the bad value. + * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is + * the symbol to which to throw, the second is the procedure in which + * to signal the error (a string) or #f, and the third is a format + * string for the message, with one template. */ - VM_DEFINE_OP (37, br_if_pair, "br-if-pair", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (37, throw_value, "throw/value", OP2 (X8_S24, N32)) { - BR_UNARY (x, scm_is_pair (x)); + uint32_t a; + int32_t offset; + scm_t_bits key_subr_and_message_bits; + SCM val, key_subr_and_message; + + UNPACK_24 (op, a); + val = SP_REF (a); + + offset = ip[1]; + key_subr_and_message_bits = (scm_t_bits) (ip + offset); + VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort()); + key_subr_and_message = SCM_PACK (key_subr_and_message_bits); + + SYNC_IP (); + CALL_INTRINSIC (throw_with_value, (val, key_subr_and_message)); + + abort (); /* never reached */ } - /* br-if-struct test:24 invert:1 _:7 offset:24 + /* throw/value+data val:24 key-subr-and-message:32 * - * If the value in TEST is a struct, add OFFSET, a signed 24-bit - * number, to the current instruction pointer. + * Raise an error, indicating VAL as the bad value. + * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is + * the symbol to which to throw, the second is the procedure in which + * to signal the error (a string) or #f, and the third is a format + * string for the message, with one template. */ - VM_DEFINE_OP (38, br_if_struct, "br-if-struct", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (38, throw_value_and_data, "throw/value+data", OP2 (X8_S24, N32)) { - BR_UNARY (x, SCM_STRUCTP (x)); + uint32_t a; + int32_t offset; + scm_t_bits key_subr_and_message_bits; + SCM val, key_subr_and_message; + + UNPACK_24 (op, a); + val = SP_REF (a); + + offset = ip[1]; + key_subr_and_message_bits = (scm_t_bits) (ip + offset); + VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort()); + key_subr_and_message = SCM_PACK (key_subr_and_message_bits); + + SYNC_IP (); + CALL_INTRINSIC (throw_with_value_and_data, (val, key_subr_and_message)); + + abort (); /* never reached */ } - /* br-if-char test:24 invert:1 _:7 offset:24 + /* handle-interrupts _:24 * - * If the value in TEST is a char, add OFFSET, a signed 24-bit number, - * to the current instruction pointer. + * Handle pending interrupts. */ - VM_DEFINE_OP (39, br_if_char, "br-if-char", OP2 (X8_S24, B1_X7_L24)) + VM_DEFINE_OP (39, handle_interrupts, "handle-interrupts", OP1 (X32)) { - BR_UNARY (x, SCM_CHARP (x)); + if (SCM_LIKELY (scm_is_null + (scm_atomic_ref_scm (&thread->pending_asyncs)))) + NEXT (1); + + if (thread->block_asyncs > 0) + NEXT (1); + + SYNC_IP (); + CALL_INTRINSIC (push_interrupt_frame, (thread, 0)); + CACHE_SP (); + ip = scm_vm_intrinsics.handle_interrupt_code; + + NEXT (0); } - /* br-if-tc7 test:24 invert:1 tc7:7 offset:24 + /* return-from-interrupt _:24 * - * 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. + * Return from handling an interrupt, discarding any return values and + * stripping away the interrupt frame. */ - VM_DEFINE_OP (40, br_if_tc7, "br-if-tc7", OP2 (X8_S24, B1_C7_L24)) + VM_DEFINE_OP (40, return_from_interrupt, "return-from-interrupt", OP1 (X32)) { - BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f)); + union scm_vm_stack_element *fp = VP->fp; + + ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp); + VP->fp = SCM_FRAME_DYNAMIC_LINK (fp); + VP->sp = sp = SCM_FRAME_PREVIOUS_SP (fp); + + NEXT (0); } - /* br-if-eq a:12 b:12 invert:1 _:7 offset:24 + /* call-thread _:24 IDX:32 * - * If the value in A is eq? to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Call the void-returning instrinsic with index IDX, passing the + * current scm_thread* as the argument. */ - VM_DEFINE_OP (41, br_if_eq, "br-if-eq", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (41, call_thread, "call-thread", OP2 (X32, C32)) { - BR_BINARY (x, y, scm_is_eq (x, y)); + scm_t_thread_intrinsic intrinsic; + + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (thread); + CACHE_SP (); + + NEXT (2); } - /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24 + /* call-thread-scm a:24 IDX:32 * - * If the value in A is eqv? to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Call the void-returning instrinsic with index IDX, passing the + * current scm_thread* and the SCM local A as arguments. */ - VM_DEFINE_OP (42, br_if_eqv, "br-if-eqv", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (42, call_thread_scm, "call-thread-scm", OP2 (X8_S24, C32)) { - BR_BINARY (x, y, - scm_is_eq (x, y) - || (SCM_NIMP (x) && SCM_NIMP (y) - && scm_is_true (scm_eqv_p (x, y)))); - } + uint32_t a; + scm_t_thread_scm_intrinsic intrinsic; - VM_DEFINE_OP (43, unused_43, NULL, NOP) - { - abort (); + UNPACK_24 (op, a); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (thread, SP_REF (a)); + CACHE_SP (); + + NEXT (2); } - /* br-if-logtest a:24 _:8 b:24 invert:1 _:7 offset:24 + /* call-thread-scm-scm a:12 b:12 IDX:32 * - * If the exact integer in A has any bits in common with the exact - * integer in B, add OFFSET, a signed 24-bit number, to the current - * instruction pointer. + * Call the void-returning instrinsic with index IDX, passing the + * current scm_thread* and the SCM locals A and B as arguments. */ - VM_DEFINE_OP (44, br_if_logtest, "br-if-logtest", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (43, call_thread_scm_scm, "call-thread-scm-scm", OP2 (X8_S12_S12, C32)) { + uint16_t a, b; + scm_t_thread_scm_scm_intrinsic intrinsic; + + UNPACK_12_12 (op, a, b); + intrinsic = intrinsics[ip[1]]; + SYNC_IP (); - { - BR_BINARY (x, y, - ((SCM_I_INUMP (x) && SCM_I_INUMP (y)) - ? (SCM_UNPACK (x) & SCM_UNPACK (y) & ~scm_tc2_int) - : scm_is_true (scm_logtest (x, y)))); - } + intrinsic (thread, SP_REF (a), SP_REF (b)); + CACHE_SP (); + + NEXT (2); } - /* br-if-= a:12 b:12 invert:1 _:7 offset:24 + /* call-scm-sz-u32 a:8 b:8 c:8 IDX:32 * - * If the value in A is = to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Call the void-returning instrinsic with index IDX, passing the + * locals A, B, and C as arguments. A is a SCM value, while B and C + * are raw u64 values which fit into size_t and uint32_t types, + * respectively. */ - VM_DEFINE_OP (45, br_if_ee, "br-if-=", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (44, call_scm_sz_u32, "call-scm-sz-u32", OP2 (X8_S8_S8_S8, C32)) { - BR_ARITHMETIC (==, scm_num_eq_p); + uint8_t a, b, c; + scm_t_scm_sz_u32_intrinsic intrinsic; + + UNPACK_8_8_8 (op, a, b, c); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (SP_REF (a), SP_REF_U64 (b), SP_REF_U64 (c)); + CACHE_SP (); + + NEXT (2); } - /* br-if-< a:12 b:12 invert:1 _:7 offset:24 + /* call-scm<-thread dst:24 IDX:32 * - * If the value in A is < to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Call the SCM-returning instrinsic with index IDX, passing the + * current scm_thread* as argument. Place the SCM result in DST. */ - VM_DEFINE_OP (46, br_if_lt, "br-if-<", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (45, call_scm_from_thread, "call-scm<-thread", DOP2 (X8_S24, C32)) { - BR_ARITHMETIC (<, scm_less_p); + uint32_t dst; + scm_t_scm_from_thread_intrinsic intrinsic; + SCM res; + + UNPACK_24 (op, dst); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (thread); + CACHE_SP (); + + SP_SET (dst, res); + + NEXT (2); } - /* br-if-<= a:12 b:12 invert:1 _:7 offset:24 + /* call-s64<-scm dst:12 a:12 IDX:32 * - * If the value in A is <= to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Call the int64_t-returning instrinsic with index IDX, passing the + * SCM local A as argument. Place the s64 result in DST. */ - VM_DEFINE_OP (47, br_if_le, "br-if-<=", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (46, call_s64_from_scm, "call-s64<-scm", DOP2 (X8_S12_S12, C32)) { - BR_ARITHMETIC (<=, scm_leq_p); - } + uint16_t dst, src; + scm_t_s64_from_scm_intrinsic intrinsic; + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; - + SYNC_IP (); +#if INDIRECT_INT64_INTRINSICS + intrinsic (& SP_REF_S64 (dst), SP_REF (src)); +#else + { + int64_t res = intrinsic (SP_REF (src)); + SP_SET_S64 (dst, res); + } +#endif - /* - * Lexical binding instructions - */ + /* No CACHE_SP () after the intrinsic, as the indirect variants + have an out argument that points at the stack; stack relocation + during this kind of intrinsic is not supported! */ - /* mov dst:12 src:12 + NEXT (2); + } + + /* call-scm<-u64 dst:12 a:12 IDX:32 * - * Copy a value from one local slot to another. + * Call the SCM-returning instrinsic with index IDX, passing the + * uint64_t local A as argument. Place the SCM result in DST. */ - VM_DEFINE_OP (48, mov, "mov", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (47, call_scm_from_u64, "call-scm<-u64", DOP2 (X8_S12_S12, C32)) { - scm_t_uint16 dst; - scm_t_uint16 src; + uint16_t dst, src; + SCM res; + scm_t_scm_from_u64_intrinsic intrinsic; UNPACK_12_12 (op, dst, src); - /* FIXME: The compiler currently emits "mov" for SCM, F64, U64, - and S64 variables. However SCM values are the usual case, and - on a 32-bit machine it might be cheaper to move a SCM than to - move a 64-bit number. */ - SP_SET_SLOT (dst, SP_REF_SLOT (src)); + intrinsic = intrinsics[ip[1]]; - NEXT (1); + SYNC_IP (); +#if INDIRECT_INT64_INTRINSICS + res = intrinsic (& SP_REF_U64 (src)); +#else + res = intrinsic (SP_REF_U64 (src)); +#endif + SP_SET (dst, res); + + /* No CACHE_SP () after the intrinsic, as the indirect variants + pass stack pointers directly; stack relocation during this kind + of intrinsic is not supported! */ + + NEXT (2); } - /* long-mov dst:24 _:8 src:24 + /* call-scm<-s64 dst:12 a:12 IDX:32 * - * Copy a value from one local slot to another. + * Call the SCM-returning instrinsic with index IDX, passing the + * int64_t local A as argument. Place the SCM result in DST. */ - VM_DEFINE_OP (49, long_mov, "long-mov", OP2 (X8_S24, X8_S24) | OP_DST) + VM_DEFINE_OP (48, call_scm_from_s64, "call-scm<-s64", DOP2 (X8_S12_S12, C32)) { - scm_t_uint32 dst; - scm_t_uint32 src; + uint16_t dst, src; + SCM res; + scm_t_scm_from_s64_intrinsic intrinsic; - UNPACK_24 (op, dst); - UNPACK_24 (ip[1], src); - /* FIXME: The compiler currently emits "long-mov" for SCM, F64, - U64, and S64 variables. However SCM values are the usual case, - and on a 32-bit machine it might be cheaper to move a SCM than - to move a 64-bit number. */ - SP_SET_SLOT (dst, SP_REF_SLOT (src)); + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); +#if INDIRECT_INT64_INTRINSICS + res = intrinsic (& SP_REF_S64 (src)); +#else + res = intrinsic (SP_REF_S64 (src)); +#endif + CACHE_SP (); + SP_SET (dst, res); NEXT (2); } - /* long-fmov dst:24 _:8 src:24 + /* call-scm<-scm dst:12 a:12 IDX:32 * - * Copy a value from one local slot to another. Slot indexes are - * relative to the FP. + * Call the SCM-returning instrinsic with index IDX, passing the SCM + * local A as argument. Place the SCM result in DST. */ - VM_DEFINE_OP (50, long_fmov, "long-fmov", OP2 (X8_F24, X8_F24) | OP_DST) + VM_DEFINE_OP (49, call_scm_from_scm, "call-scm<-scm", DOP2 (X8_S12_S12, C32)) { - scm_t_uint32 dst; - scm_t_uint32 src; + uint16_t dst, src; + SCM res; + scm_t_scm_from_scm_intrinsic intrinsic; - UNPACK_24 (op, dst); - UNPACK_24 (ip[1], src); - FP_SET (dst, FP_REF (src)); + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (SP_REF (src)); + CACHE_SP (); + SP_SET (dst, res); NEXT (2); } - /* box dst:12 src:12 + /* call-f64<-scm dst:12 a:12 IDX:32 * - * Create a new variable holding SRC, and place it in DST. + * Call the double-returning instrinsic with index IDX, passing the + * SCM local A as argument. Place the f64 result in DST. */ - VM_DEFINE_OP (51, box, "box", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (50, call_f64_from_scm, "call-f64<-scm", DOP2 (X8_S12_S12, C32)) { - scm_t_uint16 dst, src; + uint16_t dst, src; + double res; + scm_t_f64_from_scm_intrinsic intrinsic; + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + SYNC_IP (); - SP_SET (dst, scm_inline_cell (thread, scm_tc7_variable, - SCM_UNPACK (SP_REF (src)))); - NEXT (1); + res = intrinsic (SP_REF (src)); + CACHE_SP (); + SP_SET_F64 (dst, res); + + NEXT (2); } - /* box-ref dst:12 src:12 + /* call-u64<-scm dst:12 a:12 IDX:32 * - * Unpack the variable at SRC into DST, asserting that the variable is - * actually bound. + * Call the uint64_t-returning instrinsic with index IDX, passing the + * SCM local A as argument. Place the u64 result in DST. */ - VM_DEFINE_OP (52, box_ref, "box-ref", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (51, call_u64_from_scm, "call-u64<-scm", DOP2 (X8_S12_S12, C32)) { - scm_t_uint16 dst, src; - SCM var; + uint16_t dst, src; + scm_t_u64_from_scm_intrinsic intrinsic; + UNPACK_12_12 (op, dst, src); - var = SP_REF (src); - VM_VALIDATE_VARIABLE (var, "variable-ref"); - VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var)); - SP_SET (dst, VARIABLE_REF (var)); - NEXT (1); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); +#if INDIRECT_INT64_INTRINSICS + intrinsic (& SP_REF_U64 (dst), SP_REF (src)); +#else + { + uint64_t res = intrinsic (SP_REF (src)); + SP_SET_U64 (dst, res); + } +#endif + + /* No CACHE_SP () after the intrinsic, as the indirect variants + have an out argument that points at the stack; stack relocation + during this kind of intrinsic is not supported! */ + + NEXT (2); } - /* box-set! dst:12 src:12 + /* call-scm<-scm-scm dst:8 a:8 b:8 IDX:32 * - * Set the contents of the variable at DST to SET. + * Call the SCM-returning instrinsic with index IDX, passing the SCM + * locals A and B as arguments. Place the SCM result in DST. */ - VM_DEFINE_OP (53, box_set, "box-set!", OP1 (X8_S12_S12)) + VM_DEFINE_OP (52, call_scm_from_scm_scm, "call-scm<-scm-scm", DOP2 (X8_S8_S8_S8, C32)) { - scm_t_uint16 dst, src; - SCM var; - UNPACK_12_12 (op, dst, src); - var = SP_REF (dst); - VM_VALIDATE_VARIABLE (var, "variable-set!"); - VARIABLE_SET (var, SP_REF (src)); - NEXT (1); + uint8_t dst, a, b; + SCM res; + scm_t_scm_from_scm_scm_intrinsic intrinsic; + + UNPACK_8_8_8 (op, dst, a, b); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (SP_REF (a), SP_REF (b)); + CACHE_SP (); + SP_SET (dst, res); + + NEXT (2); } - /* make-closure dst:24 offset:32 _:8 nfree:24 + /* call-scm<-scm-uimm dst:8 a:8 b:8 IDX:32 * - * Make a new closure, and write it to DST. The code for the closure - * will be found at OFFSET words from the current IP. OFFSET is a - * signed 32-bit integer. Space for NFREE free variables will be - * allocated. + * Call the SCM-returning instrinsic with index IDX, passing the SCM + * local A and the uint8_t immediate B as arguments. Place the SCM + * result in DST. */ - VM_DEFINE_OP (54, make_closure, "make-closure", OP3 (X8_S24, L32, X8_C24) | OP_DST) + VM_DEFINE_OP (53, call_scm_from_scm_uimm, "call-scm<-scm-uimm", DOP2 (X8_S8_S8_C8, C32)) { - scm_t_uint32 dst, nfree, n; - scm_t_int32 offset; - SCM closure; + uint8_t dst, a, b; + SCM res; + scm_t_scm_from_scm_uimm_intrinsic intrinsic; - UNPACK_24 (op, dst); - offset = ip[1]; - UNPACK_24 (ip[2], nfree); + UNPACK_8_8_8 (op, dst, a, b); + intrinsic = intrinsics[ip[1]]; - // FIXME: Assert range of nfree? SYNC_IP (); - closure = scm_inline_words (thread, 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_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F); - SP_SET (dst, closure); - NEXT (3); + res = intrinsic (SP_REF (a), b); + CACHE_SP (); + SP_SET (dst, res); + + NEXT (2); } - /* free-ref dst:12 src:12 _:8 idx:24 + /* call-scm<-thread-scm dst:12 a:12 IDX:32 * - * Load free variable IDX from the closure SRC into local slot DST. + * Call the SCM-returning instrinsic with index IDX, passing the + * current scm_thread* and SCM local A as arguments. Place the SCM + * result in DST. */ - VM_DEFINE_OP (55, free_ref, "free-ref", OP2 (X8_S12_S12, X8_C24) | OP_DST) + VM_DEFINE_OP (54, call_scm_from_thread_scm, "call-scm<-thread-scm", DOP2 (X8_S12_S12, C32)) { - scm_t_uint16 dst, src; - scm_t_uint32 idx; + uint16_t dst, src; + scm_t_scm_from_thread_scm_intrinsic intrinsic; + SCM res; + UNPACK_12_12 (op, dst, src); - UNPACK_24 (ip[1], idx); - /* CHECK_FREE_VARIABLE (src); */ - SP_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (SP_REF (src), idx)); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (thread, SP_REF (src)); + CACHE_SP (); + + SP_SET (dst, res); + NEXT (2); } - /* free-set! dst:12 src:12 _:8 idx:24 + /* call-scm<-scm-u64 dst:8 a:8 b:8 IDX:32 * - * Set free variable IDX from the closure DST to SRC. + * Call the SCM-returning instrinsic with index IDX, passing SCM local + * A and u64 local B as arguments. Place the SCM result in DST. */ - VM_DEFINE_OP (56, free_set, "free-set!", OP2 (X8_S12_S12, X8_C24)) + VM_DEFINE_OP (55, call_scm_from_scm_u64, "call-scm<-scm-u64", DOP2 (X8_S8_S8_S8, C32)) { - scm_t_uint16 dst, src; - scm_t_uint32 idx; - UNPACK_12_12 (op, dst, src); - UNPACK_24 (ip[1], idx); - /* CHECK_FREE_VARIABLE (src); */ - SCM_PROGRAM_FREE_VARIABLE_SET (SP_REF (dst), idx, SP_REF (src)); - NEXT (2); - } + uint8_t dst, a, b; + SCM res; + scm_t_scm_from_scm_u64_intrinsic intrinsic; + UNPACK_8_8_8 (op, dst, a, b); + intrinsic = intrinsics[ip[1]]; - + SYNC_IP (); +#if INDIRECT_INT64_INTRINSICS + res = intrinsic (SP_REF (a), & SP_REF_U64 (b)); +#else + res = intrinsic (SP_REF (a), SP_REF_U64 (b)); +#endif + CACHE_SP (); - /* - * Immediates and statically allocated non-immediates - */ + SP_SET (dst, res); + + NEXT (2); + } /* make-short-immediate dst:8 low-bits:16 * * Make an immediate whose low bits are LOW-BITS, and whose top bits are * 0. */ - VM_DEFINE_OP (57, make_short_immediate, "make-short-immediate", OP1 (X8_S8_I16) | OP_DST) + VM_DEFINE_OP (56, make_short_immediate, "make-short-immediate", DOP1 (X8_S8_I16)) { - scm_t_uint8 dst; + uint8_t dst; scm_t_bits val; UNPACK_8_16 (op, dst, val); @@ -1716,9 +1668,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Make an immediate whose low bits are LOW-BITS, and whose top bits are * 0. */ - VM_DEFINE_OP (58, make_long_immediate, "make-long-immediate", OP2 (X8_S24, I32) | OP_DST) + VM_DEFINE_OP (57, make_long_immediate, "make-long-immediate", DOP2 (X8_S24, I32)) { - scm_t_uint32 dst; + uint32_t dst; scm_t_bits val; UNPACK_24 (op, dst); @@ -1731,13 +1683,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Make an immediate with HIGH-BITS and LOW-BITS. */ - VM_DEFINE_OP (59, make_long_long_immediate, "make-long-long-immediate", OP3 (X8_S24, A32, B32) | OP_DST) + VM_DEFINE_OP (58, make_long_long_immediate, "make-long-long-immediate", DOP3 (X8_S24, A32, B32)) { - scm_t_uint32 dst; + uint32_t dst; scm_t_bits val; UNPACK_24 (op, dst); -#if SIZEOF_SCM_T_BITS > 4 +#if SIZEOF_UINTPTR_T > 4 val = ip[1]; val <<= 32; val |= ip[2]; @@ -1762,11 +1714,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Whether the object is mutable or immutable depends on where it was * allocated by the compiler, and loaded by the loader. */ - VM_DEFINE_OP (60, make_non_immediate, "make-non-immediate", OP2 (X8_S24, N32) | OP_DST) + VM_DEFINE_OP (59, make_non_immediate, "make-non-immediate", DOP2 (X8_S24, N32)) { - scm_t_uint32 dst; - scm_t_int32 offset; - scm_t_uint32* loc; + uint32_t dst; + int32_t offset; + uint32_t* loc; scm_t_bits unpacked; UNPACK_24 (op, dst); @@ -1781,1374 +1733,786 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (2); } - /* static-ref dst:24 offset:32 - * - * Load a SCM value into DST. The SCM value will be fetched from - * memory, OFFSET 32-bit words away from the current instruction - * pointer. OFFSET is a signed value. + /* load-label dst:24 offset:32 * - * The intention is for this instruction to be used to load constants - * that the compiler is unable to statically allocate, like symbols. - * These values would be initialized when the object file loads. + * Load a label OFFSET words away from the current IP and write it to + * DST. OFFSET is a signed 32-bit integer. */ - VM_DEFINE_OP (61, static_ref, "static-ref", OP2 (X8_S24, R32) | OP_DST) + VM_DEFINE_OP (60, load_label, "load-label", DOP2 (X8_S24, L32)) { - scm_t_uint32 dst; - scm_t_int32 offset; - scm_t_uint32* loc; - scm_t_uintptr loc_bits; + uint32_t dst; + int32_t offset; UNPACK_24 (op, dst); offset = ip[1]; - loc = ip + offset; - loc_bits = (scm_t_uintptr) loc; - VM_ASSERT (ALIGNED_P (loc, SCM), abort()); - SP_SET (dst, *((SCM *) loc_bits)); + SP_SET_U64 (dst, (uintptr_t) (ip + offset)); NEXT (2); } - /* static-set! src:24 offset:32 + /* load-f64 dst:24 high-bits:32 low-bits:32 * - * Store a SCM value into memory, OFFSET 32-bit words away from the - * current instruction pointer. OFFSET is a signed value. + * Make a double-precision floating-point value with HIGH-BITS and + * LOW-BITS. */ - VM_DEFINE_OP (62, static_set, "static-set!", OP2 (X8_S24, LO32)) + VM_DEFINE_OP (61, load_f64, "load-f64", DOP3 (X8_S24, AF32, BF32)) { - scm_t_uint32 src; - scm_t_int32 offset; - scm_t_uint32* loc; + uint32_t dst; + uint64_t val; - UNPACK_24 (op, src); - offset = ip[1]; - loc = ip + offset; - VM_ASSERT (ALIGNED_P (loc, SCM), abort()); - - *((SCM *) loc) = SP_REF (src); - - NEXT (2); + UNPACK_24 (op, dst); + val = ip[1]; + val <<= 32; + val |= ip[2]; + SP_SET_U64 (dst, val); + NEXT (3); } - /* static-patch! _:24 dst-offset:32 src-offset:32 + /* load-u64 dst:24 high-bits:32 low-bits:32 * - * 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. + * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS. */ - VM_DEFINE_OP (63, static_patch, "static-patch!", OP3 (X32, LO32, L32)) + VM_DEFINE_OP (62, load_u64, "load-u64", DOP3 (X8_S24, AU32, BU32)) { - scm_t_int32 dst_offset, src_offset; - void *src; - void** dst_loc; - - dst_offset = ip[1]; - src_offset = ip[2]; - - dst_loc = (void **) (ip + dst_offset); - src = ip + src_offset; - VM_ASSERT (ALIGNED_P (dst_loc, void*), abort()); - - *dst_loc = src; + uint32_t dst; + uint64_t val; + UNPACK_24 (op, dst); + val = ip[1]; + val <<= 32; + val |= ip[2]; + SP_SET_U64 (dst, val); NEXT (3); } - - - /* - * Mutable top-level bindings - */ - - /* There are three slightly different ways to resolve toplevel - variables. - - 1. A toplevel reference outside of a function. These need to be - looked up when the expression is evaluated -- no later, and no - before. They are looked up relative to the module that is - current when the expression is evaluated. For example: - - (if (foo) a b) - - The "resolve" instruction resolves the variable (box), and then - access is via box-ref or box-set!. - - 2. A toplevel reference inside a function. These are looked up - relative to the module that was current when the function was - defined. Unlike code at the toplevel, which is usually run only - once, these bindings benefit from memoized lookup, in which the - variable resulting from the lookup is cached in the function. - - (lambda () (if (foo) a b)) - - The toplevel-box instruction is equivalent to "resolve", but - caches the resulting variable in statically allocated memory. - - 3. A reference to an identifier with respect to a particular - module. This can happen for primitive references, and - references residualized by macro expansions. These can always - be cached. Use module-box for these. - */ - - /* current-module dst:24 + /* load-s64 dst:24 high-bits:32 low-bits:32 * - * Store the current module in DST. + * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS. */ - VM_DEFINE_OP (64, current_module, "current-module", OP1 (X8_S24) | OP_DST) + VM_DEFINE_OP (63, load_s64, "load-s64", DOP3 (X8_S24, AS32, BS32)) { - scm_t_uint32 dst; + uint32_t dst; + uint64_t val; UNPACK_24 (op, dst); - - SYNC_IP (); - SP_SET (dst, scm_current_module ()); - - NEXT (1); + val = ip[1]; + val <<= 32; + val |= ip[2]; + SP_SET_U64 (dst, val); + NEXT (3); } - /* resolve dst:24 bound?:1 _:7 sym:24 + /* current-thread dst:24 * - * Resolve SYM in the current module, and place the resulting variable - * in DST. + * Write the current thread into DST. */ - VM_DEFINE_OP (65, resolve, "resolve", OP2 (X8_S24, B1_X7_S24) | OP_DST) + VM_DEFINE_OP (64, current_thread, "current-thread", DOP1 (X8_S24)) { - scm_t_uint32 dst; - scm_t_uint32 sym; - SCM var; + uint32_t dst; UNPACK_24 (op, dst); - UNPACK_24 (ip[1], sym); - - SYNC_IP (); - var = scm_lookup (SP_REF (sym)); - CACHE_SP (); - if (ip[1] & 0x1) - VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (SP_REF (sym))); - SP_SET (dst, var); + SP_SET (dst, thread->handle); - NEXT (2); + NEXT (1); } - /* define! dst:12 sym:12 + /* allocate-words dst:12 count:12 * - * Look up a binding for SYM in the current module, creating it if - * necessary. Set its value to VAL. + * Allocate a fresh GC-traced object consisting of COUNT words and + * store it into DST. COUNT is a u64 local. */ - VM_DEFINE_OP (66, define, "define!", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (65, allocate_words, "allocate-words", DOP1 (X8_S12_S12)) { - scm_t_uint16 dst, sym; - SCM var; - UNPACK_12_12 (op, dst, sym); + uint16_t dst, size; + + UNPACK_12_12 (op, dst, size); + SYNC_IP (); - var = scm_module_ensure_local_variable (scm_current_module (), - SP_REF (sym)); - CACHE_SP (); - SP_SET (dst, var); + SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, SP_REF_U64 (size)))); NEXT (1); } - /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31 - * - * Load a SCM value. The SCM value will be fetched from memory, - * VAR-OFFSET 32-bit words away from the current instruction pointer. - * VAR-OFFSET is a signed value. Up to here, toplevel-box is like - * static-ref. - * - * Then, if the loaded value is a variable, it is placed in DST, and control - * flow continues. + /* allocate-words/immediate dst:12 count:12 * - * Otherwise, we have to resolve the variable. In that case we load - * the module from MOD-OFFSET, just as we loaded the variable. - * Usually the module gets set when the closure is created. The name - * is an offset to a symbol. - * - * We use the module and the symbol to resolve the variable, placing it in - * DST, and caching the resolved variable so that we will hit the cache next - * time. + * Allocate a fresh GC-traced object consisting of COUNT words and + * store it into DST. COUNT is an immediate. */ - VM_DEFINE_OP (67, toplevel_box, "toplevel-box", OP5 (X8_S24, R32, R32, N32, B1_X31) | OP_DST) + VM_DEFINE_OP (66, allocate_words_immediate, "allocate-words/immediate", DOP1 (X8_S12_C12)) { - scm_t_uint32 dst; - scm_t_int32 var_offset; - scm_t_uint32* var_loc_u32; - SCM *var_loc; - SCM var; + uint16_t dst, size; - UNPACK_24 (op, dst); - var_offset = ip[1]; - var_loc_u32 = ip + var_offset; - VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort()); - var_loc = (SCM *) var_loc_u32; - var = *var_loc; + UNPACK_12_12 (op, dst, size); - if (SCM_UNLIKELY (!SCM_VARIABLEP (var))) - { - SCM mod, sym; - scm_t_int32 mod_offset = ip[2]; /* signed */ - scm_t_int32 sym_offset = ip[3]; /* signed */ - scm_t_uint32 *mod_loc = ip + mod_offset; - scm_t_uint32 *sym_loc = ip + sym_offset; - - SYNC_IP (); - - VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort()); - VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort()); - - mod = *((SCM *) mod_loc); - sym = *((SCM *) sym_loc); - - /* If the toplevel scope was captured before modules were - booted, use the root module. */ - if (scm_is_false (mod)) - mod = scm_the_root_module (); - - var = scm_module_lookup (mod, sym); - CACHE_SP (); - if (ip[4] & 0x1) - VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym)); - - *var_loc = var; - } + SYNC_IP (); + SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, size))); - SP_SET (dst, var); - NEXT (5); + NEXT (1); } - /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31 + /* scm-ref dst:8 obj:8 idx:8 * - * Like toplevel-box, except MOD-OFFSET points at the name of a module - * instead of the module itself. + * Load the SCM object at word offset IDX from local OBJ, and store it + * to DST. */ - VM_DEFINE_OP (68, module_box, "module-box", OP5 (X8_S24, R32, N32, N32, B1_X31) | OP_DST) + VM_DEFINE_OP (67, scm_ref, "scm-ref", DOP1 (X8_S8_S8_S8)) { - scm_t_uint32 dst; - scm_t_int32 var_offset; - scm_t_uint32* var_loc_u32; - SCM *var_loc; - SCM var; - - UNPACK_24 (op, dst); - var_offset = ip[1]; - var_loc_u32 = ip + var_offset; - VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort()); - var_loc = (SCM *) var_loc_u32; - var = *var_loc; + uint8_t dst, obj, idx; - if (SCM_UNLIKELY (!SCM_VARIABLEP (var))) - { - SCM modname, sym; - scm_t_int32 modname_offset = ip[2]; /* signed */ - scm_t_int32 sym_offset = ip[3]; /* signed */ - scm_t_uint32 *modname_words = ip + modname_offset; - scm_t_uint32 *sym_loc = ip + sym_offset; - - SYNC_IP (); + UNPACK_8_8_8 (op, dst, obj, idx); - VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort()); - VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort()); + SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx))); - modname = SCM_PACK ((scm_t_bits) modname_words); - sym = *((SCM *) sym_loc); - - if (!scm_module_system_booted_p) - { - ASSERT (scm_is_true - scm_equal_p (modname, - scm_list_2 - (SCM_BOOL_T, - scm_from_utf8_symbol ("guile")))); - var = scm_lookup (sym); - } - else if (scm_is_true (SCM_CAR (modname))) - var = scm_public_lookup (SCM_CDR (modname), sym); - else - var = scm_private_lookup (SCM_CDR (modname), sym); - - CACHE_SP (); - - if (ip[4] & 0x1) - VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym)); - - *var_loc = var; - } - - SP_SET (dst, var); - NEXT (5); + NEXT (1); } - - - /* - * The dynamic environment - */ - - /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24 + /* scm-set! obj:8 idx:8 val:8 * - * Push a new prompt on the dynamic stack, with a tag from TAG and a - * handler at HANDLER-OFFSET words from the current IP. The handler - * will expect a multiple-value return as if from a call with the - * procedure at PROC-SLOT. + * Store the SCM local VAL into object OBJ at word offset IDX. */ - VM_DEFINE_OP (69, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24)) + VM_DEFINE_OP (68, scm_set, "scm-set!", OP1 (X8_S8_S8_S8)) { - scm_t_uint32 tag, proc_slot; - scm_t_int32 offset; - scm_t_uint8 escape_only_p; - scm_t_dynstack_prompt_flags flags; + uint8_t obj, idx, val; - UNPACK_24 (op, tag); - escape_only_p = ip[1] & 0x1; - UNPACK_24 (ip[1], proc_slot); - offset = ip[2]; - offset >>= 8; /* Sign extension */ - - /* Push the prompt onto the dynamic stack. */ - flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0; - SYNC_IP (); - scm_dynstack_push_prompt (&thread->dynstack, flags, - SP_REF (tag), - vp->stack_top - vp->fp, - vp->stack_top - FP_SLOT (proc_slot), - ip + offset, - registers); - NEXT (3); - } + UNPACK_8_8_8 (op, obj, idx, val); - /* wind winder:12 unwinder:12 - * - * Push wind and unwind procedures onto the dynamic stack. Note that - * neither are actually called; the compiler should emit calls to wind - * and unwind for the normal dynamic-wind control flow. Also note that - * 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 (70, wind, "wind", OP1 (X8_S12_S12)) - { - scm_t_uint16 winder, unwinder; - UNPACK_12_12 (op, winder, unwinder); - SYNC_IP (); - scm_dynstack_push_dynwind (&thread->dynstack, - SP_REF (winder), SP_REF (unwinder)); - NEXT (1); - } + SCM_SET_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx), SP_REF (val)); - /* unwind _:24 - * - * A normal exit from the dynamic extent of an expression. Pop the top - * entry off of the dynamic stack. - */ - VM_DEFINE_OP (71, unwind, "unwind", OP1 (X32)) - { - scm_dynstack_pop (&thread->dynstack); NEXT (1); } - /* push-fluid fluid:12 value:12 + /* scm-ref/tag dst:8 obj:8 tag:8 * - * Dynamically bind VALUE to FLUID. + * Load the first word of OBJ, subtract the immediate TAG, and store + * the resulting SCM to DST. */ - VM_DEFINE_OP (72, push_fluid, "push-fluid", OP1 (X8_S12_S12)) + VM_DEFINE_OP (69, scm_ref_tag, "scm-ref/tag", DOP1 (X8_S8_S8_C8)) { - scm_t_uint32 fluid, value; + uint8_t dst, obj, tag; - UNPACK_12_12 (op, fluid, value); + UNPACK_8_8_8 (op, dst, obj, tag); - SYNC_IP (); - scm_dynstack_push_fluid (&thread->dynstack, - SP_REF (fluid), SP_REF (value), - thread->dynamic_state); - NEXT (1); - } + SP_SET (dst, SCM_PACK (SCM_CELL_WORD_0 (SP_REF (obj)) - tag)); - /* pop-fluid _:24 - * - * Leave the dynamic extent of a with-fluid* expression, restoring the - * fluid to its previous value. - */ - VM_DEFINE_OP (73, pop_fluid, "pop-fluid", OP1 (X32)) - { - SYNC_IP (); - scm_dynstack_unwind_fluid (&thread->dynstack, - thread->dynamic_state); NEXT (1); } - /* fluid-ref dst:12 src:12 + /* scm-set!/tag obj:8 tag:8 val:8 * - * Reference the fluid in SRC, and place the value in DST. + * Set the first word of OBJ to the SCM value VAL plus the immediate + * value TAG. */ - VM_DEFINE_OP (74, fluid_ref, "fluid-ref", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (70, scm_set_tag, "scm-set!/tag", OP1 (X8_S8_C8_S8)) { - scm_t_uint16 dst, src; - SCM fluid; - struct scm_cache_entry *entry; + uint8_t obj, tag, val; - UNPACK_12_12 (op, dst, src); - fluid = SP_REF (src); + UNPACK_8_8_8 (op, obj, tag, val); - /* If we find FLUID in the cache, then it is indeed a fluid. */ - entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid); - if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid) - && !SCM_UNBNDP (SCM_PACK (entry->value)))) - { - SP_SET (dst, SCM_PACK (entry->value)); - NEXT (1); - } - else - { - SYNC_IP (); - SP_SET (dst, scm_fluid_ref (fluid)); - NEXT (1); - } + SCM_SET_CELL_WORD_0 (SP_REF (obj), SCM_UNPACK (SP_REF (val)) + tag); + + NEXT (1); } - /* fluid-set fluid:12 val:12 + /* scm-ref/immediate dst:8 obj:8 idx:8 * - * Set the value of the fluid in DST to the value in SRC. + * Load the SCM object at word offset IDX from local OBJ, and store it + * to DST. IDX is a uint8_t immediate. */ - VM_DEFINE_OP (75, fluid_set, "fluid-set!", OP1 (X8_S12_S12)) + VM_DEFINE_OP (71, scm_ref_immediate, "scm-ref/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint16 a, b; - SCM fluid, value; - struct scm_cache_entry *entry; - - UNPACK_12_12 (op, a, b); - fluid = SP_REF (a); - value = SP_REF (b); - - /* If we find FLUID in the cache, then it is indeed a fluid. */ - entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid); - if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid))) - { - entry->value = SCM_UNPACK (value); - NEXT (1); - } - else - { - SYNC_IP (); - scm_fluid_set_x (fluid, value); - NEXT (1); - } - } + uint8_t dst, obj, idx; + UNPACK_8_8_8 (op, dst, obj, idx); - + SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), idx)); - /* - * Strings, symbols, and keywords - */ - - /* string-length dst:12 src:12 - * - * Store the length of the string in SRC in DST. - */ - VM_DEFINE_OP (76, string_length, "string-length", OP1 (X8_S12_S12) | OP_DST) - { - ARGS1 (str); - VM_VALIDATE_STRING (str, "string-length"); - SP_SET_U64 (dst, scm_i_string_length (str)); NEXT (1); } - /* string-ref dst:8 src:8 idx:8 + /* scm-set!/immediate obj:8 idx:8 val:8 * - * Fetch the character at position IDX in the string in SRC, and store - * it in DST. + * Store the SCM local VAL into object OBJ at word offset IDX. IDX is + * a uint8_t immediate. */ - VM_DEFINE_OP (77, string_ref, "string-ref", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (72, scm_set_immediate, "scm-set!/immediate", OP1 (X8_S8_C8_S8)) { - scm_t_uint8 dst, src, idx; - SCM str; - scm_t_uint64 c_idx; + uint8_t obj, idx, val; - UNPACK_8_8_8 (op, dst, src, idx); - str = SP_REF (src); - c_idx = SP_REF_U64 (idx); + UNPACK_8_8_8 (op, obj, idx, val); - VM_VALIDATE_STRING (str, "string-ref"); - VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref"); + SCM_SET_CELL_OBJECT (SP_REF (obj), idx, SP_REF (val)); - RETURN (scm_c_make_char (scm_i_string_ref (str, c_idx))); + NEXT (1); } - /* string-set! instruction is currently number 192. Probably need to - reorder before releasing. */ - - /* string->number dst:12 src:12 + /* word-ref dst:8 obj:8 idx:8 * - * Parse a string in SRC to a number, and store in DST. + * Load the word at offset IDX from local OBJ, and store it to u64 + * DST. */ - VM_DEFINE_OP (78, string_to_number, "string->number", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (73, word_ref, "word-ref", DOP1 (X8_S8_S8_S8)) { - scm_t_uint16 dst, src; + uint8_t dst, obj, idx; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, - scm_string_to_number (SP_REF (src), - SCM_UNDEFINED /* radix = 10 */)); - NEXT (1); - } + UNPACK_8_8_8 (op, dst, obj, idx); - /* string->symbol dst:12 src:12 - * - * Parse a string in SRC to a symbol, and store in DST. - */ - VM_DEFINE_OP (79, string_to_symbol, "string->symbol", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; + SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx))); - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, scm_string_to_symbol (SP_REF (src))); NEXT (1); } - /* symbol->keyword dst:12 src:12 + /* word-set! obj:8 idx:8 val:8 * - * Make a keyword from the symbol in SRC, and store it in DST. + * Store the u64 local VAL into object OBJ at word offset IDX. */ - VM_DEFINE_OP (80, symbol_to_keyword, "symbol->keyword", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (74, word_set, "word-set!", OP1 (X8_S8_S8_S8)) { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, scm_symbol_to_keyword (SP_REF (src))); - NEXT (1); - } + uint8_t obj, idx, val; - + UNPACK_8_8_8 (op, obj, idx, val); - /* - * Pairs - */ + SCM_SET_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx), SP_REF_U64 (val)); - /* cons dst:8 car:8 cdr:8 - * - * Cons CAR and CDR, and store the result in DST. - */ - VM_DEFINE_OP (81, cons, "cons", OP1 (X8_S8_S8_S8) | OP_DST) - { - ARGS2 (x, y); - SYNC_IP (); - RETURN (scm_inline_cons (thread, x, y)); + NEXT (1); } - /* car dst:12 src:12 + /* word-ref/immediate dst:8 obj:8 idx:8 * - * Place the car of SRC in DST. + * Load the word at offset IDX from local OBJ, and store it to u64 + * DST. IDX is a uint8_t immediate. */ - VM_DEFINE_OP (82, car, "car", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (75, word_ref_immediate, "word-ref/immediate", DOP1 (X8_S8_S8_C8)) { - ARGS1 (x); - VM_VALIDATE_PAIR (x, "car"); - RETURN (SCM_CAR (x)); - } + uint8_t dst, obj, idx; - /* cdr dst:12 src:12 - * - * Place the cdr of SRC in DST. - */ - VM_DEFINE_OP (83, cdr, "cdr", OP1 (X8_S12_S12) | OP_DST) - { - ARGS1 (x); - VM_VALIDATE_PAIR (x, "cdr"); - RETURN (SCM_CDR (x)); - } + UNPACK_8_8_8 (op, dst, obj, idx); + + SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), idx)); - /* set-car! pair:12 car:12 - * - * Set the car of DST to SRC. - */ - VM_DEFINE_OP (84, set_car, "set-car!", OP1 (X8_S12_S12)) - { - scm_t_uint16 a, b; - SCM x, y; - UNPACK_12_12 (op, a, b); - x = SP_REF (a); - y = SP_REF (b); - VM_VALIDATE_MUTABLE_PAIR (x, "set-car!"); - SCM_SETCAR (x, y); NEXT (1); } - /* set-cdr! pair:12 cdr:12 + /* word-set!/immediate obj:8 idx:8 val:8 * - * Set the cdr of DST to SRC. + * Store the u64 local VAL into object OBJ at word offset IDX. IDX is + * a uint8_t immediate. */ - VM_DEFINE_OP (85, set_cdr, "set-cdr!", OP1 (X8_S12_S12)) + VM_DEFINE_OP (76, word_set_immediate, "word-set!/immediate", OP1 (X8_S8_C8_S8)) { - scm_t_uint16 a, b; - SCM x, y; - UNPACK_12_12 (op, a, b); - x = SP_REF (a); - y = SP_REF (b); - VM_VALIDATE_MUTABLE_PAIR (x, "set-cdr!"); - SCM_SETCDR (x, y); - NEXT (1); - } - + uint8_t obj, idx, val; - + UNPACK_8_8_8 (op, obj, idx, val); - /* - * Numeric operations - */ + SCM_SET_CELL_WORD (SP_REF (obj), idx, SP_REF_U64 (val)); - /* add dst:8 a:8 b:8 - * - * Add A to B, and place the result in DST. - */ - VM_DEFINE_OP (86, add, "add", OP1 (X8_S8_S8_S8) | OP_DST) - { - BINARY_INTEGER_OP (+, scm_sum); + NEXT (1); } - /* add/immediate dst:8 src:8 imm:8 + /* pointer-ref/immediate dst:8 obj:8 idx:8 * - * Add the unsigned 8-bit value IMM to the value from SRC, and place - * the result in DST. + * Load the pointer at offset IDX from local OBJ, and store it to DST. + * IDX is a uint8_t immediate. */ - VM_DEFINE_OP (87, add_immediate, "add/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (77, pointer_ref_immediate, "pointer-ref/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint8 dst, src, imm; - SCM x; + uint8_t dst, obj, idx; - UNPACK_8_8_8 (op, dst, src, imm); - x = SP_REF (src); - - if (SCM_LIKELY (SCM_I_INUMP (x))) - { - scm_t_signed_bits sum = SCM_I_INUM (x) + (scm_t_signed_bits) imm; + UNPACK_8_8_8 (op, dst, obj, idx); - if (SCM_LIKELY (SCM_POSFIXABLE (sum))) - RETURN (SCM_I_MAKINUM (sum)); - } + SP_SET_PTR (dst, (void*) SCM_CELL_WORD (SP_REF (obj), idx)); - RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (imm))); + NEXT (1); } - /* sub dst:8 a:8 b:8 + /* pointer-set!/immediate obj:8 idx:8 val:8 * - * Subtract B from A, and place the result in DST. + * Store the pointer local VAL into object OBJ at offset IDX. IDX is + * a uint8_t immediate. */ - VM_DEFINE_OP (88, sub, "sub", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (78, pointer_set_immediate, "pointer-set!/immediate", OP1 (X8_S8_C8_S8)) { - BINARY_INTEGER_OP (-, scm_difference); + uint8_t obj, idx, val; + + UNPACK_8_8_8 (op, obj, idx, val); + + SCM_SET_CELL_WORD (SP_REF (obj), idx, (uintptr_t) SP_REF_PTR (val)); + + NEXT (1); } - /* sub/immediate dst:8 src:8 imm:8 + /* tail-pointer-ref/immediate dst:8 obj:8 idx:8 * - * Subtract the unsigned 8-bit value IMM from the value in SRC, and - * place the result in DST. + * Compute the address of word offset IDX from local OBJ, and store it + * to DST. IDX is a uint8_t immediate. */ - VM_DEFINE_OP (89, sub_immediate, "sub/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (79, tail_pointer_ref_immediate, "tail-pointer-ref/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint8 dst, src, imm; - SCM x; + uint8_t dst, obj, idx; - UNPACK_8_8_8 (op, dst, src, imm); - x = SP_REF (src); - - if (SCM_LIKELY (SCM_I_INUMP (x))) - { - scm_t_signed_bits diff = SCM_I_INUM (x) - (scm_t_signed_bits) imm; + UNPACK_8_8_8 (op, dst, obj, idx); - if (SCM_LIKELY (SCM_NEGFIXABLE (diff))) - RETURN (SCM_I_MAKINUM (diff)); - } + SP_SET_PTR (dst, ((scm_t_bits *) SCM2PTR (SP_REF (obj))) + idx); - RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (imm))); + NEXT (1); } - /* mul dst:8 a:8 b:8 + /* atomic-scm-ref/immediate dst:8 obj:8 idx:8 * - * Multiply A and B, and place the result in DST. + * Atomically reference the SCM object at word offset IDX from local + * OBJ, and store it to DST, using the sequential consistency memory + * model. IDX is a uint8_t immediate. */ - VM_DEFINE_OP (90, mul, "mul", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (80, atomic_scm_ref_immediate, "atomic-scm-ref/immediate", DOP1 (X8_S8_S8_C8)) { - ARGS2 (x, y); - RETURN_EXP (scm_product (x, y)); + uint8_t dst, obj, offset; + SCM *loc; + UNPACK_8_8_8 (op, dst, obj, offset); + loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); + SP_SET (dst, scm_atomic_ref_scm (loc)); + NEXT (1); } - /* div dst:8 a:8 b:8 + /* atomic-scm-set!/immediate obj:8 idx:8 val:8 * - * Divide A by B, and place the result in DST. + * Atomically store the SCM local VAL into object OBJ at word offset + * IDX, using the sequentially consistent memory model. IDX is a + * uint8_t immediate. */ - VM_DEFINE_OP (91, div, "div", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (81, atomic_scm_set_immediate, "atomic-scm-set!/immediate", OP1 (X8_S8_C8_S8)) { - ARGS2 (x, y); - RETURN_EXP (scm_divide (x, y)); + uint8_t obj, offset, val; + SCM *loc; + UNPACK_8_8_8 (op, obj, offset, val); + loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); + scm_atomic_set_scm (loc, SP_REF (val)); + NEXT (1); } - /* quo dst:8 a:8 b:8 + /* atomic-scm-swap!/immediate dst:24 _:8 obj:24 idx:8 val:24 * - * Divide A by B, and place the quotient in DST. + * Atomically swap the SCM value stored in object OBJ at word offset + * IDX with VAL, using the sequentially consistent memory model. IDX + * is a uint8_t immediate. Return the previous value to DST. */ - VM_DEFINE_OP (92, quo, "quo", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (82, atomic_scm_swap_immediate, "atomic-scm-swap!/immediate", DOP3 (X8_S24, X8_S24, C8_S24)) { - ARGS2 (x, y); - RETURN_EXP (scm_quotient (x, y)); + uint32_t dst, obj, val; + uint8_t offset; + SCM *loc; + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], obj); + UNPACK_8_24 (ip[2], offset, val); + loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); + SP_SET (dst, scm_atomic_swap_scm (loc, SP_REF (val))); + NEXT (3); } - /* rem dst:8 a:8 b:8 + /* atomic-scm-compare-and-swap!/immediate dst:24 _:8 obj:24 idx:8 expected:24 _:8 desired:24 * - * Divide A by B, and place the remainder in DST. + * Atomically swap the SCM value stored in object OBJ at word offset + * IDX with DESIRED, if and only if the value that was there was + * EXPECTED, using the sequentially consistent memory model. IDX is a + * uint8_t immediate. Return the value that was stored at IDX from + * OBJ in DST. */ - VM_DEFINE_OP (93, rem, "rem", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (83, atomic_scm_compare_and_swap_immediate, "atomic-scm-compare-and-swap!/immediate", DOP4 (X8_S24, X8_S24, C8_S24, X8_S24)) { - ARGS2 (x, y); - RETURN_EXP (scm_remainder (x, y)); + uint32_t dst, obj, expected, desired; + uint8_t offset; + SCM *loc; + SCM got; + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], obj); + UNPACK_8_24 (ip[2], offset, expected); + UNPACK_24 (ip[3], desired); + loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); + got = scm_atomic_compare_and_swap_scm (loc, SP_REF (expected), + SP_REF (desired)); + SP_SET (dst, got); + NEXT (4); } - /* mod dst:8 a:8 b:8 + /* static-ref dst:24 offset:32 * - * Place the modulo of A by B in DST. + * Load a SCM value into DST. The SCM value will be fetched from + * memory, OFFSET 32-bit words away from the current instruction + * pointer. OFFSET is a signed value. + * + * The intention is for this instruction to be used to load constants + * that the compiler is unable to statically allocate, like symbols. + * These values would be initialized when the object file loads. */ - VM_DEFINE_OP (94, mod, "mod", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (84, static_ref, "static-ref", DOP2 (X8_S24, R32)) { - ARGS2 (x, y); - RETURN_EXP (scm_modulo (x, y)); + uint32_t dst; + int32_t offset; + uint32_t* loc; + uintptr_t loc_bits; + + UNPACK_24 (op, dst); + offset = ip[1]; + loc = ip + offset; + loc_bits = (uintptr_t) loc; + VM_ASSERT (ALIGNED_P (loc, SCM), abort()); + + SP_SET (dst, *((SCM *) loc_bits)); + + NEXT (2); } - /* ash dst:8 a:8 b:8 + /* static-set! src:24 offset:32 * - * Shift A arithmetically by B bits, and place the result in DST. + * Store a SCM value into memory, OFFSET 32-bit words away from the + * current instruction pointer. OFFSET is a signed value. */ - VM_DEFINE_OP (95, ash, "ash", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (85, static_set, "static-set!", OP2 (X8_S24, LO32)) { - ARGS2 (x, y); - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) - { - if (SCM_I_INUM (y) < 0) - /* Right shift, will be a fixnum. */ - RETURN (SCM_I_MAKINUM - (SCM_SRS (SCM_I_INUM (x), - (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1) - ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1))); - else - /* Left shift. See comments in scm_ash. */ - { - scm_t_signed_bits nn, bits_to_shift; - - nn = SCM_I_INUM (x); - bits_to_shift = SCM_I_INUM (y); - - if (bits_to_shift < SCM_I_FIXNUM_BIT-1 - && ((scm_t_bits) - (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1) - <= 1)) - RETURN (SCM_I_MAKINUM (nn < 0 - ? -(-nn << bits_to_shift) - : (nn << bits_to_shift))); - /* fall through */ - } - /* fall through */ - } - RETURN_EXP (scm_ash (x, y)); + uint32_t src; + int32_t offset; + uint32_t* loc; + + UNPACK_24 (op, src); + offset = ip[1]; + loc = ip + offset; + VM_ASSERT (ALIGNED_P (loc, SCM), abort()); + + *((SCM *) loc) = SP_REF (src); + + NEXT (2); } - /* logand dst:8 a:8 b:8 + /* static-patch! _:24 dst-offset:32 src-offset:32 * - * Place the bitwise AND of A and B into DST. + * 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 (96, logand, "logand", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (86, static_patch, "static-patch!", OP3 (X32, LO32, L32)) { - ARGS2 (x, y); - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) - /* Compute bitwise AND without untagging */ - RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y))); - RETURN_EXP (scm_logand (x, y)); + int32_t dst_offset, src_offset; + void *src; + void** dst_loc; + + dst_offset = ip[1]; + src_offset = ip[2]; + + dst_loc = (void **) (ip + dst_offset); + src = ip + src_offset; + VM_ASSERT (ALIGNED_P (dst_loc, void*), abort()); + + *dst_loc = src; + + NEXT (3); } - /* logior dst:8 a:8 b:8 + /* tag-char dst:12 src:12 * - * Place the bitwise inclusive OR of A with B in DST. + * Make a SCM character whose integer value is the u64 in SRC, and + * store it in DST. */ - VM_DEFINE_OP (97, logior, "logior", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (87, tag_char, "tag-char", DOP1 (X8_S12_S12)) { - ARGS2 (x, y); - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) - /* Compute bitwise OR without untagging */ - RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y))); - RETURN_EXP (scm_logior (x, y)); + uint16_t dst, src; + UNPACK_12_12 (op, dst, src); + SP_SET (dst, + SCM_MAKE_ITAG8 ((scm_t_bits) (scm_t_wchar) SP_REF_U64 (src), + scm_tc8_char)); + NEXT (1); } - /* logxor dst:8 a:8 b:8 + /* untag-char dst:12 src:12 * - * Place the bitwise exclusive OR of A with B in DST. + * Extract the integer value from the SCM character SRC, and store the + * resulting u64 in DST. */ - VM_DEFINE_OP (98, logxor, "logxor", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (88, untag_char, "untag-char", DOP1 (X8_S12_S12)) { - ARGS2 (x, y); - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) - RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y))); - RETURN_EXP (scm_logxor (x, y)); + uint16_t dst, src; + UNPACK_12_12 (op, dst, src); + SP_SET_U64 (dst, SCM_CHAR (SP_REF (src))); + NEXT (1); } - /* make-vector dst:8 length:8 init:8 + /* tag-fixnum dst:12 src:12 * - * Make a vector and write it to DST. The vector will have space for - * LENGTH slots. They will be filled with the value in slot INIT. + * Make a SCM integer whose value is the s64 in SRC, and store it in + * DST. */ - VM_DEFINE_OP (99, make_vector, "make-vector", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (89, tag_fixnum, "tag-fixnum", DOP1 (X8_S12_S12)) { - scm_t_uint8 dst, length, init; - scm_t_uint64 length_val; + uint16_t dst, src; - UNPACK_8_8_8 (op, dst, length, init); - length_val = SP_REF_U64 (length); - VM_VALIDATE_INDEX (length_val, (size_t) -1, "make-vector"); + UNPACK_12_12 (op, dst, src); - /* TODO: Inline this allocation. */ - SYNC_IP (); - SP_SET (dst, scm_c_make_vector (length_val, SP_REF (init))); + SP_SET (dst, SCM_I_MAKINUM (SP_REF_S64 (src))); NEXT (1); } - /* make-vector/immediate dst:8 length:8 init:8 + /* untag-fixnum dst:12 src:12 * - * 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. + * Extract the integer value from the SCM integer SRC, and store the + * resulting s64 in DST. */ - VM_DEFINE_OP (100, make_vector_immediate, "make-vector/immediate", OP1 (X8_S8_C8_S8) | OP_DST) + VM_DEFINE_OP (90, untag_fixnum, "untag-fixnum", DOP1 (X8_S12_S12)) { - scm_t_uint8 dst, init; - scm_t_int32 length, n; - SCM val, vector; + uint16_t dst, src; + + UNPACK_12_12 (op, dst, src); - UNPACK_8_8_8 (op, dst, length, init); + SP_SET_S64 (dst, SCM_I_INUM (SP_REF (src))); - val = SP_REF (init); - SYNC_IP (); - vector = scm_inline_words (thread, scm_tc7_vector | (length << 8), - length + 1); - for (n = 0; n < length; n++) - SCM_SIMPLE_VECTOR_SET (vector, n, val); - SP_SET (dst, vector); NEXT (1); } - /* vector-length dst:12 src:12 + /* uadd dst:8 a:8 b:8 * - * Store the length of the vector in SRC in DST. + * Add A to B, and place the result in DST. The operands and the + * result are unboxed unsigned 64-bit integers. Overflow will wrap + * around. */ - VM_DEFINE_OP (101, vector_length, "vector-length", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (91, uadd, "uadd", DOP1 (X8_S8_S8_S8)) { - ARGS1 (vect); - VM_VALIDATE_VECTOR (vect, "vector-length"); - SP_SET_U64 (dst, SCM_I_VECTOR_LENGTH (vect)); + uint8_t dst, a, b; + UNPACK_8_8_8 (op, dst, a, b); + SP_SET_U64 (dst, SP_REF_U64 (a) + SP_REF_U64 (b)); NEXT (1); } - /* vector-ref dst:8 src:8 idx:8 + /* usub dst:8 a:8 b:8 * - * Fetch the item at position IDX in the vector in SRC, and store it - * in DST. + * Subtract B from A, and place the result in DST. The operands and + * the result are unboxed unsigned 64-bit integers. Overflow will + * wrap around. */ - VM_DEFINE_OP (102, vector_ref, "vector-ref", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (92, usub, "usub", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, src, idx; - SCM vect; - scm_t_uint64 c_idx; - - UNPACK_8_8_8 (op, dst, src, idx); - vect = SP_REF (src); - c_idx = SP_REF_U64 (idx); - - VM_VALIDATE_VECTOR (vect, "vector-ref"); - VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref"); - RETURN (SCM_I_VECTOR_ELTS (vect)[c_idx]); + uint8_t dst, a, b; + UNPACK_8_8_8 (op, dst, a, b); + SP_SET_U64 (dst, SP_REF_U64 (a) - SP_REF_U64 (b)); + NEXT (1); } - /* vector-ref/immediate dst:8 src:8 idx:8 + /* umul dst:8 a:8 b:8 * - * Fill DST with the item IDX elements into the vector at SRC. Useful - * for building data types using vectors. + * Multiply A and B, and place the result in DST. The operands and + * the result are unboxed unsigned 64-bit integers. Overflow will + * wrap around. */ - VM_DEFINE_OP (103, vector_ref_immediate, "vector-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (93, umul, "umul", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, src, idx; - SCM vect; - - UNPACK_8_8_8 (op, dst, src, idx); - vect = SP_REF (src); - VM_VALIDATE_VECTOR (vect, "vector-ref"); - VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref"); - SP_SET (dst, SCM_I_VECTOR_ELTS (vect)[idx]); + uint8_t dst, a, b; + UNPACK_8_8_8 (op, dst, a, b); + SP_SET_U64 (dst, SP_REF_U64 (a) * SP_REF_U64 (b)); NEXT (1); } - /* vector-set! dst:8 idx:8 src:8 + /* uadd/immediate dst:8 src:8 imm:8 * - * Store SRC into the vector DST at index IDX. + * Add the unsigned 64-bit value from SRC with the unsigned 8-bit + * value IMM and place the raw unsigned 64-bit result in DST. + * Overflow will wrap around. */ - VM_DEFINE_OP (104, vector_set, "vector-set!", OP1 (X8_S8_S8_S8)) + VM_DEFINE_OP (94, uadd_immediate, "uadd/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint8 dst, idx, src; - SCM vect, val; - scm_t_uint64 c_idx; - - UNPACK_8_8_8 (op, dst, idx, src); - vect = SP_REF (dst); - c_idx = SP_REF_U64 (idx); - val = SP_REF (src); + uint8_t dst, src, imm; + uint64_t x; - VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!"); - VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!"); - SCM_I_VECTOR_WELTS (vect)[c_idx] = val; + UNPACK_8_8_8 (op, dst, src, imm); + x = SP_REF_U64 (src); + SP_SET_U64 (dst, x + (uint64_t) imm); NEXT (1); } - /* vector-set!/immediate dst:8 idx:8 src:8 + /* usub/immediate dst:8 src:8 imm:8 * - * Store SRC into the vector DST at index IDX. Here IDX is an - * immediate value. + * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit + * value in SRC and place the raw unsigned 64-bit result in DST. + * Overflow will wrap around. */ - VM_DEFINE_OP (105, vector_set_immediate, "vector-set!/immediate", OP1 (X8_S8_C8_S8)) + VM_DEFINE_OP (95, usub_immediate, "usub/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint8 dst, idx, src; - SCM vect, val; - - UNPACK_8_8_8 (op, dst, idx, src); - vect = SP_REF (dst); - val = SP_REF (src); + uint8_t dst, src, imm; + uint64_t x; - VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!"); - VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!"); - SCM_I_VECTOR_WELTS (vect)[idx] = val; + UNPACK_8_8_8 (op, dst, src, imm); + x = SP_REF_U64 (src); + SP_SET_U64 (dst, x - (uint64_t) imm); NEXT (1); } - - - - /* - * Structs and GOOPS - */ - - /* struct-vtable dst:12 src:12 + /* umul/immediate dst:8 src:8 imm:8 * - * Store the vtable of SRC into DST. + * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit + * value IMM and place the raw unsigned 64-bit result in DST. + * Overflow will wrap around. */ - VM_DEFINE_OP (106, struct_vtable, "struct-vtable", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (96, umul_immediate, "umul/immediate", DOP1 (X8_S8_S8_C8)) { - ARGS1 (obj); - VM_VALIDATE_STRUCT (obj, "struct_vtable"); - RETURN (SCM_STRUCT_VTABLE (obj)); + uint8_t dst, src, imm; + uint64_t x; + + UNPACK_8_8_8 (op, dst, src, imm); + x = SP_REF_U64 (src); + SP_SET_U64 (dst, x * (uint64_t) imm); + NEXT (1); } - /* allocate-struct dst:8 vtable:8 nfields:8 + /* ulogand dst:8 a:8 b: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. + * Place the bitwise AND of the u64 values in A and B into DST. */ - VM_DEFINE_OP (107, allocate_struct, "allocate-struct", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (97, ulogand, "ulogand", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, vtable, nfields; - SCM ret; + uint8_t dst, a, b; - UNPACK_8_8_8 (op, dst, vtable, nfields); + UNPACK_8_8_8 (op, dst, a, b); - /* TODO: Specify nfields as untagged value when calling - allocate-struct. */ - SYNC_IP (); - ret = scm_allocate_struct (SP_REF (vtable), - scm_from_uint64 (SP_REF_U64 (nfields))); - SP_SET (dst, ret); + SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b)); NEXT (1); } - /* struct-ref dst:8 src:8 idx:8 + /* ulogior dst:8 a:8 b:8 * - * Fetch the item at slot IDX in the struct in SRC, and store it - * in DST. + * Place the bitwise inclusive OR of the u64 values in A and B into + * DST. */ - VM_DEFINE_OP (108, struct_ref, "struct-ref", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (98, ulogior, "ulogior", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, src, idx; - SCM obj; - scm_t_uint64 index; - - UNPACK_8_8_8 (op, dst, src, idx); + uint8_t dst, a, b; - obj = SP_REF (src); - index = SP_REF_U64 (idx); + UNPACK_8_8_8 (op, dst, a, b); - if (SCM_LIKELY (SCM_STRUCTP (obj) - && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, - SCM_VTABLE_FLAG_SIMPLE) - && index < (SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size)))) - RETURN (SCM_STRUCT_SLOT_REF (obj, index)); + SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b)); - SYNC_IP (); - RETURN (scm_struct_ref (obj, scm_from_uint64 (index))); + NEXT (1); } - /* struct-set! dst:8 idx:8 src:8 + /* ulogsub dst:8 a:8 b:8 * - * Store SRC into the struct DST at slot IDX. + * Place the (A & ~B) of the u64 values A and B into DST. */ - VM_DEFINE_OP (109, struct_set, "struct-set!", OP1 (X8_S8_S8_S8)) + VM_DEFINE_OP (99, ulogsub, "ulogsub", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, idx, src; - SCM obj, val; - scm_t_uint64 index; + uint8_t dst, a, b; - UNPACK_8_8_8 (op, dst, idx, src); - - obj = SP_REF (dst); - val = SP_REF (src); - index = SP_REF_U64 (idx); + UNPACK_8_8_8 (op, dst, a, b); - 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) - && index < (SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size)))) - { - SCM_STRUCT_SLOT_SET (obj, index, val); - NEXT (1); - } + SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b)); - SYNC_IP (); - scm_struct_set_x (obj, scm_from_uint64 (index), val); NEXT (1); } - /* allocate-struct/immediate dst:8 vtable:8 nfields:8 + /* ulogxor dst:8 a:8 b: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. + * Place the bitwise exclusive OR of the u64 values in A and B into + * DST. */ - VM_DEFINE_OP (110, allocate_struct_immediate, "allocate-struct/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (100, ulogxor, "ulogxor", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, vtable, nfields; - SCM ret; + uint8_t dst, a, b; - UNPACK_8_8_8 (op, dst, vtable, nfields); + UNPACK_8_8_8 (op, dst, a, b); - SYNC_IP (); - ret = scm_allocate_struct (SP_REF (vtable), SCM_I_MAKINUM (nfields)); - SP_SET (dst, ret); + SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b)); NEXT (1); } - /* struct-ref/immediate dst:8 src:8 idx:8 + /* ursh dst:8 a:8 b:8 * - * Fetch the item at slot IDX in the struct in SRC, and store it - * in DST. IDX is an immediate unsigned 8-bit value. + * Shift the u64 value in A right by B bits, and place the result in + * DST. Only the lower 6 bits of B are used. */ - VM_DEFINE_OP (111, struct_ref_immediate, "struct-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (101, ursh, "ursh", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, src, idx; - SCM obj; - - UNPACK_8_8_8 (op, dst, src, idx); + uint8_t dst, a, b; - obj = SP_REF (src); + UNPACK_8_8_8 (op, dst, a, b); - if (SCM_LIKELY (SCM_STRUCTP (obj) - && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, - SCM_VTABLE_FLAG_SIMPLE) - && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size))) - RETURN (SCM_STRUCT_SLOT_REF (obj, idx)); + SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63)); - SYNC_IP (); - RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx))); + NEXT (1); } - /* struct-set!/immediate dst:8 idx:8 src:8 + /* srsh dst:8 a:8 b:8 * - * Store SRC into the struct DST at slot IDX. IDX is an immediate - * unsigned 8-bit value. + * Shift the s64 value in A right by B bits, and place the result in + * DST. Only the lower 6 bits of B are used. */ - VM_DEFINE_OP (112, struct_set_immediate, "struct-set!/immediate", OP1 (X8_S8_C8_S8)) + VM_DEFINE_OP (102, srsh, "srsh", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, idx, src; - SCM obj, val; - - UNPACK_8_8_8 (op, dst, idx, src); + uint8_t dst, a, b; - obj = SP_REF (dst); - val = SP_REF (src); + UNPACK_8_8_8 (op, dst, a, b); - 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) - && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size))) - { - SCM_STRUCT_SLOT_SET (obj, idx, val); - NEXT (1); - } + SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), (SP_REF_U64 (b) & 63))); - SYNC_IP (); - scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val); NEXT (1); } - /* class-of dst:12 type:12 + /* ulsh dst:8 a:8 b:8 * - * Store the vtable of SRC into DST. + * Shift the u64 value in A left by B bits, and place the result in + * DST. Only the lower 6 bits of B are used. */ - VM_DEFINE_OP (113, class_of, "class-of", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (103, ulsh, "ulsh", DOP1 (X8_S8_S8_S8)) { - ARGS1 (obj); - if (SCM_INSTANCEP (obj)) - RETURN (SCM_CLASS_OF (obj)); - RETURN_EXP (scm_class_of (obj)); - } - - + uint8_t dst, a, b; - /* - * Arrays, packed uniform arrays, and bytevectors. - */ + UNPACK_8_8_8 (op, dst, a, b); - /* load-typed-array dst:24 _:8 type:24 _:8 shape:24 offset:32 len:32 - * - * Load the contiguous typed array located at OFFSET 32-bit words away - * from the instruction pointer, and store into DST. LEN is a byte - * length. OFFSET is signed. - */ - VM_DEFINE_OP (114, load_typed_array, "load-typed-array", OP5 (X8_S24, X8_S24, X8_S24, N32, C32) | OP_DST) - { - scm_t_uint32 dst, type, shape; - scm_t_int32 offset; - scm_t_uint32 len; + SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63)); - UNPACK_24 (op, dst); - UNPACK_24 (ip[1], type); - UNPACK_24 (ip[2], shape); - offset = ip[3]; - len = ip[4]; - SYNC_IP (); - SP_SET (dst, scm_from_contiguous_typed_array (SP_REF (type), - SP_REF (shape), - ip + offset, len)); - NEXT (5); + NEXT (1); } - /* make-array dst:24 _:8 type:24 _:8 fill:24 _:8 bounds:24 + /* ursh/immediate dst:8 a:8 b:8 * - * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST. + * Shift the u64 value in A right by the immediate B bits, and place + * the result in DST. Only the lower 6 bits of B are used. */ - VM_DEFINE_OP (115, make_array, "make-array", OP4 (X8_S24, X8_S24, X8_S24, X8_S24) | OP_DST) + VM_DEFINE_OP (104, ursh_immediate, "ursh/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint32 dst, type, fill, bounds; - UNPACK_24 (op, dst); - UNPACK_24 (ip[1], type); - UNPACK_24 (ip[2], fill); - UNPACK_24 (ip[3], bounds); - SYNC_IP (); - SP_SET (dst, scm_make_typed_array (SP_REF (type), SP_REF (fill), - SP_REF (bounds))); - NEXT (4); - } - - /* bv-u8-ref dst:8 src:8 idx:8 - * bv-s8-ref dst:8 src:8 idx:8 - * bv-u16-ref dst:8 src:8 idx:8 - * bv-s16-ref dst:8 src:8 idx:8 - * bv-u32-ref dst:8 src:8 idx:8 - * bv-s32-ref dst:8 src:8 idx:8 - * bv-u64-ref dst:8 src:8 idx:8 - * bv-s64-ref dst:8 src:8 idx:8 - * bv-f32-ref dst:8 src:8 idx:8 - * bv-f64-ref dst:8 src:8 idx:8 - * - * Fetch the item at byte offset IDX in the bytevector SRC, and store - * it in DST. All accesses use native endianness. - */ -#define BV_REF(stem, type, size, slot) \ - do { \ - type result; \ - scm_t_uint8 dst, src, idx; \ - SCM bv; \ - scm_t_uint64 c_idx; \ - UNPACK_8_8_8 (op, dst, src, idx); \ - bv = SP_REF (src); \ - c_idx = SP_REF_U64 (idx); \ - \ - VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \ - \ - VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size \ - && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx, \ - vm_error_out_of_range_uint64 ("bv-" #stem "-ref", c_idx)); \ - \ - memcpy (&result, SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, size); \ - SP_SET_ ## slot (dst, result); \ - NEXT (1); \ - } while (0) - - VM_DEFINE_OP (116, bv_u8_ref, "bv-u8-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (u8, scm_t_uint8, 1, U64); - - VM_DEFINE_OP (117, bv_s8_ref, "bv-s8-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (s8, scm_t_int8, 1, S64); + uint8_t dst, a, b; - VM_DEFINE_OP (118, bv_u16_ref, "bv-u16-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (u16, scm_t_uint16, 2, U64); - - VM_DEFINE_OP (119, bv_s16_ref, "bv-s16-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (s16, scm_t_int16, 2, S64); - - VM_DEFINE_OP (120, bv_u32_ref, "bv-u32-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (u32, scm_t_uint32, 4, U64); - - VM_DEFINE_OP (121, bv_s32_ref, "bv-s32-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (s32, scm_t_int32, 4, S64); - - VM_DEFINE_OP (122, bv_u64_ref, "bv-u64-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (u64, scm_t_uint64, 8, U64); - - VM_DEFINE_OP (123, bv_s64_ref, "bv-s64-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (s64, scm_t_int64, 8, S64); + UNPACK_8_8_8 (op, dst, a, b); - VM_DEFINE_OP (124, bv_f32_ref, "bv-f32-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (f32, float, 4, F64); + SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63)); - VM_DEFINE_OP (125, bv_f64_ref, "bv-f64-ref", OP1 (X8_S8_S8_S8) | OP_DST) - BV_REF (f64, double, 8, F64); + NEXT (1); + } - /* bv-u8-set! dst:8 idx:8 src:8 - * bv-s8-set! dst:8 idx:8 src:8 - * bv-u16-set! dst:8 idx:8 src:8 - * bv-s16-set! dst:8 idx:8 src:8 - * bv-u32-set! dst:8 idx:8 src:8 - * bv-s32-set! dst:8 idx:8 src:8 - * bv-u64-set! dst:8 idx:8 src:8 - * bv-s64-set! dst:8 idx:8 src:8 - * bv-f32-set! dst:8 idx:8 src:8 - * bv-f64-set! dst:8 idx:8 src:8 + /* srsh/immediate dst:8 a:8 b:8 * - * Store SRC into the bytevector DST at byte offset IDX. Multibyte - * values are written using native endianness. + * Shift the s64 value in A right by the immediate B bits, and place + * the result in DST. Only the lower 6 bits of B are used. */ -#define BV_BOUNDED_SET(stem, type, min, max, size, slot_type, slot) \ - do { \ - scm_t_ ## slot_type slot_val; \ - type val; \ - scm_t_uint8 dst, idx, src; \ - SCM bv; \ - scm_t_uint64 c_idx; \ - UNPACK_8_8_8 (op, dst, idx, src); \ - bv = SP_REF (dst); \ - c_idx = SP_REF_U64 (idx); \ - slot_val = SP_REF_ ## slot (src); \ - \ - VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \ - \ - VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size \ - && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx, \ - vm_error_out_of_range_uint64 ("bv-" #stem "-set!", c_idx)); \ - \ - VM_ASSERT (slot_val >= min && slot_val <= max, \ - vm_error_out_of_range_ ## slot_type ("bv-" #stem "-set!", \ - slot_val)); \ - \ - val = slot_val; \ - memcpy (SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, &val, size); \ - NEXT (1); \ - } while (0) - -#define BV_SET(stem, type, size, slot) \ - do { \ - type val; \ - scm_t_uint8 dst, idx, src; \ - SCM bv; \ - scm_t_uint64 c_idx; \ - UNPACK_8_8_8 (op, dst, idx, src); \ - bv = SP_REF (dst); \ - c_idx = SP_REF_U64 (idx); \ - val = SP_REF_ ## slot (src); \ - \ - VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \ - \ - VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size \ - && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx, \ - vm_error_out_of_range_uint64 ("bv-" #stem "-set!", c_idx)); \ - \ - memcpy (SCM_BYTEVECTOR_CONTENTS (bv) + c_idx, &val, size); \ - NEXT (1); \ - } while (0) - - VM_DEFINE_OP (126, bv_u8_set, "bv-u8-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (u8, scm_t_uint8, - 0, SCM_T_UINT8_MAX, 1, uint64, U64); - - VM_DEFINE_OP (127, bv_s8_set, "bv-s8-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (s8, scm_t_int8, - SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1, int64, S64); - - VM_DEFINE_OP (128, bv_u16_set, "bv-u16-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (u16, scm_t_uint16, - 0, SCM_T_UINT16_MAX, 2, uint64, U64); - - VM_DEFINE_OP (129, bv_s16_set, "bv-s16-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (s16, scm_t_int16, - SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2, int64, S64); - - VM_DEFINE_OP (130, bv_u32_set, "bv-u32-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (u32, scm_t_uint32, - 0, SCM_T_UINT32_MAX, 4, uint64, U64); - - VM_DEFINE_OP (131, bv_s32_set, "bv-s32-set!", OP1 (X8_S8_S8_S8)) - BV_BOUNDED_SET (s32, scm_t_int32, - SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4, int64, S64); - - VM_DEFINE_OP (132, bv_u64_set, "bv-u64-set!", OP1 (X8_S8_S8_S8)) - BV_SET (u64, scm_t_uint64, 8, U64); - - VM_DEFINE_OP (133, bv_s64_set, "bv-s64-set!", OP1 (X8_S8_S8_S8)) - BV_SET (s64, scm_t_int64, 8, S64); + VM_DEFINE_OP (105, srsh_immediate, "srsh/immediate", DOP1 (X8_S8_S8_C8)) + { + uint8_t dst, a, b; - VM_DEFINE_OP (134, bv_f32_set, "bv-f32-set!", OP1 (X8_S8_S8_S8)) - BV_SET (f32, float, 4, F64); + UNPACK_8_8_8 (op, dst, a, b); - VM_DEFINE_OP (135, bv_f64_set, "bv-f64-set!", OP1 (X8_S8_S8_S8)) - BV_SET (f6, double, 8, F64); + SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), b & 63)); - /* scm->f64 dst:12 src:12 - * - * Unpack a raw double-precision floating-point value from SRC and - * place it in DST. Note that SRC can be any value on which - * scm_to_double can operate. - */ - VM_DEFINE_OP (136, scm_to_f64, "scm->f64", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET_F64 (dst, scm_to_double (SP_REF (src))); NEXT (1); } - /* f64->scm dst:12 src:12 + /* ulsh/immediate dst:8 a:8 b:8 * - * Pack a raw double-precision floating point value into an inexact - * number allocated on the heap. + * Shift the u64 value in A left by the immediate B bits, and place + * the result in DST. Only the lower 6 bits of B are used. */ - VM_DEFINE_OP (137, f64_to_scm, "f64->scm", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (106, ulsh_immediate, "ulsh/immediate", DOP1 (X8_S8_S8_C8)) { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, scm_from_double (SP_REF_F64 (src))); + uint8_t dst, a, b; + + UNPACK_8_8_8 (op, dst, a, b); + + SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63)); + NEXT (1); } @@ -3157,9 +2521,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Add A to B, and place the result in DST. The operands and the * result are unboxed double-precision floating-point numbers. */ - VM_DEFINE_OP (138, fadd, "fadd", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (107, fadd, "fadd", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, a, b; + uint8_t dst, a, b; UNPACK_8_8_8 (op, dst, a, b); SP_SET_F64 (dst, SP_REF_F64 (a) + SP_REF_F64 (b)); NEXT (1); @@ -3170,9 +2534,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Subtract B from A, and place the result in DST. The operands and * the result are unboxed double-precision floating-point numbers. */ - VM_DEFINE_OP (139, fsub, "fsub", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (108, fsub, "fsub", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, a, b; + uint8_t dst, a, b; UNPACK_8_8_8 (op, dst, a, b); SP_SET_F64 (dst, SP_REF_F64 (a) - SP_REF_F64 (b)); NEXT (1); @@ -3183,9 +2547,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Multiply A and B, and place the result in DST. The operands and * the result are unboxed double-precision floating-point numbers. */ - VM_DEFINE_OP (140, fmul, "fmul", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (109, fmul, "fmul", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, a, b; + uint8_t dst, a, b; UNPACK_8_8_8 (op, dst, a, b); SP_SET_F64 (dst, SP_REF_F64 (a) * SP_REF_F64 (b)); NEXT (1); @@ -3196,865 +2560,726 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Divide A by B, and place the result in DST. The operands and the * result are unboxed double-precision floating-point numbers. */ - VM_DEFINE_OP (141, fdiv, "fdiv", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (110, fdiv, "fdiv", DOP1 (X8_S8_S8_S8)) { - scm_t_uint8 dst, a, b; + uint8_t dst, a, b; UNPACK_8_8_8 (op, dst, a, b); SP_SET_F64 (dst, SP_REF_F64 (a) / SP_REF_F64 (b)); NEXT (1); } - /* apply-non-program _:24 + /* u64=? a:12 b:12 * - * Used by the VM as a trampoline to apply non-programs. + * Set the comparison result to EQUAL if the u64 values A and B are + * the same, or NONE otherwise. */ - VM_DEFINE_OP (142, apply_non_program, "apply-non-program", OP1 (X32)) + VM_DEFINE_OP (111, u64_numerically_equal, "u64=?", OP1 (X8_S12_S12)) { - SCM proc = FP_REF (0); + uint16_t a, b; + uint64_t x, y; - while (!SCM_PROGRAM_P (proc)) - { - if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)) - { - proc = SCM_STRUCT_PROCEDURE (proc); - FP_SET (0, proc); - continue; - } - if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc)) - { - scm_t_uint32 n = FRAME_LOCALS_COUNT(); - - /* Shuffle args up. (FIXME: no real need to shuffle; just set - IP and go. ) */ - ALLOC_FRAME (n + 1); - while (n--) - FP_SET (n + 1, FP_REF (n)); - - proc = SCM_SMOB_DESCRIPTOR (proc).apply_trampoline; - FP_SET (0, proc); - continue; - } - - SYNC_IP(); - vm_error_wrong_type_apply (proc); - } + UNPACK_12_12 (op, a, b); + x = SP_REF_U64 (a); + y = SP_REF_U64 (b); - ip = SCM_PROGRAM_CODE (proc); - NEXT (0); - } + VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE; - /* scm->u64 dst:12 src:12 - * - * Unpack an unsigned 64-bit integer from SRC and place it in DST. - */ - VM_DEFINE_OP (143, scm_to_u64, "scm->u64", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET_U64 (dst, scm_to_uint64 (SP_REF (src))); NEXT (1); } - /* u64->scm dst:12 src:12 + /* u64<? a:12 b:12 * - * Pack an unsigned 64-bit integer into a SCM value. + * Set the comparison result to LESS_THAN if the u64 value A is less + * than the u64 value B are the same, or NONE otherwise. */ - VM_DEFINE_OP (144, u64_to_scm, "u64->scm", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (112, u64_less, "u64<?", OP1 (X8_S12_S12)) { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, scm_from_uint64 (SP_REF_U64 (src))); - NEXT (1); - } + uint16_t a, b; + uint64_t x, y; + + UNPACK_12_12 (op, a, b); + x = SP_REF_U64 (a); + y = SP_REF_U64 (b); + + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; - /* bv-length dst:12 src:12 - * - * Store the length of the bytevector in SRC in DST, as an untagged - * 64-bit integer. - */ - VM_DEFINE_OP (145, bv_length, "bv-length", OP1 (X8_S12_S12) | OP_DST) - { - ARGS1 (bv); - VM_VALIDATE_BYTEVECTOR (bv, "bytevector-length"); - SP_SET_U64 (dst, SCM_BYTEVECTOR_LENGTH (bv)); NEXT (1); } - /* br-if-= a:12 b:12 invert:1 _:7 offset:24 + /* s64<? a:12 b:12 * - * If the value in A is = to the value in B, add OFFSET, a signed - * 24-bit number, to the current instruction pointer. + * Set the comparison result to LESS_THAN if the s64 value A is less + * than the s64 value B are the same, or NONE otherwise. */ - VM_DEFINE_OP (146, br_if_u64_ee, "br-if-u64-=", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (113, s64_less, "s64<?", OP1 (X8_S12_S12)) { - BR_U64_ARITHMETIC (==); - } + uint16_t a, b; + int64_t x, y; - /* br-if-< a:12 b:12 invert:1 _:7 offset:24 - * - * 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 (147, br_if_u64_lt, "br-if-u64-<", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_U64_ARITHMETIC (<); - } + UNPACK_12_12 (op, a, b); + x = SP_REF_S64 (a); + y = SP_REF_S64 (b); - VM_DEFINE_OP (148, br_if_u64_le, "br-if-u64-<=", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_U64_ARITHMETIC (<=); - } + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; - /* uadd dst:8 a:8 b:8 - * - * Add A to B, and place the result in DST. The operands and the - * result are unboxed unsigned 64-bit integers. Overflow will wrap - * around. - */ - VM_DEFINE_OP (149, uadd, "uadd", OP1 (X8_S8_S8_S8) | OP_DST) - { - scm_t_uint8 dst, a, b; - UNPACK_8_8_8 (op, dst, a, b); - SP_SET_U64 (dst, SP_REF_U64 (a) + SP_REF_U64 (b)); NEXT (1); } - /* usub dst:8 a:8 b:8 - * - * Subtract B from A, and place the result in DST. The operands and - * the result are unboxed unsigned 64-bit integers. Overflow will - * wrap around. - */ - VM_DEFINE_OP (150, usub, "usub", OP1 (X8_S8_S8_S8) | OP_DST) - { - scm_t_uint8 dst, a, b; - UNPACK_8_8_8 (op, dst, a, b); - SP_SET_U64 (dst, SP_REF_U64 (a) - SP_REF_U64 (b)); - NEXT (1); - } - - /* umul dst:8 a:8 b:8 + /* s64-imm=? a:12 b:12 * - * Multiply A and B, and place the result in DST. The operands and - * the result are unboxed unsigned 64-bit integers. Overflow will - * wrap around. + * Set the comparison result to EQUAL if the s64 value A is equal to + * the immediate s64 value B, or NONE otherwise. */ - VM_DEFINE_OP (151, umul, "umul", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (114, s64_imm_numerically_equal, "s64-imm=?", OP1 (X8_S12_Z12)) { - scm_t_uint8 dst, a, b; - UNPACK_8_8_8 (op, dst, a, b); - SP_SET_U64 (dst, SP_REF_U64 (a) * SP_REF_U64 (b)); - NEXT (1); - } + uint16_t a; + int64_t x, y; - /* uadd/immediate dst:8 src:8 imm:8 - * - * Add the unsigned 64-bit value from SRC with the unsigned 8-bit - * value IMM and place the raw unsigned 64-bit result in DST. - * Overflow will wrap around. - */ - VM_DEFINE_OP (152, uadd_immediate, "uadd/immediate", OP1 (X8_S8_S8_C8) | OP_DST) - { - scm_t_uint8 dst, src, imm; - scm_t_uint64 x; + a = (op >> 8) & 0xfff; + x = SP_REF_S64 (a); - UNPACK_8_8_8 (op, dst, src, imm); - x = SP_REF_U64 (src); - SP_SET_U64 (dst, x + (scm_t_uint64) imm); - NEXT (1); - } + y = ((int32_t) op) >> 20; /* Sign extension. */ - /* usub/immediate dst:8 src:8 imm:8 - * - * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit - * value in SRC and place the raw unsigned 64-bit result in DST. - * Overflow will wrap around. - */ - VM_DEFINE_OP (153, usub_immediate, "usub/immediate", OP1 (X8_S8_S8_C8) | OP_DST) - { - scm_t_uint8 dst, src, imm; - scm_t_uint64 x; + VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE; - UNPACK_8_8_8 (op, dst, src, imm); - x = SP_REF_U64 (src); - SP_SET_U64 (dst, x - (scm_t_uint64) imm); NEXT (1); } - /* umul/immediate dst:8 src:8 imm:8 + /* u64-imm<? a:12 b:12 * - * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit - * value IMM and place the raw unsigned 64-bit result in DST. - * Overflow will wrap around. + * Set the comparison result to LESS_THAN if the u64 value A is less + * than the immediate u64 value B, or NONE otherwise. */ - VM_DEFINE_OP (154, umul_immediate, "umul/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (115, u64_imm_less, "u64-imm<?", OP1 (X8_S12_C12)) { - scm_t_uint8 dst, src, imm; - scm_t_uint64 x; + uint16_t a; + uint64_t x, y; - UNPACK_8_8_8 (op, dst, src, imm); - x = SP_REF_U64 (src); - SP_SET_U64 (dst, x * (scm_t_uint64) imm); - NEXT (1); - } + UNPACK_12_12 (op, a, y); + x = SP_REF_U64 (a); - /* load-f64 dst:24 high-bits:32 low-bits:32 - * - * Make a double-precision floating-point value with HIGH-BITS and - * LOW-BITS. - */ - VM_DEFINE_OP (155, load_f64, "load-f64", OP3 (X8_S24, AF32, BF32) | OP_DST) - { - scm_t_uint32 dst; - scm_t_uint64 val; + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; - UNPACK_24 (op, dst); - val = ip[1]; - val <<= 32; - val |= ip[2]; - SP_SET_U64 (dst, val); - NEXT (3); + NEXT (1); } - /* load-u64 dst:24 high-bits:32 low-bits:32 + /* imm-u64<? a:12 b:12 * - * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS. + * Set the comparison result to LESS_THAN if the u64 immediate B is + * less than the u64 value A, or NONE otherwise. */ - VM_DEFINE_OP (156, load_u64, "load-u64", OP3 (X8_S24, AU32, BU32) | OP_DST) + VM_DEFINE_OP (116, imm_u64_less, "imm-u64<?", OP1 (X8_S12_C12)) { - scm_t_uint32 dst; - scm_t_uint64 val; + uint16_t a; + uint64_t x, y; - UNPACK_24 (op, dst); - val = ip[1]; - val <<= 32; - val |= ip[2]; - SP_SET_U64 (dst, val); - NEXT (3); - } + UNPACK_12_12 (op, a, x); + y = SP_REF_U64 (a); - /* scm->s64 dst:12 src:12 - * - * Unpack a signed 64-bit integer from SRC and place it in DST. - */ - VM_DEFINE_OP (157, scm_to_s64, "scm->s64", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET_S64 (dst, scm_to_int64 (SP_REF (src))); - NEXT (1); - } + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; - /* s64->scm dst:12 src:12 - * - * Pack an signed 64-bit integer into a SCM value. - */ - VM_DEFINE_OP (158, s64_to_scm, "s64->scm", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - SP_SET (dst, scm_from_int64 (SP_REF_S64 (src))); NEXT (1); } - /* load-s64 dst:24 high-bits:32 low-bits:32 + /* s64-imm<? a:12 b:12 * - * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS. + * Set the comparison result to LESS_THAN if the s64 value A is less + * than the immediate s64 value B, or NONE otherwise. */ - VM_DEFINE_OP (159, load_s64, "load-s64", OP3 (X8_S24, AS32, BS32) | OP_DST) + VM_DEFINE_OP (117, s64_imm_less, "s64-imm<?", OP1 (X8_S12_Z12)) { - scm_t_uint32 dst; - scm_t_uint64 val; + uint16_t a; + int64_t x, y; - UNPACK_24 (op, dst); - val = ip[1]; - val <<= 32; - val |= ip[2]; - SP_SET_U64 (dst, val); - NEXT (3); - } + a = (op >> 8) & 0xfff; + x = SP_REF_S64 (a); - /* current-thread dst:24 - * - * Write the current thread into DST. - */ - VM_DEFINE_OP (160, current_thread, "current-thread", OP1 (X8_S24) | OP_DST) - { - scm_t_uint32 dst; + y = ((int32_t) op) >> 20; /* Sign extension. */ - UNPACK_24 (op, dst); - SP_SET (dst, thread->handle); + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; NEXT (1); } - /* logsub dst:8 a:8 b:8 + /* imm-s64<? a:12 b:12 * - * Place the bitwise AND of A and the bitwise NOT of B into DST. + * Set the comparison result to LESS_THAN if the s64 immediate B is + * less than the s64 value A, or NONE otherwise. */ - VM_DEFINE_OP (161, logsub, "logsub", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (118, imm_s64_less, "imm-s64<?", OP1 (X8_S12_Z12)) { - ARGS2 (x, y); + uint16_t a; + int64_t x, y; - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) - { - scm_t_signed_bits a, b; + a = (op >> 8) & 0xfff; + y = SP_REF_S64 (a); - a = SCM_I_INUM (x); - b = SCM_I_INUM (y); + x = ((int32_t) op) >> 20; /* Sign extension. */ - RETURN (SCM_I_MAKINUM (a & ~b)); - } + VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE; - RETURN_EXP (scm_logand (x, scm_lognot (y))); + NEXT (1); } - /* ulogand dst:8 a:8 b:8 + /* f64=? a:12 b:12 * - * Place the bitwise AND of the u64 values in A and B into DST. + * Set the comparison result to EQUAL if the f64 value A is equal to + * the f64 value B, or NONE otherwise. */ - VM_DEFINE_OP (162, ulogand, "ulogand", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (119, f64_numerically_equal, "f64=?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; + uint16_t a, b; + double x, y; - UNPACK_8_8_8 (op, dst, a, b); + UNPACK_12_12 (op, a, b); + x = SP_REF_F64 (a); + y = SP_REF_F64 (b); - SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b)); + if (x == y) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + /* This is also the case for NaN. */ + VP->compare_result = SCM_F_COMPARE_NONE; NEXT (1); } - /* ulogior dst:8 a:8 b:8 + /* f64<? a:12 b:12 * - * Place the bitwise inclusive OR of the u64 values in A and B into - * DST. + * Set the comparison result to LESS_THAN if the f64 value A is less + * than the f64 value B, NONE if A is greater than or equal to B, or + * INVALID otherwise. */ - VM_DEFINE_OP (163, ulogior, "ulogior", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (120, f64_less, "f64<?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; + uint16_t a, b; + double x, y; - UNPACK_8_8_8 (op, dst, a, b); + UNPACK_12_12 (op, a, b); + x = SP_REF_F64 (a); + y = SP_REF_F64 (b); - SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b)); + if (x < y) + VP->compare_result = SCM_F_COMPARE_LESS_THAN; + else if (x >= y) + VP->compare_result = SCM_F_COMPARE_NONE; + else + /* NaN. */ + VP->compare_result = SCM_F_COMPARE_INVALID; NEXT (1); } - /* ulogsub dst:8 a:8 b:8 + /* =? a:12 b:12 * - * Place the (A & ~B) of the u64 values A and B into DST. + * Set the comparison result to EQUAL if the SCM values A and B are + * numerically equal, in the sense of "=". Set to NONE otherwise. */ - VM_DEFINE_OP (164, ulogsub, "ulogsub", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (121, numerically_equal, "=?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; - - UNPACK_8_8_8 (op, dst, a, b); + uint16_t a, b; + SCM x, y; - SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b)); + UNPACK_12_12 (op, a, b); + x = SP_REF (a); + y = SP_REF (b); + SYNC_IP (); + if (CALL_INTRINSIC (numerically_equal_p, (x, y))) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + VP->compare_result = SCM_F_COMPARE_NONE; + CACHE_SP (); NEXT (1); } - /* ursh dst:8 a:8 b:8 + /* heap-numbers-equal? a:12 b:12 * - * Shift the u64 value in A right by B bits, and place the result in - * DST. Only the lower 6 bits of B are used. + * Set the comparison result to EQUAL if the SCM values A and B are + * numerically equal, in the sense of "=". Set to NONE otherwise. It + * is known that both A and B are heap numbers. */ - VM_DEFINE_OP (165, ursh, "ursh", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (122, heap_numbers_equal, "heap-numbers-equal?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; - - UNPACK_8_8_8 (op, dst, a, b); + uint16_t a, b; + SCM x, y; - SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63)); + UNPACK_12_12 (op, a, b); + x = SP_REF (a); + y = SP_REF (b); + SYNC_IP (); + if (CALL_INTRINSIC (heap_numbers_equal_p, (x, y))) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + VP->compare_result = SCM_F_COMPARE_NONE; + CACHE_SP (); NEXT (1); } - /* ulsh dst:8 a:8 b:8 + /* <? a:12 b:12 * - * Shift the u64 value in A left by B bits, and place the result in - * DST. Only the lower 6 bits of B are used. + * Set the comparison result to LESS_THAN if the SCM value A is less + * than the SCM value B, NONE if A is greater than or equal to B, or + * INVALID otherwise. */ - VM_DEFINE_OP (166, ulsh, "ulsh", OP1 (X8_S8_S8_S8) | OP_DST) + VM_DEFINE_OP (123, less, "<?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; - - UNPACK_8_8_8 (op, dst, a, b); + uint16_t a, b; + SCM x, y; - SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63)); + UNPACK_12_12 (op, a, b); + x = SP_REF (a); + y = SP_REF (b); + SYNC_IP (); + VP->compare_result = CALL_INTRINSIC (less_p, (x, y)); + CACHE_SP (); NEXT (1); } - /* scm->u64/truncate dst:12 src:12 + /* immediate-tag=? obj:24 mask:16 tag:16 * - * Unpack an exact integer from SRC and place it in the unsigned - * 64-bit register DST, truncating any high bits. If the number in - * SRC is negative, all the high bits will be set. + * Set the comparison result to EQUAL if the result of a bitwise AND + * between the bits of SCM value A and the immediate MASK is TAG, or + * NONE otherwise. */ - VM_DEFINE_OP (167, scm_to_u64_truncate, "scm->u64/truncate", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (124, immediate_tag_equals, "immediate-tag=?", OP2 (X8_S24, C16_C16)) { - scm_t_uint16 dst, src; + uint32_t a; + uint16_t mask, expected; SCM x; - UNPACK_12_12 (op, dst, src); - x = SP_REF (src); + UNPACK_24 (op, a); + UNPACK_16_16 (ip[1], mask, expected); + x = SP_REF (a); - if (SCM_I_INUMP (x)) - SP_SET_U64 (dst, (scm_t_uint64) SCM_I_INUM (x)); + if ((SCM_UNPACK (x) & mask) == expected) + VP->compare_result = SCM_F_COMPARE_EQUAL; else - { - SYNC_IP (); - SP_SET_U64 (dst, - scm_to_uint64 - (scm_logand (x, scm_from_uint64 ((scm_t_uint64) -1)))); - } + VP->compare_result = SCM_F_COMPARE_NONE; - NEXT (1); + NEXT (2); } - /* ursh/immediate dst:8 a:8 b:8 + /* heap-tag=? obj:24 mask:16 tag:16 * - * Shift the u64 value in A right by the immediate B bits, and place - * the result in DST. Only the lower 6 bits of B are used. + * Set the comparison result to EQUAL if the result of a bitwise AND + * between the first word of SCM value A and the immediate MASK is + * TAG, or NONE otherwise. */ - VM_DEFINE_OP (168, ursh_immediate, "ursh/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (125, heap_tag_equals, "heap-tag=?", OP2 (X8_S24, C16_C16)) { - scm_t_uint8 dst, a, b; + uint32_t a; + uint16_t mask, expected; + SCM x; - UNPACK_8_8_8 (op, dst, a, b); + UNPACK_24 (op, a); + UNPACK_16_16 (ip[1], mask, expected); + x = SP_REF (a); - SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63)); + if ((SCM_CELL_TYPE (x) & mask) == expected) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + VP->compare_result = SCM_F_COMPARE_NONE; - NEXT (1); + NEXT (2); } - /* ulsh/immediate dst:8 a:8 b:8 + /* eq? a:12 b:12 * - * Shift the u64 value in A left by the immediate B bits, and place - * the result in DST. Only the lower 6 bits of B are used. + * Set the comparison result to EQUAL if the SCM values A and B are + * eq?, or NONE otherwise. */ - VM_DEFINE_OP (169, ulsh_immediate, "ulsh/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + VM_DEFINE_OP (126, eq, "eq?", OP1 (X8_S12_S12)) { - scm_t_uint8 dst, a, b; + uint16_t a, b; + SCM x, y; - UNPACK_8_8_8 (op, dst, a, b); + UNPACK_12_12 (op, a, b); + x = SP_REF (a); + y = SP_REF (b); - SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63)); + if (scm_is_eq (x, y)) + VP->compare_result = SCM_F_COMPARE_EQUAL; + else + VP->compare_result = SCM_F_COMPARE_NONE; NEXT (1); } -#define BR_U64_SCM_COMPARISON(x, y, unboxed, boxed) \ - do { \ - scm_t_uint32 a, b; \ - scm_t_uint64 x; \ - SCM y_scm; \ - \ - UNPACK_24 (op, a); \ - UNPACK_24 (ip[1], b); \ - x = SP_REF_U64 (a); \ - y_scm = SP_REF (b); \ - \ - if (SCM_I_INUMP (y_scm)) \ - { \ - scm_t_signed_bits y = SCM_I_INUM (y_scm); \ - \ - if ((ip[2] & 0x1) ? !(unboxed) : (unboxed)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } \ - else \ - { \ - SCM res; \ - SYNC_IP (); \ - res = boxed (scm_from_uint64 (x), y_scm); \ - CACHE_SP (); \ - if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \ - { \ - scm_t_int32 offset = ip[2]; \ - offset >>= 8; /* Sign-extending shift. */ \ - NEXT (offset); \ - } \ - NEXT (3); \ - } \ - } while (0) - - /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24 + /* j offset:24 * - * If the U64 value in A is = to the SCM value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Add OFFSET, a signed 24-bit number, to the current instruction + * pointer. */ - VM_DEFINE_OP (170, br_if_u64_ee_scm, "br-if-u64-=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (127, j, "j", OP1 (X8_L24)) { - BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y == x, scm_num_eq_p); + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); } - /* br-if-u64-<-scm a:24 _:8 b:24 invert:1 _:7 offset:24 + /* jl offset:24 * - * If the U64 value in A is < than the SCM value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * If the last comparison result is equal to SCM_F_COMPARE_LESS_THAN, add + * OFFSET, a signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (171, br_if_u64_lt_scm, "br-if-u64-<-scm", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (128, jl, "jl", OP1 (X8_L24)) { - BR_U64_SCM_COMPARISON(x, y, y > 0 && (scm_t_uint64) y > x, scm_less_p); + if (VP->compare_result == SCM_F_COMPARE_LESS_THAN) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); } - /* br-if-u64-=-scm a:24 _:8 b:24 invert:1 _:7 offset:24 + /* je offset:24 * - * If the U64 value in A is <= than the SCM value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * If the last comparison result was EQUAL, then add OFFSET, a signed + * 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (172, br_if_u64_le_scm, "br-if-u64-<=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (129, je, "je", OP1 (X8_L24)) { - BR_U64_SCM_COMPARISON(x, y, y >= 0 && (scm_t_uint64) y >= x, scm_leq_p); + if (VP->compare_result == SCM_F_COMPARE_EQUAL) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); } - /* br-if-u64->-scm a:24 _:8 b:24 invert:1 _:7 offset:24 + /* jnl offset:24 * - * If the U64 value in A is > than the SCM value in B, add OFFSET, a + * If the last comparison result was not LESS_THAN, then add OFFSET, a * signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (173, br_if_u64_gt_scm, "br-if-u64->-scm", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (130, jnl, "jnl", OP1 (X8_L24)) { - BR_U64_SCM_COMPARISON(x, y, y < 0 || (scm_t_uint64) y < x, scm_gr_p); + if (VP->compare_result != SCM_F_COMPARE_LESS_THAN) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); } - /* br-if-u64->=-scm a:24 _:8 b:24 invert:1 _:7 offset:24 + /* jne offset:24 * - * If the U64 value in A is >= than the SCM value in B, add OFFSET, a + * If the last comparison result was not EQUAL, then add OFFSET, a * signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (174, br_if_u64_ge_scm, "br-if-u64->=-scm", OP3 (X8_S24, X8_S24, B1_X7_L24)) + VM_DEFINE_OP (131, jne, "jne", OP1 (X8_L24)) { - BR_U64_SCM_COMPARISON(x, y, y <= 0 || (scm_t_uint64) y <= x, scm_geq_p); + if (VP->compare_result != SCM_F_COMPARE_EQUAL) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); } - /* integer->char a:12 b:12 + /* jge offset:24 * - * Convert the U64 value in B to a Scheme character, and return it in - * A. + * If the last comparison result was NONE, then add OFFSET, a signed + * 24-bit number, to the current instruction pointer. + * + * This is intended for use after a "<?" comparison, and is different + * from "jnl" in the way it handles not-a-number (NaN) values: "<?" + * sets INVALID instead of NONE if either value is a NaN. For exact + * numbers, "jge" is the same as "jnl". */ - VM_DEFINE_OP (175, integer_to_char, "integer->char", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (132, jge, "jge", OP1 (X8_L24)) { - scm_t_uint16 dst, src; - scm_t_uint64 x; - - UNPACK_12_12 (op, dst, src); - x = SP_REF_U64 (src); - - VM_ASSERT (x <= (scm_t_uint64) SCM_CODEPOINT_MAX, - vm_error_out_of_range_uint64 ("integer->char", x)); - - SP_SET (dst, SCM_MAKE_ITAG8 ((scm_t_bits) (scm_t_wchar) x, scm_tc8_char)); - - NEXT (1); + if (VP->compare_result == SCM_F_COMPARE_NONE) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); } - /* char->integer a:12 b:12 + /* jnge offset:24 * - * Untag the character in B to U64, and return it in A. + * If the last comparison result was not NONE, then add OFFSET, a + * signed 24-bit number, to the current instruction pointer. + * + * This is intended for use after a "<?" comparison, and is different + * from "jl" in the way it handles not-a-number (NaN) values: "<?" + * sets INVALID instead of NONE if either value is a NaN. For exact + * numbers, "jnge" is the same as "jl". */ - VM_DEFINE_OP (176, char_to_integer, "char->integer", OP1 (X8_S12_S12) | OP_DST) + VM_DEFINE_OP (133, jnge, "jnge", OP1 (X8_L24)) { - scm_t_uint16 dst, src; - SCM x; - - UNPACK_12_12 (op, dst, src); - x = SP_REF (src); + if (VP->compare_result != SCM_F_COMPARE_NONE) + { + int32_t offset = op; + offset >>= 8; /* Sign-extending shift. */ + NEXT (offset); + } + else + NEXT (1); + } - VM_VALIDATE_CHAR (x, "char->integer"); - SP_SET_U64 (dst, SCM_CHAR (x)); +#define PTR_REF(type, slot) \ + do { \ + uint8_t dst, a, b; \ + char *ptr; \ + size_t idx; \ + type val; \ + UNPACK_8_8_8 (op, dst, a, b); \ + ptr = SP_REF_PTR (a); \ + idx = SP_REF_U64 (b); \ + memcpy (&val, ptr + idx, sizeof (val)); \ + SP_SET_ ## slot (dst, val); \ + NEXT (1); \ + } while (0) - NEXT (1); - } +#define PTR_SET(type, slot) \ + do { \ + uint8_t a, b, c; \ + char *ptr; \ + size_t idx; \ + type val; \ + UNPACK_8_8_8 (op, a, b, c); \ + ptr = SP_REF_PTR (a); \ + idx = SP_REF_U64 (b); \ + val = SP_REF_ ## slot (c); \ + memcpy (ptr + idx, &val, sizeof (val)); \ + NEXT (1); \ + } while (0) - /* ulogxor dst:8 a:8 b:8 + /* u8-ref dst:8 ptr:8 idx:8 * - * Place the bitwise exclusive OR of the u64 values in A and B into - * DST. + * Load the u8 at byte offset IDX from pointer PTR, and store it to + * u64 DST. */ - VM_DEFINE_OP (177, ulogxor, "ulogxor", OP1 (X8_S8_S8_S8) | OP_DST) - { - scm_t_uint8 dst, a, b; - - UNPACK_8_8_8 (op, dst, a, b); - - SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b)); + VM_DEFINE_OP (134, u8_ref, "u8-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (uint8_t, U64); - NEXT (1); - } - - /* make-atomic-box dst:12 src:12 + /* u16-ref dst:8 ptr:8 idx:8 * - * Create a new atomic box initialized to SRC, and place it in DST. + * Load the u16 at byte offset IDX from pointer PTR, and store it to + * u64 DST. */ - VM_DEFINE_OP (178, make_atomic_box, "make-atomic-box", OP1 (X8_S12_S12) | OP_DST) - { - SCM box; - scm_t_uint16 dst, src; - UNPACK_12_12 (op, dst, src); - SYNC_IP (); - box = scm_inline_cell (thread, scm_tc7_atomic_box, - SCM_UNPACK (SCM_UNSPECIFIED)); - scm_atomic_set_scm (scm_atomic_box_loc (box), SP_REF (src)); - SP_SET (dst, box); - NEXT (1); - } + VM_DEFINE_OP (135, u16_ref, "u16-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (uint16_t, U64); - /* atomic-box-ref dst:12 src:12 + /* u32-ref dst:8 ptr:8 idx:8 * - * Fetch the value of the atomic box at SRC into DST. + * Load the u32 at byte offset IDX from pointer PTR, and store it to + * u64 DST. */ - VM_DEFINE_OP (179, atomic_box_ref, "atomic-box-ref", OP1 (X8_S12_S12) | OP_DST) - { - scm_t_uint16 dst, src; - SCM box; - UNPACK_12_12 (op, dst, src); - box = SP_REF (src); - VM_VALIDATE_ATOMIC_BOX (box, "atomic-box-ref"); - SP_SET (dst, scm_atomic_ref_scm (scm_atomic_box_loc (box))); - NEXT (1); - } + VM_DEFINE_OP (136, u32_ref, "u32-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (uint32_t, U64); - /* atomic-box-set! dst:12 src:12 + /* u64-ref dst:8 ptr:8 idx:8 * - * Set the contents of the atomic box at DST to SRC. + * Load the u64 at byte offset IDX from pointer PTR, and store it to + * u64 DST. */ - VM_DEFINE_OP (180, atomic_box_set, "atomic-box-set!", OP1 (X8_S12_S12)) - { - scm_t_uint16 dst, src; - SCM box; - UNPACK_12_12 (op, dst, src); - box = SP_REF (dst); - VM_VALIDATE_ATOMIC_BOX (box, "atomic-box-set!"); - scm_atomic_set_scm (scm_atomic_box_loc (box), SP_REF (src)); - NEXT (1); - } + VM_DEFINE_OP (137, u64_ref, "u64-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (uint64_t, U64); - /* atomic-box-swap! dst:12 box:12 _:8 val:24 + /* u8-set! ptr:8 idx:8 val:8 * - * Replace the contents of the atomic box at BOX to VAL and store the - * previous value at DST. + * Store the u64 value VAL into the u8 at byte offset IDX from pointer + * PTR. */ - VM_DEFINE_OP (181, atomic_box_swap, "atomic-box-swap!", OP2 (X8_S12_S12, X8_S24) | OP_DST) - { - scm_t_uint16 dst, box; - scm_t_uint32 val; - SCM scm_box; - UNPACK_12_12 (op, dst, box); - UNPACK_24 (ip[1], val); - scm_box = SP_REF (box); - VM_VALIDATE_ATOMIC_BOX (scm_box, "atomic-box-swap!"); - SP_SET (dst, - scm_atomic_swap_scm (scm_atomic_box_loc (scm_box), SP_REF (val))); - NEXT (2); - } + VM_DEFINE_OP (138, u8_set, "u8-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (uint8_t, U64); - /* atomic-box-compare-and-swap! dst:12 box:12 _:8 expected:24 _:8 desired:24 + /* u16-set! ptr:8 idx:8 val:8 * - * Set the contents of the atomic box at DST to SET. + * Store the u64 value VAL into the u16 at byte offset IDX from + * pointer PTR. */ - VM_DEFINE_OP (182, atomic_box_compare_and_swap, "atomic-box-compare-and-swap!", OP3 (X8_S12_S12, X8_S24, X8_S24) | OP_DST) - { - scm_t_uint16 dst, box; - scm_t_uint32 expected, desired; - SCM scm_box, scm_expected, scm_result; - UNPACK_12_12 (op, dst, box); - UNPACK_24 (ip[1], expected); - UNPACK_24 (ip[2], desired); - scm_box = SP_REF (box); - VM_VALIDATE_ATOMIC_BOX (scm_box, "atomic-box-compare-and-swap!"); - scm_result = scm_expected = SP_REF (expected); - while (!scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (scm_box), - &scm_result, SP_REF (desired)) - && scm_is_eq (scm_result, scm_expected)) - { - /* 'scm_atomic_compare_and_swap_scm' has spuriously failed, - i.e. it has returned 0 to indicate failure, although the - observed value is 'eq?' to EXPECTED. In this case, we *must* - try again, because the API of 'atomic-box-compare-and-swap!' - provides no way to indicate to the caller that the exchange - failed when the observed value is 'eq?' to EXPECTED. */ - } - SP_SET (dst, scm_result); - NEXT (3); - } + VM_DEFINE_OP (139, u16_set, "u16-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (uint16_t, U64); - /* handle-interrupts _:24 + /* u32-set! ptr:8 idx:8 val:8 * - * Handle pending interrupts. + * Store the u64 value VAL into the u32 at byte offset IDX from + * pointer PTR. */ - VM_DEFINE_OP (183, handle_interrupts, "handle-interrupts", OP1 (X32)) - { - if (SCM_LIKELY (scm_is_null - (scm_atomic_ref_scm (&thread->pending_asyncs)))) - NEXT (1); - - if (thread->block_asyncs > 0) - NEXT (1); - - { - union scm_vm_stack_element *old_fp, *new_fp; - size_t old_frame_size = FRAME_LOCALS_COUNT (); - SCM proc = scm_i_async_pop (thread); + VM_DEFINE_OP (140, u32_set, "u32-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (uint32_t, U64); - /* No PUSH_CONTINUATION_HOOK, as we can't usefully - POP_CONTINUATION_HOOK because there are no return values. */ - - /* Three slots: two for RA and dynamic link, one for proc. */ - ALLOC_FRAME (old_frame_size + 3); - - /* Set up a frame that will return right back to this - handle-interrupts opcode to handle any additional - interrupts. */ - old_fp = vp->fp; - new_fp = SCM_FRAME_SLOT (old_fp, old_frame_size + 1); - SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp); - SCM_FRAME_SET_RETURN_ADDRESS (new_fp, ip); - vp->fp = new_fp; - - SP_SET (0, proc); - - ip = (scm_t_uint32 *) vm_handle_interrupt_code; - - APPLY_HOOK (); + /* u64-set! ptr:8 idx:8 val:8 + * + * Store the u64 value VAL into the u64 at byte offset IDX from + * pointer PTR. + */ + VM_DEFINE_OP (141, u64_set, "u64-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (uint64_t, U64); - NEXT (0); - } - } + /* s8-ref dst:8 ptr:8 idx:8 + * + * Load the s8 at byte offset IDX from pointer PTR, and store it to + * s64 DST. + */ + VM_DEFINE_OP (142, s8_ref, "s8-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (int8_t, S64); - /* return-from-interrupt _:24 + /* s16-ref dst:8 ptr:8 idx:8 * - * Return from handling an interrupt, discarding any return values and - * stripping away the interrupt frame. + * Load the s16 at byte offset IDX from pointer PTR, and store it to + * s64 DST. */ - VM_DEFINE_OP (184, return_from_interrupt, "return-from-interrupt", OP1 (X32)) - { - vp->sp = sp = SCM_FRAME_PREVIOUS_SP (vp->fp); - ip = SCM_FRAME_RETURN_ADDRESS (vp->fp); - vp->fp = SCM_FRAME_DYNAMIC_LINK (vp->fp); + VM_DEFINE_OP (143, s16_ref, "s16-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (int16_t, S64); - NEXT (0); - } + /* s32-ref dst:8 ptr:8 idx:8 + * + * Load the s32 at byte offset IDX from pointer PTR, and store it to + * s64 DST. + */ + VM_DEFINE_OP (144, s32_ref, "s32-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (int32_t, S64); - /* push-dynamic-state state:24 + /* s64-ref dst:8 ptr:8 idx:8 * - * Save the current fluid bindings on the dynamic stack, and use STATE - * instead. + * Load the s64 at byte offset IDX from pointer PTR, and store it to + * s64 DST. */ - VM_DEFINE_OP (185, push_dynamic_state, "push-dynamic-state", OP1 (X8_S24)) - { - scm_t_uint32 state; + VM_DEFINE_OP (145, s64_ref, "s64-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (int64_t, S64); - UNPACK_24 (op, state); + /* s8-set! ptr:8 idx:8 val:8 + * + * Store the s64 value VAL into the s8 at byte offset IDX from pointer + * PTR. + */ + VM_DEFINE_OP (146, s8_set, "s8-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (int8_t, S64); - SYNC_IP (); - scm_dynstack_push_dynamic_state (&thread->dynstack, SP_REF (state), - thread->dynamic_state); - NEXT (1); - } + /* s16-set! ptr:8 idx:8 val:8 + * + * Store the s64 value VAL into the s16 at byte offset IDX from + * pointer PTR. + */ + VM_DEFINE_OP (147, s16_set, "s16-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (int16_t, S64); - /* pop-dynamic-state _:24 + /* s32-set! ptr:8 idx:8 val:8 * - * Restore the saved fluid bindings from the dynamic stack. + * Store the s64 value VAL into the s32 at byte offset IDX from + * pointer PTR. */ - VM_DEFINE_OP (186, pop_dynamic_state, "pop-dynamic-state", OP1 (X32)) - { - SYNC_IP (); - scm_dynstack_unwind_dynamic_state (&thread->dynstack, - thread->dynamic_state); - NEXT (1); - } + VM_DEFINE_OP (148, s32_set, "s32-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (int32_t, S64); - /* br-if-f64-= a:12 b:12 invert:1 _:7 offset:24 + /* s64-set! ptr:8 idx:8 val:8 * - * If the F64 value in A is = to the F64 value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Store the s64 value VAL into the s64 at byte offset IDX from + * pointer PTR. */ - VM_DEFINE_OP (187, br_if_f64_ee, "br-if-f64-=", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_F64_ARITHMETIC (==); - } + VM_DEFINE_OP (149, s64_set, "s64-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (int64_t, S64); - /* br-if-f64-< a:12 b:12 invert:1 _:7 offset:24 + /* f32-ref dst:8 ptr:8 idx:8 * - * If the F64 value in A is < to the F64 value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Load the f32 at byte offset IDX from pointer PTR, and store it to + * f64 DST. */ - VM_DEFINE_OP (188, br_if_f64_lt, "br-if-f64-<", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_F64_ARITHMETIC (<); - } + VM_DEFINE_OP (150, f32_ref, "f32-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (float, F64); - /* br-if-f64-<= a:24 _:8 b:24 invert:1 _:7 offset:24 + /* f64-ref dst:8 ptr:8 idx:8 * - * If the F64 value in A is <= than the F64 value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Load the f64 at byte offset IDX from pointer PTR, and store it to + * f64 DST. */ - VM_DEFINE_OP (189, br_if_f64_le, "br-if-f64-<=", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_F64_ARITHMETIC (<=); - } + VM_DEFINE_OP (151, f64_ref, "f64-ref", DOP1 (X8_S8_S8_S8)) + PTR_REF (double, F64); - /* br-if-f64-> a:24 _:8 b:24 invert:1 _:7 offset:24 + /* f32-set! ptr:8 idx:8 val:8 * - * If the F64 value in A is > than the F64 value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Store the f64 value VAL into the f32 at byte offset IDX from + * pointer PTR. */ - VM_DEFINE_OP (190, br_if_f64_gt, "br-if-f64->", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_F64_ARITHMETIC (>); - } + VM_DEFINE_OP (152, f32_set, "f32-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (float, F64); - /* br-if-uf4->= a:24 _:8 b:24 invert:1 _:7 offset:24 + /* s64-set! ptr:8 idx:8 val:8 * - * If the F64 value in A is >= than the F64 value in B, add OFFSET, a - * signed 24-bit number, to the current instruction pointer. + * Store the f64 value VAL into the f8 at byte offset IDX from pointer + * PTR. */ - VM_DEFINE_OP (191, br_if_f64_ge, "br-if-f64->=", OP3 (X8_S24, X8_S24, B1_X7_L24)) - { - BR_F64_ARITHMETIC (>=); - } + VM_DEFINE_OP (153, f64_set, "f64-set!", OP1 (X8_S8_S8_S8)) + PTR_SET (double, F64); - /* string-set! dst:8 idx:8 src:8 + /* bind-optionals nargs:24 * - * Store the character SRC into the string DST at index IDX. + * Expand the current frame to have NARGS locals, filling in any fresh + * values with SCM_UNDEFINED. */ - VM_DEFINE_OP (192, string_set, "string-set!", OP1 (X8_S8_S8_S8)) + VM_DEFINE_OP (154, bind_optionals, "bind-optionals", DOP1 (X8_F24)) { - scm_t_uint8 dst, idx, src; - SCM str, chr; - scm_t_uint64 c_idx; - - UNPACK_8_8_8 (op, dst, idx, src); - str = SP_REF (dst); - c_idx = SP_REF_U64 (idx); - chr = SP_REF (src); + uint32_t nlocals, nargs; - VM_VALIDATE_STRING (str, "string-ref"); - VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref"); + UNPACK_24 (op, nlocals); + nargs = FRAME_LOCALS_COUNT (); - /* If needed we can speed this up and only SYNC_IP + - scm_i_string_writing if the string isn't already a non-shared - stringbuf. */ - SYNC_IP (); - scm_i_string_start_writing (str); - scm_i_string_set_x (str, c_idx, SCM_CHAR (chr)); - scm_i_string_stop_writing (); + if (nargs < nlocals) + { + ALLOC_FRAME (nlocals); + while (nargs < nlocals) + FP_SET (nargs++, SCM_UNDEFINED); + } NEXT (1); } + VM_DEFINE_OP (155, unused_155, NULL, NOP) + VM_DEFINE_OP (156, unused_156, NULL, NOP) + VM_DEFINE_OP (157, unused_157, NULL, NOP) + VM_DEFINE_OP (158, unused_158, NULL, NOP) + VM_DEFINE_OP (159, unused_159, NULL, NOP) + VM_DEFINE_OP (160, unused_160, NULL, NOP) + VM_DEFINE_OP (161, unused_161, NULL, NOP) + VM_DEFINE_OP (162, unused_162, NULL, NOP) + VM_DEFINE_OP (163, unused_163, NULL, NOP) + VM_DEFINE_OP (164, unused_164, NULL, NOP) + VM_DEFINE_OP (165, unused_165, NULL, NOP) + VM_DEFINE_OP (166, unused_166, NULL, NOP) + VM_DEFINE_OP (167, unused_167, NULL, NOP) + VM_DEFINE_OP (168, unused_168, NULL, NOP) + VM_DEFINE_OP (169, unused_169, NULL, NOP) + VM_DEFINE_OP (170, unused_170, NULL, NOP) + VM_DEFINE_OP (171, unused_171, NULL, NOP) + VM_DEFINE_OP (172, unused_172, NULL, NOP) + VM_DEFINE_OP (173, unused_173, NULL, NOP) + VM_DEFINE_OP (174, unused_174, NULL, NOP) + VM_DEFINE_OP (175, unused_175, NULL, NOP) + VM_DEFINE_OP (176, unused_176, NULL, NOP) + VM_DEFINE_OP (177, unused_177, NULL, NOP) + VM_DEFINE_OP (178, unused_178, NULL, NOP) + VM_DEFINE_OP (179, unused_179, NULL, NOP) + VM_DEFINE_OP (180, unused_180, NULL, NOP) + VM_DEFINE_OP (181, unused_181, NULL, NOP) + VM_DEFINE_OP (182, unused_182, NULL, NOP) + VM_DEFINE_OP (183, unused_183, NULL, NOP) + VM_DEFINE_OP (184, unused_184, NULL, NOP) + VM_DEFINE_OP (185, unused_185, NULL, NOP) + VM_DEFINE_OP (186, unused_186, NULL, NOP) + VM_DEFINE_OP (187, unused_187, NULL, NOP) + VM_DEFINE_OP (188, unused_188, NULL, NOP) + VM_DEFINE_OP (189, unused_189, NULL, NOP) + VM_DEFINE_OP (190, unused_190, NULL, NOP) + VM_DEFINE_OP (191, unused_191, NULL, NOP) + VM_DEFINE_OP (192, unused_192, NULL, NOP) VM_DEFINE_OP (193, unused_193, NULL, NOP) VM_DEFINE_OP (194, unused_194, NULL, NOP) VM_DEFINE_OP (195, unused_195, NULL, NOP) @@ -4119,6 +3344,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, VM_DEFINE_OP (254, unused_254, NULL, NOP) VM_DEFINE_OP (255, unused_255, NULL, NOP) { + vm_error_bad_instruction (op); abort (); /* never reached */ } @@ -4127,29 +3353,12 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, } -#undef ABORT_CONTINUATION_HOOK +#undef ABORT_HOOK #undef ALIGNED_P #undef APPLY_HOOK -#undef ARGS1 -#undef ARGS2 #undef BEGIN_DISPATCH_SWITCH -#undef BINARY_INTEGER_OP -#undef BR_ARITHMETIC -#undef BR_BINARY -#undef BR_NARGS -#undef BR_UNARY -#undef BV_FIXABLE_INT_REF -#undef BV_FIXABLE_INT_SET -#undef BV_FLOAT_REF -#undef BV_FLOAT_SET -#undef BV_INT_REF -#undef BV_INT_SET #undef CACHE_REGISTER #undef END_DISPATCH_SWITCH -#undef FREE_VARIABLE_REF -#undef INIT -#undef INUM_MAX -#undef INUM_MIN #undef FP_REF #undef FP_SET #undef FP_SLOT @@ -4157,32 +3366,17 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, #undef SP_SET #undef NEXT #undef NEXT_HOOK -#undef NEXT_JUMP -#undef POP_CONTINUATION_HOOK -#undef PUSH_CONTINUATION_HOOK -#undef RETURN +#undef RETURN_HOOK #undef RUN_HOOK -#undef RUN_HOOK0 -#undef RUN_HOOK1 #undef SYNC_IP #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 -#undef VM_CHECK_FREE_VARIABLE -#undef VM_CHECK_OBJECT -#undef VM_CHECK_UNDERFLOW #undef VM_DEFINE_OP #undef VM_INSTRUCTION_TO_LABEL #undef VM_USE_HOOKS -#undef VM_VALIDATE_ATOMIC_BOX -#undef VM_VALIDATE_BYTEVECTOR -#undef VM_VALIDATE_PAIR -#undef VM_VALIDATE_STRUCT +#undef VP /* (defun renumber-ops () @@ -4196,8 +3390,3 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, t t nil 1))))) (renumber-ops) */ -/* - Local Variables: - c-file-style: "gnu" - End: -*/ |