X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fforeign-load.lisp;h=dc39be2debb042fd9cce80172e77988653b95dbf;hb=02313fc9ceecedacefc2e2a13c5c67a2ca9a57e8;hp=7b7b92e446fbcb2726e99de386befa2fb33daad8;hpb=fe19212267bef96fedb712ebb43abc91631aea18;p=sbcl.git

diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp
index 7b7b92e..dc39be2 100644
--- a/src/code/foreign-load.lisp
+++ b/src/code/foreign-load.lisp
@@ -35,6 +35,7 @@
 (defstruct shared-object pathname namestring handle dont-save)
 
 (defun load-shared-object (pathname &key dont-save)
+  #!+sb-doc
   "Load a shared library / dynamic shared object file / similar foreign
 container specified by designated PATHNAME, such as a .so on an ELF platform.
 
@@ -69,7 +70,9 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
                         :test #'equal))
              (obj (or old (make-shared-object
                            :pathname pathname
-                           :namestring (native-namestring pathname :as-file t)))))
+                           :namestring (native-namestring
+                                        (translate-logical-pathname pathname)
+                                        :as-file t)))))
         (setf (shared-object-dont-save obj) dont-save)
         ;; FIXME: Why doesn's dlopen-or-lose on already loaded stuff work on
         ;; Windows?
@@ -88,6 +91,23 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
           (update-linkage-table))))
     pathname))
 
+(defun unload-shared-object (pathname)
+  #!+sb-doc
+  "Unloads the shared object loaded earlier using the designated PATHNAME with
+LOAD-SHARED-OBJECT, to the degree supported on the platform.
+
+Experimental."
+  (let ((pathname (pathname pathname)))
+    (sb!thread:with-mutex (*shared-objects-lock*)
+      (let ((old (find pathname *shared-objects*
+                       :key #'shared-object-pathname
+                       :test #'equal)))
+        (when old
+          #!-hpux (dlclose-or-lose old)
+          (setf *shared-objects* (remove old *shared-objects*))
+          #!+(and linkage-table (not win32))
+          (update-linkage-table))))))
+
 (defun try-reopen-shared-object (obj)
   (declare (type shared-object obj))
   (tagbody :dlopen
@@ -110,8 +130,10 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
               (unless (pathnamep pathname)
                 (format *query-io* "~&Error: invalid pathname.~%")
                 (go :query))
-              (setf (shared-object-pathname obj) pathname
-                    (shared-object-namestring obj) (native-namestring pathname :as-file t))))
+              (setf (shared-object-pathname obj) pathname)
+              (setf (shared-object-namestring obj)
+                    (native-namestring (translate-logical-pathname pathname)
+                                       :as-file t))))
          (go :dlopen))))
   obj)
 
@@ -130,11 +152,11 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
 (defun close-shared-objects ()
   (let (saved)
     (dolist (obj (reverse *shared-objects*))
-      (dlclose-or-lose obj)
+      #!-hpux (dlclose-or-lose obj)
       (unless (shared-object-dont-save obj)
         (push obj saved)))
     (setf *shared-objects* saved))
-  #!-win32
+  #!-(or win32 hpux)
   (dlclose-or-lose))
 
 (let ((symbols (make-hash-table :test #'equal))