1.0.21.19: Eagerly find a stream's external-format when a coding-error occurs.
[sbcl.git] / src / code / unix-foreign-load.lisp
1 ;;;; Loading shared object files, Unix specifics
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!ALIEN")
13
14 (define-alien-routine dlopen system-area-pointer
15   (file c-string) (mode int))
16
17 (define-alien-routine dlclose int
18   (handle system-area-pointer))
19
20 (define-alien-routine dlerror c-string)
21
22 (define-alien-routine
23     #!-openbsd dlsym
24     #!+openbsd ("os_dlsym" dlsym)
25     system-area-pointer
26   (handle system-area-pointer)
27   (symbol c-string))
28
29 (defun dlopen-or-lose (&optional (obj nil objp))
30   (when objp
31     (dlclose-or-lose obj))
32   (dlerror) ; clear errors
33   (let* ((namestring (and obj (shared-object-namestring obj)))
34          (sap (dlopen namestring (logior rtld-global rtld-now))))
35     (when (zerop (sap-int sap))
36       (if objp
37           (setf (shared-object-handle obj) nil)
38           (setf *runtime-dlhandle* nil))
39       (error "Error opening ~:[runtime~;shared object ~:*~S~]:~%  ~A."
40              namestring (dlerror)))
41     (when objp
42       (setf (shared-object-handle obj) sap))
43     sap))
44
45 (defun dlclose-or-lose (&optional (obj nil objp))
46   (dlerror)
47   (let (dlerror)
48     (cond ((and (not objp) *runtime-dlhandle*)
49            (dlclose *runtime-dlhandle*)
50            (setf dlerror (dlerror)
51                  *runtime-dlhandle* nil))
52           ((and objp (shared-object-handle obj))
53            (dlclose (shared-object-handle obj))
54            (setf dlerror (dlerror)
55                  (shared-object-handle obj) nil)))
56     (when dlerror
57       (cerror "Ignore the error and continue as if closing succeeded."
58               "dlerror() returned an error while trying to close ~
59                ~:[runtime~;shared object ~:*~S~]: ~S"
60               (when obj (shared-object-namestring obj))
61               dlerror))))
62
63 (defun find-dynamic-foreign-symbol-address (symbol)
64   (dlerror)                             ; clear old errors
65   (unless *runtime-dlhandle*
66     (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*"))
67   ;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op,
68   ;; but on platforms where dlsym is simulated we use the mangled name.
69   (let* ((extern (extern-alien-name symbol))
70          (result (sap-int (dlsym *runtime-dlhandle* extern)))
71          (err (dlerror)))
72     (if (or (not (zerop result)) (not err))
73         result
74         (dolist (obj *shared-objects*)
75           (let ((sap (shared-object-handle obj)))
76             (when sap
77               (setf result (sap-int (dlsym sap extern))
78                     err (dlerror))
79               (when (or (not (zerop result)) (not err))
80                 (return result))))))))
81
82