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   #!+sb-doc
  43   "Returns the address of the foreign symbol NAME, or NIL. Does not enter the
  44 symbol in the linkage table, and never returns an address in the linkage-table."
  45   (or #!-sb-dynamic-core
  46       (find-foreign-symbol-in-table name *static-foreign-symbols*)
  47       (find-dynamic-foreign-symbol-address name)))
  48
  49 #-sb-xc-host
  50 (defun foreign-symbol-address (name &optional datap)
  51   #!+sb-doc
  52   "Returns the address of the foreign symbol NAME. DATAP must be true if the
  53 symbol designates a variable (used only on linkage-table platforms). Returns a
  54 secondary value that is true if DATAP was true and the symbol is a dynamic
  55 foreign symbol.
  56
  57 On linkage-table ports the returned address is always static: either direct
  58 address of a static symbol, or the linkage-table address of a dynamic one.
  59 Dynamic symbols are entered into the linkage-table if they aren't there already.
  60
  61 On non-linkage-table ports signals an error if the symbol isn't found."
  62   (declare (ignorable datap))
  63   #!+sb-dynamic-core
  64   (values (ensure-foreign-symbol-linkage name datap) t)
  65   #!-sb-dynamic-core
  66   (let ((static (find-foreign-symbol-in-table name *static-foreign-symbols*)))
  67     (if static
  68         (values static nil)
  69         #!+os-provides-dlopen
  70         (progn
  71           #-sb-xc-host
  72           (values #!-linkage-table
  73                   (ensure-dynamic-foreign-symbol-address name)
  74                   #!+linkage-table
  75                   (ensure-foreign-symbol-linkage name datap)
  76                   t)
  77           #+sb-xc-host
  78           (error 'undefined-alien-error :name name))
  79         #!-os-provides-dlopen
  80         (error 'undefined-alien-error :name name))))
  81
  82 #-sb-xc-host ; SAPs don't exist
  83 (defun foreign-symbol-sap (symbol &optional datap)
  84   #!+sb-doc
  85   "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
  86 symbol designates a variable (used only on linkage-table platforms). May enter
  87 the symbol into the linkage-table. On non-linkage-table ports signals an error
  88 if the symbol isn't found."
  89   (declare (ignorable datap))
  90   #!-linkage-table
  91   (int-sap (foreign-symbol-address symbol))
  92   #!+linkage-table
  93   (multiple-value-bind (addr sharedp)
  94       (foreign-symbol-address symbol datap)
  95     #+sb-xc-host #!-sb-dynamic-core (aver (not sharedp)) ()
  96     ;; If the address is from linkage-table and refers to data
  97     ;; we need to do a bit of juggling. It is not the address of the
  98     ;; variable, but the address where the real address is stored.
  99     (if (and sharedp datap)
 100         (int-sap (sap-ref-word (int-sap addr) 0))
 101         (int-sap addr))))
 102
 103 #-sb-xc-host
 104 (defun foreign-reinit ()
 105   #!+os-provides-dlopen
 106   (reopen-shared-objects)
 107   #!+linkage-table
 108   ;; Don't warn about undefined aliens on startup. The same core can
 109   ;; reasonably be expected to work with different versions of the
 110   ;; same library.
 111   (handler-bind ((style-warning #'muffle-warning))
 112     (update-linkage-table)))
 113
 114 ;;; Cleanups before saving a core
 115 #-sb-xc-host
 116 (defun foreign-deinit ()
 117   #!+(and os-provides-dlopen (not linkage-table))
 118   (when (dynamic-foreign-symbols-p)
 119     (warn "~@<Saving cores with alien definitions referring to non-static ~
 120            foreign symbols is unsupported on this platform: references to ~
 121            such foreign symbols from the restarted core will not work. You ~
 122            may be able to work around this limitation by reloading all ~
 123            foreign definitions and code using them in the restarted core, ~
 124            but no guarantees.~%~%Dynamic foreign symbols in this core: ~
 125            ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols)))
 126   #!+os-provides-dlopen
 127   (close-shared-objects))
 128
 129 (declaim (maybe-inline sap-foreign-symbol))
 130 (defun sap-foreign-symbol (sap)
 131   (declare (ignorable sap))
 132   #-sb-xc-host
 133   (let ((addr (sap-int sap)))
 134     (declare (ignorable addr))
 135     #!+linkage-table
 136     (when (<= sb!vm:linkage-table-space-start
 137               addr
 138               sb!vm:linkage-table-space-end)
 139       (dohash ((name-and-datap table-addr) *linkage-info* :locked t)
 140         (when (and (<= table-addr addr)
 141                    (< addr (+ table-addr sb!vm:linkage-table-entry-size)))
 142           (return-from sap-foreign-symbol (car name-and-datap)))))
 143     #!+os-provides-dladdr
 144     (with-alien ((info (struct dl-info
 145                                (filename c-string)
 146                                (base unsigned)
 147                                (symbol c-string)
 148                                (symbol-address unsigned)))
 149                  (dladdr (function unsigned unsigned (* (struct dl-info)))
 150                          :extern "dladdr"))
 151       (let ((err (without-gcing
 152                    ;; On eg. Darwin GC can could otherwise interrupt
 153                    ;; the call while dladdr is holding a lock.
 154                    (alien-funcall dladdr addr (addr info)))))
 155         (if (zerop err)
 156             nil
 157             (slot info 'symbol))))
 158     ;; FIXME: Even in the absence of dladdr we could search the
 159     ;; static foreign symbols (and *linkage-info*, for that matter).
 160     ))
 161
 162 ;;; How we learn about foreign symbols and dlhandles initially
 163 (defvar *!initial-foreign-symbols*)
 164
 165 #-sb-xc-host
 166 (defun !foreign-cold-init ()
 167   #!-sb-dynamic-core
 168   (dolist (symbol *!initial-foreign-symbols*)
 169     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
 170   #!+sb-dynamic-core
 171   (loop for table-address from sb!vm::linkage-table-space-start
 172           by sb!vm::linkage-table-entry-size
 173           and reference in sb!vm::*required-runtime-c-symbols*
 174         do (setf (gethash reference *linkage-info*) table-address))
 175   #!+os-provides-dlopen
 176   (setf *runtime-dlhandle* (dlopen-or-lose))
 177   #!+os-provides-dlopen
 178   (setf *shared-objects* nil))
 179
 180 #!-os-provides-dlopen
 181 (define-unsupported-fun load-shared-object)