diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 5843012..aa7a8fb 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -1,6 +1,6 @@ ;; -*- mode: lisp-data -*- -(prin1 (let ((l (block 'c (lambda () (return-from 'c 3))))) +(prin1 (let ((l (block 'c (lambda () (return-from 'd 3))))) (block 'c (funcall l)))) (write-byte ?\n) diff --git a/src/stack.c b/src/stack.c index ae0de38..c6cc4ca 100644 --- a/src/stack.c +++ b/src/stack.c @@ -419,9 +419,12 @@ DEFSPECIAL(return_from, "return-from", (LispVal * name, LispVal *value), longjmp(*frame->block.target, 1); } } + // block went out of scope + lisp_signal(Qblock_out_of_scope_error, LIST(name)); + } else { + // block never existed + lisp_signal(Qno_such_block_error, LIST(name)); } - // block went out of scope - lisp_signal(Qno_such_block_error, LIST(name)); } DEFUN(backtrace, "backtrace", (void), "()", "") { @@ -442,5 +445,7 @@ DEFUN(backtrace, "backtrace", (void), "()", "") { DEFINE_SYMBOL(no_such_block_error, "no-such-block-error"); DEFINE_CONDITION_CLASS(no_such_block_error, error); +DEFINE_SYMBOL(block_out_of_scope_error, "block-out-of-scope-error"); +DEFINE_CONDITION_CLASS(block_out_of_scope_error, error); DEFINE_SYMBOL(excessive_lisp_nesting_error, "excessive-lisp-nesting-error"); DEFINE_CONDITION_CLASS(excessive_lisp_nesting_error, error); diff --git a/src/stack.h b/src/stack.h index d80fb53..da73318 100644 --- a/src/stack.h +++ b/src/stack.h @@ -157,6 +157,8 @@ DECLARE_FUNCTION(backtrace, (void) ); DECLARE_SYMBOL(no_such_block_error); MAKE_CONDITION_CLASS(no_such_block_error); +DECLARE_SYMBOL(block_out_of_scope_error); +MAKE_CONDITION_CLASS(block_out_of_scope_error); DECLARE_SYMBOL(excessive_lisp_nesting_error); MAKE_CONDITION_CLASS(excessive_lisp_nesting_error);