[Chicken-users] how to handle errors under callbacks?

[Rick Taube]

i need to wrap exception handling around user code inside a (macro  
generated) function that is inserted into a scheuduler an called back  
from C so scheme errors dont cause my whole C++/Chicken app to crash  
under the callback, as is currently the case. im new to chicken and  
dont really understand all the ins and outs of mixing c with scheme  
yet. I *thought* i could simply have my macro include a (condition- 
case ...) around the users code as part of the closure that gets  
returned as the callback function.  and this does sort of work: if i  
start csi and eval the define-macro below and then create and "call"  
the callback by hand from inside the csi the error handler works fine.

however, when i actually compile my macro and link it into my c++ app:

csc -c++ -embedded -t ChickenBridge.scm

then when i then create and run the real callback i get the error  
shown below about (exn) not being defined.  but this '(exn)' is part  
of the condition-case syntax boilerplate which SHOULD have been  
macroexpanded away when the closure got created when the macro was  
used. from the looks of the error message for some reason condtion- 
case clause ( [VARIABLE] (KIND ...) BODY ...) isnt being expanded in  
my compiled code -- the 'g2' is a gensym  my macro creates to receive  
the exception, (exn) is the condition kind and (printf ...) is the body:

Error: unbound variable: exn
[...]
        <eval>          [foo] (g2 (exn) (printf ">>> Aborting  
process at time ~S:~%    Error: ~S" g0 ((condition-property- 
accessor......
[...]

Ive included the macro below in case anyone sees what im doing  
wrong.  How can i get the condition-case to work when this macro is C  
compiled to C and linked into my app?

or is there a better way to handle errors under a callback -- for  
example Is there a way to trap a scheme error on the  C side thats  
calling the callback?

I hope im making sense...
-rick

;----------------------
; the go macro looks like 'do' but returns a closure
; that gets iteratively called from a c scheduler

(define-macro (go bindings terminate . body)
  (expand-go bindings terminate body)
  )

(define (expand-go bindings terminate body)
  ;; body holds the user's runtime code
  (let ((bind (list))
        (init (list))
        (step (list)))
    (if (not (list? bindings))
        (error "go bindings not a list" bindings))
    (if (not (list? terminate))
        (error "go stopping clause not a list" terminate)
        (if (null? terminate)
            (error "go stopping clause missing test form")))
    (do ((tail bindings (cdr tail)))
        ((null? tail ) #f)
      (if (and (pair? (car tail))
               (< 0 (length (car tail)) 4)
               (symbol? (car (car tail))))
          (let* ((v (car (car tail)))
                 (i (cadr (car tail)))
                 (s (if (null? (cddr (car tail)))
                        #:null
                        (caddr (car tail))
                        )))
            (set! bind (append bind (list v)))
            (set! init (append init (list i)))
            (set! step (append step
                               (if (eq? s #:null) (list)
                                   (list `(set! ,v , s))))))
          (error "binding clause not a list (var init [step])"
                 (car tail))))
    (let ((elapsedvar (gensym)) ; closure param gets scheduler time
          (errorvar (gensym))
          (deltavar (gensym)))
      `((lambda (,@bind)
          (lambda (,elapsedvar)
            (let* ((,deltavar 0)
                   (elapsed (lambda () ,elapsedvar))
                   (wait (lambda (x) (set! ,deltavar x))))
              ;; wrap user forms inside condition-case
              (condition-case
               (cond (,(car terminate) ,@(cdr terminate)
                      -1)  ; closure return -1 = stop
                     (else
                      ,@body
                      ,@step
                      ,deltavar))
               (,errorvar (exn)
                (printf "~%>>> Aborting process at time ~S:~%    Error: ~S"
                        ,elapsedvar
                        ( (condition-property-accessor 'exn 'message)
                          ,errorvar))
                -2)))))   ; closure return -2 = error stop
                
        ,@init))))

;----------------
; error of (car i) gets handled correctly in evaled code but not in  
my csc code:

(define xxx (go ((i 0 (+ i 1))) ((= i 2) ) (car i)  ))
(xxx 99)

>>> Aborting process at time 99:
    Error: "bad argument type"-2

;----------------
; here is a real go im testing with

(go ((i 0 (+ i 1))
     (e 12)
     (k 60))
  ((= i e) #f) (declare (safety #t))
   (print (elapsed ))
   (mp:note 0 90 (+ k i) 80 0)
   (wait 100)))

; the correct macroexpasion in the csi:

((lambda (i e k)
   (lambda (g48)
     (let* ((g49 0) (elapsed (lambda () g48)) (wait (lambda (x)  
(set! g49 x))))
       ((call-with-current-continuation
          (lambda (g53)
            (with-exception-handler
              (lambda (g51)
                (g53 (lambda ()
                       (let ((g52 (and (##sys#structure? g51  
'condition)
                                       (##sys#slot g51 1))))
                         (cond ((and g52 (memv 'exn g52))
                                (let ((g50 g51))
                                  (printf
                                    "~%>>> Aborting process at time  
~S:~%    Error: ~S"
                                    g48
                                    ((condition-property-accessor  
'exn 'message) g50))
                                  -2))
                               (else (##sys#signal g51)))))))
              (lambda ()
                (##sys#call-with-values
                  (lambda ()
                    (cond ((= i e) #f -1)
                          (else
                           (print (elapsed))
                           (mp:note 0 90 (+ k i) 80 0)
                           (wait 100)
                           (set! i (+ i 1))
                           g49)))
                  (lambda g54
                    (g53 (lambda () (##sys#apply ##sys#values  
g54)))))))))))))
0
12
60)


;-------
; this is what happens when i csc compile the go macro an link to my  
c app.


(sprout
 (go ((i 0 (+ i 1))
     (e 12)
     (k 60))
  ((= i e) #f) (declare (safety #t))
   (print (elapsed ))
   (mp:note 0 90 (+ k i) 80 0)
   (wait 100)))
)

Error: unbound variable: exn

        Call history:

        <eval>          [foo] (mp:note 0 90 (+ k i) 80 0)
        <eval>          [foo] (+ k i)
        ChickenBridge.scm: 214  insert-midi-note
        ##sys#gc
        <eval>          [foo] (wait 100)
        <eval>          [foo] (+ i 1)
        <eval>          [foo] (g2 (exn) (printf ">>> Aborting  
process at time ~S:~%    Error: ~S" g0 ((condition-property- 
accessor......
        <eval>          [foo] (exn)     <--


[app crashes]