Added recognition of marker in compressed files.

diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm
index 353ccc35f68e0954683e20905d44a76f340844d5..b831acccef41a6308864907f0f149baa9beadf27 100644 (file)
--- 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 6a6bd46bdc989cdcccebb7b2f0b8404672761f8b..b8fe5270606e32615b3280879e989a756cce3f14 100644 (file)
--- 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)