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:
mainzelm 2003-01-08 09:16:47 +00:00
parent 13a3bf55d2
commit 804362834b
3 changed files with 23 additions and 3 deletions

View File

@ -35,6 +35,7 @@
(raise-exception* reason 0 spec (enter-fixnum mode)))) (raise-exception* reason 0 spec (enter-fixnum mode))))
(os-lose (lambda (status) (os-lose (lambda (status)
(raise-exception os-error 0 (raise-exception os-error 0
(enter-fixnum status)
spec spec
(enter-fixnum mode) (enter-fixnum mode)
(get-error-string status key)))) (get-error-string status key))))
@ -80,7 +81,7 @@
(if (open? channel) (if (open? channel)
(let ((status (close-channel! channel))) (let ((status (close-channel! channel)))
(if (error? status) (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))) (goto no-result)))
(raise-exception wrong-type-argument 0 channel)))) (raise-exception wrong-type-argument 0 channel))))
@ -92,7 +93,7 @@
(channel-ready? (extract-channel channel) (channel-ready? (extract-channel channel)
(input-channel? channel)) (input-channel? channel))
(if (error? status) (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?))) (goto return-boolean ready?)))
(raise-exception wrong-type-argument 0 channel)))) (raise-exception wrong-type-argument 0 channel))))
@ -116,6 +117,7 @@
(os-lose (lambda (status) (os-lose (lambda (status)
(if read? (if read?
(raise-exception os-error 0 (raise-exception os-error 0
(enter-fixnum status)
thing thing
(enter-fixnum start) (enter-fixnum start)
(enter-fixnum count) (enter-fixnum count)
@ -123,6 +125,7 @@
channel channel
(get-error-string status key)) (get-error-string status key))
(raise-exception os-error 0 (raise-exception os-error 0
(enter-fixnum status)
thing thing
(enter-fixnum start) (enter-fixnum start)
(enter-fixnum count) (enter-fixnum count)
@ -403,6 +406,7 @@
(lambda (filename resume-proc comment-string key) (lambda (filename resume-proc comment-string key)
(let* ((lose (lambda (reason status) (let* ((lose (lambda (reason status)
(raise-exception* reason 0 (raise-exception* reason 0
(enter-fixnum status)
filename resume-proc comment-string filename resume-proc comment-string
(get-error-string status key)))) (get-error-string status key))))
(port-lose (lambda (reason status port) (port-lose (lambda (reason status port)

View File

@ -17,7 +17,21 @@
(if (syscall-error? condition) (if (syscall-error? condition)
(let ((stuff (condition-stuff condition))) (let ((stuff (condition-stuff condition)))
(handler (car stuff) ; errno (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)) (more))
thunk)) thunk))

View File

@ -105,6 +105,8 @@
(define-structure scsh-errors scsh-errors-interface (define-structure scsh-errors scsh-errors-interface
(open scheme (open scheme
architecture
(subset srfi-1 (last drop-right))
handle conditions signals) handle conditions signals)
(files scsh-condition)) (files scsh-condition))