win32: provide error messages when loading foreign libraries.

Decode the error codes into messages.

diff --git a/NEWS b/NEWS
index 30f7f79..1c5d073 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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");