1 ;;;; Foreign symbol linkage
3 ;;;; This software is part of the SBCL system. See the README file for
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 (in-package "SB!IMPL")
14 #!-(or elf mach-o win32)
15 (error "Not an ELF, Mach-O, or Win32 platform?")
17 (defun extern-alien-name (name)
19 (coerce name 'base-string)
21 (error "invalid external alien name: ~S" name))))
23 ;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not
24 ;;; as opposed to C's "extern"). The table contains symbols known at
25 ;;; the time that the program was built, but not symbols defined in
26 ;;; object files which have been loaded dynamically since then.
28 (declaim (type hash-table *static-foreign-symbols*))
30 (defvar *static-foreign-symbols* (make-hash-table :test 'equal))
33 (ftype (sfunction (string hash-table) (or integer null)) find-foreign-symbol-in-table))
34 (defun find-foreign-symbol-in-table (name table)
35 (let ((extern (extern-alien-name name)))
37 (or (gethash extern table)
38 (gethash (concatenate 'base-string "ldso_stub__" extern) table)))))
40 (defun find-foreign-symbol-address (name)
41 "Returns the address of the foreign symbol NAME, or NIL. Does not enter the
42 symbol in the linkage table, and never returns an address in the linkage-table."
43 (or #!-sb-dynamic-core
44 (find-foreign-symbol-in-table name *static-foreign-symbols*)
45 (find-dynamic-foreign-symbol-address name)))
47 (defun foreign-symbol-address (name &optional datap)
48 "Returns the address of the foreign symbol NAME. DATAP must be true if the
49 symbol designates a variable (used only on linkage-table platforms). Returns a
50 secondary value that is true if DATAP was true and the symbol is a dynamic
53 On linkage-table ports the returned address is always static: either direct
54 address of a static symbol, or the linkage-table address of a dynamic one.
55 Dynamic symbols are entered into the linkage-table if they aren't there already.
57 On non-linkage-table ports signals an error if the symbol isn't found."
58 (declare (ignorable datap))
60 (values (ensure-foreign-symbol-linkage name datap) t)
62 (let ((static (find-foreign-symbol-in-table name *static-foreign-symbols*)))
68 (values #!-linkage-table
69 (ensure-dynamic-foreign-symbol-address name)
71 (ensure-foreign-symbol-linkage name datap)
74 (error 'undefined-alien-error :name name))
76 (error 'undefined-alien-error :name name))))
78 (defun foreign-symbol-sap (symbol &optional datap)
79 "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
80 symbol designates a variable (used only on linkage-table platforms). May enter
81 the symbol into the linkage-table. On non-linkage-table ports signals an error
82 if the symbol isn't found."
83 (declare (ignorable datap))
85 (int-sap (foreign-symbol-address symbol))
87 (multiple-value-bind (addr sharedp)
88 (foreign-symbol-address symbol datap)
89 #+sb-xc-host #!-sb-dynamic-core (aver (not sharedp)) ()
90 ;; If the address is from linkage-table and refers to data
91 ;; we need to do a bit of juggling. It is not the address of the
92 ;; variable, but the address where the real address is stored.
93 (if (and sharedp datap)
94 (int-sap (sap-ref-word (int-sap addr) 0))
98 (defun foreign-reinit ()
100 (reopen-shared-objects)
102 ;; Don't warn about undefined aliens on startup. The same core can
103 ;; reasonably be expected to work with different versions of the
105 (handler-bind ((style-warning #'muffle-warning))
106 (update-linkage-table)))
108 ;;; Cleanups before saving a core
110 (defun foreign-deinit ()
111 #!+(and os-provides-dlopen (not linkage-table))
112 (when (dynamic-foreign-symbols-p)
113 (warn "~@<Saving cores with alien definitions referring to non-static ~
114 foreign symbols is unsupported on this platform: references to ~
115 such foreign symbols from the restarted core will not work. You ~
116 may be able to work around this limitation by reloading all ~
117 foreign definitions and code using them in the restarted core, ~
118 but no guarantees.~%~%Dynamic foreign symbols in this core: ~
119 ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols)))
120 #!+os-provides-dlopen
121 (close-shared-objects))
123 (declaim (maybe-inline sap-foreign-symbol))
124 (defun sap-foreign-symbol (sap)
125 (declare (ignorable sap))
127 (let ((addr (sap-int sap)))
128 (declare (ignorable addr))
130 (when (<= sb!vm:linkage-table-space-start
132 sb!vm:linkage-table-space-end)
133 (dohash ((name-and-datap table-addr) *linkage-info* :locked t)
134 (when (and (<= table-addr addr)
135 (< addr (+ table-addr sb!vm:linkage-table-entry-size)))
136 (return-from sap-foreign-symbol (car name-and-datap)))))
137 #!+os-provides-dladdr
138 (with-alien ((info (struct dl-info
142 (symbol-address unsigned)))
143 (dladdr (function unsigned unsigned (* (struct dl-info)))
145 (let ((err (without-gcing
146 ;; On eg. Darwin GC can could otherwise interrupt
147 ;; the call while dladdr is holding a lock.
148 (alien-funcall dladdr addr (addr info)))))
151 (slot info 'symbol))))
152 ;; FIXME: Even in the absence of dladdr we could search the
153 ;; static foreign symbols (and *linkage-info*, for that matter).
156 ;;; How we learn about foreign symbols and dlhandles initially
157 (defvar *!initial-foreign-symbols*)
160 (defun !foreign-cold-init ()
162 (dolist (symbol *!initial-foreign-symbols*)
163 (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
165 (loop for table-address from sb!vm::linkage-table-space-start
166 by sb!vm::linkage-table-entry-size
167 and reference in sb!vm::*required-runtime-c-symbols*
168 do (setf (gethash reference *linkage-info*) table-address))
169 #!+os-provides-dlopen
170 (setf *runtime-dlhandle* (dlopen-or-lose))
171 #!+os-provides-dlopen
172 (setf *shared-objects* nil))
174 #!-os-provides-dlopen
175 (define-unsupported-fun load-shared-object)