1 ;;;; Loading shared object files
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!ALIEN")
14 ;;; Used to serialize modifications to *linkage-info*,
15 ;;; *shared-objects* and the linkage-table proper. Calls thru
16 ;;; linkage-table are unaffected.
17 (defvar *foreign-lock*
18 (sb!thread:make-mutex :name "foreign definition lock"))
20 (define-unsupported-fun load-foreign
21 "Unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT."
22 "~S is unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT."
25 (define-unsupported-fun load-1-foreign
26 "Unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT."
27 "~S is unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT."
30 (define-alien-routine dlopen system-area-pointer
31 (file c-string) (mode int))
33 (define-alien-routine dlclose int
34 (handle system-area-pointer))
36 (define-alien-routine dlerror c-string)
38 (define-alien-routine dlsym system-area-pointer
39 (handle system-area-pointer)
42 (define-alien-variable undefined-alien-address unsigned-long)
44 (defvar *runtime-dlhandle*)
45 (defvar *shared-objects*)
47 (defstruct shared-object file sap)
49 (defun dlopen-or-lose (&optional (obj nil objp))
51 (dlclose-or-lose obj))
52 (dlerror) ; clear errors
53 (let* ((file (and obj (shared-object-file obj)))
54 (sap (dlopen file (logior rtld-global rtld-now))))
55 (aver (or (not objp) file))
56 (when (zerop (sap-int sap))
58 (setf (shared-object-sap obj) nil)
59 (setf *runtime-dlhandle* nil))
60 (error "Could not open ~:[runtime~;~:*shared object ~S~]: ~A"
63 (setf (shared-object-sap obj) sap))
66 (defun dlclose-or-lose (&optional (obj nil objp))
69 (cond ((and (not objp) *runtime-dlhandle*)
70 (dlclose *runtime-dlhandle*)
71 (setf dlerror (dlerror)
72 *runtime-dlhandle* nil))
73 ((and objp (shared-object-sap obj))
74 (dlclose (shared-object-sap obj))
75 (setf dlerror (dlerror)
76 (shared-object-sap obj) nil)))
78 (cerror "Ignore the error and continue anyway" "dlerror returned an error: ~S" dlerror))))
80 (defun load-shared-object (file)
81 "Load a shared library/dynamic shared object file/general dlopenable
82 alien container, such as a .so on an ELF platform.
84 Reloading the same shared object will replace the old definitions; if
85 a symbol was previously referenced thru the object and is not present
86 in the reloaded version an error will be signalled. Sameness is
87 determined using the library filename. Reloading may not work as
88 expected if user or library-code has called dlopen on FILE.
90 References to foreign symbols in loaded shared objects do not survive
91 intact through SB-EXT:SAVE-LISP-AND die on all platforms. See
92 SB-EXT:SAVE-LISP-AND-DIE for details."
93 (sb!thread:with-mutex (*foreign-lock*)
94 (let* ((filename (or (unix-namestring file) file))
95 (old (find filename *shared-objects* :key #'shared-object-file :test #'equal))
96 (obj (or old (make-shared-object :file filename))))
98 (setf *shared-objects* (append (remove obj *shared-objects*)
101 (when (or old (undefined-foreign-symbols))
102 (update-linkage-table))
103 (pathname filename))))
105 (defun try-reopen-shared-object (obj)
106 (declare (type shared-object obj))
111 :report "Skip this shared object and continue."
112 (setf (shared-object-sap obj) nil))
114 :report "Retry loading this shared object."
117 :report "Specify an alternate shared object file to load."
118 (setf (shared-object-file obj)
120 (format *query-io* "~&Enter pathname (evaluated):~%")
121 (force-output *query-io*)
122 (let ((pathname (ignore-errors (pathname (read *query-io*)))))
123 (unless (pathnamep pathname)
124 (format *query-io* "~&Error: invalid pathname.~%")
126 (unix-namestring pathname)))))))
129 ;;; Open libraries in *SHARED-OBJECTS* and the runtime. Called during
131 (defun reopen-shared-objects ()
132 ;; Ensure that the runtime is open
133 (setf *runtime-dlhandle* (dlopen-or-lose)
134 *shared-objects* (mapcar #'try-reopen-shared-object *shared-objects*)))
136 ;;; Close all dlopened libraries and clear out sap entries in
137 ;;; *SHARED-OBJECTS*.
138 (defun close-shared-objects ()
139 (mapc #'dlclose-or-lose (reverse *shared-objects*))
144 (defun get-dynamic-foreign-symbol-address (symbol)
145 (dlerror) ; clear old errors
146 (unless *runtime-dlhandle*
147 (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*"))
148 (let* ((result (sap-int (dlsym *runtime-dlhandle* symbol)))
150 (addr (if (or (not (zerop result)) (not err))
152 (dolist (obj *shared-objects*)
153 (let ((sap (shared-object-sap obj)))
155 (setf result (sap-int (dlsym sap symbol))
157 (when (or (not (zerop result)) (not err))
158 (return result))))))))
160 (style-warn "Undefined alien: ~S" symbol)
161 (pushnew symbol undefineds :test #'equal)
162 (remove symbol symbols :test #'equal)
163 undefined-alien-address)
165 (pushnew symbol symbols :test #'equal)
166 (remove symbol undefineds :test #'equal)
168 (defun dynamic-foreign-symbols ()
170 (defun undefined-foreign-symbols ()