From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Tue, 8 Mar 2016 18:38:11 +0000 (-0700)
Subject: Punt with-system-library-directories.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~75^2~12
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d4e8740a6c2ff22046d99736810946c91a4fed20;p=mit-scheme.git

Punt with-system-library-directories.

This procedure made uninstalled FFIs visible while building or testing
plugins, but it works for one thread only.  A test involving multiple
threads will fail if another thread tries to call out and cannot find
the uninstalled FFI's shim.
---

diff --git a/src/runtime/pathnm.scm b/src/runtime/pathnm.scm
index cc9a3131f..005c23772 100644
--- a/src/runtime/pathnm.scm
+++ b/src/runtime/pathnm.scm
@@ -640,29 +640,13 @@ these rules:
 	      (else #f)))
       (%find-library-directory)))
 
-(define (with-system-library-directories directories thunk)
-
-  (define (existing-directory directory)
-    (let ((dirpath (pathname-as-directory (merge-pathnames directory))))
-      (if (file-directory? dirpath)
-	  dirpath
-	  (error:file-operation dirpath
-				"find" "directory" "no such directory"
-				'with-system-library-directories
-				directories))))
-
-  (parameterize* (list (cons library-directory-path
-			     (append (map existing-directory directories)
-				     (library-directory-path))))
-    thunk))
-
 (define (%find-library-directory)
   (pathname-simplify
-   (or (find-matching-item (library-directory-path) file-directory?)
+   (or (find-matching-item library-directory-path file-directory?)
        (error "Can't find library directory."))))
 
 (define (%find-library-file pathname)
-  (let loop ((path (library-directory-path)))
+  (let loop ((path library-directory-path))
     (and (pair? path)
 	 (let ((p (merge-pathnames pathname (car path))))
 	   (if (file-exists? p)
@@ -736,9 +720,8 @@ these rules:
   (set! param:default-pathname-defaults (make-param:default-pathname-defaults))
   (param:default-pathname-defaults (make-pathname local-host #f #f #f #f #f))
   (set! library-directory-path
-	(make-unsettable-parameter
-	 (map pathname-as-directory
-	      (vector->list ((ucode-primitive microcode-library-path 0))))))
+	(map pathname-as-directory
+	     (vector->list ((ucode-primitive microcode-library-path 0)))))
   unspecific)
 
 (define (initialize-package!)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 8f0b7313a..ec95f32bb 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3212,7 +3212,6 @@ USA.
 	  pathname?
 	  system-library-directory-pathname
 	  system-library-pathname
-	  with-system-library-directories
 	  uri->pathname
 	  user-homedir-pathname)
   (initialization (initialize-package!)))