diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 27c8778ab..0733397e7 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -974,38 +974,51 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) return scm_values (ret); } - /* call from:24 _:8 proc:24 _:8 nargs:24 arg0:24 0:8 ... + /* push-frame from:24 _:8 nargs:24 * - * Call a procedure. Push a call frame on at FROM, saving the return - * address and the fp. Parse out NARGS, and push the procedure and - * arguments. All arguments except for RETURN-LOC are 24-bit values. - * FROM, PROC, and NARGS are in the upper 24 bits of the words. The - * ARGN... are in the lower 24 bits, with the upper 8 bits being 0. + * Push a frame for a new procedure call starting at FROM. + * Reserve stack space for NARGS values in the new frame, including + * the procedure. + */ + VM_DEFINE_OP (2, push_frame, "push-frame", OP2 (U8_U24, X8_U24)) + { + scm_t_uint32 from, nargs, new_size, n; + + SCM_UNPACK_RTL_24 (op, from); + SCM_UNPACK_RTL_24 (ip[1], nargs); + + new_size = from + 3 + nargs; + ALLOC_FRAME (new_size); + + /* FIXME: Elide this initialization? */ + for (n = from; n < new_size; n++) + LOCAL_SET (n, SCM_UNDEFINED); + + NEXT (2); + } + + /* call from:24 + * + * Call a procedure. Links a call frame at FROM, saving the return + * address and the fp. * * The MVRA of the new frame is set to point to the next instruction * after the end of the `call' instruction. The word following that * is the RA. */ - VM_DEFINE_OP (2, call, "call", OP3 (U8_U24, X8_U24, X8_R24)) + VM_DEFINE_OP (3, call, "call", OP1 (U8_U24)) { - scm_t_uint32 from, proc, nargs, n; + scm_t_uint32 from; SCM *old_fp = fp; SCM_UNPACK_RTL_24 (op, from); - SCM_UNPACK_RTL_24 (ip[1], proc); - SCM_UNPACK_RTL_24 (ip[2], nargs); VM_HANDLE_INTERRUPTS; fp = vp->fp = old_fp + from + 3; SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp); - SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS (fp, ip + 3 + nargs); - SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 4 + nargs); - fp[-1] = old_fp[proc - 1]; - ALLOC_FRAME (nargs + 1); - - for (n = 0; n < nargs; n++) - LOCAL_SET (n + 1, old_fp[ip[3 + n] - 1]); + SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS (fp, ip + 1); + SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 2); PUSH_CONTINUATION_HOOK (); APPLY_HOOK (); @@ -1026,7 +1039,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * As with `call', the next instruction after the call/values will be * the MVRA, and the word after that instruction is the RA. */ - VM_DEFINE_OP (3, call_values, "call/values", OP2 (U8_U24, X8_U24)) + VM_DEFINE_OP (4, call_values, "call/values", OP2 (U8_U24, X8_U24)) { scm_t_uint32 from, proc; SCM *old_fp = fp; @@ -1057,7 +1070,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Tail-call a procedure. Requires that all of the arguments have * already been shuffled into position. */ - VM_DEFINE_OP (4, tail_call, "tail-call", OP2 (U8_U24, X8_U24)) + VM_DEFINE_OP (5, tail_call, "tail-call", OP2 (U8_U24, X8_U24)) { scm_t_uint32 nargs, proc; @@ -1084,7 +1097,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Return a value. */ - VM_DEFINE_OP (5, return, "return", OP1 (U8_U24)) + VM_DEFINE_OP (6, return, "return", OP1 (U8_U24)) { scm_t_uint32 src; SCM_UNPACK_RTL_24 (op, src); @@ -1098,7 +1111,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * with tail calls, we expect that the NVALUES values have already * been shuffled down to a contiguous array starting at slot 0. */ - VM_DEFINE_OP (6, return_values, "return/values", OP1 (U8_U24)) + VM_DEFINE_OP (7, return_values, "return/values", OP1 (U8_U24)) { scm_t_uint32 nargs; SCM_UNPACK_RTL_24 (op, nargs); @@ -1121,7 +1134,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * calling frame. This instruction is part of the trampolines * created in gsubr.c, and is not generated by the compiler. */ - VM_DEFINE_OP (7, subr_call, "subr-call", OP1 (U8_U24)) + VM_DEFINE_OP (8, subr_call, "subr-call", OP1 (U8_U24)) { scm_t_uint32 ptr_idx; SCM pointer, ret; @@ -1191,7 +1204,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * part of the trampolines created by the FFI, and is not generated by * the compiler. */ - VM_DEFINE_OP (8, foreign_call, "foreign-call", OP1 (U8_U12_U12)) + VM_DEFINE_OP (9, foreign_call, "foreign-call", OP1 (U8_U12_U12)) { scm_t_uint16 cif_idx, ptr_idx; SCM closure, cif, pointer, ret; @@ -1225,7 +1238,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * the implementation of undelimited continuations, and is not * generated by the compiler. */ - VM_DEFINE_OP (9, continuation_call, "continuation-call", OP1 (U8_U24)) + VM_DEFINE_OP (10, continuation_call, "continuation-call", OP1 (U8_U24)) { SCM contregs; scm_t_uint32 contregs_idx; @@ -1254,7 +1267,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * instruction is part of the implementation of partial continuations, * and is not generated by the compiler. */ - VM_DEFINE_OP (10, compose_continuation, "compose-continuation", OP1 (U8_U24)) + VM_DEFINE_OP (11, compose_continuation, "compose-continuation", OP1 (U8_U24)) { SCM vmcont; scm_t_uint32 cont_idx; @@ -1278,7 +1291,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * arguments. This instruction is part of the implementation of * `apply', and is not generated by the compiler. */ - VM_DEFINE_OP (11, apply, "apply", OP1 (U8_X24)) + VM_DEFINE_OP (12, apply, "apply", OP1 (U8_X24)) { int i, list_idx, list_len, nargs; SCM list; @@ -1322,7 +1335,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * local slot 0 to it. This instruction is part of the implementation * of `call/cc', and is not generated by the compiler. */ - VM_DEFINE_OP (12, call_cc, "call/cc", OP1 (U8_X24)) + VM_DEFINE_OP (13, call_cc, "call/cc", OP1 (U8_X24)) #if 0 { SCM vm_cont, cont; @@ -1363,7 +1376,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * This instruction is part of the implementation of * `values', and is not generated by the compiler. */ - VM_DEFINE_OP (13, values, "values", OP1 (U8_X24)) + VM_DEFINE_OP (14, values, "values", OP1 (U8_X24)) { SCM *base = fp; #if VM_USE_HOOKS @@ -1403,15 +1416,15 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to * the current instruction pointer. */ - VM_DEFINE_OP (14, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24)) + VM_DEFINE_OP (15, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24)) { BR_NARGS (!=); } - VM_DEFINE_OP (15, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24)) + VM_DEFINE_OP (16, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24)) { BR_NARGS (<); } - VM_DEFINE_OP (16, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24)) + VM_DEFINE_OP (17, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24)) { BR_NARGS (>); } @@ -1423,7 +1436,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the number of actual arguments is not ==, >=, or <= EXPECTED, * respectively, signal an error. */ - VM_DEFINE_OP (17, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24)) + VM_DEFINE_OP (18, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24)) { scm_t_uint32 expected; SCM_UNPACK_RTL_24 (op, expected); @@ -1431,7 +1444,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); NEXT (1); } - VM_DEFINE_OP (18, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24)) + VM_DEFINE_OP (19, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24)) { scm_t_uint32 expected; SCM_UNPACK_RTL_24 (op, expected); @@ -1439,7 +1452,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); NEXT (1); } - VM_DEFINE_OP (19, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24)) + VM_DEFINE_OP (20, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24)) { scm_t_uint32 expected; SCM_UNPACK_RTL_24 (op, expected); @@ -1454,7 +1467,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * setting them all to SCM_UNDEFINED, except those nargs values that * were passed as arguments and procedure. */ - VM_DEFINE_OP (20, reserve_locals, "reserve-locals", OP1 (U8_U24)) + VM_DEFINE_OP (21, reserve_locals, "reserve-locals", OP1 (U8_U24)) { scm_t_uint32 nlocals, nargs; SCM_UNPACK_RTL_24 (op, nlocals); @@ -1472,7 +1485,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The * number of locals reserved is EXPECTED + NLOCALS. */ - VM_DEFINE_OP (21, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12)) + VM_DEFINE_OP (22, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12)) { scm_t_uint16 expected, nlocals; SCM_UNPACK_RTL_12_12 (op, expected, nlocals); @@ -1497,7 +1510,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * A macro-mega-instruction. */ - VM_DEFINE_OP (22, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32)) + VM_DEFINE_OP (23, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32)) { scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs; scm_t_int32 kw_offset; @@ -1583,7 +1596,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Collect any arguments at or above DST into a list, and store that * list at DST. */ - VM_DEFINE_OP (23, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST) + VM_DEFINE_OP (24, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST) { scm_t_uint32 dst, nargs; SCM rest = SCM_EOL; @@ -1609,7 +1622,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Reset the stack pointer to only have space for NLOCALS values. * Used after extracting values from an MV return. */ - VM_DEFINE_OP (24, drop_values, "drop-values", OP1 (U8_U24)) + VM_DEFINE_OP (25, drop_values, "drop-values", OP1 (U8_U24)) { scm_t_bits nlocals; @@ -1632,7 +1645,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Add OFFSET, a signed 24-bit number, to the current instruction * pointer. */ - VM_DEFINE_OP (25, br, "br", OP1 (U8_L24)) + VM_DEFINE_OP (26, br, "br", OP1 (U8_L24)) { scm_t_int32 offset = op; offset >>= 8; /* Sign-extending shift. */ @@ -1644,7 +1657,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (26, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (27, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, scm_is_true (x)); } @@ -1654,7 +1667,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (27, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (28, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, scm_is_null (x)); } @@ -1664,7 +1677,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit * number, to the current instruction pointer. */ - VM_DEFINE_OP (28, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (29, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, scm_is_lisp_false (x)); } @@ -1674,7 +1687,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in TEST is a pair, add OFFSET, a signed 24-bit number, * to the current instruction pointer. */ - VM_DEFINE_OP (29, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (30, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, scm_is_pair (x)); } @@ -1684,7 +1697,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in TEST is a struct, add OFFSET, a signed 24-bit * number, to the current instruction pointer. */ - VM_DEFINE_OP (30, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (31, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, SCM_STRUCTP (x)); } @@ -1694,7 +1707,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in TEST is a char, add OFFSET, a signed 24-bit number, * to the current instruction pointer. */ - VM_DEFINE_OP (31, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24)) + VM_DEFINE_OP (32, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24)) { BR_UNARY (x, SCM_CHARP (x)); } @@ -1704,7 +1717,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (32, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24)) + VM_DEFINE_OP (33, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24)) { BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f)); } @@ -1714,7 +1727,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (33, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (34, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y)); } @@ -1724,7 +1737,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (34, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (35, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y) @@ -1738,7 +1751,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 24-bit number, to the current instruction pointer. */ // FIXME: should sync_ip before calling out? - VM_DEFINE_OP (35, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24)) + VM_DEFINE_OP (36, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24)) { BR_BINARY (x, y, scm_is_eq (x, y) @@ -1751,7 +1764,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in A is = to the value in B, add OFFSET, a signed * 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (36, br_if_ee, "br-if-=", OP2 (U8_U12_U12, X8_L24)) + VM_DEFINE_OP (37, br_if_ee, "br-if-=", OP2 (U8_U12_U12, X8_L24)) { BR_ARITHMETIC (==, scm_num_eq_p); } @@ -1761,7 +1774,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * If the value in A is < to the value in B, add OFFSET, a signed * 24-bit number, to the current instruction pointer. */ - VM_DEFINE_OP (37, br_if_lt, "br-if-<", OP2 (U8_U12_U12, X8_L24)) + VM_DEFINE_OP (38, br_if_lt, "br-if-<", OP2 (U8_U12_U12, X8_L24)) { BR_ARITHMETIC (<, scm_less_p); } @@ -1771,7 +1784,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (38, br_if_le, "br-if-<=", OP2 (U8_U12_U12, X8_L24)) + VM_DEFINE_OP (39, br_if_le, "br-if-<=", OP2 (U8_U12_U12, X8_L24)) { BR_ARITHMETIC (<=, scm_leq_p); } @@ -1781,7 +1794,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (39, br_if_gt, "br-if->", OP2 (U8_U12_U12, X8_L24)) + VM_DEFINE_OP (40, br_if_gt, "br-if->", OP2 (U8_U12_U12, X8_L24)) { BR_ARITHMETIC (>, scm_gr_p); } @@ -1791,7 +1804,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (40, br_if_ge, "br-if->=", OP2 (U8_U12_U12, X8_L24)) + VM_DEFINE_OP (41, br_if_ge, "br-if->=", OP2 (U8_U12_U12, X8_L24)) { BR_ARITHMETIC (>=, scm_geq_p); } @@ -1807,7 +1820,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Copy a value from one local slot to another. */ - VM_DEFINE_OP (41, mov, "mov", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (42, mov, "mov", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst; scm_t_uint16 src; @@ -1822,7 +1835,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Copy a value from one local slot to another. */ - VM_DEFINE_OP (42, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST) + VM_DEFINE_OP (43, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST) { scm_t_uint32 dst; scm_t_uint32 src; @@ -1838,7 +1851,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Create a new variable holding SRC, and place it in DST. */ - VM_DEFINE_OP (43, box, "box", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (44, box, "box", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; SCM_UNPACK_RTL_12_12 (op, dst, src); @@ -1852,7 +1865,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * general implementation of `letrec', in those cases that fix-letrec * fails to fix. */ - VM_DEFINE_OP (44, empty_box, "empty-box", OP1 (U8_U24) | OP_DST) + VM_DEFINE_OP (45, empty_box, "empty-box", OP1 (U8_U24) | OP_DST) { scm_t_uint32 dst; SCM_UNPACK_RTL_24 (op, dst); @@ -1865,7 +1878,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Unpack the variable at SRC into DST, asserting that the variable is * actually bound. */ - VM_DEFINE_OP (45, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (46, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; SCM var; @@ -1888,7 +1901,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Set the contents of the variable at DST to SET. */ - VM_DEFINE_OP (46, box_set, "box-set!", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (47, box_set, "box-set!", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; SCM var; @@ -1906,7 +1919,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * signed 32-bit integer. Space for NFREE free variables will be * allocated. */ - VM_DEFINE_OP (47, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST) + VM_DEFINE_OP (48, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST) { scm_t_uint32 dst, nfree, n; scm_t_int32 offset; @@ -1930,7 +1943,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Load free variable IDX from the closure SRC into local slot DST. */ - VM_DEFINE_OP (48, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST) + VM_DEFINE_OP (49, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST) { scm_t_uint16 dst, src; scm_t_uint32 idx; @@ -1945,7 +1958,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Set free variable IDX from the closure DST to SRC. */ - VM_DEFINE_OP (49, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24)) + VM_DEFINE_OP (50, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24)) { scm_t_uint16 dst, src; scm_t_uint32 idx; @@ -1968,7 +1981,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Make an immediate whose low bits are LOW-BITS, and whose top bits are * 0. */ - VM_DEFINE_OP (50, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST) + VM_DEFINE_OP (51, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST) { scm_t_uint8 dst; scm_t_bits val; @@ -1983,7 +1996,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Make an immediate whose low bits are LOW-BITS, and whose top bits are * 0. */ - VM_DEFINE_OP (51, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32)) + VM_DEFINE_OP (52, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32)) { scm_t_uint8 dst; scm_t_bits val; @@ -1998,7 +2011,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Make an immediate with HIGH-BITS and LOW-BITS. */ - VM_DEFINE_OP (52, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST) + VM_DEFINE_OP (53, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST) { scm_t_uint8 dst; scm_t_bits val; @@ -2029,7 +2042,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Whether the object is mutable or immutable depends on where it was * allocated by the compiler, and loaded by the loader. */ - VM_DEFINE_OP (53, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST) + VM_DEFINE_OP (54, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST) { scm_t_uint32 dst; scm_t_int32 offset; @@ -2058,7 +2071,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * that the compiler is unable to statically allocate, like symbols. * These values would be initialized when the object file loads. */ - VM_DEFINE_OP (54, static_ref, "static-ref", OP2 (U8_U24, S32)) + VM_DEFINE_OP (55, static_ref, "static-ref", OP2 (U8_U24, S32)) { scm_t_uint32 dst; scm_t_int32 offset; @@ -2081,7 +2094,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Store a SCM value into memory, OFFSET 32-bit words away from the * current instruction pointer. OFFSET is a signed value. */ - VM_DEFINE_OP (55, static_set, "static-set!", OP2 (U8_U24, LO32)) + VM_DEFINE_OP (56, static_set, "static-set!", OP2 (U8_U24, LO32)) { scm_t_uint32 src; scm_t_int32 offset; @@ -2103,7 +2116,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * words away from the current instruction pointer. OFFSET is a * signed value. */ - VM_DEFINE_OP (56, link_procedure, "link-procedure!", OP2 (U8_U24, L32)) + VM_DEFINE_OP (57, link_procedure, "link-procedure!", OP2 (U8_U24, L32)) { scm_t_uint32 src; scm_t_int32 offset; @@ -2164,7 +2177,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store the current module in DST. */ - VM_DEFINE_OP (57, current_module, "current-module", OP1 (U8_U24) | OP_DST) + VM_DEFINE_OP (58, current_module, "current-module", OP1 (U8_U24) | OP_DST) { scm_t_uint32 dst; @@ -2180,7 +2193,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Resolve SYM in MOD, and place the resulting variable in DST. */ - VM_DEFINE_OP (58, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (59, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_uint8 dst, mod, sym; @@ -2198,7 +2211,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * nonzero, resolve the public interface, otherwise use the private * interface. */ - VM_DEFINE_OP (59, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (60, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_uint8 dst, name, public; SCM mod; @@ -2219,7 +2232,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Look up a binding for SYM in the current module, creating it if * necessary. Set its value to VAL. */ - VM_DEFINE_OP (60, define, "define", OP1 (U8_U12_U12)) + VM_DEFINE_OP (61, define, "define", OP1 (U8_U12_U12)) { scm_t_uint16 sym, val; SCM_UNPACK_RTL_12_12 (op, sym, val); @@ -2247,7 +2260,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * an error if it is unbound, unbox it into DST, and cache the * resolved variable so that we will hit the cache next time. */ - VM_DEFINE_OP (61, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32) | OP_DST) + VM_DEFINE_OP (62, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32) | OP_DST) { scm_t_uint32 dst; scm_t_int32 var_offset; @@ -2293,7 +2306,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Set a top-level variable from a variable cache cell. The variable * is resolved as in toplevel-ref. */ - VM_DEFINE_OP (62, toplevel_set, "toplevel-set!", OP4 (U8_U24, S32, S32, N32)) + VM_DEFINE_OP (63, toplevel_set, "toplevel-set!", OP4 (U8_U24, S32, S32, N32)) { scm_t_uint32 src; scm_t_int32 var_offset; @@ -2338,7 +2351,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Like toplevel-ref, except MOD-OFFSET points at the name of a module * instead of the module itself. */ - VM_DEFINE_OP (63, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) | OP_DST) + VM_DEFINE_OP (64, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) | OP_DST) { scm_t_uint32 dst; scm_t_int32 var_offset; @@ -2388,7 +2401,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Like toplevel-set!, except MOD-OFFSET points at the name of a module * instead of the module itself. */ - VM_DEFINE_OP (64, module_set, "module-set!", OP4 (U8_U24, S32, N32, N32)) + VM_DEFINE_OP (65, module_set, "module-set!", OP4 (U8_U24, S32, N32, N32)) { scm_t_uint32 src; scm_t_int32 var_offset; @@ -2443,7 +2456,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * handler at HANDLER-OFFSET words from the current IP. The handler * will expect a multiple-value return. */ - VM_DEFINE_OP (65, prompt, "prompt", OP2 (U8_U24, U8_L24)) + VM_DEFINE_OP (66, prompt, "prompt", OP2 (U8_U24, U8_L24)) #if 0 { scm_t_uint32 tag; @@ -2475,7 +2488,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (66, wind, "wind", OP1 (U8_U12_U12)) + VM_DEFINE_OP (67, wind, "wind", OP1 (U8_U12_U12)) { scm_t_uint16 winder, unwinder; SCM_UNPACK_RTL_12_12 (op, winder, unwinder); @@ -2490,7 +2503,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * VAL1, etc are 24-bit values, in the lower 24 bits of their words. * The upper 8 bits are 0. */ - VM_DEFINE_OP (67, abort, "abort", OP2 (U8_U24, X8_R24)) + VM_DEFINE_OP (68, abort, "abort", OP2 (U8_U24, X8_R24)) #if 0 { scm_t_uint32 tag, nvalues; @@ -2513,7 +2526,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * A normal exit from the dynamic extent of an expression. Pop the top * entry off of the dynamic stack. */ - VM_DEFINE_OP (68, unwind, "unwind", OP1 (U8_X24)) + VM_DEFINE_OP (69, unwind, "unwind", OP1 (U8_X24)) { scm_dynstack_pop (¤t_thread->dynstack); NEXT (1); @@ -2525,7 +2538,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * allocated in a continguous range on the stack, starting from * FLUID-BASE. The values do not have this restriction. */ - VM_DEFINE_OP (69, push_fluid, "push-fluid", OP1 (U8_U12_U12)) + VM_DEFINE_OP (70, push_fluid, "push-fluid", OP1 (U8_U12_U12)) { scm_t_uint32 fluid, value; @@ -2542,7 +2555,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Leave the dynamic extent of a with-fluids expression, restoring the * fluids to their previous values. */ - VM_DEFINE_OP (70, pop_fluid, "pop-fluid", OP1 (U8_X24)) + VM_DEFINE_OP (71, pop_fluid, "pop-fluid", OP1 (U8_X24)) { /* This function must not allocate. */ scm_dynstack_unwind_fluid (¤t_thread->dynstack, @@ -2554,7 +2567,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Reference the fluid in SRC, and place the value in DST. */ - VM_DEFINE_OP (71, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (72, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; size_t num; @@ -2587,7 +2600,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Set the value of the fluid in DST to the value in SRC. */ - VM_DEFINE_OP (72, fluid_set, "fluid-set", OP1 (U8_U12_U12)) + VM_DEFINE_OP (73, fluid_set, "fluid-set", OP1 (U8_U12_U12)) { scm_t_uint16 a, b; size_t num; @@ -2620,7 +2633,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store the length of the string in SRC in DST. */ - VM_DEFINE_OP (73, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (74, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (str); if (SCM_LIKELY (scm_is_string (str))) @@ -2637,7 +2650,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Fetch the character at position IDX in the string in SRC, and store * it in DST. */ - VM_DEFINE_OP (74, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (75, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_signed_bits i = 0; ARGS2 (str, idx); @@ -2659,7 +2672,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Parse a string in SRC to a number, and store in DST. */ - VM_DEFINE_OP (75, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (76, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; @@ -2675,7 +2688,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Parse a string in SRC to a symbol, and store in DST. */ - VM_DEFINE_OP (76, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (77, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; @@ -2689,7 +2702,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Make a keyword from the symbol in SRC, and store it in DST. */ - VM_DEFINE_OP (77, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (78, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; SCM_UNPACK_RTL_12_12 (op, dst, src); @@ -2708,7 +2721,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Cons CAR and CDR, and store the result in DST. */ - VM_DEFINE_OP (78, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (79, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); RETURN (scm_cons (x, y)); @@ -2718,7 +2731,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the car of SRC in DST. */ - VM_DEFINE_OP (79, car, "car", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (80, car, "car", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (x); VM_VALIDATE_PAIR (x, "car"); @@ -2729,7 +2742,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the cdr of SRC in DST. */ - VM_DEFINE_OP (80, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (81, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (x); VM_VALIDATE_PAIR (x, "cdr"); @@ -2740,7 +2753,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Set the car of DST to SRC. */ - VM_DEFINE_OP (81, set_car, "set-car!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (82, set_car, "set-car!", OP1 (U8_U12_U12)) { scm_t_uint16 a, b; SCM x, y; @@ -2756,7 +2769,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Set the cdr of DST to SRC. */ - VM_DEFINE_OP (82, set_cdr, "set-cdr!", OP1 (U8_U12_U12)) + VM_DEFINE_OP (83, set_cdr, "set-cdr!", OP1 (U8_U12_U12)) { scm_t_uint16 a, b; SCM x, y; @@ -2779,7 +2792,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Add A to B, and place the result in DST. */ - VM_DEFINE_OP (83, add, "add", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (84, add, "add", OP1 (U8_U8_U8_U8) | OP_DST) { BINARY_INTEGER_OP (+, scm_sum); } @@ -2788,7 +2801,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Add 1 to the value in SRC, and place the result in DST. */ - VM_DEFINE_OP (84, add1, "add1", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (85, add1, "add1", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (x); @@ -2814,7 +2827,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Subtract B from A, and place the result in DST. */ - VM_DEFINE_OP (85, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (86, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST) { BINARY_INTEGER_OP (-, scm_difference); } @@ -2823,7 +2836,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Subtract 1 from SRC, and place the result in DST. */ - VM_DEFINE_OP (86, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (87, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (x); @@ -2849,7 +2862,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Multiply A and B, and place the result in DST. */ - VM_DEFINE_OP (87, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (88, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); SYNC_IP (); @@ -2860,7 +2873,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Divide A by B, and place the result in DST. */ - VM_DEFINE_OP (88, div, "div", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (89, div, "div", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); SYNC_IP (); @@ -2871,7 +2884,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Divide A by B, and place the quotient in DST. */ - VM_DEFINE_OP (89, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (90, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); SYNC_IP (); @@ -2882,7 +2895,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Divide A by B, and place the remainder in DST. */ - VM_DEFINE_OP (90, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (91, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); SYNC_IP (); @@ -2893,7 +2906,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the modulo of A by B in DST. */ - VM_DEFINE_OP (91, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (92, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); SYNC_IP (); @@ -2904,7 +2917,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Shift A arithmetically by B bits, and place the result in DST. */ - VM_DEFINE_OP (92, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (93, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2937,7 +2950,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the bitwise AND of A and B into DST. */ - VM_DEFINE_OP (93, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (94, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2950,7 +2963,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the bitwise inclusive OR of A with B in DST. */ - VM_DEFINE_OP (94, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (95, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2963,7 +2976,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Place the bitwise exclusive OR of A with B in DST. */ - VM_DEFINE_OP (95, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (96, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (x, y); if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) @@ -2976,7 +2989,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * 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 (97, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (vect); if (SCM_LIKELY (SCM_I_IS_VECTOR (vect))) @@ -2993,7 +3006,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * 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 (98, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_signed_bits i = 0; ARGS2 (vect, idx); @@ -3014,7 +3027,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Fill DST with the item IDX elements into the vector at SRC. Useful * for building data types using vectors. */ - VM_DEFINE_OP (98, constant_vector_ref, "constant-vector-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (99, constant_vector_ref, "constant-vector-ref", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_uint8 dst, src, idx; SCM v; @@ -3033,7 +3046,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * 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 (100, vector_set, "vector-set", OP1 (U8_U8_U8_U8)) { scm_t_uint8 dst, idx_var, src; SCM vect, idx, val; @@ -3068,7 +3081,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store the vtable of SRC into DST. */ - VM_DEFINE_OP (100, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (101, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (obj); VM_VALIDATE_STRUCT (obj, "struct_vtable"); @@ -3082,7 +3095,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * the locals given by INIT0.... The format of INIT0... is as in the * "call" opcode: unsigned 24-bit values, with 0 in the high byte. */ - VM_DEFINE_OP (101, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24)) + VM_DEFINE_OP (102, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24)) #if 0 { scm_t_uint16 dst, vtable_r; @@ -3125,7 +3138,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Fetch the item at slot IDX in the struct in SRC, and store it * in DST. */ - VM_DEFINE_OP (102, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (103, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST) { ARGS2 (obj, pos); @@ -3159,7 +3172,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store SRC into the struct DST at slot IDX. */ - VM_DEFINE_OP (103, struct_set, "struct-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (104, struct_set, "struct-set!", OP1 (U8_U8_U8_U8)) { scm_t_uint8 dst, idx, src; SCM obj, pos, val; @@ -3200,7 +3213,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store the vtable of SRC into DST. */ - VM_DEFINE_OP (104, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST) + VM_DEFINE_OP (105, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST) { ARGS1 (obj); if (SCM_INSTANCEP (obj)) @@ -3215,7 +3228,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * DST. Unlike struct-ref, IDX is an 8-bit immediate value, not an * index into the stack. */ - VM_DEFINE_OP (105, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (106, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_uint8 dst, src, idx; SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx); @@ -3229,7 +3242,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * Store SRC into slot IDX of the struct in DST. Unlike struct-set!, * IDX is an 8-bit immediate value, not an index into the stack. */ - VM_DEFINE_OP (106, slot_set, "slot-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (107, slot_set, "slot-set!", OP1 (U8_U8_U8_U8)) { scm_t_uint8 dst, idx, src; SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); @@ -3250,7 +3263,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * from the instruction pointer, and store into DST. LEN is a byte * length. OFFSET is signed. */ - VM_DEFINE_OP (107, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST) + VM_DEFINE_OP (108, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST) { scm_t_uint8 dst, type, shape; scm_t_int32 offset; @@ -3270,7 +3283,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST. */ - VM_DEFINE_OP (108, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST) + VM_DEFINE_OP (109, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST) { scm_t_uint16 dst, type, fill, bounds; SCM_UNPACK_RTL_12_12 (op, dst, type); @@ -3368,42 +3381,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \ } while (0) - VM_DEFINE_OP (109, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (110, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FIXABLE_INT_REF (u8, u8, uint8, 1); - VM_DEFINE_OP (110, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (111, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FIXABLE_INT_REF (s8, s8, int8, 1); - VM_DEFINE_OP (111, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (112, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2); - VM_DEFINE_OP (112, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (113, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FIXABLE_INT_REF (s16, s16_native, int16, 2); - VM_DEFINE_OP (113, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (114, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4); #else BV_INT_REF (u32, uint32, 4); #endif - VM_DEFINE_OP (114, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (115, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_REF (s32, s32_native, int32, 4); #else BV_INT_REF (s32, int32, 4); #endif - VM_DEFINE_OP (115, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (116, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_INT_REF (u64, uint64, 8); - VM_DEFINE_OP (116, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (117, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_INT_REF (s64, int64, 8); - VM_DEFINE_OP (117, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (118, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FLOAT_REF (f32, ieee_single, float, 4); - VM_DEFINE_OP (118, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST) + VM_DEFINE_OP (119, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST) BV_FLOAT_REF (f64, ieee_double, double, 8); /* bv-u8-set! dst:8 idx:8 src:8 @@ -3507,42 +3520,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) NEXT (1); \ } while (0) - VM_DEFINE_OP (119, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (120, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8)) BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1); - VM_DEFINE_OP (120, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (121, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8)) BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1); - VM_DEFINE_OP (121, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (122, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8)) BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2); - VM_DEFINE_OP (122, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (123, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8)) BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2); - VM_DEFINE_OP (123, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (124, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8)) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4); #else BV_INT_SET (u32, uint32, 4); #endif - VM_DEFINE_OP (124, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (125, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8)) #if SIZEOF_VOID_P > 4 BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4); #else BV_INT_SET (s32, int32, 4); #endif - VM_DEFINE_OP (125, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (126, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8)) BV_INT_SET (u64, uint64, 8); - VM_DEFINE_OP (126, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (127, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8)) BV_INT_SET (s64, int64, 8); - VM_DEFINE_OP (127, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (128, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8)) BV_FLOAT_SET (f32, ieee_single, float, 4); - VM_DEFINE_OP (128, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (129, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8)) BV_FLOAT_SET (f64, ieee_double, double, 8); END_DISPATCH_SWITCH; diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test index 47202c2ad..ce0a0c2c9 100644 --- a/test-suite/tests/rtl.test +++ b/test-suite/tests/rtl.test @@ -145,7 +145,9 @@ '((begin-program call ((name . call))) (begin-standard-arity (f) 2 #f) - (call 2 1 ()) + (push-frame 2 1) + (mov 5 1) + (call 2) (return 2) ;; MVRA from call (return 2) ;; RA from call (end-arity) @@ -158,10 +160,12 @@ '((begin-program call-with-3 ((name . call-with-3))) (begin-standard-arity (f) 3 #f) - (load-constant 2 3) - (call 3 1 (2)) - (return 3) ;; MVRA from call - (return 3) ;; RA from call + (push-frame 2 2) + (mov 5 1) + (load-constant 6 3) + (call 2) + (return 2) ;; MVRA from call + (return 2) ;; RA from call (end-arity) (end-program))))) (call-with-3 (lambda (x) (* x 2))))))