From a4273a1875f820360beafb848b0bbf0e1ea6c536 Mon Sep 17 00:00:00 2001 From: "Henry M. Wu" Date: Tue, 26 May 1992 17:20:40 +0000 Subject: [PATCH] Added recognition of marker in compressed files. --- v7/src/runtime/infutl.scm | 24 ++++++++++++++++-------- v8/src/runtime/infutl.scm | 24 ++++++++++++++++-------- 2 files changed, 32 insertions(+), 16 deletions(-) diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm index 353ccc35f..b831accce 100644 --- a/v7/src/runtime/infutl.scm +++ b/v7/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.24 1992/05/26 16:09:40 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.25 1992/05/26 17:20:40 mhwu Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -489,13 +489,21 @@ MIT in each case. |# (let ((input (open-binary-input-file (merge-pathnames ifile)))) (if (not (input-port? input)) (error "UNCOMPRESS: error opening input" ifile)) - (let ((output (file-open-output-channel - (->namestring (merge-pathnames ofile)))) - (size (file-attributes/length (file-attributes ifile)))) - (expand input output (fix:* size 2)) - (channel-close output) - (close-input-port input)))) - + (let* ((file-marker "Compressed-B1-1.00") + (marker-size (string-length file-marker)) + (actual-marker (make-string marker-size))) + ;; This may get more hairy as we up versions + (if (and (fix:= ((input-port/operation input 'read-substring) + input actual-marker 0 marker-size) + marker-size) + (string=? file-marker actual-marker)) + (let ((output (file-open-output-channel + (->namestring (merge-pathnames ofile)))) + (size (file-attributes/length (file-attributes ifile)))) + (expand input output (fix:* size 2)) + (channel-close output) + (close-input-port input)) + (error "Not a recognized compressed file" ifile))))) (define (find-alternate-file-type base-pathname exts/receivers) (or (null? exts/receivers) diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm index 6a6bd46bd..b8fe52706 100644 --- a/v8/src/runtime/infutl.scm +++ b/v8/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.24 1992/05/26 16:09:40 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.25 1992/05/26 17:20:40 mhwu Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -489,13 +489,21 @@ MIT in each case. |# (let ((input (open-binary-input-file (merge-pathnames ifile)))) (if (not (input-port? input)) (error "UNCOMPRESS: error opening input" ifile)) - (let ((output (file-open-output-channel - (->namestring (merge-pathnames ofile)))) - (size (file-attributes/length (file-attributes ifile)))) - (expand input output (fix:* size 2)) - (channel-close output) - (close-input-port input)))) - + (let* ((file-marker "Compressed-B1-1.00") + (marker-size (string-length file-marker)) + (actual-marker (make-string marker-size))) + ;; This may get more hairy as we up versions + (if (and (fix:= ((input-port/operation input 'read-substring) + input actual-marker 0 marker-size) + marker-size) + (string=? file-marker actual-marker)) + (let ((output (file-open-output-channel + (->namestring (merge-pathnames ofile)))) + (size (file-attributes/length (file-attributes ifile)))) + (expand input output (fix:* size 2)) + (channel-close output) + (close-input-port input)) + (error "Not a recognized compressed file" ifile))))) (define (find-alternate-file-type base-pathname exts/receivers) (or (null? exts/receivers) -- 2.25.1