converting make-exception to a primitive opcode instead of a foreign

function, since foreign functions will always raise any exception they
return (hence the double catch in issue #15).

also restoring the original exception handler when an exception is
raised in with-exception-handler, so that exceptions within the
handler itself don't cause an infinite loop.  this may change, as
with-exception-handler is meant to be a low-level tool on which to
build either guard or condition-case, but until then the restoring
is necessary.

eval.c

@@ -1581,6 +1581,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     _ARG2 = sexp_make_vector(ctx, _ARG1, _ARG2);
     top--;
     break;
+  case SEXP_OP_MAKE_EXCEPTION:
+    _ARG5 = sexp_make_exception(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
+    top -= 4;
+    break;
   case SEXP_OP_AND:
     _ARG2 = sexp_make_boolean((_ARG1 != SEXP_FALSE) && (_ARG2 != SEXP_FALSE));
     top--;

include/chibi/eval.h

@@ -76,6 +76,7 @@ enum sexp_opcode_names {
   SEXP_OP_STRING_LENGTH,
   SEXP_OP_MAKE_PROCEDURE,
   SEXP_OP_MAKE_VECTOR,
+  SEXP_OP_MAKE_EXCEPTION,
   SEXP_OP_AND,
   SEXP_OP_NULLP,
   SEXP_OP_FIXNUMP,

lib/init.scm

@@ -312,7 +312,10 @@
 
 (define (with-exception-handler handler thunk)
   (let ((orig-handler (current-exception-handler)))
-    (current-exception-handler handler)
+    (current-exception-handler
+     (lambda (exn)
+       (current-exception-handler orig-handler)
+       (handler exn)))
     (let ((res (thunk)))
       (current-exception-handler orig-handler)
       res)))

opcodes.c

@@ -48,6 +48,7 @@ _OP(SEXP_OPC_PREDICATE,      SEXP_OP_EQ,  2, 0, 0, 0, 0, "eq?", 0, NULL),
 _OP(SEXP_OPC_CONSTRUCTOR,    SEXP_OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
 _OP(SEXP_OPC_CONSTRUCTOR,    SEXP_OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL),
 _OP(SEXP_OPC_CONSTRUCTOR,    SEXP_OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
+_OP(SEXP_OPC_CONSTRUCTOR,    SEXP_OP_MAKE_EXCEPTION, 5, 0, 0, 0, 0, "make-exception", 0, NULL),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_NULLP,  1, 0, 0, 0, 0, "null?", NULL, 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_EOFP,  1, 0, 0, 0, 0, "eof-object?", NULL, 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_SYMBOLP,  1, 0, 0, 0, 0, "symbol?", NULL, 0),
@@ -95,7 +96,6 @@ _FN2OPTP(SEXP_STRING, SEXP_ENV, "load", (sexp)"*interaction-environment*", sexp_
 _FN4(SEXP_ENV, SEXP_ENV, "%env-copy!", 0, sexp_env_copy),
 _FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception),
 _FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func),
-_FN5(SEXP_SYMBOL, SEXP_STRING, "make-exception", 0, sexp_make_exception),
 _FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string),
 _FN3(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp),
 _FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring),

opt/debug.c

@@ -11,8 +11,8 @@ static const char* reverse_opcode_names[] =
    "JUMP-UNLESS", "JUMP", "PUSH", "DROP", "GLOBAL-REF", "GLOBAL-KNOWN-REF",
    "STACK-REF", "LOCAL-REF", "LOCAL-SET",
    "CLOSURE-REF", "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", "STRING-REF",
-   "STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR", "AND",
+   "STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR",
-   "NULL?", "FIXNUM?", "SYMBOL?", "CHAR?",
+   "MAKE-EXCEPTION", "AND", "NULL?", "FIXNUM?", "SYMBOL?", "CHAR?",
    "EOF?", "TYPEP", "MAKE", "SLOT-REF", "SLOT-SET", "CAR", "CDR",
    "SET-CAR", "SET-CDR", "CONS", "ADD", "SUB",
    "MUL", "DIV", "QUOTIENT", "REMAINDER", "NEGATIVE", "INVERSE",