Fix FORMAT compilation on non-simple strings.
[sbcl.git] / src / code / foreign.lisp
blob9230040defa1e15fd962c67109ee185a32d642a2
1 ;;;; Foreign symbol linkage
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 (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)
18 (handler-case
19 (coerce name 'base-string)
20 (error ()
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.
27 #!-sb-dynamic-core
28 (declaim (type hash-table *static-foreign-symbols*))
29 #!-sb-dynamic-core
30 (defvar *static-foreign-symbols* (make-hash-table :test 'equal))
32 (declaim
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)))
36 (values
37 (or (gethash extern table)
38 (gethash (concatenate 'base-string "ldso_stub__" extern) table)))))
40 #-sb-xc-host
41 (defun find-foreign-symbol-address (name)
42 "Returns the address of the foreign symbol NAME, or NIL. Does not enter the
43 symbol in the linkage table, and never returns an address in the linkage-table."
44 (or #!-sb-dynamic-core
45 (find-foreign-symbol-in-table name *static-foreign-symbols*)
46 (find-dynamic-foreign-symbol-address name)))
48 #-sb-xc-host
49 (defun foreign-symbol-address (name &optional datap)
50 "Returns the address of the foreign symbol NAME. DATAP must be true if the
51 symbol designates a variable (used only on linkage-table platforms).
52 Returns a secondary value T if the symbol is a dynamic foreign symbol.
54 On linkage-table ports the returned address is always static: either direct
55 address of a static symbol, or the linkage-table address of a dynamic one.
56 Dynamic symbols are entered into the linkage-table if they aren't there already.
58 On non-linkage-table ports signals an error if the symbol isn't found."
59 (declare (ignorable datap))
60 #!+sb-dynamic-core
61 (values (ensure-foreign-symbol-linkage name datap) t)
62 #!-sb-dynamic-core
63 (let ((static (find-foreign-symbol-in-table name *static-foreign-symbols*)))
64 (if static
65 (values static nil)
66 #!+os-provides-dlopen
67 (progn
68 #-sb-xc-host
69 (values #!-linkage-table
70 (ensure-dynamic-foreign-symbol-address name)
71 #!+linkage-table
72 (ensure-foreign-symbol-linkage name datap)
74 #+sb-xc-host
75 (error 'undefined-alien-error :name name))
76 #!-os-provides-dlopen
77 (error 'undefined-alien-error :name name))))
79 #-sb-xc-host ; SAPs don't exist
80 (defun foreign-symbol-sap (symbol &optional datap)
81 "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
82 symbol designates a variable (used only on linkage-table platforms). May enter
83 the symbol into the linkage-table. On non-linkage-table ports signals an error
84 if the symbol isn't found."
85 (declare (ignorable datap))
86 #!-linkage-table
87 (int-sap (foreign-symbol-address symbol))
88 #!+linkage-table
89 (multiple-value-bind (addr sharedp)
90 (foreign-symbol-address symbol datap)
91 #+sb-xc-host #!-sb-dynamic-core (aver (not sharedp)) ()
92 ;; If the address is from linkage-table and refers to data
93 ;; we need to do a bit of juggling. It is not the address of the
94 ;; variable, but the address where the real address is stored.
95 (if (and sharedp datap)
96 (int-sap (sap-ref-word (int-sap addr) 0))
97 (int-sap addr))))
99 #-sb-xc-host
100 (defun foreign-reinit ()
101 #!+os-provides-dlopen
102 (reopen-shared-objects)
103 #!+linkage-table
104 ;; Don't warn about undefined aliens on startup. The same core can
105 ;; reasonably be expected to work with different versions of the
106 ;; same library.
107 (handler-bind ((style-warning #'muffle-warning))
108 (update-linkage-table)))
110 ;;; Cleanups before saving a core
111 #-sb-xc-host
112 (defun foreign-deinit ()
113 #!+(and os-provides-dlopen (not linkage-table))
114 (when (dynamic-foreign-symbols-p)
115 (warn "~@<Saving cores with alien definitions referring to non-static ~
116 foreign symbols is unsupported on this platform: references to ~
117 such foreign symbols from the restarted core will not work. You ~
118 may be able to work around this limitation by reloading all ~
119 foreign definitions and code using them in the restarted core, ~
120 but no guarantees.~%~%Dynamic foreign symbols in this core: ~
121 ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols)))
122 #!+os-provides-dlopen
123 (close-shared-objects))
125 (declaim (maybe-inline sap-foreign-symbol))
126 (defun sap-foreign-symbol (sap)
127 (declare (ignorable sap))
128 #-sb-xc-host
129 (let ((addr (sap-int sap)))
130 (declare (ignorable addr))
131 #!+linkage-table
132 (when (<= sb!vm:linkage-table-space-start
133 addr
134 sb!vm:linkage-table-space-end)
135 (dohash ((key table-addr) *linkage-info* :locked t)
136 (let ((datap (listp key)))
137 (when (<= table-addr addr (+ table-addr (1- sb!vm:linkage-table-entry-size)))
138 (return-from sap-foreign-symbol (if datap (car key) key))))))
139 #!+os-provides-dladdr
140 (with-alien ((info (struct dl-info
141 (filename c-string)
142 (base unsigned)
143 (symbol c-string)
144 (symbol-address unsigned)))
145 (dladdr (function unsigned unsigned (* (struct dl-info)))
146 :extern "dladdr"))
147 (let ((err (without-gcing
148 ;; On eg. Darwin GC can could otherwise interrupt
149 ;; the call while dladdr is holding a lock.
150 (alien-funcall dladdr addr (addr info)))))
151 (if (zerop err)
153 (slot info 'symbol))))
154 ;; FIXME: Even in the absence of dladdr we could search the
155 ;; static foreign symbols (and *linkage-info*, for that matter).
158 ;;; How we learn about foreign symbols and dlhandles initially
159 (defvar *!initial-foreign-symbols*)
161 #-sb-xc-host
162 (defun !foreign-cold-init ()
163 #!-sb-dynamic-core
164 (dovector (symbol *!initial-foreign-symbols*)
165 (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
166 #!+sb-dynamic-core
167 (loop for table-address from sb!vm:linkage-table-space-start
168 by sb!vm::linkage-table-entry-size
169 and reference across (symbol-value 'sb!vm::+required-foreign-symbols+)
170 do (setf (gethash reference *linkage-info*) table-address))
171 #!+os-provides-dlopen
172 (setf *runtime-dlhandle* (dlopen-or-lose))
173 #!+os-provides-dlopen
174 (setf *shared-objects* nil))
176 #!-os-provides-dlopen
177 (define-unsupported-fun load-shared-object)