-;;;; support for dynamically loading foreign object files
+;;;; support for dynamically loading foreign object files and
+;;;; resolving symbols therein
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB-SYS")
+(in-package "SB-ALIEN") ; (SB-ALIEN, not SB!ALIEN, since we're in warm load.)
-(file-comment
- "$Header$")
+;;; SEMI-KLUDGE: Preferable would be to use something like O_NOFOLLOW
+;;; which will refuse to open() a file if it is a symlink; but I've
+;;; been told that is a FreeBSD/Linux-only thing. Meanwhile, this will
+;;; make our filenames a lot less predictable.
+;;; (The man file for open() says O_EXCL should treat even a symlink as
+;;; an existing file. I wonder if it really does that.)
+;;; Also, no more dependence on ASCII character ordering.
+;;; -- mrd 20021101
+(defun generate-random-string (&optional (len 6))
+ (let* ((characters "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
+ (num (length characters))
+ (string (make-string len)))
+ (dotimes (i len string)
+ (setf (char string i)
+ (char characters (random num))))))
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
(defun pick-temporary-file-name (&optional
- ;; KLUDGE: There are various security
- ;; nastyisms associated with easily
- ;; guessable temporary file names,
- ;; and we haven't done anything to
- ;; work around them here. -- pointed
- ;; out by Dan Barlow on sbcl-devel
- ;; 20000702
- (base "/tmp/sbcl-tmp-~D~C"))
- (let ((code (char-code #\A)))
+ (base "/tmp/sbcl-tmp-~D~A"))
+ (let ((code (generate-random-string)))
(loop
- (let ((name (format nil base (sb-unix:unix-getpid) (code-char code))))
+ (let ((name (format nil base (sb-unix:unix-getpid) code)))
(multiple-value-bind (fd errno)
(sb-unix:unix-open name
(logior sb-unix:o_wronly
(sb-unix:unix-close fd)
(return name))
((not (= errno sb-unix:eexist))
- (error "could not create temporary file ~S: ~A"
- name
- (sb-unix:get-unix-error-msg errno)))
- ;; KLUDGE: depends on ASCII character ordering -- WHN 20000128
- ((= code (char-code #\Z))
- (setf code (char-code #\a)))
- ((= code (char-code #\z))
- (return nil))
+ (simple-file-perror "couldn't create temporary file ~S"
+ name
+ errno))
(t
- (incf code))))))))
-|#
+ (setf code (generate-random-string)))))))))
;;; On any OS where we don't support foreign object file loading, any
;;; query of a foreign symbol value is answered with "no definition
;;; known", i.e. NIL.
-;;;
-;;; (On any OS which *does* support foreign object file loading, this
-;;; placeholder implementation is overwritten by a subsequent real
-;;; implementation.)
+#-(or linux sunos FreeBSD OpenBSD)
(defun get-dynamic-foreign-symbol-address (symbol)
(declare (type simple-string symbol) (ignore symbol))
nil)
-;;; Linux implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
-;;; and functions (e.g. LOAD-FOREIGN) which affect it
-#+linux
+;;; dlsym()-based implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
+;;; and functions (e.g. LOAD-FOREIGN) which affect it. This should
+;;; work on any ELF system with dlopen(3) and dlsym(3)
+;;; It also works on OpenBSD, which isn't ELF, but is otherwise modern
+;;; enough to have a fairly well working dlopen/dlsym implementation.
+#-(or linux sunos FreeBSD OpenBSD)
+(macrolet ((define-unsupported-fun (fun-name)
+ `(defun ,fun-name (&rest rest)
+ "unsupported on this system"
+ (declare (ignore rest))
+ (error 'unsupported-operator :name ',fun-name))))
+ (define-unsupported-fun load-1-foreign)
+ (define-unsupported-fun load-foreign))
+#+(or linux sunos FreeBSD OpenBSD)
(progn
;;; flags for dlopen()
; obj file were linked directly
; into the program)?
-;;; a list of tables returned from dlopen(3) (or possibly some
+;;; a list of handles returned from dlopen(3) (or possibly some
;;; bogus value temporarily during initialization)
-(defvar *tables-from-dlopen* nil)
+(defvar *handles-from-dlopen* nil)
+
;;; Dynamically loaded stuff isn't there upon restoring from a save.
;;; Clearing the variable this way was originally done primarily for
;;; Irix, which resolves tzname at runtime, resulting in
-;;; *TABLES-FROM-DLOPEN* being set in the saved core image, resulting
-;;; in havoc upon restart; but it seems harmless and tidy for other
-;;; OSes too.
+;;; *HANDLES-FROM-DLOPEN* (which was then called *TABLES-FROM-DLOPEN*)
+;;; being set in the saved core image, resulting in havoc upon
+;;; restart; but it seems harmless and tidy for other OSes too.
;;;
;;; Of course, it can be inconvenient that dynamically loaded stuff
;;; goes away when we save and restore. However,
;;; dynamic loading of foreign files and saving/restoring cores,
;;; he probably has the sophistication to write his own after-save
;;; code to reload the libraries without much difficulty.
-(push (lambda () (setq *tables-from-dlopen* nil))
- sb-int:*after-save-initializations*)
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
+;;; dan 2001.05.10 suspects that objection (1) is bogus for
+;;; dlsym()-enabled systems
+
+(push (lambda () (setq *handles-from-dlopen* nil))
+ *after-save-initializations*)
+
(defvar *dso-linker* "/usr/bin/ld")
-(defvar *dso-linker-options* '("-G" "-o"))
-|#
+(defvar *dso-linker-options* '("-shared" "-o"))
-(sb-alien:def-alien-routine dlopen system-area-pointer
- (file sb-c-call:c-string) (mode sb-c-call:int))
-(sb-alien:def-alien-routine dlsym system-area-pointer
+(sb-alien:define-alien-routine dlopen system-area-pointer
+ (file sb-alien:c-string) (mode sb-alien:int))
+(sb-alien:define-alien-routine dlsym system-area-pointer
(lib system-area-pointer)
- (name sb-c-call:c-string))
-(sb-alien:def-alien-routine dlerror sb-c-call:c-string)
-
-;;; Ensure that we've opened our own binary so we can resolve global
-;;; variables in the Lisp image that come from libraries. This used to
-;;; happen only in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no
-;;; libraries were dlopen()ed already, but that didn't work if
-;;; something was dlopen()ed before any problem global vars were used.
-;;; So now we do this in any function that can add to the
-;;; *TABLES-FROM-DLOPEN*, as well as in
-;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
-(defun ensure-lisp-table-opened ()
- (unless *tables-from-dlopen*
+ (name sb-alien:c-string))
+(sb-alien:define-alien-routine dlerror sb-alien:c-string)
+
+;;; Ensure that we've opened our own binary so we can dynamically resolve
+;;; symbols in the C runtime.
+;;;
+;;; Old comment: This used to happen only in
+;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no libraries were
+;;; dlopen()ed already, but that didn't work if something was
+;;; dlopen()ed before any problem global vars were used. So now we do
+;;; this in any function that can add to the *HANDLES-FROM-DLOPEN*, as
+;;; well as in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
+;;;
+;;; FIXME: It would work just as well to do it once at startup, actually.
+;;; Then at least we know it's done. -dan 2001.05.10
+(defun ensure-runtime-symbol-table-opened ()
+ (unless *handles-from-dlopen*
;; Prevent recursive call if dlopen() isn't defined.
- (setf *tables-from-dlopen* (int-sap 0))
- (setf *tables-from-dlopen* (list (dlopen nil rtld-lazy)))
- (when (zerop (sb-sys:sap-int (first *tables-from-dlopen*)))
- (error "can't open global symbol table: ~S" (dlerror)))))
+ (setf *handles-from-dlopen* (int-sap 0))
+ (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy)))
+ (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*)))
+ (error "can't open our own binary's symbol table: ~S" (dlerror)))))
(defun load-1-foreign (file)
- "a primitive way to load a foreign object file. (LOAD-FOREIGN is
- probably preferred, but as of SBCL 0.6.7 is not implemented..)
+ "the primitive upon which the more general LOAD-FOREIGN is built: load
+ a single foreign object file
To use LOAD-1-FOREIGN, at the Unix command line do this:
echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
ld -shared -o /tmp/ffi-test.so /tmp/ffi-test.o
then in SBCL do this:
(LOAD-1-FOREIGN \"/tmp/ffi-test.so\")
- (DEF-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT))
+ (DEFINE-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT))
Now running (SUMMISH 10 20) should return 31.
"
- (ensure-lisp-table-opened)
+ (ensure-runtime-symbol-table-opened)
;; Note: We use RTLD-GLOBAL so that it can find all the symbols
;; previously loaded. We use RTLD-NOW so that dlopen() will fail if
;; not all symbols are defined.
- (let ((sap (dlopen file (logior rtld-now rtld-global))))
+ (let* ((real-file (or (unix-namestring file) file))
+ (sap (dlopen real-file (logior rtld-now rtld-global))))
(if (zerop (sap-int sap))
- (error "can't open object ~S: ~S" file (dlerror))
- (pushnew sap *tables-from-dlopen* :test #'sap=)))
+ (error "can't open object ~S: ~S" real-file (dlerror))
+ (pushnew sap *handles-from-dlopen* :test #'sap=)))
(values))
(defun get-dynamic-foreign-symbol-address (symbol)
- (ensure-lisp-table-opened)
+ (ensure-runtime-symbol-table-opened)
;; Find the symbol in any of the loaded object files. Search in
;; reverse order of loading, so that later loadings take precedence.
;;
;; that the list isn't guaranteed to be in reverse order of loading,
;; at least not if a file is loaded more than once. Is this the
;; right thing? (In what cases does it matter?)
- (dolist (table *tables-from-dlopen*)
+ (dolist (handle *handles-from-dlopen*)
;; KLUDGE: We implicitly exclude the possibility that the variable
;; could actually be NULL, but the man page for dlsym(3)
;; recommends doing a more careful test. -- WHN 20000825
- (let ((possible-result (sap-int (dlsym table symbol))))
+ (let ((possible-result (sap-int (dlsym handle symbol))))
(unless (zerop possible-result)
(return possible-result)))))
-;;; code partially ported from CMU CL to SBCL, but needs RUN-PROGRAM
-#|
-(defun load-foreign (files &key
- (libraries '("-lc"))
- (base-file nil)
- ;; Note: Since SBCL has no *ENVIRONMENT-LIST*
- ;; variable, if this code is ever restored,
- ;; the default should be taken from the alien
- ;; "environ" variable.
- ,, ; do it!
- (env sb-ext:*environment-list*))
+;;; Dan Barlow's quick summary from IRC 2003-06-21:
+;;; fwiw, load-foreign does random stuff with ld so that you can use
+;;; it with static libraries
+;;; if you have shared objects, load-1-foreign will do fine
+;;; and
+;;; I think my position on this matter is consistent with Tim Moore's:
+;;; use (cmucl equivalent of) load-1-foreign, load-foreign is arse
+;;; though he may say ass
+(defun load-foreign (files
+ &key
+ (libraries '("-lc"))
+ ;; FIXME: The old documentation said
+ ;; The BASE-FILE argument is used to specify a
+ ;; file to use as the starting place for
+ ;; defined symbols. The default is the C start
+ ;; up code for Lisp.
+ ;; But the code ignored the BASE-FILE argument.
+ ;; The comment above
+ ;; (DECLARE (IGNORE BASE-FILE))
+ ;; said
+ ;; dlopen() remembers the name of an object,
+ ;; when dlopen()ing the same name twice, the
+ ;; old object is reused.
+ ;; So I deleted all reference to BASE-FILE,
+ ;; including the now-bogus reference to the
+ ;; BASE-FILE argument in the documentation. But
+ ;; are there any other subtleties of the new code
+ ;; which need to be documented in its place?
+ (env nil env-p)
+ (environment (if env-p
+ (unix-environment-sbcl-from-cmu env)
+ (posix-environ))
+ environment-p))
#+sb-doc
"LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES
argument should be a single file or a list of files. The files may be
specified as namestrings or as pathnames. The libraries argument should be a
list of library files as would be specified to ld. They will be searched in
the order given. The default is just \"-lc\", i.e., the C library. The
- base-file argument is used to specify a file to use as the starting place for
- defined symbols. The default is the C start up code for Lisp. The ENV
- argument is the Unix environment variable definitions for the invocation of
- the linker. The default is the environment passed to Lisp."
- ;; Note: dlopen() remembers the name of an object, when dlopen()ing
- ;; the same name twice, the old object is reused.
- (declare (ignore base-file))
+ ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix
+ environment (\"man environ\") definitions for the invocation of the linker.
+ The default is the environment that Lisp is itself running in. Instead of
+ using the ENVIRONMENT argument, it is also possible to use the ENV argument,
+ using the older, lossy CMU CL representation."
+ (when (and env-p environment-p)
+ (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
(let ((output-file (pick-temporary-file-name
- (concatenate 'string "/tmp/~D~C" (string (gensym)))))
+ (concatenate 'string "/tmp/~D~A" (string (gensym)))))
(error-output (make-string-output-stream)))
(/show "running" *dso-linker*)
*dso-linker*
(append *dso-linker-options*
(list output-file)
- (append (mapcar #'(lambda (name)
- (unix-namestring name nil))
+ (append (mapcar (lambda (name)
+ (unix-namestring name nil))
(if (atom files)
(list files)
files))
libraries))
- :env env
+ :environment environment
:input nil
:output error-output
:error :output)))
(load-1-foreign output-file))
#-sb-show (sb-unix:unix-unlink output-file)
#+sb-show (/show "not unlinking" output-file)))) ; so we can look at it
-|#
) ; PROGN