From 9de65d498a9da0c70a60ea2bf9b5af39aaffe55d Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 6 Nov 2013 21:20:21 +0400 Subject: [PATCH] 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. --- build-order.lisp-expr | 6 +++-- src/code/filesys.lisp | 6 ++--- src/code/target-pathname.lisp | 51 ++++++----------------------------------- src/code/unix-pathname.lisp | 17 ++++++++++++++ src/code/win32-pathname.lisp | 18 +++++++++++++++ 5 files changed, 48 insertions(+), 50 deletions(-) diff --git a/build-order.lisp-expr b/build-order.lisp-expr index f86669b..c6b35e8 100644 --- 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 --- 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 --- 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)) -;;;; 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 --- 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 --- 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")) -- 1.7.10.4