From 804362834ba118b0cb85c1e679c09292bc9e9618 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 8 Jan 2003 09:16:47 +0000
Subject: [PATCH] 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
---
 scheme/vm/prim-io.scm   |  8 ++++++--
 scsh/scsh-condition.scm | 16 +++++++++++++++-
 scsh/scsh-package.scm   |  2 ++
 3 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/scheme/vm/prim-io.scm b/scheme/vm/prim-io.scm
index c65cd19..e6bbe59 100644
--- a/scheme/vm/prim-io.scm
+++ b/scheme/vm/prim-io.scm
@@ -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)
diff --git a/scsh/scsh-condition.scm b/scsh/scsh-condition.scm
index 87347e9..90fdc81 100644
--- a/scsh/scsh-condition.scm
+++ b/scsh/scsh-condition.scm
@@ -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))
 
diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm
index 19827ba..35836a5 100644
--- a/scsh/scsh-package.scm
+++ b/scsh/scsh-package.scm
@@ -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))