diff options
| author | Andy Wingo <wingo@pobox.com> | 2015-10-20 20:06:40 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2015-10-21 11:49:20 +0200 |
| commit | 0da0308b8479aab335230675c94e0773985f06d6 (patch) | |
| tree | 6f593368f7db3462b933554a17e6d926d8e6b2cd | |
| parent | 72353de77d0a06f158d8af66a2540015658e2574 (diff) | |
Prepare for SP-addressed locals
* libguile/vm-engine.c: Renumber opcodes, and take the opportunity to
fold recent additions into more logical places. Be more precise when
describing the encoding of operands, to shuffle local references only
and not constants, immediates, or other such values.
(SP_REF, SP_SET): New helpers.
(BR_BINARY, BR_ARITHMETIC): Take full 24-bit operands. Our shuffle
strategy is to emit push when needed to bring far locals near, then
pop afterwards, shuffling away far destination values as needed; but
that doesn't work for conditionals, unless we introduce a trampoline.
Let's just do the simple thing for now. Native compilation will use
condition codes.
(push, pop, drop): Back from the dead! We'll only use these for
temporary shuffling though, when an opcode can't address the full
24-bit range.
(long-fmov): New instruction, like long-mov but relative to the frame
pointer.
(load-typed-array, make-array): Don't use a compressed encoding so
that we can avoid the shuffling case. It would be a pain, given that
they have so many operands already.
* module/language/bytecode.scm (compute-instruction-arity): Update for
new instrution word encodings.
* module/system/vm/assembler.scm: Update to expose some opcodes
directly, without the need for shuffling wrappers. Adapt to
instruction word encodings change.
* module/system/vm/disassembler.scm (disassembler): Adapt to instruction
coding change.
| -rw-r--r-- | libguile/instructions.c | 52 | ||||
| -rw-r--r-- | libguile/vm-engine.c | 581 | ||||
| -rw-r--r-- | module/language/bytecode.scm | 42 | ||||
| -rw-r--r-- | module/system/vm/assembler.scm | 135 | ||||
| -rw-r--r-- | module/system/vm/disassembler.scm | 68 |
5 files changed, 493 insertions, 385 deletions
diff --git a/libguile/instructions.c b/libguile/instructions.c index e474cf5d5..003fd5425 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -31,30 +31,34 @@ SCM_SYMBOL (sym_left_arrow, "<-"); SCM_SYMBOL (sym_bang, "!"); -#define OP_HAS_ARITY (1U << 0) - #define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \ M(X32) \ - M(U8_X24) \ - M(U8_U24) \ - M(U8_L24) \ - M(U8_U8_I16) \ - M(U8_U8_U8_U8) \ - M(U8_U12_U12) \ - M(U32) /* Unsigned. */ \ + M(X8_S24) \ + M(X8_F24) \ + M(X8_L24) \ + M(X8_C24) \ + M(X8_S8_I16) \ + M(X8_S12_S12) \ + M(X8_S12_C12) \ + M(X8_C12_C12) \ + M(X8_F12_F12) \ + M(X8_S8_S8_S8) \ + M(X8_S8_C8_S8) \ + M(X8_S8_S8_C8) \ + M(C8_C24) \ + M(C32) /* Unsigned. */ \ M(I32) /* Immediate. */ \ M(A32) /* Immediate, high bits. */ \ M(B32) /* Immediate, low bits. */ \ M(N32) /* Non-immediate. */ \ - M(S32) /* Scheme value (indirected). */ \ + M(R32) /* Scheme value (indirected). */ \ M(L32) /* Label. */ \ M(LO32) /* Label with offset. */ \ - M(X8_U24) \ - M(X8_U12_U12) \ - M(X8_L24) \ + M(B1_C7_L24) \ M(B1_X7_L24) \ - M(B1_U7_L24) \ - M(B1_X7_U24) \ + M(B1_X7_C24) \ + M(B1_X7_S24) \ + M(B1_X7_F24) \ M(B1_X31) #define TYPE_WIDTH 5 @@ -73,7 +77,7 @@ static SCM word_type_symbols[] = #undef FALSE }; -#define OP(n,type) ((type) << (n*TYPE_WIDTH)) +#define OP(n,type) (((type) + 1) << (n*TYPE_WIDTH)) /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of arguments each instruction takes. This piece of code is the only @@ -99,8 +103,12 @@ static SCM word_type_symbols[] = #define OP_DST (1 << (TYPE_WIDTH * 5)) -#define WORD_TYPE(n, word) \ +#define WORD_TYPE_AND_FLAG(n, word) \ (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1)) +#define WORD_TYPE(n, word) \ + (WORD_TYPE_AND_FLAG (n, word) - 1) +#define HAS_WORD(n, word) \ + (WORD_TYPE_AND_FLAG (n, word) != 0) /* Scheme interface */ @@ -112,15 +120,15 @@ parse_instruction (scm_t_uint8 opcode, const char *name, scm_t_uint32 meta) /* Format: (name opcode word0 word1 ...) */ - if (WORD_TYPE (4, meta)) + if (HAS_WORD (4, meta)) len = 5; - else if (WORD_TYPE (3, meta)) + else if (HAS_WORD (3, meta)) len = 4; - else if (WORD_TYPE (2, meta)) + else if (HAS_WORD (2, meta)) len = 3; - else if (WORD_TYPE (1, meta)) + else if (HAS_WORD (1, meta)) len = 2; - else if (WORD_TYPE (0, meta)) + else if (HAS_WORD (0, meta)) len = 1; else abort (); diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index daea0bfe2..df7a528eb 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -258,6 +258,9 @@ #define LOCAL_REF(i) SCM_FRAME_LOCAL (locals + 1, i) #define LOCAL_SET(i,o) SCM_FRAME_LOCAL (locals + 1, i) = o +#define SP_REF(i) (vp->sp[i].as_scm) +#define SP_SET(i,o) (vp->sp[i].as_scm = 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)) @@ -323,57 +326,59 @@ NEXT (2) #define BR_BINARY(x, y, exp) \ - scm_t_uint16 a, b; \ + scm_t_uint32 a, b; \ SCM x, y; \ - UNPACK_12_12 (op, a, b); \ + UNPACK_24 (op, a); \ + UNPACK_24 (ip[1], b); \ x = LOCAL_REF (a); \ y = LOCAL_REF (b); \ - if ((ip[1] & 0x1) ? !(exp) : (exp)) \ + if ((ip[2] & 0x1) ? !(exp) : (exp)) \ { \ - scm_t_int32 offset = ip[1]; \ + scm_t_int32 offset = ip[2]; \ offset >>= 8; /* Sign-extending shift. */ \ if (offset <= 0) \ VM_HANDLE_INTERRUPTS; \ NEXT (offset); \ } \ - NEXT (2) + NEXT (3) #define BR_ARITHMETIC(crel,srel) \ { \ - scm_t_uint16 a, b; \ + scm_t_uint32 a, b; \ SCM x, y; \ - UNPACK_12_12 (op, a, b); \ + UNPACK_24 (op, a); \ + UNPACK_24 (ip[1], b); \ x = LOCAL_REF (a); \ y = LOCAL_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[1] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \ + if ((ip[2] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \ { \ - scm_t_int32 offset = ip[1]; \ + scm_t_int32 offset = ip[2]; \ offset >>= 8; /* Sign-extending shift. */ \ if (offset <= 0) \ VM_HANDLE_INTERRUPTS; \ NEXT (offset); \ } \ - NEXT (2); \ + NEXT (3); \ } \ else \ { \ SCM res; \ SYNC_IP (); \ res = srel (x, y); \ - CACHE_LOCALS (); \ - if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \ + CACHE_LOCALS (); \ + if ((ip[2] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \ { \ - scm_t_int32 offset = ip[1]; \ + scm_t_int32 offset = ip[2]; \ offset >>= 8; /* Sign-extending shift. */ \ if (offset <= 0) \ VM_HANDLE_INTERRUPTS; \ NEXT (offset); \ } \ - NEXT (2); \ + NEXT (3); \ } \ } @@ -515,7 +520,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Bring the VM to a halt, returning all the values from the stack. */ - VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24)) + VM_DEFINE_OP (0, halt, "halt", OP1 (X32)) { /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */ @@ -553,7 +558,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * stack; the precise number can be had by subtracting the address of * PROC from the post-call SP. */ - VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24)) + VM_DEFINE_OP (1, call, "call", OP2 (X8_F24, X8_C24)) { scm_t_uint32 proc, nlocals; union scm_vm_stack_element *old_fp; @@ -593,7 +598,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * the current IP. Since PROC is not dereferenced, it may be some * other representation of the closure. */ - VM_DEFINE_OP (2, call_label, "call-label", OP3 (U8_U24, X8_U24, L32)) + VM_DEFINE_OP (2, call_label, "call-label", OP3 (X8_F24, X8_C24, L32)) { scm_t_uint32 proc, nlocals; scm_t_int32 label; @@ -628,7 +633,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * arguments have already been shuffled into position. Will reset the * frame to NLOCALS. */ - VM_DEFINE_OP (3, tail_call, "tail-call", OP1 (U8_U24)) + VM_DEFINE_OP (3, tail_call, "tail-call", OP1 (X8_C24)) { scm_t_uint32 nlocals; @@ -653,7 +658,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (U8_U24, L32)) + VM_DEFINE_OP (4, tail_call_label, "tail-call-label", OP2 (X8_C24, L32)) { scm_t_uint32 nlocals; scm_t_int32 label; @@ -679,7 +684,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * FROM, shuffled down to start at slot 0. This is part of the * implementation of the call-with-values builtin. */ - VM_DEFINE_OP (5, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24)) + VM_DEFINE_OP (5, tail_call_shuffle, "tail-call/shuffle", OP1 (X8_F24)) { scm_t_uint32 n, from, nlocals; @@ -711,7 +716,7 @@ 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 (U8_U12_U12, X8_U24) | OP_DST) + VM_DEFINE_OP (6, receive, "receive", OP2 (X8_F12_F12, X8_C24) | OP_DST) { scm_t_uint16 dst, proc; scm_t_uint32 nlocals; @@ -731,7 +736,7 @@ 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 (U8_U24, B1_X7_U24)) + VM_DEFINE_OP (7, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24)) { scm_t_uint32 proc, nvalues; UNPACK_24 (op, proc); @@ -749,7 +754,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Return a value. */ - VM_DEFINE_OP (8, return, "return", OP1 (U8_U24)) + VM_DEFINE_OP (8, return, "return", OP1 (X8_S24)) { scm_t_uint32 src; UNPACK_24 (op, src); @@ -764,7 +769,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * shuffled down to a contiguous array starting at slot 1. * We also expect the frame has already been reset. */ - VM_DEFINE_OP (9, return_values, "return-values", OP1 (U8_X24)) + VM_DEFINE_OP (9, return_values, "return-values", OP1 (X32)) { union scm_vm_stack_element *old_fp; @@ -798,7 +803,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * calling frame. This instruction is part of the trampolines * created in gsubr.c, and is not generated by the compiler. */ - VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (U8_U24)) + VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X8_C24)) { scm_t_uint32 ptr_idx; SCM pointer, ret; @@ -879,7 +884,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * part of the trampolines created by the FFI, and is not generated by * the compiler. */ - VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (U8_U12_U12)) + VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (X8_C12_C12)) { scm_t_uint16 cif_idx, ptr_idx; SCM closure, cif, pointer, ret; @@ -913,7 +918,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * the implementation of undelimited continuations, and is not * generated by the compiler. */ - VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (U8_U24)) + VM_DEFINE_OP (12, continuation_call, "continuation-call", OP1 (X8_C24)) { SCM contregs; scm_t_uint32 contregs_idx; @@ -943,7 +948,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (U8_U24)) + VM_DEFINE_OP (13, compose_continuation, "compose-continuation", OP1 (X8_C24)) { SCM vmcont; scm_t_uint32 cont_idx; @@ -966,7 +971,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * arguments. This instruction is part of the implementation of * `apply', and is not generated by the compiler. */ - VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (U8_X24)) + VM_DEFINE_OP (14, tail_apply, "tail-apply", OP1 (X32)) { int i, list_idx, list_len, nlocals; SCM list; @@ -1012,7 +1017,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * local slot 1 to it. This instruction is part of the implementation * of `call/cc', and is not generated by the compiler. */ - VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (U8_X24)) + VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (X32)) { SCM vm_cont, cont; scm_t_dynstack *dynstack; @@ -1064,7 +1069,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (U8_X24)) + VM_DEFINE_OP (16, abort, "abort", OP1 (X32)) { scm_t_uint32 nlocals = FRAME_LOCALS_COUNT (); @@ -1084,7 +1089,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Load a builtin stub by index into DST. */ - VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (17, builtin_ref, "builtin-ref", OP1 (X8_S12_C12) | OP_DST) { scm_t_uint16 dst, idx; @@ -1109,15 +1114,15 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to * the current instruction pointer. */ - VM_DEFINE_OP (18, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24)) + 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 (U8_U24, X8_L24)) + 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 (U8_U24, X8_L24)) + VM_DEFINE_OP (20, br_if_nargs_gt, "br-if-nargs-gt", OP2 (X8_C24, X8_L24)) { BR_NARGS (>); } @@ -1129,7 +1134,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the number of actual arguments is not ==, >=, or <= EXPECTED, * respectively, signal an error. */ - VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24)) + VM_DEFINE_OP (21, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24)) { scm_t_uint32 expected; UNPACK_24 (op, expected); @@ -1137,7 +1142,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, vm_error_wrong_num_args (LOCAL_REF (0))); NEXT (1); } - VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24)) + VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24)) { scm_t_uint32 expected; UNPACK_24 (op, expected); @@ -1145,7 +1150,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, vm_error_wrong_num_args (LOCAL_REF (0))); NEXT (1); } - VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24)) + VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24)) { scm_t_uint32 expected; UNPACK_24 (op, expected); @@ -1160,7 +1165,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * setting them all to SCM_UNDEFINED, except those nargs values that * were passed as arguments and procedure. */ - VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (U8_U24)) + VM_DEFINE_OP (24, alloc_frame, "alloc-frame", OP1 (X8_C24)) { scm_t_uint32 nlocals, nargs; UNPACK_24 (op, nlocals); @@ -1179,7 +1184,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Used to reset the frame size to something less than the size that * was previously set via alloc-frame. */ - VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (U8_U24)) + VM_DEFINE_OP (25, reset_frame, "reset-frame", OP1 (X8_C24)) { scm_t_uint32 nlocals; UNPACK_24 (op, nlocals); @@ -1187,12 +1192,57 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (1); } + /* push src:24 + * + * Push SRC onto the stack. + */ + VM_DEFINE_OP (26, push, "push", OP1 (X8_S24)) + { + scm_t_uint32 src; + SCM val; + + UNPACK_24 (op, src); + val = SP_REF (src); + ALLOC_FRAME (FRAME_LOCALS_COUNT () + 1); + SP_SET (0, val); + NEXT (1); + } + + /* pop dst:24 + * + * Pop the stack, storing to DST. + */ + VM_DEFINE_OP (27, pop, "pop", OP1 (X8_S24) | OP_DST) + { + scm_t_uint32 dst; + SCM val; + + UNPACK_24 (op, dst); + val = SP_REF (0); + vp->sp++; + SP_SET (dst, val); + NEXT (1); + } + + /* drop count:24 + * + * Drop some number of values from the stack. + */ + VM_DEFINE_OP (28, drop, "drop", OP1 (X8_C24)) + { + scm_t_uint32 count; + + UNPACK_24 (op, count); + vp->sp += count; + NEXT (1); + } + /* assert-nargs-ee/locals expected:12 nlocals:12 * * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The * number of locals reserved is EXPECTED + NLOCALS. */ - VM_DEFINE_OP (26, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12)) + VM_DEFINE_OP (29, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12)) { scm_t_uint16 expected, nlocals; UNPACK_12_12 (op, expected, nlocals); @@ -1215,7 +1265,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * See "Case-lambda" in the manual, for more on how case-lambda * chooses the clause to apply. */ - VM_DEFINE_OP (27, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24)) + VM_DEFINE_OP (30, br_if_npos_gt, "br-if-npos-gt", OP3 (X8_C24, X8_C24, X8_L24)) { scm_t_uint32 nreq, npos; @@ -1253,7 +1303,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * A macro-mega-instruction. */ - VM_DEFINE_OP (28, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32)) + VM_DEFINE_OP (31, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32)) { scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs; scm_t_int32 kw_offset; @@ -1339,7 +1389,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Collect any arguments at or above DST into a list, and store that * list at DST. */ - VM_DEFINE_OP (29, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST) + VM_DEFINE_OP (32, bind_rest, "bind-rest", OP1 (X8_F24) | OP_DST) { scm_t_uint32 dst, nargs; SCM rest = SCM_EOL; @@ -1381,7 +1431,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Add OFFSET, a signed 24-bit number, to the current instruction * pointer. */ - VM_DEFINE_OP (30, br, "br", OP1 (U8_L24)) + VM_DEFINE_OP (33, br, "br", OP1 (X8_L24)) { scm_t_int32 offset = op; offset >>= 8; /* Sign-extending shift. */ @@ -1395,7 +1445,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is true for the purposes of Scheme, add * OFFSET, a signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (31, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (34, br_if_true, "br-if-true", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, scm_is_true (x)); } @@ -1405,7 +1455,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a * signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (32, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (35, br_if_null, "br-if-null", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, scm_is_null (x)); } @@ -1415,7 +1465,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit * number, to the current instruction pointer. */ - VM_DEFINE_OP (33, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (36, br_if_nil, "br-if-nil", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, scm_is_lisp_false (x)); } @@ -1425,7 +1475,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is a pair, add OFFSET, a signed 24-bit number, * to the current instruction pointer. */ - VM_DEFINE_OP (34, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (37, br_if_pair, "br-if-pair", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, scm_is_pair (x)); } @@ -1435,7 +1485,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is a struct, add OFFSET, a signed 24-bit * number, to the current instruction pointer. */ - VM_DEFINE_OP (35, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (38, br_if_struct, "br-if-struct", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, SCM_STRUCTP (x)); } @@ -1445,7 +1495,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST is a char, add OFFSET, a signed 24-bit number, * to the current instruction pointer. */ - VM_DEFINE_OP (36, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (39, br_if_char, "br-if-char", OP2 (X8_S24, B1_X7_L24)) { BR_UNARY (x, SCM_CHARP (x)); } @@ -1455,7 +1505,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in TEST has the TC7 given in the second word, add * OFFSET, a signed 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (37, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24)) + VM_DEFINE_OP (40, br_if_tc7, "br-if-tc7", OP2 (X8_S24, B1_C7_L24)) { BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f)); } @@ -1465,7 +1515,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in A is eq? to the value in B, add OFFSET, a signed * 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (38, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (41, br_if_eq, "br-if-eq", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y)); } @@ -1475,7 +1525,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * If the value in A is eqv? to the value in B, add OFFSET, a signed * 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (39, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (42, br_if_eqv, "br-if-eqv", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y) @@ -1491,7 +1541,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, */ // FIXME: Should sync_ip before calling out and cache_locals before coming // back! Another reason to remove this opcode! - VM_DEFINE_OP (40, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (43, br_if_equal, "br-if-equal", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y) @@ -1499,12 +1549,26 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, && scm_is_true (scm_equal_p (x, y)))); } + /* br-if-logtest a:24 _:8 b:24 invert:1 _:7 offset:24 + * + * 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. + */ + VM_DEFINE_OP (44, br_if_logtest, "br-if-logtest", OP3 (X8_S24, X8_S24, B1_X7_L24)) + { + 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)))); + } + /* 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 (41, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (45, br_if_ee, "br-if-=", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_ARITHMETIC (==, scm_num_eq_p); } @@ -1514,7 +1578,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (42, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (46, br_if_lt, "br-if-<", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_ARITHMETIC (<, scm_less_p); } @@ -1524,7 +1588,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (43, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (47, br_if_le, "br-if-<=", OP3 (X8_S24, X8_S24, B1_X7_L24)) { BR_ARITHMETIC (<=, scm_leq_p); } @@ -1540,7 +1604,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Copy a value from one local slot to another. */ - VM_DEFINE_OP (44, mov, "mov", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (48, mov, "mov", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst; scm_t_uint16 src; @@ -1555,7 +1619,24 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Copy a value from one local slot to another. */ - VM_DEFINE_OP (45, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST) + VM_DEFINE_OP (49, long_mov, "long-mov", OP2 (X8_S24, X8_S24) | OP_DST) + { + scm_t_uint32 dst; + scm_t_uint32 src; + + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], src); + LOCAL_SET (dst, LOCAL_REF (src)); + + NEXT (2); + } + + /* long-fmov dst:24 _:8 src:24 + * + * Copy a value from one local slot to another. Slot indexes are + * relative to the FP. + */ + VM_DEFINE_OP (50, long_fmov, "long-fmov", OP2 (X8_F24, X8_F24) | OP_DST) { scm_t_uint32 dst; scm_t_uint32 src; @@ -1571,7 +1652,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Create a new variable holding SRC, and place it in DST. */ - VM_DEFINE_OP (46, box, "box", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (51, box, "box", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; UNPACK_12_12 (op, dst, src); @@ -1585,7 +1666,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Unpack the variable at SRC into DST, asserting that the variable is * actually bound. */ - VM_DEFINE_OP (47, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (52, box_ref, "box-ref", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; SCM var; @@ -1602,7 +1683,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Set the contents of the variable at DST to SET. */ - VM_DEFINE_OP (48, box_set, "box-set!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (53, box_set, "box-set!", OP1 (X8_S12_S12)) { scm_t_uint16 dst, src; SCM var; @@ -1621,7 +1702,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * signed 32-bit integer. Space for NFREE free variables will be * allocated. */ - VM_DEFINE_OP (49, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST) + VM_DEFINE_OP (54, make_closure, "make-closure", OP3 (X8_S24, L32, X8_C24) | OP_DST) { scm_t_uint32 dst, nfree, n; scm_t_int32 offset; @@ -1646,7 +1727,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Load free variable IDX from the closure SRC into local slot DST. */ - VM_DEFINE_OP (50, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST) + VM_DEFINE_OP (55, free_ref, "free-ref", OP2 (X8_S12_S12, X8_C24) | OP_DST) { scm_t_uint16 dst, src; scm_t_uint32 idx; @@ -1661,7 +1742,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Set free variable IDX from the closure DST to SRC. */ - VM_DEFINE_OP (51, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24)) + VM_DEFINE_OP (56, free_set, "free-set!", OP2 (X8_S12_S12, X8_C24)) { scm_t_uint16 dst, src; scm_t_uint32 idx; @@ -1684,7 +1765,7 @@ 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 (52, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST) + VM_DEFINE_OP (57, make_short_immediate, "make-short-immediate", OP1 (X8_S8_I16) | OP_DST) { scm_t_uint8 dst; scm_t_bits val; @@ -1699,7 +1780,7 @@ 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 (53, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32) | OP_DST) + VM_DEFINE_OP (58, make_long_immediate, "make-long-immediate", OP2 (X8_S24, I32) | OP_DST) { scm_t_uint32 dst; scm_t_bits val; @@ -1714,7 +1795,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Make an immediate with HIGH-BITS and LOW-BITS. */ - VM_DEFINE_OP (54, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST) + VM_DEFINE_OP (59, make_long_long_immediate, "make-long-long-immediate", OP3 (X8_S24, A32, B32) | OP_DST) { scm_t_uint32 dst; scm_t_bits val; @@ -1745,7 +1826,7 @@ 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 (55, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST) + VM_DEFINE_OP (60, make_non_immediate, "make-non-immediate", OP2 (X8_S24, N32) | OP_DST) { scm_t_uint32 dst; scm_t_int32 offset; @@ -1774,7 +1855,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * that the compiler is unable to statically allocate, like symbols. * These values would be initialized when the object file loads. */ - VM_DEFINE_OP (56, static_ref, "static-ref", OP2 (U8_U24, S32) | OP_DST) + VM_DEFINE_OP (61, static_ref, "static-ref", OP2 (X8_S24, R32) | OP_DST) { scm_t_uint32 dst; scm_t_int32 offset; @@ -1797,7 +1878,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Store a SCM value into memory, OFFSET 32-bit words away from the * current instruction pointer. OFFSET is a signed value. */ - VM_DEFINE_OP (57, static_set, "static-set!", OP2 (U8_U24, LO32)) + VM_DEFINE_OP (62, static_set, "static-set!", OP2 (X8_S24, LO32)) { scm_t_uint32 src; scm_t_int32 offset; @@ -1819,7 +1900,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (58, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32)) + VM_DEFINE_OP (63, static_patch, "static-patch!", OP3 (X32, LO32, L32)) { scm_t_int32 dst_offset, src_offset; void *src; @@ -1877,7 +1958,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store the current module in DST. */ - VM_DEFINE_OP (59, current_module, "current-module", OP1 (U8_U24) | OP_DST) + VM_DEFINE_OP (64, current_module, "current-module", OP1 (X8_S24) | OP_DST) { scm_t_uint32 dst; @@ -1894,7 +1975,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Resolve SYM in the current module, and place the resulting variable * in DST. */ - VM_DEFINE_OP (60, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST) + VM_DEFINE_OP (65, resolve, "resolve", OP2 (X8_S24, B1_X7_S24) | OP_DST) { scm_t_uint32 dst; scm_t_uint32 sym; @@ -1918,7 +1999,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Look up a binding for SYM in the current module, creating it if * necessary. Set its value to VAL. */ - VM_DEFINE_OP (61, define, "define!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (66, define, "define!", OP1 (X8_S12_S12)) { scm_t_uint16 sym, val; UNPACK_12_12 (op, sym, val); @@ -1947,7 +2028,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * DST, and caching the resolved variable so that we will hit the cache next * time. */ - VM_DEFINE_OP (62, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST) + VM_DEFINE_OP (67, toplevel_box, "toplevel-box", OP5 (X8_S24, R32, R32, N32, B1_X31) | OP_DST) { scm_t_uint32 dst; scm_t_int32 var_offset; @@ -2000,7 +2081,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Like toplevel-box, except MOD-OFFSET points at the name of a module * instead of the module itself. */ - VM_DEFINE_OP (63, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST) + VM_DEFINE_OP (68, module_box, "module-box", OP5 (X8_S24, R32, N32, N32, B1_X31) | OP_DST) { scm_t_uint32 dst; scm_t_int32 var_offset; @@ -2070,7 +2151,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * will expect a multiple-value return as if from a call with the * procedure at PROC-SLOT. */ - VM_DEFINE_OP (64, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24)) + VM_DEFINE_OP (69, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24)) { scm_t_uint32 tag, proc_slot; scm_t_int32 offset; @@ -2102,7 +2183,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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 (65, wind, "wind", OP1 (U8_U12_U12)) + VM_DEFINE_OP (70, wind, "wind", OP1 (X8_S12_S12)) { scm_t_uint16 winder, unwinder; UNPACK_12_12 (op, winder, unwinder); @@ -2116,7 +2197,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * A normal exit from the dynamic extent of an expression. Pop the top * entry off of the dynamic stack. */ - VM_DEFINE_OP (66, unwind, "unwind", OP1 (U8_X24)) + VM_DEFINE_OP (71, unwind, "unwind", OP1 (X32)) { scm_dynstack_pop (&thread->dynstack); NEXT (1); @@ -2126,7 +2207,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Dynamically bind VALUE to FLUID. */ - VM_DEFINE_OP (67, push_fluid, "push-fluid", OP1 (U8_U12_U12)) + VM_DEFINE_OP (72, push_fluid, "push-fluid", OP1 (X8_S12_S12)) { scm_t_uint32 fluid, value; @@ -2143,7 +2224,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Leave the dynamic extent of a with-fluid* expression, restoring the * fluid to its previous value. */ - VM_DEFINE_OP (68, pop_fluid, "pop-fluid", OP1 (U8_X24)) + VM_DEFINE_OP (73, pop_fluid, "pop-fluid", OP1 (X32)) { /* This function must not allocate. */ scm_dynstack_unwind_fluid (&thread->dynstack, @@ -2155,7 +2236,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Reference the fluid in SRC, and place the value in DST. */ - VM_DEFINE_OP (69, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (74, fluid_ref, "fluid-ref", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; size_t num; @@ -2188,7 +2269,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Set the value of the fluid in DST to the value in SRC. */ - VM_DEFINE_OP (70, fluid_set, "fluid-set", OP1 (U8_U12_U12)) + VM_DEFINE_OP (75, fluid_set, "fluid-set", OP1 (X8_S12_S12)) { scm_t_uint16 a, b; size_t num; @@ -2221,7 +2302,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store the length of the string in SRC in DST. */ - VM_DEFINE_OP (71, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (76, string_length, "string-length", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (str); if (SCM_LIKELY (scm_is_string (str))) @@ -2238,7 +2319,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Fetch the character at position IDX in the string in SRC, and store * it in DST. */ - VM_DEFINE_OP (72, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (77, string_ref, "string-ref", OP1 (X8_S8_S8_S8) | OP_DST) { scm_t_signed_bits i = 0; ARGS2 (str, idx); @@ -2260,7 +2341,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Parse a string in SRC to a number, and store in DST. */ - VM_DEFINE_OP (73, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (78, string_to_number, "string->number", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; @@ -2276,7 +2357,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Parse a string in SRC to a symbol, and store in DST. */ - VM_DEFINE_OP (74, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (79, string_to_symbol, "string->symbol", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; @@ -2290,7 +2371,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Make a keyword from the symbol in SRC, and store it in DST. */ - VM_DEFINE_OP (75, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (80, symbol_to_keyword, "symbol->keyword", OP1 (X8_S12_S12) | OP_DST) { scm_t_uint16 dst, src; UNPACK_12_12 (op, dst, src); @@ -2309,7 +2390,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Cons CAR and CDR, and store the result in DST. */ - VM_DEFINE_OP (76, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (81, cons, "cons", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN (scm_inline_cons (thread, x, y)); @@ -2319,7 +2400,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the car of SRC in DST. */ - VM_DEFINE_OP (77, car, "car", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (82, car, "car", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (x); VM_VALIDATE_PAIR (x, "car"); @@ -2330,7 +2411,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the cdr of SRC in DST. */ - VM_DEFINE_OP (78, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (83, cdr, "cdr", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (x); VM_VALIDATE_PAIR (x, "cdr"); @@ -2341,7 +2422,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Set the car of DST to SRC. */ - VM_DEFINE_OP (79, set_car, "set-car!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (84, set_car, "set-car!", OP1 (X8_S12_S12)) { scm_t_uint16 a, b; SCM x, y; @@ -2357,7 +2438,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Set the cdr of DST to SRC. */ - VM_DEFINE_OP (80, set_cdr, "set-cdr!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (85, set_cdr, "set-cdr!", OP1 (X8_S12_S12)) { scm_t_uint16 a, b; SCM x, y; @@ -2380,7 +2461,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Add A to B, and place the result in DST. */ - VM_DEFINE_OP (81, add, "add", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (86, add, "add", OP1 (X8_S8_S8_S8) | OP_DST) { BINARY_INTEGER_OP (+, scm_sum); } @@ -2389,7 +2470,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Add 1 to the value in SRC, and place the result in DST. */ - VM_DEFINE_OP (82, add1, "add1", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (87, add1, "add1", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (x); @@ -2413,7 +2494,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Subtract B from A, and place the result in DST. */ - VM_DEFINE_OP (83, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (88, sub, "sub", OP1 (X8_S8_S8_S8) | OP_DST) { BINARY_INTEGER_OP (-, scm_difference); } @@ -2422,7 +2503,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Subtract 1 from SRC, and place the result in DST. */ - VM_DEFINE_OP (84, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (89, sub1, "sub1", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (x); @@ -2446,7 +2527,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Multiply A and B, and place the result in DST. */ - VM_DEFINE_OP (85, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (90, mul, "mul", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN_EXP (scm_product (x, y)); @@ -2456,7 +2537,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Divide A by B, and place the result in DST. */ - VM_DEFINE_OP (86, div, "div", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (91, div, "div", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN_EXP (scm_divide (x, y)); @@ -2466,7 +2547,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Divide A by B, and place the quotient in DST. */ - VM_DEFINE_OP (87, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (92, quo, "quo", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN_EXP (scm_quotient (x, y)); @@ -2476,7 +2557,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Divide A by B, and place the remainder in DST. */ - VM_DEFINE_OP (88, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (93, rem, "rem", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN_EXP (scm_remainder (x, y)); @@ -2486,7 +2567,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the modulo of A by B in DST. */ - VM_DEFINE_OP (89, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (94, mod, "mod", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); RETURN_EXP (scm_modulo (x, y)); @@ -2496,7 +2577,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Shift A arithmetically by B bits, and place the result in DST. */ - VM_DEFINE_OP (90, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (95, ash, "ash", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2533,7 +2614,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the bitwise AND of A and B into DST. */ - VM_DEFINE_OP (91, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (96, logand, "logand", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2546,7 +2627,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the bitwise inclusive OR of A with B in DST. */ - VM_DEFINE_OP (92, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (97, logior, "logior", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2559,7 +2640,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Place the bitwise exclusive OR of A with B in DST. */ - VM_DEFINE_OP (93, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (98, logxor, "logxor", OP1 (X8_S8_S8_S8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2572,7 +2653,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * 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. */ - VM_DEFINE_OP (94, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (99, make_vector, "make-vector", OP1 (X8_S8_S8_S8) | OP_DST) { scm_t_uint8 dst, init, length; @@ -2589,7 +2670,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * will have space for LENGTH slots, an immediate value. They will be * filled with the value in slot INIT. */ - VM_DEFINE_OP (95, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (100, make_vector_immediate, "make-vector/immediate", OP1 (X8_S8_C8_S8) | OP_DST) { scm_t_uint8 dst, init; scm_t_int32 length, n; @@ -2610,7 +2691,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store the length of the vector in SRC in DST. */ - VM_DEFINE_OP (96, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (101, vector_length, "vector-length", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (vect); VM_ASSERT (SCM_I_IS_VECTOR (vect), @@ -2623,7 +2704,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Fetch the item at position IDX in the vector in SRC, and store it * in DST. */ - VM_DEFINE_OP (97, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (102, vector_ref, "vector-ref", OP1 (X8_S8_S8_S8) | OP_DST) { scm_t_signed_bits i = 0; ARGS2 (vect, idx); @@ -2641,7 +2722,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Fill DST with the item IDX elements into the vector at SRC. Useful * for building data types using vectors. */ - VM_DEFINE_OP (98, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (103, vector_ref_immediate, "vector-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) { scm_t_uint8 dst, src, idx; SCM v; @@ -2660,7 +2741,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store SRC into the vector DST at index IDX. */ - VM_DEFINE_OP (99, vector_set, "vector-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (104, vector_set, "vector-set!", OP1 (X8_S8_S8_S8)) { scm_t_uint8 dst, idx_var, src; SCM vect, idx, val; @@ -2686,7 +2767,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Store SRC into the vector DST at index IDX. Here IDX is an * immediate value. */ - VM_DEFINE_OP (100, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (105, vector_set_immediate, "vector-set!/immediate", OP1 (X8_S8_C8_S8)) { scm_t_uint8 dst, idx, src; SCM vect, val; @@ -2714,20 +2795,105 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store the vtable of SRC into DST. */ - VM_DEFINE_OP (101, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (106, struct_vtable, "struct-vtable", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (obj); VM_VALIDATE_STRUCT (obj, "struct_vtable"); RETURN (SCM_STRUCT_VTABLE (obj)); } + /* allocate-struct dst:8 vtable:8 nfields:8 + * + * Allocate a new struct with VTABLE, and place it in DST. The struct + * will be constructed with space for NFIELDS fields, which should + * correspond to the field count of the VTABLE. + */ + VM_DEFINE_OP (107, allocate_struct, "allocate-struct", OP1 (X8_S8_S8_S8) | OP_DST) + { + scm_t_uint8 dst, vtable, nfields; + SCM ret; + + UNPACK_8_8_8 (op, dst, vtable, nfields); + + SYNC_IP (); + ret = scm_allocate_struct (LOCAL_REF (vtable), LOCAL_REF (nfields)); + LOCAL_SET (dst, ret); + + NEXT (1); + } + + /* struct-ref dst:8 src:8 idx:8 + * + * Fetch the item at slot IDX in the struct in SRC, and store it + * in DST. + */ + VM_DEFINE_OP (108, struct_ref, "struct-ref", OP1 (X8_S8_S8_S8) | OP_DST) + { + scm_t_uint8 dst, src, idx; + SCM obj; + SCM index; + + UNPACK_8_8_8 (op, dst, src, idx); + + obj = LOCAL_REF (src); + index = LOCAL_REF (idx); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_I_INUMP (index) + && SCM_I_INUM (index) >= 0 + && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF + (SCM_STRUCT_VTABLE (obj), + scm_vtable_index_size)))) + RETURN (SCM_STRUCT_SLOT_REF (obj, SCM_I_INUM (index))); + + SYNC_IP (); + RETURN (scm_struct_ref (obj, index)); + } + + /* struct-set! dst:8 idx:8 src:8 + * + * Store SRC into the struct DST at slot IDX. + */ + VM_DEFINE_OP (109, struct_set, "struct-set!", OP1 (X8_S8_S8_S8)) + { + scm_t_uint8 dst, idx, src; + SCM obj, val, index; + + UNPACK_8_8_8 (op, dst, idx, src); + + obj = LOCAL_REF (dst); + val = LOCAL_REF (src); + index = LOCAL_REF (idx); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE_RW) + && SCM_I_INUMP (index) + && SCM_I_INUM (index) >= 0 + && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF + (SCM_STRUCT_VTABLE (obj), + scm_vtable_index_size)))) + { + SCM_STRUCT_SLOT_SET (obj, SCM_I_INUM (index), val); + NEXT (1); + } + + SYNC_IP (); + scm_struct_set_x (obj, index, val); + NEXT (1); + } + /* allocate-struct/immediate dst:8 vtable:8 nfields:8 * * Allocate a new struct with VTABLE, and place it in DST. The struct * will be constructed with space for NFIELDS fields, which should * correspond to the field count of the VTABLE. */ - VM_DEFINE_OP (102, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (110, allocate_struct_immediate, "allocate-struct/immediate", OP1 (X8_S8_S8_C8) | OP_DST) { scm_t_uint8 dst, vtable, nfields; SCM ret; @@ -2746,7 +2912,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Fetch the item at slot IDX in the struct in SRC, and store it * in DST. IDX is an immediate unsigned 8-bit value. */ - VM_DEFINE_OP (103, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (111, struct_ref_immediate, "struct-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) { scm_t_uint8 dst, src, idx; SCM obj; @@ -2771,7 +2937,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Store SRC into the struct DST at slot IDX. IDX is an immediate * unsigned 8-bit value. */ - VM_DEFINE_OP (104, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (112, struct_set_immediate, "struct-set!/immediate", OP1 (X8_S8_C8_S8)) { scm_t_uint8 dst, idx, src; SCM obj, val; @@ -2802,7 +2968,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * * Store the vtable of SRC into DST. */ - VM_DEFINE_OP (105, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (113, class_of, "class-of", OP1 (X8_S12_S12) | OP_DST) { ARGS1 (obj); if (SCM_INSTANCEP (obj)) @@ -2817,41 +2983,45 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, * Arrays, packed uniform arrays, and bytevectors. */ - /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32 + /* 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 (106, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST) + VM_DEFINE_OP (114, load_typed_array, "load-typed-array", OP5 (X8_S24, X8_S24, X8_S24, N32, C32) | OP_DST) { - scm_t_uint8 dst, type, shape; + scm_t_uint32 dst, type, shape; scm_t_int32 offset; scm_t_uint32 len; - UNPACK_8_8_8 (op, dst, type, shape); - offset = ip[1]; - len = ip[2]; + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], type); + UNPACK_24 (ip[2], shape); + offset = ip[3]; + len = ip[4]; SYNC_IP (); LOCAL_SET (dst, scm_from_contiguous_typed_array (LOCAL_REF (type), LOCAL_REF (shape), ip + offset, len)); - NEXT (3); + NEXT (5); } - /* make-array dst:8 type:8 fill:8 _:8 bounds:24 + /* make-array dst:24 _:8 type:24 _:8 fill:24 _:8 bounds:24 * * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST. */ - VM_DEFINE_OP (107, make_array, "make-array", OP2 (U8_U8_U8_U8, X8_U24) | OP_DST) + VM_DEFINE_OP (115, make_array, "make-array", OP4 (X8_S24, X8_S24, X8_S24, X8_S24) | OP_DST) { - scm_t_uint8 dst, type, fill, bounds; - UNPACK_8_8_8 (op, dst, type, fill); - UNPACK_24 (ip[1], bounds); + 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 (); LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill), LOCAL_REF (bounds))); - NEXT (2); + NEXT (4); } /* bv-u8-ref dst:8 src:8 idx:8 @@ -2941,42 +3111,42 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \ } while (0) - VM_DEFINE_OP (108, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (116, bv_u8_ref, "bv-u8-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FIXABLE_INT_REF (u8, u8, uint8, 1); - VM_DEFINE_OP (109, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (117, bv_s8_ref, "bv-s8-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FIXABLE_INT_REF (s8, s8, int8, 1); - VM_DEFINE_OP (110, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (118, bv_u16_ref, "bv-u16-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2); - VM_DEFINE_OP (111, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (119, bv_s16_ref, "bv-s16-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FIXABLE_INT_REF (s16, s16_native, int16, 2); - VM_DEFINE_OP (112, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (120, bv_u32_ref, "bv-u32-ref", OP1 (X8_S8_S8_S8) | OP_DST) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4); #else BV_INT_REF (u32, uint32, 4); #endif - VM_DEFINE_OP (113, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (121, bv_s32_ref, "bv-s32-ref", OP1 (X8_S8_S8_S8) | OP_DST) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_REF (s32, s32_native, int32, 4); #else BV_INT_REF (s32, int32, 4); #endif - VM_DEFINE_OP (114, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (122, bv_u64_ref, "bv-u64-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_INT_REF (u64, uint64, 8); - VM_DEFINE_OP (115, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (123, bv_s64_ref, "bv-s64-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_INT_REF (s64, int64, 8); - VM_DEFINE_OP (116, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (124, bv_f32_ref, "bv-f32-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FLOAT_REF (f32, ieee_single, float, 4); - VM_DEFINE_OP (117, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (125, bv_f64_ref, "bv-f64-ref", OP1 (X8_S8_S8_S8) | OP_DST) BV_FLOAT_REF (f64, ieee_double, double, 8); /* bv-u8-set! dst:8 idx:8 src:8 @@ -3080,149 +3250,44 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (1); \ } while (0) - VM_DEFINE_OP (118, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (126, bv_u8_set, "bv-u8-set!", OP1 (X8_S8_S8_S8)) BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1); - VM_DEFINE_OP (119, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (127, bv_s8_set, "bv-s8-set!", OP1 (X8_S8_S8_S8)) BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1); - VM_DEFINE_OP (120, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (128, bv_u16_set, "bv-u16-set!", OP1 (X8_S8_S8_S8)) BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2); - VM_DEFINE_OP (121, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (129, bv_s16_set, "bv-s16-set!", OP1 (X8_S8_S8_S8)) BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2); - VM_DEFINE_OP (122, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (130, bv_u32_set, "bv-u32-set!", OP1 (X8_S8_S8_S8)) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4); #else BV_INT_SET (u32, uint32, 4); #endif - VM_DEFINE_OP (123, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (131, bv_s32_set, "bv-s32-set!", OP1 (X8_S8_S8_S8)) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4); #else BV_INT_SET (s32, int32, 4); #endif - VM_DEFINE_OP (124, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (132, bv_u64_set, "bv-u64-set!", OP1 (X8_S8_S8_S8)) BV_INT_SET (u64, uint64, 8); - VM_DEFINE_OP (125, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (133, bv_s64_set, "bv-s64-set!", OP1 (X8_S8_S8_S8)) BV_INT_SET (s64, int64, 8); - VM_DEFINE_OP (126, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (134, bv_f32_set, "bv-f32-set!", OP1 (X8_S8_S8_S8)) BV_FLOAT_SET (f32, ieee_single, float, 4); - VM_DEFINE_OP (127, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (135, bv_f64_set, "bv-f64-set!", OP1 (X8_S8_S8_S8)) BV_FLOAT_SET (f64, ieee_double, double, 8); - /* br-if-logtest a:12 b:12 invert:1 _:7 offset:24 - * - * 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. - */ - VM_DEFINE_OP (128, br_if_logtest, "br-if-logtest", OP2 (U8_U12_U12, B1_X7_L24)) - { - 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)))); - } - - /* FIXME: Move above */ - - /* allocate-struct dst:8 vtable:8 nfields:8 - * - * Allocate a new struct with VTABLE, and place it in DST. The struct - * will be constructed with space for NFIELDS fields, which should - * correspond to the field count of the VTABLE. - */ - VM_DEFINE_OP (129, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST) - { - scm_t_uint8 dst, vtable, nfields; - SCM ret; - - UNPACK_8_8_8 (op, dst, vtable, nfields); - - SYNC_IP (); - ret = scm_allocate_struct (LOCAL_REF (vtable), LOCAL_REF (nfields)); - LOCAL_SET (dst, ret); - - NEXT (1); - } - - /* struct-ref dst:8 src:8 idx:8 - * - * Fetch the item at slot IDX in the struct in SRC, and store it - * in DST. - */ - VM_DEFINE_OP (130, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST) - { - scm_t_uint8 dst, src, idx; - SCM obj; - SCM index; - - UNPACK_8_8_8 (op, dst, src, idx); - - obj = LOCAL_REF (src); - index = LOCAL_REF (idx); - - if (SCM_LIKELY (SCM_STRUCTP (obj) - && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, - SCM_VTABLE_FLAG_SIMPLE) - && SCM_I_INUMP (index) - && SCM_I_INUM (index) >= 0 - && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF - (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size)))) - RETURN (SCM_STRUCT_SLOT_REF (obj, SCM_I_INUM (index))); - - SYNC_IP (); - RETURN (scm_struct_ref (obj, index)); - } - - /* struct-set! dst:8 idx:8 src:8 - * - * Store SRC into the struct DST at slot IDX. - */ - VM_DEFINE_OP (131, struct_set, "struct-set!", OP1 (U8_U8_U8_U8)) - { - scm_t_uint8 dst, idx, src; - SCM obj, val, index; - - UNPACK_8_8_8 (op, dst, idx, src); - - obj = LOCAL_REF (dst); - val = LOCAL_REF (src); - index = LOCAL_REF (idx); - - if (SCM_LIKELY (SCM_STRUCTP (obj) - && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, - SCM_VTABLE_FLAG_SIMPLE) - && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, - SCM_VTABLE_FLAG_SIMPLE_RW) - && SCM_I_INUMP (index) - && SCM_I_INUM (index) >= 0 - && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF - (SCM_STRUCT_VTABLE (obj), - scm_vtable_index_size)))) - { - SCM_STRUCT_SLOT_SET (obj, SCM_I_INUM (index), val); - NEXT (1); - } - - SYNC_IP (); - scm_struct_set_x (obj, index, val); - NEXT (1); - } - - VM_DEFINE_OP (132, unused_132, NULL, NOP) - VM_DEFINE_OP (133, unused_133, NULL, NOP) - VM_DEFINE_OP (134, unused_134, NULL, NOP) - VM_DEFINE_OP (135, unused_135, NULL, NOP) VM_DEFINE_OP (136, unused_136, NULL, NOP) VM_DEFINE_OP (137, unused_137, NULL, NOP) VM_DEFINE_OP (138, unused_138, NULL, NOP) diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm index 2ef98675a..089bf9e7e 100644 --- a/module/language/bytecode.scm +++ b/module/language/bytecode.scm @@ -34,34 +34,40 @@ (define (compute-instruction-arity name args) (define (first-word-arity word) (case word - ((U8_X24) 0) - ((U8_U24) 1) - ((U8_L24) 1) - ((U8_U8_I16) 2) - ((U8_U12_U12) 2) - ((U8_U8_U8_U8) 3))) + ((X32) 0) + ((X8_S24) 1) + ((X8_F24) 1) + ((X8_C24) 1) + ((X8_L24) 1) + ((X8_S8_I16) 2) + ((X8_S12_S12) 2) + ((X8_S12_C12) 2) + ((X8_C12_C12) 2) + ((X8_F12_F12) 2) + ((X8_S8_S8_S8) 3) + ((X8_S8_S8_C8) 3) + ((X8_S8_C8_S8) 3))) (define (tail-word-arity word) (case word - ((U8_U24) 2) - ((U8_L24) 2) - ((U8_U8_I16) 3) - ((U8_U12_U12) 3) - ((U8_U8_U8_U8) 4) - ((U32) 1) + ((C32) 1) ((I32) 1) ((A32) 1) ((B32) 0) ((N32) 1) - ((S32) 1) + ((R32) 1) ((L32) 1) ((LO32) 1) - ((X8_U24) 1) - ((X8_U12_U12) 2) - ((X8_L24) 1) + ((C8_C24) 2) + ((B1_C7_L24) 3) + ((B1_X7_S24) 2) + ((B1_X7_F24) 2) + ((B1_X7_C24) 2) ((B1_X7_L24) 2) - ((B1_U7_L24) 3) ((B1_X31) 1) - ((B1_X7_U24) 2))) + ((X8_S24) 1) + ((X8_F24) 1) + ((X8_C24) 1) + ((X8_L24) 1))) (match args ((arg0 . args) (fold (lambda (arg arity) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 6bc2bcf84..f29105108 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -89,13 +89,13 @@ emit-br-if-struct emit-br-if-char emit-br-if-tc7 - (emit-br-if-eq* . emit-br-if-eq) - (emit-br-if-eqv* . emit-br-if-eqv) - (emit-br-if-equal* . emit-br-if-equal) - (emit-br-if-=* . emit-br-if-=) - (emit-br-if-<* . emit-br-if-<) - (emit-br-if-<=* . emit-br-if-<=) - (emit-br-if-logtest* . emit-br-if-logtest) + emit-br-if-eq + emit-br-if-eqv + emit-br-if-equal + emit-br-if-= + emit-br-if-< + emit-br-if-<= + emit-br-if-logtest (emit-mov* . emit-mov) (emit-box* . emit-box) (emit-box-ref* . emit-box-ref) @@ -153,7 +153,7 @@ (emit-struct-ref* . emit-struct-ref) (emit-struct-set!* . emit-struct-set!) (emit-class-of* . emit-class-of) - (emit-make-array* . emit-make-array) + emit-make-array (emit-bv-u8-ref* . emit-bv-u8-ref) (emit-bv-s8-ref* . emit-bv-s8-ref) (emit-bv-u16-ref* . emit-bv-u16-ref) @@ -510,29 +510,38 @@ later by the linker." (with-syntax ((opcode opcode)) (op-case asm type - ((U8_X24) + ((X32) (emit asm opcode)) - ((U8_U24 arg) + ((X8_S24 arg) (emit asm (pack-u8-u24 opcode arg))) - ((U8_L24 label) + ((X8_F24 arg) + (emit asm (pack-u8-u24 opcode arg))) + ((X8_C24 arg) + (emit asm (pack-u8-u24 opcode arg))) + ((X8_L24 label) (record-label-reference asm label) (emit asm opcode)) - ((U8_U8_I16 a imm) + ((X8_S8_I16 a imm) (emit asm (pack-u8-u8-u16 opcode a (object-address imm)))) - ((U8_U12_U12 a b) + ((X8_S12_S12 a b) + (emit asm (pack-u8-u12-u12 opcode a b))) + ((X8_S12_C12 a b) + (emit asm (pack-u8-u12-u12 opcode a b))) + ((X8_C12_C12 a b) (emit asm (pack-u8-u12-u12 opcode a b))) - ((U8_U8_U8_U8 a b c) + ((X8_F12_F12 a b) + (emit asm (pack-u8-u12-u12 opcode a b))) + ((X8_S8_S8_S8 a b c) + (emit asm (pack-u8-u8-u8-u8 opcode a b c))) + ((X8_S8_S8_C8 a b c) + (emit asm (pack-u8-u8-u8-u8 opcode a b c))) + ((X8_S8_C8_S8 a b c) (emit asm (pack-u8-u8-u8-u8 opcode a b c)))))) (define (pack-tail-word asm type) (op-case asm type - ((U8_U24 a b) - (emit asm (pack-u8-u24 a b))) - ((U8_L24 a label) - (record-label-reference asm label) - (emit asm a)) - ((U32 a) + ((C32 a) (emit asm a)) ((I32 imm) (let ((val (object-address imm))) @@ -548,7 +557,7 @@ later by the linker." ((N32 label) (record-far-label-reference asm label) (emit asm 0)) - ((S32 label) + ((R32 label) (record-far-label-reference asm label) (emit asm 0)) ((L32 label) @@ -558,21 +567,31 @@ later by the linker." (record-far-label-reference asm label (* offset (/ (asm-word-size asm) 4))) (emit asm 0)) - ((X8_U24 a) - (emit asm (pack-u8-u24 0 a))) - ((X8_L24 label) - (record-label-reference asm label) - (emit asm 0)) + ((C8_C24 a b) + (emit asm (pack-u8-u24 a b))) ((B1_X7_L24 a label) (record-label-reference asm label) (emit asm (pack-u1-u7-u24 (if a 1 0) 0 0))) - ((B1_U7_L24 a b label) + ((B1_C7_L24 a b label) (record-label-reference asm label) (emit asm (pack-u1-u7-u24 (if a 1 0) b 0))) ((B1_X31 a) (emit asm (pack-u1-u7-u24 (if a 1 0) 0 0))) - ((B1_X7_U24 a b) - (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b))))) + ((B1_X7_S24 a b) + (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b))) + ((B1_X7_F24 a b) + (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b))) + ((B1_X7_C24 a b) + (emit asm (pack-u1-u7-u24 (if a 1 0) 0 b))) + ((X8_S24 a) + (emit asm (pack-u8-u24 0 a))) + ((X8_F24 a) + (emit asm (pack-u8-u24 0 a))) + ((X8_C24 a) + (emit asm (pack-u8-u24 0 a))) + ((X8_L24 label) + (record-label-reference asm label) + (emit asm 0)))) (syntax-case x () ((_ name opcode word0 word* ...) @@ -651,25 +670,44 @@ later by the linker." #f))) (op-case word0 - ((U8_U8_I16 ! a imm) - (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253)) - imm)) - ((U8_U8_I16 <- a imm) + ((X8_S8_I16 <- a imm) (values (if (< a (ash 1 8)) a 253) imm)) - ((U8_U12_U12 ! a b) + ((X8_S12_S12 ! a b) (values (if (< a (ash 1 12)) a (begin (emit-mov* asm 253 a) 253)) (if (< b (ash 1 12)) b (begin (emit-mov* asm 254 b) 254)))) - ((U8_U12_U12 <- a b) + ((X8_S12_S12 <- a b) (values (if (< a (ash 1 12)) a 253) (if (< b (ash 1 12)) b (begin (emit-mov* asm 254 b) 254)))) - ((U8_U8_U8_U8 ! a b c) + ((X8_S12_C12 <- a b) + (values (if (< a (ash 1 12)) a 253) + b)) + + ((X8_S8_S8_S8 ! a b c) (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253)) (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254)) (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255)))) - ((U8_U8_U8_U8 <- a b c) + ((X8_S8_S8_S8 <- a b c) + (values (if (< a (ash 1 8)) a 253) + (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254)) + (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255)))) + + ((X8_S8_S8_C8 ! a b c) + (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253)) + (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254)) + c)) + ((X8_S8_S8_C8 <- a b c) (values (if (< a (ash 1 8)) a 253) (if (< b (ash 1 8)) b (begin (emit-mov* asm 254 b) 254)) + c)) + + ((X8_S8_C8_S8 ! a b c) + (values (if (< a (ash 1 8)) a (begin (emit-mov* asm 253 a) 253)) + b + (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255)))) + ((X8_S8_C8_S8 <- a b c) + (values (if (< a (ash 1 8)) a 253) + b (if (< c (ash 1 8)) c (begin (emit-mov* asm 255 c) 255)))))) (define (tail-formals type) @@ -682,22 +720,25 @@ later by the linker." ((op-case type) (error "unmatched type" type)))) (op-case type - (U8_U24 a b) - (U8_L24 a label) - (U32 a) + (C32 a) (I32 imm) (A32 imm) (B32) (N32 label) - (S32 label) + (R32 label) (L32 label) (LO32 label offset) - (X8_U24 a) - (X8_L24 label) + (C8_C24 a b) + (B1_C7_L24 a b label) + (B1_X7_S24 a b) + (B1_X7_F24 a b) + (B1_X7_C24 a b) (B1_X7_L24 a label) - (B1_U7_L24 a b label) (B1_X31 a) - (B1_X7_U24 a b))) + (X8_S24 a) + (X8_F24 a) + (X8_C24 a) + (X8_L24 label))) (define (shuffle-up dst) (define-syntax op-case @@ -711,10 +752,10 @@ later by the linker." (with-syntax ((dst dst)) (op-case word0 - ((U8_U8_I16 U8_U8_U8_U8) + ((X8_S8_I16 X8_S8_S8_S8 X8_S8_S8_C8 X8_S8_C8_S8) (unless (< dst (ash 1 8)) (emit-mov* asm dst 253))) - ((U8_U12_U12) + ((X8_S12_S12 X8_S12_C12) (unless (< dst (ash 1 12)) (emit-mov* asm dst 253)))))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 08aa057a2..c1a8ce700 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -80,70 +80,58 @@ (define (parse-first-word word type) (with-syntax ((word word)) (case type - ((U8_X24) + ((X32) #'()) - ((U8_U24) + ((X8_S24 X8_F24 X8_C24) #'((ash word -8))) - ((U8_L24) + ((X8_L24) #'((unpack-s24 (ash word -8)))) - ((U8_U8_I16) + ((X8_S8_I16) #'((logand (ash word -8) #xff) (ash word -16))) - ((U8_U12_U12) + ((X8_S12_S12 + X8_S12_C12 + X8_C12_C12 + X8_F12_F12) #'((logand (ash word -8) #xfff) (ash word -20))) - ((U8_U8_U8_U8) + ((X8_S8_S8_S8 + X8_S8_S8_C8 + X8_S8_C8_S8) #'((logand (ash word -8) #xff) (logand (ash word -16) #xff) (ash word -24))) (else - (error "bad kind" type))))) + (error "bad head kind" type))))) (define (parse-tail-word word type) (with-syntax ((word word)) (case type - ((U8_X24) - #'((logand word #ff))) - ((U8_U24) - #'((logand word #xff) - (ash word -8))) - ((U8_L24) - #'((logand word #xff) - (unpack-s24 (ash word -8)))) - ((U32) - #'(word)) - ((I32) - #'(word)) - ((A32) + ((C32 I32 A32 B32) #'(word)) - ((B32) - #'(word)) - ((N32) - #'((unpack-s32 word))) - ((S32) - #'((unpack-s32 word))) - ((L32) - #'((unpack-s32 word))) - ((LO32) + ((N32 R32 L32 LO32) #'((unpack-s32 word))) - ((X8_U24) - #'((ash word -8))) - ((X8_L24) - #'((unpack-s24 (ash word -8)))) - ((B1_X7_L24) + ((C8_C24) + #'((logand word #xff) + (ash word -8))) + ((B1_C7_L24) #'((not (zero? (logand word #x1))) + (logand (ash word -1) #x7f) (unpack-s24 (ash word -8)))) - ((B1_U7_L24) + ((B1_X7_S24 B1_X7_F24 B1_X7_C24) + #'((not (zero? (logand word #x1))) + (ash word -8))) + ((B1_X7_L24) #'((not (zero? (logand word #x1))) - (logand (ash word -1) #x7f) (unpack-s24 (ash word -8)))) ((B1_X31) #'((not (zero? (logand word #x1))))) - ((B1_X7_U24) - #'((not (zero? (logand word #x1))) - (ash word -8))) + ((X8_S24 X8_F24 X8_C24) + #'((ash word -8))) + ((X8_L24) + #'((unpack-s24 (ash word -8)))) (else - (error "bad kind" type))))) + (error "bad tail kind" type))))) (syntax-case x () ((_ name opcode word0 word* ...) |