Teach the runtime system how to handle files whose lines end in

something other than newline.

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 005e3202d7f633b89e359541000bd7a680cee336..47b681e65c9ae9c6e1d9a345fb67320d3c3f3008 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dospth.scm,v 1.2 1992/04/14 18:13:54 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dospth.scm,v 1.3 1992/04/16 05:13:05 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -61,7 +61,8 @@ MIT in each case. |#
                  dos/pathname->truename
                  dos/user-homedir-pathname
                  dos/init-file-pathname
-                 dos/pathname-simplify))
+                 dos/pathname-simplify
+                 dos/end-of-line-string))
 
 (define (initialize-package!)
   (add-pathname-host-type! 'DOS make-dos-host-type))
@@ -339,4 +340,8 @@ MIT in each case. |#
                                 (->namestring pathname)
                                 (->namestring pathname*))
                                pathname*)))))))
-      pathname))
\ No newline at end of file
+      pathname))
+
+(define (dos/end-of-line-string pathname)
+  pathname                             ; ignored
+  "\r\n")
\ No newline at end of file

diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm
index 36dda7389e16e9a74d23e62187b696f3292bcdbc..eca87c446d005d7fe5381c0f0e8192e7c87d89db 100644 (file)
--- a/v7/src/runtime/fileio.scm
+++ b/v7/src/runtime/fileio.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/fileio.scm,v 1.3 1992/02/10 15:57:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/fileio.scm,v 1.4 1992/04/16 05:12:36 jinx Exp $
 
-Copyright (c) 1991-92 Massachusetts Institute of Technology
+Copyright (c) 1991-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -97,18 +97,79 @@ MIT in each case. |#
 (define i/o-file-template)
 \f
 (define (open-input-file filename)
+  (let* ((pathname (merge-pathnames filename))
+        (channel (file-open-input-channel (->namestring pathname)))
+        (port
+         (port/copy input-file-template
+                    (make-file-state
+                     (make-input-buffer channel
+                                        input-buffer-size
+                                        (pathname-newline-translation
+                                         pathname))
+                     false
+                     pathname))))
+    (set-channel-port! channel port)
+    port))
+
+(define (open-output-file filename #!optional append?)
+  (let* ((pathname (merge-pathnames filename))
+        (channel
+         (let ((filename (->namestring pathname)))
+           (if (and (not (default-object? append?)) append?)
+               (file-open-append-channel filename)
+               (file-open-output-channel filename))))
+        (port
+         (port/copy output-file-template
+                    (make-file-state
+                     false
+                     (make-output-buffer channel
+                                         output-buffer-size
+                                         (pathname-newline-translation
+                                          pathname))
+                     pathname))))
+    (set-channel-port! channel port)
+    port))
+
+(define (open-i/o-file filename)
+  (let* ((pathname (merge-pathnames filename))
+        (channel (file-open-io-channel (->namestring pathname)))
+        (port
+         (let ((translation (pathname-newline-translation pathname)))
+           (port/copy i/o-file-template
+                      (make-file-state (make-input-buffer
+                                        channel
+                                        input-buffer-size
+                                        translation)
+                                       (make-output-buffer
+                                        channel
+                                        output-buffer-size
+                                        translation)
+                                       pathname)))))
+    (set-channel-port! channel port)
+    port))
+
+(define (pathname-newline-translation pathname)
+  (let ((end-of-line (pathname-end-of-line-string pathname)))
+    (and (not (string=? "\n" end-of-line))
+        end-of-line)))
+\f
+(define input-buffer-size 512)
+(define output-buffer-size 512)
+
+(define (open-binary-input-file filename)
   (let* ((pathname (merge-pathnames filename))
         (channel (file-open-input-channel (->namestring pathname)))
         (port
          (port/copy input-file-template
                     (make-file-state (make-input-buffer channel
-                                                        input-buffer-size)
+                                                        input-buffer-size
+                                                        false)
                                      false
                                      pathname))))
     (set-channel-port! channel port)
     port))
 
-(define (open-output-file filename #!optional append?)
+(define (open-binary-output-file filename #!optional append?)
   (let* ((pathname (merge-pathnames filename))
         (channel
          (let ((filename (->namestring pathname)))
@@ -119,26 +180,26 @@ MIT in each case. |#
          (port/copy output-file-template
                     (make-file-state false
                                      (make-output-buffer channel
-                                                         output-buffer-size)
+                                                         output-buffer-size
+                                                         false)
                                      pathname))))
     (set-channel-port! channel port)
     port))
 
-(define (open-i/o-file filename)
+(define (open-binary-i/o-file filename)
   (let* ((pathname (merge-pathnames filename))
         (channel (file-open-io-channel (->namestring pathname)))
         (port
          (port/copy i/o-file-template
                     (make-file-state (make-input-buffer channel
-                                                        input-buffer-size)
+                                                        input-buffer-size
+                                                        false)
                                      (make-output-buffer channel
-                                                         output-buffer-size)
+                                                         output-buffer-size
+                                                         false)
                                      pathname))))
     (set-channel-port! channel port)
     port))
-
-(define input-buffer-size 512)
-(define output-buffer-size 512)
 \f
 (define-structure (file-state (type vector)
                              (conc-name file-state/))

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 5753722dd1848d04dd3e069c2504af3be08d6996..b108c313d09d44a1ddbf9e6701eb05783ae7720f 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.29 1992/02/08 15:08:29 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.30 1992/04/16 05:12:27 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -521,43 +521,73 @@ MIT in each case. |#
                   (constructor %make-output-buffer))
   (channel false read-only true)
   string
-  position)
-
-(define (make-output-buffer channel buffer-size)
-  (%make-output-buffer channel
-                      (and (fix:> buffer-size 0) (make-string buffer-size))
-                      0))
+  position
+  line-translation                     ; string that newline maps to
+  logical-size)
+
+(define (output-buffer-sizes translation buffer-size)
+  (let ((logical-size
+        (if (and translation (fix:< buffer-size 1))
+            1
+            buffer-size)))
+    (values logical-size
+           (if (not translation)
+               logical-size
+               (fix:+ logical-size
+                      (fix:- (string-length translation) 1))))))
+
+(define (make-output-buffer channel buffer-size #!optional line-translation)
+  (let ((translation (and (not (default-object? line-translation))
+                         line-translation)))
+    (with-values
+       (lambda ()
+         (output-buffer-sizes translation
+                              buffer-size))
+      (lambda (logical-size string-size)
+       (%make-output-buffer channel
+                            (and (fix:> string-size 0) (make-string string-size))
+                            0
+                            translation
+                            logical-size)))))
 
 (define (output-buffer/close buffer)
   (output-buffer/drain-block buffer)
   (channel-close (output-buffer/channel buffer)))
 
 (define (output-buffer/size buffer)
-  (let ((string (output-buffer/string buffer)))
-    (if string
-       (string-length string)
-       0)))
+  (output-buffer/logical-size buffer))
 
 (define (output-buffer/set-size buffer buffer-size)
   (output-buffer/drain-block buffer)
-  (set-output-buffer/string! buffer
-                            (and (fix:> buffer-size 0)
-                                 (make-string buffer-size))))
+  (with-values
+      (lambda ()
+       (output-buffer-sizes (output-buffer/line-translation buffer)
+                            buffer-size))
+    (lambda (logical-size string-size)
+      (set-output-buffer/logical-size! buffer logical-size)
+      (set-output-buffer/string!
+       buffer
+       (and (fix:> string-size 0) (make-string string-size))))))
 
 (define output-buffer/buffered-chars
   output-buffer/position)
-
+\f
 (define (output-buffer/drain buffer)
   (let ((string (output-buffer/string buffer))
        (position (output-buffer/position buffer)))
     (if (or (not string) (zero? position))
        0
-       (let ((n
-              (channel-write (output-buffer/channel buffer)
-                             string 0 position)))
+       (let ((n (channel-write
+                 (output-buffer/channel buffer)
+                 string
+                 0
+                 (let ((logical-size (output-buffer/logical-size buffer)))
+                   (if (fix:> position logical-size)
+                       logical-size
+                       position)))))
          (cond ((or (not n) (fix:= n 0))
                 position)
-               ((< n position)
+               ((fix:< n position)
                 (let ((position* (fix:- position n)))
                   (substring-move-left! string n position string 0)
                   (set-output-buffer/position! buffer position*)
@@ -568,39 +598,94 @@ MIT in each case. |#
 
 (define (output-buffer/flush buffer)
   (set-output-buffer/position! buffer 0))
-\f
+
 (define (output-buffer/write-substring buffer string start end)
+  (define (output-buffer/write-buffered-substring start end)
+    (let loop ((start start) (n-left (fix:- end start)) (n-previous 0))
+      (let ((string* (output-buffer/string buffer))
+           (position (output-buffer/position buffer)))
+       (let ((max-position (output-buffer/logical-size buffer))
+             (position* (fix:+ position n-left)))
+         (cond ((fix:<= position* max-position)
+                (substring-move-left! string start end string* position)
+                (set-output-buffer/position! buffer position*)
+                (if (fix:= position* max-position)
+                    (output-buffer/drain buffer))
+                (fix:+ n-previous n-left))
+               ((fix:< position max-position)
+                (let ((room (fix:- max-position position)))
+                  (let ((end (fix:+ start room))
+                        (n-previous (fix:+ n-previous room)))
+                    (substring-move-left! string start end
+                                          string* position)
+                    (set-output-buffer/position! buffer max-position)
+                    (if (fix:< (output-buffer/drain buffer) max-position)
+                        (loop end (fix:- n-left room) n-previous)
+                        n-previous))))
+               (else
+                (if (fix:< (output-buffer/drain buffer) max-position)
+                    (loop start n-left n-previous)
+                    n-previous)))))))
+
+  ;; This transfers the end-of-line string atomically.  In this way,
+  ;; as far as the Scheme program is concerned, either the newline has
+  ;; been completely buffered/written, or it has not at all.
+
+  (define (output-buffer/write-translated-newline)
+    (let ((translation (output-buffer/line-translation buffer))
+         (string (output-buffer/string buffer))
+         (posn (output-buffer/position buffer)))
+      (let ((tlen (string-length translation)))
+       (and (fix:<= tlen (fix:- (string-length string) posn))
+            (begin
+              (substring-move-left! translation 0 tlen string posn)
+              (set-output-buffer/position! buffer (fix:+ posn tlen))
+              true)))))
+\f  
+  (define (find-next-newline posn)
+    (and (fix:< posn end)
+        (if (char=? (string-ref string posn) #\Newline)
+            posn
+            (find-next-newline (fix:+ posn 1)))))
+
   (cond ((fix:= start end)
         0)
        ((not (output-buffer/string buffer))
         (or (channel-write (output-buffer/channel buffer) string start end)
             0))
+       ((not (output-buffer/line-translation buffer))
+        (output-buffer/write-buffered-substring start end))
        (else
-        (let loop ((start start) (n-left (fix:- end start)) (n-previous 0))
-          (let ((string* (output-buffer/string buffer))
-                (position (output-buffer/position buffer)))
-            (let ((length (string-length string*))
-                  (position* (fix:+ position n-left)))
-              (cond ((fix:<= position* length)
-                     (substring-move-left! string start end string* position)
-                     (set-output-buffer/position! buffer position*)
-                     (if (fix:= position* length)
-                         (output-buffer/drain buffer))
-                     (fix:+ n-previous n-left))
-                    ((fix:< position length)
-                     (let ((room (fix:- length position)))
-                       (let ((end (fix:+ start room))
-                             (n-previous (fix:+ n-previous room)))
-                         (substring-move-left! string start end
-                                               string* position)
-                         (set-output-buffer/position! buffer length)
-                         (if (fix:< (output-buffer/drain buffer) length)
-                             (loop end (fix:- n-left room) n-previous)
-                             n-previous))))
-                    (else
-                     (if (fix:< (output-buffer/drain buffer) length)
-                         (loop start n-left n-previous)
-                         n-previous)))))))))
+        (letrec ((write-newline
+                  (lambda (posn)
+                    (and (output-buffer/write-translated-newline)
+                         (let ((next (fix:+ posn 1)))
+                           (if (fix:= next end)
+                               1
+                               (fix:+ 1
+                                      (or (write-segment
+                                           next
+                                           (find-next-newline next))
+                                          0)))))))
+                 (write-segment
+                  (lambda (start posn)
+                    (cond ((not posn)
+                           (output-buffer/write-buffered-substring start end))
+                          ((fix:= posn start)
+                           (write-newline posn))
+                          (else
+                           (let ((delta (fix:- posn start))
+                                 (n-written
+                                  (output-buffer/write-buffered-substring
+                                   start posn)))
+                             (and n-written
+                                  (if (fix:< n-written delta)
+                                      n-written
+                                      (fix:+ n-written
+                                             (or (write-newline posn)
+                                                 0))))))))))
+
+          (write-segment start (find-next-newline start))))))
 
 (define (output-buffer/drain-block buffer)
   (let loop ()
@@ -628,14 +713,30 @@ MIT in each case. |#
   string
   start-index
   ;; END-INDEX is zero iff CHANNEL is closed.
-  end-index)
+  end-index
+  line-translation                     ; string that maps to newline
+  real-end)
+
+(define (input-buffer-size translation buffer-size)
+  (cond ((not translation)
+        (if (fix:< buffer-size 1)
+            1
+            buffer-size))
+       ((fix:< buffer-size (string-length translation))
+        (string-length translation))
+       (else
+        buffer-size)))
 
-(define (make-input-buffer channel buffer-size)
-  (let ((buffer-size (if (fix:> buffer-size 1) buffer-size 1)))
+(define (make-input-buffer channel buffer-size #!optional line-translation)
+  (let* ((translation (and (not (default-object? line-translation))
+                          line-translation))
+        (string-size (input-buffer-size translation buffer-size)))
     (%make-input-buffer channel
-                       (make-string buffer-size)
-                       buffer-size
-                       buffer-size)))
+                       (make-string string-size)
+                       string-size
+                       string-size
+                       translation
+                       string-size)))
 
 (define (input-buffer/close buffer)
   (set-input-buffer/end-index! buffer 0)
@@ -648,11 +749,27 @@ MIT in each case. |#
   ;; Returns the actual buffer size, which may be different from the arg.
   ;; Discards any buffered characters.
   (if (not (fix:= (input-buffer/end-index buffer) 0))
-      (let ((buffer-size (if (fix:> buffer-size 1) buffer-size 1)))
-       (set-input-buffer/string! buffer (make-string buffer-size))
-       (set-input-buffer/start-index! buffer buffer-size)
-       (set-input-buffer/end-index! buffer buffer-size)
-       buffer-size)))
+      (let ((string-size 
+            (input-buffer-size (input-buffer/line-translation buffer)
+                               buffer-size)))
+       (let ((old-string (input-buffer/string buffer))
+             (delta (fix:- (input-buffer/real-end buffer)
+                           (input-buffer/end-index buffer))))
+         (set-input-buffer/string! buffer (make-string string-size))
+         (let ((logical-end
+                (if (fix:zero? delta)
+                    string-size
+                    (let ((logical-end (fix:- string-size delta)))
+                      (substring-move-left! old-string
+                                            (input-buffer/end-index buffer)
+                                            (input-buffer/real-end buffer)
+                                            (input-buffer/string buffer)
+                                            logical-end)
+                      logical-end))))
+           (set-input-buffer/start-index! buffer logical-end)
+           (set-input-buffer/end-index! buffer logical-end)
+           (set-input-buffer/real-end! buffer string-size)
+           string-size)))))
 
 (define (input-buffer/flush buffer)
   (set-input-buffer/start-index! buffer (input-buffer/end-index buffer)))
@@ -664,6 +781,7 @@ MIT in each case. |#
   (let ((channel (input-buffer/channel buffer)))
     (and (channel-open? channel)
         (channel-type=file? channel)
+        (not (input-buffer/line-translation buffer)) ; Can't tell otherwise
         (let ((n (fix:- (file-length channel) (file-position channel))))
           (and (fix:>= n 0)
                (fix:+ (input-buffer/buffered-chars buffer) n))))))
@@ -701,22 +819,125 @@ MIT in each case. |#
   (let ((channel (input-buffer/channel buffer)))
     (if (channel-closed? channel)
        0
-       (let ((end-index
-              (let ((string (input-buffer/string buffer)))
-                (channel-read channel string 0 (string-length string)))))
-         (if end-index
-             (begin
-               (set-input-buffer/start-index! buffer 0)
-               (set-input-buffer/end-index! buffer end-index)
-               (if (fix:= end-index 0)
-                   (channel-close channel))))
-         end-index))))
+       (let ((delta (fix:- (input-buffer/real-end buffer)
+                           (input-buffer/end-index buffer)))
+             (string (input-buffer/string buffer)))
+         (if (not (fix:zero? delta))
+             (substring-move-left! string
+                                   (input-buffer/end-index buffer)
+                                   (input-buffer/real-end buffer)
+                                   string
+                                   0))
+         (let ((n-read
+                (channel-read channel string delta (string-length string))))
+           (and n-read
+                (let ((end-index (fix:+ delta n-read)))
+                  (set-input-buffer/start-index! buffer 0)
+                  (set-input-buffer/end-index! buffer end-index)
+                  (set-input-buffer/real-end! buffer end-index)
+                  (cond ((and (input-buffer/line-translation buffer)
+                              (not (fix:= end-index 0)))
+                         (input-buffer/translate! buffer))
+                        ((fix:= n-read 0)
+                         (channel-close channel)
+                         end-index)
+                        (else
+                         end-index)))))))))
 
 (define-integrable (input-buffer/fill* buffer)
   (let ((n (input-buffer/fill buffer)))
     (and n
         (fix:> n 0))))
 \f
+;;;; Input line termination translation
+
+(define (input-buffer/translate! buffer)
+  (with-values
+      (lambda ()
+       (substring/input-translate! (input-buffer/string buffer)
+                                   (input-buffer/line-translation buffer)
+                                   0
+                                   (input-buffer/real-end buffer)))
+    (lambda (logical-end real-end)
+      (set-input-buffer/end-index! buffer logical-end)
+      (set-input-buffer/real-end! buffer real-end)
+      logical-end)))
+
+;; This maps a multi-character (perhaps only 1) sequence into a single
+;; newline character.
+
+(define (substring/input-translate! string translation start end)
+  (let ((tlen (string-length translation))
+       (match (vector-8b-ref translation 0)))
+
+    (define (verify position)
+      (or (fix:< tlen 2)
+         (let ((next (fix:+ position 1)))
+           (if (not (fix:< next end))
+               'TOO-SHORT
+               (and (fix:= (vector-8b-ref translation 1)
+                           (vector-8b-ref string next))
+                    (or (fix:= tlen 2)
+                        (let verify-loop ((tpos 2) (spos (fix:+ next 1)))
+                          (cond ((not (fix:< tpos tlen))
+                                 true)
+                                ((not (fix:< spos end))
+                                 'TOO-SHORT)
+                                ((not (fix:= (vector-8b-ref translation tpos)
+                                             (vector-8b-ref string spos)))
+                                 false)
+                                (else
+                                 (verify-loop (fix:+ tpos 1)
+                                              (fix:+ spos 1)))))))))))
+\f
+    (define (clobber-loop target source)
+      ;; Found one match, continue looking at source
+      (string-set! string target #\Newline)
+      (let find-next ((target (fix:+ target 1)) (source source))
+       (cond ((not (fix:< source end))
+              ;; Finished after doing some clobbering.
+              ;; Real and virtual pointer in sync.
+              (values target target))
+             ((not (fix:= match (vector-8b-ref string source)))
+              (vector-8b-set! string target
+                              (vector-8b-ref string source))
+              (find-next (fix:+ target 1) (fix:+ source 1)))
+             (else
+              (case (verify source)
+                ((#f)
+                 (vector-8b-set! string target
+                                 (vector-8b-ref string source))
+                 (find-next (fix:+ target 1) (fix:+ source 1)))
+                ((TOO-SHORT)
+                 ;; Pointers not in sync, since the buffer ends
+                 ;; in what appears to be the middle of a
+                 ;; translation sequence
+                 (let copy-loop ((target* target) (source source))
+                   (if (not (fix:< source end))
+                       (values target target*)
+                       (begin
+                         (vector-8b-set! string target*
+                                         (vector-8b-ref string source))
+                         (copy-loop (fix:+ target* 1) (fix:+ source 1))))))
+                (else
+                 (clobber-loop target (fix:+ source tlen))))))))
+
+    (define (find-loop position)
+      (cond ((not (fix:< position end))
+            (values position position))
+           ((not (fix:= match (vector-8b-ref string position)))
+            (find-loop (fix:+ position 1)))
+           (else
+            (case (verify position)
+              ((#f)
+               (find-loop (fix:+ position 1)))
+              ((TOO-SHORT)
+               (values position end))
+              (else
+               (clobber-loop position (fix:+ position tlen)))))))
+
+    (find-loop start)))
+\f
 (define (input-buffer/read-char buffer)
   (let ((start-index (input-buffer/start-index buffer))
        (end-index (input-buffer/end-index buffer)))
@@ -752,36 +973,43 @@ MIT in each case. |#
        (set-input-buffer/start-index! buffer (fix:+ start-index 1)))))
 
 (define (input-buffer/read-substring buffer string start end)
-  (let ((start-index (input-buffer/start-index buffer))
-       (end-index (input-buffer/end-index buffer))
-       (channel (input-buffer/channel buffer)))
-    (cond ((fix:< start-index end-index)
-          (let ((string* (input-buffer/string buffer))
-                (available (fix:- end-index start-index))
-                (needed (fix:- end start)))
-            (if (fix:>= available needed)
-                (begin
-                  (let ((end-index (fix:+ start-index needed)))
+  (define (read-directly start end)
+    (if (not (input-buffer/line-translation buffer))
+       (channel-read (input-buffer/channel buffer) string start end)
+       (let ((next (input-buffer/fill buffer)))
+         (and next
+              (transfer-input-buffer start end)))))
+
+  (define (transfer-input-buffer start end)
+    (let ((start-index (input-buffer/start-index buffer))
+         (end-index (input-buffer/end-index buffer)))
+      (cond ((fix:< start-index end-index)
+            (let ((string* (input-buffer/string buffer))
+                  (available (fix:- end-index start-index))
+                  (needed (fix:- end start)))
+              (if (fix:>= available needed)
+                  (begin
+                    (let ((end-index (fix:+ start-index needed)))
+                      (substring-move-left! string* start-index end-index
+                                            string start)
+                      (set-input-buffer/start-index! buffer end-index))
+                    needed)
+                  (begin
                     (substring-move-left! string* start-index end-index
                                           string start)
-                    (set-input-buffer/start-index! buffer end-index))
-                  needed)
-                (begin
-                  (substring-move-left! string* start-index end-index
-                                        string start)
-                  (set-input-buffer/start-index! buffer end-index)
-                  (fix:+ available
-                         (or (and (channel-open? channel)
-                                  (channel-read channel
-                                                string
-                                                (fix:+ start available)
-                                                end))
-                             0))))))
-         ((or (fix:= end-index 0)
-              (channel-closed? channel))
-          0)
-         (else
-          (channel-read channel string start end)))))
+                    (set-input-buffer/start-index! buffer end-index)
+                    (fix:+ available
+                           (or (and (channel-open? (input-buffer/channel buffer))
+                                    (read-directly (fix:+ start available)
+                                                   end))
+                               0))))))
+           ((or (fix:= end-index 0)
+                (channel-closed? channel))
+            0)
+           (else
+            (read-directly start end)))))
+
+  (transfer-input-buffer start end))
 \f
 (define (input-buffer/read-until-delimiter buffer delimiters)
   (let ((channel (input-buffer/channel buffer)))

diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index c32af2cbcbc18255c14d79b4f544392bd171db92..4f85519a9c58cf988509139707f4a443b20fc485 100644 (file)
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.19 1992/04/11 23:48:35 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.20 1992/04/16 05:12:44 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -151,6 +151,11 @@ these rules:
 (define (pathname-version pathname)
   (%pathname-version (->pathname pathname)))
 
+(define (pathname-end-of-line-string pathname)
+  (let ((pathname (->pathname pathname)))
+    ((host-operation/end-of-line-string (%pathname-host pathname))
+     pathname)))
+
 (define (pathname=? x y)
   (let ((x (->pathname x))
        (y (->pathname y)))
@@ -437,7 +442,8 @@ these rules:
   (operation/pathname->truename false read-only true)
   (operation/user-homedir-pathname false read-only true)
   (operation/init-file-pathname false read-only true)
-  (operation/pathname-simplify false read-only true))
+  (operation/pathname-simplify false read-only true)
+  (operation/end-of-line-string false read-only true))
 
 (define-structure (host
                   (named (string->symbol "#[(runtime pathname)host]"))
@@ -490,6 +496,9 @@ these rules:
 
 (define (host-operation/pathname-simplify host)
   (host-type/operation/pathname-simplify (host/type host)))
+
+(define (host-operation/end-of-line-string host)
+  (host-type/operation/end-of-line-string (host/type host)))
 \f
 ;;;; File System Stuff
 
@@ -569,7 +578,8 @@ these rules:
                        name all))))
     (make-host-type index name
                    fail fail fail fail fail
-                   fail fail fail fail fail)))
+                   fail fail fail fail fail
+                   fail)))
 
 (define available-host-types
   '())

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 5687f1e14d35f0df60271fa2c8cba67b086f9955..15b0574f57319439eacf095d8d0e5cc8912ff851 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.146 1992/04/13 18:24:27 hal Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.147 1992/04/16 05:12:18 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -648,6 +648,9 @@ MIT in each case. |#
   (files "fileio")
   (parent ())
   (export ()
+         open-binary-i/o-file
+         open-binary-input-file
+         open-binary-output-file
          open-i/o-file
          open-input-file
          open-output-file)
@@ -1438,6 +1441,7 @@ MIT in each case. |#
          pathname-default-version
          pathname-device
          pathname-directory
+         pathname-end-of-line-string
          pathname-host
          pathname-name
          pathname-new-device

diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 1892022f3d9b822adc7b0d7acb5c9643aad88e40..e83da27b7cc9938d4d98cfbdeeef44a37f68f338 100644 (file)
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxpth.scm,v 14.10 1992/04/11 23:48:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxpth.scm,v 14.11 1992/04/16 05:12:55 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -49,7 +49,8 @@ MIT in each case. |#
                  unix/pathname->truename
                  unix/user-homedir-pathname
                  unix/init-file-pathname
-                 unix/pathname-simplify))
+                 unix/pathname-simplify
+                 unix/end-of-line-string))
 
 (define (initialize-package!)
   (add-pathname-host-type! 'UNIX make-unix-host-type))
@@ -302,4 +303,8 @@ MIT in each case. |#
                                 (->namestring pathname)
                                 (->namestring pathname*))
                                pathname*)))))))
-      pathname))
\ No newline at end of file
+      pathname))
+
+(define (unix/end-of-line-string pathname)
+  pathname                             ; ignored
+  "\n")
\ No newline at end of file

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index e602d3524665d8b5144f45f4e30e83a9f63f516e..be7cc730bd11582c2789c1137365fc908f84f78d 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.149 1992/04/11 23:49:03 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.150 1992/04/16 05:13:13 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 149))
+  (add-identification! "Runtime" 14 150))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 29eafcdefa1fee42d56b9cde957c513b75c49323..1a538dfb247eb2248192ecf40bcf5740f2eea8d7 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.146 1992/04/13 18:24:27 hal Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.147 1992/04/16 05:12:18 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -648,6 +648,9 @@ MIT in each case. |#
   (files "fileio")
   (parent ())
   (export ()
+         open-binary-i/o-file
+         open-binary-input-file
+         open-binary-output-file
          open-i/o-file
          open-input-file
          open-output-file)
@@ -1438,6 +1441,7 @@ MIT in each case. |#
          pathname-default-version
          pathname-device
          pathname-directory
+         pathname-end-of-line-string
          pathname-host
          pathname-name
          pathname-new-device