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 (defvar *shared-object-lock*) ; initialized in foreign-load.lisp
  23
  24 (define-alien-routine arch-write-linkage-table-jmp void
  25   (table-address system-area-pointer)
  26   (real-address system-area-pointer))
  27
  28 (define-alien-routine arch-write-linkage-table-ref void
  29   (table-address system-area-pointer)
  30   (real-address system-area-pointer))
  31
  32 (defvar *linkage-info* (make-hash-table :test 'equal :synchronized t))
  33
  34 (defstruct linkage-info datap address)
  35
  36 (defun write-linkage-table-entry (table-address real-address datap)
  37   (/show0 "write-linkage-table-entry")
  38   (let ((reloc (int-sap table-address))
  39         (target (int-sap real-address)))
  40     (if datap
  41         (arch-write-linkage-table-ref reloc target)
  42         (arch-write-linkage-table-jmp reloc target))))
  43
  44 ;;; Add the linkage information about a foreign symbol in the
  45 ;;; persistent table, and write the linkage-table entry.
  46 (defun link-foreign-symbol (name datap)
  47   (/show0 "link-foreign-symbol")
  48   (let ((table-address (+ (* (hash-table-count *linkage-info*)
  49                              sb!vm:linkage-table-entry-size)
  50                           sb!vm:linkage-table-space-start))
  51         (real-address (ensure-dynamic-foreign-symbol-address name datap)))
  52     (aver real-address)
  53     (unless (< table-address sb!vm:linkage-table-space-end)
  54       (error "Linkage-table full (~D entries): cannot link ~S."
  55              (hash-table-count *linkage-info*)
  56              name))
  57     (write-linkage-table-entry table-address real-address datap)
  58     (setf (gethash (cons name datap) *linkage-info*)
  59           (make-linkage-info :address table-address :datap datap))))
  60
  61 ;;; Add a foreign linkage entry if none exists, return the address
  62 ;;; in the linkage table.
  63 (defun ensure-foreign-symbol-linkage (name datap)
  64   (/show0 "ensure-foreign-symbol-linkage")
  65   (with-locked-hash-table (*linkage-info*)
  66     (let ((info (or (gethash (cons name datap) *linkage-info*)
  67                     (link-foreign-symbol name datap))))
  68       (linkage-info-address info))))
  69
  70 ;;; Update the linkage-table. Called during initialization after all
  71 ;;; shared libraries have been reopened, and after a previously loaded
  72 ;;; shared object is reloaded.
  73 ;;;
  74 ;;; FIXME: Should figure out how to write only those entries that need
  75 ;;; updating.
  76 (defun update-linkage-table ()
  77   (dohash ((name-and-datap info) *linkage-info* :locked t)
  78     (let* ((name (car name-and-datap))
  79            (datap (cdr name-and-datap))
  80            (table-address (linkage-info-address info))
  81            (real-address
  82             (ensure-dynamic-foreign-symbol-address name datap)))
  83       (aver (and table-address real-address))
  84       (write-linkage-table-entry table-address
  85                                  real-address
  86                                  datap))))