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