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")
15 (error "Not an ELF or Mach-O platform?")
17 (defun extern-alien-name (name)
19 #!+elf (coerce name 'base-string)
20 #!+mach-o (concatenate 'base-string "_" name)
22 (error "invalid external alien name: ~S" name))))
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))
31 (defun find-foreign-symbol-in-table (name table)
32 (let ((extern (extern-alien-name name)))
33 (or (gethash extern table)
34 (gethash (concatenate 'base-string "ldso_stub__" extern) table))))
36 (defun foreign-symbol-address-as-integer-or-nil (name &optional datap)
37 (declare (ignorable datap))
38 (or (find-foreign-symbol-in-table name *static-foreign-symbols*)
42 (values #!-linkage-table
43 (get-dynamic-foreign-symbol-address name datap)
45 (ensure-foreign-symbol-linkage name datap)
48 (defun foreign-symbol-address-as-integer (name &optional datap)
49 (multiple-value-bind (addr sharedp)
50 (foreign-symbol-address-as-integer-or-nil name datap)
53 (error "Unknown foreign symbol: ~S" name))))
55 (defun foreign-symbol-address (symbol &optional datap)
56 (declare (ignorable datap))
58 (int-sap (foreign-symbol-address-as-integer symbol))
60 (multiple-value-bind (addr sharedp)
61 (foreign-symbol-address-as-integer symbol datap)
64 ;; If the address is from linkage-table and refers to data
65 ;; we need to do a bit of juggling.
66 (if (and sharedp datap)
67 (int-sap (sap-ref-word (int-sap addr) 0))
71 (defun foreign-reinit ()
73 (reopen-shared-objects)
75 (update-linkage-table))
77 ;;; Cleanups before saving a core
79 (defun foreign-deinit ()
80 ;; KLUDGE: Giving this warning only when non-static foreign symbols
81 ;; are used would be much nicer, but actually pretty hard: we can
82 ;; get dynamic symbols thru the runtime as well, so cheking the
83 ;; list of *shared-objects* is not enough. Eugh & blech.
84 #!+(and os-provides-dlopen (not linkage-table))
85 (when (dynamic-foreign-symbols)
86 (warn "~@<Saving cores with alien definitions referring to non-static ~
87 foreign symbols is unsupported on this platform: references to ~
88 such foreign symbols from the restarted core will not work. You ~
89 may be able to work around this limitation by reloading all ~
90 foreign definitions and code using them in the restarted core, ~
91 but no guarantees.~%~%Dynamic foreign symbols in this core: ~
92 ~{~A~^, ~}~:@>" (dynamic-foreign-symbols)))
94 (close-shared-objects))
96 (defun foreign-symbol-in-address (sap)
97 (declare (ignorable sap))
99 (let ((addr (sap-int sap)))
100 (declare (ignorable addr))
102 (when (<= sb!vm:linkage-table-space-start
104 sb!vm:linkage-table-space-end)
105 (maphash (lambda (name info)
106 (let ((table-addr (linkage-info-address info)))
109 (+ table-addr sb!vm:linkage-table-entry-size))
110 (return-from foreign-symbol-in-address name))))
112 #!+os-provides-dladdr
113 (with-alien ((info (struct dl-info
117 (symbol-address unsigned)))
118 (dladdr (function unsigned unsigned (* (struct dl-info)))
120 (let ((err (alien-funcall dladdr addr (addr info))))
123 (slot info 'symbol))))
124 ;; FIXME: Even in the absence of dladdr we could search the
125 ;; static foreign symbols (and *linkage-info*, for that matter).
128 ;;; How we learn about foreign symbols and dlhandles initially
129 (defvar *!initial-foreign-symbols*)
132 (defun !foreign-cold-init ()
133 (dolist (symbol *!initial-foreign-symbols*)
134 (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol)))
135 #!+os-provides-dlopen
136 (setf *runtime-dlhandle* (dlopen-or-lose)
137 *shared-objects* nil))
139 #!-os-provides-dlopen
140 (define-unsupported-fun load-shared-object)