Index: package-data-list.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v
retrieving revision 1.423
diff -u -r1.423 package-data-list.lisp-expr
--- package-data-list.lisp-expr	5 Oct 2007 14:00:08 -0000	1.423
+++ package-data-list.lisp-expr	16 Oct 2007 12:17:14 -0000
@@ -2493,7 +2493,7 @@
       :doc "private: a wrapper layer for Win32 functions needed by
 SBCL itself"
       :use ("CL" "SB!ALIEN" "SB!EXT" "SB!INT" "SB!SYS")
-      :export ("BOOL"
+      :export ("BOOL" "QUERY-DOS-DEVICE"
                "DWORD" "FD-CLEAR-INPUT" "FD-LISTEN"
                "FLUSH-CONSOLE-INPUT-BUFFER" "FORMAT-MESSAGE"
                "GET-LAST-ERROR" "GET-OSFHANDLE" "HANDLE"
Index: src/code/filesys.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/filesys.lisp,v
retrieving revision 1.65
diff -u -r1.65 filesys.lisp
--- src/code/filesys.lisp	1 Dec 2006 17:23:20 -0000	1.65
+++ src/code/filesys.lisp	16 Oct 2007 12:17:31 -0000
@@ -456,6 +456,11 @@
 ;;; Convert PATHNAME into a string that can be used with UNIX system
 ;;; calls, or return NIL if no match is found. Wild-cards are expanded.
 ;;;
+;;; On Win32 systems, DOS devices always exist as their bare device
+;;; name (this is arguably wrong, as they aren't supposed to exist in
+;;; non-existant directories, but an improvement over the case of them
+;;; never existing).
+;;;
 ;;; FIXME: apart from the error checking (for wildness and for
 ;;; existence) and conversion to physical pathanme, this is redundant
 ;;; with UNPARSE-NATIVE-UNIX-NAMESTRING; one should probably be
@@ -469,6 +474,9 @@
       (error 'simple-file-error
              :pathname namestring
              :format-control "bad place for a wild pathname"))
+    #!+win32
+    (when (sb!win32:query-dos-device (pathname-name namestring))
+      (return-from unix-namestring (pathname-name namestring)))
     (!enumerate-matches (match namestring nil :verify-existence for-input)
                         (push match matches))
     (case (length matches)
Index: src/code/win32.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/win32.lisp,v
retrieving revision 1.15
diff -u -r1.15 win32.lisp
--- src/code/win32.lisp	7 Apr 2007 09:38:47 -0000	1.15
+++ src/code/win32.lisp	16 Oct 2007 12:17:44 -0000
@@ -440,6 +440,19 @@
                (concatenate 'string (cast-and-free apath) "\\"))
              0 csidl 0 0 apath)))
 
+(defun query-dos-device (name)
+  "http://msdn2.microsoft.com/en-us/library/aa365461.aspx"
+  (with-alien ((target-path (* char) (make-system-buffer (1+ max_path))))
+    (syscall (("QueryDosDevice" 12 t) dword system-string (* char) dword)
+	     (if (zerop result)
+		 ;; Technically, we might do something with
+		 ;; ERROR_INSUFFICIENT_BUFFER here.
+		 nil
+		 ;; Technically, this is a NUL-terminated set
+		 ;; of NUL-terminated strings, not a single string.
+		 (cast-and-free target-path))
+	     name target-path max_path)))
+
 (defun sb!unix:posix-getcwd ()
   (with-alien ((apath (* char) (make-system-buffer (1+ max_path))))
     (with-sysfun (afunc ("GetCurrentDirectory" 8 t) dword dword (* char))
Index: src/runtime/win32-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/win32-os.c,v
retrieving revision 1.34
diff -u -r1.34 win32-os.c
--- src/runtime/win32-os.c	2 May 2007 23:04:37 -0000	1.34
+++ src/runtime/win32-os.c	16 Oct 2007 12:18:35 -0000
@@ -568,6 +568,7 @@
       GetEnvironmentVariableA(0, 0, 0);
       GetVersionExA(0);
       MoveFileA(0,0);
+      QueryDosDeviceA(0, 0, 0);
       SHGetFolderPathA(0, 0, 0, 0, 0);
       SetCurrentDirectoryA(0);
       SetEnvironmentVariableA(0, 0);
@@ -579,6 +580,7 @@
       GetEnvironmentVariableW(0, 0, 0);
       GetVersionExW(0);
       MoveFileW(0,0);
+      QueryDosDeviceW(0, 0, 0);
       SHGetFolderPathW(0, 0, 0, 0, 0);
       SetCurrentDirectoryW(0);
       SetEnvironmentVariableW(0, 0);

