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            ;; CLH/NS: if we're on sufficiently old darwin we can't close
  50            ;; *runtime-dlhandle* for some reason, so don't.
  51            #!-darwin
  52            (dlclose *runtime-dlhandle*)
  53            (setf dlerror (dlerror)
  54                  *runtime-dlhandle* nil))
  55           ((and objp (shared-object-handle obj))
  56            (dlclose (shared-object-handle obj))
  57            (setf dlerror (dlerror)
  58                  (shared-object-handle obj) nil)))
  59     (when dlerror
  60       (cerror "Ignore the error and continue as if closing succeeded."
  61               "dlerror() returned an error while trying to close ~
  62                ~:[runtime~;shared object ~:*~S~]: ~S"
  63               (when obj (shared-object-namestring obj))
  64               dlerror))))
  65
  66 (defun find-dynamic-foreign-symbol-address (symbol)
  67   (dlerror)                             ; clear old errors
  68   (unless *runtime-dlhandle*
  69     (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*"))
  70   ;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op,
  71   ;; but on platforms where dlsym is simulated we use the mangled name.
  72   (let* ((extern (extern-alien-name symbol))
  73          (result (sap-int (dlsym *runtime-dlhandle* extern)))
  74          (err (dlerror)))
  75     (if (or (not (zerop result)) (not err))
  76         result
  77         (dolist (obj *shared-objects*)
  78           (let ((sap (shared-object-handle obj)))
  79             (when sap
  80               (setf result (sap-int (dlsym sap extern))
  81                     err (dlerror))
  82               (when (or (not (zerop result)) (not err))
  83                 (return result))))))))
  84
  85