src/code/foreign.lisp

   1 ;;;; Foreign symbol linkage
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package "SB!IMPL")
  13
  14 #!-(or elf mach-o win32)
  15 (error "Not an ELF, Mach-O, or Win32 platform?")
  16
  17 (defun extern-alien-name (name)
  18   (handler-case
  19       (coerce name 'base-string)
  20     (error ()
  21       (error "invalid external alien name: ~S" name))))
  22
  23 ;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not
  24 ;;; as opposed to C's "extern"). The table contains symbols known at
  25 ;;; the time that the program was built, but not symbols defined in
  26 ;;; object files which have been loaded dynamically since then.
  27 #!-sb-dynamic-core
  28 (declaim (type hash-table *static-foreign-symbols*))
  29 #!-sb-dynamic-core
  30 (defvar *static-foreign-symbols* (make-hash-table :test 'equal))
  31
  32 (declaim
  33  (ftype (sfunction (string hash-table) (or integer null)) find-foreign-symbol-in-table))
  34 (defun find-foreign-symbol-in-table (name table)
  35   (let ((extern (extern-alien-name name)))
  36     (values
  37      (or (gethash extern table)
  38          (gethash (concatenate 'base-string "ldso_stub__" extern) table)))))
  39
  40 (defun find-foreign-symbol-address (name)
  41   #!+sb-doc
  42   "Returns the address of the foreign symbol NAME, or NIL. Does not enter the
  43 symbol in the linkage table, and never returns an address in the linkage-table."
  44   (or #!-sb-dynamic-core
  45       (find-foreign-symbol-in-table name *static-foreign-symbols*)
  46       (find-dynamic-foreign-symbol-address name)))
  47
  48 (defun foreign-symbol-address (name &optional datap)
  49   #!+sb-doc
  50   "Returns the address of the foreign symbol NAME. DATAP must be true if the
  51 symbol designates a variable (used only on linkage-table platforms). Returns a
  52 secondary value that is true if DATAP was true and the symbol is a dynamic
  53 foreign symbol.
  54
  55 On linkage-table ports the returned address is always static: either direct
  56 address of a static symbol, or the linkage-table address of a dynamic one.
  57 Dynamic symbols are entered into the linkage-table if they aren't there already.
  58
  59 On non-linkage-table ports signals an error if the symbol isn't found."
  60   (declare (ignorable datap))
  61   #!+sb-dynamic-core
  62   (values (ensure-foreign-symbol-linkage name datap) t)
  63   #!-sb-dynamic-core
  64   (let ((static (find-foreign-symbol-in-table name *static-foreign-symbols*)))
  65     (if static
  66         (values static nil)
  67         #!+os-provides-dlopen
  68         (progn
  69           #-sb-xc-host
  70           (values #!-linkage-table
  71                   (ensure-dynamic-foreign-symbol-address name)
  72                   #!+linkage-table
  73                   (ensure-foreign-symbol-linkage name datap)
  74                   t)
  75           #+sb-xc-host
  76           (error 'undefined-alien-error :name name))
  77         #!-os-provides-dlopen
  78         (error 'undefined-alien-error :name name))))
  79
  80 (defun foreign-symbol-sap (symbol &optional datap)
  81   #!+sb-doc
  82   "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
  83 symbol designates a variable (used only on linkage-table platforms). May enter
  84 the symbol into the linkage-table. On non-linkage-table ports signals an error
  85 if the symbol isn't found."
  86   (declare (ignorable datap))
  87   #!-linkage-table
  88   (int-sap (foreign-symbol-address symbol))
  89   #!+linkage-table
  90   (multiple-value-bind (addr sharedp)
  91       (foreign-symbol-address symbol datap)
  92     #+sb-xc-host #!-sb-dynamic-core (aver (not sharedp)) ()
  93     ;; If the address is from linkage-table and refers to data
  94     ;; we need to do a bit of juggling. It is not the address of the
  95     ;; variable, but the address where the real address is stored.
  96     (if (and sharedp datap)
  97         (int-sap (sap-ref-word (int-sap addr) 0))
  98         (int-sap addr))))
  99
 100 #-sb-xc-host
 101 (defun foreign-reinit ()
 102   #!+os-provides-dlopen
 103   (reopen-shared-objects)
 104   #!+linkage-table
 105   ;; Don't warn about undefined aliens on startup. The same core can
 106   ;; reasonably be expected to work with different versions of the
 107   ;; same library.
 108   (handler-bind ((style-warning #'muffle-warning))
 109     (update-linkage-table)))
 110
 111 ;;; Cleanups before saving a core
 112 #-sb-xc-host
 113 (defun foreign-deinit ()
 114   #!+(and os-provides-dlopen (not linkage-table))
 115   (when (dynamic-foreign-symbols-p)
 116     (warn "~@<Saving cores with alien definitions referring to non-static ~
 117            foreign symbols is unsupported on this platform: references to ~
 118            such foreign symbols from the restarted core will not work. You ~
 119            may be able to work around this limitation by reloading all ~
 120            foreign definitions and code using them in the restarted core, ~
 121            but no guarantees.~%~%Dynamic foreign symbols in this core: ~
 122            ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols)))
 123   #!+os-provides-dlopen
 124   (close-shared-objects))
 125
 126 (declaim (maybe-inline sap-foreign-symbol))
 127 (defun sap-foreign-symbol (sap)
 128   (declare (ignorable sap))
 129   #-sb-xc-host
 130   (let ((addr (sap-int sap)))
 131     (declare (ignorable addr))
 132     #!+linkage-table
 133     (when (<= sb!vm:linkage-table-space-start
 134               addr
 135               sb!vm:linkage-table-space-end)
 136       (dohash ((name-and-datap table-addr) *linkage-info* :locked t)
 137         (when (and (<= table-addr addr)
 138                    (< addr (+ table-addr sb!vm:linkage-table-entry-size)))
 139           (return-from sap-foreign-symbol (car name-and-datap)))))
 140     #!+os-provides-dladdr
 141     (with-alien ((info (struct dl-info
 142                                (filename c-string)
 143                                (base unsigned)
 144                                (symbol c-string)
 145                                (symbol-address unsigned)))
 146                  (dladdr (function unsigned unsigned (* (struct dl-info)))
 147                          :extern "dladdr"))
 148       (let ((err (without-gcing
 149                    ;; On eg. Darwin GC can could otherwise interrupt
 150                    ;; the call while dladdr is holding a lock.
 151                    (alien-funcall dladdr addr (addr info)))))
 152         (if (zerop err)
 153             nil
 154             (slot info 'symbol))))
 155     ;; FIXME: Even in the absence of dladdr we could search the
 156     ;; static foreign symbols (and *linkage-info*, for that matter).
 157     ))
 158
 159 ;;; How we learn about foreign symbols and dlhandles initially
 160 (defvar *!initial-foreign-symbols*)
 161
 162 #-sb-xc-host
 163 (defun !foreign-cold-init ()
 164   #!-sb-dynamic-core
 165   (dolist (symbol *!initial-foreign-symbols*)
 166     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
 167   #!+sb-dynamic-core
 168   (loop for table-address from sb!vm::linkage-table-space-start
 169           by sb!vm::linkage-table-entry-size
 170           and reference in sb!vm::*required-runtime-c-symbols*
 171         do (setf (gethash reference *linkage-info*) table-address))
 172   #!+os-provides-dlopen
 173   (setf *runtime-dlhandle* (dlopen-or-lose))
 174   #!+os-provides-dlopen
 175   (setf *shared-objects* nil))
 176
 177 #!-os-provides-dlopen
 178 (define-unsupported-fun load-shared-object)