Add support for handling end-of-file ^Z under DOS.

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 3a1e283eeb6fdcbf709caf8f922eb579faa31aa1..9ed69eb42dbef7555290301be9fba2c63bf0d6c4 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.17 1992/11/03 22:42:35 jinx Exp $
+$Id: dospth.scm,v 1.18 1993/01/12 23:09:04 gjr Exp $
 
-Copyright (c) 1992 Massachusetts Institute of Technology
+Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -38,6 +38,8 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define hook/dos/end-of-line-string)
+(define hook/dos/end-of-file-marker/input)
+(define hook/dos/end-of-file-marker/output)
 
 (define sub-directory-delimiters
   ;; Allow forward slashes as well as backward slashes so that
@@ -65,10 +67,14 @@ MIT in each case. |#
                  dos/init-file-pathname
                  dos/pathname-simplify
                  dos/end-of-line-string
-                 dos/canonicalize))
+                 dos/canonicalize
+                 dos/end-of-file-marker/input
+                 dos/end-of-file-marker/output))
 
 (define (initialize-package!)
   (set! hook/dos/end-of-line-string default/dos/end-of-line-string)
+  (set! hook/dos/end-of-file-marker/input default/dos/end-of-file-marker/input)
+  (set! hook/dos/end-of-file-marker/output default/dos/end-of-file-marker/output)
   (add-pathname-host-type! 'DOS make-dos-host-type))
 \f
 ;;;; Pathname Parser
@@ -403,4 +409,21 @@ MIT in each case. |#
 
 (define (default/dos/end-of-line-string pathname)
   pathname                             ; ignored
-  "\r\n")
\ No newline at end of file
+  "\r\n")
+
+;; Scheme understands files that end in ^Z, but does not create them
+
+(define (dos/end-of-file-marker/input pathname)
+  (hook/dos/end-of-file-marker/input pathname))
+
+(define (default/dos/end-of-file-marker/input pathname)
+  pathname                             ; ignored
+  #\Call                               ; ^Z
+  )
+
+(define (dos/end-of-file-marker/output pathname)
+  (hook/dos/end-of-file-marker/output pathname))
+
+(define (default/dos/end-of-file-marker/output pathname)
+  pathname                             ; ignored
+  false)
\ No newline at end of file

diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm
index eca87c446d005d7fe5381c0f0e8192e7c87d89db..ac005509ea09ed549273a99c2c6170c670e863fb 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.4 1992/04/16 05:12:36 jinx Exp $
+$Id: fileio.scm,v 1.5 1993/01/12 23:08:51 gjr Exp $
 
-Copyright (c) 1991-1992 Massachusetts Institute of Technology
+Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -105,6 +105,8 @@ MIT in each case. |#
                      (make-input-buffer channel
                                         input-buffer-size
                                         (pathname-newline-translation
+                                         pathname)
+                                        (pathname-end-of-file-marker/input
                                          pathname))
                      false
                      pathname))))
@@ -125,6 +127,8 @@ MIT in each case. |#
                      (make-output-buffer channel
                                          output-buffer-size
                                          (pathname-newline-translation
+                                          pathname)
+                                         (pathname-end-of-file-marker/output
                                           pathname))
                      pathname))))
     (set-channel-port! channel port)
@@ -136,15 +140,20 @@ MIT in each case. |#
         (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)))))
+                      (make-file-state
+                       (make-input-buffer
+                        channel
+                        input-buffer-size
+                        translation
+                        (pathname-end-of-file-marker/input
+                         pathname))
+                       (make-output-buffer
+                        channel
+                        output-buffer-size
+                        translation
+                        (pathname-end-of-file-marker/output
+                         pathname))
+                       pathname)))))
     (set-channel-port! channel port)
     port))
 
@@ -163,6 +172,7 @@ MIT in each case. |#
          (port/copy input-file-template
                     (make-file-state (make-input-buffer channel
                                                         input-buffer-size
+                                                        false
                                                         false)
                                      false
                                      pathname))))
@@ -181,6 +191,7 @@ MIT in each case. |#
                     (make-file-state false
                                      (make-output-buffer channel
                                                          output-buffer-size
+                                                         false
                                                          false)
                                      pathname))))
     (set-channel-port! channel port)
@@ -193,9 +204,11 @@ MIT in each case. |#
          (port/copy i/o-file-template
                     (make-file-state (make-input-buffer channel
                                                         input-buffer-size
+                                                        false
                                                         false)
                                      (make-output-buffer channel
                                                          output-buffer-size
+                                                         false
                                                          false)
                                      pathname))))
     (set-channel-port! channel port)

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 2857bc0d329d907447bf9caeedb5171cebafc681..b610fcafcd96dd87fe64eeb73dd981929a24cc8d 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.31 1992/12/07 19:06:45 cph Exp $
+$Id: io.scm,v 14.32 1993/01/12 23:08:46 gjr Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -525,7 +525,8 @@ MIT in each case. |#
   string
   position
   line-translation                     ; string that newline maps to
-  logical-size)
+  logical-size
+  end-marker)
 
 (define (output-buffer-sizes translation buffer-size)
   (let ((logical-size
@@ -538,7 +539,8 @@ MIT in each case. |#
                (fix:+ logical-size
                       (fix:- (string-length translation) 1))))))
 
-(define (make-output-buffer channel buffer-size #!optional line-translation)
+(define (make-output-buffer channel buffer-size
+                           #!optional line-translation end-marker)
   (let ((translation (and (not (default-object? line-translation))
                          line-translation)))
     (with-values
@@ -551,9 +553,14 @@ MIT in each case. |#
                                  (make-string string-size))
                             0
                             translation
-                            logical-size)))))
+                            logical-size
+                            (and (not (default-object? end-marker))
+                                 end-marker))))))
 
 (define (output-buffer/close buffer)
+  (cond ((output-buffer/end-marker buffer)
+        => (lambda (marker)
+             (output-buffer/write-char-block buffer marker))))
   (output-buffer/drain-block buffer)
   (channel-close (output-buffer/channel buffer)))
 
@@ -718,7 +725,8 @@ MIT in each case. |#
   ;; END-INDEX is zero iff CHANNEL is closed.
   end-index
   line-translation                     ; string that maps to newline
-  real-end)
+  real-end
+  end-marker)
 
 (define (input-buffer-size translation buffer-size)
   (cond ((not translation)
@@ -730,7 +738,8 @@ MIT in each case. |#
        (else
         buffer-size)))
 
-(define (make-input-buffer channel buffer-size #!optional line-translation)
+(define (make-input-buffer channel buffer-size
+                          #!optional line-translation end-marker)
   (let* ((translation (and (not (default-object? line-translation))
                           line-translation))
         (string-size (input-buffer-size translation buffer-size)))
@@ -739,7 +748,9 @@ MIT in each case. |#
                        string-size
                        string-size
                        translation
-                       string-size)))
+                       string-size
+                       (and (not (default-object? end-marker))
+                            end-marker))))
 
 (define (input-buffer/close buffer)
   (set-input-buffer/end-index! buffer 0)
@@ -785,6 +796,7 @@ MIT in each case. |#
     (and (channel-open? channel)
         (channel-type=file? channel)
         (not (input-buffer/line-translation buffer)) ; Can't tell otherwise
+        (not (input-buffer/end-marker 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))))))
@@ -834,18 +846,34 @@ MIT in each case. |#
          (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)))))))))
+                (let ((n-read
+                       (cond ((input-buffer/end-marker buffer)
+                              => (lambda (marker)
+                                   (if (and (fix:> n-read 0)
+                                            (channel-type=file? channel)
+                                            (fix:= (file-position channel)
+                                                   (file-length channel))
+                                            (char=?
+                                             (string-ref string
+                                                         (+ delta
+                                                            (-1+ n-read)))
+                                                    marker))
+                                       (-1+ n-read)
+                                       n-read)))
+                             (else
+                              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)))

diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index 37b1e5ad7f24023f44b502bd893c739e59a6082f..2e77d82f6ee16e9c0d0ffe9fa76b113b1af4f9ea 100644 (file)
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: pathnm.scm,v 14.24 1992/12/03 03:20:15 cph Exp $
+$Id: pathnm.scm,v 14.25 1993/01/12 23:08:57 gjr Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -158,6 +158,16 @@ these rules:
     ((host-operation/end-of-line-string (%pathname-host pathname))
      pathname)))
 
+(define (pathname-end-of-file-marker/input pathname)
+  (let ((pathname (->pathname pathname)))
+    ((host-operation/end-of-file-marker/input (%pathname-host pathname))
+     pathname)))
+
+(define (pathname-end-of-file-marker/output pathname)
+  (let ((pathname (->pathname pathname)))
+    ((host-operation/end-of-file-marker/output (%pathname-host pathname))
+     pathname)))
+
 (define (pathname=? x y)
   (let ((x (->pathname x))
        (y (->pathname y)))
@@ -449,7 +459,9 @@ these rules:
   (operation/init-file-pathname false read-only true)
   (operation/pathname-simplify false read-only true)
   (operation/end-of-line-string false read-only true)
-  (operation/pathname-canonicalize false read-only true))
+  (operation/pathname-canonicalize false read-only true)
+  (operation/end-of-file-marker/input false read-only true)
+  (operation/end-of-file-marker/output false read-only true))
 
 (define-structure (host (type vector)
                        (named ((ucode-primitive string->symbol)
@@ -508,6 +520,12 @@ these rules:
 
 (define (host-operation/pathname-canonicalize host)
   (host-type/operation/pathname-canonicalize (host/type host)))
+
+(define (host-operation/end-of-file-marker/input host)
+  (host-type/operation/end-of-file-marker/input (host/type host)))
+
+(define (host-operation/end-of-file-marker/output host)
+  (host-type/operation/end-of-file-marker/output (host/type host)))
 \f
 ;;;; File System Stuff
 
@@ -572,7 +590,8 @@ these rules:
 (define known-host-types
   '((UNIX . 0)
     (DOS . 1)
-    (VMS . 2)))
+    (VMS . 2)
+    (MS-NT . 3)))
 
 (define (make-unimplemented-host-type index)
   (let* ((name (let loop ((types known-host-types))
@@ -588,7 +607,7 @@ these rules:
     (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 8c278b33e37537b1a35b7de70c3dc1954cd7ed83..258ef2dad6183118ec3432c39a8da1cad93f64b2 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.169 1993/01/12 21:42:09 cph Exp $
+$Id: runtime.pkg,v 14.170 1993/01/12 23:12:24 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1475,6 +1475,8 @@ MIT in each case. |#
          pathname-device
          pathname-directory
          pathname-end-of-line-string
+         pathname-end-of-file-marker/input
+         pathname-end-of-file-marker/output
          pathname-host
          pathname-name
          pathname-new-device

diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index ef9c9dd05496bb4333d96a2754740964e3b15e85..9a5bb9903a7b330a8495783a40c9831d4c9173fc 100644 (file)
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.13 1992/11/03 22:42:43 jinx Exp $
+$Id: unxpth.scm,v 14.14 1993/01/12 23:09:10 gjr Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -51,7 +51,9 @@ MIT in each case. |#
                  unix/init-file-pathname
                  unix/pathname-simplify
                  unix/end-of-line-string
-                 unix/canonicalize))
+                 unix/canonicalize
+                 unix/end-of-file-marker/input
+                 unix/end-of-file-marker/output))
 
 (define (initialize-package!)
   (add-pathname-host-type! 'UNIX make-unix-host-type))
@@ -314,4 +316,12 @@ MIT in each case. |#
 
 (define (unix/end-of-line-string pathname)
   pathname                             ; ignored
-  "\n")
\ No newline at end of file
+  "\n")
+
+(define (unix/end-of-file-marker/input pathname)
+  pathname                             ; ignored
+  false)
+
+(define (unix/end-of-file-marker/output pathname)
+  pathname                             ; ignored
+  false)
\ No newline at end of file

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 9d8489cbb020e2a4c2240d64af11f67e8e55c16c..68d7614133b4eda7f03c9bbf7f65fb179427f614 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: version.scm,v 14.159 1992/12/07 19:07:03 cph Exp $
+$Id: version.scm,v 14.160 1993/01/12 23:08:40 gjr Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -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 159))
+  (add-identification! "Runtime" 14 160))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 8c278b33e37537b1a35b7de70c3dc1954cd7ed83..258ef2dad6183118ec3432c39a8da1cad93f64b2 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.169 1993/01/12 21:42:09 cph Exp $
+$Id: runtime.pkg,v 14.170 1993/01/12 23:12:24 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1475,6 +1475,8 @@ MIT in each case. |#
          pathname-device
          pathname-directory
          pathname-end-of-line-string
+         pathname-end-of-file-marker/input
+         pathname-end-of-file-marker/output
          pathname-host
          pathname-name
          pathname-new-device