From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 20 Nov 1994 05:13:14 +0000 (+0000)
Subject: Implement file-length procedure.
X-Git-Tag: 20090517-FFI~6999
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1b3bc5925fc6a5b655c44a9a9e0955de3798f3d3;p=mit-scheme.git

Implement file-length procedure.
---

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 6b10f6c63..84b39c8ff 100644
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.21 1993/11/09 04:31:37 cph Exp $
+$Id: dosprm.scm,v 1.22 1994/11/20 05:12:28 cph Exp $
 
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -131,6 +131,9 @@ MIT in each case. |#
   (mode-string false read-only true)
   (inode-number false read-only true))
 
+(define (file-length filename)
+  (file-attributes/length (file-attributes filename)))
+
 (define (file-modification-time filename)
   ((ucode-primitive file-mod-time 1)
    (->namestring (merge-pathnames filename))))
diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm
index 4b37d1a16..4cf796a27 100644
--- a/v7/src/runtime/infutl.scm
+++ b/v7/src/runtime/infutl.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: infutl.scm,v 1.56 1994/03/11 05:15:08 cph Exp $
+$Id: infutl.scm,v 1.57 1994/11/20 05:13:14 cph Exp $
 
-Copyright (c) 1988-1994 Massachusetts Institute of Technology
+Copyright (c) 1988-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -651,8 +651,7 @@ MIT in each case. |#
 		 (string=? file-marker actual-marker))
 	    (call-with-binary-output-file (merge-pathnames ofile)
    	      (lambda (output)					  
-		(let ((size (file-attributes/length (file-attributes ifile))))
-		  (uncompress-ports input output (fix:* size 2)))))
+		(uncompress-ports input output (fix:* (file-length ifile) 2))))
 	    (if-fail "Not a recognized compressed file:" ifile))))))
 
 (define (lookup-uncompressed-file compressed-file if-found if-not-found)
diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 8795e0b8f..a8139e500 100644
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.30 1994/06/02 21:41:07 cph Exp $
+$Id: unxprm.scm,v 1.31 1994/11/20 05:12:40 cph Exp $
 
 Copyright (c) 1988-94 Massachusetts Institute of Technology
 
@@ -141,6 +141,9 @@ MIT in each case. |#
   (mode-string false read-only true)
   (inode-number false read-only true))
 
+(define (file-length filename)
+  (file-attributes/length (file-attributes-direct filename)))
+
 (define (file-modification-time-direct filename)
   ((ucode-primitive file-mod-time 1)
    (->namestring (merge-pathnames filename))))
diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm
index 4b37d1a16..4cf796a27 100644
--- a/v8/src/runtime/infutl.scm
+++ b/v8/src/runtime/infutl.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: infutl.scm,v 1.56 1994/03/11 05:15:08 cph Exp $
+$Id: infutl.scm,v 1.57 1994/11/20 05:13:14 cph Exp $
 
-Copyright (c) 1988-1994 Massachusetts Institute of Technology
+Copyright (c) 1988-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -651,8 +651,7 @@ MIT in each case. |#
 		 (string=? file-marker actual-marker))
 	    (call-with-binary-output-file (merge-pathnames ofile)
    	      (lambda (output)					  
-		(let ((size (file-attributes/length (file-attributes ifile))))
-		  (uncompress-ports input output (fix:* size 2)))))
+		(uncompress-ports input output (fix:* (file-length ifile) 2))))
 	    (if-fail "Not a recognized compressed file:" ifile))))))
 
 (define (lookup-uncompressed-file compressed-file if-found if-not-found)