1.0.22.13: fixed bug 426: nested inline expansion failure
[sbcl/tcr.git] / src / code / linkage-table.lisp
blob6a4a70c89c99b4823bd375db2b8d5698d9d7bf34
1 ;;;; Linkage table specifics
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.
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.
20 (in-package "SB!IMPL")
22 (define-alien-routine arch-write-linkage-table-jmp void
23 (table-address system-area-pointer)
24 (real-address system-area-pointer))
26 (define-alien-routine arch-write-linkage-table-ref void
27 (table-address system-area-pointer)
28 (real-address system-area-pointer))
30 (defvar *linkage-info* (make-hash-table :test 'equal :synchronized t))
32 (defstruct linkage-info datap address)
34 (defun write-linkage-table-entry (table-address real-address datap)
35 (/show0 "write-linkage-table-entry")
36 (let ((reloc (int-sap table-address))
37 (target (int-sap real-address)))
38 (if datap
39 (arch-write-linkage-table-ref reloc target)
40 (arch-write-linkage-table-jmp reloc target))))
42 ;;; Add the linkage information about a foreign symbol in the
43 ;;; persistent table, and write the linkage-table entry.
44 (defun link-foreign-symbol (name datap)
45 (/show0 "link-foreign-symbol")
46 (let ((table-address (+ (* (hash-table-count *linkage-info*)
47 sb!vm:linkage-table-entry-size)
48 sb!vm:linkage-table-space-start))
49 (real-address (ensure-dynamic-foreign-symbol-address name datap)))
50 (aver real-address)
51 (unless (< table-address sb!vm:linkage-table-space-end)
52 (error "Linkage-table full (~D entries): cannot link ~S."
53 (hash-table-count *linkage-info*)
54 name))
55 (write-linkage-table-entry table-address real-address datap)
56 (setf (gethash (cons name datap) *linkage-info*)
57 (make-linkage-info :address table-address :datap datap))))
59 ;;; Add a foreign linkage entry if none exists, return the address
60 ;;; in the linkage table.
61 (defun ensure-foreign-symbol-linkage (name datap)
62 (/show0 "ensure-foreign-symbol-linkage")
63 (with-locked-hash-table (*linkage-info*)
64 (let ((info (or (gethash (cons name datap) *linkage-info*)
65 (link-foreign-symbol name datap))))
66 (linkage-info-address info))))
68 ;;; Update the linkage-table. Called during initialization after all
69 ;;; shared libraries have been reopened, and after a previously loaded
70 ;;; shared object is reloaded.
71 ;;;
72 ;;; FIXME: Should figure out how to write only those entries that need
73 ;;; updating.
74 (defun update-linkage-table ()
75 (dohash ((name-and-datap info) *linkage-info* :locked t)
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))))