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 #-sb-xc-host
  41 (defun find-foreign-symbol-address (name)
  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 #-sb-xc-host
  49 (defun foreign-symbol-address (name &optional datap)
  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 #-sb-xc-host ; SAPs don't exist
  81 (defun foreign-symbol-sap (symbol &optional datap)
  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)