Use new primitive `microcode-library-path', if present, to get a

sequence of library directory names.

Change `system-library-directory-pathname' to search through this
sequence; also change it to accept an argument which is the name of a
subdirectory to look for.

New procedure `system-library-pathname' searches for a given file in
one of the library directories.

`load-option' and `disk-restore' changed to use
`system-library-pathname'.

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index ba03be578b47dfe0b718b1da339a74265418f7a8..2b3417147fbd6ad49709715481935e8b797563b6 100644 (file)
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.24 1990/11/09 08:44:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.25 1990/11/15 23:27:03 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -325,6 +325,7 @@ MIT in each case. |#
    (RUNTIME TRUNCATED-STRING-OUTPUT)
    (RUNTIME INPUT-PORT)
    (RUNTIME OUTPUT-PORT)
+   (RUNTIME PATHNAME)
    (RUNTIME WORKING-DIRECTORY)
    (RUNTIME DIRECTORY)
    (RUNTIME LOAD)

diff --git a/v7/src/runtime/option.scm b/v7/src/runtime/option.scm
index 8baa79b2f8076f759455d7975df377f3529aeb9e..9d53a2402455cc5b369e1971c75e2c082daee0a7 100644 (file)
--- a/v7/src/runtime/option.scm
+++ b/v7/src/runtime/option.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/option.scm,v 14.7 1990/02/10 23:45:01 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/option.scm,v 14.8 1990/11/15 23:27:15 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -39,10 +39,7 @@ MIT in each case. |#
 \f
 (define (load-option name)
   (let ((entry (assq name options))
-       (pathname
-        (pathname-as-directory
-         (merge-pathnames (string->pathname "options")
-                          (system-library-directory-pathname)))))
+       (pathname (pathname-as-directory (string->pathname "options"))))
     (if (not entry)
        (error "Unknown option name" name))
     (for-each
@@ -50,8 +47,9 @@ MIT in each case. |#
        (let ((environment
              (package/environment (find-package (car descriptor)))))
         (for-each (lambda (filename)
-                    (load (merge-pathnames (string->pathname filename)
-                                           pathname)
+                    (load (system-library-pathname
+                           (merge-pathnames (string->pathname filename)
+                                            pathname))
                           environment
                           syntax-table/system-internal
                           true))

diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index 76d05c96754d80d89aba1a5d3ed2eb46a6305825..671e00fe3674a8196e8f701fb3b0826f0390b832 100644 (file)
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.7 1990/06/20 20:29:44 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.8 1990/11/15 23:27:22 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -394,7 +394,7 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|#
 
 (define (file-exists? filename)
   (pathname->input-truename (->pathname filename)))
-
+\f
 (define (init-file-truename)
   (let ((pathname (init-file-pathname)))
     (and pathname
@@ -403,6 +403,43 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|#
             (pathname->input-truename
              (merge-pathnames pathname (home-directory-pathname)))))))
 
-(define (system-library-directory-pathname)
-  (pathname-directory-path
-   (string->pathname ((ucode-primitive microcode-tables-filename 0)))))
\ No newline at end of file
+(define (initialize-package!)
+  (reset-library-directory-path!)
+  (add-event-receiver! event:after-restore reset-library-directory-path!))
+
+(define (reset-library-directory-path!)
+  (set! library-directory-path
+       (if (implemented-primitive-procedure? microcode-library-path)
+           (map (lambda (filename)
+                  (pathname-as-directory (string->pathname filename)))
+                (vector->list (microcode-library-path)))
+           (list 
+            (pathname-directory-path
+             (string->pathname (microcode-tables-filename))))))
+  unspecific)
+
+(define-primitives
+  (microcode-library-path 0)
+  (microcode-tables-filename 0))
+
+(define library-directory-path)
+
+(define (system-library-pathname pathname)
+  (let loop ((directories library-directory-path))
+    (and (not (null? directories))
+        (or (pathname->input-truename
+             (merge-pathnames pathname (car directories)))
+            (loop (cdr directories))))))
+
+(define (system-library-directory-pathname pathname)
+  (if (not pathname)
+      (let ((pathname
+            (list-search-positive library-directory-path file-directory?)))
+       (and pathname
+            (pathname-as-directory pathname)))
+      (let loop ((directories library-directory-path))
+       (and (not (null? directories))
+            (let ((pathname (merge-pathnames pathname (car directories))))
+              (if (file-directory? pathname)
+                  (pathname-as-directory pathname)
+                  (loop (cdr directories))))))))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 80114acd1240c2a1caddaad72aacad7946ad6958..4dd598226fcf901fcaca3fe961e2cb5ed8aa5c66 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.86 1990/11/15 15:42:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.87 1990/11/15 23:27:32 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1349,9 +1349,11 @@ MIT in each case. |#
          pathname-version
          pathname?
          string->pathname
-         system-library-directory-pathname)
+         system-library-directory-pathname
+         system-library-pathname)
   (export (runtime pathname-parser)
-         simplify-directory))
+         simplify-directory)
+  (initialization (initialize-package!)))
 
 (define-package (runtime pathname-parser)
   (file-case os-type

diff --git a/v7/src/runtime/savres.scm b/v7/src/runtime/savres.scm
index 4a073363b900da0c16dc2bb47ad6431b66b97aa5..c71cdb06806ceb671e3fe9bd065f8552eeb7e697 100644 (file)
--- a/v7/src/runtime/savres.scm
+++ b/v7/src/runtime/savres.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/savres.scm,v 14.15 1990/11/14 13:27:28 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/savres.scm,v 14.16 1990/11/15 23:27:44 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -141,14 +141,21 @@ MIT in each case. |#
   ;; Force order of events -- no need to run event:before-exit if
   ;; there's an error here.
   (let ((filename
-        (canonicalize-input-filename
+        (pathname->string
          (if (default-object? filename)
-             (or ((ucode-primitive reload-band-name))
-                 (error "DISK-RESTORE: No default band name available"))
-             filename))))
+             (canonicalize-input-pathname
+              (or ((ucode-primitive reload-band-name))
+                  (error "no default band name available")))
+             (let ((pathname
+                    (pathname-default-type (->pathname filename) "com")))
+               (let ((truename
+                      (or (pathname->input-truename pathname)
+                          (system-library-pathname pathname))))
+                 (if (not truename) (error error-type:open-file pathname))
+                 truename))))))
     (event-distributor/invoke! event:before-exit)
     ((ucode-primitive load-band) filename)))
-\f
+
 (define world-identification "Scheme")
 (define time-world-saved)
 

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 353a7bb81af00ff6baf50aae199929c2dc99d8b4..c9a3a8a5fbdb8913e2ad49c35d36ca346a511506 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.102 1990/11/14 13:28:42 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.103 1990/11/15 23:27:53 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 102))
+  (add-identification! "Runtime" 14 103))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm
index 305245514c57d150148c7850b8fbf7915437b583..8b1131d1832ae29a4c44f28a352031eb3b10285d 100644 (file)
--- a/v8/src/runtime/make.scm
+++ b/v8/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.24 1990/11/09 08:44:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.25 1990/11/15 23:27:03 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -325,6 +325,7 @@ MIT in each case. |#
    (RUNTIME TRUNCATED-STRING-OUTPUT)
    (RUNTIME INPUT-PORT)
    (RUNTIME OUTPUT-PORT)
+   (RUNTIME PATHNAME)
    (RUNTIME WORKING-DIRECTORY)
    (RUNTIME DIRECTORY)
    (RUNTIME LOAD)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 1061692528784a1db25a14782c4e72a25d026d2b..32b798e855fe74ea914c6348e25f95fa27e89490 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.86 1990/11/15 15:42:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.87 1990/11/15 23:27:32 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1349,9 +1349,11 @@ MIT in each case. |#
          pathname-version
          pathname?
          string->pathname
-         system-library-directory-pathname)
+         system-library-directory-pathname
+         system-library-pathname)
   (export (runtime pathname-parser)
-         simplify-directory))
+         simplify-directory)
+  (initialization (initialize-package!)))
 
 (define-package (runtime pathname-parser)
   (file-case os-type