From: Guillermo J. Rozas Date: Thu, 16 Apr 1992 05:13:13 +0000 (+0000) Subject: Teach the runtime system how to handle files whose lines end in X-Git-Tag: 20090517-FFI~9482 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=914f30144f45c74e84a0034c954c07b82c1f2ba0;p=mit-scheme.git 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 005e3202d..47b681e65 100644 --- 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 36dda7389..eca87c446 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.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) (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))) + +(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) (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 5753722dd..b108c313d 100644 --- 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) - + (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)) - + (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))))) + + (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)))) +;;;; 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))))))))))) + + (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))) + (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)) (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 c32af2cbc..4f85519a9 100644 --- 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))) ;;;; 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 5687f1e14..15b0574f5 100644 --- 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 1892022f3..e83da27b7 100644 --- 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 e602d3524..be7cc730b 100644 --- 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 29eafcdef..1a538dfb2 100644 --- 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