From ce441123bbd3c32a0b1a14618b7cdc9405df730e Mon Sep 17 00:00:00 2001
From: Noah Lavine <noah.b.lavine@gmail.com>
Date: Sat, 20 Apr 2013 18:57:01 -0400
Subject: [PATCH 2/3] Better Exception in RTL VM

 * libguile/vm-engine.c: in box-ref, throw an exception instead of
   aborting when the register does not contain a variable.
 * test-suite/tests/rtl.test: test this behavior.
 * test-suite/test-suite/lib.scm: add a new exception to enable this
   test.
---
 libguile/vm-engine.c          |    3 ++-
 test-suite/test-suite/lib.scm |    3 +++
 test-suite/tests/rtl.test     |    9 +++++++++
 3 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 44687e2..f5f1617 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1865,7 +1865,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       SCM var;
       SCM_UNPACK_RTL_12_12 (op, dst, src);
       var = LOCAL_REF (src);
-      VM_ASSERT (SCM_VARIABLEP (var), abort ());
+      VM_ASSERT (SCM_VARIABLEP (var),
+		 vm_error_not_a_variable ("box-ref (VM instruction)", var));
       if (SCM_UNLIKELY (!VARIABLE_BOUNDP (var)))
         {
           SCM var_name;
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 7517b4e..6b289ca 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -31,6 +31,7 @@
  exception:out-of-range exception:unbound-var
  exception:used-before-defined
  exception:wrong-num-args exception:wrong-type-arg
+ exception:not-a-variable
  exception:numerical-overflow
  exception:struct-set!-denied
  exception:system-error
@@ -277,6 +278,8 @@
   (cons 'wrong-number-of-args "^Wrong number of arguments"))
 (define exception:wrong-type-arg
   (cons 'wrong-type-arg "^Wrong type"))
+(define exception:not-a-variable
+  (cons 'wrong-type-arg "^Not a variable"))
 (define exception:numerical-overflow
   (cons 'numerical-overflow "^Numerical overflow"))
 (define exception:struct-set!-denied
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index 219407c..633425c 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -247,3 +247,12 @@
                             (end-program)))))
                     ((make-top-incrementor))
                     *top-val*))))
+
+(with-test-prefix "box-ref"
+  (pass-if-exception "bad variable" exception:not-a-variable
+    ((assemble-program
+      '((begin-program foo)
+        (assert-nargs-ee/locals 0 2)
+        (box-ref 0 1)
+        (return 0)
+        (end-program))))))
-- 
1.7.10.4