src/code/foreign.lisp

   1 ;;;; support for dynamically loading foreign object files and
   2 ;;;; resolving symbols therein
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   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.
  12
  13 (in-package "SB-SYS") ; (SB-SYS, not SB!SYS, since we're built in warm load.)
  14
  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
  22                                  ;; 20000702
  23                                  (base "/tmp/sbcl-tmp-~D~C"))
  24   (let ((code (char-code #\A)))
  25     (loop
  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
  30                                        sb-unix:o_creat
  31                                        sb-unix:o_excl)
  32                                #o666)
  33           (cond ((not (null fd))
  34                  (sb-unix:unix-close fd)
  35                  (return name))
  36                 ((not (= errno sb-unix:eexist))
  37                  (simple-file-perror "couldn't create temporary file ~S"
  38                                      name
  39                                      errno))
  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))
  44                  (return nil))
  45                 (t
  46                  (incf code))))))))
  47
  48
  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
  51 ;;; known", i.e. NIL.
  52 ;;;
  53 ;;; (On any OS which *does* support foreign object file loading, this
  54 ;;; placeholder implementation is overwritten by a subsequent real
  55 ;;; implementation.)
  56 ;;;
  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))
  61   nil)
  62
  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 #+(or linux FreeBSD)
  67 (progn
  68
  69 ;;; flags for dlopen()
  70 (defconstant rtld-lazy 1)               ; lazy function call binding?
  71 (defconstant rtld-now 2)                ; immediate function call binding?
  72 (defconstant rtld-global #x100)         ; symbols of loaded obj file
  73                                         ; (and its dependencies) made
  74                                         ; visible (as though the
  75                                         ; obj file were linked directly
  76                                         ; into the program)?
  77
  78 ;;; a list of handles returned from dlopen(3) (or possibly some
  79 ;;; bogus value temporarily during initialization)
  80 (defvar *handles-from-dlopen* nil)
  81
  82 ;;; Dynamically loaded stuff isn't there upon restoring from a save.
  83 ;;; Clearing the variable this way was originally done primarily for
  84 ;;; Irix, which resolves tzname at runtime, resulting in
  85 ;;; *HANDLES-FROM-DLOPEN* (which was then called *TABLES-FROM-DLOPEN*)
  86 ;;; being set in the saved core image, resulting in havoc upon
  87 ;;; restart; but it seems harmless and tidy for other OSes too.
  88 ;;;
  89 ;;; Of course, it can be inconvenient that dynamically loaded stuff
  90 ;;; goes away when we save and restore. However,
  91 ;;;  (1) trying to avoid it by system programming here could open a
  92 ;;;      huge can of worms, since e.g. now we would need to worry about
  93 ;;;      libraries possibly being in different locations (file locations
  94 ;;;      or memory locations) at restore time than at save time; and
  95 ;;;  (2) by the time the application programmer is so deep into the
  96 ;;;      the use of hard core extension features as to be doing
  97 ;;;      dynamic loading of foreign files and saving/restoring cores,
  98 ;;;      he probably has the sophistication to write his own after-save
  99 ;;;      code to reload the libraries without much difficulty.
 100
 101 ;;; dan 2001.05.10 suspects that objection (1) is bogus for
 102 ;;; dlsym()-enabled systems
 103
 104 (push (lambda () (setq *handles-from-dlopen* nil))
 105       *after-save-initializations*)
 106
 107 (defvar *dso-linker* "/usr/bin/ld")
 108 (defvar *dso-linker-options* '("-G" "-o"))
 109
 110
 111 (sb-alien:define-alien-routine dlopen system-area-pointer
 112   (file sb-c-call:c-string) (mode sb-c-call:int))
 113 (sb-alien:define-alien-routine dlsym system-area-pointer
 114   (lib system-area-pointer)
 115   (name sb-c-call:c-string))
 116 (sb-alien:define-alien-routine dlerror sb-c-call:c-string)
 117
 118 ;;; Ensure that we've opened our own binary so we can dynamically resolve
 119 ;;; symbols in the C runtime.
 120
 121 ;;; Old comment: This used to happen only in
 122 ;;; GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS, and only if no libraries were
 123 ;;; dlopen()ed already, but that didn't work if something was
 124 ;;; dlopen()ed before any problem global vars were used.  So now we do
 125 ;;; this in any function that can add to the *HANDLES-FROM-DLOPEN*, as
 126 ;;; well as in GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 127
 128 ;;; FIXME: It would work just as well to do it once at startup, actually.
 129 ;;; Then at least we know it's done.    -dan 2001.05.10
 130
 131 (defun ensure-runtime-symbol-table-opened ()
 132   (unless *handles-from-dlopen*
 133     ;; Prevent recursive call if dlopen() isn't defined.
 134     (setf *handles-from-dlopen* (int-sap 0))
 135     (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy)))
 136     (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*)))
 137       (error "can't open our own binary's symbol table: ~S" (dlerror)))))
 138
 139 (defun load-1-foreign (file)
 140   "the primitive upon which the more general LOAD-FOREIGN is built: load
 141   a single foreign object file
 142
 143   To use LOAD-1-FOREIGN, at the Unix command line do this:
 144     echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
 145     make /tmp/ffi-test.o # i.e. cc -c -o /tmp/ffi-test.o /tmp/ffi-test.c
 146     ld -shared -o /tmp/ffi-test.so /tmp/ffi-test.o
 147   then in SBCL do this:
 148     (LOAD-1-FOREIGN \"/tmp/ffi-test.so\")
 149     (DEFINE-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT))
 150   Now running (SUMMISH 10 20) should return 31.
 151 "
 152   (ensure-runtime-symbol-table-opened)
 153   ;; Note: We use RTLD-GLOBAL so that it can find all the symbols
 154   ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if
 155   ;; not all symbols are defined.
 156   (let* ((real-file (or (unix-namestring file) file))
 157          (sap (dlopen real-file (logior rtld-now rtld-global))))
 158        (if (zerop (sap-int sap))
 159            (error "can't open object ~S: ~S" real-file (dlerror))
 160            (pushnew sap *handles-from-dlopen* :test #'sap=)))
 161   (values))
 162
 163 (defun get-dynamic-foreign-symbol-address (symbol)
 164   (ensure-runtime-symbol-table-opened)
 165   ;; Find the symbol in any of the loaded object files. Search in
 166   ;; reverse order of loading, so that later loadings take precedence.
 167   ;;
 168   ;; FIXME: The way that we use PUSHNEW SAP in LOAD-1-FOREIGN means
 169   ;; that the list isn't guaranteed to be in reverse order of loading,
 170   ;; at least not if a file is loaded more than once. Is this the
 171   ;; right thing? (In what cases does it matter?)
 172   (dolist (handle *handles-from-dlopen*)
 173     ;; KLUDGE: We implicitly exclude the possibility that the variable
 174     ;; could actually be NULL, but the man page for dlsym(3)
 175     ;; recommends doing a more careful test. -- WHN 20000825
 176     (let ((possible-result (sap-int (dlsym handle symbol))))
 177       (unless (zerop possible-result)
 178         (return possible-result)))))
 179
 180 (defun load-foreign (files
 181                      &key
 182                      (libraries '("-lc"))
 183                      ;; FIXME: The old documentation said
 184                      ;;   The BASE-FILE argument is used to specify a
 185                      ;;   file to use as the starting place for
 186                      ;;   defined symbols. The default is the C start
 187                      ;;   up code for Lisp.
 188                      ;; But the code ignored the BASE-FILE argument.
 189                      ;; The comment above
 190                      ;;   (DECLARE (IGNORE BASE-FILE))
 191                      ;; said
 192                      ;;   dlopen() remembers the name of an object,
 193                      ;;   when dlopen()ing the same name twice, the
 194                      ;;   old object is reused.
 195                      ;; So I deleted all reference to BASE-FILE,
 196                      ;; including the now-bogus reference to the
 197                      ;; BASE-FILE argument in the documentation. But
 198                      ;; are there any other subtleties of the new code
 199                      ;; which need to be documented in its place?
 200                      (env nil env-p)
 201                      (environment (if env-p
 202                                       (unix-environment-sbcl-from-cmu env)
 203                                       (posix-environ))
 204                                   environment-p))
 205   #+sb-doc
 206   "LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES
 207   argument should be a single file or a list of files. The files may be
 208   specified as namestrings or as pathnames. The libraries argument should be a
 209   list of library files as would be specified to ld. They will be searched in
 210   the order given. The default is just \"-lc\", i.e., the C library. The
 211   ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix
 212   environment (\"man environ\") definitions for the invocation of the linker.
 213   The default is the environment that Lisp is itself running in. Instead of
 214   using the ENVIRONMENT argument, it is also possible to use the ENV argument,
 215   using the older, lossy CMU CL representation."
 216   (when (and env-p environment-p)
 217     (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
 218   (let ((output-file (pick-temporary-file-name
 219                       (concatenate 'string "/tmp/~D~C" (string (gensym)))))
 220         (error-output (make-string-output-stream)))
 221
 222     (/show "running" *dso-linker*)
 223     (force-output)
 224     (unwind-protect
 225         (let ((proc (sb-ext:run-program
 226                      *dso-linker*
 227                      (append *dso-linker-options*
 228                              (list output-file)
 229                              (append (mapcar (lambda (name)
 230                                                (unix-namestring name nil))
 231                                              (if (atom files)
 232                                                  (list files)
 233                                                files))
 234                                      libraries))
 235                      :environment environment
 236                      :input nil
 237                      :output error-output
 238                      :error :output)))
 239           (unless proc
 240             (error "could not run ~A" *dso-linker*))
 241           (unless (zerop (sb-ext:process-exit-code proc))
 242             (sb-sys:serve-all-events 0)
 243             (error "~A failed:~%~A" *dso-linker*
 244                    (get-output-stream-string error-output)))
 245           (load-1-foreign output-file))
 246       #-sb-show (sb-unix:unix-unlink output-file)
 247       #+sb-show (/show "not unlinking" output-file)))) ; so we can look at it
 248
 249 ) ; PROGN