0.8.15.7
[sbcl.git] / 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*))