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

View File

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

View File

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