Extend with-errno to capture all I/O exceptions of the VM:
+ add errno as first argument to raise-exception os-error in prim-io.scm + capture os-error in with-errno-handler* and adjust exception arguments to fit errno-handlers
This commit is contained in:
parent
13a3bf55d2
commit
804362834b
|
@ -35,6 +35,7 @@
|
|||
(raise-exception* reason 0 spec (enter-fixnum mode))))
|
||||
(os-lose (lambda (status)
|
||||
(raise-exception os-error 0
|
||||
(enter-fixnum status)
|
||||
spec
|
||||
(enter-fixnum mode)
|
||||
(get-error-string status key))))
|
||||
|
@ -80,7 +81,7 @@
|
|||
(if (open? channel)
|
||||
(let ((status (close-channel! channel)))
|
||||
(if (error? status)
|
||||
(raise-exception os-error 0 channel (get-error-string status key))
|
||||
(raise-exception os-error 0 (enter-fixnum status) channel (get-error-string status key))
|
||||
(goto no-result)))
|
||||
(raise-exception wrong-type-argument 0 channel))))
|
||||
|
||||
|
@ -92,7 +93,7 @@
|
|||
(channel-ready? (extract-channel channel)
|
||||
(input-channel? channel))
|
||||
(if (error? status)
|
||||
(raise-exception os-error 0 channel (get-error-string status key))
|
||||
(raise-exception os-error 0 (enter-fixnum status) channel (get-error-string status key))
|
||||
(goto return-boolean ready?)))
|
||||
(raise-exception wrong-type-argument 0 channel))))
|
||||
|
||||
|
@ -116,6 +117,7 @@
|
|||
(os-lose (lambda (status)
|
||||
(if read?
|
||||
(raise-exception os-error 0
|
||||
(enter-fixnum status)
|
||||
thing
|
||||
(enter-fixnum start)
|
||||
(enter-fixnum count)
|
||||
|
@ -123,6 +125,7 @@
|
|||
channel
|
||||
(get-error-string status key))
|
||||
(raise-exception os-error 0
|
||||
(enter-fixnum status)
|
||||
thing
|
||||
(enter-fixnum start)
|
||||
(enter-fixnum count)
|
||||
|
@ -403,6 +406,7 @@
|
|||
(lambda (filename resume-proc comment-string key)
|
||||
(let* ((lose (lambda (reason status)
|
||||
(raise-exception* reason 0
|
||||
(enter-fixnum status)
|
||||
filename resume-proc comment-string
|
||||
(get-error-string status key))))
|
||||
(port-lose (lambda (reason status port)
|
||||
|
|
|
@ -17,7 +17,21 @@
|
|||
(if (syscall-error? condition)
|
||||
(let ((stuff (condition-stuff condition)))
|
||||
(handler (car stuff) ; errno
|
||||
(cdr stuff)))) ; (msg syscall . packet)
|
||||
(cdr stuff))) ; (msg syscall . packet)
|
||||
;; capture VM exceptions (currently only prim-io.scm)
|
||||
(if (and (exception? condition)
|
||||
(eq? (exception-reason condition)
|
||||
'os-error))
|
||||
(let ((stuff (condition-stuff condition)))
|
||||
(if (> (length stuff) 3)
|
||||
(handler (caddr stuff) ; errno
|
||||
(cons
|
||||
(last stuff) ; msg
|
||||
(cons
|
||||
(enumerand->name ; syscall (almost ...)
|
||||
(exception-opcode condition) op)
|
||||
; packet:
|
||||
(drop-right (cdddr stuff) 1))))))))
|
||||
(more))
|
||||
thunk))
|
||||
|
||||
|
|
|
@ -105,6 +105,8 @@
|
|||
|
||||
(define-structure scsh-errors scsh-errors-interface
|
||||
(open scheme
|
||||
architecture
|
||||
(subset srfi-1 (last drop-right))
|
||||
handle conditions signals)
|
||||
(files scsh-condition))
|
||||
|
||||
|
|
Loading…
Reference in New Issue