diff --git a/code/filesys.lisp b/code/filesys.lisp
index ad3128846fa19d1036a8cd1a51c2044ce19f7895..bd50873afca892a03b34cf249a11d9cf2c2d3dc6 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.12 1991/09/03 20:44:02 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.13 1991/10/22 16:31:32 chiles Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -256,19 +256,18 @@
 				 (defaults *default-pathname-defaults*)
 				 default-version)
   "Fills in unspecified slots of Pathname from Defaults (defaults to
-  *default-pathname-defaults*).  If the version remains unspecified,
-  gets it from Default-Version."
+   *default-pathname-defaults*).  If the version remains unspecified,
+   gets it from Default-Version."
   ;;
   ;; finish hairy argument defaulting
   (let ((pathname (pathname pathname))
 	(defaults (pathname defaults)))
     ;;
     ;; make a new pathname
-    (let ((name (%pathname-name pathname))
-	  (device (%pathname-device pathname)))
+    (let ((name (%pathname-name pathname)))
       (%make-pathname
        (or (%pathname-host pathname) (%pathname-host defaults))
-       (or device (%pathname-device defaults))
+       (or (%pathname-device pathname) (%pathname-device defaults))
        (or (%pathname-directory pathname) (%pathname-directory defaults))
        (or name (%pathname-name defaults))
        (or (%pathname-type pathname) (%pathname-type defaults))
@@ -689,13 +688,13 @@
   (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname)))
 	 (device (%pathname-device pathname))
 	 (pattern (parse-pattern pathname))
-	 (results nil)
-	 (really-won nil))
+	 (results nil))
     (if (or (eq device :absolute)
 	    (null device)
 	    (string= device "Default"))
-	(multiple-value-setq (results really-won)
-	  (matching-files-in-dir (directory-namestring pathname) pattern all))
+	(setf results
+	      (matching-files-in-dir (directory-namestring pathname)
+				     pattern all))
 	(let ((remainder (namestring-without-device
 			  (directory-namestring pathname))))
 	  (do-search-list (dir device)
@@ -709,11 +708,7 @@
 	      (when won
 		(setf really-won t))
 	      (setf results (append results files))))))
-    (unless really-won
-      (error "Could not find ~S." pathname))
-    (setf results
-	  (sort (delete-duplicates results :test #'string=)
-		#'string<))
+    (setf results (sort (delete-duplicates results :test #'string=) #'string<))
     (mapcar #'(lambda (name)
 		(if (and check-for-subdirs
 			 (eq (mach:unix-file-kind name) :directory))
@@ -937,14 +932,12 @@
 
 ;;;; File completion.
 
+;;; COMPLETE-FILE -- Public
+;;;
 (defun complete-file (pathname &key (defaults *default-pathname-defaults*)
 			       ignore-types)
-  ;; Find all possible pathnames.
   (let ((files
-	 (directory (concatenate 'string
-				 (namestring (merge-pathnames pathname
-							      defaults))
-				 "*")
+	 (directory (complete-file-directory-arg pathname defaults)
 		    :check-for-subdirs nil)))
     (cond ((null files)
 	   (values nil nil))
@@ -981,12 +974,49 @@
 	       (values (merge-pathnames common pathname)
 		       nil)))))))
 
+;;; COMPLETE-FILE-DIRECTORY-ARG -- Internal.
+;;;
+;;; This is necessary to make COMPLETE-FILE reasonable.  The problem is that
+;;; MERGE-PATHNAMES of pathname and defaults fails us when pathname has a
+;;; non-nil directory slot, and pathname is relative to the "default" device.
+;;; There is no good argument for making MERGE-PATHNAMES do what COMPLETE-FILE
+;;; wants, but since COMPLETE-FILE is used in the context of the defaults
+;;; argument, it should always complete relative to the defaults, not relative
+;;; to the "default" logical name.  That is, what users want when pathname is
+;;; not absolute and specifies directories is something relative to the
+;;; absolute defaults supplied.
+;;;
+(defun complete-file-directory-arg (pathname defaults)
+  (let ((pathname (pathname pathname))
+	(defaults (pathname defaults)))
+    (concatenate 'simple-string
+		 (namestring
+		  (cond
+		   ((not (and (string= (pathname-device pathname) "Default")
+			      (pathname-directory pathname)))
+		    (merge-pathnames pathname defaults))
+		   ((eq (pathname-device defaults) :absolute)
+		    ;;
+		    (make-pathname
+		     :host (or (pathname-host pathname) (pathname-host defaults))
+		     :device :absolute
+		     :directory (concatenate 'simple-vector
+					     (pathname-directory defaults)
+					     (pathname-directory pathname))
+		     :name (or (pathname-name pathname) (pathname-name defaults))
+		     :type (or (pathname-type pathname)
+			       (pathname-type defaults))))
+		   (t
+		    ;; This branch should never fire, but just in case ...
+		    (merge-pathnames pathname defaults))))
+		 "*")))
+
 ;;; Ambiguous-Files  --  Public
 ;;;
 (defun ambiguous-files (pathname &optional defaults)
   "Return a list of all files which are possible completions of Pathname.
-  We look in the directory specified by Defaults as well as looking down
-  the search list."
+   We look in the directory specified by Defaults as well as looking down
+   the search list."
   (directory (concatenate 'string
 			  (namestring
 			   (merge-pathnames pathname