I removed DEFINE-SIMPLE-ERRNO-SYSCALL because it is simply a special

case of DEFINE-ERRNO-SYSCALL. However, this change causes simple errno
syscalls to return 0 values, which blows up I/O methods used in S48's
extensible port system, so I had to hack three or four of those methods
to return a random value (#F).

scsh/flock.scm

@@ -86,13 +86,9 @@
 ;;; The main routines
 ;;;;;;;;;;;;;;;;;;;;;
 
-(define (lock-region fdes lock)
+(define-errno-syscall (lock-region fdes lock)
-  (let lp ()
+  (lambda (fdes lock)
-    (cond ((call-lock-region %set-lock fcntl/set-record-lock fdes lock) =>
+    (call-lock-region %set-lock fcntl/set-record-lock fdes lock)))
-           (lambda (errno)
-	     (if (= errno errno/intr) (lp) 	; Retry on interrupt.
-		 (errno-error errno lock-region fdes lock)))))))
-
 
 ;;; Return true/false indicating success/failure.
 

scsh/newports.scm

@@ -62,12 +62,14 @@
 (define (fdport*-write-char data char)
   (check-arg open-fdport-data? data fdport*-write-char)
   (if (not (fdport-data:closed? data))
-      (%fdport*-write-char data char)))
+      (%fdport*-write-char data char))
+  #f) ; Bogus fix -- otherwise %fdport*-...'s 0-value return blows up S48.
 
 (define (fdport*-write-string data string)
   (check-arg open-fdport-data? data fdport*-write-string)
   (generic-write-string string 0 (string-length string) ; from rw.scm
-			write-fdport*-substring/errno data))
+			write-fdport*-substring/errno data)
+  #f)
 
 (define input-fdport-methods
   (make-input-port-methods close-fdport*
@@ -82,12 +84,13 @@
   (make-output-port-methods close-fdport*
 			    fdport*-write-char
 			    fdport*-write-string
-			    flush-fdport*		; force-output
+			    (lambda (d)			; force output
+			      (flush-fdport* d)
+			      #f) ; bogus workaround.
 			    fdport-null-method		; fresh-line
 			    fdport-null-method		; current-column
 			    fdport-null-method))	; current-row
 
-
 (define (fdport-data port)
   (let ((d ((cond ((extensible-input-port? port)
 		   extensible-input-port-local-data)

scsh/procobj.scm

@@ -218,11 +218,9 @@
 (define (%wait-pid pid flags)
   (let lp ()
     (receive (err pid status) (%wait-pid/errno pid flags)
-      (if err
+      (cond ((not err) (and (not (zero? pid)) status))	; pid=0 => none ready.
-	  (if (= err errno/intr) (lp)
+	    ((= err errno/intr) (lp))
-	      (errno-error err %wait-pid pid flags))
+	    (else (errno-error err %wait-pid pid flags))))))
-	  (and (not (zero? pid)) status)))))	; pid=0 => none ready.
-
 
 (define (%wait-any flags)
   (let lp ()

scsh/rw.scm

@@ -19,13 +19,12 @@
   (if (= start end) 0 ; Vacuous request.
       (let loop ()
 	(receive (err nread) (reader s start end source)
-	  (if err
+	  (cond ((not err) (and (not (zero? nread)) nread))
-	      (case err
+		((= err errno/intr) (loop))
-		((errno/intr) (loop))
+		((or (= err errno/wouldblock)	; No forward-progess here.
-		((errno/wouldblock errno/again) 0) ; No forward-progess here.
+		     (= err errno/again))
-		(else (errno-error err reader
+		 0)
-				   s start start end source)))
+		(else (errno-error err reader s start start end source)))))))
-	      (and (not (zero? nread)) nread))))))
 
 (define (read-string!/partial s . args)
   (let-optionals args ((fd/port (current-input-port))
@@ -132,13 +131,11 @@
   (if (= start end) 0			; Vacuous request.
       (let loop ()
 	(receive (err nwritten) (writer s start end target)
-	  (if err
+	  (cond ((not err) nwritten)
-	      (case err
+		((= err errno/intr) (loop))
-		((errno/intr) (loop))
+		((or (= err errno/again) (= err errno/wouldblock)) 0)
-		((errno/again errno/wouldblock) 0)
 		(else (errno-error err writer
-				   s start start end target)))
+				   s start start end target)))))))
-	      nwritten)))))
 
 (define (write-string/partial s . args)
   (let-optionals args ((fd/port (current-output-port))
@@ -164,12 +161,10 @@
   (let loop ((i start))
     (if (< i end)
 	(receive (err nwritten) (writer s i end target)
-	  (if err
+	  (cond ((not err) (loop (+ i nwritten)))
-	      (case err
+		((= err errno/intr) (loop i))
-		((errno/intr) (loop i))
 		(else (errno-error err writer
-				   s start i end target)))
+				   s start i end target)))))))
-	      (loop (+ i nwritten)))))))
 
 (define (write-string s . args)
   (let-optionals args ((fd/port (current-output-port))

scsh/syscalls.scm

@@ -66,6 +66,15 @@
 	       ((= err errno/intr) (apply syscall args))	; Retry
 	       (else (apply errno-error err syscall args)))))))); Lose
 
+;;; By the way, it would be better to insert a (LET LP () ...) for the
+;;; the errno/intr retries, instead of calling the top-level definition
+;;; (because in Scheme you have to allow for the fact that top-level
+;;; defns can be re-defined, so the compiler can't just turn it into a
+;;; jump), but the brain-dead S48 byte-compiler will cons a closure for
+;;; the LP loop, which means that little syscalls like read-char can cons
+;;; like crazy. So I'm doing it this way. Ech.
+
+
 ;;; Process
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -975,11 +984,20 @@
 (define-errno-syscall (%fdport*-write-char desc c)
   %fdport*-write-char/errno)
 
-
 (define-foreign flush-fdport*/errno (flush_fdport (desc data))
   (to-scheme integer "False_on_zero")) 	; Win: #f, lose: errno
 
-(define-errno-syscall (flush-fdport* data) flush-fdport*/errno)
+;;; FLUSH-FDPORT* isn't defined with DEFINE-ERRNO-SYSCALL because that would
+;;; return 0 values, which blows up S48's extended-port machinery. This
+;;; version returns #f.
+;;; ???
+
+(define (flush-fdport* data)
+  (cond ((flush-fdport*/errno data) =>
+         (lambda (err) (if (= err errno/intr)
+			   (flush-fdport* data)
+			   (errno-error err flush-fdport* data))))
+	(else #f)))
 
 (define-foreign flush-all-ports/errno (flush_all_ports)
   (to-scheme integer errno_or_false))