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)
  15 (error "Not an ELF or Mach-O platform?")
  16
  17 (defun extern-alien-name (name)
  18   (handler-case
  19       #!+elf (coerce name 'base-string)
  20       #!+mach-o (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 (defun find-foreign-symbol-in-table (name table)
  32   (let ((extern (extern-alien-name name)))
  33     (or (gethash extern table)
  34         (gethash (concatenate 'base-string "ldso_stub__" extern) table))))
  35
  36 (defun foreign-symbol-address-as-integer-or-nil (name &optional datap)
  37   (declare (ignorable datap))
  38   (or (find-foreign-symbol-in-table name  *static-foreign-symbols*)
  39       #!+os-provides-dlopen
  40       (progn
  41         #-sb-xc-host
  42         (values #!-linkage-table
  43                 (get-dynamic-foreign-symbol-address name datap)
  44                 #!+linkage-table
  45                 (ensure-foreign-symbol-linkage name datap)
  46                 t))))
  47
  48 (defun foreign-symbol-address-as-integer (name &optional datap)
  49   (multiple-value-bind (addr sharedp)
  50       (foreign-symbol-address-as-integer-or-nil name datap)
  51     (if addr
  52         (values addr sharedp)
  53         (error "Unknown foreign symbol: ~S" name))))
  54
  55 (defun foreign-symbol-address (symbol &optional datap)
  56   (declare (ignorable datap))
  57   #!-linkage-table
  58   (int-sap (foreign-symbol-address-as-integer symbol))
  59   #!+linkage-table
  60   (multiple-value-bind (addr sharedp)
  61       (foreign-symbol-address-as-integer symbol datap)
  62     #+sb-xc-host
  63     (aver (not sharedp))
  64     ;; If the address is from linkage-table and refers to data
  65     ;; we need to do a bit of juggling.
  66     (if (and sharedp datap)
  67         (int-sap (sap-ref-word (int-sap addr) 0))
  68         (int-sap addr))))
  69
  70 #-sb-xc-host
  71 (defun foreign-reinit ()
  72   #!+os-provides-dlopen
  73   (reopen-shared-objects)
  74   #!+linkage-table
  75   (update-linkage-table))
  76
  77 ;;; Cleanups before saving a core
  78 #-sb-xc-host
  79 (defun foreign-deinit ()
  80   ;; KLUDGE: Giving this warning only when non-static foreign symbols
  81   ;; are used would be much nicer, but actually pretty hard: we can
  82   ;; get dynamic symbols thru the runtime as well, so cheking the
  83   ;; list of *shared-objects* is not enough. Eugh & blech.
  84   #!+(and os-provides-dlopen (not linkage-table))
  85   (when (dynamic-foreign-symbols)
  86     (warn "~@<Saving cores with alien definitions referring to non-static ~
  87            foreign symbols is unsupported on this platform: references to ~
  88            such foreign symbols from the restarted core will not work. You ~
  89            may be able to work around this limitation by reloading all ~
  90            foreign definitions and code using them in the restarted core, ~
  91            but no guarantees.~%~%Dynamic foreign symbols in this core: ~
  92            ~{~A~^, ~}~:@>" (dynamic-foreign-symbols)))
  93   #!+os-provides-dlopen
  94   (close-shared-objects))
  95
  96 (defun foreign-symbol-in-address (sap)
  97   (declare (ignorable sap))
  98   #-sb-xc-host
  99   (let ((addr (sap-int sap)))
 100     (declare (ignorable addr))
 101     #!+linkage-table
 102     (when (<= sb!vm:linkage-table-space-start
 103               addr
 104               sb!vm:linkage-table-space-end)
 105       (maphash (lambda (name info)
 106                  (let ((table-addr (linkage-info-address info)))
 107                    (when (<= table-addr
 108                              addr
 109                              (+ table-addr sb!vm:linkage-table-entry-size))
 110                      (return-from foreign-symbol-in-address name))))
 111                *linkage-info*))
 112     #!+os-provides-dladdr
 113     (with-alien ((info (struct dl-info
 114                                (filename c-string)
 115                                (base unsigned)
 116                                (symbol c-string)
 117                                (symbol-address unsigned)))
 118                  (dladdr (function unsigned unsigned (* (struct dl-info)))
 119                          :extern "dladdr"))
 120       (let ((err (alien-funcall dladdr addr (addr info))))
 121         (if (zerop err)
 122             nil
 123             (slot info 'symbol))))
 124     ;; FIXME: Even in the absence of dladdr we could search the
 125     ;; static foreign symbols (and *linkage-info*, for that matter).
 126     ))
 127
 128 ;;; How we learn about foreign symbols and dlhandles initially
 129 (defvar *!initial-foreign-symbols*)
 130
 131 #-sb-xc-host
 132 (defun !foreign-cold-init ()
 133   (dolist (symbol *!initial-foreign-symbols*)
 134     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
 135   #!+os-provides-dlopen
 136   (setf *runtime-dlhandle* (dlopen-or-lose)
 137         *shared-objects* nil))
 138
 139 #!-os-provides-dlopen
 140 (define-unsupported-fun load-shared-object)