diff --git a/cgen.scm b/cgen.scm index 322610a3..8c80f78a 100644 --- a/cgen.scm +++ b/cgen.scm @@ -435,6 +435,7 @@ ((eq? p '%halt) "__halt") ((eq? p 'exit) "__halt") ((eq? p 'raise) "Cyc_raise") + ((eq? p 'Cyc-add-exception-handler) "Cyc_add_exception_handler") ((eq? p 'error) "Cyc_error") ((eq? p 'current-input-port) "Cyc_io_current_input_port") ((eq? p 'open-input-file) "Cyc_io_open_input_file") diff --git a/runtime.h b/runtime.h index 169b31da..a2327123 100644 --- a/runtime.h +++ b/runtime.h @@ -466,24 +466,24 @@ static void default_exception_handler(int argc, closure _, object k, object err) exit(1); } -static void add_exception_handler(function_type handler) { +static object Cyc_add_exception_handler(object 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) { static object Cyc_raise(object err) { - function_type fnc = (function_type) car(exception_handler_stack); - mclosure0(clo, fnc); - (fnc)(2, &clo, &clo, err); + //function_type fnc = (function_type) car(exception_handler_stack); + //mclosure0(clo, fnc); + //(fnc)(2, &clo, &clo, err); + object clo = car(exception_handler_stack); + ((closure)clo)->fn(2, clo, clo, err); return nil; } -static void init_exception_handler(){ - add_exception_handler(default_exception_handler); -} /* END exception handler */ /* Global variables. */ @@ -1957,9 +1957,10 @@ static void main_main (stack_size,heap_size,stack_base) /* Create closure for the test function. */ mclosure0(run_test,&c_entry_pt); + mclosure0(default_ex, &default_exception_handler); gc_cont = &run_test; /* Initialize constant expressions for the test runs. */ - init_exception_handler(); + Cyc_add_exception_handler(&default_ex); /* Allocate heap area for second generation. */ /* Use calloc instead of malloc to assure pages are in main memory. */ diff --git a/test.scm b/test.scm index 40fab36b..a0cf52a8 100644 --- a/test.scm +++ b/test.scm @@ -23,6 +23,7 @@ ;(eval '(a 1)) ;(eval '(begin (define (a z) z) (a 1) (a 1))) +(Cyc-add-exception-handler (lambda (err) (write 'new-ex-handler))) (define test '(a b)) (set-car! test '(1 2 3)) (write test) diff --git a/trans.scm b/trans.scm index 081622bf..23e40704 100644 --- a/trans.scm +++ b/trans.scm @@ -519,6 +519,7 @@ error exit raise + Cyc-add-exception-handler cons cell-get set-global!