From 8a773f30001d324e99db94c16060c4ed846d4c94 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 23 Dec 2000 06:01:15 +0000
Subject: [PATCH] Update to new GUARDED-SYSTEM-LOADER.

---
 v7/src/etc/optiondb.scm | 85 ++++++++++++++++++++++++-----------------
 1 file changed, 51 insertions(+), 34 deletions(-)

diff --git a/v7/src/etc/optiondb.scm b/v7/src/etc/optiondb.scm
index 62a104f8c..c3e0122a8 100644
--- a/v7/src/etc/optiondb.scm
+++ b/v7/src/etc/optiondb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: optiondb.scm,v 1.3 2000/12/07 21:56:29 cph Exp $
+$Id: optiondb.scm,v 1.4 2000/12/23 06:01:15 cph Exp $
 
 Copyright (c) 2000 Massachusetts Institute of Technology
 
@@ -20,55 +20,72 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 |#
 
 (define (guarded-system-loader package-name place #!optional filename)
-  (let ((directory
-	 (let ((here (directory-pathname (current-load-pathname))))
-	   (let ((directory
-		  (pathname-new-directory here
-					  (append (pathname-directory here)
-						  (list 'UP place)))))
-	     (if (file-directory? directory)
-		 directory
-		 (merge-pathnames place here))))))
+  (let ((dirs
+	 (list (directory-pathname (current-load-pathname))
+	       (or (get-environment-variable "MITSCHEME_INF_DIRECTORY")
+		   "/scheme/v7/linux")))
+	(files
+	 (if (default-object? filename)
+	     (list "make" "load")
+	     (list filename)))
+	(test
+	 (lambda (name)
+	   (or (file-exists? name)
+	       (there-exists? load/default-types
+		 (lambda (type)
+		   (file-exists?
+		    (pathname-new-type name (car type)))))))))
     (lambda ()
       (if (not (name->package package-name))
-	  (with-working-directory-pathname directory
-	    (lambda ()
-	      (load
-	       (let ((test
-		      (lambda (name)
-			(or (file-exists? name)
-			    (there-exists? load/default-types
-			      (lambda (type)
-				(file-exists?
-				 (pathname-new-type name (car type)))))))))
-		 (cond ((not (default-object? filename)) filename)
-		       ((test "make") "make")
-		       ((test "load") "load")
-		       (else (error "Can't find loader.")))))))))))
+	  (let dir-loop ((dirs dirs))
+	    (if (pair? dirs)
+		(let ((directory
+		       (merge-pathnames place
+					(pathname-as-directory (car dirs)))))
+		  (if (file-directory? directory)
+		      (let file-loop ((files files))
+			(if (pair? files)
+			    (if (test
+				 (merge-pathnames
+				  (car files)
+				  (pathname-as-directory directory)))
+				(with-working-directory-pathname directory
+				  (lambda ()
+				    (load (car files))))
+				(file-loop (cdr files)))
+			    (dir-loop (cdr dirs))))
+		      (dir-loop (cdr dirs))))
+		(error "Unable to find package directory:" place)))))))
+
+(define-load-option 'SF
+  (guarded-system-loader '(scode-optimizer) "sf"))
 
 (define-load-option 'CREF
   (guarded-system-loader '(cross-reference) "cref"))
 
+(define-load-option 'EDWIN
+  (guarded-system-loader '(edwin) "edwin"))
+
 (define-load-option 'COMPILER
   (lambda () (load-option 'SF))
   (guarded-system-loader '(compiler) "compiler"))
 
-(define-load-option 'EDWIN
-  (guarded-system-loader '(edwin) "edwin"))
+(define-load-option 'STUDENT
+  (guarded-system-loader '(student) "6001"))
 
-(define-load-option 'IMAIL
-  (guarded-system-loader '(edwin imail) "imail"))
+(define-load-option 'SOS
+  (guarded-system-loader '(runtime object-system) "sos"))
 
 (define-load-option 'RCS
   (guarded-system-loader '(rcs) "rcs"))
 
-(define-load-option 'SF
-  (guarded-system-loader '(scode-optimizer) "sf"))
+(define-load-option 'IMAIL
+  (guarded-system-loader '(edwin imail) "imail"))
 
-(define-load-option 'STUDENT
-  (guarded-system-loader '(student) "6001"))
+(define-load-option 'PC-SAMPLE
+  (guarded-system-loader '(pc-sample) "pcsample"))
 
-(define-load-option 'SOS
-  (guarded-system-loader '(runtime object-system) "sos"))
+(define-load-option 'SWAT
+  (guarded-system-loader '(swat) "swat"))
 
 (further-load-options standard-load-options)
\ No newline at end of file
-- 
2.25.1