diff --git a/cgen.scm b/cgen.scm index 8c80f78a..39c76c68 100644 --- a/cgen.scm +++ b/cgen.scm @@ -436,6 +436,7 @@ ((eq? p 'exit) "__halt") ((eq? p 'raise) "Cyc_raise") ((eq? p 'Cyc-add-exception-handler) "Cyc_add_exception_handler") + ((eq? p 'Cyc-remove-exception-handler) "Cyc_remove_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 a2327123..b3831876 100644 --- a/runtime.h +++ b/runtime.h @@ -457,6 +457,15 @@ static void clear_mutations() { /* END mutation table */ /* Exception handler */ +/* +notes: + +- with-exception-handler, need to: + * GOOD case (no exception is raised): install new exception handler, execute thunk, uninstall ex handler, and return value from thunk + * EX raised - install new ex handler, execute thunk, uninstall handler, call handler, and throw 2nd exception if handler returns + +- if a handler returns, a second exception is raised. how to handle that? +*/ list exception_handler_stack = nil; static void default_exception_handler(int argc, closure _, object k, object err) { @@ -466,15 +475,26 @@ static void default_exception_handler(int argc, closure _, object k, object err) exit(1); } +// TODO: not sure this is the best approach, may be able to do this in +// Scheme code, but for now do add/remove this way: static object Cyc_add_exception_handler(object handler) { // TODO: error checking on handler? exception_handler_stack = mcons(handler, exception_handler_stack); return handler; } +static object Cyc_remove_exception_handler(){ + object old_cons = exception_handler_stack; + + if (nullp(exception_handler_stack)) { + printf("Internal error, no exception handler to remove\n"); + exit(1); + } + exception_handler_stack = cdr(exception_handler_stack); + free(old_cons); + return exception_handler_stack; +} +// END TODO -// 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); diff --git a/trans.scm b/trans.scm index 23e40704..2d9dad64 100644 --- a/trans.scm +++ b/trans.scm @@ -520,6 +520,7 @@ exit raise Cyc-add-exception-handler + Cyc-remove-exception-handler cons cell-get set-global!