VM has "builtins": primitives addressable by emitted RTL code
authorAndy Wingo <wingo@pobox.com>
Sun, 20 Oct 2013 13:49:22 +0000 (15:49 +0200)
committerAndy Wingo <wingo@pobox.com>
Sun, 27 Oct 2013 19:09:01 +0000 (20:09 +0100)
* libguile/Makefile.am:
* libguile/vm-builtins.h: New header, declaring stubs needed by the
  compiler like values, apply, and abort-to-prompt.

* libguile/vm.c: Adapt the apply and values stubs to conform to a
  standard interface.  Add an abort-to-prompt stub.  Add call/cc and
  call-with-values stubs.
  (scm_vm_builtin_ref): New helper, for the builtin-ref opcode.
  (scm_vm_builtin_name_to_index)
  (scm_vm_builtin_index_to_name): New helpers, for the compiler and
  disassembler, respectively.
  (scm_init_vm_builtins, scm_bootstrap_vm): Allow the compiler helpers
  to be loaded later into a module.
* module/language/rtl.scm: Export builtin-index->name and
  builtin-name->index.

* libguile/vm-engine.c (RETURN_VALUE_LIST): Update to use new names of
  "apply" and "values".
  (tail-call/shuffle): New opcode.
  (abort): Update to be a tail VM op, and reorder and renumber other
  ops.
  (builtin-ref): New opcode.

* libguile/continuations.h:
* libguile/continuations.c (scm_i_call_with_current_continuation):
  Move this to vm.[ch], implemented as a builtin.

* module/language/tree-il/compile-cps.scm (convert): Convert to
  'abort-to-prompt calls, possibly with 'apply, effectively undoing the
  tree-il transformation.

* module/language/cps/reify-primitives.scm (builtin-ref): New helper.
  (reify-primitives): Convert builtin primitives to builtin-ref.

* module/language/cps/dfg.scm (constant-needs-allocation?):
* module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add support
  for compiling builtin-ref.

* module/system/vm/disassembler.scm (code-annotation): Add annotation
  for builtin-ref.

13 files changed:
libguile/Makefile.am
libguile/continuations.c
libguile/continuations.h
libguile/vm-builtins.h [new file with mode: 0644]
libguile/vm-engine.c
libguile/vm.c
libguile/vm.h
module/language/cps/compile-rtl.scm
module/language/cps/dfg.scm
module/language/cps/reify-primitives.scm
module/language/rtl.scm
module/language/tree-il/compile-cps.scm
module/system/vm/disassembler.scm

index ce437e4..e3a9e00 100644 (file)
@@ -639,6 +639,7 @@ modinclude_HEADERS =                                \
        values.h                                \
        variable.h                              \
        vectors.h                               \
+       vm-builtins.h                           \
        vm-expand.h                             \
        vm.h                                    \
        vports.h                                \
index 58a1936..21fc5e2 100644 (file)
@@ -68,15 +68,6 @@ static const scm_t_uint32 continuation_stub_code[] =
     SCM_PACK_RTL_24 (scm_rtl_op_continuation_call, 0)
   };
 
-/* Before Scheme's call/cc is compiled, eval.c will use this hand-coded
-   call/cc. */
-
-static const scm_t_uint32 call_cc_code[] =
-  {
-    SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, 2),
-    SCM_PACK_RTL_24 (scm_rtl_op_call_cc, 0)
-  };
-
 static SCM
 make_continuation_trampoline (SCM contregs)
 {
@@ -174,17 +165,6 @@ scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
 }
 #undef FUNC_NAME
 
-SCM
-scm_i_call_with_current_continuation (SCM proc)
-{
-  static SCM call_cc = SCM_BOOL_F;
-
-  if (scm_is_false (call_cc))
-    call_cc = scm_i_make_rtl_program (call_cc_code);
-  
-  return scm_call_1 (call_cc, proc);
-}
-
 SCM
 scm_i_continuation_to_frame (SCM continuation)
 {
index e7fa16d..ca658bd 100644 (file)
@@ -74,8 +74,6 @@ SCM_INTERNAL SCM scm_i_make_continuation (int *first, SCM vm, SCM vm_cont);
 SCM_INTERNAL void scm_i_check_continuation (SCM cont);
 SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont);
 
-SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
-
 SCM_INTERNAL SCM scm_i_continuation_to_frame (SCM cont);
 SCM_INTERNAL SCM scm_i_contregs_vm (SCM contregs);
 SCM_INTERNAL SCM scm_i_contregs_vm_cont (SCM contregs);
diff --git a/libguile/vm-builtins.h b/libguile/vm-builtins.h
new file mode 100644 (file)
index 0000000..c51174c
--- /dev/null
@@ -0,0 +1,46 @@
+/* Copyright (C) 2013 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_VM_BUILTINS_H_
+#define _SCM_VM_BUILTINS_H_
+
+#ifdef BUILDING_LIBGUILE
+
+#define FOR_EACH_VM_BUILTIN(M) \
+  M(apply, APPLY) \
+  M(values, VALUES) \
+  M(abort_to_prompt, ABORT_TO_PROMPT) \
+  M(call_with_values, CALL_WITH_VALUES) \
+  M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION)
+
+/* These enumerated values are embedded in RTL code, and as such are
+   part of Guile's ABI.  */
+enum scm_vm_builtins
+{
+#define ENUM(builtin, BUILTIN) SCM_VM_BUILTIN_##BUILTIN,
+  FOR_EACH_VM_BUILTIN(ENUM)
+#undef ENUM
+  SCM_VM_BUILTIN_COUNT
+};
+
+SCM_INTERNAL SCM scm_vm_builtin_name_to_index (SCM name);
+SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx);
+
+#endif /* BUILDING_LIBGUILE */
+
+#endif /* _SCM_VM_BUILTINS_H_ */
index 3e68c50..978ec6b 100644 (file)
@@ -659,11 +659,11 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   do {                                                  \
     SCM vals = vals_;                                   \
     VM_HANDLE_INTERRUPTS;                               \
-    fp[-1] = rtl_apply;                                 \
-    fp[0] = rtl_values;                                 \
+    fp[-1] = vm_builtin_apply;                          \
+    fp[0] = vm_builtin_values;                          \
     fp[1] = vals;                                       \
     RESET_FRAME (3);                                    \
-    ip = (scm_t_uint32 *) rtl_apply_code;               \
+    ip = (scm_t_uint32 *) vm_builtin_apply_code;        \
     goto op_tail_apply;                                 \
   } while (0)
 
@@ -1022,7 +1022,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
   /* tail-call nlocals:24
    *
    * Tail-call a procedure.  Requires that the procedure and all of the
-   * arguments have already been shuffled into position.
+   * arguments have already been shuffled into position.  Will reset the
+   * frame to NLOCALS.
    */
   VM_DEFINE_OP (2, tail_call, "tail-call", OP1 (U8_U24))
     {
@@ -1033,6 +1034,39 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       VM_HANDLE_INTERRUPTS;
 
       RESET_FRAME (nlocals);
+
+      APPLY_HOOK ();
+
+      if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+        goto apply;
+
+      ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+      NEXT (0);
+    }
+
+  /* tail-call/shuffle from:24
+   *
+   * Tail-call a procedure.  The procedure should already be set to slot
+   * 0.  The rest of the args are taken from the frame, starting at
+   * FROM, shuffled down to start at slot 0.  This is part of the
+   * implementation of the call-with-values builtin.
+   */
+  VM_DEFINE_OP (3, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24))
+    {
+      scm_t_uint32 n, from, nlocals;
+
+      SCM_UNPACK_RTL_24 (op, from);
+
+      VM_HANDLE_INTERRUPTS;
+
+      VM_ASSERT (from > 0, abort ());
+      nlocals = FRAME_LOCALS_COUNT ();
+
+      for (n = 0; from + n < nlocals; n++)
+        LOCAL_SET (n + 1, LOCAL_REF (from + n));
+
+      RESET_FRAME (n + 1);
+
       APPLY_HOOK ();
 
       if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
@@ -1048,7 +1082,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * PROC, asserting that the call actually returned at least one
    * value.  Afterwards, resets the frame to NLOCALS locals.
    */
-  VM_DEFINE_OP (3, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
+  VM_DEFINE_OP (4, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
     {
       scm_t_uint16 dst, proc;
       scm_t_uint32 nlocals;
@@ -1068,7 +1102,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * return values equals NVALUES exactly.  After receive-values has
    * run, the values can be copied down via `mov'.
    */
-  VM_DEFINE_OP (4, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
+  VM_DEFINE_OP (5, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
     {
       scm_t_uint32 proc, nvalues;
       SCM_UNPACK_RTL_24 (op, proc);
@@ -1086,7 +1120,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);
@@ -1101,7 +1135,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * shuffled down to a contiguous array starting at slot 1.
    * We also expect the frame has already been reset.
    */
-  VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_X24))
+  VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
     {
       scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT();
       SCM *base = fp;
@@ -1134,7 +1168,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;
@@ -1204,7 +1238,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;
@@ -1238,7 +1272,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;
@@ -1267,7 +1301,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;
@@ -1291,7 +1325,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, tail_apply, "tail-apply", OP1 (U8_X24))
+  VM_DEFINE_OP (12, tail_apply, "tail-apply", OP1 (U8_X24))
     {
       int i, list_idx, list_len, nlocals;
       SCM list;
@@ -1336,7 +1370,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * local slot 1 to it.  This instruction is part of the implementation
    * of `call/cc', and is not generated by the compiler.
    */
-  VM_DEFINE_OP (12, call_cc, "call/cc", OP1 (U8_X24))
+  VM_DEFINE_OP (13, call_cc, "call/cc", OP1 (U8_X24))
     {
       SCM vm_cont, cont;
       scm_t_dynstack *dynstack;
@@ -1382,6 +1416,39 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
         }
     }
 
+  /* abort _:24
+   *
+   * Abort to a prompt handler.  The tag is expected in r1, and the rest
+   * of the values in the frame are returned to the prompt handler.
+   * This corresponds to a tail application of abort-to-prompt.
+   */
+  VM_DEFINE_OP (14, abort, "abort", OP1 (U8_X24))
+    {
+      scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
+
+      ASSERT (nlocals >= 2);
+      SYNC_IP ();
+      vm_abort (vm, LOCAL_REF (1), nlocals - 2, &LOCAL_REF (2),
+                SCM_EOL, &LOCAL_REF (1), &registers);
+
+      /* vm_abort should not return */
+      abort ();
+    }
+
+  /* builtin-ref dst:12 idx:12
+   *
+   * Load a builtin stub by index into DST.
+   */
+  VM_DEFINE_OP (15, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
+    {
+      scm_t_uint16 dst, idx;
+
+      SCM_UNPACK_RTL_12_12 (op, dst, idx);
+      LOCAL_SET (dst, scm_vm_builtin_ref (idx));
+
+      NEXT (1);
+    }
+
 
   \f
 
@@ -1397,15 +1464,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 (13, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
+  VM_DEFINE_OP (16, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
     {
       BR_NARGS (!=);
     }
-  VM_DEFINE_OP (14, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
+  VM_DEFINE_OP (17, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
     {
       BR_NARGS (<);
     }
-  VM_DEFINE_OP (15, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
+  VM_DEFINE_OP (18, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
     {
       BR_NARGS (>);
     }
@@ -1417,7 +1484,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 (16, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
+  VM_DEFINE_OP (19, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
     {
       scm_t_uint32 expected;
       SCM_UNPACK_RTL_24 (op, expected);
@@ -1425,7 +1492,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 (17, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
+  VM_DEFINE_OP (20, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
     {
       scm_t_uint32 expected;
       SCM_UNPACK_RTL_24 (op, expected);
@@ -1433,7 +1500,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_le, "assert-nargs-le", OP1 (U8_U24))
+  VM_DEFINE_OP (21, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
     {
       scm_t_uint32 expected;
       SCM_UNPACK_RTL_24 (op, expected);
@@ -1448,7 +1515,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 (19, alloc_frame, "alloc-frame", OP1 (U8_U24))
+  VM_DEFINE_OP (22, alloc_frame, "alloc-frame", OP1 (U8_U24))
     {
       scm_t_uint32 nlocals, nargs;
       SCM_UNPACK_RTL_24 (op, nlocals);
@@ -1467,7 +1534,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * Used to reset the frame size to something less than the size that
    * was previously set via alloc-frame.
    */
-  VM_DEFINE_OP (20, reset_frame, "reset-frame", OP1 (U8_U24))
+  VM_DEFINE_OP (23, reset_frame, "reset-frame", OP1 (U8_U24))
     {
       scm_t_uint32 nlocals;
       SCM_UNPACK_RTL_24 (op, nlocals);
@@ -1480,7 +1547,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 (24, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
     {
       scm_t_uint16 expected, nlocals;
       SCM_UNPACK_RTL_12_12 (op, expected, nlocals);
@@ -1505,7 +1572,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 (25, 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;
@@ -1591,7 +1658,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 (26, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
     {
       scm_t_uint32 dst, nargs;
       SCM rest = SCM_EOL;
@@ -1633,7 +1700,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 (24, br, "br", OP1 (U8_L24))
+  VM_DEFINE_OP (27, br, "br", OP1 (U8_L24))
     {
       scm_t_int32 offset = op;
       offset >>= 8; /* Sign-extending shift. */
@@ -1645,7 +1712,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 (25, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (28, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_true (x));
     }
@@ -1655,7 +1722,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 (26, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (29, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_null (x));
     }
@@ -1665,7 +1732,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 (27, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (30, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_lisp_false (x));
     }
@@ -1675,7 +1742,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 (28, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (31, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_pair (x));
     }
@@ -1685,7 +1752,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 (29, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (32, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, SCM_STRUCTP (x));
     }
@@ -1695,7 +1762,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 (30, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
+  VM_DEFINE_OP (33, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, SCM_CHARP (x));
     }
@@ -1705,7 +1772,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 (31, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
+  VM_DEFINE_OP (34, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
     {
       BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
     }
@@ -1715,7 +1782,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 (32, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (35, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y, scm_is_eq (x, y));
     }
@@ -1725,7 +1792,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 (33, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (36, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y,
                  scm_is_eq (x, y)
@@ -1740,7 +1807,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 (34, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (37, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y,
                  scm_is_eq (x, y)
@@ -1753,7 +1820,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 (35, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (38, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_ARITHMETIC (==, scm_num_eq_p);
     }
@@ -1763,7 +1830,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_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (39, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_ARITHMETIC (<, scm_less_p);
     }
@@ -1773,7 +1840,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_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
+  VM_DEFINE_OP (40, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_ARITHMETIC (<=, scm_leq_p);
     }
@@ -1789,7 +1856,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 (38, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (41, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst;
       scm_t_uint16 src;
@@ -1804,7 +1871,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 (39, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
+  VM_DEFINE_OP (42, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
     {
       scm_t_uint32 dst;
       scm_t_uint32 src;
@@ -1820,7 +1887,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 (40, box, "box", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (43, box, "box", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
       SCM_UNPACK_RTL_12_12 (op, dst, src);
@@ -1833,7 +1900,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 (41, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (44, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
       SCM var;
@@ -1851,7 +1918,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 (42, box_set, "box-set!", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (45, box_set, "box-set!", OP1 (U8_U12_U12))
     {
       scm_t_uint16 dst, src;
       SCM var;
@@ -1870,7 +1937,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 (43, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
+  VM_DEFINE_OP (46, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
     {
       scm_t_uint32 dst, nfree, n;
       scm_t_int32 offset;
@@ -1894,7 +1961,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 (44, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
+  VM_DEFINE_OP (47, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
     {
       scm_t_uint16 dst, src;
       scm_t_uint32 idx;
@@ -1909,7 +1976,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 (45, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
+  VM_DEFINE_OP (48, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
     {
       scm_t_uint16 dst, src;
       scm_t_uint32 idx;
@@ -1932,7 +1999,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 (46, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
+  VM_DEFINE_OP (49, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
     {
       scm_t_uint8 dst;
       scm_t_bits val;
@@ -1947,7 +2014,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 (47, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
+  VM_DEFINE_OP (50, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
     {
       scm_t_uint8 dst;
       scm_t_bits val;
@@ -1962,7 +2029,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 (48, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
+  VM_DEFINE_OP (51, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
     {
       scm_t_uint8 dst;
       scm_t_bits val;
@@ -1993,7 +2060,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 (49, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
+  VM_DEFINE_OP (52, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
     {
       scm_t_uint32 dst;
       scm_t_int32 offset;
@@ -2022,7 +2089,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 (50, static_ref, "static-ref", OP2 (U8_U24, S32))
+  VM_DEFINE_OP (53, static_ref, "static-ref", OP2 (U8_U24, S32))
     {
       scm_t_uint32 dst;
       scm_t_int32 offset;
@@ -2045,7 +2112,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 (51, static_set, "static-set!", OP2 (U8_U24, LO32))
+  VM_DEFINE_OP (54, static_set, "static-set!", OP2 (U8_U24, LO32))
     {
       scm_t_uint32 src;
       scm_t_int32 offset;
@@ -2067,7 +2134,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 (52, link_procedure, "link-procedure!", OP2 (U8_U24, L32))
+  VM_DEFINE_OP (55, link_procedure, "link-procedure!", OP2 (U8_U24, L32))
     {
       scm_t_uint32 src;
       scm_t_int32 offset;
@@ -2122,7 +2189,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Store the current module in DST.
    */
-  VM_DEFINE_OP (53, current_module, "current-module", OP1 (U8_U24) | OP_DST)
+  VM_DEFINE_OP (56, current_module, "current-module", OP1 (U8_U24) | OP_DST)
     {
       scm_t_uint32 dst;
 
@@ -2139,7 +2206,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * Resolve SYM in the current module, and place the resulting variable
    * in DST.
    */
-  VM_DEFINE_OP (54, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
+  VM_DEFINE_OP (57, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
     {
       scm_t_uint32 dst;
       scm_t_uint32 sym;
@@ -2163,7 +2230,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 (55, define, "define", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (58, define, "define", OP1 (U8_U12_U12))
     {
       scm_t_uint16 sym, val;
       SCM_UNPACK_RTL_12_12 (op, sym, val);
@@ -2191,7 +2258,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * DST, and caching the resolved variable so that we will hit the cache next
    * time.
    */
-  VM_DEFINE_OP (56, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
+  VM_DEFINE_OP (59, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
     {
       scm_t_uint32 dst;
       scm_t_int32 var_offset;
@@ -2243,7 +2310,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * Like toplevel-box, except MOD-OFFSET points at the name of a module
    * instead of the module itself.
    */
-  VM_DEFINE_OP (57, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
+  VM_DEFINE_OP (60, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
     {
       scm_t_uint32 dst;
       scm_t_int32 var_offset;
@@ -2313,7 +2380,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * will expect a multiple-value return as if from a call with the
    * procedure at PROC-SLOT.
    */
-  VM_DEFINE_OP (58, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
+  VM_DEFINE_OP (61, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
     {
       scm_t_uint32 tag, proc_slot;
       scm_t_int32 offset;
@@ -2345,7 +2412,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 (59, wind, "wind", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (62, wind, "wind", OP1 (U8_U12_U12))
     {
       scm_t_uint16 winder, unwinder;
       SCM_UNPACK_RTL_12_12 (op, winder, unwinder);
@@ -2354,38 +2421,12 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       NEXT (1);
     }
 
-  /* abort tag:24 _:8 proc:24
-   *
-   * Return a number of values to a prompt handler.  The values are
-   * expected in a frame pushed on at PROC.
-   */
-  VM_DEFINE_OP (60, abort, "abort", OP2 (U8_U24, X8_U24))
-#if 0
-    {
-      scm_t_uint32 tag, from, nvalues;
-      SCM *base;
-
-      SCM_UNPACK_RTL_24 (op, tag);
-      SCM_UNPACK_RTL_24 (ip[1], from);
-      base = (fp - 1) + from + 3;
-      nvalues = FRAME_LOCALS_COUNT () - from - 3;
-
-      SYNC_IP ();
-      vm_abort (vm, LOCAL_REF (tag), base, nvalues, &registers);
-
-      /* vm_abort should not return */
-      abort ();
-    }
-#else
-  abort();
-#endif
-
   /* unwind _:24
    *
    * A normal exit from the dynamic extent of an expression. Pop the top
    * entry off of the dynamic stack.
    */
-  VM_DEFINE_OP (61, unwind, "unwind", OP1 (U8_X24))
+  VM_DEFINE_OP (63, unwind, "unwind", OP1 (U8_X24))
     {
       scm_dynstack_pop (&current_thread->dynstack);
       NEXT (1);
@@ -2397,7 +2438,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 (62, push_fluid, "push-fluid", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (64, push_fluid, "push-fluid", OP1 (U8_U12_U12))
     {
       scm_t_uint32 fluid, value;
 
@@ -2414,7 +2455,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 (63, pop_fluid, "pop-fluid", OP1 (U8_X24))
+  VM_DEFINE_OP (65, pop_fluid, "pop-fluid", OP1 (U8_X24))
     {
       /* This function must not allocate.  */
       scm_dynstack_unwind_fluid (&current_thread->dynstack,
@@ -2426,7 +2467,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 (64, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (66, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
       size_t num;
@@ -2459,7 +2500,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 (65, fluid_set, "fluid-set", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (67, fluid_set, "fluid-set", OP1 (U8_U12_U12))
     {
       scm_t_uint16 a, b;
       size_t num;
@@ -2492,7 +2533,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 (66, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (68, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (str);
       if (SCM_LIKELY (scm_is_string (str)))
@@ -2509,7 +2550,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 (67, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (69, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_signed_bits i = 0;
       ARGS2 (str, idx);
@@ -2531,7 +2572,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 (68, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (70, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
 
@@ -2547,7 +2588,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 (69, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (71, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
 
@@ -2561,7 +2602,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 (70, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (72, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, src;
       SCM_UNPACK_RTL_12_12 (op, dst, src);
@@ -2580,7 +2621,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 (71, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (73, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       RETURN (scm_cons (x, y));
@@ -2590,7 +2631,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Place the car of SRC in DST.
    */
-  VM_DEFINE_OP (72, car, "car", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (74, car, "car", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (x);
       VM_VALIDATE_PAIR (x, "car");
@@ -2601,7 +2642,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Place the cdr of SRC in DST.
    */
-  VM_DEFINE_OP (73, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (75, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (x);
       VM_VALIDATE_PAIR (x, "cdr");
@@ -2612,7 +2653,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Set the car of DST to SRC.
    */
-  VM_DEFINE_OP (74, set_car, "set-car!", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (76, set_car, "set-car!", OP1 (U8_U12_U12))
     {
       scm_t_uint16 a, b;
       SCM x, y;
@@ -2628,7 +2669,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Set the cdr of DST to SRC.
    */
-  VM_DEFINE_OP (75, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
+  VM_DEFINE_OP (77, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
     {
       scm_t_uint16 a, b;
       SCM x, y;
@@ -2651,7 +2692,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 (76, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (78, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       BINARY_INTEGER_OP (+, scm_sum);
     }
@@ -2660,7 +2701,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 (77, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (79, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (x);
 
@@ -2685,7 +2726,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 (78, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (80, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       BINARY_INTEGER_OP (-, scm_difference);
     }
@@ -2694,7 +2735,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 (79, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (81, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (x);
 
@@ -2719,7 +2760,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 (80, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (82, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       SYNC_IP ();
@@ -2730,7 +2771,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 (81, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (83, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       SYNC_IP ();
@@ -2741,7 +2782,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 (82, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (84, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       SYNC_IP ();
@@ -2752,7 +2793,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 (83, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (85, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       SYNC_IP ();
@@ -2763,7 +2804,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 (84, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (86, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       SYNC_IP ();
@@ -2774,7 +2815,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 (85, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (87, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2810,7 +2851,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 (86, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (88, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2824,7 +2865,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 (87, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (89, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2838,7 +2879,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 (88, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (90, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
       if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2852,7 +2893,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * 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 (89, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (91, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_uint8 dst, length, init;
 
@@ -2869,7 +2910,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * will have space for LENGTH slots, an immediate value.  They will be
    * filled with the value in slot INIT.
    */
-  VM_DEFINE_OP (90, constant_make_vector, "constant-make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (92, constant_make_vector, "constant-make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_uint8 dst, init;
       scm_t_int32 length, n;
@@ -2889,7 +2930,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 (91, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (93, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (vect);
       if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
@@ -2906,7 +2947,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 (92, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (94, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_signed_bits i = 0;
       ARGS2 (vect, idx);
@@ -2927,7 +2968,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 (93, constant_vector_ref, "constant-vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (95, constant_vector_ref, "constant-vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_uint8 dst, src, idx;
       SCM v;
@@ -2946,7 +2987,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 (94, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (96, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
     {
       scm_t_uint8 dst, idx_var, src;
       SCM vect, idx, val;
@@ -2975,7 +3016,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * Store SRC into the vector DST at index IDX.  Here IDX is an
    * immediate value.
    */
-  VM_DEFINE_OP (95, constant_vector_set, "constant-vector-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (97, constant_vector_set, "constant-vector-set!", OP1 (U8_U8_U8_U8))
     {
       scm_t_uint8 dst, idx, src;
       SCM vect, val;
@@ -3006,7 +3047,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Store the vtable of SRC into DST.
    */
-  VM_DEFINE_OP (96, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (98, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (obj);
       VM_VALIDATE_STRUCT (obj, "struct_vtable");
@@ -3019,7 +3060,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * will be constructed with space for NFIELDS fields, which should
    * correspond to the field count of the VTABLE.
    */
-  VM_DEFINE_OP (97, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (99, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_uint8 dst, vtable, nfields;
       SCM ret;
@@ -3038,7 +3079,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 (98, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (100, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (obj, pos);
 
@@ -3072,7 +3113,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 (99, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (101, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
     {
       scm_t_uint8 dst, idx, src;
       SCM obj, pos, val;
@@ -3113,7 +3154,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    *
    * Store the vtable of SRC into DST.
    */
-  VM_DEFINE_OP (100, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (102, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (obj);
       if (SCM_INSTANCEP (obj))
@@ -3128,7 +3169,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 (101, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (103, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       scm_t_uint8 dst, src, idx;
       SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
@@ -3142,7 +3183,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 (102, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (104, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
     {
       scm_t_uint8 dst, idx, src;
       SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
@@ -3163,7 +3204,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 (103, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
+  VM_DEFINE_OP (105, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
     {
       scm_t_uint8 dst, type, shape;
       scm_t_int32 offset;
@@ -3183,7 +3224,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 (104, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
+  VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
     {
       scm_t_uint16 dst, type, fill, bounds;
       SCM_UNPACK_RTL_12_12 (op, dst, type);
@@ -3281,42 +3322,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 (105, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (107, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
 
-  VM_DEFINE_OP (106, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (108, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FIXABLE_INT_REF (s8, s8, int8, 1);
 
-  VM_DEFINE_OP (107, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (109, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
 
-  VM_DEFINE_OP (108, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (110, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
 
-  VM_DEFINE_OP (109, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (111, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
 #if SIZEOF_VOID_P > 4
     BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
 #else
     BV_INT_REF (u32, uint32, 4);
 #endif
 
-  VM_DEFINE_OP (110, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (112, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
 #if SIZEOF_VOID_P > 4
     BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
 #else
     BV_INT_REF (s32, int32, 4);
 #endif
 
-  VM_DEFINE_OP (111, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (113, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_INT_REF (u64, uint64, 8);
 
-  VM_DEFINE_OP (112, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (114, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_INT_REF (s64, int64, 8);
 
-  VM_DEFINE_OP (113, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (115, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FLOAT_REF (f32, ieee_single, float, 4);
 
-  VM_DEFINE_OP (114, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+  VM_DEFINE_OP (116, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
     BV_FLOAT_REF (f64, ieee_double, double, 8);
 
   /* bv-u8-set! dst:8 idx:8 src:8
@@ -3420,42 +3461,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
     NEXT (1);                                                           \
   } while (0)
 
-  VM_DEFINE_OP (115, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (117, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
     BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
 
-  VM_DEFINE_OP (116, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (118, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
     BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
 
-  VM_DEFINE_OP (117, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (119, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
     BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
 
-  VM_DEFINE_OP (118, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (120, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
     BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
 
-  VM_DEFINE_OP (119, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (121, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
 #if SIZEOF_VOID_P > 4
     BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
 #else
     BV_INT_SET (u32, uint32, 4);
 #endif
 
-  VM_DEFINE_OP (120, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (122, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
 #if SIZEOF_VOID_P > 4
     BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
 #else
     BV_INT_SET (s32, int32, 4);
 #endif
 
-  VM_DEFINE_OP (121, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (123, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
     BV_INT_SET (u64, uint64, 8);
 
-  VM_DEFINE_OP (122, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (124, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
     BV_INT_SET (s64, int64, 8);
 
-  VM_DEFINE_OP (123, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (125, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
     BV_FLOAT_SET (f32, ieee_single, float, 4);
 
-  VM_DEFINE_OP (124, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
+  VM_DEFINE_OP (126, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
     BV_FLOAT_SET (f64, ieee_double, double, 8);
 
   END_DISPATCH_SWITCH;
index 5a2aef7..4154cfe 100644 (file)
@@ -36,6 +36,7 @@
 #include "objcodes.h"
 #include "programs.h"
 #include "vm.h"
+#include "vm-builtins.h"
 
 #include "private-gc.h" /* scm_getenv_int */
 
@@ -602,21 +603,120 @@ vm_error_bad_wide_string_length (size_t len)
 static SCM boot_continuation;
 
 static SCM rtl_boot_continuation;
-static SCM rtl_apply;
-static SCM rtl_values;
+static SCM vm_builtin_apply;
+static SCM vm_builtin_values;
+static SCM vm_builtin_abort_to_prompt;
+static SCM vm_builtin_call_with_values;
+static SCM vm_builtin_call_with_current_continuation;
 
 static const scm_t_uint32 rtl_boot_continuation_code[] = {
   SCM_PACK_RTL_24 (scm_rtl_op_halt, 0)
 };
 
-static const scm_t_uint32 rtl_apply_code[] = {
-  SCM_PACK_RTL_24 (scm_rtl_op_tail_apply, 0) /* proc in r1, args from r2, nargs set */
+static const scm_t_uint32 vm_builtin_apply_code[] = {
+  SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, 3),
+  SCM_PACK_RTL_24 (scm_rtl_op_tail_apply, 0), /* proc in r1, args from r2 */
 };
 
-static const scm_t_uint32 rtl_values_code[] = {
+static const scm_t_uint32 vm_builtin_values_code[] = {
   SCM_PACK_RTL_24 (scm_rtl_op_return_values, 0) /* vals from r1 */
 };
 
+static const scm_t_uint32 vm_builtin_abort_to_prompt_code[] = {
+  SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, 2),
+  SCM_PACK_RTL_24 (scm_rtl_op_abort, 0), /* tag in r1, vals from r2 */
+  /* FIXME: Partial continuation should capture caller regs.  */
+  SCM_PACK_RTL_24 (scm_rtl_op_return_values, 0) /* vals from r1 */
+};
+
+static const scm_t_uint32 vm_builtin_call_with_values_code[] = {
+  SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, 3),
+  SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, 7),
+  SCM_PACK_RTL_12_12 (scm_rtl_op_mov, 6, 1),
+  SCM_PACK_RTL_24 (scm_rtl_op_call, 6), SCM_PACK_RTL_24 (0, 1),
+  SCM_PACK_RTL_12_12 (scm_rtl_op_mov, 0, 2),
+  SCM_PACK_RTL_24 (scm_rtl_op_tail_call_shuffle, 7)
+};
+
+static const scm_t_uint32 vm_builtin_call_with_current_continuation_code[] = {
+  SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, 2),
+  SCM_PACK_RTL_24 (scm_rtl_op_call_cc, 0)
+};
+
+
+static SCM
+scm_vm_builtin_ref (unsigned idx)
+{
+  switch (idx)
+    {
+#define INDEX_TO_NAME(builtin, BUILTIN) \
+      case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin;
+      FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
+#undef INDEX_TO_NAME
+      default: abort();
+    }
+}
+
+static SCM scm_sym_values;
+static SCM scm_sym_abort_to_prompt;
+static SCM scm_sym_call_with_values;
+static SCM scm_sym_call_with_current_continuation;
+
+SCM
+scm_vm_builtin_name_to_index (SCM name)
+#define FUNC_NAME "builtin-name->index"
+{
+  SCM_VALIDATE_SYMBOL (1, name);
+
+#define NAME_TO_INDEX(builtin, BUILTIN)                 \
+  if (scm_is_eq (name, scm_sym_##builtin))              \
+    return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN);
+  FOR_EACH_VM_BUILTIN(NAME_TO_INDEX)
+#undef NAME_TO_INDEX
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM
+scm_vm_builtin_index_to_name (SCM index)
+#define FUNC_NAME "builtin-index->name"
+{
+  unsigned idx;
+
+  SCM_VALIDATE_UINT_COPY (1, index, idx);
+
+  switch (idx)
+    {
+#define INDEX_TO_NAME(builtin, BUILTIN) \
+      case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin;
+      FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
+#undef INDEX_TO_NAME
+      default: return SCM_BOOL_F;
+    }
+}
+#undef FUNC_NAME
+
+static void
+scm_init_vm_builtins (void)
+{
+  scm_sym_values = scm_from_utf8_symbol ("values");
+  scm_sym_abort_to_prompt = scm_from_utf8_symbol ("abort-to-prompt");
+  scm_sym_call_with_values = scm_from_utf8_symbol ("call-with-values");
+  scm_sym_call_with_current_continuation =
+    scm_from_utf8_symbol ("call-with-current-continuation");
+
+  scm_c_define_gsubr ("builtin-name->index", 1, 0, 0,
+                      scm_vm_builtin_name_to_index);
+  scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
+                      scm_vm_builtin_index_to_name);
+}
+
+SCM
+scm_i_call_with_current_continuation (SCM proc)
+{
+  return scm_call_1 (vm_builtin_call_with_current_continuation, proc);
+}
 
 \f
 /*
@@ -659,7 +759,7 @@ resolve_variable (SCM what, SCM module)
 }
   
 #define VM_MIN_STACK_SIZE      (1024)
-#define VM_DEFAULT_STACK_SIZE  (64 * 1024)
+#define VM_DEFAULT_STACK_SIZE  (256 * 1024)
 static size_t vm_stack_size = VM_DEFAULT_STACK_SIZE;
 
 static void
@@ -781,10 +881,10 @@ scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
 {
   struct scm_vm *vp = SCM_VM_DATA (vm);
   SCM_CHECK_STACK;
-  if (SCM_RTL_PROGRAM_P (program))
-    return rtl_vm_engines[vp->engine](vm, program, argv, nargs);
-  else
+  if (SCM_PROGRAM_P (program))
     return vm_engines[vp->engine](vm, program, argv, nargs);
+  else
+    return rtl_vm_engines[vp->engine](vm, program, argv, nargs);
 }
 
 /* Scheme interface */
@@ -1130,6 +1230,10 @@ scm_bootstrap_vm (void)
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_vm",
                             (scm_t_extension_init_func)scm_init_vm, NULL);
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_vm_builtins",
+                            (scm_t_extension_init_func)scm_init_vm_builtins,
+                            NULL);
 
   initialize_default_stack_size ();
 
@@ -1145,8 +1249,14 @@ scm_bootstrap_vm (void)
   SCM_SET_CELL_WORD_0 (rtl_boot_continuation,
                        (SCM_CELL_WORD_0 (rtl_boot_continuation)
                         | SCM_F_PROGRAM_IS_BOOT));
-  rtl_apply = scm_i_make_rtl_program (rtl_apply_code);
-  rtl_values = scm_i_make_rtl_program (rtl_values_code);
+  vm_builtin_apply = scm_i_make_rtl_program (vm_builtin_apply_code);
+  vm_builtin_values = scm_i_make_rtl_program (vm_builtin_values_code);
+  vm_builtin_abort_to_prompt =
+    scm_i_make_rtl_program (vm_builtin_abort_to_prompt_code);
+  vm_builtin_call_with_values =
+    scm_i_make_rtl_program (vm_builtin_call_with_values_code);
+  vm_builtin_call_with_current_continuation =
+    scm_i_make_rtl_program (vm_builtin_call_with_current_continuation_code);
 
 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
   vm_stack_gc_kind =
index c45d17f..80423ec 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -107,6 +107,7 @@ SCM_INTERNAL SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
 
 SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
                                   scm_print_state *pstate);
+SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
 SCM_INTERNAL SCM scm_i_capture_current_stack (void);
 SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
                                          scm_t_uint8 *ra, scm_t_uint8 *mvra,
index 341b715..26aa87b 100644 (file)
                   (emit-constant-vector-ref asm dst (slot vector) index)))
             (else
              (emit-vector-ref asm dst (slot vector) (slot index)))))
+          (($ $primcall 'builtin-ref (name))
+           (emit-builtin-ref asm dst (constant name)))
           (($ $primcall name args)
            ;; FIXME: Inline all the cases.
            (let ((inst (prim-rtl-instruction name)))
index ec558e9..45c5dd6 100644 (file)
               (not (and (eq? sym i) (immediate-u8? val))))
              (($ $primcall 'vector-set! (v i x))
               (not (and (eq? sym i) (immediate-u8? val))))
+             (($ $primcall 'builtin-ref (idx))
+              #f)
              (_ #t)))
          uses))))))
 
index 34700b1..5c2725f 100644 (file)
                 (build-cps-term
                   ($continue k ($primcall 'box-ref (box)))))))
 
+(define (builtin-ref idx k)
+  (let-gensyms (idx-sym)
+    (build-cps-term
+      ($letconst (('idx idx-sym idx))
+        ($continue k
+          ($primcall 'builtin-ref (idx-sym)))))))
+
 (define (reify-clause ktail)
   (let-gensyms (kclause kbody wna false str eol kthrow throw)
     (build-cps-cont
          ,(match exp
             (($ $prim name)
              (match (lookup-cont k conts)
-               (($ $kargs (_)) (primitive-ref name k))
+               (($ $kargs (_))
+                (cond
+                 ((builtin-name->index name)
+                  => (lambda (idx)
+                       (builtin-ref idx k)))
+                 (else (primitive-ref name k))))
                (_ (build-cps-term ($continue k ($void))))))
             (($ $fun)
              (build-cps-term ($continue k ,(visit-fun exp))))
                  (build-cps-term
                    ($letk ((k* #f ($kargs (v) (v)
                                     ($continue k ($call v args)))))
-                     ,(primitive-ref name k*)))))))
+                     ,(cond
+                       ((builtin-name->index name)
+                        => (lambda (idx)
+                             (builtin-ref idx k*)))
+                       (else (primitive-ref name k*)))))))))
             (_ term)))))
 
     (visit-fun fun)))
index d217517..8ec9fe2 100644 (file)
   #:use-module ((srfi srfi-1) #:select (fold))
   #:use-module (system vm instruction)
   #:re-export (rtl-instruction-list)
-  #:export (rtl-instruction-arity))
+  #:export (rtl-instruction-arity
+            builtin-name->index
+            builtin-index->name))
+
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_vm_builtins")
 
 (define (compute-rtl-instruction-arity name args)
   (define (first-word-arity word)
index f26b188..7ea82b4 100644 (file)
         k
         subst)))
 
+    (($ <abort> src tag args ($ <const> _ ()))
+     (convert-args (cons tag args)
+       (lambda (args*)
+         (build-cps-term
+           ($continue k ($primcall 'abort-to-prompt args*))))))
+
     (($ <abort> src tag args tail)
-     (convert-args (append (list tag) args (list tail))
+     (convert-args (append (list (make-primitive-ref #f 'abort-to-prompt)
+                                 tag)
+                           args
+                           (list tail))
        (lambda (args*)
-         (build-cps-term ($continue k ($primcall 'abort args*))))))
+         (build-cps-term
+           ($continue k ($primcall 'apply args*))))))
 
     (($ <conditional> src test consequent alternate)
      (let-gensyms (kif kt kf)
index a920923..f5f7b7f 100644 (file)
@@ -19,7 +19,7 @@
 ;;; Code:
 
 (define-module (system vm disassembler)
-  #:use-module (system vm instruction)
+  #:use-module (language rtl)
   #:use-module (system vm elf)
   #:use-module (system vm debug)
   #:use-module (system vm program)
@@ -250,6 +250,8 @@ address of that offset."
              nfree)))
     (('make-non-immediate dst target)
      (list "~@Y" (reference-scm target)))
+    (('builtin-ref dst idx)
+     (list "~A" (builtin-index->name idx)))
     (((or 'static-ref 'static-set!) _ target)
      (list "~@Y" (dereference-scm target)))
     (('link-procedure! src target)