From 77a4f4461d5bb316e06e195bd1716bd8eaeeda78 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 28 Jan 2013 14:52:12 -0500
Subject: [PATCH] 2.26.160: fix getcwd for cmucl

Also, separate filesystem access functions from pathname object munging.
---
 Makefile                          |  14 +-
 asdf-driver.asd                   |   9 +-
 asdf.asd                          |   2 +-
 configuration.lisp                |   2 +-
 driver.lisp                       |   4 +-
 filesystem.lisp                   | 448 +++++++++++++++++++++++++
 header.lisp                       |   2 +-
 lisp-build.lisp                   |   7 +-
 os.lisp                           |  40 ++-
 pathname.lisp                     | 537 +++---------------------------
 run-program.lisp                  |   2 +-
 stream.lisp                       |   2 +-
 test/test-system-pathnames.script |   2 -
 upgrade.lisp                      |   2 +-
 version.lisp-expr                 |   2 +-
 15 files changed, 549 insertions(+), 526 deletions(-)
 create mode 100644 filesystem.lisp

diff --git a/Makefile b/Makefile
index fc21e14c4..e00afdf5c 100644
--- a/Makefile
+++ b/Makefile
@@ -42,7 +42,7 @@ XCL ?= xcl
 # website, tag, install
 
 header_lisp := header.lisp
-driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
+driver_lisp := package.lisp common-lisp.lisp utility.lisp os.lisp pathname.lisp filesystem.lisp stream.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
 defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
 
 # Making ASDF itself should be our first, default, target:
@@ -51,11 +51,19 @@ build/asdf.lisp: $(wildcard *.lisp)
 	cat $(header_lisp) $(driver_lisp) $(defsystem_lisp) > $@
 
 # This quickly locates such mistakes as unbalanced parentheses:
-load: build/asdf.lisp
-	rlwrap sbcl \
+load: load-in-sbcl
+
+load-in-sbcl: build/asdf.lisp
+	rlwrap sbcl --eval '(setf *load-verbose* t *compile-verbose* t)' \
 	`for i in $(driver_lisp) $(defsystem_lisp) ; do echo --load $$i ; done` \
 	--eval '(in-package :asdf)'
 
+load-in-cmucl: build/asdf.lisp
+	rlwrap cmucl -eval '(setf *load-verbose* t *compile-verbose* t *gc-verbose* nil)' \
+	`for i in $(driver_lisp) $(defsystem_lisp) ; do echo -load $$i ; done` \
+	-eval '(in-package :asdf)'
+
+
 install: archive-copy
 
 bump: bump-version
diff --git a/asdf-driver.asd b/asdf-driver.asd
index aa3d0780d..93ea577a2 100644
--- a/asdf-driver.asd
+++ b/asdf-driver.asd
@@ -2,7 +2,9 @@
 (in-package :asdf)
 
 (defun call-without-redefinition-warnings (thunk)
-  (handler-bind (#+clozure (ccl:compiler-warning #'muffle-warning))
+  (handler-bind ((or #+clozure ccl:compiler-warning
+                     #+cmu kernel:simple-style-warning)
+                 #'muffle-warning)
     (funcall thunk)))
 
 (defsystem :asdf-driver
@@ -20,8 +22,9 @@ that you can't portably construct a complete program without using them."
    (:file "common-lisp" :depends-on ("package"))
    (:file "utility" :depends-on ("common-lisp"))
    (:file "os" :depends-on ("utility"))
-   (:file "pathname" :depends-on ("os"))
-   (:file "stream" :depends-on ("pathname"))
+   (:file "pathname" :depends-on ("utility"))
+   (:file "filesystem" :depends-on ("os" "pathname"))
+   (:file "stream" :depends-on ("filesystem"))
    (:file "image" :depends-on ("stream"))
    (:file "run-program" :depends-on ("stream"))
    (:file "lisp-build" :depends-on ("image"))
diff --git a/asdf.asd b/asdf.asd
index 29665831a..755252d8e 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -62,7 +62,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.159" ;; to be automatically updated by make bump-version
+  :version "2.26.160" ;; to be automatically updated by make bump-version
   :depends-on ()
   #+asdf3 :encoding #+asdf3 :utf-8
   ;; For most purposes, asdf itself specially counts as a builtin system.
diff --git a/configuration.lisp b/configuration.lisp
index b4dccd9ae..59b6ff9f0 100644
--- a/configuration.lisp
+++ b/configuration.lisp
@@ -4,7 +4,7 @@
 (asdf/package:define-package :asdf/configuration
   (:recycle :asdf/configuration :asdf)
   (:use :asdf/common-lisp :asdf/utility
-   :asdf/pathname :asdf/stream :asdf/os :asdf/image)
+   :asdf/os :asdf/pathname :asdf/filesystem :asdf/stream :asdf/image)
   (:export
    #:get-folder-path
    #:user-configuration-directories #:system-configuration-directories
diff --git a/driver.lisp b/driver.lisp
index 950ed7c9d..48334b9ef 100644
--- a/driver.lisp
+++ b/driver.lisp
@@ -4,13 +4,13 @@
 (asdf/package:define-package :asdf/driver
   (:nicknames :d :asdf-driver :asdf-utils)
   (:use :asdf/common-lisp :asdf/package :asdf/utility
-   :asdf/pathname :asdf/stream :asdf/os :asdf/image
+    :asdf/os :asdf/pathname :asdf/stream :asdf/filesystem :asdf/image
    :asdf/run-program :asdf/lisp-build
    :asdf/configuration :asdf/backward-driver)
   (:reexport
    ;; NB: excluding asdf/common-lisp
    ;; which include all of CL with compatibility modifications on select platforms.
    :asdf/package :asdf/utility
-   :asdf/pathname :asdf/stream :asdf/os :asdf/image
+    :asdf/os :asdf/pathname :asdf/stream :asdf/filesystem :asdf/image
    :asdf/run-program :asdf/lisp-build
    :asdf/configuration :asdf/backward-driver))
diff --git a/filesystem.lisp b/filesystem.lisp
new file mode 100644
index 000000000..fd8cf7de3
--- /dev/null
+++ b/filesystem.lisp
@@ -0,0 +1,448 @@
+;;;; -------------------------------------------------------------------------
+;;;; Portability layer around Common Lisp filesystem access
+
+(asdf/package:define-package :asdf/filesystem
+  (:recycle :asdf/pathname :asdf)
+  (:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os :asdf/pathname)
+  (:export
+   ;; Native namestrings
+   #:native-namestring #:parse-native-namestring
+   ;; Probing the filesystem
+   #:truename* #:safe-file-write-date #:probe-file*
+   #:directory* #:filter-logical-directory-results #:directory-files #:subdirectories
+   #:collect-sub*directories
+   ;; Resolving symlinks somewhat
+   #:truenamize #:resolve-symlinks #:*resolve-symlinks* #:resolve-symlinks*
+   ;; merging with cwd
+   #:get-pathname-defaults #:call-with-current-directory #:with-current-directory
+   ;; Environment pathnames
+   #:inter-directory-separator #:split-native-pathnames-string
+   #:getenv-pathname #:getenv-pathnames
+   #:getenv-absolute-directory #:getenv-absolute-directories
+   #:lisp-implementation-directory #:lisp-implementation-pathname-p))
+(in-package :asdf/filesystem)
+
+;;; Native namestrings, as seen by the operating system calls rather than Lisp
+(defun* native-namestring (x)
+  "From a non-wildcard CL pathname, a return namestring suitable for passing to the operating system"
+  (when x
+    (let ((p (pathname x)))
+      #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978
+      #+(or cmu scl) (ext:unix-namestring p nil)
+      #+sbcl (sb-ext:native-namestring p)
+      #-(or clozure cmu sbcl scl)
+      (if (os-unix-p) (unix-namestring p)
+          (namestring p)))))
+
+(defun* parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys)
+  "From a native namestring suitable for use by the operating system, return
+a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
+  (check-type string (or string null))
+  (let* ((pathname
+           (when string
+             (with-pathname-defaults ()
+               #+clozure (ccl:native-to-pathname string)
+               #+sbcl (sb-ext:parse-native-namestring string)
+               #-(or clozure sbcl)
+               (if (os-unix-p)
+                   (parse-unix-namestring string :ensure-directory ensure-directory)
+                   (parse-namestring string)))))
+         (pathname
+           (if ensure-directory
+               (and pathname (ensure-directory-pathname pathname))
+               pathname)))
+    (apply 'ensure-pathname pathname constraints)))
+
+
+;;; Probing the filesystem
+(defun* truename* (p)
+  ;; avoids both logical-pathname merging and physical resolution issues
+  (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil))))
+
+(defun* safe-file-write-date (pathname)
+  ;; If FILE-WRITE-DATE returns NIL, it's possible that
+  ;; the user or some other agent has deleted an input file.
+  ;; Also, generated files will not exist at the time planning is done
+  ;; and calls compute-action-stamp which calls safe-file-write-date.
+  ;; So it is very possible that we can't get a valid file-write-date,
+  ;; and we can survive and we will continue the planning
+  ;; as if the file were very old.
+  ;; (or should we treat the case in a different, special way?)
+  (handler-case (file-write-date pathname) (file-error () nil)))
+
+(defun* probe-file* (p &key truename)
+  "when given a pathname P (designated by a string as per PARSE-NAMESTRING),
+probes the filesystem for a file or directory with given pathname.
+If it exists, return its truename is ENSURE-PATHNAME is true,
+or the original (parsed) pathname if it is false (the default)."
+  (with-pathname-defaults () ;; avoids logical-pathname issues on some implementations
+    (etypecase p
+      (null nil)
+      (string (probe-file* (parse-namestring p) :truename truename))
+      (pathname
+       (handler-case
+           (or
+            #+allegro
+            (probe-file p :follow-symlinks truename)
+            #-(or allegro clisp gcl2.6)
+            (if truename
+                (probe-file p)
+                (and (ignore-errors
+                      #+(or cmu scl) (unix:unix-stat (ext:unix-namestring (translate-logical-pathname p)))
+                      #+(and lispworks unix) (system:get-file-stat p)
+                      #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring (translate-logical-pathname p)))
+                      #-(or cmu (and lispworks unix) sbcl scl)
+                      (file-write-date p))
+                     p))
+            #+(or clisp gcl2.6)
+            #.(flet ((probe (probe)
+                       `(let ((foundtrue ,probe))
+                          (cond
+                            (truename foundtrue)
+                            (foundtrue p)))))
+                #+gcl2.6
+                (probe '(or (probe-file p)
+                         (and (directory-pathname-p p)
+                          (ignore-errors
+                           (ensure-directory-pathname
+                            (truename* (subpathname
+                                        (ensure-directory-pathname p) ".")))))))
+                #+clisp
+                (let* ((fs (find-symbol* '#:file-stat :posix nil))
+                       (pp (find-symbol* '#:probe-pathname :ext nil))
+                       (resolve (if pp
+                                    `(ignore-errors (,pp p))
+                                    '(or (truename* p)
+                                      (truename* (ignore-errors (ensure-directory-pathname p)))))))
+                  (if fs
+                      `(if truename
+                           ,resolve
+                           (and (ignore-errors (,fs p)) p))
+                      (probe resolve)))))
+         (file-error () nil))))))
+
+(defun* directory* (pathname-spec &rest keys &key &allow-other-keys)
+  (apply 'directory pathname-spec
+         (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
+                             #+clozure '(:follow-links nil)
+                             #+clisp '(:circle t :if-does-not-exist :ignore)
+                             #+(or cmu scl) '(:follow-links nil :truenamep nil)
+                             #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
+                                      '(:resolve-symlinks nil))))))
+
+(defun* filter-logical-directory-results (directory entries merger)
+  (if (logical-pathname-p directory)
+      ;; Try hard to not resolve logical-pathname into physical pathnames;
+      ;; otherwise logical-pathname users/lovers will be disappointed.
+      ;; If directory* could use some implementation-dependent magic,
+      ;; we will have logical pathnames already; otherwise,
+      ;; we only keep pathnames for which specifying the name and
+      ;; translating the LPN commute.
+      (loop :for f :in entries
+        :for p = (or (and (logical-pathname-p f) f)
+                     (let* ((u (ignore-errors (funcall merger f))))
+                       ;; The first u avoids a cumbersome (truename u) error.
+                       ;; At this point f should already be a truename,
+                       ;; but isn't quite in CLISP, for it doesn't have :version :newest
+                       (and u (equal (truename* u) (truename* f)) u)))
+        :when p :collect p)
+      entries))
+
+(defun* directory-files (directory &optional (pattern *wild-file*))
+  (let ((dir (pathname directory)))
+    (when (logical-pathname-p dir)
+      ;; Because of the filtering we do below,
+      ;; logical pathnames have restrictions on wild patterns.
+      ;; Not that the results are very portable when you use these patterns on physical pathnames.
+      (when (wild-pathname-p dir)
+        (error "Invalid wild pattern in logical directory ~S" directory))
+      (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)
+        (error "Invalid file pattern ~S for logical directory ~S" pattern directory))
+      (setf pattern (make-pathname-logical pattern (pathname-host dir))))
+    (let ((entries (ignore-errors (directory* (merge-pathnames* pattern dir)))))
+      (filter-logical-directory-results
+       directory entries
+       #'(lambda (f)
+           (make-pathname :defaults dir
+                          :name (make-pathname-component-logical (pathname-name f))
+                          :type (make-pathname-component-logical (pathname-type f))
+                          :version (make-pathname-component-logical (pathname-version f))))))))
+
+(defun* subdirectories (directory)
+  (let* ((directory (ensure-directory-pathname directory))
+         #-(or abcl cormanlisp genera xcl)
+         (wild (merge-pathnames*
+                #-(or abcl allegro cmu lispworks sbcl scl xcl)
+                *wild-directory*
+                #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*"
+                directory))
+         (dirs
+          #-(or abcl cormanlisp genera xcl)
+          (ignore-errors
+            (directory* wild . #.(or #+clozure '(:directories t :files nil)
+                                     #+mcl '(:directories t))))
+          #+(or abcl xcl) (system:list-directory directory)
+          #+cormanlisp (cl::directory-subdirs directory)
+          #+genera (fs:directory-list directory))
+         #+(or abcl allegro cmu genera lispworks sbcl scl xcl)
+         (dirs (loop :for x :in dirs
+                 :for d = #+(or abcl xcl) (extensions:probe-directory x)
+                          #+allegro (excl:probe-directory x)
+                          #+(or cmu sbcl scl) (directory-pathname-p x)
+                          #+genera (getf (cdr x) :directory)
+                          #+lispworks (lw:file-directory-p x)
+                 :when d :collect #+(or abcl allegro xcl) d
+                                  #+genera (ensure-directory-pathname (first x))
+                                  #+(or cmu lispworks sbcl scl) x)))
+    (filter-logical-directory-results
+     directory dirs
+     (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory))
+                       '(:absolute)))) ; because allegro returns NIL for #p"FOO:"
+       #'(lambda (d)
+           (let ((dir (normalize-pathname-directory-component (pathname-directory d))))
+             (and (consp dir) (consp (cdr dir))
+                  (make-pathname
+                   :defaults directory :name nil :type nil :version nil
+                   :directory (append prefix (make-pathname-component-logical (last dir)))))))))))
+
+(defun* collect-sub*directories (directory collectp recursep collector)
+  (when (funcall collectp directory)
+    (funcall collector directory))
+  (dolist (subdir (subdirectories directory))
+    (when (funcall recursep subdir)
+      (collect-sub*directories subdir collectp recursep collector))))
+
+;;; Resolving symlinks somewhat
+(defun* truenamize (pathname)
+  "Resolve as much of a pathname as possible"
+  (block nil
+    (when (typep pathname '(or null logical-pathname)) (return pathname))
+    (let ((p pathname))
+      (unless (absolute-pathname-p p)
+        (setf p (or (absolute-pathname-p (ensure-pathname-absolute p 'get-pathname-defaults nil))
+                    (return p))))
+      (when (logical-pathname-p p) (return p))
+      (let ((found (probe-file* p :truename t)))
+        (when found (return found)))
+      (let* ((directory (normalize-pathname-directory-component (pathname-directory p)))
+             (up-components (reverse (rest directory)))
+             (down-components ()))
+        (assert (eq :absolute (first directory)))
+        (loop :while up-components :do
+          (if-let (parent (probe-file* (make-pathname* :directory `(:absolute ,@(reverse up-components))
+                                                       :name nil :type nil :version nil :defaults p)))
+            (return (merge-pathnames* (make-pathname* :directory `(:relative ,@down-components)
+                                                      :defaults p)
+                                      (ensure-directory-pathname parent)))
+            (push (pop up-components) down-components))
+          :finally (return p))))))
+
+(defun* resolve-symlinks (path)
+  #-allegro (truenamize path)
+  #+allegro
+  (if (physical-pathname-p path)
+      (or (ignore-errors (excl:pathname-resolve-symbolic-links path)) path)
+      path))
+
+(defvar *resolve-symlinks* t
+  "Determine whether or not ASDF resolves symlinks when defining systems.
+Defaults to T.")
+
+(defun* resolve-symlinks* (path)
+  (if *resolve-symlinks*
+      (and path (resolve-symlinks path))
+      path))
+
+
+;;; Check pathname constraints
+
+(defun* ensure-pathname
+    (pathname &key
+              on-error
+              defaults type dot-dot
+              want-pathname
+              want-logical want-physical ensure-physical
+              want-relative want-absolute ensure-absolute ensure-subpath
+              want-non-wild want-wild wilden
+              want-file want-directory ensure-directory
+              want-existing ensure-directories-exist
+              truename resolve-symlinks truenamize
+              &aux (p pathname)) ;; mutable working copy, preserve original
+  "Coerces its argument into a PATHNAME,
+optionally doing some transformations and checking specified constraints.
+
+If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified.
+
+If the argument is a STRING, it is first converted to a pathname via PARSE-UNIX-NAMESTRING
+reusing the keywords DEFAULTS TYPE DOT-DOT ENSURE-DIRECTORY WANT-RELATIVE;
+then the result is optionally merged into the DEFAULTS if ENSURE-ABSOLUTE is true,
+and the all the checks and transformations are run.
+
+Each non-nil constraint argument can be one of the symbols T, ERROR, CERROR or IGNORE.
+The boolean T is an alias for ERROR.
+ERROR means that an error will be raised if the constraint is not satisfied.
+CERROR means that an continuable error will be raised if the constraint is not satisfied.
+IGNORE means just return NIL instead of the pathname.
+
+The ON-ERROR argument, if not NIL, is a function designator (as per CALL-FUNCTION)
+that will be called with the the following arguments:
+a generic format string for ensure pathname, the pathname,
+the keyword argument corresponding to the failed check or transformation,
+a format string for the reason ENSURE-PATHNAME failed,
+and a list with arguments to that format string.
+If ON-ERROR is NIL, ERROR is used instead, which does the right thing.
+You could also pass (CERROR \"CONTINUE DESPITE FAILED CHECK\").
+
+The transformations and constraint checks are done in this order,
+which is also the order in the lambda-list:
+
+WANT-PATHNAME checks that pathname (after parsing if needed) is not null.
+Otherwise, if the pathname is NIL, ensure-pathname returns NIL.
+WANT-LOGICAL checks that pathname is a LOGICAL-PATHNAME
+WANT-PHYSICAL checks that pathname is not a LOGICAL-PATHNAME
+ENSURE-PHYSICAL ensures that pathname is physical via TRANSLATE-LOGICAL-PATHNAME
+WANT-RELATIVE checks that pathname has a relative directory component
+WANT-ABSOLUTE checks that pathname does have an absolute directory component
+ENSURE-ABSOLUTE merges with the DEFAULTS, then checks again
+that the result absolute is an absolute pathname indeed.
+ENSURE-SUBPATH checks that the pathname is a subpath of the DEFAULTS.
+WANT-FILE checks that pathname has a non-nil FILE component
+WANT-DIRECTORY checks that pathname has nil FILE and TYPE components
+ENSURE-DIRECTORY uses ENSURE-DIRECTORY-PATHNAME to interpret
+any file and type components as being actually a last directory component.
+WANT-NON-WILD checks that pathname is not a wild pathname
+WANT-WILD checks that pathname is a wild pathname
+WILDEN merges the pathname with **/*.*.* if it is not wild
+WANT-EXISTING checks that a file (or directory) exists with that pathname.
+ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST.
+TRUENAME replaces the pathname by its truename, or errors if not possible.
+RESOLVE-SYMLINKS replaces the pathname by a variant with symlinks resolved by RESOLVE-SYMLINKS.
+TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
+  (block nil
+    (flet ((report-error (keyword description &rest arguments)
+             (call-function (or on-error 'error)
+                            "Invalid pathname ~S: ~*~?"
+                            pathname keyword description arguments)))
+      (macrolet ((err (constraint &rest arguments)
+                   `(report-error ',(intern* constraint :keyword) ,@arguments))
+                 (check (constraint condition &rest arguments)
+                   `(when ,constraint
+                      (unless ,condition (err ,constraint ,@arguments))))
+                 (transform (transform condition expr)
+                   `(when ,transform
+                      (,@(if condition `(when ,condition) '(progn))
+                       (setf p ,expr)))))
+        (etypecase p
+          ((or null pathname))
+          (string
+           (setf p (parse-unix-namestring
+                    p :defaults defaults :type type :dot-dot dot-dot
+                    :ensure-directory ensure-directory :want-relative want-relative))))
+        (check want-pathname (pathnamep p) "Expected a pathname, not NIL")
+        (unless (pathnamep p) (return nil))
+        (check want-logical (logical-pathname-p p) "Expected a logical pathname")
+        (check want-physical (physical-pathname-p p) "Expected a physical pathname")
+        (transform ensure-physical () (translate-logical-pathname p))
+        (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
+        (check want-relative (relative-pathname-p p) "Expected a relative pathname")
+        (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname")
+        (transform ensure-absolute (not (absolute-pathname-p p)) (merge-pathnames* p defaults))
+        (check ensure-absolute (absolute-pathname-p p)
+               "Could not make into an absolute pathname even after merging with ~S" defaults)
+        (check ensure-subpath (absolute-pathname-p defaults)
+               "cannot be checked to be a subpath of non-absolute pathname ~S" defaults)
+        (check ensure-subpath (subpathp p defaults) "is not a sub pathname of ~S" defaults)
+        (check want-file (file-pathname-p p) "Expected a file pathname")
+        (check want-directory (directory-pathname-p p) "Expected a directory pathname")
+        (transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p))
+        (check want-non-wild (not (wild-pathname-p p)) "Expected a non-wildcard pathname")
+        (check want-wild (wild-pathname-p p) "Expected a wildcard pathname")
+        (transform wilden (not (wild-pathname-p p)) (wilden p))
+        (when want-existing
+          (let ((existing (probe-file* p :truename truename)))
+            (if existing
+                (when truename
+                  (return existing))
+                (err want-existing "Expected an existing pathname"))))
+        (when ensure-directories-exist (ensure-directories-exist p))
+        (when truename
+          (let ((truename (truename* p)))
+            (if truename
+                (return truename)
+                (err truename "Can't get a truename for pathname"))))
+        (transform resolve-symlinks () (resolve-symlinks p))
+        (transform truenamize () (truenamize p))
+        p))))
+
+
+;;; Pathname defaults
+(defun* get-pathname-defaults (&optional (defaults *default-pathname-defaults*))
+  (or (absolute-pathname-p defaults)
+      (merge-pathnames* defaults (getcwd))))
+
+(defun* call-with-current-directory (dir thunk)
+  (if dir
+      (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir))))
+             (*default-pathname-defaults* dir)
+             (cwd (getcwd)))
+        (chdir dir)
+        (unwind-protect
+             (funcall thunk)
+          (chdir cwd)))
+      (funcall thunk)))
+
+(defmacro with-current-directory ((&optional dir) &body body)
+  "Call BODY while the POSIX current working directory is set to DIR"
+  `(call-with-current-directory ,dir #'(lambda () ,@body)))
+
+
+;;; Environment pathnames
+(defun* inter-directory-separator ()
+  (if (os-unix-p) #\: #\;))
+
+(defun* split-native-pathnames-string (string &rest constraints &key &allow-other-keys)
+  (loop :for namestring :in (split-string string :separator (string (inter-directory-separator)))
+        :collect (apply 'parse-native-namestring namestring constraints)))
+
+(defun* getenv-pathname (x &rest constraints &key on-error &allow-other-keys)
+  (apply 'parse-native-namestring (getenvp x)
+         :on-error (or on-error
+                       `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathname ,x))
+         constraints))
+(defun* getenv-pathnames (x &rest constraints &key on-error &allow-other-keys)
+  (apply 'split-native-pathnames-string (getenvp x)
+         :on-error (or on-error
+                       `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x))
+         constraints))
+(defun* getenv-absolute-directory (x)
+  (getenv-pathname x :want-absolute t :ensure-directory t))
+(defun* getenv-absolute-directories (x)
+  (getenv-pathnames x :want-absolute t :ensure-directory t))
+
+(defun* lisp-implementation-directory (&key truename)
+  (declare (ignorable truename))
+  #+(or clozure ecl gcl mkcl sbcl)
+  (let ((dir
+          (ignore-errors
+           #+clozure #p"ccl:"
+           #+(or ecl mkcl) #p"SYS:"
+           #+gcl system::*system-directory*
+           #+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil))
+                     (funcall it)
+                     (getenv-pathname "SBCL_HOME" :ensure-directory t)))))
+    (if (and dir truename)
+        (truename* dir)
+        dir)))
+
+(defun* lisp-implementation-pathname-p (pathname)
+  ;; Other builtin systems are those under the implementation directory
+  (and (when pathname
+         (if-let (impdir (lisp-implementation-directory))
+           (or (subpathp pathname impdir)
+               (when *resolve-symlinks*
+                 (if-let (truename (truename* pathname))
+                   (if-let (trueimpdir (truename* impdir))
+                     (subpathp truename trueimpdir)))))))
+       t))
+
+
diff --git a/header.lisp b/header.lisp
index 725ef3a8f..495ab43f8 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 2.26.159: Another System Definition Facility.
+;;; This is ASDF 2.26.160: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/lisp-build.lisp b/lisp-build.lisp
index c9d750a33..698841266 100644
--- a/lisp-build.lisp
+++ b/lisp-build.lisp
@@ -84,13 +84,15 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
 
 (defvar *uninteresting-compiler-conditions*
   (append
+   ;;#+clozure '(ccl:compiler-warning)
+   #+cmu '("Deleting unreachable code.")
    #+sbcl
-   `(sb-c::simple-compiler-note
+   '(sb-c::simple-compiler-note
      "&OPTIONAL and &KEY found in the same lambda list: ~S"
      sb-int:package-at-variance
      sb-kernel:uninteresting-redefinition
      sb-kernel:undefined-alien-style-warning
-     ;; sb-ext:implicit-generic-function-warning ; controversial, but let's allow it by default.
+     ;; sb-ext:implicit-generic-function-warning ; Controversial. Let's allow it by default.
      sb-kernel:lexical-environment-too-complex
      sb-grovel-unknown-constant-condition ; defined above.
      ;; BEWARE: the below four are controversial to include here.
@@ -98,7 +100,6 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
      sb-kernel:redefinition-with-defgeneric
      sb-kernel:redefinition-with-defmethod
      sb-kernel::redefinition-with-defmacro) ; not exported by old SBCLs
-   ;;#+clozure '(ccl:compiler-warning)
    '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.")) ;; from closer2mop
   "Conditions that may be skipped while compiling")
 
diff --git a/os.lisp b/os.lisp
index 7d2a91831..c800baaa9 100644
--- a/os.lisp
+++ b/os.lisp
@@ -194,6 +194,12 @@ then returning the non-empty string value of the variable"
 
 
 ;;; Current directory
+#+(or cmu scl)
+(defun* parse-unix-namestring* (unix-namestring)
+  (multiple-value-bind (host device directory name type version)
+      (lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring))
+    (make-pathname :host (or host #+cmu lisp::*unix-host*) :device device
+                   :directory directory :name name :type type :version version)))
 
 (defun* getcwd ()
   "Get the current working directory as per POSIX getcwd(3), as a pathname object"
@@ -202,8 +208,8 @@ then returning the non-empty string value of the variable"
       #+allegro (excl::current-directory)
       #+clisp (ext:default-directory)
       #+clozure (ccl:current-directory)
-      #+(or cmu scl) (ext:parse-unix-namestring
-                      (nth-value 1 (unix:unix-current-directory)) :ensure-directory t)
+      #+(or cmu scl) (parse-unix-namestring*
+                      (strcat (nth-value 1 (unix:unix-current-directory)) "/"))
       #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
       #+ecl (ext:getcwd)
       #+gcl (parse-namestring ;; this is a joke. Isn't there a better way?
@@ -216,21 +222,21 @@ then returning the non-empty string value of the variable"
       (error "getcwd not supported on your implementation")))
 
 (defun* chdir (x)
-  "Change current directory, as per POSIX chdir(2)"
-  (declare (ignorable x))
-  (or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x))
-      #+allegro (excl:chdir x)
-      #+clisp (ext:cd x)
-      #+clozure (setf (ccl:current-directory) x)
-      #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x))
-      #+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
-                     (error "Could not set current directory to ~A" x))
-      #+ecl (ext:chdir x)
-      #+genera (setf *default-pathname-defaults* (pathname x))
-      #+lispworks (hcl:change-directory x)
-      #+mkcl (mk-ext:chdir x)
-      #+sbcl (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))
-      (error "chdir not supported on your implementation")))
+  "Change current directory, as per POSIX chdir(2), to a given pathname object"
+  (if-let (x (pathname x))
+    (or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x))
+        #+allegro (excl:chdir x)
+        #+clisp (ext:cd x)
+        #+clozure (setf (ccl:current-directory) x)
+        #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x))
+        #+cormanlisp (unless (zerop (win32::_chdir (namestring x)))
+                       (error "Could not set current directory to ~A" x))
+        #+ecl (ext:chdir x)
+        #+genera (setf *default-pathname-defaults* x)
+        #+lispworks (hcl:change-directory x)
+        #+mkcl (mk-ext:chdir x)
+        #+sbcl (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))
+        (error "chdir not supported on your implementation"))))
 
 
 ;;;; -----------------------------------------------------------------
diff --git a/pathname.lisp b/pathname.lisp
index d5287d420..30c64c607 100644
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -1,66 +1,44 @@
 ;;;; -------------------------------------------------------------------------
 ;;;; Portability layer around Common Lisp pathnames
+;; This layer allows for portable manipulation of pathname objects themselves,
+;; which all is necessary prior to any access the filesystem or environment.
 
 (asdf/package:define-package :asdf/pathname
   (:recycle :asdf/pathname :asdf)
-  (:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os)
+  (:use :asdf/common-lisp :asdf/package :asdf/utility)
   (:export
-   #:*resolve-symlinks*
-   ;; Making pathnames, portably
+   ;; Making and merging pathnames, portably
    #:normalize-pathname-directory-component #:denormalize-pathname-directory-component
    #:merge-pathname-directory-components #:*unspecific-pathname-type* #:make-pathname*
    #:make-pathname-component-logical #:make-pathname-logical
    #:merge-pathnames*
+   #:nil-pathname #:*nil-pathname* #:with-pathname-defaults
    ;; Predicates
    #:pathname-equal #:logical-pathname-p #:physical-pathname-p
    #:absolute-pathname-p #:relative-pathname-p #:hidden-pathname-p #:file-pathname-p
    ;; Directories
    #:pathname-directory-pathname #:pathname-parent-directory-pathname
    #:directory-pathname-p #:ensure-directory-pathname
-   ;; defaults
-   #:nil-pathname #:with-pathname-defaults #:*nil-pathname*
    ;; Parsing filenames
    #:component-name-to-pathname-components
    #:split-name-type #:parse-unix-namestring #:unix-namestring
    #:split-unix-namestring-directory-components
-   #:native-namestring #:parse-native-namestring
+   ;; Absolute and relative pathnames
    #:subpathname #:subpathname*
-   ;; Wildcard pathnames
-   #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden
-   ;; probe filesystem
-   #:truename* #:safe-file-write-date #:probe-file*
-   #:directory* #:filter-logical-directory-results #:directory-files #:subdirectories
-   #:collect-sub*directories
-   ;; Absolute vs relative pathnames
    #:ensure-pathname-absolute
    #:pathname-root #:pathname-host-pathname
    #:subpathp
-   ;; Resolving symlinks somewhat
-   #:truenamize #:resolve-symlinks #:resolve-symlinks*
    ;; Checking constraints
-   #:ensure-pathname
-   ;; merging with cwd
-   #:get-pathname-defaults #:call-with-current-directory #:with-current-directory
-   ;; Environment pathnames
-   #:inter-directory-separator #:split-native-pathnames-string
-   #:getenv-pathname #:getenv-pathnames
-   #:getenv-absolute-directory #:getenv-absolute-directories
-   #:lisp-implementation-directory #:lisp-implementation-pathname-p
+   #:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints
+   ;; Wildcard pathnames
+   #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden
    ;; Translate a pathname
    #:relativize-directory-component #:relativize-pathname-directory
    #:directory-separator-for-host #:directorize-pathname-host-device
    #:translate-pathname*
    #:*output-translation-function*))
-
 (in-package :asdf/pathname)
 
-;;; User-visible parameters
-(defvar *resolve-symlinks* t
-  "Determine whether or not ASDF resolves symlinks when defining systems.
-
-Defaults to T.")
-
-
 ;;; Normalizing pathnames across implementations
 
 (defun* normalize-pathname-directory-component (directory)
@@ -195,6 +173,23 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
                         :type (funcall unspecific-handler type)
                         :version (funcall unspecific-handler version))))))
 
+(defun* nil-pathname (&optional (defaults *default-pathname-defaults*))
+  "A pathname that is as neutral as possible for use as defaults
+   when merging, making or parsing pathnames"
+  ;; 19.2.2.2.1 says a NIL host can mean a default host;
+  ;; see also "valid physical pathname host" in the CLHS glossary, that suggests
+  ;; strings and lists of strings or :unspecific
+  ;; But CMUCL decides to die on NIL.
+  (make-pathname* :directory nil :name nil :type nil :version nil :device nil
+                  :host (or #+cmu lisp::*unix-host*)
+                  ;; the default shouldn't matter, but we really want something physical
+                  :defaults defaults))
+
+(defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
+
+(defmacro with-pathname-defaults ((&optional defaults) &body body)
+  `(let ((*default-pathname-defaults* ,(or defaults '*nil-pathname*))) ,@body))
+
 
 ;;; Some pathname predicates
 
@@ -321,26 +316,7 @@ actually-existing directory."
                     :name nil :type nil :version nil :defaults pathspec))))
 
 
-;;; defaults
-(defun* nil-pathname (&optional (defaults *default-pathname-defaults*))
-  "A pathname that is as neutral as possible for use as defaults
-   when merging, making or parsing pathnames"
-  ;; 19.2.2.2.1 says a NIL host can mean a default host;
-  ;; see also "valid physical pathname host" in the CLHS glossary, that suggests
-  ;; strings and lists of strings or :unspecific
-  ;; But CMUCL decides to die on NIL.
-  (make-pathname* :directory nil :name nil :type nil :version nil :device nil
-                  :host (or #+cmu lisp::*unix-host*)
-                  ;; the default shouldn't matter, but we really want something physical
-                  :defaults defaults))
-
-(defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
-
-(defmacro with-pathname-defaults ((&optional defaults) &body body)
-  `(let ((*default-pathname-defaults* ,(or defaults '*nil-pathname*))) ,@body))
-
-
-;;; Parsing filenames and lists thereof
+;;; Parsing filenames
 (defun* split-unix-namestring-directory-components
     (unix-namestring &key ensure-directory dot-dot)
   "Splits the path string UNIX-NAMESTRING, returning four values:
@@ -517,36 +493,7 @@ or if it is a PATHNAME but some of its components are not recognized."
              (t
               (or (null type) (err))))))))))
 
-(defun* native-namestring (x)
-  "From a non-wildcard CL pathname, a return namestring suitable for passing to the operating system"
-  (when x
-    (let ((p (pathname x)))
-      #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978
-      #+(or cmu scl) (ext:unix-namestring p nil)
-      #+sbcl (sb-ext:native-namestring p)
-      #-(or clozure cmu sbcl scl)
-      (if (os-unix-p) (unix-namestring p)
-          (namestring p)))))
-
-(defun* parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys)
-  "From a native namestring suitable for use by the operating system, return
-a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
-  (check-type string (or string null))
-  (let* ((pathname
-           (when string
-             (with-pathname-defaults ()
-               #+clozure (ccl:native-to-pathname string)
-               #+sbcl (sb-ext:parse-native-namestring string)
-               #-(or clozure sbcl)
-               (if (os-unix-p)
-                   (parse-unix-namestring string :ensure-directory ensure-directory)
-                   (parse-namestring string)))))
-         (pathname
-           (if ensure-directory
-               (and pathname (ensure-directory-pathname pathname))
-               pathname)))
-    (apply 'ensure-pathname pathname constraints)))
-
+;;; Absolute and relative pathnames
 (defun* subpathname (pathname subpath &key type)
   "This function takes a PATHNAME and a SUBPATH and a TYPE.
 If SUBPATH is already a PATHNAME object (not namestring),
@@ -564,185 +511,6 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
        (subpathname (ensure-directory-pathname pathname) subpath :type type)))
 
 
-;;; Wildcard pathnames
-(defparameter *wild* (or #+cormanlisp "*" :wild))
-(defparameter *wild-directory-component* (or #+gcl2.6 "*" :wild))
-(defparameter *wild-inferiors-component* (or #+gcl2.6 "**" :wild-inferiors))
-(defparameter *wild-file*
-  (make-pathname :directory nil :name *wild* :type *wild*
-                 :version (or #-(or allegro abcl xcl) *wild*)))
-(defparameter *wild-directory*
-  (make-pathname* :directory `(:relative ,*wild-directory-component*)
-                  :name nil :type nil :version nil))
-(defparameter *wild-inferiors*
-  (make-pathname* :directory `(:relative ,*wild-inferiors-component*)
-                  :name nil :type nil :version nil))
-(defparameter *wild-path*
-  (merge-pathnames* *wild-file* *wild-inferiors*))
-
-(defun* wilden (path)
-  (merge-pathnames* *wild-path* path))
-
-
-;;; Probing the filesystem
-(defun* truename* (p)
-  ;; avoids both logical-pathname merging and physical resolution issues
-  (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil))))
-
-(defun* safe-file-write-date (pathname)
-  ;; If FILE-WRITE-DATE returns NIL, it's possible that
-  ;; the user or some other agent has deleted an input file.
-  ;; Also, generated files will not exist at the time planning is done
-  ;; and calls compute-action-stamp which calls safe-file-write-date.
-  ;; So it is very possible that we can't get a valid file-write-date,
-  ;; and we can survive and we will continue the planning
-  ;; as if the file were very old.
-  ;; (or should we treat the case in a different, special way?)
-  (handler-case (file-write-date pathname) (file-error () nil)))
-
-(defun* probe-file* (p &key truename)
-  "when given a pathname P (designated by a string as per PARSE-NAMESTRING),
-probes the filesystem for a file or directory with given pathname.
-If it exists, return its truename is ENSURE-PATHNAME is true,
-or the original (parsed) pathname if it is false (the default)."
-  (with-pathname-defaults () ;; avoids logical-pathname issues on some implementations
-    (etypecase p
-      (null nil)
-      (string (probe-file* (parse-namestring p) :truename truename))
-      (pathname
-       (handler-case
-           (or
-            #+allegro
-            (probe-file p :follow-symlinks truename)
-            #-(or allegro clisp gcl2.6)
-            (if truename
-                (probe-file p)
-                (and (ignore-errors
-                      #+(or cmu scl) (unix:unix-stat (ext:unix-namestring (translate-logical-pathname p)))
-                      #+(and lispworks unix) (system:get-file-stat p)
-                      #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring (translate-logical-pathname p)))
-                      #-(or cmu (and lispworks unix) sbcl scl)
-                      (file-write-date p))
-                     p))
-            #+(or clisp gcl2.6)
-            #.(flet ((probe (probe)
-                       `(let ((foundtrue ,probe))
-                          (cond
-                            (truename foundtrue)
-                            (foundtrue p)))))
-                #+gcl2.6
-                (probe '(or (probe-file p)
-                         (and (directory-pathname-p p)
-                          (ignore-errors
-                           (ensure-directory-pathname
-                            (truename* (subpathname
-                                        (ensure-directory-pathname p) ".")))))))
-                #+clisp
-                (let* ((fs (find-symbol* '#:file-stat :posix nil))
-                       (pp (find-symbol* '#:probe-pathname :ext nil))
-                       (resolve (if pp
-                                    `(ignore-errors (,pp p))
-                                    '(or (truename* p)
-                                      (truename* (ignore-errors (ensure-directory-pathname p)))))))
-                  (if fs
-                      `(if truename
-                           ,resolve
-                           (and (ignore-errors (,fs p)) p))
-                      (probe resolve)))))
-         (file-error () nil))))))
-
-(defun* directory* (pathname-spec &rest keys &key &allow-other-keys)
-  (apply 'directory pathname-spec
-         (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
-                             #+clozure '(:follow-links nil)
-                             #+clisp '(:circle t :if-does-not-exist :ignore)
-                             #+(or cmu scl) '(:follow-links nil :truenamep nil)
-                             #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil)
-                                      '(:resolve-symlinks nil))))))
-
-(defun* filter-logical-directory-results (directory entries merger)
-  (if (logical-pathname-p directory)
-      ;; Try hard to not resolve logical-pathname into physical pathnames;
-      ;; otherwise logical-pathname users/lovers will be disappointed.
-      ;; If directory* could use some implementation-dependent magic,
-      ;; we will have logical pathnames already; otherwise,
-      ;; we only keep pathnames for which specifying the name and
-      ;; translating the LPN commute.
-      (loop :for f :in entries
-        :for p = (or (and (logical-pathname-p f) f)
-                     (let* ((u (ignore-errors (funcall merger f))))
-                       ;; The first u avoids a cumbersome (truename u) error.
-                       ;; At this point f should already be a truename,
-                       ;; but isn't quite in CLISP, for it doesn't have :version :newest
-                       (and u (equal (truename* u) (truename* f)) u)))
-        :when p :collect p)
-      entries))
-
-(defun* directory-files (directory &optional (pattern *wild-file*))
-  (let ((dir (pathname directory)))
-    (when (logical-pathname-p dir)
-      ;; Because of the filtering we do below,
-      ;; logical pathnames have restrictions on wild patterns.
-      ;; Not that the results are very portable when you use these patterns on physical pathnames.
-      (when (wild-pathname-p dir)
-        (error "Invalid wild pattern in logical directory ~S" directory))
-      (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)
-        (error "Invalid file pattern ~S for logical directory ~S" pattern directory))
-      (setf pattern (make-pathname-logical pattern (pathname-host dir))))
-    (let ((entries (ignore-errors (directory* (merge-pathnames* pattern dir)))))
-      (filter-logical-directory-results
-       directory entries
-       #'(lambda (f)
-           (make-pathname :defaults dir
-                          :name (make-pathname-component-logical (pathname-name f))
-                          :type (make-pathname-component-logical (pathname-type f))
-                          :version (make-pathname-component-logical (pathname-version f))))))))
-
-(defun* subdirectories (directory)
-  (let* ((directory (ensure-directory-pathname directory))
-         #-(or abcl cormanlisp genera xcl)
-         (wild (merge-pathnames*
-                #-(or abcl allegro cmu lispworks sbcl scl xcl)
-                *wild-directory*
-                #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*"
-                directory))
-         (dirs
-          #-(or abcl cormanlisp genera xcl)
-          (ignore-errors
-            (directory* wild . #.(or #+clozure '(:directories t :files nil)
-                                     #+mcl '(:directories t))))
-          #+(or abcl xcl) (system:list-directory directory)
-          #+cormanlisp (cl::directory-subdirs directory)
-          #+genera (fs:directory-list directory))
-         #+(or abcl allegro cmu genera lispworks sbcl scl xcl)
-         (dirs (loop :for x :in dirs
-                 :for d = #+(or abcl xcl) (extensions:probe-directory x)
-                          #+allegro (excl:probe-directory x)
-                          #+(or cmu sbcl scl) (directory-pathname-p x)
-                          #+genera (getf (cdr x) :directory)
-                          #+lispworks (lw:file-directory-p x)
-                 :when d :collect #+(or abcl allegro xcl) d
-                                  #+genera (ensure-directory-pathname (first x))
-                                  #+(or cmu lispworks sbcl scl) x)))
-    (filter-logical-directory-results
-     directory dirs
-     (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory))
-                       '(:absolute)))) ; because allegro returns NIL for #p"FOO:"
-       #'(lambda (d)
-           (let ((dir (normalize-pathname-directory-component (pathname-directory d))))
-             (and (consp dir) (consp (cdr dir))
-                  (make-pathname
-                   :defaults directory :name nil :type nil :version nil
-                   :directory (append prefix (make-pathname-component-logical (last dir)))))))))))
-
-(defun* collect-sub*directories (directory collectp recursep collector)
-  (when (funcall collectp directory)
-    (funcall collector directory))
-  (dolist (subdir (subdirectories directory))
-    (when (funcall recursep subdir)
-      (collect-sub*directories subdir collectp recursep collector))))
-
-
 ;;; Pathname host and its root
 (defun* pathname-root (pathname)
   (make-pathname* :directory '(:absolute)
@@ -770,7 +538,7 @@ or the original (parsed) pathname if it is false (the default)."
 (defun* ensure-pathname-absolute (path &optional defaults (on-error 'error))
   (cond
     ((absolute-pathname-p path))
-    ((stringp path) (ensure-pathname-absolute (pathname path) defaults))
+    ((stringp path) (ensure-pathname-absolute (pathname path) defaults on-error))
     ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path))
     ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults))))
        (or (if (absolute-pathname-p default-pathname)
@@ -784,232 +552,24 @@ or the original (parsed) pathname if it is false (the default)."
                       path defaults))))
 
 
-;;; Resolving symlinks somewhat
-(defun* truenamize (pathname)
-  "Resolve as much of a pathname as possible"
-  (block nil
-    (when (typep pathname '(or null logical-pathname)) (return pathname))
-    (let ((p pathname))
-      (unless (absolute-pathname-p p)
-        (setf p (or (absolute-pathname-p (ensure-pathname-absolute p 'get-pathname-defaults nil))
-                    (return p))))
-      (when (logical-pathname-p p) (return p))
-      (let ((found (probe-file* p :truename t)))
-        (when found (return found)))
-      (let* ((directory (normalize-pathname-directory-component (pathname-directory p)))
-             (up-components (reverse (rest directory)))
-             (down-components ()))
-        (assert (eq :absolute (first directory)))
-        (loop :while up-components :do
-          (if-let (parent (probe-file* (make-pathname* :directory `(:absolute ,@(reverse up-components))
-                                                       :name nil :type nil :version nil :defaults p)))
-            (return (merge-pathnames* (make-pathname* :directory `(:relative ,@down-components)
-                                                      :defaults p)
-                                      (ensure-directory-pathname parent)))
-            (push (pop up-components) down-components))
-          :finally (return p))))))
-
-(defun* resolve-symlinks (path)
-  #-allegro (truenamize path)
-  #+allegro
-  (if (physical-pathname-p path)
-      (or (ignore-errors (excl:pathname-resolve-symbolic-links path)) path)
-      path))
-
-(defun* resolve-symlinks* (path)
-  (if *resolve-symlinks*
-      (and path (resolve-symlinks path))
-      path))
-
-
-;;; Check pathname constraints
-
-(defun* ensure-pathname
-    (pathname &key
-              on-error
-              defaults type dot-dot
-              want-pathname
-              want-logical want-physical ensure-physical
-              want-relative want-absolute ensure-absolute ensure-subpath
-              want-non-wild want-wild wilden
-              want-file want-directory ensure-directory
-              want-existing ensure-directories-exist
-              truename resolve-symlinks truenamize
-              &aux (p pathname)) ;; mutable working copy, preserve original
-  "Coerces its argument into a PATHNAME,
-optionally doing some transformations and checking specified constraints.
-
-If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified.
-
-If the argument is a STRING, it is first converted to a pathname via PARSE-UNIX-NAMESTRING
-reusing the keywords DEFAULTS TYPE DOT-DOT ENSURE-DIRECTORY WANT-RELATIVE;
-then the result is optionally merged into the DEFAULTS if ENSURE-ABSOLUTE is true,
-and the all the checks and transformations are run.
-
-Each non-nil constraint argument can be one of the symbols T, ERROR, CERROR or IGNORE.
-The boolean T is an alias for ERROR.
-ERROR means that an error will be raised if the constraint is not satisfied.
-CERROR means that an continuable error will be raised if the constraint is not satisfied.
-IGNORE means just return NIL instead of the pathname.
-
-The ON-ERROR argument, if not NIL, is a function designator (as per CALL-FUNCTION)
-that will be called with the the following arguments:
-a generic format string for ensure pathname, the pathname,
-the keyword argument corresponding to the failed check or transformation,
-a format string for the reason ENSURE-PATHNAME failed,
-and a list with arguments to that format string.
-If ON-ERROR is NIL, ERROR is used instead, which does the right thing.
-You could also pass (CERROR \"CONTINUE DESPITE FAILED CHECK\").
-
-The transformations and constraint checks are done in this order,
-which is also the order in the lambda-list:
-
-WANT-PATHNAME checks that pathname (after parsing if needed) is not null.
-Otherwise, if the pathname is NIL, ensure-pathname returns NIL.
-WANT-LOGICAL checks that pathname is a LOGICAL-PATHNAME
-WANT-PHYSICAL checks that pathname is not a LOGICAL-PATHNAME
-ENSURE-PHYSICAL ensures that pathname is physical via TRANSLATE-LOGICAL-PATHNAME
-WANT-RELATIVE checks that pathname has a relative directory component
-WANT-ABSOLUTE checks that pathname does have an absolute directory component
-ENSURE-ABSOLUTE merges with the DEFAULTS, then checks again
-that the result absolute is an absolute pathname indeed.
-ENSURE-SUBPATH checks that the pathname is a subpath of the DEFAULTS.
-WANT-FILE checks that pathname has a non-nil FILE component
-WANT-DIRECTORY checks that pathname has nil FILE and TYPE components
-ENSURE-DIRECTORY uses ENSURE-DIRECTORY-PATHNAME to interpret
-any file and type components as being actually a last directory component.
-WANT-NON-WILD checks that pathname is not a wild pathname
-WANT-WILD checks that pathname is a wild pathname
-WILDEN merges the pathname with **/*.*.* if it is not wild
-WANT-EXISTING checks that a file (or directory) exists with that pathname.
-ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST.
-TRUENAME replaces the pathname by its truename, or errors if not possible.
-RESOLVE-SYMLINKS replaces the pathname by a variant with symlinks resolved by RESOLVE-SYMLINKS.
-TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
-  (block nil
-    (flet ((report-error (keyword description &rest arguments)
-             (call-function (or on-error 'error)
-                            "Invalid pathname ~S: ~*~?"
-                            pathname keyword description arguments)))
-      (macrolet ((err (constraint &rest arguments)
-                   `(report-error ',(intern* constraint :keyword) ,@arguments))
-                 (check (constraint condition &rest arguments)
-                   `(when ,constraint
-                      (unless ,condition (err ,constraint ,@arguments))))
-                 (transform (transform condition expr)
-                   `(when ,transform
-                      (,@(if condition `(when ,condition) '(progn))
-                       (setf p ,expr)))))
-        (etypecase p
-          ((or null pathname))
-          (string
-           (setf p (parse-unix-namestring
-                    p :defaults defaults :type type :dot-dot dot-dot
-                    :ensure-directory ensure-directory :want-relative want-relative))))
-        (check want-pathname (pathnamep p) "Expected a pathname, not NIL")
-        (unless (pathnamep p) (return nil))
-        (check want-logical (logical-pathname-p p) "Expected a logical pathname")
-        (check want-physical (physical-pathname-p p) "Expected a physical pathname")
-        (transform ensure-physical () (translate-logical-pathname p))
-        (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
-        (check want-relative (relative-pathname-p p) "Expected a relative pathname")
-        (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname")
-        (transform ensure-absolute (not (absolute-pathname-p p)) (merge-pathnames* p defaults))
-        (check ensure-absolute (absolute-pathname-p p)
-               "Could not make into an absolute pathname even after merging with ~S" defaults)
-        (check ensure-subpath (absolute-pathname-p defaults)
-               "cannot be checked to be a subpath of non-absolute pathname ~S" defaults)
-        (check ensure-subpath (subpathp p defaults) "is not a sub pathname of ~S" defaults)
-        (check want-file (file-pathname-p p) "Expected a file pathname")
-        (check want-directory (directory-pathname-p p) "Expected a directory pathname")
-        (transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p))
-        (check want-non-wild (not (wild-pathname-p p)) "Expected a non-wildcard pathname")
-        (check want-wild (wild-pathname-p p) "Expected a wildcard pathname")
-        (transform wilden (not (wild-pathname-p p)) (wilden p))
-        (when want-existing
-          (let ((existing (probe-file* p :truename truename)))
-            (if existing
-                (when truename
-                  (return existing))
-                (err want-existing "Expected an existing pathname"))))
-        (when ensure-directories-exist (ensure-directories-exist p))
-        (when truename
-          (let ((truename (truename* p)))
-            (if truename
-                (return truename)
-                (err truename "Can't get a truename for pathname"))))
-        (transform resolve-symlinks () (resolve-symlinks p))
-        (transform truenamize () (truenamize p))
-        p))))
-
-
-;;; Environment pathnames
-(defun* inter-directory-separator ()
-  (if (os-unix-p) #\: #\;))
-
-(defun* split-native-pathnames-string (string &rest constraints &key &allow-other-keys)
-  (loop :for namestring :in (split-string string :separator (string (inter-directory-separator)))
-        :collect (apply 'parse-native-namestring namestring constraints)))
-
-(defun* getenv-pathname (x &rest constraints &key on-error &allow-other-keys)
-  (apply 'parse-native-namestring (getenvp x)
-         :on-error (or on-error
-                       `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathname ,x))
-         constraints))
-(defun* getenv-pathnames (x &rest constraints &key on-error &allow-other-keys)
-  (apply 'split-native-pathnames-string (getenvp x)
-         :on-error (or on-error
-                       `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x))
-         constraints))
-(defun* getenv-absolute-directory (x)
-  (getenv-pathname x :want-absolute t :ensure-directory t))
-(defun* getenv-absolute-directories (x)
-  (getenv-pathnames x :want-absolute t :ensure-directory t))
-
-(defun* lisp-implementation-directory (&key truename)
-  (let ((dir
-          (ignore-errors
-           #+clozure #p"ccl:"
-           #+(or ecl mkcl) #p"SYS:"
-           #+gcl system::*system-directory*
-           #+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil))
-                     (funcall it)
-                     (getenv-pathname "SBCL_HOME" :ensure-directory t)))))
-    (if (and dir truename)
-        (truename* dir)
-        dir)))
-
-(defun* lisp-implementation-pathname-p (pathname)
-  ;; Other builtin systems are those under the implementation directory
-  (and (when pathname
-         (if-let (impdir (lisp-implementation-directory))
-           (or (subpathp pathname impdir)
-               (when *resolve-symlinks*
-                 (if-let (truename (truename* pathname))
-                   (if-let (trueimpdir (truename* impdir))
-                     (subpathp truename trueimpdir)))))))
-       t))
-
-
-;;; Pathname defaults and current directory
-(defun* get-pathname-defaults (&optional (defaults *default-pathname-defaults*))
-  (or (absolute-pathname-p defaults)
-      (merge-pathnames* defaults (getcwd))))
-
-(defun* call-with-current-directory (dir thunk)
-  (if dir
-      (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir))))
-             (*default-pathname-defaults* dir)
-             (cwd (getcwd)))
-        (chdir dir)
-        (unwind-protect
-             (funcall thunk)
-          (chdir cwd)))
-      (funcall thunk)))
-
-(defmacro with-current-directory ((&optional dir) &body body)
-  "Call BODY while the POSIX current working directory is set to DIR"
-  `(call-with-current-directory ,dir #'(lambda () ,@body)))
+;;; Wildcard pathnames
+(defparameter *wild* (or #+cormanlisp "*" :wild))
+(defparameter *wild-directory-component* (or #+gcl2.6 "*" :wild))
+(defparameter *wild-inferiors-component* (or #+gcl2.6 "**" :wild-inferiors))
+(defparameter *wild-file*
+  (make-pathname :directory nil :name *wild* :type *wild*
+                 :version (or #-(or allegro abcl xcl) *wild*)))
+(defparameter *wild-directory*
+  (make-pathname* :directory `(:relative ,*wild-directory-component*)
+                  :name nil :type nil :version nil))
+(defparameter *wild-inferiors*
+  (make-pathname* :directory `(:relative ,*wild-inferiors-component*)
+                  :name nil :type nil :version nil))
+(defparameter *wild-path*
+  (merge-pathnames* *wild-file* *wild-inferiors*))
+
+(defun* wilden (path)
+  (merge-pathnames* *wild-path* path))
 
 
 ;;; Translate a pathname
@@ -1094,7 +654,6 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
     (t
      (translate-pathname path absolute-source destination))))
 
-;;; Hook for output translations
-(defvar *output-translation-function* 'identity)
+(defvar *output-translation-function* 'identity) ; Hook for output translations
 
 
diff --git a/run-program.lisp b/run-program.lisp
index f2c19e006..127a51740 100644
--- a/run-program.lisp
+++ b/run-program.lisp
@@ -3,7 +3,7 @@
 
 (asdf/package:define-package :asdf/run-program
   (:recycle :asdf/run-program :xcvb-driver)
-  (:use :asdf/common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os)
+  (:use :asdf/common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/filesystem :asdf/stream)
   (:export
    ;;; Escaping the command invocation madness
    #:easy-sh-character-p #:escape-sh-token #:escape-sh-command
diff --git a/stream.lisp b/stream.lisp
index 9d4172164..082667ec0 100644
--- a/stream.lisp
+++ b/stream.lisp
@@ -3,7 +3,7 @@
 
 (asdf/package:define-package :asdf/stream
   (:recycle :asdf/stream)
-  (:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os :asdf/pathname)
+  (:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os :asdf/pathname :asdf/filesystem)
   (:export
    #:*default-stream-element-type* #:*stderr* #:setup-stderr
    #:with-safe-io-syntax #:call-with-safe-io-syntax
diff --git a/test/test-system-pathnames.script b/test/test-system-pathnames.script
index 2130cb6b6..f66cf57b4 100644
--- a/test/test-system-pathnames.script
+++ b/test/test-system-pathnames.script
@@ -1,7 +1,5 @@
 ;;; -*- Lisp -*-
 
-(trace parse-unix-namestring asdf::determine-system-directory)
-
 (defsystem :test-system-pathnames
   :pathname "sources/level1"
   :components
diff --git a/upgrade.lisp b/upgrade.lisp
index c6bb0debe..f347e0cff 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -35,7 +35,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.159")
+         (asdf-version "2.26.160")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version))
diff --git a/version.lisp-expr b/version.lisp-expr
index 4b661b43d..22c1efebd 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.159"
+"2.26.160"
-- 
GitLab