mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-05 20:26:35 +02:00
Experimenting with exception handler
This commit is contained in:
parent
dd7a8c1846
commit
deff3e910d
2 changed files with 13 additions and 7 deletions
19
runtime.h
19
runtime.h
|
@ -459,25 +459,28 @@ static void clear_mutations() {
|
|||
/* Exception handler */
|
||||
list exception_handler_stack = nil;
|
||||
|
||||
static object default_exception_handler(object err) {
|
||||
printf("Error: ");
|
||||
static void default_exception_handler(int argc, closure _, object k, object err) {
|
||||
printf("default handler Error: ");
|
||||
Cyc_display(err);
|
||||
printf("\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
static object add_exception_handler(object handler) {
|
||||
static void add_exception_handler(function_type handler) {
|
||||
// TODO: error checking on handler?
|
||||
exception_handler_stack = mcons(handler, exception_handler_stack);
|
||||
return handler;
|
||||
}
|
||||
|
||||
// TODO: remove ex handler, err if all are removed?
|
||||
// TODO: raise - call current exception handler
|
||||
static void Cyc_raise(/*object cont,*/ object err) {
|
||||
function_type fnc = (function_type) car(exception_handler_stack);
|
||||
mclosure0(clo, fnc);
|
||||
(fnc)(2, clo, clo, err);
|
||||
}
|
||||
|
||||
static void init_exception_handler(){
|
||||
// TODO: package default_exception_handler into a closure??
|
||||
// add_exception_handler(
|
||||
add_exception_handler(default_exception_handler);
|
||||
}
|
||||
/* END exception handler */
|
||||
|
||||
|
@ -1011,7 +1014,8 @@ static object Cyc_error_va(int count, object obj1, va_list ap) {
|
|||
printf("\n");
|
||||
}
|
||||
|
||||
exit(1);
|
||||
//exit(1);
|
||||
Cyc_raise(obj1);
|
||||
return boolean_f;
|
||||
}
|
||||
|
||||
|
@ -1953,6 +1957,7 @@ static void main_main (stack_size,heap_size,stack_base)
|
|||
mclosure0(run_test,&c_entry_pt);
|
||||
gc_cont = &run_test;
|
||||
/* Initialize constant expressions for the test runs. */
|
||||
init_exception_handler();
|
||||
|
||||
/* Allocate heap area for second generation. */
|
||||
/* Use calloc instead of malloc to assure pages are in main memory. */
|
||||
|
|
1
test.scm
1
test.scm
|
@ -23,6 +23,7 @@
|
|||
;(eval '(a 1))
|
||||
;(eval '(begin (define (a z) z) (a 1) (a 1)))
|
||||
|
||||
(error 'test)
|
||||
(define test '(a b))
|
||||
(set-car! test '(1 2 3))
|
||||
(write test)
|
||||
|
|
Loading…
Add table
Reference in a new issue