From b755411ac78c2912a74e43038bfaea9e0037e142 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 19 Jul 2005 03:48:44 +0000
Subject: [PATCH] Remove unused LOAD-PACKED-BINARIES.

---
 v7/src/runtime/load.scm | 135 +---------------------------------------
 1 file changed, 2 insertions(+), 133 deletions(-)

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index 9e928577e..edba02017 100644
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: load.scm,v 14.71 2005/04/01 04:46:49 cph Exp $
+$Id: load.scm,v 14.72 2005/07/19 03:48:44 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1999,2000,2001,2002,2003 Massachusetts Institute of Technology
@@ -556,135 +556,4 @@ USA.
 	   (repl-eval/write (read (open-input-string arg)
 				  environment)
 			    environment
-			    repl)))))))
-
-;;;; Loader for packed binaries
-
-(define (load-packed-binaries pathname fname count environment)
-  fname
-
-  (define (process-bunch alist)
-    (let ((real-load load)
-	  (real-fasload fasload)
-	  (real-file-exists? file-exists?)
-	  (real-file-directory? file-directory?)
-	  (to-purify '()))
-      (fluid-let
-	  ((load
-	    (lambda (fname #!optional env syntax-table purify?)
-	      syntax-table		;ignored
-	      (let ((place (find-filename fname alist)))
-		(if (not place)
-		    (real-load fname env 'DEFAULT purify?)
-		    (handle-load-hooks
-		     (lambda ()
-		       (let ((scode (caddr place)))
-			 (loading-message fname
-					  load/suppress-loading-message?
-					  ";Pseudo-loading ")
-			 (if (if (default-object? purify?) #f purify?)
-			     (set! to-purify
-				   (cons (load/purification-root scode)
-					 to-purify)))
-			 (fluid-let ((load/current-pathname (cadr place)))
-			   (extended-scode-eval scode
-						(if (default-object? env)
-						    environment
-						    env))))))))))
-	   (fasload
-	    (lambda (filename #!optional suppress-message?)
-	      (let ((suppress-message?
-		     (if (default-object? suppress-message?)
-			 load/suppress-loading-message?
-			 suppress-message?))
-		    (place (find-filename filename alist)))
-		(if (not place)
-		    (real-fasload filename suppress-message?)
-		    (begin
-		      (loading-message filename
-		                       suppress-message?
-				       ";Pseudo-fasloading ")
-		      (caddr place))))))
-	   (file-exists?
-	    (lambda (fname)
-	      (or (find-filename fname alist)
-		  (real-file-exists? fname))))
-	   (file-directory?
-	    (lambda (dname)
-	      (or (directory-represented? dname alist)
-		  (real-file-directory? dname)))))
-        (load (caar alist)))
-      (set! alist)
-      (for-each purify (reverse! to-purify)))
-    (flush-purification-queue!))
-
-  (define (find-filename fname alist)
-    (search-alist (->pathname fname) alist
-      (lambda (path1 path2)
-	(and (equal? (pathname-directory path1)
-		     (pathname-directory path2))
-	     (equal? (pathname-name path1)
-		     (pathname-name path2))
-	     (or (equal? (pathname-type path1) (pathname-type path2))
-		 (and (member (pathname-type path1) '(#f "bin" "com"))
-		      (member (pathname-type path2) '(#f "bin" "com"))))))))
-
-  (define (directory-represented? dname alist)
-    (search-alist (pathname-as-directory (->pathname dname)) alist
-      (lambda (path1 path2)
-	(equal? (pathname-directory path1)
-		(pathname-directory path2)))))
-
-  (define (search-alist path alist predicate?)
-    (let loop ((alist alist))
-      (and (pair? alist)
-	   (if (predicate? path (cadar alist))
-	       (car alist)
-	       (loop (cdr alist))))))
-
-  (define (loading-message fname suppress? kind)
-    (if (not suppress?)
-	(let ((port (notification-output-port)))
-	  (fresh-line port)
-	  (write-string kind port)
-	  (write-string (->namestring (->pathname fname)) port)
-	  (write-string "..." port)
-	  (newline port))))
-
-  (with-binary-input-file (->truename pathname)
-    (lambda (channel)
-      ((ucode-primitive binary-fasload) channel) ; Dismiss header.
-      (let ((process-next-bunch
-	     (lambda ()
-	       (process-bunch
-		(map (lambda (pair)
-		       (list (car pair)
-			     (->pathname (car pair))
-			     (cdr pair)))
-		     ((ucode-primitive binary-fasload) channel))))))
-	(do ((count count (-1+ count)))
-	    ((= count 1)
-	     (process-next-bunch))
-	  (process-next-bunch))))))
-
-(define (with-binary-input-file file action)
-  (with-binary-file-channel file action
-    open-binary-input-file
-    port/input-channel
-    'with-binary-input-file))
-
-(define (with-binary-file-channel file action open extract-channel name)
-  (let ((port #f))
-    (dynamic-wind
-     (lambda ()
-       (if port
-           (error "cannot re-enter with-binary-file-channel" name)))
-     (lambda ()
-       (set! port (open file))
-       (action (channel-descriptor (extract-channel port))))
-     (lambda ()
-       (if (and port
-                (not (eq? port #t)))
-           (begin
-             (close-port port)
-             (set! port #t)))))))
\ No newline at end of file
+			    repl)))))))
\ No newline at end of file
-- 
2.25.1