From: Juho Snellman Date: Wed, 20 Sep 2006 12:08:22 +0000 (+0000) Subject: 0.9.16.41: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a4a5e8fb87c7af981cb4c759dc3c5e6d44074f42;p=sbcl.git 0.9.16.41: More win32 fixes. (Thanks to Yaroslav Kavenchuk: sbcl-devel "win32 regression" on 2006-09-18 and "merge-pathnames on win32" on 2006-09-19) * Double the size of the string buffers given to syscalls on sb-unicode, since the data is going to be in UCS-2 instead of some single-octet encoding * Fix the code for finding the system-wide sbclrc * Whitespace --- diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 4aea10d..fcd8a5e 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -43,9 +43,9 @@ (when sbcl-homedir (probe-file (merge-pathnames sbcl-homedir "sbclrc")))) #!+win32 - (merge-pathnames (sb!win32::get-folder-pathname - sb!win32::csidl_common_appdata) - "\\sbcl\\sbclrc") + (merge-pathnames "sbcl\\sbclrc" + (sb!win32::get-folder-pathname + sb!win32::csidl_common_appdata)) #!-win32 "/etc/sbclrc")) diff --git a/src/code/win32-os.lisp b/src/code/win32-os.lisp index f485d71..57bc68f 100644 --- a/src/code/win32-os.lisp +++ b/src/code/win32-os.lisp @@ -26,11 +26,11 @@ if not available." (or *software-version* (setf *software-version* - (multiple-value-bind (MajorVersion MinorVersion BuildNumber PlatformId CSDVersion) - (sb!win32:get-version-ex) - (declare (ignore PlatformId)) - (format nil (if (zerop (length CSDVersion)) "~A.~A.~A" "~A.~A.~A (~A)") - MajorVersion MinorVersion BuildNumber CSDVersion))))) + (multiple-value-bind (MajorVersion MinorVersion BuildNumber PlatformId CSDVersion) + (sb!win32:get-version-ex) + (declare (ignore PlatformId)) + (format nil (if (zerop (length CSDVersion)) "~A.~A.~A" "~A.~A.~A (~A)") + MajorVersion MinorVersion BuildNumber CSDVersion))))) ;;; Return user time, system time, and number of page faults. (defun get-system-info () diff --git a/src/code/win32.lisp b/src/code/win32.lisp index c5210df..5049c1e 100644 --- a/src/code/win32.lisp +++ b/src/code/win32.lisp @@ -374,6 +374,8 @@ l)))))) ,@body))) +(defmacro make-system-buffer (x) + `(make-alien char #!+sb-unicode (ash ,x 1) #!-sb-unicode ,x)) ;;; FIXME: The various FOO-SYSCALL-BAR macros, and perhaps some other ;;; macros in this file, are only used in this file, and could be @@ -432,21 +434,21 @@ (defun get-folder-pathname (csidl) "http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetfolderpath.asp" - (with-alien ((apath (* char) (make-alien char (1+ max_path)))) + (with-alien ((apath (* char) (make-system-buffer (1+ max_path)))) (syscall (("SHGetFolderPath" 20 t) int handle int handle dword (* char)) (parse-native-namestring (concatenate 'string (cast-and-free apath) "\\")) 0 csidl 0 0 apath))) (defun sb!unix:posix-getcwd () - (with-alien ((apath (* char) (make-alien char (1+ max_path)))) + (with-alien ((apath (* char) (make-system-buffer (1+ max_path)))) (with-sysfun (afunc ("GetCurrentDirectory" 8 t) dword dword (* char)) (let ((ret (alien-funcall afunc (1+ max_path) apath))) (when (zerop ret) (win32-error "GetCurrentDirectory")) (when (> ret (1+ max_path)) (free-alien apath) - (setf apath (make-alien char ret)) + (setf apath (make-system-buffer ret)) (alien-funcall afunc ret apath)) (cast-and-free apath))))) @@ -462,13 +464,13 @@ (defun sb!unix::posix-getenv (name) (declare (type simple-string name)) - (with-alien ((aenv (* char) (make-alien char default-environment-length))) + (with-alien ((aenv (* char) (make-system-buffer default-environment-length))) (with-sysfun (afunc ("GetEnvironmentVariable" 12 t) dword system-string (* char) dword) (let ((ret (alien-funcall afunc name aenv default-environment-length))) (when (> ret default-environment-length) (free-alien aenv) - (setf aenv (make-alien char ret)) + (setf aenv (make-system-buffer ret)) (alien-funcall afunc name aenv ret)) (if (> ret 0) (cast-and-free aenv) @@ -557,7 +559,7 @@ ;; http://msdn.microsoft.com/library/en-us/sysinfo/base/getcomputername.asp (declaim (ftype (function () simple-string) get-computer-name)) (defun get-computer-name () - (with-alien ((aname (* char) (make-alien char (1+ MAX_COMPUTERNAME_LENGTH))) + (with-alien ((aname (* char) (make-system-buffer (1+ MAX_COMPUTERNAME_LENGTH))) (length dword (1+ MAX_COMPUTERNAME_LENGTH))) (with-sysfun (afunc ("GetComputerName" 8 t) bool (* char) (* dword)) (when (zerop (alien-funcall afunc aname (addr length))) @@ -565,6 +567,6 @@ (unless (= err ERROR_BUFFER_OVERFLOW) (win32-error "GetComputerName" err)) (free-alien aname) - (setf aname (make-alien char length)) + (setf aname (make-system-buffer length)) (alien-funcall afunc aname (addr length)))) (cast-and-free aname)))) diff --git a/version.lisp-expr b/version.lisp-expr index 5b37fcc..c0f797a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.16.40" +"0.9.16.41"