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