[[project @ 1997-01-06 21:01:53 by ghouston]
ghouston**19970106210156
 Ignore-this: e8a168974407f371a64a4e6cb17fb83d
 * network.scm (generic-receive-message!): use guile primitives.
 (receive-message!): minor change.
 (receive-message): use the SCSH definition.
 (generic-receive-mesage/partial, receive-message/partial,
 receive-message!/partial): similar.
 
 * init.scm: load rw.scm
 
 * rw.scm: copied from SCSH.
] addfile ./rw.scm
hunk ./ChangeLog 1
+Mon Jan  6 05:00:19 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* network.scm (generic-receive-message!): use guile primitives.
+	(receive-message!): minor change.
+	(receive-message): use the SCSH definition.
+	(generic-receive-mesage/partial, receive-message/partial,
+	receive-message!/partial): similar.
+
+	* init.scm: load rw.scm
+
+	* rw.scm: copied from SCSH.
+
hunk ./ChangeLog 30
-	create-socket-pair, receive-message,
-
-	use Guile network primitives.
+	create-socket-pair, receive-message: use Guile network primitives.
hunk ./INCOMPAT 2
-a lot of stuff is missing
-:optional renamed to optional
-everything is defined at the top level, no modules
+
+a lot of stuff is missing.
+
+:optional renamed to optional.
+
+everything is defined at the top level, no modules.
+
+generic-receive-message! always returns 2 values: the number of
+bytes read and the address received from.  Likewise for receive-message!
+and receive-message (bug in SCSH?)
hunk ./init.scm 11
-(define-module (guile) :use-module (ice-9 slib))
-(require 'values)
-
-(load-from-path "scsh/syntax.scm")
-
hunk ./init.scm 22
-(load-from-path "scsh/receive.scm")
+(define-module (guile) :use-module (ice-9 slib))
+(require 'values)
hunk ./init.scm 25
+(load-from-path "scsh/syntax.scm")
+(load-from-path "scsh/receive.scm")
hunk ./init.scm 33
+(load-from-path "scsh/rw.scm")
hunk ./network.scm 377
-	   (recv (socket->port socket) len flags)))))
+	   (let ((s (make-string len)))
+	     (receive (nread from)
+		      (receive-message! socket s 0 len flags)
+               (values
+		(cond ((not nread) #f)	; EOF
+		      ((= nread len) s)
+		      (else (substring s 0 nread)))
+		from)))))))
hunk ./network.scm 398
-	       (recv (socket->port socket) flags
+	       (generic-receive-message! (socket->port socket) flags
hunk ./network.scm 400
-					 recv-substring!/errno
+					 'dummy
hunk ./network.scm 405
-      (error "Bad substring indices" 
-	     reader sockfd flags
-	     s start end from))
-  (let ((addr (make-addr from)))
-    (let loop ((i start))
-      (if (>= i end) (- i start)
-	  (receive (err nread) 
-		   (reader sockfd flags s i end addr)
-	     (cond (err (if (= err errno/intr) (loop i)
-		         ;; Give info on partially-read data in error packet.
-			    (errno-error err reader sockfd flags
-					 s start i end addr)))
-
-		   ((zero? nread)	; EOF
-		    (values
-		     (let ((result (- i start)))
-		       (and (not (zero? result)) result))
-		     from))
-		   (else (loop (+ i nread)))))))))
+      (error "Bad substring indices" s start end))
+  (let loop ((i start)
+	     (addr #f))
+    (if (>= i end) (values (- i start)
+			   (make-socket-address from addr))
+	(let* ((rv (recvfrom sockfd (list s i end) flags))
+	       (nread (cadr rv))
+	       (addr (caddr rv)))
+	  (cond
+	   ((zero? nread)	; EOF
+	    (values
+	     (let ((result (- i start)))
+	       (and (not (zero? result)) result))
+	     (make-socket-address from addr)))
+	   (else (loop (+ i nread) addr)))))))
hunk ./network.scm 449
-	       (generic-receive-message!/partial (socket->fdes socket)
+	       (generic-receive-message!/partial (socket->port socket)
hunk ./network.scm 452
-						 recv-substring!/errno
+						 'dummy
hunk ./network.scm 460
-      (let ((addr (make-addr from)))
-	(let loop ()
-	  (receive (err nread) 
-		   (reader sockfd flags s start end addr)
-
-	     (cond ((not err)
-		    (values (and (not (zero? nread)) nread)
-			    (make-socket-address from addr)))
-
-		   ((= err errno/intr) (loop))
-
-		   ; No forward-progess here.
-		   ((or (= err errno/wouldblock)
-			(= err errno/again))
-		    0) 
-
-		   (else (errno-error err reader sockfd flags
-				      s start start end addr))))))))
+      (let* ((rv (recvfrom sockfd (list s start end) flags))
+	     (nread (cadr rv))
+	     (addr (caddr rv)))
+	(values (and (not (zero? nread)) nread)
+		(make-socket-address from addr)))))
hunk ./rw.scm 1
+;;; Basic read and write
+;;; Copyright (c) 1993 by Olin Shivers.
+
+;;; Note: read ops should check to see if their string args are mutable.
+
+(define (bogus-substring-spec? s start end)
+  (or (< start 0)
+      (< (string-length s) end)
+      (< end start)))
+
+
+;;; Best-effort/forward-progress reading 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (generic-read-string!/partial s start end reader source)
+  (if (bogus-substring-spec? s start end)
+      (error "Bad substring indices" reader source s start end))
+
+  (if (= start end) 0 ; Vacuous request.
+      (let loop ()
+	(receive (err nread) (reader s start end source)
+	  (cond ((not err) (and (not (zero? nread)) nread))
+		((= err errno/intr) (loop))
+		((or (= err errno/wouldblock)	; No forward-progess here.
+		     (= err errno/again))
+		 0)
+		(else (errno-error err reader s start start end source)))))))
+
+(define (read-string!/partial s . args)
+  (let-optionals args ((fd/port (current-input-port))
+		       (start   0)
+		       (end     (string-length s)))
+    (cond ((integer? fd/port)
+	   (generic-read-string!/partial s start end
+					 read-fdes-substring!/errno fd/port))
+	  ((fdport? fd/port)
+	   (generic-read-string!/partial s start end
+					 read-fdport*-substring!/errno 
+					 (extensible-port-local-data fd/port)))
+
+	  (else ; Hack it for base S48 ports
+	   ;; This case is a little gross in order to get 
+	   ;; the forward-progress guarantee and handle non-blocking i/o.
+	   ;; Unix sux. So do low-level Scheme looping constructs.
+	   (if (>= start end) 0
+	       (let lp ((i start))
+		 (let ((c (with-errno-handler
+			      ((err data) ((errno/wouldblock errno/again) #f))
+			    (read-char fd/port))))
+		   (cond ((not c) (- i start)) ; non-blocking i/o bailout
+			 ((eof-object? c)
+			  (let ((nread (- i start)))
+			    (and (not (zero? nread)) nread)))
+			 (else
+			  (string-set! s i c)
+			  (let ((i (+ i 1)))
+			    (if (or (= i end) (not (char-ready? fd/port)))
+				(- i start)
+				(lp i))))))))))))
+
+(define (read-string/partial len . maybe-fd/port) 
+  (let* ((s (make-string len))
+	 (fd/port (:optional maybe-fd/port (current-input-port)))
+	 (nread (read-string!/partial s fd/port 0 len)))
+    (cond ((not nread) #f) ; EOF
+	  ((= nread len) s)
+	  (else (substring s 0 nread)))))
+
+
+;;; Persistent reading
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (generic-read-string! s start end reader source)
+  (if (bogus-substring-spec? s start end)
+      (error "Bad substring indices" reader source s start end))
+
+  (let loop ((i start))
+    (if (>= i end) (- i start)
+	(receive (err nread) (reader s i end source)
+	  (cond (err (if (= err errno/intr) (loop i)
+			 ;; Give info on partially-read data in error packet.
+			 (errno-error err reader
+				      s start i end source)))
+
+		((zero? nread) ; EOF
+		 (let ((result (- i start)))
+		   (and (not (zero? result)) result)))
+
+		(else (loop (+ i nread))))))))
+
+(define (read-string! s . args)
+  (let-optionals args ((fd/port (current-input-port))
+		       (start   0)
+		       (end     (string-length s)))
+    (cond ((integer? fd/port)
+	   (generic-read-string! s start end
+				 read-fdes-substring!/errno fd/port))
+
+	  ((fdport? fd/port)
+	   (generic-read-string! s start end
+				 read-fdport*-substring!/errno
+				 (extensible-port-local-data fd/port)))
+
+	  ;; Hack it
+	  (else (let lp ((i start))
+		  (if (= i end) (- end start)
+		      (let ((c (read-char fd/port)))
+			(if (eof-object? c)
+			    (let ((nread (- i start)))
+			      (and (not (zero? nread)) nread))
+			    (begin (string-set! s i c)
+				   (lp (+ i 1)))))))))))
+
+(define (read-string len . maybe-fd/port) 
+  (let* ((s (make-string len))
+	 (fd/port (:optional maybe-fd/port (current-input-port)))
+	 (nread (read-string! s fd/port 0 len)))
+    (cond ((not nread) #f) ; EOF
+	  ((= nread len) s)
+	  (else (substring s 0 nread)))))
+
+
+;;; Best-effort/forward-progress writing
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Non-blocking output to a buffered port is not defined.
+
+(define (generic-write-string/partial s start end writer target)
+  (if (bogus-substring-spec? s start end)
+      (error "Bad substring indices" writer s start end target))
+
+  (if (= start end) 0			; Vacuous request.
+      (let loop ()
+	(receive (err nwritten) (writer s start end target)
+	  (cond ((not err) nwritten)
+		((= err errno/intr) (loop))
+		((or (= err errno/again) (= err errno/wouldblock)) 0)
+		(else (errno-error err writer
+				   s start start end target)))))))
+
+(define (write-string/partial s . args)
+  (let-optionals args ((fd/port (current-output-port))
+		       (start 0)
+		       (end (string-length s)))
+    (cond ((integer? fd/port)
+	   (generic-write-string/partial s start end
+					 write-fdes-substring/errno fd/port))
+	  ((fdport? fd/port)
+	   (generic-write-string/partial s start end
+					 write-fdport*-substring/errno
+					 (extensible-port-local-data fd/port)))
+	  (else (display (substring s start end) fd/port))))) ; hack
+
+
+;;; Persistent writing
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (generic-write-string s start end writer target)
+  (if (bogus-substring-spec? s start end)
+      (error "Bad substring indices" writer s start end target))
+
+  (let loop ((i start))
+    (if (< i end)
+	(receive (err nwritten) (writer s i end target)
+	  (cond ((not err) (loop (+ i nwritten)))
+		((= err errno/intr) (loop i))
+		(else (errno-error err writer
+				   s start i end target)))))))
+
+(define (write-string s . args)
+  (let-optionals args ((fd/port (current-output-port))
+		       (start   0)
+		       (end     (string-length s)))
+    (cond ((integer? fd/port)
+	   (generic-write-string s start end
+				 write-fdes-substring/errno fd/port))
+	  ((fdport? fd/port)
+	   (generic-write-string s start end
+				 write-fdport*-substring/errno
+				 (extensible-port-local-data fd/port)))
+
+	  (else (display (substring s start end) fd/port))))) ; hack
+
+(define (y-or-n? question . maybe-eof-value)
+  (let loop ((count *y-or-n-eof-count*))
+    (display question)
+    (display " (y/n)? ")
+    (let ((line (read-line)))
+      (cond ((eof-object? line)
+	     (newline)
+	     (if (= count 0)
+		 (:optional maybe-eof-value (error "EOF in y-or-n?"))
+		 (begin (display "I'll only ask another ")
+			(write count)
+			(display " times.")
+			(newline)
+			(loop (- count 1)))))
+	    ((< (string-length line) 1) (loop count))
+	    ((char=? (string-ref line 0) #\y) #t)
+	    ((char=? (string-ref line 0) #\n) #f)
+	    (else (loop count))))))
+
+(define *y-or-n-eof-count* 100)