Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 14:49:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Alex Shinn 2009-12-26 16:21:37 +09:00
parent 55710f48be
commit 7eae77d0f9
5 changed files with 12 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
eval.c
View file

@ -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--;

1
include/chibi/eval.h
View file

@ -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,

5
lib/init.scm
View file

@ -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)))

2
opcodes.c
View file

@ -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),

4
opt/debug.c
View file

@ -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",
"NULL?", "FIXNUM?", "SYMBOL?", "CHAR?",
"STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR",
"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",