-(defun dlopen-or-lose (obj)
- (let* ((namestring (shared-object-namestring obj))
- (handle (loadlibrary 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))
+(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)))