[[project @ 1997-01-18 18:13:32 by ghouston] ghouston**19970118181334 Ignore-this: 846761a5d7b20009fd5b9e4b3b887d26 * init.scm (index, rindex): replace versions in utilities.scm with primitives. load errno.scm. * rw.scm: globally replace :optional with optional. comment out y-or-n? and *y-or-n-eof-count*. (read-string!/partial, generic-read-string!/partial, generic-read-string!, read-string!, generic-write-string/partial, write-string/partial, generic-write-string, write-string): use guile primitives. * netconst.scm: undefine maybe-define and maybe-define-so after use. * errno.scm: new file. ] hunk ./ChangeLog 1 +Sat Jan 18 00:52:14 1997 Gary Houston + + * init.scm (index, rindex): replace versions in utilities.scm with + primitives. + load errno.scm. + + * rw.scm: globally replace :optional with optional. + comment out y-or-n? and *y-or-n-eof-count*. + (read-string!/partial, generic-read-string!/partial, + generic-read-string!, read-string!, generic-write-string/partial, + write-string/partial, generic-write-string, write-string): + use guile primitives. + + * netconst.scm: undefine maybe-define and maybe-define-so after use. + * errno.scm: new file. + hunk ./ChangeLog 23 - remove a few SO_ types which don't appear in SCSH's netconst.scm. + remove a few SO_ types which don't appear in scsh's netconst.scm. hunk ./ChangeLog 39 - (receive-message): use the SCSH definition. + (receive-message): use the scsh definition. hunk ./ChangeLog 45 - * rw.scm: copied from SCSH. + * rw.scm: copied from scsh. hunk ./ChangeLog 53 - * let-opt.scm: new copy from SCSH. replace :optional with optional. + * let-opt.scm: new copy from scsh. replace :optional with optional. hunk ./ChangeLog 88 - * network.scm: copied from SCSH + * network.scm: copied from scsh hunk ./ChangeLog 95 - * defrec.scm: copied from SCSH. + * defrec.scm: copied from scsh. hunk ./ChangeLog 97 - * syntax.scm: copied from SCSH. + * syntax.scm: copied from scsh. hunk ./ChangeLog 103 - * receive.scm: copied from SCSH. + * receive.scm: copied from scsh. hunk ./ChangeLog 122 - * COPYING, let-opt.scm, utilities.scm: from SCSH 0.4.4. + * COPYING, let-opt.scm, utilities.scm: from scsh 0.4.4. hunk ./INCOMPAT 1 -Incompatibilities with SCSH 0.4.4: +Incompatibilities with scsh 0.4.4: hunk ./INCOMPAT 11 -and receive-message (bug in SCSH?) +and receive-message (bug in scsh?) hunk ./INCOMPAT 13 -network-info works when its argument is a socket address (bug in SCSH?) +network-info works when its argument is a socket address (bug in scsh?) hunk ./init.scm 34 +;; replace procedures in utilities.scm with guile primitives. +(set! index string-index) +(set! rindex string-rindex) + +(load-from-path "scsh/errno.scm") + hunk ./netconst.scm 54 +(undefine maybe-define) +(undefine maybe-define-so) + hunk ./rw.scm 3 +;;; modified to use Guile primitives. hunk ./rw.scm 22 - (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))))))) + (catch 'system-error + (lambda () + (let ((nread (reader s source start (- end start)))) + (and (not (zero? nread)) nread))) + (lambda args + (let ((err (car (list-ref args 4)))) + (cond ;; ((= err errno/intr) (loop)) ; handled by primitive. + ((or (= err errno/wouldblock); No forward-progess here. + (= err errno/again)) + 0) + (else (apply scm-error args))))))))) hunk ./rw.scm 38 - (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)))))))))))) + (generic-read-string!/partial s start end + uniform-array-read! + fd/port))) hunk ./rw.scm 44 - (fd/port (:optional maybe-fd/port (current-input-port))) + (fd/port (optional maybe-fd/port (current-input-port))) hunk ./rw.scm 60 - (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)))))))) + (catch 'system-error + (lambda () + (let ((nread (reader s source i (- end i)))) + (if (zero? nread) ; EOF + (let ((result (- i start))) + (and (not (zero? result)) result)) + (loop (+ i nread))))) + (lambda args + ;; Give info on partially-read data in error packet. + (set-cdr! (list-ref args 4) s) + (apply scm-error args)))))) hunk ./rw.scm 76 - (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))))))))))) + (generic-read-string! s start end + uniform-array-read! + fd/port))) hunk ./rw.scm 82 - (fd/port (:optional maybe-fd/port (current-input-port))) + (fd/port (optional maybe-fd/port (current-input-port))) hunk ./rw.scm 99 - (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))))))) + (catch 'system-error + (lambda () + (let ((nwritten (writer s target start (- end start)))) + nwritten)) + (lambda args + (let ((err (car (list-ref args 4)))) + (cond ;; ((= err errno/intr) (loop)) ; handled by primitive. + ((or (= err errno/wouldblock); No forward-progess here. + (= err errno/again)) + 0) + (else (apply scm-error args))))))))) hunk ./rw.scm 115 - (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 + (generic-write-string/partial s start end + uniform-array-write fd/port))) hunk ./rw.scm 128 - (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))))))) + (catch 'system-error + (lambda () + (let ((nwritten (writer s target i (- end i)))) + + (loop (+ i nwritten)))) + (lambda args + (apply scm-error args)))))) hunk ./rw.scm 140 - (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 + (generic-write-string s start end + uniform-array-write fd/port))) hunk ./rw.scm 143 -(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? 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)))))) hunk ./rw.scm 162 -(define *y-or-n-eof-count* 100) +;(define *y-or-n-eof-count* 100)