0.9.13.30
[sbcl.git] / src / code / foreign.lisp
1 ;;;; Foreign symbol linkage
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 (in-package "SB!IMPL")
13
14 #!-(or elf mach-o win32)
15 (error "Not an ELF, Mach-O, or Win32 platform?")
16
17 (defun extern-alien-name (name)
18   (handler-case
19       #!+elf (coerce name 'base-string)
20       #!+(or mach-o win32) (concatenate 'base-string "_" name)
21     (error ()
22       (error "invalid external alien name: ~S" name))))
23
24 ;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not
25 ;;; as opposed to C's "extern"). The table contains symbols known at
26 ;;; the time that the program was built, but not symbols defined in
27 ;;; object files which have been loaded dynamically since then.
28 (declaim (type hash-table *static-foreign-symbols*))
29 (defvar *static-foreign-symbols* (make-hash-table :test 'equal))
30
31 (declaim
32  (ftype (sfunction (string hash-table) (or integer null)) find-foreign-symbol-in-table))
33 (defun find-foreign-symbol-in-table (name table)
34   (let ((extern (extern-alien-name name)))
35     (values
36      (or (gethash extern table)
37          (gethash (concatenate 'base-string "ldso_stub__" extern) table)))))
38
39 (defun find-foreign-symbol-address (name)
40   "Returns the address of the foreign symbol NAME, or NIL. Does not enter the
41 symbol in the linkage table, and never returns an address in the linkage-table."
42   (or (find-foreign-symbol-in-table name *static-foreign-symbols*)
43       (find-dynamic-foreign-symbol-address name)))
44
45 (defun foreign-symbol-address (name &optional datap)
46   "Returns the address of the foreign symbol NAME. DATAP must be true if the
47 symbol designates a variable (used only on linkage-table platforms). Returns a
48 secondary value that is true if DATAP was true and the symbol is a dynamic
49 foreign symbol.
50
51 On linkage-table ports the returned address is always static: either direct
52 address of a static symbol, or the linkage-table address of a dynamic one.
53 Dynamic symbols are entered into the linkage-table if they aren't there already.
54
55 On non-linkage-table ports signals an error if the symbol isn't found."
56   (declare (ignorable datap))
57   (let ((static (find-foreign-symbol-in-table name  *static-foreign-symbols*)))
58     (if static
59         (values static nil)
60         #!+os-provides-dlopen
61         (progn
62           #-sb-xc-host
63           (values #!-linkage-table
64                   (ensure-dynamic-foreign-symbol-address name)
65                   #!+linkage-table
66                   (ensure-foreign-symbol-linkage name datap)
67                   t)
68           #+sb-xc-host
69           (error 'undefined-alien-error :name name))
70         #!-os-provides-dlopen
71         (error 'undefined-alien-error :name name))))
72
73 (defun foreign-symbol-sap (symbol &optional datap)
74   "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the
75 symbol designates a variable (used only on linkage-table platforms). May enter
76 the symbol into the linkage-table. On non-linkage-table ports signals an error
77 if the symbol isn't found."
78   (declare (ignorable datap))
79   #!-linkage-table
80   (int-sap (foreign-symbol-address symbol))
81   #!+linkage-table
82   (multiple-value-bind (addr sharedp)
83       (foreign-symbol-address symbol datap)
84     #+sb-xc-host
85     (aver (not sharedp))
86     ;; If the address is from linkage-table and refers to data
87     ;; we need to do a bit of juggling. It is not the address of the
88     ;; variable, but the address where the real address is stored.
89     (if (and sharedp datap)
90         (int-sap (sap-ref-word (int-sap addr) 0))
91         (int-sap addr))))
92
93 #-sb-xc-host
94 (defun foreign-reinit ()
95   #!+os-provides-dlopen
96   (reopen-shared-objects)
97   #!+linkage-table
98   (update-linkage-table))
99
100 ;;; Cleanups before saving a core
101 #-sb-xc-host
102 (defun foreign-deinit ()
103   #!+(and os-provides-dlopen (not linkage-table))
104   (when (dynamic-foreign-symbols-p)
105     (warn "~@<Saving cores with alien definitions referring to non-static ~
106            foreign symbols is unsupported on this platform: references to ~
107            such foreign symbols from the restarted core will not work. You ~
108            may be able to work around this limitation by reloading all ~
109            foreign definitions and code using them in the restarted core, ~
110            but no guarantees.~%~%Dynamic foreign symbols in this core: ~
111            ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols)))
112   #!+os-provides-dlopen
113   (close-shared-objects))
114
115 (defun sap-foreign-symbol (sap)
116   (declare (ignorable sap))
117   #-sb-xc-host
118   (let ((addr (sap-int sap)))
119     (declare (ignorable addr))
120     #!+linkage-table
121     (when (<= sb!vm:linkage-table-space-start
122               addr
123               sb!vm:linkage-table-space-end)
124       (maphash (lambda (name-and-datap info)
125                  (let ((table-addr (linkage-info-address info)))
126                    (when (<= table-addr
127                              addr
128                              (+ table-addr sb!vm:linkage-table-entry-size))
129                      (return-from sap-foreign-symbol (car name-and-datap)))))
130                *linkage-info*))
131     #!+os-provides-dladdr
132     (with-alien ((info (struct dl-info
133                                (filename c-string)
134                                (base unsigned)
135                                (symbol c-string)
136                                (symbol-address unsigned)))
137                  (dladdr (function unsigned unsigned (* (struct dl-info)))
138                          :extern "dladdr"))
139       (let ((err (alien-funcall dladdr addr (addr info))))
140         (if (zerop err)
141             nil
142             (slot info 'symbol))))
143     ;; FIXME: Even in the absence of dladdr we could search the
144     ;; static foreign symbols (and *linkage-info*, for that matter).
145     ))
146
147 ;;; How we learn about foreign symbols and dlhandles initially
148 (defvar *!initial-foreign-symbols*)
149
150 #-sb-xc-host
151 (defun !foreign-cold-init ()
152   (dolist (symbol *!initial-foreign-symbols*)
153     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
154   #!+(and os-provides-dlopen (not win32))
155   (setf *runtime-dlhandle* (dlopen-or-lose))
156   #!+os-provides-dlopen
157   (setf *shared-objects* nil))
158
159 #!-os-provides-dlopen
160 (define-unsupported-fun load-shared-object)