diff --git a/cgen.scm b/cgen.scm index 39c76c68..8828c651 100644 --- a/cgen.scm +++ b/cgen.scm @@ -434,7 +434,7 @@ ((eq? p 'apply) "apply") ((eq? p '%halt) "__halt") ((eq? p 'exit) "__halt") - ((eq? p 'raise) "Cyc_raise") + ((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler") ((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") diff --git a/runtime.h b/runtime.h index b3831876..68be4449 100644 --- a/runtime.h +++ b/runtime.h @@ -495,13 +495,8 @@ static object Cyc_remove_exception_handler(){ } // END TODO -static object Cyc_raise(object 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 object Cyc_current_exception_handler() { + return car(exception_handler_stack); } /* END exception handler */ diff --git a/trans.scm b/trans.scm index 9645edfb..ebbdea5c 100644 --- a/trans.scm +++ b/trans.scm @@ -69,14 +69,23 @@ (foldr (lambda (x y) (cons (func x) y)) '() lst)) (define (not x) (if x #f #t)) (define (reverse lst) (foldl cons '() lst)) + (define (raise obj) + ((Cyc-current-exception-handler) (list 'raised obj))) + (define (raise-continuable obj) + ((Cyc-current-exception-handler) (list 'continuable obj))) (define (with-exception-handler handler thunk) (let ((my-handler (lambda (obj) - ;; Unregister this handler since it is no longer needed - (Cyc-remove-exception-handler) - (handler obj) ;; Actual handler - ;; TODO: unless obj is continuable, then return above result: - (error "exception handler returned")))) + (let ((result #f) + (continuable? (and (pair? obj) + (equal? (car obj) 'continuable)))) + ;; Unregister this handler since it is no longer needed + (Cyc-remove-exception-handler) + (set! result (handler (cadr obj))) ;; Actual handler + + (if continuable? + result + (error "exception handler returned")))))) ;; TODO: cond-expand below, since it uses Cyc functions? ;; probably no need since this is part of internal lib (Cyc-add-exception-handler my-handler) @@ -532,7 +541,7 @@ %halt error exit - raise + Cyc-current-exception-handler Cyc-add-exception-handler Cyc-remove-exception-handler cons