guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-244-ga910918


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-244-ga910918
Date: Mon, 30 Apr 2012 18:37:34 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a91091808ffddf49d61419a0dc67f5a9ed15ae2b

The branch, wip-rtl has been updated
       via  a91091808ffddf49d61419a0dc67f5a9ed15ae2b (commit)
       via  c60b5479f67078c4cb4ca75c2c9f272b2bf97681 (commit)
       via  9cc0a430de026bccdaa71cd6d361ea2a8adfff5c (commit)
       via  8a00c2e680d3079c0082cc11a28f6f88d9ec940f (commit)
       via  287f348b423a7618d51732c10a0f0593ea38fd3b (commit)
      from  9d8a10a94c022e5fe4b58aa4b586eda514b1189f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit a91091808ffddf49d61419a0dc67f5a9ed15ae2b
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 30 20:26:24 2012 +0200

    temp

commit c60b5479f67078c4cb4ca75c2c9f272b2bf97681
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 30 20:26:09 2012 +0200

    fix peval test for recent merge
    
    * test-suite/tests/peval.test: Fix test for master.

commit 9cc0a430de026bccdaa71cd6d361ea2a8adfff5c
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 30 20:25:53 2012 +0200

    push error handlers out of line in the vm
    
    * libguile/vm.c:
      (vm_error):
      (vm_error_bad_instruction):
      (vm_error_unbound):
      (vm_error_unbound_fluid):
      (vm_error_not_a_variable):
      (vm_error_apply_to_non_list):
      (vm_error_kwargs_length_not_even):
      (vm_error_kwargs_invalid_keyword):
      (vm_error_kwargs_unrecognized_keyword):
      (vm_error_too_many_args):
      (vm_error_wrong_num_args):
      (vm_error_wrong_type_apply):
      (vm_error_stack_overflow):
      (vm_error_stack_underflow):
      (vm_error_improper_list):
      (vm_error_not_a_pair):
      (vm_error_not_a_bytevector):
      (vm_error_not_a_struct):
      (vm_error_no_values):
      (vm_error_not_enough_values):
      (vm_error_continuation_not_rewindable):
      (vm_error_bad_wide_string_length):
      (vm_error_invalid_address):
      (vm_error_object):
      (vm_error_free_variable): New internal helpers, implementing VM error
      handling.
    
    * libguile/vm-engine.h (VM_ASSERT): New helper macro.
      (ASSERT, CHECK_OBJECT, CHECK_FREE_VARIABLE, CHECK_OVERFLOW):
      (PRE_CHECK_UNDERFLOW, PUSH_LIST): Use the new helper.
    
    * libguile/vm-i-loader.c:
    * libguile/vm-i-scheme.c:
    * libguile/vm-i-system.c: Use VM_ASSERT and the out-of-line error
      handlers.
    
    * libguile/vm-engine.c (vm_engine): Remove inline error handlers, and
      remove a couple of local vars.  Use VM_ASSERT.  Have halt handle the
      return itself.

commit 8a00c2e680d3079c0082cc11a28f6f88d9ec940f
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 30 19:51:06 2012 +0200

    add internal SCM_NOINLINE definition
    
    * libguile/_scm.h (SCM_NOINLINE): New internal define, for things that
      we definitely don't want the compiler to inline.

commit 287f348b423a7618d51732c10a0f0593ea38fd3b
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 30 19:40:52 2012 +0200

    add scm_c_values helper
    
    * libguile/values.h:
    * libguile/values.c (scm_c_values): New public helper.

-----------------------------------------------------------------------

Summary of changes:
 libguile/Makefile.am                 |    6 +-
 libguile/_scm.h                      |    8 +
 libguile/values.c                    |   20 ++-
 libguile/values.h                    |    3 +-
 libguile/vm-engine.c                 |  294 ++++++++++++++++------------------
 libguile/vm-engine.h                 |   48 +++---
 libguile/vm-expand.h                 |    8 +
 libguile/vm-i-loader.c               |    9 +-
 libguile/vm-i-scheme.c               |   26 +---
 libguile/vm-i-system.c               |  151 ++++++++----------
 libguile/{vm-i-system.c => vm-ops.c} |  256 ++++++++++++++---------------
 libguile/vm.c                        |  278 ++++++++++++++++++++++++++++++++
 test-suite/tests/peval.test          |    4 +-
 13 files changed, 676 insertions(+), 435 deletions(-)
 copy libguile/{vm-i-system.c => vm-ops.c} (81%)

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 68d503e..e54d202 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -427,7 +427,7 @@ DOT_DOC_FILES =                             \
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 
-DOT_I_FILES = vm-i-system.i vm-i-scheme.i vm-i-loader.i
+DOT_I_FILES = vm-i-system.i vm-i-scheme.i vm-i-loader.i vm-ops.i
 
 .c.i:
        $(AM_V_GEN)$(GREP) '^VM_DEFINE' $< > $@
@@ -461,7 +461,7 @@ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c         
\
                 private-gc.h private-options.h
 
 # vm instructions
-noinst_HEADERS += vm-engine.c vm-i-system.c vm-i-scheme.c vm-i-loader.c
+noinst_HEADERS += vm-engine.c vm-i-system.c vm-i-scheme.c vm-i-loader.c 
vm-ops.c
 
 address@hidden@_la_DEPENDENCIES = @LIBLOBJS@
 
@@ -801,6 +801,6 @@ MOSTLYCLEANFILES = \
        scmconfig.h scmconfig.h.tmp
 
 CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi 
guile.texi \
-       vm-i-*.i
+       *.i
 
 MAINTAINERCLEANFILES = c-tokenize.c
diff --git a/libguile/_scm.h b/libguile/_scm.h
index c3384be..7dd188d 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -247,6 +247,14 @@ void scm_ia64_longjmp (scm_i_jmp_buf *, int);
 
 
 
+#if (defined __GNUC__)
+# define SCM_NOINLINE __attribute__ ((__noinline__))
+#else
+# define SCM_NOINLINE /* noinline */
+#endif
+
+
+
 /* The endianness marker in objcode.  */
 #ifdef WORDS_BIGENDIAN
 # define SCM_OBJCODE_ENDIANNESS "BE"
diff --git a/libguile/values.c b/libguile/values.c
index fdd9359..55577f2 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011 Free Software Foundation, 
Inc.
+/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011, 2012 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
@@ -108,14 +108,26 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
   if (n == 1)
     result = SCM_CAR (args);
   else
-    {
-      result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
-    }
+    result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
 
   return result;
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_values (SCM *base, size_t nvalues)
+{
+  SCM ret, *walk;
+
+  if (nvalues == 1)
+    return *base;
+
+  for (ret = SCM_EOL, walk = base + nvalues - 1; walk >= base; walk--)
+    ret = scm_cons (*walk, ret);
+
+  return scm_values (ret);
+}
+
 void
 scm_init_values (void)
 {
diff --git a/libguile/values.h b/libguile/values.h
index 5f79855..f11c9d9 100644
--- a/libguile/values.h
+++ b/libguile/values.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VALUES_H
 #define SCM_VALUES_H
 
-/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2000,2001, 2006, 2008, 2012 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
@@ -33,6 +33,7 @@ SCM_API SCM scm_values_vtable;
 SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2);
 
 SCM_API SCM scm_values (SCM args);
+SCM_API SCM scm_c_values (SCM *base, size_t nvalues);
 SCM_API SCM scm_c_value_ref (SCM values, size_t idx);
 SCM_INTERNAL void scm_init_values (void);
 
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 1d16ec4..6e57964 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -56,9 +56,6 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
 
   /* Internal variables */
   int nvalues = 0;
-  const char *func_name = NULL;         /* used for error reporting */
-  SCM finish_args;                      /* used both for returns: both in error
-                                           and normal situations */
   scm_i_jmp_buf registers;              /* used for prompts */
 
 #ifdef HAVE_LABELS_AS_VALUES
@@ -128,8 +125,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     PUSH (SCM_PACK (0)); /* mvra */
     PUSH (SCM_PACK (0)); /* ra */
     PUSH (prog);
-    if (SCM_UNLIKELY (sp + nargs >= stack_limit))
-      goto vm_error_too_many_args;
+    VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
     while (nargs--)
       PUSH (*argv++);
   }
@@ -154,171 +150,153 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
 #endif
 
   
- vm_done:
-  SYNC_ALL ();
-  return finish_args;
+ vm_error_bad_instruction:
+  vm_error_bad_instruction (ip[-1]);
 
-  /* Errors */
-  {
-    SCM err_msg;
-
-    /* FIXME: need to sync regs before allocating anything, in each case. */
-
-  vm_error_bad_instruction:
-    err_msg  = scm_from_latin1_string ("VM: Bad instruction: ~s");
-    finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
-    goto vm_error;
-
-  vm_error_unbound:
-    /* FINISH_ARGS should be the name of the unbound variable.  */
-    SYNC_ALL ();
-    err_msg = scm_from_latin1_string ("Unbound variable: ~s");
-    scm_error_scm (scm_misc_error_key, program, err_msg,
-                   scm_list_1 (finish_args), SCM_BOOL_F);
-    goto vm_error;
-
-  vm_error_unbound_fluid:
-    SYNC_ALL ();
-    err_msg = scm_from_latin1_string ("Unbound fluid: ~s");
-    scm_error_scm (scm_misc_error_key, program, err_msg,
-                   scm_list_1 (finish_args), SCM_BOOL_F);
-    goto vm_error;
-
-  vm_error_not_a_variable:
-    SYNC_ALL ();
-    scm_error (scm_arg_type_key, func_name, "Not a variable: ~S",
-               scm_list_1 (finish_args), scm_list_1 (finish_args));
-    goto vm_error;
-
-  vm_error_apply_to_non_list:
-    SYNC_ALL ();
-    scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
-               scm_list_1 (finish_args), scm_list_1 (finish_args));
-    goto vm_error;
-
-  vm_error_kwargs_length_not_even:
-    SYNC_ALL ();
-    err_msg = scm_from_latin1_string ("Odd length of keyword argument list");
-    scm_error_scm (sym_keyword_argument_error, program, err_msg,
-                   SCM_EOL, SCM_BOOL_F);
-
-  vm_error_kwargs_invalid_keyword:
-    /* FIXME say which one it was */
-    SYNC_ALL ();
-    err_msg = scm_from_latin1_string ("Invalid keyword");
-    scm_error_scm (sym_keyword_argument_error, program, err_msg,
-                   SCM_EOL, SCM_BOOL_F);
-
-  vm_error_kwargs_unrecognized_keyword:
-    /* FIXME say which one it was */
-    SYNC_ALL ();
-    err_msg = scm_from_latin1_string ("Unrecognized keyword");
-    scm_error_scm (sym_keyword_argument_error, program, err_msg,
-                   SCM_EOL, SCM_BOOL_F);
-
-  vm_error_too_many_args:
-    err_msg  = scm_from_latin1_string ("VM: Too many arguments");
-    finish_args = scm_list_1 (scm_from_int (nargs));
-    goto vm_error;
-
-  vm_error_wrong_num_args:
-    /* nargs and program are valid */
-    SYNC_ALL ();
-    scm_wrong_num_args (program);
-    /* shouldn't get here */
-    goto vm_error;
-
-  vm_error_wrong_type_apply:
-    SYNC_ALL ();
-    scm_error (scm_arg_type_key, NULL, "Wrong type to apply: ~S",
-               scm_list_1 (program), scm_list_1 (program));
-    goto vm_error;
-
-  vm_error_stack_overflow:
-    err_msg  = scm_from_latin1_string ("VM: Stack overflow");
-    finish_args = SCM_EOL;
-    if (stack_limit < vp->stack_base + vp->stack_size)
-      /* There are VM_STACK_RESERVE_SIZE bytes left.  Make them available so
-        that `throw' below can run on this VM.  */
-      vp->stack_limit = vp->stack_base + vp->stack_size;
-    goto vm_error;
-
-  vm_error_stack_underflow:
-    err_msg  = scm_from_latin1_string ("VM: Stack underflow");
-    finish_args = SCM_EOL;
-    goto vm_error;
-
-  vm_error_improper_list:
-    err_msg  = scm_from_latin1_string ("Expected a proper list, but got object 
with tail ~s");
-    goto vm_error;
-
-  vm_error_not_a_pair:
-    SYNC_ALL ();
-    scm_wrong_type_arg_msg (func_name, 1, finish_args, "pair");
-    /* shouldn't get here */
-    goto vm_error;
-
-  vm_error_not_a_bytevector:
-    SYNC_ALL ();
-    scm_wrong_type_arg_msg (func_name, 1, finish_args, "bytevector");
-    /* shouldn't get here */
-    goto vm_error;
-
-  vm_error_not_a_struct:
-    SYNC_ALL ();
-    scm_wrong_type_arg_msg (func_name, 1, finish_args, "struct");
-    /* shouldn't get here */
-    goto vm_error;
-
-  vm_error_no_values:
-    err_msg  = scm_from_latin1_string ("Zero values returned to single-valued 
continuation");
-    finish_args = SCM_EOL;
-    goto vm_error;
-
-  vm_error_not_enough_values:
-    err_msg  = scm_from_latin1_string ("Too few values returned to 
continuation");
-    finish_args = SCM_EOL;
-    goto vm_error;
-
-  vm_error_continuation_not_rewindable:
-    err_msg  = scm_from_latin1_string ("Unrewindable partial continuation");
-    finish_args = scm_cons (finish_args, SCM_EOL);
-    goto vm_error;
-
-  vm_error_bad_wide_string_length:
-    err_msg  = scm_from_latin1_string ("VM: Bad wide string length: ~S");
-    goto vm_error;
-
-#ifdef VM_CHECK_IP
-  vm_error_invalid_address:
-    err_msg  = scm_from_latin1_string ("VM: Invalid program address");
-    finish_args = SCM_EOL;
-    goto vm_error;
+  abort (); /* never reached */
+}
+
+#if 0
+#define RTL 1
+#define BYTE(x,n) (((x) >> ((n)*8)) & 0xff)
+#define OPERATOR()  (BYTE(op,0))
+#define OPERAND8(n) (BYTE(op,n+1))
+#define OPERAND16() (op >> 16)
+#define OPERAND24() (op >> 8)
+#define SOPERAND8() ((scm_t_int8) OPERAND8(op))
+#define SOPERAND16() ((scm_t_int16) OPERAND16(op))
+#define SOPERAND24() (((scm_t_int32) op) >> 8)
+
+static SCM
+scm_i_paste(rtl_,VM_NAME) (SCM vm, SCM program, SCM *argv, int nargs_)
+{
+  /* VM registers */
+  register scm_t_uint32 *ip IP_REG;    /* instruction pointer */
+  register SCM *fp FP_REG;             /* frame pointer */
+  register scm_t_uint32 op;
+  SCM *sp; /* Really, stack_top */
+
+  /* Indicates the number of arguments to a function, or the number of
+     values to a continuation.  In the JIT, this will be part of a
+     the calling convention.  For returns, it only gets set for MV
+     returns, not single-valued returns.  */
+  int nargs = 0;
+
+  /* Cached variables. */
+  struct scm_rtl_vm *vp = SCM_RTL_VM_DATA (vm);
+  SCM *stack_limit = vp->stack_limit;  /* stack limit address */
+  scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
+  scm_i_jmp_buf registers;              /* used for prompts */
+
+  /* Debugging variables */
+#ifdef VM_ENABLE_PARANOID_ASSERTIONS
+  scm_t_uint32 *ip_lower_bound;
+  scm_t_uint32 *ip_upper_bound;
 #endif
 
-#if VM_CHECK_OBJECT
-  vm_error_object:
-    err_msg = scm_from_latin1_string ("VM: Invalid object table access");
-    finish_args = SCM_EOL;
-    goto vm_error;
+#ifdef HAVE_LABELS_AS_VALUES
+  static const void **jump_table_pointer = NULL;
+#endif
+
+#ifdef HAVE_LABELS_AS_VALUES
+  register const void **jump_table JT_REG;
+
+  if (SCM_UNLIKELY (!jump_table_pointer))
+    {
+      int i;
+      jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*));
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+        jump_table_pointer[i] = &&vm_error_bad_instruction;
+#define VM_INSTRUCTION_TO_LABEL 1
+#define jump_table jump_table_pointer
+#include "vm-expand.h"
+#include "vm-ops.i"
+#undef jump_table
+#undef VM_INSTRUCTION_TO_LABEL
+    }
+
+  /* Attempt to keep JUMP_TABLE_POINTER in a register.  This saves one
+     load instruction at each instruction dispatch.  */
+  jump_table = jump_table_pointer;
 #endif
 
-#if VM_CHECK_FREE_VARIABLES
-  vm_error_free_variable:
-    err_msg = scm_from_latin1_string ("VM: Invalid free variable access");
-    finish_args = SCM_EOL;
-    goto vm_error;
+  if (nargs = SCM_I_SETJMP (registers))
+    {
+      /* Non-local return.  Cache the VM registers back from the vp, and
+         go to the handler.
+
+         Note, at this point, we must assume that any variable local to
+         vm_engine that can be assigned *has* been assigned. So we need to pull
+         all our state back from the ip/fp/sp.
+      */
+      nargs--;
+      CACHE_REGISTER ();
+      LOAD_IP_BOUNDS ();
+      /* The stack contains the values returned to this continuation,
+         along with a number-of-values marker -- like an MV return. */
+      ABORT_CONTINUATION_HOOK ();
+      NEXT;
+    }
+
+  /* Initialization */
+  {
+    SCM *base;
+
+    /* Load previous VM registers. */
+    CACHE_REGISTER ();
+
+    /* Check that we have enough space: 4 words for the boot program,
+       and 4 + nargs for the procedure application.  */
+    base = sp;
+    nargs = nargs_;
+    INCREMENT_SP (4 + 4 + nargs);
+
+    /* Initial frame: */
+    base[0] = SCM_PACK (fp); /* dynamic link */
+    base[1] = SCM_PACK (0); /* mvra */
+    base[2] = SCM_PACK (ip); /* ra */
+    base[3] = rtl_boot_program;
+    fp = &base[4];
+    ip = SCM_PROGRAM_ENTRY (rtl_boot_program);
+    LOAD_IP_BOUNDS ();
+    /* MV-call frame, function & arguments */
+    base[4] = SCM_PACK (0); /* dynamic link */
+    base[5] = SCM_PACK (0); /* mvra */
+    base[6] = SCM_PACK (0); /* ra */
+    base[7] = program;
+    {
+      int i;
+      for (i = 0; i < nargs; i++)
+        base[8 + i] = argv[i];
+    }
+  }
+
+  /* Let's go! */
+  NEXT;
+
+#ifndef HAVE_LABELS_AS_VALUES
+ vm_start:
+  op = *ip;
+  switch (OPERATOR()) {
 #endif
 
-  vm_error:
-    SYNC_ALL ();
+#include "vm-expand.h"
+#include "vm-ops.c"
 
-    scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args),
-               1);
+#ifndef HAVE_LABELS_AS_VALUES
+  default:
+    goto vm_error_bad_instruction;
   }
+#endif
+
+  
+ vm_error_bad_instruction:
+  vm_error_bad_instruction (ip[-1]);
 
   abort (); /* never reached */
 }
+#undef RTL
+#endif
 
 #undef VM_USE_HOOKS
 #undef VM_CHECK_OBJECT
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 000397d..9391ac7 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -103,8 +103,11 @@
  * Cache/Sync
  */
 
+#define VM_ASSERT(condition, handler) \
+  do { if (SCM_UNLIKELY (!(condition))) { SYNC_ALL(); handler; } } while (0)
+
 #ifdef VM_ENABLE_ASSERTIONS
-# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
+# define ASSERT(condition) VM_ASSERT (condition, abort())
 #else
 # define ASSERT(condition)
 #endif
@@ -191,18 +194,16 @@
 
 /* Accesses to a program's object table.  */
 #if VM_CHECK_OBJECT
-#define CHECK_OBJECT(_num) \
-  do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } 
while (0)
+#define CHECK_OBJECT(_num)                              \
+  VM_ASSERT ((_num) < object_count, vm_error_object ())
 #else
 #define CHECK_OBJECT(_num)
 #endif
 
 #if VM_CHECK_FREE_VARIABLES
-#define CHECK_FREE_VARIABLE(_num)                                       \
-  do {                                                                  \
-    if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
-      goto vm_error_free_variable;                                      \
-  } while (0)
+#define CHECK_FREE_VARIABLE(_num)                               \
+  VM_ASSERT ((_num) < SCM_PROGRAM_NUM_FREE_VARIABLES (program), \
+             vm_error_free_variable ())
 #else
 #define CHECK_FREE_VARIABLE(_num)
 #endif
@@ -276,21 +277,17 @@
 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 #endif
 
-#define CHECK_OVERFLOW()                       \
-  if (SCM_UNLIKELY (sp >= stack_limit))         \
-    goto vm_error_stack_overflow
+#define CHECK_OVERFLOW()                                                \
+  VM_ASSERT (sp < stack_limit, vm_error_stack_overflow (vp))
 
 
 #ifdef VM_CHECK_UNDERFLOW
-#define CHECK_UNDERFLOW()                       \
-  if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp)))        \
-    goto vm_error_stack_underflow
 #define PRE_CHECK_UNDERFLOW(N)                  \
-  if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp)))    \
-    goto vm_error_stack_underflow
+  VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow 
())
+#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
 #else
-#define CHECK_UNDERFLOW() /* nop */
 #define PRE_CHECK_UNDERFLOW(N) /* nop */
+#define CHECK_UNDERFLOW() /* nop */
 #endif
 
 
@@ -333,10 +330,7 @@ do                                         \
 {                                              \
   for (; scm_is_pair (l); l = SCM_CDR (l))      \
     PUSH (SCM_CAR (l));                         \
-  if (SCM_UNLIKELY (!NILP (l))) {               \
-    finish_args = scm_list_1 (l);               \
-    goto vm_error_improper_list;                \
-  }                                             \
+  VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
 } while (0)
 
 
@@ -376,9 +370,17 @@ do {                                               \
 
 #undef NEXT_JUMP
 #ifdef HAVE_LABELS_AS_VALUES
-#define NEXT_JUMP()            goto *jump_table[FETCH () & 
SCM_VM_INSTRUCTION_MASK]
+# ifdef RTL
+#  define NEXT_JUMP()          do { op = *ip; goto *jump_table[OPERAND(op)]; } 
while (0)
+# else
+#  define NEXT_JUMP()          goto *jump_table[FETCH () & 
SCM_VM_INSTRUCTION_MASK]
+# endif
 #else
-#define NEXT_JUMP()            goto vm_start
+# ifdef RTL
+#  define NEXT_JUMP()          do { op = *ip; goto vm_start; } while (0)
+# else
+#  define NEXT_JUMP()          goto vm_start
+# endif
 #endif
 
 #define NEXT                                   \
diff --git a/libguile/vm-expand.h b/libguile/vm-expand.h
index 787223d..c285ae6 100644
--- a/libguile/vm-expand.h
+++ b/libguile/vm-expand.h
@@ -31,6 +31,7 @@
 
 #undef VM_DEFINE_FUNCTION
 #undef VM_DEFINE_LOADER
+#undef VM_DEFINE_OP
 #define VM_DEFINE_FUNCTION(code,tag,name,nargs) \
   VM_DEFINE_INSTRUCTION(code,tag,name,0,nargs,1)
 #define VM_DEFINE_LOADER(code,tag,name)         \
@@ -47,6 +48,10 @@
   table[VM_OPCODE (tag_)].len = len_;                              \
   table[VM_OPCODE (tag_)].npop = npop_;                            \
   table[VM_OPCODE (tag_)].npush = npush_;
+#define VM_DEFINE_OP(code_, tag_, name_, len_) \
+  table[VM_OPCODE (tag_)].opcode = code_;                          \
+  table[VM_OPCODE (tag_)].name = name_;                            \
+  table[VM_OPCODE (tag_)].len = len_;
 
 #else
 #ifdef VM_INSTRUCTION_TO_LABEL
@@ -54,6 +59,7 @@
  * These will go to jump_table in vm_engine.c
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)    
jump_table[code] = VM_ADDR (tag);
+#define VM_DEFINE_OP(code, tag, name, len)                      
jump_table[code] = VM_ADDR (tag);
 
 #else
 #ifdef VM_INSTRUCTION_TO_OPCODE
@@ -61,12 +67,14 @@
  * These will go to scm_opcode in instructions.h
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)    VM_OPCODE (tag) 
= code,
+#define VM_DEFINE_OP(code, tag, name, len)                      VM_OPCODE 
(tag) = code,
 
 #else /* Otherwise */
 /*
  * These are directly included in vm_engine.c
  */
 #define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)    VM_TAG (tag)
+#define VM_DEFINE_OP(code,tag,name,len)                                VM_TAG 
(tag)
 
 #endif /* VM_INSTRUCTION_TO_OPCODE */
 #endif /* VM_INSTRUCTION_TO_LABEL */
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 6fa8eb2..c323156 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2008,2009,2010,2011,2012 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
@@ -105,11 +105,8 @@ VM_DEFINE_LOADER (107, load_wide_string, 
"load-wide-string")
   scm_t_wchar *wbuf;
 
   FETCH_LENGTH (len);
-  if (SCM_UNLIKELY (len % 4))
-    {
-      finish_args = scm_list_1 (scm_from_size_t (len));
-      goto vm_error_bad_wide_string_length;
-    }
+  VM_ASSERT ((len % 4) == 0,
+             vm_error_bad_wide_string_length (len));
 
   SYNC_REGISTER ();
   PUSH (scm_i_make_wide_string (len / 4, &wbuf, 1));
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 89c3555..0e39563 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012 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
@@ -136,11 +136,7 @@ VM_DEFINE_FUNCTION (142, cons, "cons", 2)
 }
 
 #define VM_VALIDATE_CONS(x, proc)              \
-  if (SCM_UNLIKELY (!scm_is_pair (x)))          \
-    { func_name = proc;                         \
-      finish_args = x;                          \
-      goto vm_error_not_a_pair;                 \
-    }
+  VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
   
 VM_DEFINE_FUNCTION (143, car, "car", 1)
 {
@@ -562,12 +558,7 @@ VM_DEFINE_INSTRUCTION (170, make_array, "make-array", 3, 
-1, 1)
  * Structs
  */
 #define VM_VALIDATE_STRUCT(obj, proc)           \
-  if (SCM_UNLIKELY (!SCM_STRUCTP (obj)))       \
-    {                                          \
-      func_name = proc;                         \
-      finish_args = (obj);                     \
-      goto vm_error_not_a_struct;              \
-    }
+  VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
 
 VM_DEFINE_FUNCTION (171, struct_p, "struct?", 1)
 {
@@ -713,16 +704,7 @@ VM_DEFINE_INSTRUCTION (178, slot_set, "slot-set", 0, 3, 0)
  * Bytevectors
  */
 #define VM_VALIDATE_BYTEVECTOR(x, proc)                \
-  do                                           \
-    {                                          \
-      if (SCM_UNLIKELY (!SCM_BYTEVECTOR_P (x)))        \
-       {                                       \
-          func_name = proc;                     \
-         finish_args = x;                      \
-         goto vm_error_not_a_bytevector;       \
-       }                                       \
-    }                                          \
-  while (0)
+  VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
 
 #define BV_REF_WITH_ENDIANNESS(stem, fn_stem)                           \
 {                                                                       \
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 7153ab5..b6c15d2 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -31,16 +31,20 @@ VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0)
 
 VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
 {
+  SCM ret;
+
   nvalues = SCM_I_INUM (*sp--);
   NULLSTACK (1);
+
   if (nvalues == 1)
-    POP (finish_args);
+    POP (ret);
   else
     {
-      POP_LIST (nvalues);
-      POP (finish_args);
       SYNC_REGISTER ();
-      finish_args = scm_values (finish_args);
+      sp -= nvalues;
+      CHECK_UNDERFLOW ();
+      ret = scm_c_values (sp + 1, nvalues);
+      NULLSTACK (nvalues);
     }
     
   {
@@ -58,7 +62,8 @@ VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
     NULLSTACK (old_sp - sp);
   }
   
-  goto vm_done;
+  SYNC_ALL ();
+  return ret;
 }
 
 VM_DEFINE_INSTRUCTION (2, drop, "drop", 0, 1, 0)
@@ -298,20 +303,16 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 
0, 1, 1)
      unlike in top-variable-ref, it really isn't an internal assertion
      that can be optimized out -- the variable could be coming directly
      from the user.  */
-  if (SCM_UNLIKELY (!SCM_VARIABLEP (x)))
-    {
-      func_name = "variable-ref";
-      finish_args = x;
-      goto vm_error_not_a_variable;
-    }
-  else if (SCM_UNLIKELY (!VARIABLE_BOUNDP (x)))
+  VM_ASSERT (SCM_VARIABLEP (x),
+             vm_error_not_a_variable ("variable-ref", x));
+
+  if (SCM_UNLIKELY (!VARIABLE_BOUNDP (x)))
     {
       SCM var_name;
 
       /* Attempt to provide the variable name in the error message.  */
       var_name = scm_module_reverse_lookup (scm_current_module (), x);
-      finish_args = scm_is_true (var_name) ? var_name : x;
-      goto vm_error_unbound;
+      vm_error_unbound (program, scm_is_true (var_name) ? var_name : x);
     }
   else
     {
@@ -326,14 +327,10 @@ VM_DEFINE_INSTRUCTION (26, variable_bound, 
"variable-bound?", 0, 1, 1)
 {
   SCM x = *sp;
   
-  if (SCM_UNLIKELY (!SCM_VARIABLEP (x)))
-    {
-      func_name = "variable-bound?";
-      finish_args = x;
-      goto vm_error_not_a_variable;
-    }
-  else
-    *sp = scm_from_bool (VARIABLE_BOUNDP (x));
+  VM_ASSERT (SCM_VARIABLEP (x),
+             vm_error_not_a_variable ("variable-bound?", x));
+
+  *sp = scm_from_bool (VARIABLE_BOUNDP (x));
   NEXT;
 }
 
@@ -348,11 +345,7 @@ VM_DEFINE_INSTRUCTION (27, toplevel_ref, "toplevel-ref", 
1, 0, 1)
     {
       SYNC_REGISTER ();
       resolved = resolve_variable (what, scm_program_module (program));
-      if (!VARIABLE_BOUNDP (resolved))
-        {
-          finish_args = what;
-          goto vm_error_unbound;
-        }
+      VM_ASSERT (VARIABLE_BOUNDP (resolved), vm_error_unbound (program, what));
       what = resolved;
       OBJECT_SET (objnum, what);
     }
@@ -374,11 +367,8 @@ VM_DEFINE_INSTRUCTION (28, long_toplevel_ref, 
"long-toplevel-ref", 2, 0, 1)
     {
       SYNC_REGISTER ();
       resolved = resolve_variable (what, scm_program_module (program));
-      if (!VARIABLE_BOUNDP (resolved))
-        {
-          finish_args = what;
-          goto vm_error_unbound;
-        }
+      VM_ASSERT (VARIABLE_BOUNDP (resolved),
+                 vm_error_unbound (program, what));
       what = resolved;
       OBJECT_SET (objnum, what);
     }
@@ -410,12 +400,8 @@ VM_DEFINE_INSTRUCTION (30, long_local_set, 
"long-local-set", 2, 1, 0)
 
 VM_DEFINE_INSTRUCTION (31, variable_set, "variable-set", 0, 2, 0)
 {
-  if (SCM_UNLIKELY (!SCM_VARIABLEP (sp[0])))
-    {
-      func_name = "variable-set!";
-      finish_args = sp[0];
-      goto vm_error_not_a_variable;
-    }
+  VM_ASSERT (SCM_VARIABLEP (sp[0]),
+             vm_error_not_a_variable ("variable-set!", sp[0]));
   VARIABLE_SET (sp[0], sp[-1]);
   DROPN (2);
   NEXT;
@@ -598,8 +584,8 @@ VM_DEFINE_INSTRUCTION (46, assert_nargs_ee, 
"assert-nargs-ee", 2, 0, 0)
   scm_t_ptrdiff n;
   n = FETCH () << 8;
   n += FETCH ();
-  if (sp - (fp - 1) != n)
-    goto vm_error_wrong_num_args;
+  VM_ASSERT (sp - (fp - 1) == n,
+             vm_error_wrong_num_args (program));
   NEXT;
 }
 
@@ -608,8 +594,8 @@ VM_DEFINE_INSTRUCTION (47, assert_nargs_ge, 
"assert-nargs-ge", 2, 0, 0)
   scm_t_ptrdiff n;
   n = FETCH () << 8;
   n += FETCH ();
-  if (sp - (fp - 1) < n)
-    goto vm_error_wrong_num_args;
+  VM_ASSERT (sp - (fp - 1) >= n,
+             vm_error_wrong_num_args (program));
   NEXT;
 }
 
@@ -679,9 +665,9 @@ VM_DEFINE_INSTRUCTION (50, bind_kwargs, "bind-kwargs", 5, 
0, 0)
   nkw += FETCH ();
   kw_and_rest_flags = FETCH ();
 
-  if (!(kw_and_rest_flags & F_REST)
-      && ((sp - (fp - 1) - nkw) % 2))
-    goto vm_error_kwargs_length_not_even;
+  VM_ASSERT ((kw_and_rest_flags & F_REST)
+             || ((sp - (fp - 1) - nkw) % 2) == 0,
+             vm_error_kwargs_length_not_even (program))
 
   CHECK_OBJECT (idx);
   kw = OBJECT_REF (idx);
@@ -703,13 +689,14 @@ VM_DEFINE_INSTRUCTION (50, bind_kwargs, "bind-kwargs", 5, 
0, 0)
                  break;
                }
            }
-         if (!(kw_and_rest_flags & F_ALLOW_OTHER_KEYS) && !scm_is_pair (walk))
-           goto vm_error_kwargs_unrecognized_keyword;
-
+          VM_ASSERT (scm_is_pair (walk)
+                     || (kw_and_rest_flags & F_ALLOW_OTHER_KEYS),
+                     vm_error_kwargs_unrecognized_keyword (program));
          nkw++;
        }
-      else if (!(kw_and_rest_flags & F_REST))
-        goto vm_error_kwargs_invalid_keyword;
+      else
+        VM_ASSERT (kw_and_rest_flags & F_REST,
+                   vm_error_kwargs_invalid_keyword (program));
     }
 
   NEXT;
@@ -808,7 +795,10 @@ VM_DEFINE_INSTRUCTION (55, call, "call", 1, -1, 1)
           goto vm_call;
         }
       else
-        goto vm_error_wrong_type_apply;
+        {
+          SYNC_ALL();
+          vm_error_wrong_type_apply (program);
+        }
     }
 
   CACHE_PROGRAM ();
@@ -856,7 +846,10 @@ VM_DEFINE_INSTRUCTION (56, tail_call, "tail-call", 1, -1, 
1)
           goto vm_tail_call;
         }
       else
-        goto vm_error_wrong_type_apply;
+        {
+          SYNC_ALL();
+          vm_error_wrong_type_apply (program);
+        }
     }
   else
     {
@@ -1003,10 +996,8 @@ VM_DEFINE_INSTRUCTION (61, partial_cont_call, 
"partial-cont-call", 0, -1, 0)
   SCM vmcont;
   POP (vmcont);
   SYNC_REGISTER ();
-  if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont)))
-    { finish_args = vmcont;
-      goto vm_error_continuation_not_rewindable;
-    }
+  VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
+             vm_error_continuation_not_rewindable (vmcont));
   vm_reinstate_partial_continuation (vm, vmcont, sp + 1 - fp, fp,
                                      &current_thread->dynstack,
                                      &registers);
@@ -1064,7 +1055,10 @@ VM_DEFINE_INSTRUCTION (64, mv_call, "mv-call", 4, -1, 1)
           goto vm_mv_call;
         }
       else
-        goto vm_error_wrong_type_apply;
+        {
+          SYNC_ALL();
+          vm_error_wrong_type_apply (program);
+        }
     }
 
   CACHE_PROGRAM ();
@@ -1098,12 +1092,8 @@ VM_DEFINE_INSTRUCTION (65, apply, "apply", 1, -1, 1)
   ASSERT (nargs >= 2);
 
   len = scm_ilength (ls);
-  if (SCM_UNLIKELY (len < 0))
-    {
-      finish_args = ls;
-      goto vm_error_apply_to_non_list;
-    }
-
+  VM_ASSERT (len >= 0,
+             vm_error_apply_to_non_list (ls));
   PUSH_LIST (ls, SCM_NULL_OR_NIL_P);
 
   nargs += len - 2;
@@ -1120,12 +1110,8 @@ VM_DEFINE_INSTRUCTION (66, tail_apply, "tail-apply", 1, 
-1, 1)
   ASSERT (nargs >= 2);
 
   len = scm_ilength (ls);
-  if (SCM_UNLIKELY (len < 0))
-    {
-      finish_args = ls;
-      goto vm_error_apply_to_non_list;
-    }
-
+  VM_ASSERT (len >= 0,
+             vm_error_apply_to_non_list (ls));
   PUSH_LIST (ls, SCM_NULL_OR_NIL_P);
 
   nargs += len - 2;
@@ -1296,7 +1282,10 @@ VM_DEFINE_INSTRUCTION (70, return_values, 
"return/values", 1, -1, -1)
       NULLSTACK (vals + nvalues - sp);
     }
   else
-    goto vm_error_no_values;
+    {
+      SYNC_ALL ();
+      vm_error_no_values ();
+    }
 
   /* Restore the last program */
   program = SCM_FRAME_PROGRAM (fp);
@@ -1320,10 +1309,7 @@ VM_DEFINE_INSTRUCTION (71, return_values_star, 
"return/values*", 1, -1, -1)
       l = SCM_CDR (l);
       nvalues++;
     }
-  if (SCM_UNLIKELY (!SCM_NULL_OR_NIL_P (l))) {
-    finish_args = scm_list_1 (l);
-    goto vm_error_improper_list;
-  }
+  VM_ASSERT (SCM_NULL_OR_NIL_P (l), vm_error_improper_list (l));
 
   goto vm_return_values;
 }
@@ -1349,8 +1335,7 @@ VM_DEFINE_INSTRUCTION (73, truncate_values, 
"truncate-values", 2, -1, -1)
   if (rest)
     nbinds--;
 
-  if (nvalues < nbinds)
-    goto vm_error_not_enough_values;
+  VM_ASSERT (nvalues >= nbinds, vm_error_not_enough_values ());
 
   if (rest)
     POP_LIST (nvalues - nbinds);
@@ -1542,8 +1527,7 @@ VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1)
 {
   unsigned n = FETCH ();
   SYNC_REGISTER ();
-  if (sp - n - 2 <= SCM_FRAME_UPPER_ADDRESS (fp))
-    goto vm_error_stack_underflow;
+  PRE_CHECK_UNDERFLOW (n + 2);
   vm_abort (vm, n, &registers);
   /* vm_abort should not return */
   abort ();
@@ -1597,11 +1581,8 @@ VM_DEFINE_INSTRUCTION (93, fluid_ref, "fluid-ref", 0, 1, 
1)
       SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
       if (scm_is_eq (val, SCM_UNDEFINED))
         val = SCM_I_FLUID_DEFAULT (*sp);
-      if (SCM_UNLIKELY (scm_is_eq (val, SCM_UNDEFINED)))
-        {
-          finish_args = *sp;
-          goto vm_error_unbound_fluid;
-        }
+      VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
+                 vm_error_unbound_fluid (program, *sp));
       *sp = val;
     }
   
@@ -1636,8 +1617,8 @@ VM_DEFINE_INSTRUCTION (95, assert_nargs_ee_locals, 
"assert-nargs-ee/locals", 1,
   /* nargs = n & 0x7, nlocs = nargs + (n >> 3) */
   n = FETCH ();
 
-  if (SCM_UNLIKELY (sp - (fp - 1) != (n & 0x7)))
-    goto vm_error_wrong_num_args;
+  VM_ASSERT (sp - (fp - 1) == (n & 0x7),
+             vm_error_wrong_num_args (program));
 
   old_sp = sp;
   sp += (n >> 3);
diff --git a/libguile/vm-i-system.c b/libguile/vm-ops.c
similarity index 81%
copy from libguile/vm-i-system.c
copy to libguile/vm-ops.c
index 7153ab5..329f885 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-ops.c
@@ -24,23 +24,16 @@
  * Basic operations
  */
 
-VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0)
+VM_DEFINE_OP (0, halt, "halt")
 {
-  NEXT;
-}
+  SCM ret;
 
-VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
-{
-  nvalues = SCM_I_INUM (*sp--);
-  NULLSTACK (1);
-  if (nvalues == 1)
-    POP (finish_args);
+  if (nargs == 1)
+    ret = LOCAL_REF (OPERAND24 ());
   else
     {
-      POP_LIST (nvalues);
-      POP (finish_args);
       SYNC_REGISTER ();
-      finish_args = scm_values (finish_args);
+      ret = scm_c_values (LOCAL_PTR (OPERAND24 ()), nargs);
     }
     
   {
@@ -58,16 +51,17 @@ VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
     NULLSTACK (old_sp - sp);
   }
   
-  goto vm_done;
+  SYNC_ALL ();
+  return ret;
 }
 
-VM_DEFINE_INSTRUCTION (2, drop, "drop", 0, 1, 0)
+VM_DEFINE_OP (2, drop, "drop", 0, 1, 0)
 {
   DROP ();
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (3, dup, "dup", 0, 0, 1)
+VM_DEFINE_OP (3, dup, "dup", 0, 0, 1)
 {
   SCM x = *sp;
   PUSH (x);
@@ -79,55 +73,55 @@ VM_DEFINE_INSTRUCTION (3, dup, "dup", 0, 0, 1)
  * Object creation
  */
 
-VM_DEFINE_INSTRUCTION (4, void, "void", 0, 0, 1)
+VM_DEFINE_OP (4, void, "void", 0, 0, 1)
 {
   PUSH (SCM_UNSPECIFIED);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (5, make_true, "make-true", 0, 0, 1)
+VM_DEFINE_OP (5, make_true, "make-true", 0, 0, 1)
 {
   PUSH (SCM_BOOL_T);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (6, make_false, "make-false", 0, 0, 1)
+VM_DEFINE_OP (6, make_false, "make-false", 0, 0, 1)
 {
   PUSH (SCM_BOOL_F);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (7, make_nil, "make-nil", 0, 0, 1)
+VM_DEFINE_OP (7, make_nil, "make-nil", 0, 0, 1)
 {
   PUSH (SCM_ELISP_NIL);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (8, make_eol, "make-eol", 0, 0, 1)
+VM_DEFINE_OP (8, make_eol, "make-eol", 0, 0, 1)
 {
   PUSH (SCM_EOL);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (9, make_int8, "make-int8", 1, 0, 1)
+VM_DEFINE_OP (9, make_int8, "make-int8", 1, 0, 1)
 {
   PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (10, make_int8_0, "make-int8:0", 0, 0, 1)
+VM_DEFINE_OP (10, make_int8_0, "make-int8:0", 0, 0, 1)
 {
   PUSH (SCM_INUM0);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (11, make_int8_1, "make-int8:1", 0, 0, 1)
+VM_DEFINE_OP (11, make_int8_1, "make-int8:1", 0, 0, 1)
 {
   PUSH (SCM_I_MAKINUM (1));
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (12, make_int16, "make-int16", 2, 0, 1)
+VM_DEFINE_OP (12, make_int16, "make-int16", 2, 0, 1)
 {
   int h = FETCH ();
   int l = FETCH ();
@@ -135,7 +129,7 @@ VM_DEFINE_INSTRUCTION (12, make_int16, "make-int16", 2, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (13, make_int64, "make-int64", 8, 0, 1)
+VM_DEFINE_OP (13, make_int64, "make-int64", 8, 0, 1)
 {
   scm_t_uint64 v = 0;
   v += FETCH ();
@@ -150,7 +144,7 @@ VM_DEFINE_INSTRUCTION (13, make_int64, "make-int64", 8, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (14, make_uint64, "make-uint64", 8, 0, 1)
+VM_DEFINE_OP (14, make_uint64, "make-uint64", 8, 0, 1)
 {
   scm_t_uint64 v = 0;
   v += FETCH ();
@@ -165,7 +159,7 @@ VM_DEFINE_INSTRUCTION (14, make_uint64, "make-uint64", 8, 
0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (15, make_char8, "make-char8", 1, 0, 1)
+VM_DEFINE_OP (15, make_char8, "make-char8", 1, 0, 1)
 {
   scm_t_uint8 v = 0;
   v = FETCH ();
@@ -177,7 +171,7 @@ VM_DEFINE_INSTRUCTION (15, make_char8, "make-char8", 1, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (16, make_char32, "make-char32", 4, 0, 1)
+VM_DEFINE_OP (16, make_char32, "make-char32", 4, 0, 1)
 {
   scm_t_wchar v = 0;
   v += FETCH ();
@@ -190,7 +184,7 @@ VM_DEFINE_INSTRUCTION (16, make_char32, "make-char32", 4, 
0, 1)
 
 
 
-VM_DEFINE_INSTRUCTION (17, list, "list", 2, -1, 1)
+VM_DEFINE_OP (17, list, "list", 2, -1, 1)
 {
   unsigned h = FETCH ();
   unsigned l = FETCH ();
@@ -199,7 +193,7 @@ VM_DEFINE_INSTRUCTION (17, list, "list", 2, -1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (18, vector, "vector", 2, -1, 1)
+VM_DEFINE_OP (18, vector, "vector", 2, -1, 1)
 {
   unsigned h = FETCH ();
   unsigned l = FETCH ();
@@ -239,7 +233,7 @@ VM_DEFINE_INSTRUCTION (18, vector, "vector", 2, -1, 1)
 
 /* ref */
 
-VM_DEFINE_INSTRUCTION (19, object_ref, "object-ref", 1, 0, 1)
+VM_DEFINE_OP (19, object_ref, "object-ref", 1, 0, 1)
 {
   register unsigned objnum = FETCH ();
   CHECK_OBJECT (objnum);
@@ -248,7 +242,7 @@ VM_DEFINE_INSTRUCTION (19, object_ref, "object-ref", 1, 0, 
1)
 }
 
 /* FIXME: necessary? elt 255 of the vector could be a vector... */
-VM_DEFINE_INSTRUCTION (20, long_object_ref, "long-object-ref", 2, 0, 1)
+VM_DEFINE_OP (20, long_object_ref, "long-object-ref", 2, 0, 1)
 {
   unsigned int objnum = FETCH ();
   objnum <<= 8;
@@ -258,14 +252,14 @@ VM_DEFINE_INSTRUCTION (20, long_object_ref, 
"long-object-ref", 2, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (21, local_ref, "local-ref", 1, 0, 1)
+VM_DEFINE_OP (21, local_ref, "local-ref", 1, 0, 1)
 {
   PUSH (LOCAL_REF (FETCH ()));
   ASSERT_BOUND (*sp);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (22, long_local_ref, "long-local-ref", 2, 0, 1)
+VM_DEFINE_OP (22, long_local_ref, "long-local-ref", 2, 0, 1)
 {
   unsigned int i = FETCH ();
   i <<= 8;
@@ -275,13 +269,13 @@ VM_DEFINE_INSTRUCTION (22, long_local_ref, 
"long-local-ref", 2, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (23, local_bound, "local-bound?", 1, 0, 1)
+VM_DEFINE_OP (23, local_bound, "local-bound?", 1, 0, 1)
 {
   PUSH (scm_from_bool (!scm_is_eq (LOCAL_REF (FETCH ()), SCM_UNDEFINED)));
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (24, long_local_bound, "long-local-bound?", 2, 0, 1)
+VM_DEFINE_OP (24, long_local_bound, "long-local-bound?", 2, 0, 1)
 {
   unsigned int i = FETCH ();
   i <<= 8;
@@ -290,7 +284,7 @@ VM_DEFINE_INSTRUCTION (24, long_local_bound, 
"long-local-bound?", 2, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 0, 1, 1)
+VM_DEFINE_OP (25, variable_ref, "variable-ref", 0, 1, 1)
 {
   SCM x = *sp;
 
@@ -322,7 +316,7 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 0, 
1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (26, variable_bound, "variable-bound?", 0, 1, 1)
+VM_DEFINE_OP (26, variable_bound, "variable-bound?", 0, 1, 1)
 {
   SCM x = *sp;
   
@@ -337,7 +331,7 @@ VM_DEFINE_INSTRUCTION (26, variable_bound, 
"variable-bound?", 0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (27, toplevel_ref, "toplevel-ref", 1, 0, 1)
+VM_DEFINE_OP (27, toplevel_ref, "toplevel-ref", 1, 0, 1)
 {
   unsigned objnum = FETCH ();
   SCM what, resolved;
@@ -361,7 +355,7 @@ VM_DEFINE_INSTRUCTION (27, toplevel_ref, "toplevel-ref", 1, 
0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (28, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
+VM_DEFINE_OP (28, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
 {
   SCM what, resolved;
   unsigned int objnum = FETCH ();
@@ -389,7 +383,7 @@ VM_DEFINE_INSTRUCTION (28, long_toplevel_ref, 
"long-toplevel-ref", 2, 0, 1)
 
 /* set */
 
-VM_DEFINE_INSTRUCTION (29, local_set, "local-set", 1, 1, 0)
+VM_DEFINE_OP (29, local_set, "local-set", 1, 1, 0)
 {
   SCM x;
   POP (x);
@@ -397,7 +391,7 @@ VM_DEFINE_INSTRUCTION (29, local_set, "local-set", 1, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (30, long_local_set, "long-local-set", 2, 1, 0)
+VM_DEFINE_OP (30, long_local_set, "long-local-set", 2, 1, 0)
 {
   SCM x;
   unsigned int i = FETCH ();
@@ -408,7 +402,7 @@ VM_DEFINE_INSTRUCTION (30, long_local_set, 
"long-local-set", 2, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (31, variable_set, "variable-set", 0, 2, 0)
+VM_DEFINE_OP (31, variable_set, "variable-set", 0, 2, 0)
 {
   if (SCM_UNLIKELY (!SCM_VARIABLEP (sp[0])))
     {
@@ -421,7 +415,7 @@ VM_DEFINE_INSTRUCTION (31, variable_set, "variable-set", 0, 
2, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (32, toplevel_set, "toplevel-set", 1, 1, 0)
+VM_DEFINE_OP (32, toplevel_set, "toplevel-set", 1, 1, 0)
 {
   unsigned objnum = FETCH ();
   SCM what;
@@ -440,7 +434,7 @@ VM_DEFINE_INSTRUCTION (32, toplevel_set, "toplevel-set", 1, 
1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (33, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
+VM_DEFINE_OP (33, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
 {
   SCM what;
   unsigned int objnum = FETCH ();
@@ -486,7 +480,7 @@ VM_DEFINE_INSTRUCTION (33, long_toplevel_set, 
"long-toplevel-set", 2, 1, 0)
   NEXT;                                                \
 }
 
-VM_DEFINE_INSTRUCTION (34, br, "br", 3, 0, 0)
+VM_DEFINE_OP (34, br, "br", 3, 0, 0)
 {
   scm_t_int32 offset;
   FETCH_OFFSET (offset);
@@ -496,56 +490,56 @@ VM_DEFINE_INSTRUCTION (34, br, "br", 3, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (35, br_if, "br-if", 3, 0, 0)
+VM_DEFINE_OP (35, br_if, "br-if", 3, 0, 0)
 {
   SCM x;
   POP (x);
   BR (scm_is_true (x));
 }
 
-VM_DEFINE_INSTRUCTION (36, br_if_not, "br-if-not", 3, 0, 0)
+VM_DEFINE_OP (36, br_if_not, "br-if-not", 3, 0, 0)
 {
   SCM x;
   POP (x);
   BR (scm_is_false (x));
 }
 
-VM_DEFINE_INSTRUCTION (37, br_if_eq, "br-if-eq", 3, 0, 0)
+VM_DEFINE_OP (37, br_if_eq, "br-if-eq", 3, 0, 0)
 {
   SCM x, y;
   POP2 (y, x);
   BR (scm_is_eq (x, y));
 }
 
-VM_DEFINE_INSTRUCTION (38, br_if_not_eq, "br-if-not-eq", 3, 0, 0)
+VM_DEFINE_OP (38, br_if_not_eq, "br-if-not-eq", 3, 0, 0)
 {
   SCM x, y;
   POP2 (y, x);
   BR (!scm_is_eq (x, y));
 }
 
-VM_DEFINE_INSTRUCTION (39, br_if_null, "br-if-null", 3, 0, 0)
+VM_DEFINE_OP (39, br_if_null, "br-if-null", 3, 0, 0)
 {
   SCM x;
   POP (x);
   BR (scm_is_null (x));
 }
 
-VM_DEFINE_INSTRUCTION (40, br_if_not_null, "br-if-not-null", 3, 0, 0)
+VM_DEFINE_OP (40, br_if_not_null, "br-if-not-null", 3, 0, 0)
 {
   SCM x;
   POP (x);
   BR (!scm_is_null (x));
 }
 
-VM_DEFINE_INSTRUCTION (41, br_if_nil, "br-if-nil", 3, 0, 0)
+VM_DEFINE_OP (41, br_if_nil, "br-if-nil", 3, 0, 0)
 {
   SCM x;
   POP (x);
   BR (scm_is_lisp_false (x));
 }
 
-VM_DEFINE_INSTRUCTION (42, br_if_not_nil, "br-if-not-nil", 3, 0, 0)
+VM_DEFINE_OP (42, br_if_not_nil, "br-if-not-nil", 3, 0, 0)
 {
   SCM x;
   POP (x);
@@ -556,7 +550,7 @@ VM_DEFINE_INSTRUCTION (42, br_if_not_nil, "br-if-not-nil", 
3, 0, 0)
  * Subprogram call
  */
 
-VM_DEFINE_INSTRUCTION (43, br_if_nargs_ne, "br-if-nargs-ne", 5, 0, 0)
+VM_DEFINE_OP (43, br_if_nargs_ne, "br-if-nargs-ne", 5, 0, 0)
 {
   scm_t_ptrdiff n;
   scm_t_int32 offset;
@@ -568,7 +562,7 @@ VM_DEFINE_INSTRUCTION (43, br_if_nargs_ne, 
"br-if-nargs-ne", 5, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (44, br_if_nargs_lt, "br-if-nargs-lt", 5, 0, 0)
+VM_DEFINE_OP (44, br_if_nargs_lt, "br-if-nargs-lt", 5, 0, 0)
 {
   scm_t_ptrdiff n;
   scm_t_int32 offset;
@@ -580,7 +574,7 @@ VM_DEFINE_INSTRUCTION (44, br_if_nargs_lt, 
"br-if-nargs-lt", 5, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (45, br_if_nargs_gt, "br-if-nargs-gt", 5, 0, 0)
+VM_DEFINE_OP (45, br_if_nargs_gt, "br-if-nargs-gt", 5, 0, 0)
 {
   scm_t_ptrdiff n;
   scm_t_int32 offset;
@@ -593,7 +587,7 @@ VM_DEFINE_INSTRUCTION (45, br_if_nargs_gt, 
"br-if-nargs-gt", 5, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (46, assert_nargs_ee, "assert-nargs-ee", 2, 0, 0)
+VM_DEFINE_OP (46, assert_nargs_ee, "assert-nargs-ee", 2, 0, 0)
 {
   scm_t_ptrdiff n;
   n = FETCH () << 8;
@@ -603,7 +597,7 @@ VM_DEFINE_INSTRUCTION (46, assert_nargs_ee, 
"assert-nargs-ee", 2, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (47, assert_nargs_ge, "assert-nargs-ge", 2, 0, 0)
+VM_DEFINE_OP (47, assert_nargs_ge, "assert-nargs-ge", 2, 0, 0)
 {
   scm_t_ptrdiff n;
   n = FETCH () << 8;
@@ -613,7 +607,7 @@ VM_DEFINE_INSTRUCTION (47, assert_nargs_ge, 
"assert-nargs-ge", 2, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (48, bind_optionals, "bind-optionals", 2, -1, -1)
+VM_DEFINE_OP (48, bind_optionals, "bind-optionals", 2, -1, -1)
 {
   scm_t_ptrdiff n;
   n = FETCH () << 8;
@@ -623,7 +617,7 @@ VM_DEFINE_INSTRUCTION (48, bind_optionals, 
"bind-optionals", 2, -1, -1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (49, bind_optionals_shuffle, "bind-optionals/shuffle", 
6, -1, -1)
+VM_DEFINE_OP (49, bind_optionals_shuffle, "bind-optionals/shuffle", 6, -1, -1)
 {
   SCM *walk;
   scm_t_ptrdiff nreq, nreq_and_opt, ntotal;
@@ -666,7 +660,7 @@ VM_DEFINE_INSTRUCTION (49, bind_optionals_shuffle, 
"bind-optionals/shuffle", 6,
 #define F_ALLOW_OTHER_KEYS  1
 #define F_REST              2
 
-VM_DEFINE_INSTRUCTION (50, bind_kwargs, "bind-kwargs", 5, 0, 0)
+VM_DEFINE_OP (50, bind_kwargs, "bind-kwargs", 5, 0, 0)
 {
   scm_t_uint16 idx;
   scm_t_ptrdiff nkw;
@@ -719,7 +713,7 @@ VM_DEFINE_INSTRUCTION (50, bind_kwargs, "bind-kwargs", 5, 
0, 0)
 #undef F_REST
 
 
-VM_DEFINE_INSTRUCTION (51, push_rest, "push-rest", 2, -1, -1)
+VM_DEFINE_OP (51, push_rest, "push-rest", 2, -1, -1)
 {
   scm_t_ptrdiff n;
   SCM rest = SCM_EOL;
@@ -732,7 +726,7 @@ VM_DEFINE_INSTRUCTION (51, push_rest, "push-rest", 2, -1, 
-1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (52, bind_rest, "bind-rest", 4, -1, -1)
+VM_DEFINE_OP (52, bind_rest, "bind-rest", 4, -1, -1)
 {
   scm_t_ptrdiff n;
   scm_t_uint32 i;
@@ -748,7 +742,7 @@ VM_DEFINE_INSTRUCTION (52, bind_rest, "bind-rest", 4, -1, 
-1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (53, reserve_locals, "reserve-locals", 2, -1, -1)
+VM_DEFINE_OP (53, reserve_locals, "reserve-locals", 2, -1, -1)
 {
   SCM *old_sp;
   scm_t_int32 n;
@@ -769,7 +763,7 @@ VM_DEFINE_INSTRUCTION (53, reserve_locals, 
"reserve-locals", 2, -1, -1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (54, new_frame, "new-frame", 0, 0, 3)
+VM_DEFINE_OP (54, new_frame, "new-frame", 0, 0, 3)
 {
   /* NB: if you change this, see frames.c:vm-frame-num-locals */
   /* and frames.h, vm-engine.c, etc of course */
@@ -784,7 +778,7 @@ VM_DEFINE_INSTRUCTION (54, new_frame, "new-frame", 0, 0, 3)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (55, call, "call", 1, -1, 1)
+VM_DEFINE_OP (55, call, "call", 1, -1, 1)
 {
   nargs = FETCH ();
 
@@ -832,7 +826,7 @@ VM_DEFINE_INSTRUCTION (55, call, "call", 1, -1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (56, tail_call, "tail-call", 1, -1, 1)
+VM_DEFINE_OP (56, tail_call, "tail-call", 1, -1, 1)
 {
   nargs = FETCH ();
 
@@ -883,7 +877,7 @@ VM_DEFINE_INSTRUCTION (56, tail_call, "tail-call", 1, -1, 1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, -1)
+VM_DEFINE_OP (57, subr_call, "subr-call", 1, -1, -1)
 {
   SCM pointer, ret;
   SCM (*subr)();
@@ -941,7 +935,7 @@ VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, 
-1)
     {
       /* multiple values returned to continuation */
       ret = scm_struct_ref (ret, SCM_INUM0);
-      nvalues = scm_ilength (ret);
+      nargs = scm_ilength (ret);
       PUSH_LIST (ret, scm_is_null);
       goto vm_return_values;
     }
@@ -954,7 +948,7 @@ VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, 
-1)
 
 /* Instruction 58 used to be smob-call.  */
 
-VM_DEFINE_INSTRUCTION (59, foreign_call, "foreign-call", 1, -1, -1)
+VM_DEFINE_OP (59, foreign_call, "foreign-call", 1, -1, -1)
 {
   SCM foreign, ret;
   nargs = FETCH ();
@@ -971,7 +965,7 @@ VM_DEFINE_INSTRUCTION (59, foreign_call, "foreign-call", 1, 
-1, -1)
     {
       /* multiple values returned to continuation */
       ret = scm_struct_ref (ret, SCM_INUM0);
-      nvalues = scm_ilength (ret);
+      nargs = scm_ilength (ret);
       PUSH_LIST (ret, scm_is_null);
       goto vm_return_values;
     }
@@ -982,7 +976,7 @@ VM_DEFINE_INSTRUCTION (59, foreign_call, "foreign-call", 1, 
-1, -1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (60, continuation_call, "continuation-call", 0, -1, 0)
+VM_DEFINE_OP (60, continuation_call, "continuation-call", 0, -1, 0)
 {
   SCM contregs;
   POP (contregs);
@@ -998,7 +992,7 @@ VM_DEFINE_INSTRUCTION (60, continuation_call, 
"continuation-call", 0, -1, 0)
   abort ();
 }
 
-VM_DEFINE_INSTRUCTION (61, partial_cont_call, "partial-cont-call", 0, -1, 0)
+VM_DEFINE_OP (61, partial_cont_call, "partial-cont-call", 0, -1, 0)
 {
   SCM vmcont;
   POP (vmcont);
@@ -1017,7 +1011,7 @@ VM_DEFINE_INSTRUCTION (61, partial_cont_call, 
"partial-cont-call", 0, -1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (62, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
+VM_DEFINE_OP (62, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
 {
   SCM x;
   POP (x);
@@ -1026,7 +1020,7 @@ VM_DEFINE_INSTRUCTION (62, tail_call_nargs, 
"tail-call/nargs", 0, 0, 1)
   goto vm_tail_call;
 }
 
-VM_DEFINE_INSTRUCTION (63, call_nargs, "call/nargs", 0, 0, 1)
+VM_DEFINE_OP (63, call_nargs, "call/nargs", 0, 0, 1)
 {
   SCM x;
   POP (x);
@@ -1035,7 +1029,7 @@ VM_DEFINE_INSTRUCTION (63, call_nargs, "call/nargs", 0, 
0, 1)
   goto vm_call;
 }
 
-VM_DEFINE_INSTRUCTION (64, mv_call, "mv-call", 4, -1, 1)
+VM_DEFINE_OP (64, mv_call, "mv-call", 4, -1, 1)
 {
   scm_t_int32 offset;
   scm_t_uint8 *mvra;
@@ -1088,7 +1082,7 @@ VM_DEFINE_INSTRUCTION (64, mv_call, "mv-call", 4, -1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (65, apply, "apply", 1, -1, 1)
+VM_DEFINE_OP (65, apply, "apply", 1, -1, 1)
 {
   int len;
   SCM ls;
@@ -1110,7 +1104,7 @@ VM_DEFINE_INSTRUCTION (65, apply, "apply", 1, -1, 1)
   goto vm_call;
 }
 
-VM_DEFINE_INSTRUCTION (66, tail_apply, "tail-apply", 1, -1, 1)
+VM_DEFINE_OP (66, tail_apply, "tail-apply", 1, -1, 1)
 {
   int len;
   SCM ls;
@@ -1132,7 +1126,7 @@ VM_DEFINE_INSTRUCTION (66, tail_apply, "tail-apply", 1, 
-1, 1)
   goto vm_tail_call;
 }
 
-VM_DEFINE_INSTRUCTION (67, call_cc, "call/cc", 0, 1, 1)
+VM_DEFINE_OP (67, call_cc, "call/cc", 0, 1, 1)
 {
   int first;
   SCM proc, vm_cont, cont;
@@ -1170,7 +1164,7 @@ VM_DEFINE_INSTRUCTION (67, call_cc, "call/cc", 0, 1, 1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc", 0, 1, 1)
+VM_DEFINE_OP (68, tail_call_cc, "tail-call/cc", 0, 1, 1)
 {
   int first;
   SCM proc, vm_cont, cont;
@@ -1204,8 +1198,8 @@ VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc", 
0, 1, 1)
       program = SCM_FRAME_PROGRAM (fp);
       CACHE_PROGRAM ();
       /* Unfortunately we don't know whether we are at the RA, and thus
-         have one value without an nvalues marker, or we are at the
-         MVRA and thus have multiple values and the nvalues
+         have one value without an nargs marker, or we are at the
+         MVRA and thus have multiple values and the nargs
          marker. Instead of adding heuristics here, we will let hook
          client code do that. */
       RESTORE_CONTINUATION_HOOK ();
@@ -1213,7 +1207,7 @@ VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc", 
0, 1, 1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1)
+VM_DEFINE_OP (69, return, "return", 0, 1, 1)
 {
  vm_return:
   POP_CONTINUATION_HOOK (1);
@@ -1249,20 +1243,20 @@ VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (70, return_values, "return/values", 1, -1, -1)
+VM_DEFINE_OP (70, return_values, "return/values", 1, -1, -1)
 {
-  /* nvalues declared at top level, because for some reason gcc seems to think
+  /* nargs declared at top level, because for some reason gcc seems to think
      that perhaps it might be used without declaration. Fooey to that, I say. 
*/
-  nvalues = FETCH ();
+  nargs = FETCH ();
  vm_return_values:
-  POP_CONTINUATION_HOOK (nvalues);
+  POP_CONTINUATION_HOOK (nargs);
 
   VM_HANDLE_INTERRUPTS;
 
-  if (nvalues != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp)) 
+  if (nargs != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp)) 
     {
       /* A multiply-valued continuation */
-      SCM *vals = sp - nvalues;
+      SCM *vals = sp - nargs;
       int i;
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
@@ -1270,20 +1264,20 @@ VM_DEFINE_INSTRUCTION (70, return_values, 
"return/values", 1, -1, -1)
       fp = SCM_FRAME_DYNAMIC_LINK (fp);
         
       /* Push return values, and the number of values */
-      for (i = 0; i < nvalues; i++)
+      for (i = 0; i < nargs; i++)
         *++sp = vals[i+1];
-      *++sp = SCM_I_MAKINUM (nvalues);
+      *++sp = SCM_I_MAKINUM (nargs);
              
       /* Finally null the end of the stack */
-      NULLSTACK (vals + nvalues - sp);
+      NULLSTACK (vals + nargs - sp);
     }
-  else if (nvalues >= 1)
+  else if (nargs >= 1)
     {
       /* Multiple values for a single-valued continuation -- here's where I
          break with guile tradition and try and do something sensible. (Also,
          this block handles the single-valued return to an mv
          continuation.) */
-      SCM *vals = sp - nvalues;
+      SCM *vals = sp - nargs;
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
       ip = SCM_FRAME_RETURN_ADDRESS (fp);
@@ -1293,7 +1287,7 @@ VM_DEFINE_INSTRUCTION (70, return_values, 
"return/values", 1, -1, -1)
       *++sp = vals[1];
              
       /* Finally null the end of the stack */
-      NULLSTACK (vals + nvalues - sp);
+      NULLSTACK (vals + nargs - sp);
     }
   else
     goto vm_error_no_values;
@@ -1305,20 +1299,20 @@ VM_DEFINE_INSTRUCTION (70, return_values, 
"return/values", 1, -1, -1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (71, return_values_star, "return/values*", 1, -1, -1)
+VM_DEFINE_OP (71, return_values_star, "return/values*", 1, -1, -1)
 {
   SCM l;
 
-  nvalues = FETCH ();
-  ASSERT (nvalues >= 1);
+  nargs = FETCH ();
+  ASSERT (nargs >= 1);
     
-  nvalues--;
+  nargs--;
   POP (l);
   while (scm_is_pair (l))
     {
       PUSH (SCM_CAR (l));
       l = SCM_CDR (l);
-      nvalues++;
+      nargs++;
     }
   if (SCM_UNLIKELY (!SCM_NULL_OR_NIL_P (l))) {
     finish_args = scm_list_1 (l);
@@ -1328,39 +1322,39 @@ VM_DEFINE_INSTRUCTION (71, return_values_star, 
"return/values*", 1, -1, -1)
   goto vm_return_values;
 }
 
-VM_DEFINE_INSTRUCTION (72, return_nvalues, "return/nvalues", 0, 1, -1)
+VM_DEFINE_OP (72, return_nargs, "return/nargs", 0, 1, -1)
 {
   SCM n;
   POP (n);
-  nvalues = scm_to_int (n);
-  ASSERT (nvalues >= 0);
+  nargs = scm_to_int (n);
+  ASSERT (nargs >= 0);
   goto vm_return_values;
 }
 
-VM_DEFINE_INSTRUCTION (73, truncate_values, "truncate-values", 2, -1, -1)
+VM_DEFINE_OP (73, truncate_values, "truncate-values", 2, -1, -1)
 {
   SCM x;
   int nbinds, rest;
   POP (x);
-  nvalues = scm_to_int (x);
+  nargs = scm_to_int (x);
   nbinds = FETCH ();
   rest = FETCH ();
 
   if (rest)
     nbinds--;
 
-  if (nvalues < nbinds)
+  if (nargs < nbinds)
     goto vm_error_not_enough_values;
 
   if (rest)
-    POP_LIST (nvalues - nbinds);
+    POP_LIST (nargs - nbinds);
   else
-    DROPN (nvalues - nbinds);
+    DROPN (nargs - nbinds);
 
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (74, box, "box", 1, 1, 0)
+VM_DEFINE_OP (74, box, "box", 1, 1, 0)
 {
   SCM val;
   POP (val);
@@ -1374,7 +1368,7 @@ VM_DEFINE_INSTRUCTION (74, box, "box", 1, 1, 0)
      (set! a (lambda () (b ...)))
      ...)
  */
-VM_DEFINE_INSTRUCTION (75, empty_box, "empty-box", 1, 0, 0)
+VM_DEFINE_OP (75, empty_box, "empty-box", 1, 0, 0)
 {
   SYNC_BEFORE_GC ();
   LOCAL_SET (FETCH (),
@@ -1382,7 +1376,7 @@ VM_DEFINE_INSTRUCTION (75, empty_box, "empty-box", 1, 0, 
0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (76, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
+VM_DEFINE_OP (76, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
 {
   SCM v = LOCAL_REF (FETCH ());
   ASSERT_BOUND_VARIABLE (v);
@@ -1390,7 +1384,7 @@ VM_DEFINE_INSTRUCTION (76, local_boxed_ref, 
"local-boxed-ref", 1, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (77, local_boxed_set, "local-boxed-set", 1, 1, 0)
+VM_DEFINE_OP (77, local_boxed_set, "local-boxed-set", 1, 1, 0)
 {
   SCM v, val;
   v = LOCAL_REF (FETCH ());
@@ -1400,7 +1394,7 @@ VM_DEFINE_INSTRUCTION (77, local_boxed_set, 
"local-boxed-set", 1, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (78, free_ref, "free-ref", 1, 0, 1)
+VM_DEFINE_OP (78, free_ref, "free-ref", 1, 0, 1)
 {
   scm_t_uint8 idx = FETCH ();
   
@@ -1411,7 +1405,7 @@ VM_DEFINE_INSTRUCTION (78, free_ref, "free-ref", 1, 0, 1)
 
 /* no free-set -- if a var is assigned, it should be in a box */
 
-VM_DEFINE_INSTRUCTION (79, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
+VM_DEFINE_OP (79, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
 {
   SCM v;
   scm_t_uint8 idx = FETCH ();
@@ -1422,7 +1416,7 @@ VM_DEFINE_INSTRUCTION (79, free_boxed_ref, 
"free-boxed-ref", 1, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (80, free_boxed_set, "free-boxed-set", 1, 1, 0)
+VM_DEFINE_OP (80, free_boxed_set, "free-boxed-set", 1, 1, 0)
 {
   SCM v, val;
   scm_t_uint8 idx = FETCH ();
@@ -1434,7 +1428,7 @@ VM_DEFINE_INSTRUCTION (80, free_boxed_set, 
"free-boxed-set", 1, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (81, make_closure, "make-closure", 2, -1, 1)
+VM_DEFINE_OP (81, make_closure, "make-closure", 2, -1, 1)
 {
   size_t n, len;
   SCM closure;
@@ -1453,7 +1447,7 @@ VM_DEFINE_INSTRUCTION (81, make_closure, "make-closure", 
2, -1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (82, make_variable, "make-variable", 0, 0, 1)
+VM_DEFINE_OP (82, make_variable, "make-variable", 0, 0, 1)
 {
   SYNC_BEFORE_GC ();
   /* fixme underflow */
@@ -1461,7 +1455,7 @@ VM_DEFINE_INSTRUCTION (82, make_variable, 
"make-variable", 0, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (83, fix_closure, "fix-closure", 2, -1, 0)
+VM_DEFINE_OP (83, fix_closure, "fix-closure", 2, -1, 0)
 {
   SCM x;
   unsigned int i = FETCH ();
@@ -1478,7 +1472,7 @@ VM_DEFINE_INSTRUCTION (83, fix_closure, "fix-closure", 2, 
-1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (84, define, "define", 0, 0, 2)
+VM_DEFINE_OP (84, define, "define", 0, 0, 2)
 {
   SCM sym, val;
   POP2 (sym, val);
@@ -1489,7 +1483,7 @@ VM_DEFINE_INSTRUCTION (84, define, "define", 0, 0, 2)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (85, make_keyword, "make-keyword", 0, 1, 1)
+VM_DEFINE_OP (85, make_keyword, "make-keyword", 0, 1, 1)
 {
   CHECK_UNDERFLOW ();
   SYNC_REGISTER ();
@@ -1497,7 +1491,7 @@ VM_DEFINE_INSTRUCTION (85, make_keyword, "make-keyword", 
0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (86, make_symbol, "make-symbol", 0, 1, 1)
+VM_DEFINE_OP (86, make_symbol, "make-symbol", 0, 1, 1)
 {
   CHECK_UNDERFLOW ();
   SYNC_REGISTER ();
@@ -1505,7 +1499,7 @@ VM_DEFINE_INSTRUCTION (86, make_symbol, "make-symbol", 0, 
1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (87, prompt, "prompt", 4, 2, 0)
+VM_DEFINE_OP (87, prompt, "prompt", 4, 2, 0)
 {
   scm_t_int32 offset;
   scm_t_uint8 escape_only_p;
@@ -1524,7 +1518,7 @@ VM_DEFINE_INSTRUCTION (87, prompt, "prompt", 4, 2, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (88, wind, "wind", 0, 2, 0)
+VM_DEFINE_OP (88, wind, "wind", 0, 2, 0)
 {
   SCM wind, unwind;
   POP2 (unwind, wind);
@@ -1538,7 +1532,7 @@ VM_DEFINE_INSTRUCTION (88, wind, "wind", 0, 2, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1)
+VM_DEFINE_OP (89, abort, "abort", 1, -1, -1)
 {
   unsigned n = FETCH ();
   SYNC_REGISTER ();
@@ -1549,7 +1543,7 @@ VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1)
   abort ();
 }
 
-VM_DEFINE_INSTRUCTION (90, unwind, "unwind", 0, 0, 0)
+VM_DEFINE_OP (90, unwind, "unwind", 0, 0, 0)
 {
   /* A normal exit from the dynamic extent of an expression. Pop the top entry
      off of the dynamic stack. */
@@ -1557,7 +1551,7 @@ VM_DEFINE_INSTRUCTION (90, unwind, "unwind", 0, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (91, wind_fluids, "wind-fluids", 1, -1, 0)
+VM_DEFINE_OP (91, wind_fluids, "wind-fluids", 1, -1, 0)
 {
   unsigned n = FETCH ();
   
@@ -1570,7 +1564,7 @@ VM_DEFINE_INSTRUCTION (91, wind_fluids, "wind-fluids", 1, 
-1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (92, unwind_fluids, "unwind-fluids", 0, 0, 0)
+VM_DEFINE_OP (92, unwind_fluids, "unwind-fluids", 0, 0, 0)
 {
   /* This function must not allocate.  */
   scm_dynstack_unwind_fluids (&current_thread->dynstack,
@@ -1578,7 +1572,7 @@ VM_DEFINE_INSTRUCTION (92, unwind_fluids, 
"unwind-fluids", 0, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (93, fluid_ref, "fluid-ref", 0, 1, 1)
+VM_DEFINE_OP (93, fluid_ref, "fluid-ref", 0, 1, 1)
 {
   size_t num;
   SCM fluids;
@@ -1608,7 +1602,7 @@ VM_DEFINE_INSTRUCTION (93, fluid_ref, "fluid-ref", 0, 1, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (94, fluid_set, "fluid-set", 0, 2, 0)
+VM_DEFINE_OP (94, fluid_set, "fluid-set", 0, 2, 0)
 {
   size_t num;
   SCM val, fluid, fluids;
@@ -1628,7 +1622,7 @@ VM_DEFINE_INSTRUCTION (94, fluid_set, "fluid-set", 0, 2, 
0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (95, assert_nargs_ee_locals, "assert-nargs-ee/locals", 
1, 0, 0)
+VM_DEFINE_OP (95, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1, 0, 0)
 {
   scm_t_ptrdiff n;
   SCM *old_sp;
diff --git a/libguile/vm.c b/libguile/vm.c
index 5645f81..22f93aa 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -379,6 +379,225 @@ scm_i_vm_print (SCM x, SCM port, scm_print_state *pstate)
   scm_puts_unlocked (">", port);
 }
 
+
+/*
+ * VM Error Handling
+ */
+
+static void vm_error (const char *msg, SCM arg) SCM_NORETURN;
+static void vm_error_bad_instruction (scm_t_uint32 inst) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_unbound (SCM proc, SCM sym) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_unbound_fluid (SCM proc, SCM fluid) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_not_a_variable (const char *func_name, SCM x) 
SCM_NORETURN SCM_NOINLINE;
+static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_kwargs_invalid_keyword (SCM proc) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_kwargs_unrecognized_keyword (SCM proc) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_too_many_args (int nargs) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_stack_overflow (struct scm_vm *vp) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_stack_underflow (void) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_improper_list (SCM x) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_continuation_not_rewindable (SCM cont) SCM_NORETURN 
SCM_NOINLINE;
+static void vm_error_bad_wide_string_length (size_t len) SCM_NORETURN 
SCM_NOINLINE;
+#if VM_CHECK_IP
+static void vm_error_invalid_address (void) SCM_NORETURN SCM_NOINLINE;
+#endif
+#if VM_CHECK_OBJECT
+static void vm_error_object (void) SCM_NORETURN SCM_NOINLINE;
+#endif
+#if VM_CHECK_FREE_VARIABLES
+static void vm_error_free_variable (void) SCM_NORETURN SCM_NOINLINE;
+#endif
+
+static void
+vm_error (const char *msg, SCM arg)
+{
+  scm_throw (sym_vm_error,
+             scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
+                         SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
+  abort(); /* not reached */
+}
+
+static void
+vm_error_bad_instruction (scm_t_uint32 inst)
+{
+  vm_error ("VM: Bad instruction: ~s", scm_from_uint32 (inst));
+}
+
+static void
+vm_error_unbound (SCM proc, SCM sym)
+{
+  scm_error_scm (scm_misc_error_key, proc,
+                 scm_from_latin1_string ("Unbound variable: ~s"),
+                 scm_list_1 (sym), SCM_BOOL_F);
+}
+
+static void
+vm_error_unbound_fluid (SCM proc, SCM fluid)
+{
+  scm_error_scm (scm_misc_error_key, proc,
+                 scm_from_latin1_string ("Unbound fluid: ~s"),
+                 scm_list_1 (fluid), SCM_BOOL_F);
+}
+
+static void
+vm_error_not_a_variable (const char *func_name, SCM x)
+{
+  scm_error (scm_arg_type_key, func_name, "Not a variable: ~S",
+             scm_list_1 (x), scm_list_1 (x));
+}
+
+static void
+vm_error_apply_to_non_list (SCM x)
+{
+  scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
+             scm_list_1 (x), scm_list_1 (x));
+}
+
+static void
+vm_error_kwargs_length_not_even (SCM proc)
+{
+  scm_error_scm (sym_keyword_argument_error, proc,
+                 scm_from_latin1_string ("Odd length of keyword argument 
list"),
+                 SCM_EOL, SCM_BOOL_F);
+}
+
+static void
+vm_error_kwargs_invalid_keyword (SCM proc)
+{
+  scm_error_scm (sym_keyword_argument_error, proc,
+                 scm_from_latin1_string ("Invalid keyword"),
+                 SCM_EOL, SCM_BOOL_F);
+}
+
+static void
+vm_error_kwargs_unrecognized_keyword (SCM proc)
+{
+  scm_error_scm (sym_keyword_argument_error, proc,
+                 scm_from_latin1_string ("Unrecognized keyword"),
+                 SCM_EOL, SCM_BOOL_F);
+}
+
+static void
+vm_error_too_many_args (int nargs)
+{
+  vm_error ("VM: Too many arguments", scm_from_int (nargs));
+}
+
+static void
+vm_error_wrong_num_args (SCM proc)
+{
+  scm_wrong_num_args (proc);
+}
+
+static void
+vm_error_wrong_type_apply (SCM proc)
+{
+  scm_error (scm_arg_type_key, NULL, "Wrong type to apply: ~S",
+             scm_list_1 (proc), scm_list_1 (proc));
+}
+
+static void
+vm_error_stack_overflow (struct scm_vm *vp)
+{
+  if (vp->stack_limit < vp->stack_base + vp->stack_size)
+    /* There are VM_STACK_RESERVE_SIZE bytes left.  Make them available so
+       that `throw' below can run on this VM.  */
+    vp->stack_limit = vp->stack_base + vp->stack_size;
+  else
+    /* There is no space left on the stack.  FIXME: Do something more
+       sensible here! */
+    abort ();
+  vm_error ("VM: Stack overflow", SCM_UNDEFINED);
+}
+
+static void
+vm_error_stack_underflow (void)
+{
+  vm_error ("VM: Stack underflow", SCM_UNDEFINED);
+}
+
+static void
+vm_error_improper_list (SCM x)
+{
+  vm_error ("Expected a proper list, but got object with tail ~s", x);
+}
+
+static void
+vm_error_not_a_pair (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "pair");
+}
+
+static void
+vm_error_not_a_bytevector (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "bytevector");
+}
+
+static void
+vm_error_not_a_struct (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "struct");
+}
+
+static void
+vm_error_no_values (void)
+{
+  vm_error ("Zero values returned to single-valued continuation",
+            SCM_UNDEFINED);
+}
+
+static void
+vm_error_not_enough_values (void)
+{
+  vm_error ("Too few values returned to continuation", SCM_UNDEFINED);
+}
+
+static void
+vm_error_continuation_not_rewindable (SCM cont)
+{
+  vm_error ("Unrewindable partial continuation", cont);
+}
+
+static void
+vm_error_bad_wide_string_length (size_t len)
+{
+  vm_error ("VM: Bad wide string length: ~S", scm_from_size_t (len));
+}
+
+#ifdef VM_CHECK_IP
+static void
+vm_error_invalid_address (void)
+{
+  vm_error ("VM: Invalid program address", SCM_UNDEFINED);
+}
+#endif
+
+#if VM_CHECK_OBJECT
+static void
+vm_error_object ()
+{
+  vm_error ("VM: Invalid object table access", SCM_UNDEFINED);
+}
+#endif
+
+#if VM_CHECK_FREE_VARIABLES
+static void
+vm_error_free_variable ()
+{
+  vm_error ("VM: Invalid free variable access", SCM_UNDEFINED);
+}
+#endif
+
+
 static SCM
 really_make_boot_program (long nargs)
 {
@@ -428,6 +647,65 @@ vm_make_boot_program (long nargs)
     return really_make_boot_program (nargs);
 }
 
+#if 0
+#define SCM_PACK_RTL_3(op,a,b,c) ((op) | ((a) << 8) | ((b) << 16) | ((d) << 
24))
+
+#define SCM_PACK_RTL_1(op,a) ((op) | ((a) << 8))
+
+scm_t_uint32 text[] = { SCM_PACK_RTL_3 (scm_rtl_op_mv_call_nargs,
+                                        0, /* nargs in r0 */
+                                        1, /* program and args starting at r1 
*/
+                                        0), /* mv offset of 1 instruction */
+                        scm_rtl_op_indicate_one_value,
+                        scm_rtl_op_halt };
+
+static SCM
+really_make_rtl_boot_program (long nargs)
+{
+  SCM u8vec;
+  struct scm_objcode *bp;
+  SCM ret;
+
+  if (SCM_UNLIKELY (nargs > 255 || nargs < 0))
+    scm_misc_error ("vm-engine", "too many args when making boot procedure",
+                    scm_list_1 (scm_from_long (nargs)));
+
+  text[1] = (scm_t_uint8)nargs;
+
+  bp = scm_gc_malloc_pointerless (sizeof (struct scm_objcode) + sizeof (text),
+                                  "boot-program");
+  memcpy (SCM_C_OBJCODE_BASE (bp), text, sizeof (text));
+  bp->len = sizeof(text);
+  bp->metalen = 0;
+
+  u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp,
+                                    sizeof (struct scm_objcode) + sizeof 
(text),
+                                    SCM_BOOL_F);
+  ret = scm_make_program (scm_bytecode_to_native_objcode (u8vec),
+                          SCM_BOOL_F, SCM_BOOL_F);
+  SCM_SET_CELL_WORD_0 (ret, SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_BOOT);
+
+  return ret;
+}
+static SCM
+vm_make_rtl_boot_program (long nargs)
+{
+  static SCM programs[NUM_BOOT_PROGS] = { SCM_BOOL_F, };
+
+  if (SCM_UNLIKELY (scm_is_false (programs[0])))
+    {
+      int i;
+      for (i = 0; i < NUM_BOOT_PROGS; i++)
+        programs[i] = really_make_rtl_boot_program (i);
+    }
+  
+  if (SCM_LIKELY (nargs < NUM_BOOT_PROGS))
+    return programs[nargs];
+  else
+    return really_make_rtl_boot_program (nargs);
+}
+#endif
+
 
 /*
  * VM
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 2bd8919..008b5c9 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1005,11 +1005,11 @@
   ;; residualizing a reference to the leaf identifier.  The bailout is
   ;; driven by the recursive-effort-limit, which is currently 100.  We
   ;; make sure to trip it with this recursive sum thing.
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (let ((x (let sum ((n 0) (out 0))
                (if (< n 10000)
                    (sum (1+ n) (+ out n))
                    out))))
       ((lambda (y) (list y)) x))
     (let (x) (_) (_)
-         (apply (primitive list) (lexical x _)))))
+         (primcall list (lexical x _)))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]