X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fforeign-load.lisp;h=185d95849f6f3220414124350dc7e74acf327620;hb=b15ec266a38f1dae4e52a46c1980d4b7259686d3;hp=c8ee2ce16e2a2557c9d9765b71fad6adfb17121d;hpb=801730762f17302c33b70398b632aa1393c6722a;p=sbcl.git

diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp
index c8ee2ce..185d958 100644
--- a/src/code/foreign-load.lisp
+++ b/src/code/foreign-load.lisp
@@ -25,9 +25,8 @@
   "~S is unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT."
   (load-1-foreign))
 
-#!-win32
 (progn
-  (define-alien-variable undefined-alien-address unsigned-long)
+  (define-alien-variable undefined-alien-address unsigned)
   (defvar *runtime-dlhandle*))
 
 (defvar *shared-objects*)
@@ -35,6 +34,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.
 
@@ -75,6 +75,14 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
         (setf (shared-object-dont-save obj) dont-save)
         ;; FIXME: Why doesn's dlopen-or-lose on already loaded stuff work on
         ;; Windows?
+        ;;
+        ;; Kovalenko 2010-11-24: It would work, but it does nothing
+        ;; useful on Windows: library reference count is increased
+        ;; after each LoadLibrary, making it harder to unload it, and
+        ;; that's all the effect. Also, equal pathnames on Windows
+        ;; always designate _exactly the same library image_; Unix
+        ;; tricks like deleting an open library and replacing it with
+        ;; another version just don't work here.
         #!-win32
         (dlopen-or-lose obj)
         #!+win32
@@ -85,11 +93,34 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
         ;; FIXME: Why doesn't the linkage table work on Windows? (Or maybe it
         ;; does and this can be just #!+linkage-table?) Note: remember to change
         ;; FOREIGN-DEINIT as well then!
-        #!+(and linkage-table (not win32))
+        ;;
+        ;; Kovalenko 2010-11-24: I think so. Alien _data_ references
+        ;; are the only thing on win32 that is even slightly
+        ;; problematic. Handle function references in the same way as
+        ;; other linkage-table platforms is easy.
+        ;;
+        #!+linkage-table
         (when (or old (undefined-foreign-symbols-p))
           (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*))
+          #!+linkage-table
+          (update-linkage-table))))))
+
 (defun try-reopen-shared-object (obj)
   (declare (type shared-object obj))
   (tagbody :dlopen
@@ -112,8 +143,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)
 
@@ -121,7 +154,6 @@ will be signalled when the core is saved -- this is orthogonal from DONT-SAVE."
 ;;; initialization.
 (defun reopen-shared-objects ()
   ;; Ensure that the runtime is open
-  #!-win32
   (setf *runtime-dlhandle* (dlopen-or-lose))
   ;; Reopen stuff.
   (setf *shared-objects*
@@ -132,11 +164,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
+  #!-hpux
   (dlclose-or-lose))
 
 (let ((symbols (make-hash-table :test #'equal))
@@ -149,10 +181,10 @@ error is immediately signalled if the symbol isn't found. The returned address
 is never in the linkage-table."
     (declare (ignorable datap))
     (let ((addr (find-dynamic-foreign-symbol-address symbol)))
-      (cond  #!-(and linkage-table (not win32))
+      (cond  #!-linkage-table
              ((not addr)
               (error 'undefined-alien-error :name symbol))
-             #!+(and linkage-table (not win32))
+             #!+linkage-table
              ((not addr)
               (style-warn 'sb!kernel:undefined-alien-style-warning
                           :symbol symbol)
@@ -171,5 +203,7 @@ is never in the linkage-table."
     (plusp (hash-table-count symbols)))
   (defun list-dynamic-foreign-symbols ()
     (loop for symbol being each hash-key in symbols
-         collect symbol)))
-
+         collect symbol))
+  (defun list-undefined-foreign-symbols ()
+    (loop for symbol being each hash-key in undefineds
+          collect symbol)))