X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32.lisp;h=d1b7b5cb25c1f464e668e4795b320414a7881b81;hb=a4c87f2654b9bd5b5f35cb84ddf12e40bbadc407;hp=9c5cc97922e4123fdca85db10ef08298199ad60f;hpb=1975bd0492ed33de669f92d8c03d75bca19ed011;p=sbcl.git 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"