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   (update-linkage-table))
  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   (when (dynamic-foreign-symbols)
  75     (warn "~@<Saving cores with alien definitions referring to non-static ~
  76            foreign symbols is unsupported on this platform: references to ~
  77            such foreign symbols from the restarted core will not work. You ~
  78            may be able to work around this limitation by reloading all ~
  79            foreign definitions and code using them in the restarted core, ~
  80            but no guarantees.~%~%Dynamic foreign symbols in this core: ~
  81            ~{~A~^, ~}~:@>" (dynamic-foreign-symbols)))
  82   #!+os-provides-dlopen
  83   (close-shared-objects))
  84
  85 (defun foreign-symbol-in-address (sap)
  86   (declare (ignorable sap))
  87   #-sb-xc-host
  88   (let ((addr (sap-int sap)))
  89     (declare (ignorable addr))
  90     #!+linkage-table
  91     (when (<= sb!vm:linkage-table-space-start
  92               addr
  93               sb!vm:linkage-table-space-end)
  94       (maphash (lambda (name info)
  95                  (let ((table-addr (linkage-info-address info)))
  96                    (when (<= table-addr
  97                              addr
  98                              (+ table-addr sb!vm:linkage-table-entry-size))
  99                      (return-from foreign-symbol-in-address name))))
 100                *linkage-info*))
 101     #!+os-provides-dladdr
 102     (with-alien ((info (struct dl-info
 103                                (filename c-string)
 104                                (base unsigned)
 105                                (symbol c-string)
 106                                (symbol-address unsigned)))
 107                  (dladdr (function unsigned unsigned (* (struct dl-info)))
 108                          :extern "dladdr"))
 109       (let ((err (alien-funcall dladdr addr (addr info))))
 110         (if (zerop err)
 111             nil
 112             (slot info 'symbol))))
 113     ;; FIXME: Even in the absence of dladdr we could search the
 114     ;; static foreign symbols (and *linkage-info*, for that matter).
 115     ))
 116
 117 ;;; How we learn about foreign symbols and dlhandles initially
 118 (defvar *!initial-foreign-symbols*)
 119
 120 #-sb-xc-host
 121 (defun !foreign-cold-init ()
 122   (dolist (symbol *!initial-foreign-symbols*)
 123     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
 124   #!+os-provides-dlopen
 125   (setf *runtime-dlhandle* (dlopen-or-lose)
 126         *shared-objects* nil))
 127
 128 #!-os-provides-dlopen
 129 (define-unsupported-fun load-shared-object)