[f05756]: src / code / win32-foreign-load.lisp Maximize Restore History

Download this file

win32-foreign-load.lisp    117 lines (99 with data), 4.5 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;;;; Loading shared object files, Win32 specifics
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
(in-package "SB!ALIEN")
(define-alien-type hinstance signed)
(define-alien-routine ("LoadLibraryA" loadlibrary) hinstance
(file c-string))
(define-alien-routine ("FreeLibrary" freelibrary) int
(handle hinstance))
(define-alien-routine ("GetProcAddress" getprocaddress) system-area-pointer
(handle hinstance)
(symbol c-string))
(define-alien-routine ("GetLastError" getlasterror) unsigned-int)
(define-alien-routine ("SetStdHandle" set-std-handle)
void
(id int)
(handle int))
(sb!alien:define-alien-routine ("GetStdHandle" get-std-handle)
sb!alien:int
(id sb!alien:int))
(define-alien-routine ("GetModuleHandleW" get-module-handle)
hinstance
(name (c-string :external-format :ucs-2)))
(defvar *reset-stdio-on-dlopen* t)
(defconstant +stdio-handle+ -10)
(defun loadlibrary-without-stdio (namestring)
(flet ((loadlibrary (namestring)
(loadlibrary namestring)))
(if *reset-stdio-on-dlopen*
(let ((stdio (get-std-handle +stdio-handle+)))
(unwind-protect
(progn
(set-std-handle +stdio-handle+ -1)
(loadlibrary namestring))
(set-std-handle +stdio-handle+ stdio)))
(loadlibrary namestring))))
(defun dlopen-or-lose (&optional obj)
(if obj
(let* ((namestring (shared-object-namestring obj))
(handle (loadlibrary-without-stdio namestring)))
(aver namestring)
(when (zerop handle)
(setf (shared-object-handle obj) nil)
(error "Error opening shared object ~S:~% ~A."
namestring (getlasterror)))
(setf (shared-object-handle obj) handle)
handle)
(extern-alien "runtime_module_handle" hinstance)))
(defun dlclose-or-lose (&optional (obj nil objp))
(when (and objp (shared-object-handle obj))
(unless (freelibrary (shared-object-handle obj))
(cerror "Ignore the error and continue as if closing succeeded."
"FreeLibrary() caused an error while trying to close ~
shared object ~S: ~S"
(shared-object-namestring obj)
(getlasterror)))
(setf (shared-object-handle obj) nil)))
(defun find-dynamic-foreign-symbol-address (symbol)
;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op,
;; but on platforms where dlsym is simulated we use the mangled name.
;; Win32 is a special case. It needs EXTERN-ALIEN-NAME to mangle the
;; name for static linkage, but also needs unmangled symbols for
;; GetProcAddress(). So we coerce to base-string instead.
;; Oh, and we assume that all runtime symbols are static-linked.
;; No *runtime-dlhandle* for us.
;; Also, GetProcAddress doesn't call SetLastError(0) on success,
;; and GetLastError() doesn't either. For now, we assume that
;; GetProcAddress() won't return NULL on success.
(let* ((extern (coerce symbol 'base-string))
(result nil))
(dolist (handle
(cons *runtime-dlhandle*
(mapcar #'shared-object-handle *shared-objects*)))
(when handle
(setf result (sap-int (getprocaddress handle extern)))
(when (not (zerop result))
(return result))))))
(defun runtime-exported-symbols ()
;; TODO: reimplement for x86-64. Not so hard.
(let* ((image-base (extern-alien "runtime_module_handle" system-area-pointer))
(pe-base (sap+ image-base (sap-ref-32 image-base 60)))
(export-directory (sap+ pe-base (- #!+x86 248 #!+x86-64 264 (* 16 8))))
(export-data (sap+ image-base (sap-ref-32 export-directory 0)))
(n-functions (sap-ref-32 export-data 20))
(n-names (sap-ref-32 export-data 24))
(functions-sap (sap+ image-base (sap-ref-32 export-data 28)))
(names-sap (sap+ image-base (sap-ref-32 export-data 32))))
(loop repeat (min n-functions n-names)
for offset from 0 by #.sb!vm::n-word-bytes
collect
(cons
(sap-int (sap+ image-base (sap-ref-32 functions-sap offset)))
(sap-int (sap+ image-base (sap-ref-32 names-sap offset)))))))