src/code/linkage-table.lisp

   1 ;;;; Linkage table specifics
   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 ;;;; Linkage table itself is a mmapped memory area in C-land, which is
  13 ;;;; initialized by INIT-LINKAGE-TABLE once all shared objects have
  14 ;;;; been reopened, based on the information stored in *LINKAGE-INFO*.
  15 ;;;;
  16 ;;;; For data entries the linkage table holds the real address
  17 ;;;; of the foreign symbol, and for code the entries are jumps
  18 ;;;; to the real addresses.
  19
  20 (in-package "SB!IMPL")
  21
  22 ;;; Used to serialize modifications to *linkage-info* and the linkage-table
  23 ;;; proper. Calls thru linkage-table are unaffected.
  24 (defvar *linkage-table-lock*
  25   (sb!thread:make-mutex :name "linkage-table lock"))
  26
  27 (define-alien-routine arch-write-linkage-table-jmp void
  28   (table-address system-area-pointer)
  29   (real-address system-area-pointer))
  30
  31 (define-alien-routine arch-write-linkage-table-ref void
  32   (table-address system-area-pointer)
  33   (real-address system-area-pointer))
  34
  35 (defvar *linkage-info* (make-hash-table :test 'equal))
  36
  37 (defstruct linkage-info datap address)
  38
  39 (defun write-linkage-table-entry (table-address real-address datap)
  40   (/show0 "write-linkage-table-entry")
  41   (let ((reloc (int-sap table-address))
  42         (target (int-sap real-address)))
  43     (if datap
  44         (arch-write-linkage-table-ref reloc target)
  45         (arch-write-linkage-table-jmp reloc target))))
  46
  47 ;;; Add the linkage information about a foreign symbol in the
  48 ;;; persistent table, and write the linkage-table entry.
  49 (defun link-foreign-symbol (name datap)
  50   (/show0 "link-foreign-symbol")
  51   (let ((table-address (+ (* (hash-table-count *linkage-info*)
  52                              sb!vm:linkage-table-entry-size)
  53                           sb!vm:linkage-table-space-start))
  54         (real-address (get-dynamic-foreign-symbol-address name)))
  55     (when real-address
  56       (unless (< table-address sb!vm:linkage-table-space-end)
  57         (error "Linkage-table full (~D entries): cannot link ~S."
  58                (hash-table-count *linkage-info*)
  59                name))
  60       (write-linkage-table-entry table-address real-address datap)
  61       (setf (gethash name *linkage-info*)
  62             (make-linkage-info :address table-address :datap datap)))))
  63
  64 ;;; Add a foreign linkage entry if none exists, return the address
  65 ;;; in the linkage table.
  66 (defun ensure-foreign-symbol-linkage (name datap)
  67   (/show0 "ensure-foreign-symbol-linkage")
  68   (sb!thread:with-mutex (*linkage-table-lock*)
  69     (let ((info (or (gethash name *linkage-info*)
  70                     (link-foreign-symbol name datap))))
  71       (when info
  72         (linkage-info-address info)))))
  73
  74 ;;; Initialize the linkage-table. Called during initialization after
  75 ;;; all shared libraries have been reopened.
  76 (defun linkage-table-reinit ()
  77   (/show0 "linkage-table-reinit")
  78   ;; No locking here, as this should be done just once per image initialization,
  79   ;; before any threads user are spawned.
  80   (maphash (lambda (name info)
  81              (let ((datap (linkage-info-datap info))
  82                    (table-address (linkage-info-address info))
  83                    (real-address (get-dynamic-foreign-symbol-address name)))
  84                (cond (real-address
  85                       (write-linkage-table-entry table-address
  86                                                  real-address
  87                                                  datap))
  88                      (t
  89                       (/show0 "oops")
  90                       (cerror "Ignore. Attempts to access this foreign symbol ~
  91                                will lead to badness characterized by ~
  92                                segfaults, and potential corruption."
  93                               "Could not resolve foreign function ~S for ~
  94                                linkage-table." name)))))
  95            *linkage-info*))