1 ;;;; support for dynamically loading foreign object files and
2 ;;;; resolving symbols therein
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
13 (in-package "SB-ALIEN") ; (SB-ALIEN, not SB!ALIEN, since we're in warm load.)
15 (defun pick-temporary-file-name (&optional
16 ;; KLUDGE: There are various security
17 ;; nastyisms associated with easily
18 ;; guessable temporary file names,
19 ;; and we haven't done anything to
20 ;; work around them here. -- pointed
21 ;; out by Dan Barlow on sbcl-devel
23 (base "/tmp/sbcl-tmp-~D~C"))
24 (let ((code (char-code #\A)))
26 (let ((name (format nil base (sb-unix:unix-getpid) (code-char code))))
27 (multiple-value-bind (fd errno)
28 (sb-unix:unix-open name
29 (logior sb-unix:o_wronly
33 (cond ((not (null fd))
34 (sb-unix:unix-close fd)
36 ((not (= errno sb-unix:eexist))
37 (simple-file-perror "couldn't create temporary file ~S"
40 ;; KLUDGE: depends on ASCII character ordering -- WHN 20000128
41 ((= code (char-code #\Z))
42 (setf code (char-code #\a)))
43 ((= code (char-code #\z))
49 ;;; On any OS where we don't support foreign object file loading, any
50 ;;; query of a foreign symbol value is answered with "no definition
53 ;;; (On any OS which *does* support foreign object file loading, this
54 ;;; placeholder implementation is overwritten by a subsequent real
57 ;;; You may want to use SB-SYS:FOREIGN-SYMBOL-ADDRESS instead of
58 ;;; calling this directly; see code/target-load.lisp.
59 (defun get-dynamic-foreign-symbol-address (symbol)
60 (declare (type simple-string symbol) (ignore symbol))
63 ;;; dlsym()-based implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
64 ;;; and functions (e.g. LOAD-FOREIGN) which affect it. This should
65 ;;; work on any ELF system with dlopen(3) and dlsym(3)
66 ;;; It also works on OpenBSD, which isn't ELF, but is otherwise modern
67 ;;; enough to have a fairly well working dlopen/dlsym implementation.
68 #-(or linux FreeBSD OpenBSD)
69 (macrolet ((define-unsupported-fun (fun-name)
70 `(defun ,fun-name (&rest rest)
71 "unsupported on this system"
72 (declare (ignore rest))
73 (error 'unsupported-operator :name ',fun-name))))
74 (define-unsupported-fun load-1-foreign)
75 (define-unsupported-fun load-foreign))
76 #+(or linux FreeBSD OpenBSD)
79 ;;; flags for dlopen()
80 (defconstant rtld-lazy 1) ; lazy function call binding?
81 (defconstant rtld-now 2) ; immediate function call binding?
82 (defconstant rtld-global #x100) ; symbols of loaded obj file
83 ; (and its dependencies) made
84 ; visible (as though the
85 ; obj file were linked directly
88 ;;; a list of handles returned from dlopen(3) (or possibly some
89 ;;; bogus value temporarily during initialization)
90 (defvar *handles-from-dlopen* nil)
92 ;;; Dynamically loaded stuff isn't there upon restoring from a save.
93 ;;; Clearing the variable this way was originally done primarily for
94 ;;; Irix, which resolves tzname at runtime, resulting in
95 ;;; *HANDLES-FROM-DLOPEN* (which was then called *TABLES-FROM-DLOPEN*)
96 ;;; being set in the saved core image, resulting in havoc upon
97 ;;; restart; but it seems harmless and tidy for other OSes too.
99 ;;; Of course, it can be inconvenient that dynamically loaded stuff
100 ;;; goes away when we save and restore. However,
101 ;;; (1) trying to avoid it by system programming here could open a
102 ;;; huge can of worms, since e.g. now we would need to worry about
103 ;;; libraries possibly being in different locations (file locations
104 ;;; or memory locations) at restore time than at save time; and
105 ;;; (2) by the time the application programmer is so deep into the
106 ;;; the use of hard core extension features as to be doing
107 ;;; dynamic loading of foreign files and saving/restoring cores,
108 ;;; he probably has the sophistication to write his own after-save
109 ;;; code to reload the libraries without much difficulty.
111 ;;; dan 2001.05.10 suspects that objection (1) is bogus for
112 ;;; dlsym()-enabled systems
114 (push (lambda () (setq *handles-from-dlopen* nil))
115 *after-save-initializations*)
117 (defvar *dso-linker* "/usr/bin/ld")
118 (defvar *dso-linker-options* '("-shared" "-o"))
121 (sb-alien:define-alien-routine dlopen system-area-pointer
122 (file sb-alien:c-string) (mode sb-alien:int))
123 (sb-alien:define-alien-routine dlsym system-area-pointer
124 (lib system-area-pointer)
125 (name sb-alien:c-string))
126 (sb-alien:define-alien-routine dlerror sb-alien:c-string)
128 ;;; Ensure that we've opened our own binary so we can dynamically resolve
129 ;;; symbols in the C runtime.
131 ;;; Old comment: This used to happen only in
132 ;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no libraries were
133 ;;; dlopen()ed already, but that didn't work if something was
134 ;;; dlopen()ed before any problem global vars were used. So now we do
135 ;;; this in any function that can add to the *HANDLES-FROM-DLOPEN*, as
136 ;;; well as in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
138 ;;; FIXME: It would work just as well to do it once at startup, actually.
139 ;;; Then at least we know it's done. -dan 2001.05.10
141 (defun ensure-runtime-symbol-table-opened ()
142 (unless *handles-from-dlopen*
143 ;; Prevent recursive call if dlopen() isn't defined.
144 (setf *handles-from-dlopen* (int-sap 0))
145 (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy)))
146 (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*)))
147 (error "can't open our own binary's symbol table: ~S" (dlerror)))))
149 (defun load-1-foreign (file)
150 "the primitive upon which the more general LOAD-FOREIGN is built: load
151 a single foreign object file
153 To use LOAD-1-FOREIGN, at the Unix command line do this:
154 echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
155 make /tmp/ffi-test.o # i.e. cc -c -o /tmp/ffi-test.o /tmp/ffi-test.c
156 ld -shared -o /tmp/ffi-test.so /tmp/ffi-test.o
157 then in SBCL do this:
158 (LOAD-1-FOREIGN \"/tmp/ffi-test.so\")
159 (DEFINE-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT))
160 Now running (SUMMISH 10 20) should return 31.
162 (ensure-runtime-symbol-table-opened)
163 ;; Note: We use RTLD-GLOBAL so that it can find all the symbols
164 ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if
165 ;; not all symbols are defined.
166 (let* ((real-file (or (unix-namestring file) file))
167 (sap (dlopen real-file (logior rtld-now rtld-global))))
168 (if (zerop (sap-int sap))
169 (error "can't open object ~S: ~S" real-file (dlerror))
170 (pushnew sap *handles-from-dlopen* :test #'sap=)))
173 (defun get-dynamic-foreign-symbol-address (symbol)
174 (ensure-runtime-symbol-table-opened)
175 ;; Find the symbol in any of the loaded object files. Search in
176 ;; reverse order of loading, so that later loadings take precedence.
178 ;; FIXME: The way that we use PUSHNEW SAP in LOAD-1-FOREIGN means
179 ;; that the list isn't guaranteed to be in reverse order of loading,
180 ;; at least not if a file is loaded more than once. Is this the
181 ;; right thing? (In what cases does it matter?)
182 (dolist (handle *handles-from-dlopen*)
183 ;; KLUDGE: We implicitly exclude the possibility that the variable
184 ;; could actually be NULL, but the man page for dlsym(3)
185 ;; recommends doing a more careful test. -- WHN 20000825
186 (let ((possible-result (sap-int (dlsym handle symbol))))
187 (unless (zerop possible-result)
188 (return possible-result)))))
190 (defun load-foreign (files
193 ;; FIXME: The old documentation said
194 ;; The BASE-FILE argument is used to specify a
195 ;; file to use as the starting place for
196 ;; defined symbols. The default is the C start
198 ;; But the code ignored the BASE-FILE argument.
200 ;; (DECLARE (IGNORE BASE-FILE))
202 ;; dlopen() remembers the name of an object,
203 ;; when dlopen()ing the same name twice, the
204 ;; old object is reused.
205 ;; So I deleted all reference to BASE-FILE,
206 ;; including the now-bogus reference to the
207 ;; BASE-FILE argument in the documentation. But
208 ;; are there any other subtleties of the new code
209 ;; which need to be documented in its place?
211 (environment (if env-p
212 (unix-environment-sbcl-from-cmu env)
216 "LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES
217 argument should be a single file or a list of files. The files may be
218 specified as namestrings or as pathnames. The libraries argument should be a
219 list of library files as would be specified to ld. They will be searched in
220 the order given. The default is just \"-lc\", i.e., the C library. The
221 ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix
222 environment (\"man environ\") definitions for the invocation of the linker.
223 The default is the environment that Lisp is itself running in. Instead of
224 using the ENVIRONMENT argument, it is also possible to use the ENV argument,
225 using the older, lossy CMU CL representation."
226 (when (and env-p environment-p)
227 (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
228 (let ((output-file (pick-temporary-file-name
229 (concatenate 'string "/tmp/~D~C" (string (gensym)))))
230 (error-output (make-string-output-stream)))
232 (/show "running" *dso-linker*)
235 (let ((proc (sb-ext:run-program
237 (append *dso-linker-options*
239 (append (mapcar (lambda (name)
240 (unix-namestring name nil))
245 :environment environment
250 (error "could not run ~A" *dso-linker*))
251 (unless (zerop (sb-ext:process-exit-code proc))
252 (sb-sys:serve-all-events 0)
253 (error "~A failed:~%~A" *dso-linker*
254 (get-output-stream-string error-output)))
255 (load-1-foreign output-file))
256 #-sb-show (sb-unix:unix-unlink output-file)
257 #+sb-show (/show "not unlinking" output-file)))) ; so we can look at it