fix direct execution of (shebanged) fasls

[sbcl.git] / src / code / foreign-load.lisp

diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp
index 7b7b92e..185d958 100644 (file)
--- 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.
 
@@ -69,10 +69,20 @@ 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?
+        ;;
+        ;; 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
@@ -83,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
@@ -110,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)
 
@@ -119,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*
@@ -130,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))
@@ -147,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)
@@ -169,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)))