Implement LOAD-LIBRARY-OBJECT-FILE for loading primitives that are

implemented as dynamically-loaded shared libraries.

diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm
index fc52b30568c8b27193a7f5ede98604b1fb69985f..5a64e6a378ba077b9e2ade6de48dd89ceb9bc444 100644 (file)
--- a/v7/src/runtime/load.scm
+++ b/v7/src/runtime/load.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: load.scm,v 14.55 2000/01/10 03:35:36 cph Exp $
+$Id: load.scm,v 14.56 2001/03/08 19:26:56 cph Exp $
 
 Copyright (c) 1988-2000 Massachusetts Institute of Technology
 
@@ -43,6 +43,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (set! condition-type:not-loading
        (make-condition-type 'NOT-LOADING condition-type:error '()
          "No file being loaded."))
+  (reset-loaded-object-files!)
+  (add-event-receiver! event:after-restart reset-loaded-object-files!)
   (initialize-command-line-parsers)
   (set! hook/process-command-line default/process-command-line)
   (add-event-receiver! event:after-restart process-command-line))
@@ -56,6 +58,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define condition-type:not-loading)
 (define load/default-find-pathname-with-type)
 (define fasload/default-types)
+(define loaded-object-files)
 \f
 ;;; This is careful to do the minimum number of file existence probes
 ;;; before opening the input file.
@@ -273,6 +276,39 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                           (nearest-repl/environment)
                           environment)))
 \f
+(define (load-library-object-file name errors?)
+  (let ((pathname
+        (merge-pathnames name
+                         (system-library-directory-pathname "lib"))))
+    (if (there-exists? loaded-object-files
+         (lambda (pathname*)
+           (pathname=? pathname pathname*)))
+       #t
+       (let ((pathname*
+              (let ((find
+                     (lambda (type)
+                       (let ((pathname (pathname-new-type pathname type)))
+                         (and (file-exists? pathname)
+                              pathname)))))
+                (or (find "so")
+                    (find "sl")))))
+         (cond ((not pathname*)
+                (and errors?
+                     (error "No library object file of this name:" pathname)))
+               ((ignore-errors (lambda () (load pathname*)))
+                => (lambda (condition)
+                     (if errors?
+                         (signal-condition condition)
+                         condition)))
+               (else
+                (set! loaded-object-files
+                      (cons pathname loaded-object-files))
+                #t))))))
+
+(define (reset-loaded-object-files!)
+  (set! loaded-object-files '())
+  unspecific)
+\f
 (define (loading-message suppress-loading-message? pathname do-it)
   (if suppress-loading-message?
       (do-it)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 4cca60330f01eaa6415c8b9849ea96ad078d7648..26bbd540a5675be9b8ca8a138e8e9cba7b738632 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.360 2001/02/28 21:42:42 cph Exp $
+$Id: runtime.pkg,v 14.361 2001/03/08 19:26:59 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -1454,6 +1454,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          fasload/default-types
          load
          load-latest
+         load-library-object-file
          load-noisily
          load-noisily?
          load/default-find-pathname-with-type