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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"