1.0.9.18: Instrument COMPUTE-CALLING-FRAME for non-x86 with /noshow0.
[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 (defvar *foreign-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))
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   (sb!thread:with-mutex (*foreign-lock*)
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 (defun update-linkage-table ()
74   ;; Doesn't take care of its own locking -- callers are responsible
75   (maphash (lambda (name-and-datap info)
76              (let* ((name (car name-and-datap))
77                     (datap (cdr name-and-datap))
78                     (table-address (linkage-info-address info))
79                     (real-address
80                      (ensure-dynamic-foreign-symbol-address name datap)))
81                (aver (and table-address real-address))
82                (write-linkage-table-entry table-address
83                                           real-address
84                                           datap)))
85            *linkage-info*))