Index: /trunk/source/level-1/l1-pathnames.lisp
===================================================================
--- /trunk/source/level-1/l1-pathnames.lisp	(revision 14019)
+++ /trunk/source/level-1/l1-pathnames.lisp	(revision 14020)
@@ -684,12 +684,18 @@
                                       (return-from full-pathname nil)
                                       (error condition)))))
-         (dir (%pathname-directory path)))
-    (if (eq (car dir) :absolute)
-      path
-      (cons-pathname (absolute-directory-list dir)
-                       (%pathname-name path)
-                       (%pathname-type path)
-                       (pathname-host path)
-                       (pathname-version path)))))
+         (dir (%pathname-directory path))
+	 (device #+windows-target
+	         (or (pathname-device path)
+		     (pathname-device (mac-default-directory)))
+		 #-windows-target
+		 nil))
+    (cons-pathname (if (eq (car dir) :absolute)
+		     dir
+		     (absolute-directory-list dir))
+		   (%pathname-name path)
+		   (%pathname-type path)
+		   (pathname-host path)
+		   (pathname-version path)
+		   device)))
 
 
