31 lines
896 B
Scheme
31 lines
896 B
Scheme
|
(define-syntax import-os-error-syscall
|
||
|
|
(syntax-rules ()
|
||
|
|
((import-os-error-syscall syscall (%arg ...) c-name)
|
||
|
|
(begin
|
||
|
|
(import-lambda-definition syscall/eintr (%arg ...) c-name)
|
||
|
|
(define (syscall %arg ...)
|
||
|
|
(let ((arg %arg) ...)
|
||
|
|
(continuation-capture
|
||
|
|
(lambda (cont)
|
||
|
|
(let loop ()
|
||
|
|
(with-handler
|
||
|
|
(lambda (condition more)
|
||
|
|
(if (and (exception? condition) (eq? (exception-reason condition)
|
||
|
|
'os-error))
|
||
|
|
(let ((stuff (exception-arguments condition)))
|
||
|
|
(if (= (cadr stuff) errno/intr)
|
||
|
|
(loop)
|
||
|
|
(continuation-graft
|
||
|
|
cont
|
||
|
|
(lambda ()
|
||
|
|
(apply errno-error
|
||
|
|
(cadr stuff) ; errno
|
||
|
|
(caddr stuff) ;msg
|
||
|
|
syscall
|
||
|
|
(cdddr stuff)))))) ;packet
|
||
|
|
(more)))
|
||
|
|
(lambda ()
|
||
|
|
(syscall/eintr %arg ...))))))))))))
|
||
|
|
|
||
|
|
(import-os-error-syscall errno-msg (i) "errno_msg")
|