Initial version of (raise-continuable)

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")

runtime.h

@@ -495,13 +495,8 @@ static object Cyc_remove_exception_handler(){
 }
 // END TODO
 
-static object Cyc_raise(object err) {
+static object Cyc_current_exception_handler() {
-    //function_type fnc = (function_type) car(exception_handler_stack);
+    return 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;
 }
 
 /* END exception handler */

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
+              (let ((result #f)
-              (Cyc-remove-exception-handler)
+                    (continuable? (and (pair? obj) 
-              (handler obj) ;; Actual handler
+                                       (equal? (car obj) 'continuable))))
-           ;; TODO: unless obj is continuable, then return above result:
+                ;; Unregister this handler since it is no longer needed
-              (error "exception handler returned")))) 
+                (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