diff --git a/code/pathname.lisp b/code/pathname.lisp
index b805da3b2fa8c81bc55ad000211d8393d8f6aca7..2015972e197071db9d09f7d47be0e44b4a793e1e 100644
--- a/code/pathname.lisp
+++ b/code/pathname.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.83 2005/10/24 14:55:32 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.84 2005/11/08 17:12:29 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -125,18 +125,57 @@
 	   (if (or *print-escape* *print-readably*)
 	       (format stream "#P~S" namestring)
 	       (format stream "~A" namestring)))
-	  (*print-readably*
-	   (error 'print-not-readable :object pathname))
 	  (t
-	   (funcall (formatter "#<Unprintable pathname, Host=~S, Device=~S, ~
-				Directory=~S, Name=~S, Type=~S, Version=~S>")
-		    stream
-		    (%pathname-host pathname)
-		    (%pathname-device pathname)
-		    (%pathname-directory pathname)
-		    (%pathname-name pathname)
-		    (%pathname-type pathname)
-		    (%pathname-version pathname))))))
+	   (let ((host (%pathname-host pathname))
+		 (device (%pathname-device pathname))
+		 (directory (%pathname-directory pathname))
+		 (name (%pathname-name pathname))
+		 (type (%pathname-type pathname))
+		 (version (%pathname-version pathname)))
+	     (cond ((every #'(lambda (d)
+			       (or (stringp d)
+				   (symbolp d)))
+			   (cdr directory))
+		    ;; A CMUCL extension.  If we have an unprintable
+		    ;; pathname, convert it to a form that would be
+		    ;; suitable as args to MAKE-PATHNAME to recreate
+		    ;; the pathname.
+		    ;;
+		    ;; We don't handle search-lists because we don't
+		    ;; currently have a readable syntax for
+		    ;; search-lists.
+		    (collect ((result))
+		      (unless (eq host *unix-host*)
+			(result :host)
+			(result (pathname-host pathname)))
+		      (when device
+			(result :device)
+			(result device))
+		      (when directory
+			(result :directory)
+			(result directory))
+		      (when name
+			(result :name)
+			(result name))
+		      (when type
+			(result :type)
+			(result type))
+		      (when version
+			(result :version)
+			(result version))
+		      (format stream "#P~S" (result))))
+		   (*print-readably*
+		    (error 'print-not-readable :object pathname))
+		   (t
+		    (funcall (formatter "#<Unprintable pathname,~:_ Host=~S,~:_ Device=~S,~:_ ~
+				Directory=~S,~:_ Name=~S,~:_ Type=~S,~:_ Version=~S>")
+			     stream
+			     (%pathname-host pathname)
+			     (%pathname-device pathname)
+			     (%pathname-directory pathname)
+			     (%pathname-name pathname)
+			     (%pathname-type pathname)
+			     (%pathname-version pathname)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff --git a/code/sharpm.lisp b/code/sharpm.lisp
index 025e9b5feab3b29f133f479cdef6b63111ac53e1..f6098330b53dc1a352270d096299dce36ef33dfc 100644
--- a/code/sharpm.lisp
+++ b/code/sharpm.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.25 2005/04/28 20:32:10 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.26 2005/11/08 17:12:29 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -400,7 +400,11 @@
   (ignore-numarg sub-char numarg)
   (let ((namestring (read stream t nil t)))
     (unless *read-suppress*
-      (parse-namestring namestring))))
+      (if (listp namestring)
+	  ;; A CMUCL extension: #P(foo) treats foo as the args to
+	  ;; make-pathname
+	  (apply #'make-pathname namestring)
+	  (parse-namestring namestring)))))
 
 (make-dispatch-macro-character #\# t)
 (set-dispatch-macro-character #\# #\\ #'sharp-backslash)