Merge remote-tracking branch 'origin/stable-2.0'

Conflicts:
	libguile/vm-engine.c
	libguile/vm-i-system.c

9 files changed, 345 insertions, 308 deletions

diff --git a/libguile/_scm.h b/libguile/_scm.h
index c3384be68..7dd188d33 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 fdd93599a..55577f291 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 5f79855be..f11c9d9de 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 1d16ec431..4b6c98a1f 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++);
   }
@@ -153,170 +149,15 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   }
 #endif
 
-  
- vm_done:
-  SYNC_ALL ();
-  return finish_args;
-
-  /* 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;
-#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;
-#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;
-#endif
-
-  vm_error:
-    SYNC_ALL ();
+  abort (); /* never reached */
 
-    scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args),
-		1);
-  }
+ vm_error_bad_instruction:
+  vm_error_bad_instruction (ip[-1]);
+  abort (); /* never reached */
 
+ handle_overflow:
+  SYNC_ALL ();
+  vm_error_stack_overflow (vp);
   abort (); /* never reached */
 }
 
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 000397de2..5a4bf40f3 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -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
@@ -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,19 @@
 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 #endif
 
-#define CHECK_OVERFLOW()			\
-  if (SCM_UNLIKELY (sp >= stack_limit))         \
-    goto vm_error_stack_overflow
-
+/* For this check, we don't use VM_ASSERT, because that leads to a
+   per-site SYNC_ALL, which is too much code growth.  The real problem
+   of course is having to check for overflow all the time... */
+#define CHECK_OVERFLOW()                                                \
+  do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
 
 #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 +332,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)
 
 
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 6fa8eb2ea..c3231568e 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 89c3555ce..0e3956363 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 7153ab589..b6c15d28e 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.c b/libguile/vm.c
index 5645f81c1..b2d07315c 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)
 {