;;; 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,
(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))))
(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"
(type sb!unix:unix-file-mode mode)
(ignore mode))
(syscall (("CreateDirectory" t) lispbool system-string (* t))
- (values result (if result 0 (- (get-last-error))))
+ (values result (if result 0 (get-last-error)))
name nil))
(defun sb!unix:unix-rename (name1 name2)
(declare (type sb!unix:unix-pathname name1 name2))
(syscall (("MoveFile" t) lispbool system-string system-string)
- (values result (if result 0 (- (get-last-error))))
+ (values result (if result 0 (get-last-error)))
name1 name2))
(defun sb!unix::posix-getenv (name)
(set-file-pointer-ex handle offset whence)
(if moved
(values to-place 0)
- (values -1 (- (get-last-error))))))
+ (values -1 (get-last-error)))))
;; File mapping support routines
(define-alien-routine (#!+sb-unicode "CreateFileMappingW"
sb!unix:enoent)
((#.error_already_exists #.error_file_exists)
sb!unix:eexist)
- (otherwise (- error-code)))))
+ (otherwise error-code))))
(progn
;; FIXME: seeking to the end is not enough for real APPEND
;; semantics, but it's better than nothing.
(duplicate-handle me fd me 0 t +duplicate-same-access+)
(if duplicated
(values handle 0)
- (values nil (- (get-last-error)))))))
+ (values nil (get-last-error))))))
(defun call-with-crt-fd (thunk handle &optional (flags 0))
(multiple-value-bind (duplicate errno)