From: Stas Boukarev Date: Mon, 11 Nov 2013 11:13:51 +0000 (+0400) Subject: win32: provide error messages when loading foreign libraries. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a4c87f2654b9bd5b5f35cb84ddf12e40bbadc407;p=sbcl.git win32: provide error messages when loading foreign libraries. Decode the error codes into messages. --- diff --git a/NEWS b/NEWS index 30f7f79..1c5d073 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,8 @@ changes relative to sbcl-1.1.13: Thanks to Jan Moringen. (lp#1249055) * enhancement: Top-level defmethod without defgeneric no longer causes undefined-function warnings in subsequent forms. (lp#503095) + * enhancement: Errors during loading foreign libraries on Windows now + include error messages instead of error codes. * bug fix: EQUALP now compares correctly structures with raw slots larger than a single word. * bug fix: contribs couldn't be built on Windows with MinGW. diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index 8cf96d5..ed863ae 100644 --- a/contrib/sb-bsd-sockets/sockets.lisp +++ b/contrib/sb-bsd-sockets/sockets.lisp @@ -475,7 +475,7 @@ request an input stream and get an output stream in response\)." (or (socket-error-symbol c) (socket-error-errno c)) #+cmu (sb-unix:get-unix-error-msg num) #+sbcl - #+win32 (sb-win32::get-last-error-message num) + #+win32 (sb-win32:format-system-message num) #-win32 (sb-int:strerror num))))) (:documentation "Common base class of socket related conditions.")) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 4e81775..8adc3b5 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2925,7 +2925,7 @@ SBCL itself" "FILE-TRUNCATE-EXISTING" "FLUSH-CONSOLE-INPUT-BUFFER" "FLUSH-VIEW-OF-FILE" - "FORMAT-MESSAGE" + "FORMAT-SYSTEM-MESSAGE" "GET-FILE-ATTRIBUTES" "GET-FILE-SIZE-EX" "GET-FILE-TYPE" diff --git a/src/code/win32-foreign-load.lisp b/src/code/win32-foreign-load.lisp index 0bcf0cb..f62718d 100644 --- a/src/code/win32-foreign-load.lisp +++ b/src/code/win32-foreign-load.lisp @@ -23,8 +23,6 @@ (handle hinstance) (symbol c-string)) -(define-alien-routine ("GetLastError" getlasterror) unsigned-int) - (define-alien-routine ("SetStdHandle" set-std-handle) void (id int) @@ -61,8 +59,8 @@ (aver namestring) (when (zerop handle) (setf (shared-object-handle obj) nil) - (error "Error opening shared object ~S:~% ~A." - namestring (getlasterror))) + (error "Error opening shared object ~S:~% ~A" + namestring (sb!win32:format-system-message (sb!win32:get-last-error)))) (setf (shared-object-handle obj) handle) handle) (extern-alien "runtime_module_handle" hinstance))) @@ -72,9 +70,9 @@ (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 ~S:~% ~A" (shared-object-namestring obj) - (getlasterror))) + (sb!win32:format-system-message (sb!win32:get-last-error)))) (setf (shared-object-handle obj) nil))) (defun find-dynamic-foreign-symbol-address (symbol) diff --git a/src/code/win32.lisp b/src/code/win32.lisp index 9c5cc97..d1b7b5c 100644 --- a/src/code/win32.lisp +++ b/src/code/win32.lisp @@ -74,21 +74,6 @@ ;;; last-error code is maintained on a per-thread basis. (define-alien-routine ("GetLastError" get-last-error) dword) -;;; Flag constants for FORMAT-MESSAGE. -(defconstant format-message-from-system #x1000) - -;;; Format an error message based on a lookup table. See MSDN for the -;;; full meaning of the all options---most are not used when getting -;;; system error codes. -(define-alien-routine ("FormatMessageA" format-message) dword - (flags dword) - (source (* t)) - (message-id dword) - (language-id dword) - (buffer c-string) - (size dword) - (arguments (* t))) - ;;;; File Handles ;;; Historically, SBCL on Windows used CRT (lowio) file descriptors, @@ -521,16 +506,17 @@ (defmacro void-syscall* ((name &rest arg-types) &rest args) `(syscall* (,name ,@arg-types) (values t 0) ,@args)) -(defun get-last-error-message (err) +(defun format-system-message (err) "http://msdn.microsoft.com/library/default.asp?url=/library/en-us/debug/base/retrieving_the_last_error_code.asp" (let ((message (with-alien ((amsg (* char))) (syscall (("FormatMessage" t) dword dword dword dword dword (* (* char)) dword dword) (cast-and-free amsg :free-function local-free) - (logior FORMAT_MESSAGE_ALLOCATE_BUFFER - FORMAT_MESSAGE_FROM_SYSTEM - FORMAT_MESSAGE_MAX_WIDTH_MASK) + (logior format-message-allocate-buffer + format-message-from-system + format-message-max-width-mask + format-message-ignore-inserts) 0 err 0 (addr amsg) 0 0)))) (and message (string-right-trim '(#\Space) message)))) @@ -540,7 +526,7 @@ (error "~%Win32 Error [~A] - ~A~%~A" ,func-name err-code - (get-last-error-message err-code)))) + (format-system-message err-code)))) (defun get-folder-namestring (csidl) "http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetfolderpath.asp" diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c index 9be8744..ebf1449 100644 --- a/tools-for-build/grovel-headers.c +++ b/tools-for-build/grovel-headers.c @@ -204,9 +204,10 @@ main(int argc, char *argv[]) printf(";;; FormatMessage\n"); - defconstant("FORMAT_MESSAGE_ALLOCATE_BUFFER", FORMAT_MESSAGE_ALLOCATE_BUFFER); - defconstant("FORMAT_MESSAGE_FROM_SYSTEM", FORMAT_MESSAGE_FROM_SYSTEM); - defconstant("FORMAT_MESSAGE_MAX_WIDTH_MASK", FORMAT_MESSAGE_MAX_WIDTH_MASK); + defconstant("format-message-allocate-buffer", FORMAT_MESSAGE_ALLOCATE_BUFFER); + defconstant("format-message-from-system", FORMAT_MESSAGE_FROM_SYSTEM); + defconstant("format-message-max-width-mask", FORMAT_MESSAGE_MAX_WIDTH_MASK); + defconstant("format-message-ignore-inserts", FORMAT_MESSAGE_IGNORE_INSERTS); printf(";;; Errors\n");