X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-pathname.lisp;h=25cf000c5c1c4294ec8c6e903fd899f190ff0992;hb=cd176690400f8b6fa23faa4dc6fa8494bcbce480;hp=f1dfb0eb0de5d59c3b3c86fe2ba4d7c87f52ea42;hpb=7ef5ec93744c7cc1c7a0280e46f8b42b74353713;p=sbcl.git

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index f1dfb0e..25cf000 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -13,10 +13,30 @@
 
 #!-sb-fluid (declaim (freeze-type logical-pathname logical-host))
 
-;;; host methods
-
-(def!method print-object ((host host) stream)
-  (print-unreadable-object (host stream :type t :identity t)))
+;;;; UNIX-HOST stuff
+
+(def!struct (unix-host
+	     (:make-load-form-fun make-unix-host-load-form)
+	     (:include host
+		       (parse #'parse-unix-namestring)
+		       (unparse #'unparse-unix-namestring)
+		       (unparse-host #'unparse-unix-host)
+		       (unparse-directory #'unparse-unix-directory)
+		       (unparse-file #'unparse-unix-file)
+		       (unparse-enough #'unparse-unix-enough)
+		       (customary-case :lower))))
+
+(defvar *unix-host* (make-unix-host))
+
+(defun make-unix-host-load-form (host)
+  (declare (ignore host))
+  '*unix-host*)
+
+;;; Return a value suitable, e.g., for preinitializing
+;;; *DEFAULT-PATHNAME-DEFAULTS* before *DEFAULT-PATHNAME-DEFAULTS* is
+;;; initialized (at which time we can't safely call e.g. #'PATHNAME).
+(defun make-trivial-default-pathname ()
+  (%make-pathname *unix-host* nil nil nil nil :newest))
 
 ;;; pathname methods
 
@@ -736,7 +756,7 @@ a host-structure or string."
 
 (defun host-namestring (pathname)
   #!+sb-doc
-  "Returns a string representation of the name of the host in the pathname."
+  "Return a string representation of the name of the host in the pathname."
   (declare (type pathname-designator pathname)
 	   (values (or null simple-base-string)))
   (with-pathname (pathname pathname)
@@ -749,7 +769,7 @@ a host-structure or string."
 
 (defun directory-namestring (pathname)
   #!+sb-doc
-  "Returns a string representation of the directories used in the pathname."
+  "Return a string representation of the directories used in the pathname."
   (declare (type pathname-designator pathname)
 	   (values (or null simple-base-string)))
   (with-pathname (pathname pathname)
@@ -762,7 +782,7 @@ a host-structure or string."
 
 (defun file-namestring (pathname)
   #!+sb-doc
-  "Returns a string representation of the name used in the pathname."
+  "Return a string representation of the name used in the pathname."
   (declare (type pathname-designator pathname)
 	   (values (or null simple-base-string)))
   (with-pathname (pathname pathname)
@@ -777,7 +797,7 @@ a host-structure or string."
 			  &optional
 			  (defaults *default-pathname-defaults*))
   #!+sb-doc
-  "Returns an abbreviated pathname sufficent to identify the pathname relative
+  "Return an abbreviated pathname sufficent to identify the pathname relative
    to the defaults."
   (declare (type pathname-designator pathname))
   (with-pathname (pathname pathname)
@@ -1050,7 +1070,7 @@ a host-structure or string."
 ;;;;  logical pathname support. ANSI 92-102 specification.
 ;;;;
 ;;;;  As logical-pathname translations are loaded they are
-;;;;  canonicalized as patterns to enable rapid efficent translation
+;;;;  canonicalized as patterns to enable rapid efficient translation
 ;;;;  into physical pathnames.
 
 ;;;; utilities
@@ -1368,8 +1388,7 @@ a host-structure or string."
 
 (defun (setf logical-pathname-translations) (translations host)
   #!+sb-doc
-  "Set the translations list for the logical host argument.
-   Return translations."
+  "Set the translations list for the logical host argument."
   (declare (type (or string logical-host) host)
 	   (type list translations)
 	   (values list))
@@ -1378,9 +1397,15 @@ a host-structure or string."
 	  (canonicalize-logical-pathname-translations translations host))
     (setf (logical-host-translations host) translations)))
 
-(defun translate-logical-pathname (pathname &key)
-  #!+sb-doc
-  "Translate PATHNAME to a physical pathname, which is returned."
+;;; KLUDGE: Ordinarily known functions aren't defined recursively, and
+;;; it's common for compiler problems (e.g. missing/broken
+;;; optimization transforms) to cause them to recurse inadvertently,
+;;; so the compiler should warn about it. But the natural definition
+;;; of TRANSLATE-LOGICAL-PATHNAME *is* recursive; and we don't want
+;;; the warning, so we hide the definition of T-L-P in this
+;;; differently named function so that the compiler won't warn about
+;;; it. -- WHN 2001-09-16
+(defun %translate-logical-pathname (pathname)
   (declare (type pathname-designator pathname)
 	   (values (or null pathname)))
   (typecase pathname
@@ -1398,6 +1423,13 @@ a host-structure or string."
     (stream (translate-logical-pathname (pathname pathname)))
     (t (translate-logical-pathname (logical-pathname pathname)))))
 
+(defun translate-logical-pathname (pathname &key)
+  #!+sb-doc
+  "Translate PATHNAME to a physical pathname, which is returned."
+  (declare (type pathname-designator pathname)
+	   (values (or null pathname)))
+  (%translate-logical-pathname pathname))
+
 (defvar *logical-pathname-defaults*
   (%make-logical-pathname (make-logical-host :name "BOGUS")
 			  :unspecific