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