From d05527117fa1e8b32dca4235554f9c0a0efb35f2 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 12 Jan 1993 23:12:24 +0000 Subject: [PATCH] Add support for handling end-of-file ^Z under DOS. --- v7/src/runtime/dospth.scm | 31 ++++++++++++++--- v7/src/runtime/fileio.scm | 35 ++++++++++++++------ v7/src/runtime/io.scm | 68 +++++++++++++++++++++++++++----------- v7/src/runtime/pathnm.scm | 29 +++++++++++++--- v7/src/runtime/runtime.pkg | 4 ++- v7/src/runtime/unxpth.scm | 18 +++++++--- v7/src/runtime/version.scm | 6 ++-- v8/src/runtime/runtime.pkg | 4 ++- 8 files changed, 146 insertions(+), 49 deletions(-) diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm index 3a1e283ee..9ed69eb42 100644 --- 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)) ;;;; 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 eca87c446..ac005509e 100644 --- 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 2857bc0d3..b610fcafc 100644 --- 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 37b1e5ad7..2e77d82f6 100644 --- 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))) ;;;; 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 8c278b33e..258ef2dad 100644 --- 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 ef9c9dd05..9a5bb9903 100644 --- 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 9d8489cbb..68d761413 100644 --- 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 8c278b33e..258ef2dad 100644 --- 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 -- 2.25.1