diff --git a/cgen.scm b/cgen.scm index d27b33d8..df21a91e 100644 --- a/cgen.scm +++ b/cgen.scm @@ -415,6 +415,7 @@ ((eq? p '%halt) "__halt") ((eq? p 'exit) "__halt") ((eq? p 'Cyc-default-exception-handler) "Cyc_default_exception_handler") + ((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler") ((eq? p 'current-input-port) "Cyc_io_current_input_port") ((eq? p 'open-input-file) "Cyc_io_open_input_file") ((eq? p 'close-input-port) "Cyc_io_close_input_port") diff --git a/eval.scm b/eval.scm index 8db5c50f..c3e20257 100644 --- a/eval.scm +++ b/eval.scm @@ -189,6 +189,8 @@ (list 'Cyc-set-cvar! Cyc-set-cvar!) (list 'Cyc-cvar? Cyc-cvar?) (list 'Cyc-has-cycle? Cyc-has-cycle?) + (list 'Cyc-default-exception-handler Cyc-default-exception-handler) + (list 'Cyc-current-exception-handler Cyc-current-exception-handler) (list '+ +) (list '- -) (list '* *) diff --git a/runtime.h b/runtime.h index c6548ce3..3e888094 100644 --- a/runtime.h +++ b/runtime.h @@ -198,6 +198,14 @@ static object Cyc_default_exception_handler(int argc, closure _, object err) { printf("\n"); exit(1); return nil; + +// TODO: need to avoid using a global here, or add a define to shadow it for libcyclone +object Cyc_current_exception_handler() { + if (nil(__glo__85exception_91handler_91stack_85)) { + return primitive_Cyc_91default_91exception_91handler; + } else { + return __glo__85exception_91handler_91stack_85; + } } /* Provide the ability to raise an exception from the C runtime. @@ -1108,6 +1116,8 @@ static void _string_91_125number(object cont, object args) { //static void _error(object cont, object args) { // integer_type argc = Cyc_length(args); // dispatch_va(argc.value, dispatch_error, cont, cont, args); } +static void _Cyc_91current_91exception_91handler(object cont, object args) { + return_funcall1(cont, Cyc_current_exception_handler()); } static void _Cyc_91default_91exception_91handler(object cont, object args) { // TODO: this is a quick-and-dirty implementation, may be a better way to write this Cyc_default_exception_handler(1, args, car(args)); @@ -1172,6 +1182,10 @@ defprimitive(apply, apply, &_apply); /* apply */ defprimitive(_75halt, %halt, &__75halt); /* %halt */ defprimitive(exit, exit, &_cyc_exit); /* exit */ //defprimitive(error, error, &_error); /* error */ +defprimitive( + Cyc_91current_91exception_91handler, + Cyc_current_exception_handler, + &_Cyc_91current_91exception_91handler); /* Cyc-current-exception-handler */ defprimitive( Cyc_91default_91exception_91handler, Cyc_default_exception_handler, diff --git a/trans.scm b/trans.scm index 7d091244..827c5ac2 100644 --- a/trans.scm +++ b/trans.scm @@ -214,10 +214,10 @@ (define (Cyc-remove-exception-handler) (if (not (null? *exception-handler-stack*)) (set! *exception-handler-stack* (cdr *exception-handler-stack*)))) - (define (Cyc-current-exception-handler) - (if (null? *exception-handler-stack*) - Cyc-default-exception-handler - (car *exception-handler-stack*))) +; (define (Cyc-current-exception-handler) +; (if (null? *exception-handler-stack*) +; Cyc-default-exception-handler +; (car *exception-handler-stack*))) )) ;; Built-in macros @@ -699,6 +699,7 @@ %halt exit Cyc-default-exception-handler + Cyc-current-exception-handler cons cell-get set-global! @@ -766,6 +767,7 @@ %halt exit Cyc-default-exception-handler + Cyc-current-exception-handler cell-get set-global! set-cell!