Changeset 13922

Timestamp:

04/30/12 07:47:19 (12 years ago)

Author:

Mark Evenson

Message:

asdf: update to asdf-2.21

Location:

trunk/abcl

Files:

• doc/asdf/asdf.texinfo (modified) (8 diffs)
• src/org/armedbear/lisp/asdf.lisp (modified) (59 diffs)

trunk/abcl/doc/asdf/asdf.texinfo

@@ -36 +36 @@
 @url{http://common-lisp.net/project/asdf/asdf.html}.
 
-ASDF Copyright @copyright{} 2001-2011 Daniel Barlow and contributors.
-
-This manual Copyright @copyright{} 2001-2011 Daniel Barlow and contributors.
-
-This manual revised @copyright{} 2009-2011 Robert P. Goldman and Francois-Rene Rideau.
+ASDF Copyright @copyright{} 2001-2012 Daniel Barlow and contributors.
+
+This manual Copyright @copyright{} 2001-2012 Daniel Barlow and contributors.
+
+This manual revised @copyright{} 2009-2012 Robert P. Goldman and Francois-Rene Rideau.
 
 Permission is hereby granted, free of charge, to any person obtaining
@@ -198 +198 @@
 @cindex link farm
 @findex load-system
+@findex require-system
 @findex compile-system
 @findex test-system
@@ -220 +221 @@
 As of the writing of this manual,
 the following implementations provide ASDF 2 this way:
-abcl allegro ccl clisp cmucl ecl sbcl xcl.
-The following implementations don't provide it yet but will in a future release:
-lispworks scl.
-The following implementations are obsolete and most probably will never bundle it:
+abcl allegro ccl clisp cmucl ecl lispworks sbcl xcl.
+The following implementation doesn't provide it yet but will in a future release:
+scl.
+The following implementations are obsolete, not actively maintained,
+and most probably will never bundle it:
 cormancl gcl genera mcl.
 
@@ -668 +670 @@
 ASDF provides three commands for the most common system operations:
 @code{load-system}, @code{compile-system} or @code{test-system}.
+It also provides @code{require-system}, a version of @code{load-system}
+that skips trying to update systems that are already loaded.
 
 Because ASDF is an extensible system
@@ -2082 +2086 @@
              ;; In output translations, if last component, **/*.*.* is added
     PATHNAME | ;; pathname; unless last component, directory is assumed.
-    :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.49-linux-x64
+    :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64
     :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl
     :DEFAULT-DIRECTORY | ;; a relativized version of the default directory
@@ -2905 +2909 @@
 etc.
 
+Note that there is no around-load hook. This is on purpose.
+Some implementations such as ECL or GCL link object files,
+which allows for no such hook.
+Other implementations allow for concatenating FASL files,
+which doesn't allow for such a hook either.
+We aim to discourage something that's not portable,
+and has some dubious impact on performance and semantics
+even when it is possible.
+Things you might want to do with an around-load hook
+are better done around-compile,
+though it may at times require some creativity
+(see e.g. the @code{package-renaming} system).
+
+
+@section Controlling source file character encoding
+
+Starting with ASDF 2.21, components accept a @code{:encoding} option.
+By default, only @code{:default}, @code{:utf-8}
+and @code{:autodetect} are accepted.
+@code{:autodetect} is the default, and calls
+@code{*encoding-detection-hook*} which by default always returns
+@code{*default-encoding*} which itself defaults to @code{:default}.
+In other words, there now are plenty of extension hooks, but
+by default ASDF follows the backwards compatible behavior
+of using whichever @code{:default} encoding your implementation uses,
+which itself may or may not vary based on environment variables
+and other locale settings.
+In practice this means that only source code that only uses ASCII
+is guaranteed to be read the same on all implementations
+independently from any user setting.
+
+Additionally, for backward-compatibility with older versions of ASDF
+and/or with implementations that do not support unicode and its many encodings,
+you may want to use
+the reader conditionals @code{#+asdf-unicode #+asdf-unicode}
+to protect any @code{:encoding @emph{encoding}} statement
+as @code{:asdf-unicode} will be present in @code{*features*}
+only if you're using a recent ASDF
+on an implementation that supports unicode.
+We recommend that you avoid using unprotected @code{:encoding} specifications
+until after ASDF 2.21 becomes widespread, hopefully by the end of 2012.
+
+While it offers plenty of hooks for extension,
+and one such extension is being developed (see below),
+ASDF itself only recognizes one encoding beside @code{:default},
+and that is @code{:utf-8}, which is the @emph{de facto} standard,
+already used by the vast majority of libraries that use more than ASCII.
+On implementations that do not support unicode,
+the feature @code{:asdf-unicode} is absent, and
+the @code{:default} external-format is used
+to read even source files declared as @code{:utf-8}.
+On these implementations, non-ASCII characters
+intended to be read as one CL character
+may thus end up being read as multiple CL characters.
+In most cases, this shouldn't affect the software's semantics:
+comments will be skipped just the same, strings with be read and printed
+with slightly different lengths, symbol names will be accordingly longer,
+but none of it should matter.
+But a few systems that actually depend on unicode characters
+may fail to work properly, or may work in a subtly different way.
+See for instance @code{lambda-reader}.
+
+We invite you to embrace UTF-8
+as the encoding for non-ASCII characters starting today,
+even without any explicit specification in your @code{.asd} files.
+Indeed, on some implementations and configurations,
+UTF-8 is already the @code{:default},
+and loading your code may cause errors if it is encoded in anything but UTF-8.
+Therefore, even with the legacy behavior,
+non-UTF-8 is guaranteed to break for some users,
+whereas UTF-8 is pretty much guaranteed not to break anywhere
+(provided you do @emph{not} use a BOM),
+although it might be read incorrectly on some implementations.
+In the future, we intend to make @code{:utf-8}
+the default value of @code{*default-encoding*},
+to be enforced everywhere, so at least the code is guaranteed
+to be read correctly everywhere it can be.
+
+If you need non-standard character encodings for your source code,
+use the extension system @code{asdf-encodings}, by specifying
+@code{:defsystem-depends-on (:asdf-encodings)} in your @code{defsystem}.
+This extension system will register support for more encodings using the
+@code{*encoding-external-format-hook*} facility,
+so you can explicitly specify @code{:encoding :latin1}
+in your @code{.asd} file.
+Using the @code{*encoding-detection-hook*} it will also
+eventually implement some autodetection of a file's encoding
+from an emacs-style @code{-*- mode: lisp ; coding: latin1 -*-} declaration,
+or otherwise based on an analysis of octet patterns in the file.
+At this point, asdf-encoding only supports the encodings
+that are supported as part of your implementation.
+Since the list varies depending on implementations,
+we once again recommend you use @code{:utf-8} everywhere,
+which is the most portable (next is @code{:latin1}).
+
+If you're not using a version of Quicklisp that has it,
+you may get the source for @code{asdf-encodings} using git:
+@kbd{git clone git://common-lisp.net/projects/asdf/asdf-encodings.git}
+or
+@kbd{git clone ssh://common-lisp.net/project/asdf/git/asdf-encodings.git}.
+You can also browse the repository on
+@url{http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git}.
+
+In the future, we intend to change the default @code{*default-encoding*}
+to @code{:utf-8}, which is already the de facto standard
+for most libraries that use non-ASCII characters:
+utf-8 works everywhere and was backhandedly enforced by
+a lot of people using SBCL and utf-8 and sending reports to authors
+so they make their packages compatible.
+A survey showed only about a handful few libraries
+are incompatible with non-UTF-8, and then, only in comments,
+and we believe that authors will adopt UTF-8 when prompted.
+See the April 2012 discussion on the asdf-devel mailing-list.
+For backwards compatibility with users who insist on a non-UTF-8 encoding,
+but cannot immediately transition to using @code{asdf-encodings}
+(maybe because it isn't ready), it will still be possible to use
+the @code{:encoding :default} option in your @code{defsystem} form
+to restore the behavior of ASDF 2.20 and earlier.
+This shouldn't be required in libraries,
+because user pressure as mentioned above will already have pushed
+library authors towards using UTF-8;
+but authors of end-user programs might care.
+
+When you use @code{asdf-encodings}, any further loaded @code{.asd} file
+will use the autodetection algorithm to determine its encoding;
+yet if you depend on this detection happening,
+you may want to explicitly load @code{asdf-encodings} early in your build,
+for by the time you can use @code{:defsystem-depends-on},
+it is already too late to load it.
+In practice, this means that the @code{*default-encoding*}
+is usually used for @code{.asd} files.
+Currently, this defaults to @code{:default} for backwards compatibility,
+and that means that you shouldn't rely on non-ASCII characters in a .asd file.
+Since component (path)names are the only real data in these files,
+and non-ASCII characters are not very portable for file names,
+this isn't too much of an issue.
+We still encourage you to use either plain ASCII or UTF-8
+in @code{.asd} files,
+as we intend to make @code{:utf-8} the default encoding in the future.
+This might matter, for instance, in meta-data about author's names.
+
 
 @section Miscellaneous Exported Functions
@@ -3006 +3151 @@
 ``If it's not backwards, it's not compatible''. We strongly discourage its use.
 Its current behavior is only well-defined on Unix platforms
-(which includes MacOS X and cygwin). On Windows, anything goes.
+(which include MacOS X and cygwin). On Windows, anything goes.
 
 Instead we recommend the use of such a function as
-@code{xcvb-driver:run-program/process-output-stream}
+@code{xcvb-driver:run-program/}
 from the @code{xcvb-driver} system that is distributed with XCVB:
 @url{http://common-lisp.net/project/xcvb}.
@@ -3018 +3163 @@
 @code{run-shell-command} doesn't make sense anyway on that platform).
 
-This function takes as arguments a @code{format} control-string
+@code{run-shell-command} takes as arguments a @code{format} control-string
 and arguments to be passed to @code{format} after this control-string
 to produce a string.

trunk/abcl/src/org/armedbear/lisp/asdf.lisp

@@ -1 @@
-;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 2.20: Another System Definition Facility.
+;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
+;;; This is ASDF 2.21: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
@@ -20 +20 @@
 ;;;  Monday; July 13, 2009)
 ;;;
-;;; Copyright (c) 2001-2011 Daniel Barlow and contributors
+;;; Copyright (c) 2001-2012 Daniel Barlow and contributors
 ;;;
 ;;; Permission is hereby granted, free of charge, to any person obtaining
@@ -48 +48 @@
 #+xcvb (module ())
 
-(cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user)
+(cl:in-package :common-lisp-user)
+#+genera (in-package :future-common-lisp-user)
 
 #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl sbcl scl xcl)
 (error "ASDF is not supported on your implementation. Please help us port it.")
 
+;;;; Create and setup packages in a way that is compatible with hot-upgrade.
+;;;; See https://bugs.launchpad.net/asdf/+bug/485687
+;;;; See these two eval-when forms, and more near the end of the file.
+
 #+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;;; Implementation-dependent tweaks
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  ;;; Before we do anything, some implementation-dependent tweaks
   ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; NO: trust implementation defaults.
   #+allegro
@@ -62 +67 @@
         (remove "asdf" excl::*autoload-package-name-alist*
                 :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below
-  #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
-  #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp))
   #+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
   (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all
@@ -69 +72 @@
                  (< system::*gcl-minor-version* 7)))
     (pushnew :gcl-pre2.7 *features*))
+  #+(or abcl (and allegro ics) (and clisp unicode) clozure (and cmu unicode)
+        (and ecl unicode) lispworks (and sbcl sb-unicode) scl)
+  (pushnew :asdf-unicode *features*)
   ;;; make package if it doesn't exist yet.
   ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
@@ -76 +82 @@
 (in-package :asdf)
 
-;;;; Create packages in a way that is compatible with hot-upgrade.
-;;;; See https://bugs.launchpad.net/asdf/+bug/485687
-;;;; See more near the end of the file.
-
 (eval-when (:load-toplevel :compile-toplevel :execute)
+  ;;; This would belong amongst implementation-dependent tweaks above,
+  ;;; except that the defun has to be in package asdf.
+  #+ecl (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t))
+  #+ecl (unless (use-ecl-byte-compiler-p) (require :cmp))
+
+  ;;; Package setup, step 2.
   (defvar *asdf-version* nil)
   (defvar *upgraded-p* nil)
@@ -109 +117 @@
          ;; "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.20")
+         (asdf-version "2.21")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
@@ -169 +177 @@
              (shadow symbols package))
            (ensure-use (package use)
+             (dolist (used (package-use-list package))
+               (unless (member (package-name used) use :test 'string=)
+                 (unuse-package used)
+                 (do-external-symbols (sym used)
+                   (when (eq sym (find-symbol* sym package))
+                     (remove-symbol sym package)))))
              (dolist (used (reverse use))
                (do-external-symbols (sym used)
@@ -200 +214 @@
                                  shadow export redefined-functions)
              (let* ((p (ensure-exists name nicknames use)))
-               (ensure-unintern p unintern)
+               (ensure-unintern p (append unintern #+cmu redefined-functions))
                (ensure-shadow p shadow)
                (ensure-export p export)
-               (ensure-fmakunbound p redefined-functions)
+               #-cmu (ensure-fmakunbound p redefined-functions)
                p)))
         (macrolet
@@ -235 +249 @@
             #:system-definition-pathname #:with-system-definitions
             #:search-for-system-definition #:find-component #:component-find-path
-            #:compile-system #:load-system #:load-systems #:test-system #:clear-system
+            #:compile-system #:load-system #:load-systems
+            #:require-system #:test-system #:clear-system
             #:operation #:compile-op #:load-op #:load-source-op #:test-op
             #:feature #:version #:version-satisfies
             #:upgrade-asdf
-            #:implementation-identifier #:implementation-type
+            #:implementation-identifier #:implementation-type #:hostname
             #:input-files #:output-files #:output-file #:perform
             #:operation-done-p #:explain
@@ -256 +271 @@
 
             #:module-components          ; component accessors
-            #:module-components-by-name  ; component accessors
+            #:module-components-by-name
             #:component-pathname
             #:component-relative-pathname
@@ -264 +279 @@
             #:component-property
             #:component-system
-
             #:component-depends-on
+            #:component-encoding
+            #:component-external-format
 
             #:system-description
@@ -282 +298 @@
             #:operation-on-failure
             #:component-visited-p
-            ;;#:*component-parent-pathname*
-            #:*system-definition-search-functions*
-            #:*central-registry*         ; variables
+
+            #:*system-definition-search-functions*   ; variables
+            #:*central-registry*
             #:*compile-file-warnings-behaviour*
             #:*compile-file-failure-behaviour*
@@ -312 +328 @@
             #:coerce-entry-to-directory
             #:remove-entry-from-registry
+
+            #:*encoding-detection-hook*
+            #:*encoding-external-format-hook*
+            #:*default-encoding*
+            #:*utf-8-external-format*
 
             #:clear-configuration
@@ -330 +351 @@
             #:ensure-source-registry
             #:process-source-registry
-            #:system-registered-p
+            #:system-registered-p #:registered-systems #:loaded-systems
+            #:resolve-location
             #:asdf-message
             #:user-output-translations-pathname
@@ -342 +364 @@
 
             ;; Utilities
-            #:absolute-pathname-p
             ;; #:aif #:it
-            ;; #:appendf #:orf
+            #:appendf #:orf
+            #:length=n-p
+            #:remove-keys #:remove-keyword
+            #:first-char #:last-char #:ends-with
             #:coerce-name
-            #:directory-pathname-p
-            ;; #:ends-with
-            #:ensure-directory-pathname
+            #:directory-pathname-p #:ensure-directory-pathname
+            #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root
             #:getenv
-            ;; #:length=n-p
-            ;; #:find-symbol*
-            #:merge-pathnames* #:coerce-pathname #:subpathname
-            #:pathname-directory-pathname
+            #:probe-file*
+            #:find-symbol* #:strcat
+            #:make-pathname-component-logical #:make-pathname-logical
+            #:merge-pathnames* #:coerce-pathname #:subpathname #:subpathname*
+            #:pathname-directory-pathname #:pathname-parent-directory-pathname
             #:read-file-forms
-            ;; #:remove-keys
-            ;; #:remove-keyword
-            #:resolve-symlinks
+            #:resolve-symlinks #:truenamize
             #:split-string
             #:component-name-to-pathname-components
             #:split-name-type
-            #:subdirectories
-            #:truenamize
-            #:while-collecting)))
+            #:subdirectories #:directory-files
+            #:while-collecting
+            #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors*
+            #:*wild-path* #:wilden
+            #:directorize-pathname-host-device
+            )))
         #+genera (import 'scl:boolean :asdf)
         (setf *asdf-version* asdf-version
@@ -482 +507 @@
 
 (defmacro aif (test then &optional else)
+  "Anaphoric version of IF, On Lisp style"
   `(let ((it ,test)) (if it ,then ,else)))
 
@@ -491 +517 @@
 
 (defun* normalize-pathname-directory-component (directory)
+  "Given a pathname directory component, return an equivalent form that is a list"
   (cond
-    #-(or cmu sbcl scl)
+    #-(or cmu sbcl scl) ;; these implementations already normalize directory components.
     ((stringp directory) `(:absolute ,directory) directory)
     #+gcl
@@ -504 +531 @@
 
 (defun* merge-pathname-directory-components (specified defaults)
+  ;; Helper for merge-pathnames* that handles directory components.
   (let ((directory (normalize-pathname-directory-component specified)))
     (ecase (first directory)
@@ -525 +553 @@
               :finally (return (cons defabs (append (reverse defrev) reldir)))))))))))
 
-(defun* ununspecific (x)
-  (if (eq x :unspecific) nil x))
+(defun* make-pathname-component-logical (x)
+  "Make a pathname component suitable for use in a logical-pathname"
+  (typecase x
+    ((eql :unspecific) nil)
+    #+clisp (string (string-upcase x))
+    #+clisp (cons (mapcar 'make-pathname-component-logical x))
+    (t x)))
+
+(defun* make-pathname-logical (pathname host)
+  "Take a PATHNAME's directory, name, type and version components,
+and make a new pathname with corresponding components and specified logical HOST"
+  (make-pathname
+   :host host
+   :directory (make-pathname-component-logical (pathname-directory pathname))
+   :name (make-pathname-component-logical (pathname-name pathname))
+   :type (make-pathname-component-logical (pathname-type pathname))
+   :version (make-pathname-component-logical (pathname-version pathname))))
 
 (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
@@ -547 +590 @@
          (version (or (pathname-version specified) (pathname-version defaults))))
     (labels ((unspecific-handler (p)
-               (if (typep p 'logical-pathname) #'ununspecific #'identity)))
+               (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity)))
       (multiple-value-bind (host device directory unspecific-handler)
           (ecase (first directory)
@@ -615 +658 @@
          ;; Giving :unspecific as argument to make-pathname is not portable.
          ;; See CLHS make-pathname and 19.2.2.2.3.
-         ;; We only use it on implementations that support it.
-         (or #+(or clozure gcl lispworks sbcl) :unspecific)))
+         ;; We only use it on implementations that support it,
+         #+(or abcl allegro clozure cmu gcl genera lispworks sbcl scl xcl) :unspecific
+         #+(or clisp ecl #|These haven't been tested:|# cormanlisp mcl) nil))
     (destructuring-bind (name &optional (type unspecific))
         (split-string filename :max 2 :separator ".")
@@ -745 +789 @@
   (and (typep pathspec '(or pathname string))
        (eq :absolute (car (pathname-directory (pathname pathspec))))))
+
+(defun* coerce-pathname (name &key type defaults)
+  "coerce NAME into a PATHNAME.
+When given a string, portably decompose it into a relative pathname:
+#\\/ separates subdirectories. The last #\\/-separated string is as follows:
+if TYPE is NIL, its last #\\. if any separates name and type from from type;
+if TYPE is a string, it is the type, and the whole string is the name;
+if TYPE is :DIRECTORY, the string is a directory component;
+if the string is empty, it's a directory.
+Any directory named .. is read as :BACK.
+Host, device and version components are taken from DEFAULTS."
+  ;; The defaults are required notably because they provide the default host
+  ;; to the below make-pathname, which may crucially matter to people using
+  ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
+  ;; NOTE that the host and device slots will be taken from the defaults,
+  ;; but that should only matter if you later merge relative pathnames with
+  ;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
+  (etypecase name
+    ((or null pathname)
+     name)
+    (symbol
+     (coerce-pathname (string-downcase name) :type type :defaults defaults))
+    (string
+     (multiple-value-bind (relative path filename)
+         (component-name-to-pathname-components name :force-directory (eq type :directory)
+                                                :force-relative t)
+       (multiple-value-bind (name type)
+           (cond
+             ((or (eq type :directory) (null filename))
+              (values nil nil))
+             (type
+              (values filename type))
+             (t
+              (split-name-type filename)))
+         (apply 'make-pathname :directory (cons relative path) :name name :type type
+                (when defaults `(:defaults ,defaults))))))))
+
+(defun* merge-component-name-type (name &key type defaults)
+  ;; For backwards compatibility only, for people using internals.
+  ;; Will be removed in a future release, e.g. 2.016.
+  (warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
+  (coerce-pathname name :type type :defaults defaults))
+
+(defun* subpathname (pathname subpath &key type)
+  (and pathname (merge-pathnames* (coerce-pathname subpath :type type)
+                                  (pathname-directory-pathname pathname))))
+
+(defun subpathname* (pathname subpath &key type)
+  (and pathname
+       (subpathname (ensure-directory-pathname pathname) subpath :type type)))
 
 (defun* length=n-p (x n) ;is it that (= (length x) n) ?
@@ -897 +991 @@
         (port (ext:pathname-port pathname))
         (directory (pathname-directory pathname)))
-    (if (or (ununspecific port)
-            (and (ununspecific host) (plusp (length host)))
-            (ununspecific scheme))
+    (flet ((specificp (x) (and x (not (eq x :unspecific)))))
+      (if (or (specificp port)
+              (and (specificp host) (plusp (length host)))
+              (specificp scheme))
         (let ((prefix ""))
-          (when (ununspecific port)
+          (when (specificp port)
             (setf prefix (format nil ":~D" port)))
-          (when (and (ununspecific host) (plusp (length host)))
+          (when (and (specificp host) (plusp (length host)))
             (setf prefix (strcat host prefix)))
           (setf prefix (strcat ":" prefix))
-          (when (ununspecific scheme)
+          (when (specificp scheme)
             (setf prefix (strcat scheme prefix)))
           (assert (and directory (eq (first directory) :absolute)))
           (make-pathname :directory `(:absolute ,prefix ,@(rest directory))
                          :defaults pathname)))
-    pathname))
+    pathname)))
 
 ;;;; -------------------------------------------------------------------------
@@ -949 +1044 @@
 (defgeneric* (setf component-property) (new-value component property))
 
+(defgeneric* component-external-format (component))
+
+(defgeneric* component-encoding (component))
+
 (eval-when (#-gcl :compile-toplevel :load-toplevel :execute)
   (defgeneric* (setf module-components-by-name) (new-value module)))
@@ -1026 +1125 @@
 ;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
 (when *upgraded-p*
-   (when (find-class 'module nil)
-     (eval
-      '(defmethod update-instance-for-redefined-class :after
-           ((m module) added deleted plist &key)
-         (declare (ignorable deleted plist))
-         (when *asdf-verbose*
-           (asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
-                         m (asdf-version)))
-         (when (member 'components-by-name added)
-           (compute-module-components-by-name m))
-         (when (typep m 'system)
-           (when (member 'source-file added)
-             (%set-system-source-file
-              (probe-asd (component-name m) (component-pathname m)) m)
-             (when (equal (component-name m) "asdf")
-               (setf (component-version m) *asdf-version*))))))))
+  (when (find-class 'module nil)
+    (eval
+     '(defmethod update-instance-for-redefined-class :after
+          ((m module) added deleted plist &key)
+        (declare (ignorable deleted plist))
+        (when *asdf-verbose*
+          (asdf-message (compatfmt "~&~@<; ~@;Updating ~A for ASDF ~A~@:>~%")
+                        m (asdf-version)))
+        (when (member 'components-by-name added)
+          (compute-module-components-by-name m))
+        (when (typep m 'system)
+          (when (member 'source-file added)
+            (%set-system-source-file
+             (probe-asd (component-name m) (component-pathname m)) m)
+           (when (equal (component-name m) "asdf")
+             (setf (component-version m) *asdf-version*))))))))
 
 ;;;; -------------------------------------------------------------------------
@@ -1151 +1250 @@
    ;; hasn't yet been loaded in the current image (do-first).
    ;; The names are crap, but they have been the official API since Dan Barlow's ASDF 1.52!
+   ;; LispWorks's defsystem has caused-by and requires for in-order-to and do-first respectively.
+   ;; Maybe rename the slots in ASDF? But that's not very backwards compatible.
    ;; See our ASDF 2 paper for more complete explanations.
    (in-order-to :initform nil :initarg :in-order-to
@@ -1169 +1270 @@
                     :accessor component-operation-times)
    (around-compile :initarg :around-compile)
+   (%encoding :accessor %component-encoding :initform nil :initarg :encoding)
    ;; XXX we should provide some atomic interface for updating the
    ;; component properties
@@ -1278 +1380 @@
               (acons property new-value (slot-value c 'properties)))))
   new-value)
+
+(defvar *default-encoding* :default
+  "Default encoding for source files.
+The default value :default preserves the legacy behavior.
+A future default might be :utf-8 or :autodetect
+reading emacs-style -*- coding: utf-8 -*- specifications,
+and falling back to utf-8 or latin1 if nothing is specified.")
+
+(defparameter *utf-8-external-format*
+  #+(and asdf-unicode (not clisp)) :utf-8
+  #+(and asdf-unicode clisp) charset:utf-8
+  #-asdf-unicode :default
+  "Default :external-format argument to pass to CL:OPEN and also
+CL:LOAD or CL:COMPILE-FILE to best process a UTF-8 encoded file.
+On modern implementations, this will decode UTF-8 code points as CL characters.
+On legacy implementations, it may fall back on some 8-bit encoding,
+with non-ASCII code points being read as several CL characters;
+hopefully, if done consistently, that won't affect program behavior too much.")
+
+(defun* always-default-encoding (pathname)
+  (declare (ignore pathname))
+  *default-encoding*)
+
+(defvar *encoding-detection-hook* #'always-default-encoding
+  "Hook for an extension to define a function to automatically detect a file's encoding")
+
+(defun* detect-encoding (pathname)
+  (funcall *encoding-detection-hook* pathname))
+
+(defmethod component-encoding ((c component))
+  (or (loop :for x = c :then (component-parent x)
+        :while x :thereis (%component-encoding x))
+      (detect-encoding (component-pathname c))))
+
+(defun* default-encoding-external-format (encoding)
+  (case encoding
+    (:default :default) ;; for backwards compatibility only. Explicit usage discouraged.
+    (:utf-8 *utf-8-external-format*)
+    (otherwise
+     (cerror "Continue using :external-format :default" (compatfmt "~@<Your ASDF component is using encoding ~S but it isn't recognized. Your system should :defsystem-depends-on (:asdf-encodings).~:>") encoding)
+     :default)))
+
+(defvar *encoding-external-format-hook*
+  #'default-encoding-external-format
+  "Hook for an extension to define a mapping between non-default encodings
+and implementation-defined external-format's")
+
+(defun encoding-external-format (encoding)
+  (funcall *encoding-external-format-hook* encoding))
+
+(defmethod component-external-format ((c component))
+  (encoding-external-format (component-encoding c)))
 
 (defclass proto-system () ; slots to keep when resetting a system
@@ -1442 +1596 @@
   (gethash (coerce-name name) *defined-systems*))
 
+(defun* registered-systems ()
+  (loop :for (() . system) :being :the :hash-values :of *defined-systems*
+    :collect (coerce-name system)))
+
 (defun* register-system (system)
   (check-type system system)
@@ -1532 +1690 @@
   (block nil
     (when (directory-pathname-p defaults)
-      (let ((file (make-pathname
-                   :defaults defaults :name name
-                   :version :newest :case :local :type "asd")))
-        (when (probe-file* file)
+      (let* ((file (probe-file* (subpathname defaults (strcat name ".asd")))))
+        (when file
           (return file)))
       #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
@@ -1651 +1807 @@
              (let ((*package* package)
                    (*default-pathname-defaults*
-                    (pathname-directory-pathname pathname)))
+                    ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings.
+                    (pathname-directory-pathname (translate-logical-pathname pathname)))
+                   (external-format (encoding-external-format (detect-encoding pathname))))
                (asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
                              pathname package)
-               (load pathname)))
+               (load pathname :external-format external-format)))
         (delete-package package)))))
 
 (defun* locate-system (name)
   "Given a system NAME designator, try to locate where to load the system from.
-Returns four values: FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
-FOUNDP is true when a new was found, either a new unregistered one or a previously registered one.
+Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
+FOUNDP is true when a system was found,
+either a new unregistered one or a previously registered one.
 FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is
-PATHNAME when not null is a path from where to load the system, associated with FOUND-SYSTEM, or with the PREVIOUS system.
+PATHNAME when not null is a path from where to load the system,
+either associated with FOUND-SYSTEM, or with the PREVIOUS system.
 PREVIOUS when not null is a previously loaded SYSTEM object of same name.
 PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
@@ -1670 +1830 @@
          (previous (and (typep previous 'system) previous))
          (previous-time (car in-memory))
-           (found (search-for-system-definition name))
+         (found (search-for-system-definition name))
          (found-system (and (typep found 'system) found))
          (pathname (or (and (typep found '(or pathname string)) (pathname found))
@@ -1716 +1876 @@
         (reinitialize-source-registry-and-retry ()
           :report (lambda (s)
-                    (format s "~@<Retry finding system ~A after reinitializing the source-registry.~@:>" name))
+                    (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
           (initialize-source-registry))))))
 
@@ -1790 +1950 @@
   (source-file-explicit-type component))
 
-(defun* coerce-pathname (name &key type defaults)
-  "coerce NAME into a PATHNAME.
-When given a string, portably decompose it into a relative pathname:
-#\\/ separates subdirectories. The last #\\/-separated string is as follows:
-if TYPE is NIL, its last #\\. if any separates name and type from from type;
-if TYPE is a string, it is the type, and the whole string is the name;
-if TYPE is :DIRECTORY, the string is a directory component;
-if the string is empty, it's a directory.
-Any directory named .. is read as :BACK.
-Host, device and version components are taken from DEFAULTS."
-  ;; The defaults are required notably because they provide the default host
-  ;; to the below make-pathname, which may crucially matter to people using
-  ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
-  ;; NOTE that the host and device slots will be taken from the defaults,
-  ;; but that should only matter if you later merge relative pathnames with
-  ;; CL:MERGE-PATHNAMES instead of ASDF:MERGE-PATHNAMES*
-  (etypecase name
-    ((or null pathname)
-     name)
-    (symbol
-     (coerce-pathname (string-downcase name) :type type :defaults defaults))
-    (string
-     (multiple-value-bind (relative path filename)
-         (component-name-to-pathname-components name :force-directory (eq type :directory)
-                                                :force-relative t)
-       (multiple-value-bind (name type)
-           (cond
-             ((or (eq type :directory) (null filename))
-              (values nil nil))
-             (type
-              (values filename type))
-             (t
-              (split-name-type filename)))
-         (apply 'make-pathname :directory (cons relative path) :name name :type type
-                (when defaults `(:defaults ,defaults))))))))
-
-(defun* merge-component-name-type (name &key type defaults)
-  ;; For backwards compatibility only, for people using internals.
-  ;; Will be removed in a future release, e.g. 2.016.
-  (warn "Please don't use ASDF::MERGE-COMPONENT-NAME-TYPE. Use ASDF:COERCE-PATHNAME.")
-  (coerce-pathname name :type type :defaults defaults))
-
 (defmethod component-relative-pathname ((component component))
   (coerce-pathname
@@ -1838 +1956 @@
    :type (source-file-type component (component-system component))
    :defaults (component-parent-pathname component)))
-
-(defun* subpathname (pathname subpath &key type)
-  (and pathname (merge-pathnames* (coerce-pathname subpath :type type)
-                                  (pathname-directory-pathname pathname))))
-
-(defun subpathname* (pathname subpath &key type)
-  (and pathname
-       (subpathname (ensure-directory-pathname pathname) subpath :type type)))
 
 ;;;; -------------------------------------------------------------------------
@@ -1862 +1972 @@
    ;; However, but this feature has only ever worked but starting with ASDF 2.014.5
    (forced :initform nil :initarg :force :accessor operation-forced)
+   (forced-not :initform nil :initarg :force-not :accessor operation-forced-not)
    (original-initargs :initform nil :initarg :original-initargs
                       :accessor operation-original-initargs)
@@ -1874 +1985 @@
 
 (defmethod shared-initialize :after ((operation operation) slot-names
-                                     &key force
+                                     &key force force-not
                                      &allow-other-keys)
-  (declare (ignorable operation slot-names force))
-  ;; empty method to disable initarg validity checking
+  ;; the &allow-other-keys disables initarg validity checking
+  (declare (ignorable operation slot-names force force-not))
+  (macrolet ((frob (x) ;; normalize forced and forced-not slots
+               `(when (consp (,x operation))
+                  (setf (,x operation)
+                        (mapcar #'coerce-name (,x operation))))))
+    (frob operation-forced) (frob operation-forced-not))
   (values))
 
@@ -2055 +2171 @@
       (retry ()
         :report (lambda (s)
-                  (format s "~@<Retry loading ~3i~_~A.~@:>" name))
+                  (format s (compatfmt "~@<Retry loading ~3i~_~A.~@:>") name))
         :test
         (lambda (c)
@@ -2145 +2261 @@
       (setf (visiting-component operation c) t)
       (unwind-protect
-           (progn
-             (let ((f (operation-forced
-                       (operation-ancestor operation))))
-               (when (and f (or (not (consp f)) ;; T or :ALL
-                                (and (typep c 'system) ;; list of names of systems to force
-                                     (member (component-name c) f
-                                             :test #'string=))))
-                 (setf *forcing* t)))
+           (block nil
+             (when (typep c 'system) ;; systems can be forced or forced-not
+               (let ((ancestor (operation-ancestor operation)))
+                 (flet ((match? (f)
+                          (and f (or (not (consp f)) ;; T or :ALL
+                                     (member (component-name c) f :test #'equal)))))
+                   (cond
+                     ((match? (operation-forced ancestor))
+                      (setf *forcing* t))
+                     ((match? (operation-forced-not ancestor))
+                      (return))))))
              ;; first we check and do all the dependencies for the module.
              ;; Operations planned in this loop will show up
@@ -2207 +2326 @@
                  (do-collect collect (vector module-ops))
                  (do-collect collect (cons operation c)))))
-             (setf (visiting-component operation c) nil)))
-      (visit-component operation c (when flag (incf *visit-count*)))
-      flag))
+        (setf (visiting-component operation c) nil)))
+    (visit-component operation c (when flag (incf *visit-count*)))
+    flag))
 
 (defun* flatten-tree (l)
@@ -2228 +2347 @@
 
 (defmethod traverse ((operation operation) (c component))
-  (when (consp (operation-forced operation))
-    (setf (operation-forced operation)
-          (mapcar #'coerce-name (operation-forced operation))))
   (flatten-tree
    (while-collecting (collect)
@@ -2301 +2417 @@
 
 (defun* ensure-all-directories-exist (pathnames)
-   (loop :for pn :in pathnames
-     :for pathname = (if (typep pn 'logical-pathname)
-                         (translate-logical-pathname pn)
-                         pn)
-     :do (ensure-directories-exist pathname)))
+   (dolist (pathname pathnames)
+     (ensure-directories-exist (translate-logical-pathname pathname))))
 
 (defmethod perform :before ((operation compile-op) (c source-file))
-  (ensure-all-directories-exist (asdf:output-files operation c)))
+  (ensure-all-directories-exist (output-files operation c)))
 
 (defmethod perform :after ((operation operation) (c component))
@@ -2354 +2467 @@
          c #'(lambda ()
                (apply *compile-op-compile-file-function* source-file
-                      :output-file output-file (compile-op-flags operation))))
+                      :output-file output-file
+                      :external-format (component-external-format c)
+                      (compile-op-flags operation))))
       (unless output
         (error 'compile-error :component c :operation operation))
@@ -2460 +2575 @@
   (let ((source (component-pathname c)))
     (setf (component-property c 'last-loaded-as-source)
-          (and (call-with-around-compile-hook c #'(lambda () (load source)))
+          (and (call-with-around-compile-hook
+                c #'(lambda () (load source :external-format (component-external-format c))))
                (get-universal-time)))))
 
@@ -2522 +2638 @@
 ;;;; Separating this into a different function makes it more forward-compatible
 (defun* cleanup-upgraded-asdf (old-version)
-  (let ((new-version (asdf:asdf-version)))
+  (let ((new-version (asdf-version)))
     (unless (equal old-version new-version)
       (cond
@@ -2548 +2664 @@
 ;;;; We need do that before we operate on anything that depends on ASDF.
 (defun* upgrade-asdf ()
-  (let ((version (asdf:asdf-version)))
+  (let ((version (asdf-version)))
     (handler-bind (((or style-warning warning) #'muffle-warning))
       (operate 'load-op :asdf :verbose nil))
@@ -2630 +2746 @@
   (map () 'load-system systems))
 
+(defun component-loaded-p (c)
+  (and (gethash 'load-op (component-operation-times (find-component c nil))) t))
+
+(defun loaded-systems ()
+  (remove-if-not 'component-loaded-p (registered-systems)))
+
+(defun require-system (s)
+  (load-system s :force-not (loaded-systems)))
+
 (defun* compile-system (system &rest args &key force verbose version
                        &allow-other-keys)
-  "Shorthand for `(operate 'asdf:compile-op system)`. See OPERATE
+  "Shorthand for `(asdf:operate 'asdf:compile-op system)`. See OPERATE
 for details."
   (declare (ignore force verbose version))
@@ -2640 +2765 @@
 (defun* test-system (system &rest args &key force verbose version
                     &allow-other-keys)
-  "Shorthand for `(operate 'asdf:test-op system)`. See OPERATE for
+  "Shorthand for `(asdf:operate 'asdf:test-op system)`. See OPERATE for
 details."
   (declare (ignore force verbose version))
@@ -2764 +2889 @@
               components pathname default-component-class
               perform explain output-files operation-done-p
-              weakly-depends-on
-              depends-on serial in-order-to do-first
+              weakly-depends-on depends-on serial in-order-to
+              do-first
               (version nil versionp)
               ;; list ends
@@ -2894 +3019 @@
 ;;;; As a suggested replacement which is portable to all ASDF-supported
 ;;;; implementations and operating systems except Genera, I recommend
-;;;; xcvb-driver's xcvb-driver:run-program/process-output-stream and its
-;;;; derivatives such as xcvb-driver:run-program/for-side-effects.
+;;;; xcvb-driver's xcvb-driver:run-program/ and its derivatives.
 
 (defun* run-shell-command (control-string &rest args)
@@ -3019 +3143 @@
 
 (defmethod system-source-file ((system system))
+  ;; might be missing when upgrading from ASDF 1 and u-i-f-r-c failed
+  (unless (slot-boundp system 'source-file)
+    (%set-system-source-file
+     (probe-asd (component-name system) (component-pathname system)) system))
   (%system-source-file system))
 (defmethod system-source-file ((system-name string))
@@ -3090 +3218 @@
 (defun* ccl-fasl-version ()
   ;; the fasl version is target-dependent from CCL 1.8 on.
-  (or (and (fboundp 'ccl::target-fasl-version)
-           (funcall 'ccl::target-fasl-version))
+  (or (let ((s 'ccl::target-fasl-version))
+        (and (fboundp s) (funcall s)))
       (and (boundp 'ccl::fasl-version)
            (symbol-value 'ccl::fasl-version))
@@ -3139 +3267 @@
            (or (architecture) (machine-type)))))
 
+(defun* hostname ()
+  ;; Note: untested on RMCL
+  #+(or abcl clozure cmucl ecl genera lispworks mcl sbcl scl xcl) (machine-instance)
+  #+cormanlisp "localhost" ;; is there a better way? Does it matter?
+  #+allegro (excl.osi:gethostname)
+  #+clisp (first (split-string (machine-instance) :separator " "))
+  #+gcl (system:gethostname))
+
 
 ;;; ---------------------------------------------------------------------------
@@ -3166 +3302 @@
   (ensure-absolute-pathname* s "from (getenv ~S)" x))
 (defun getenv-absolute-pathnames (x &aux (s (getenv x)))
-  (split-absolute-pathnames s "from (getenv ~S) = ~S" x s))
+  (and (plusp (length s))
+       (split-absolute-pathnames s "from (getenv ~S) = ~S" x s)))
 
 (defun* user-configuration-directories ()
@@ -3379 +3516 @@
               (coerce-pathname (implementation-identifier) :type :directory))
              ((eql :implementation-type)
-              (coerce-pathname (string-downcase (implementation-type)) :type :directory)))))
+              (coerce-pathname (string-downcase (implementation-type)) :type :directory))
+             ((eql :hostname)
+              (coerce-pathname (hostname) :type :directory)))))
     (when (absolute-pathname-p r)
       (error (compatfmt "~@<pathname ~S is not relative~@:>") x))
@@ -3865 +4004 @@
         :for p = (or (and (typep f 'logical-pathname) f)
                      (let* ((u (ignore-errors (funcall merger f))))
-                       ;; The first u avoids a cumbersome (truename u) error
-                       (and u (equal (ignore-errors (truename u)) f) u)))
+                       ;; 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 doesn't have :version :newest
+                       (and u (equal (ignore-errors (truename u)) (truename f)) u)))
         :when p :collect p)
       entries))
 
 (defun* directory-files (directory &optional (pattern *wild-file*))
+  (setf directory (pathname directory))
   (when (wild-pathname-p directory)
     (error "Invalid wild in ~S" directory))
   (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal)
     (error "Invalid file pattern ~S" pattern))
+  (when (typep directory 'logical-pathname)
+    (setf pattern (make-pathname-logical pattern (pathname-host directory))))
   (let ((entries (ignore-errors (directory* (merge-pathnames* pattern directory)))))
     (filter-logical-directory-results
@@ -3880 +4024 @@
      #'(lambda (f)
          (make-pathname :defaults directory
-                        :name (pathname-name f) :type (ununspecific (pathname-type f))
-                        :version (ununspecific (pathname-version f)))))))
+                        :name (pathname-name f)
+                        :type (make-pathname-component-logical (pathname-type f))
+                        :version (make-pathname-component-logical (pathname-version f)))))))
 
 (defun* directory-asd-files (directory)
@@ -3914 +4059 @@
     (filter-logical-directory-results
      directory dirs
-     (let ((prefix (normalize-pathname-directory-component
-                    (pathname-directory directory))))
+     (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))))
+           (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 (last dir))))))))))
+                   :directory (append prefix (make-pathname-component-logical (last dir)))))))))))
 
 (defun* collect-asds-in-directory (directory collect)