Disable win32 pathnames routines on -win32 and vice versa.

#-win32 has all the win32 pathname code enabled, but it's not used
anywhere and not exported. Even if using pathnames of a different OS
may be a good idea, it's currently not presented in any usable way and
only wastes space.

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index f86669b..c6b35e8 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -666,8 +666,10 @@
  ("src/code/reader"            :not-host) ; needs "code/readtable"
  ("src/code/target-stream"     :not-host) ; needs WHITESPACEP from "code/reader"
  ("src/code/target-pathname"   :not-host) ; needs "code/pathname"
- ("src/code/unix-pathname"      :not-host)
- ("src/code/win32-pathname"     :not-host)
+ #!-win32
+ ("src/code/unix-pathname"     :not-host)
+ #!+win32
+ ("src/code/win32-pathname"    :not-host)
  ("src/code/filesys"           :not-host) ; needs HOST from "code/pathname"
 
  ("src/code/save"              :not-host) ; uses the definition of PATHNAME

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index b51c601..960cf4e 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -579,8 +579,7 @@ exist or if is a file or a symbolic link."
     ;; SBCL_HOME isn't set for :EXECUTABLE T embedded cores
     (when (and sbcl-home (not (string= sbcl-home "")))
       (parse-native-namestring sbcl-home
-                               #!-win32 sb!impl::*unix-host*
-                               #!+win32 sb!impl::*win32-host*
+                               *physical-host*
                                *default-pathname-defaults*
                                :as-directory t))))
 
@@ -606,8 +605,7 @@ system. HOST argument is ignored by SBCL."
     (or (user-homedir-namestring)
         #!+win32
         (sb!win32::get-folder-namestring sb!win32::csidl_profile))
-    #!-win32 sb!impl::*unix-host*
-    #!+win32 sb!impl::*win32-host*
+    *physical-host*
     *default-pathname-defaults*
     :as-directory t)))
 

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 4b9e766..2d20434 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -13,49 +13,12 @@
 
 #!-sb-fluid (declaim (freeze-type logical-pathname logical-host))
 \f
-;;;; PHYSICAL-HOST stuff
-
-(def!struct (unix-host
-             (:make-load-form-fun make-unix-host-load-form)
-             (:include host
-                       (parse #'parse-unix-namestring)
-                       (parse-native #'parse-native-unix-namestring)
-                       (unparse #'unparse-unix-namestring)
-                       (unparse-native #'unparse-native-unix-namestring)
-                       (unparse-host #'unparse-unix-host)
-                       (unparse-directory #'unparse-physical-directory)
-                       (unparse-file #'unparse-unix-file)
-                       (unparse-enough #'unparse-unix-enough)
-                       (unparse-directory-separator "/")
-                       (simplify-namestring #'simplify-unix-namestring)
-                       (customary-case :lower))))
-(defvar *unix-host* (make-unix-host))
-(defun make-unix-host-load-form (host)
-  (declare (ignore host))
-  '*unix-host*)
-
-(def!struct (win32-host
-             (:make-load-form-fun make-win32-host-load-form)
-             (:include host
-                       (parse #'parse-win32-namestring)
-                       (parse-native #'parse-native-win32-namestring)
-                       (unparse #'unparse-win32-namestring)
-                       (unparse-native #'unparse-native-win32-namestring)
-                       (unparse-host #'unparse-win32-host)
-                       (unparse-directory #'unparse-physical-directory)
-                       (unparse-file #'unparse-win32-file)
-                       (unparse-enough #'unparse-win32-enough)
-                       (unparse-directory-separator "\\")
-                       (simplify-namestring #'simplify-win32-namestring)
-                       (customary-case :lower))))
-(defparameter *win32-host* (make-win32-host))
-(defun make-win32-host-load-form (host)
-  (declare (ignore host))
-  '*win32-host*)
+;;; To be initialized in unix/win32-pathname.lisp
+(defvar *physical-host*)
 
-(defvar *physical-host*
-  #!-win32 *unix-host*
-  #!+win32 *win32-host*)
+(defun make-host-load-form (host)
+  (declare (ignore host))
+  '*physical-host*)
 
 ;;; Return a value suitable, e.g., for preinitializing
 ;;; *DEFAULT-PATHNAME-DEFAULTS* before *DEFAULT-PATHNAME-DEFAULTS* is
@@ -278,7 +241,7 @@
                               (%pathname-name pathname2))
            (compare-component (%pathname-type pathname1)
                               (%pathname-type pathname2))
-           (or (eq (%pathname-host pathname1) *unix-host*)
+           (or (eq (%pathname-host pathname1) *physical-host*)
                (compare-component (%pathname-version pathname1)
                                   (%pathname-version pathname2))))))
 
@@ -1293,7 +1256,7 @@ unspecified elements into a completed to-pathname based on the to-wildname."
                (frob %pathname-directory translate-directories)
                (frob %pathname-name)
                (frob %pathname-type)
-               (if (eq from-host *unix-host*)
+               (if (eq from-host *physical-host*)
                    (if (or (eq (%pathname-version to) :wild)
                            (eq (%pathname-version to) nil))
                        (%pathname-version source)

diff --git a/src/code/unix-pathname.lisp b/src/code/unix-pathname.lisp
index 7393052..48ebabe 100644 (file)
--- a/src/code/unix-pathname.lisp
+++ b/src/code/unix-pathname.lisp
@@ -11,6 +11,23 @@
 
 (in-package "SB!IMPL")
 
+(def!struct (unix-host
+             (:make-load-form-fun make-host-load-form)
+             (:include host
+                       (parse #'parse-unix-namestring)
+                       (parse-native #'parse-native-unix-namestring)
+                       (unparse #'unparse-unix-namestring)
+                       (unparse-native #'unparse-native-unix-namestring)
+                       (unparse-host #'unparse-unix-host)
+                       (unparse-directory #'unparse-physical-directory)
+                       (unparse-file #'unparse-unix-file)
+                       (unparse-enough #'unparse-unix-enough)
+                       (unparse-directory-separator "/")
+                       (simplify-namestring #'simplify-unix-namestring)
+                       (customary-case :lower))))
+
+(defvar *physical-host* (make-unix-host))
+
 ;;; Take a string and return a list of cons cells that mark the char
 ;;; separated subseq. The first value is true if absolute directories
 ;;; location.

diff --git a/src/code/win32-pathname.lisp b/src/code/win32-pathname.lisp
index 5cfa995..169f384 100644 (file)
--- a/src/code/win32-pathname.lisp
+++ b/src/code/win32-pathname.lisp
@@ -11,6 +11,24 @@
 
 (in-package "SB!IMPL")
 
+(def!struct (win32-host
+             (:make-load-form-fun make-host-load-form)
+             (:include host
+                       (parse #'parse-win32-namestring)
+                       (parse-native #'parse-native-win32-namestring)
+                       (unparse #'unparse-win32-namestring)
+                       (unparse-native #'unparse-native-win32-namestring)
+                       (unparse-host #'unparse-win32-host)
+                       (unparse-directory #'unparse-physical-directory)
+                       (unparse-file #'unparse-win32-file)
+                       (unparse-enough #'unparse-win32-enough)
+                       (unparse-directory-separator "\\")
+                       (simplify-namestring #'simplify-win32-namestring)
+                       (customary-case :lower))))
+
+(defvar *physical-host* (make-win32-host))
+
+;;;
 (define-symbol-macro +long-file-name-prefix+ (quote "\\\\?\\"))
 (define-symbol-macro +unc-file-name-prefix+ (quote "\\\\?\\UNC"))