Index: /trunk/source/tools/asdf.lisp
===================================================================
--- /trunk/source/tools/asdf.lisp	(revision 14687)
+++ /trunk/source/tools/asdf.lisp	(revision 14688)
@@ -1,4 +1,4 @@
-;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 2.013: Another System Definition Facility.
+;;; -*- mode: common-lisp; package: asdf; -*-
+;;; This is ASDF: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
@@ -11,7 +11,7 @@
 ;;; location above for a more recent version (and for documentation
 ;;; and test files, if your copy came without them) before reporting
-;;; bugs.  There are usually two "supported" revisions - the git master
-;;; branch is the latest development version, whereas the git release
-;;; branch may be slightly older but is considered `stable'
+;;; bugs.  There are usually two "supported" revisions - the git HEAD
+;;; is the latest development version, whereas the revision tagged
+;;; RELEASE may be slightly older but is considered `stable'
 
 ;;; -- LICENSE START
@@ -48,5 +48,5 @@
 #+xcvb (module ())
 
-(cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user)
+(cl:in-package :cl-user)
 
 #+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
@@ -56,5 +56,5 @@
   ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
   (unless (find-package :asdf)
-    (make-package :asdf :use '(:common-lisp)))
+    (make-package :asdf :use '(:cl)))
   ;;; Implementation-dependent tweaks
   ;; (declaim (optimize (speed 2) (debug 2) (safety 3))) ; NO: rely on the implementation defaults.
@@ -63,7 +63,5 @@
         (remove "asdf" excl::*autoload-package-name-alist*
                 :test 'equalp :key 'car))
-  #+(and ecl (not ecl-bytecmp)) (require :cmp)
-  #+(and (or win32 windows mswindows mingw32) (not cygwin)) (pushnew :asdf-windows *features*)
-  #+(or unix cygwin) (pushnew :asdf-unix *features*))
+  #+ecl (require :cmp))
 
 (in-package :asdf)
@@ -79,10 +77,9 @@
          ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version
          ;; can help you do these changes in synch (look at the source for documentation).
-         ;; Relying on its automation, the version is now redundantly present on top of this file.
          ;; "2.345" would be an official release
          ;; "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.013")
+         (asdf-version "2.012")
          (existing-asdf (fboundp 'find-system))
          (existing-version *asdf-version*)
@@ -91,19 +88,12 @@
       (when existing-asdf
         (format *trace-output*
-         "~&; Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
+         "~&~@<; ~@;Upgrading ASDF package ~@[from version ~A ~]to version ~A~@:>~%"
          existing-version asdf-version))
       (labels
-          ((present-symbol-p (symbol package)
-             (member (nth-value 1 (find-symbol symbol package)) '(:internal :external)))
-           (present-symbols (package)
-             ;; #-genera (loop :for s :being :the :present-symbols :in package :collect s) #+genera
-             (let (l)
-               (do-symbols (s package)
-                 (when (present-symbol-p s package) (push s l)))
-               (reverse l)))
-           (unlink-package (package)
+          ((unlink-package (package)
              (let ((u (find-package package)))
                (when u
-                 (ensure-unintern u (present-symbols u))
+                 (ensure-unintern u
+                   (loop :for s :being :each :present-symbol :in u :collect s))
                  (loop :for p :in (package-used-by-list u) :do
                    (unuse-package u p))
@@ -159,5 +149,5 @@
                    (bothly-exported-symbols nil)
                    (newly-exported-symbols nil))
-               (do-external-symbols (sym package)
+               (loop :for sym :being :each :external-symbol :in package :do
                  (if (member sym export :test 'string-equal)
                      (push sym bothly-exported-symbols)
@@ -197,6 +187,5 @@
             #:perform-with-restarts #:component-relative-pathname
             #:system-source-file #:operate #:find-component #:find-system
-            #:apply-output-translations #:translate-pathname* #:resolve-location
-            #:compile-file*)
+            #:apply-output-translations #:translate-pathname* #:resolve-location)
            :unintern
            (#:*asdf-revision* #:around #:asdf-method-combination
@@ -290,5 +279,4 @@
 
             #:clear-configuration
-            #:*output-translations-parameter*
             #:initialize-output-translations
             #:disable-output-translations
@@ -300,5 +288,4 @@
             #:enable-asdf-binary-locations-compatibility
             #:*default-source-registries*
-            #:*source-registry-parameter*
             #:initialize-source-registry
             #:compute-source-registry
@@ -322,5 +309,4 @@
             ;; #:find-symbol*
             #:merge-pathnames*
-            #:coerce-pathname
             #:pathname-directory-pathname
             #:read-file-forms
@@ -334,5 +320,4 @@
             #:truenamize
             #:while-collecting)))
-	#+genera (import 'scl:boolean :asdf)
         (setf *asdf-version* asdf-version
               *upgraded-p* (if existing-version
@@ -346,5 +331,5 @@
   "Exported interface to the version of ASDF currently installed. A string.
 You can compare this string with e.g.:
-(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.013\")."
+(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.000\")."
   *asdf-version*)
 
@@ -421,39 +406,4 @@
     (make-pathname :name nil :type nil :version nil :defaults pathname)))
 
-(defun* normalize-pathname-directory-component (directory)
-  (cond
-    #-(or sbcl cmu)
-    ((stringp directory) `(:absolute ,directory) directory)
-    #+gcl
-    ((and (consp directory) (stringp (first directory)))
-     `(:absolute ,@directory))
-    ((or (null directory)
-         (and (consp directory) (member (first directory) '(:absolute :relative))))
-     directory)
-    (t
-     (error "Unrecognized pathname directory component ~S" directory))))
-
-(defun* merge-pathname-directory-components (specified defaults)
-  (let ((directory (normalize-pathname-directory-component specified)))
-    (ecase (first directory)
-      ((nil) defaults)
-      (:absolute specified)
-      (:relative
-       (let ((defdir (normalize-pathname-directory-component defaults))
-             (reldir (cdr directory)))
-         (cond
-           ((null defdir)
-            directory)
-           ((not (eq :back (first reldir)))
-            (append defdir reldir))
-           (t
-            (loop :with defabs = (first defdir)
-              :with defrev = (reverse (rest defdir))
-              :while (and (eq :back (car reldir))
-                          (or (and (eq :absolute defabs) (null defrev))
-                              (stringp (car defrev))))
-              :do (pop reldir) (pop defrev)
-              :finally (return (cons defabs (append (reverse defrev) reldir)))))))))))
-
 (defun* merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
   "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname
@@ -464,5 +414,17 @@
   (let* ((specified (pathname specified))
          (defaults (pathname defaults))
-         (directory (normalize-pathname-directory-component (pathname-directory specified)))
+         (directory (pathname-directory specified))
+         (directory
+          (cond
+            #-(or sbcl cmu scl)
+            ((stringp directory) `(:absolute ,directory) directory)
+            #+gcl
+            ((and (consp directory) (not (member (first directory) '(:absolute :relative))))
+             `(:relative ,@directory))
+            ((or (null directory)
+                 (and (consp directory) (member (first directory) '(:absolute :relative))))
+             directory)
+            (t
+             (error "Unrecognized directory component ~S in pathname ~S" directory specified))))
          (name (or (pathname-name specified) (pathname-name defaults)))
          (type (or (pathname-type specified) (pathname-type defaults)))
@@ -474,4 +436,9 @@
       (multiple-value-bind (host device directory unspecific-handler)
           (ecase (first directory)
+            ((nil)
+             (values (pathname-host defaults)
+                     (pathname-device defaults)
+                     (pathname-directory defaults)
+                     (unspecific-handler defaults)))
             ((:absolute)
              (values (pathname-host specified)
@@ -479,8 +446,10 @@
                      directory
                      (unspecific-handler specified)))
-            ((nil :relative)
+            ((:relative)
              (values (pathname-host defaults)
                      (pathname-device defaults)
-                     (merge-pathname-directory-components directory (pathname-directory defaults))
+                     (if (pathname-directory defaults)
+                         (append (pathname-directory defaults) (cdr directory))
+                         directory)
                      (unspecific-handler defaults))))
         (make-pathname :host host :device device :directory directory
@@ -489,13 +458,4 @@
                        :version (funcall unspecific-handler version))))))
 
-(defun* pathname-parent-directory-pathname (pathname)
-  "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
-and NIL NAME, TYPE and VERSION components"
-  (when pathname
-    (make-pathname :name nil :type nil :version nil
-                   :directory (merge-pathname-directory-components '(:relative :back) (pathname-directory pathname))
-                   :defaults pathname)))
-
-
 (define-modify-macro appendf (&rest args)
   append "Append onto list") ;; only to be used on short lists.
@@ -510,13 +470,7 @@
   (and (stringp s) (plusp (length s)) (char s (1- (length s)))))
 
-(defun* errfmt (out format-string &rest format-args)
-  (declare (dynamic-extent format-args))
-  (apply #'format out
-         #-genera (format nil "~~@<~A~~:>" format-string) #+genera format-string
-         format-args))
-
 (defun* asdf-message (format-string &rest format-args)
   (declare (dynamic-extent format-args))
-  (apply #'errfmt *verbose-out* format-string format-args))
+  (apply #'format *verbose-out* format-string format-args))
 
 (defun* split-string (string &key max (separator '(#\Space #\Tab)))
@@ -545,5 +499,5 @@
          ;; 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)))
+         (or #+(or ccl gcl lispworks sbcl) :unspecific)))
     (destructuring-bind (name &optional (type unspecific))
         (split-string filename :max 2 :separator ".")
@@ -582,6 +536,5 @@
                 (values :relative nil))
           (values :relative components))
-      (setf components (remove-if #'(lambda (x) (member x '("" ".") :test #'equal)) components))
-      (setf components (substitute :back ".." components :test #'equal))
+      (setf components (remove "" components :test #'equal))
       (cond
         ((equal last-comp "")
@@ -603,25 +556,14 @@
     :append (list k v)))
 
-#+mcl
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ccl:define-entry-point (_getenv "getenv") ((name :string)) :string))
-
 (defun* getenv (x)
-  (declare (ignorable x))
-  #+(or abcl clisp) (ext:getenv x)
-  #+allegro (sys:getenv x)
-  #+clozure (ccl:getenv x)
-  #+(or cmu scl) (cdr (assoc x ext:*environment-list* :test #'string=))
-  #+ecl (si:getenv x)
-  #+gcl (system:getenv x)
-  #+genera nil
-  #+lispworks (lispworks:environment-variable x)
-  #+mcl (ccl:with-cstrs ((name x))
-          (let ((value (_getenv name)))
-            (unless (ccl:%null-ptr-p value)
-              (ccl:%get-cstring value))))
-  #+sbcl (sb-ext:posix-getenv x)
-  #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl)
-  (error "getenv not available on your implementation"))
+  (#+(or abcl clisp) ext:getenv
+   #+allegro sys:getenv
+   #+clozure ccl:getenv
+   #+(or cmu scl) (lambda (x) (cdr (assoc x ext:*environment-list* :test #'string=)))
+   #+ecl si:getenv
+   #+gcl system:getenv
+   #+lispworks lispworks:environment-variable
+   #+sbcl sb-ext:posix-getenv
+   x))
 
 (defun* directory-pathname-p (pathname)
@@ -661,9 +603,4 @@
                    :defaults pathspec))))
 
-#+genera
-(unless (fboundp 'ensure-directories-exist)
-  (defun ensure-directories-exist (path)
-    (fs:create-directories-recursively (pathname path))))
-
 (defun* absolute-pathname-p (pathspec)
   (and (typep pathspec '(or pathname string))
@@ -693,5 +630,5 @@
      :collect form)))
 
-#+asdf-unix
+#-(and (or win32 windows mswindows mingw32) (not cygwin))
 (progn
   #+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601)
@@ -733,11 +670,11 @@
    (pathname (unless (wild-pathname-p p)
                #.(or #+(or allegro clozure cmu ecl sbcl scl) '(probe-file p)
-                     #+clisp (aif (find-symbol (string '#:probe-pathname) :ext) `(ignore-errors (,it p)))
-                     '(ignore-errors (truename p)))))))
+               #+clisp (aif (find-symbol (string '#:probe-pathname) :ext) `(ignore-errors (,it p)))
+               '(ignore-errors (truename p)))))))
 
 (defun* truenamize (p)
   "Resolve as much of a pathname as possible"
   (block nil
-    (when (typep p '(or null logical-pathname)) (return p))
+    (when (typep p 'logical-pathname) (return p))
     (let* ((p (merge-pathnames* p))
            (directory (pathname-directory p)))
@@ -771,7 +708,5 @@
 (defun* resolve-symlinks (path)
   #-allegro (truenamize path)
-  #+allegro (if (typep path 'logical-pathname)
-                path
-                (excl:pathname-resolve-symbolic-links path)))
+  #+allegro (excl:pathname-resolve-symbolic-links path))
 
 (defun* default-directory ()
@@ -793,18 +728,15 @@
   (merge-pathnames* *wild-path* path))
 
-(defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*))
-  (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname)))
-    (last-char (namestring foo))))
-
 (defun* directorize-pathname-host-device (pathname)
   (let* ((root (pathname-root pathname))
          (wild-root (wilden root))
          (absolute-pathname (merge-pathnames* pathname root))
-         (separator (directory-separator-for-host root))
+         (foo (make-pathname :directory '(:absolute "FOO") :defaults root))
+         (separator (last-char (namestring foo)))
          (root-namestring (namestring root))
          (root-string
           (substitute-if #\/
-                         #'(lambda (x) (or (eql x #\:)
-                                           (eql x separator)))
+                         (lambda (x) (or (eql x #\:)
+                                         (eql x separator)))
                          root-namestring)))
     (multiple-value-bind (relative path filename)
@@ -925,4 +857,11 @@
 ;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
 (when *upgraded-p*
+   #+ecl
+   (when (find-class 'compile-op nil)
+     (defmethod update-instance-for-redefined-class :after
+         ((c compile-op) added deleted plist &key)
+       (declare (ignore added deleted))
+       (let ((system-p (getf plist 'system-p)))
+         (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
    (when (find-class 'module nil)
      (eval
@@ -931,5 +870,5 @@
          (declare (ignorable deleted plist))
          (when (or *asdf-verbose* *load-verbose*)
-           (asdf-message "~&; Updating ~A for ASDF ~A~%" m ,(asdf-version)))
+           (asdf-message "~&~@<; ~@; Updating ~A for ASDF ~A~@:>~%" m ,(asdf-version)))
          (when (member 'components-by-name added)
            (compute-module-components-by-name m))
@@ -959,8 +898,5 @@
                 error-component error-operation
                 module-components module-components-by-name
-                circular-dependency-components
-                condition-arguments condition-form
-                condition-format condition-location
-                coerce-name)
+                circular-dependency-components)
          (ftype (function (t t) t) (setf module-components-by-name)))
 
@@ -970,5 +906,5 @@
    (format-arguments :initarg :format-arguments :reader format-arguments))
   (:report (lambda (c s)
-               (apply #'errfmt s (format-control c) (format-arguments c)))))
+             (apply #'format s (format-control c) (format-arguments c)))))
 
 (define-condition load-system-definition-error (system-definition-error)
@@ -977,17 +913,17 @@
    (condition :initarg :condition :reader error-condition))
   (:report (lambda (c s)
-	     (errfmt s "Error while trying to load definition for system ~A from pathname ~A: ~A"
-		     (error-name c) (error-pathname c) (error-condition c)))))
+             (format s "~@<Error while trying to load definition for system ~A from pathname ~A: ~A~@:>"
+                     (error-name c) (error-pathname c) (error-condition c)))))
 
 (define-condition circular-dependency (system-definition-error)
   ((components :initarg :components :reader circular-dependency-components))
   (:report (lambda (c s)
-	     (errfmt s "Circular dependency: ~S" (circular-dependency-components c)))))
+             (format s "~@<Circular dependency: ~S~@:>" (circular-dependency-components c)))))
 
 (define-condition duplicate-names (system-definition-error)
   ((name :initarg :name :reader duplicate-names-name))
   (:report (lambda (c s)
-	     (errfmt s "Error while defining system: multiple components are given same name ~A"
-		     (duplicate-names-name c)))))
+             (format s "~@<Error while defining system: multiple components are given same name ~A~@:>"
+                     (duplicate-names-name c)))))
 
 (define-condition missing-component (system-definition-error)
@@ -1009,6 +945,6 @@
    (operation :reader error-operation :initarg :operation))
   (:report (lambda (c s)
-               (errfmt s "erred while invoking ~A on ~A"
-                       (error-operation c) (error-component c)))))
+             (format s "~@<erred while invoking ~A on ~A~@:>"
+                     (error-operation c) (error-component c)))))
 (define-condition compile-error (operation-error) ())
 (define-condition compile-failed (compile-error) ())
@@ -1021,12 +957,12 @@
    (arguments :reader condition-arguments :initarg :arguments :initform nil))
   (:report (lambda (c s)
-               (errfmt s "~? (will be skipped)"
-                       (condition-format c)
-                       (list* (condition-form c) (condition-location c)
-                              (condition-arguments c))))))
+             (format s "~@<~? (will be skipped)~@:>"
+                     (condition-format c)
+                     (list* (condition-form c) (condition-location c)
+                            (condition-arguments c))))))
 (define-condition invalid-source-registry (invalid-configuration warning)
-  ((format :initform "invalid source registry ~S~@[ in ~S~]~@{ ~@?~}")))
+  ((format :initform "~@<invalid source registry ~S~@[ in ~S~]~@{ ~@?~}~>")))
 (define-condition invalid-output-translation (invalid-configuration warning)
-  ((format :initform "invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}")))
+  ((format :initform "~@<invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~>")))
 
 (defclass component ()
@@ -1034,10 +970,7 @@
          "Component name: designator for a string composed of portable pathname characters")
    (version :accessor component-version :initarg :version)
-   (description :accessor component-description :initarg :description)
-   (long-description :accessor component-long-description :initarg :long-description)
-   ;; This one below is used by POIU - http://www.cliki.net/poiu
-   ;; a parallelizing extension of ASDF that compiles in multiple parallel
-   ;; slave processes (forked on demand) and loads in the master process.
-   ;; Maybe in the future ASDF may use it internally instead of in-order-to.
+   ;; This one is used by POIU. Maybe in the future by ASDF instead of in-order-to?
+   ;; POIU is a parallel (multi-process build) extension of ASDF.  See
+   ;; http://www.cliki.net/poiu
    (load-dependencies :accessor component-load-dependencies :initform nil)
    ;; In the ASDF object model, dependencies exist between *actions*
@@ -1058,5 +991,4 @@
    ;; 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!
-   ;; See our ASDF 2 paper for more complete explanations.
    (in-order-to :initform nil :initarg :in-order-to
                 :accessor component-in-order-to)
@@ -1086,5 +1018,5 @@
 (defmethod print-object ((c component) stream)
   (print-unreadable-object (c stream :type t :identity nil)
-    (format stream "~{~S~^ ~}" (component-find-path c))))
+    (format stream "~@<~{~S~^ ~}~@:>" (component-find-path c))))
 
 
@@ -1092,5 +1024,5 @@
 
 (defmethod print-object ((c missing-dependency) s)
-  (format s "~A, required by ~A"
+  (format s "~@<~A, required by ~A~@:>"
           (call-next-method c nil) (missing-required-by c)))
 
@@ -1102,5 +1034,5 @@
 
 (defmethod print-object ((c missing-component) s)
-  (format s "component ~S not found~@[ in ~A~]"
+  (format s "~@<component ~S not found~@[ in ~A~]~@:>"
           (missing-requires c)
           (when (missing-parent c)
@@ -1108,5 +1040,5 @@
 
 (defmethod print-object ((c missing-component-of-version) s)
-  (format s "component ~S does not match version ~A~@[ in ~A~]"
+  (format s "~@<component ~S does not match version ~A~@[ in ~A~]~@:>"
           (missing-requires c)
           (missing-version c)
@@ -1185,8 +1117,7 @@
 
 (defclass system (module)
-  (;; description and long-description are now available for all component's,
-   ;; but now also inherited from component, but we add the legacy accessor
-   (description :accessor system-description :initarg :description)
-   (long-description :accessor system-long-description :initarg :long-description)
+  ((description :accessor system-description :initarg :description)
+   (long-description
+    :accessor system-long-description :initarg :long-description)
    (author :accessor system-author :initarg :author)
    (maintainer :accessor system-maintainer :initarg :maintainer)
@@ -1237,5 +1168,5 @@
     (symbol (string-downcase (symbol-name name)))
     (string name)
-    (t (sysdef-error "invalid component designator ~A" name))))
+    (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
 
 (defun* system-registered-p (name)
@@ -1255,9 +1186,9 @@
 FN should be a function of one argument. It will be
 called with an object of type asdf:system."
-  (maphash #'(lambda (_ datum)
+  (maphash (lambda (_ datum)
+             (declare (ignore _))
+             (destructuring-bind (_ . def) datum
                (declare (ignore _))
-               (destructuring-bind (_ . def) datum
-                 (declare (ignore _))
-                 (funcall fn def)))
+               (funcall fn def)))
            *defined-systems*))
 
@@ -1271,5 +1202,5 @@
   (let ((system-name (coerce-name system)))
     (or
-     (some #'(lambda (x) (funcall x system-name))
+     (some (lambda (x) (funcall x system-name))
            *system-definition-search-functions*)
      (let ((system-pair (system-registered-p system-name)))
@@ -1300,7 +1231,7 @@
               :name name
               :type "asd")))
-        (when (probe-file* file)
+        (when (probe-file file)
           (return file)))
-      #+(and asdf-windows (not clisp))
+      #+(and (or win32 windows mswindows mingw32) (not cygwin) (not clisp))
       (let ((shortcut
              (make-pathname
@@ -1308,5 +1239,5 @@
               :name (concatenate 'string name ".asd")
               :type "lnk")))
-        (when (probe-file* shortcut)
+        (when (probe-file shortcut)
           (let ((target (parse-windows-shortcut shortcut)))
             (when target
@@ -1330,6 +1261,6 @@
                             (let* ((*print-circle* nil)
                                    (message
-                                    (errfmt nil
-                                            "While searching for system ~S: ~S evaluated to ~S which is not a directory."
+                                    (format nil
+                                            "~@<While searching for system ~S: ~S evaluated to ~S which is not a directory.~@:>"
                                             system dir defaults)))
                               (error message))
@@ -1339,6 +1270,6 @@
                           (coerce-entry-to-directory ()
                             :report (lambda (s)
-				      (errfmt s "Coerce entry to ~a, replace ~a and continue."
-					      (ensure-directory-pathname defaults) dir))
+                                      (format s "Coerce entry to ~a, replace ~a and continue."
+                                              (ensure-directory-pathname defaults) dir))
                             (push (cons dir (ensure-directory-pathname defaults)) to-replace))))))))
         ;; cleanup
@@ -1372,5 +1303,5 @@
   ;; as if the file were very old.
   ;; (or should we treat the case in a different, special way?)
-  (or (and pathname (probe-file* pathname) (file-write-date pathname))
+  (or (and pathname (probe-file pathname) (file-write-date pathname))
       (progn
         (when (and pathname *asdf-verbose*)
@@ -1387,11 +1318,11 @@
     (unwind-protect
          (handler-bind
-             ((error #'(lambda (condition)
-                         (error 'load-system-definition-error
-                                :name name :pathname pathname
-                                :condition condition))))
+             ((error (lambda (condition)
+                       (error 'load-system-definition-error
+                              :name name :pathname pathname
+                              :condition condition))))
            (let ((*package* package))
              (asdf-message
-              "~&; Loading system definition from ~A into ~A~%"
+              "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%"
               pathname package)
              (load pathname)))
@@ -1419,5 +1350,5 @@
 
 (defun* register-system (name system)
-  (asdf-message "~&; Registering ~A as ~A~%" system name)
+  (asdf-message "~&~@<; ~@;Registering ~A as ~A~@:>~%" system name)
   (setf (gethash (coerce-name name) *defined-systems*)
         (cons (get-universal-time) system)))
@@ -1498,18 +1429,4 @@
 
 (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.014.
-  (coerce-pathname name :type type :defaults defaults))
-
-(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
@@ -1520,8 +1437,8 @@
   ;; ASDF:MERGE-PATHNAMES*
   (etypecase name
-    ((or null pathname)
+    (pathname
      name)
     (symbol
-     (coerce-pathname (string-downcase name) :type type :defaults defaults))
+     (merge-component-name-type (string-downcase name) :type type :defaults defaults))
     (string
      (multiple-value-bind (relative path filename)
@@ -1544,5 +1461,5 @@
 
 (defmethod component-relative-pathname ((component component))
-  (coerce-pathname
+  (merge-component-name-type
    (or (slot-value component 'relative-pathname)
        (component-name component))
@@ -1652,6 +1569,6 @@
 (defmethod component-self-dependencies ((o operation) (c component))
   (let ((all-deps (component-depends-on o c)))
-    (remove-if-not #'(lambda (x)
-                       (member (component-name c) (cdr x) :test #'string=))
+    (remove-if-not (lambda (x)
+                     (member (component-name c) (cdr x) :test #'string=))
                    all-deps)))
 
@@ -1660,8 +1577,8 @@
         (self-deps (component-self-dependencies operation c)))
     (if self-deps
-        (mapcan #'(lambda (dep)
-                    (destructuring-bind (op name) dep
-                      (output-files (make-instance op)
-                                    (find-component parent name))))
+        (mapcan (lambda (dep)
+                  (destructuring-bind (op name) dep
+                    (output-files (make-instance op)
+                                  (find-component parent name))))
                 self-deps)
         ;; no previous operations needed?  I guess we work with the
@@ -1717,6 +1634,6 @@
          ;; second). So that's cool.
          (and
-          (every #'probe-file* in-files)
-          (every #'probe-file* out-files)
+          (every #'probe-file in-files)
+          (every #'probe-file out-files)
           (>= (earliest-out) (latest-in))))))))
 
@@ -1765,11 +1682,11 @@
       (retry ()
         :report (lambda (s)
-		  (errfmt s "Retry loading component ~S." required-c))
+                  (format s "~@<Retry loading component ~S.~@:>" required-c))
         :test
         (lambda (c)
-	  (or (null c)
-	      (and (typep c 'missing-dependency)
-		   (equalp (missing-requires c)
-			   required-c))))))))
+          (or (null c)
+              (and (typep c 'missing-dependency)
+                   (equalp (missing-requires c)
+                           required-c))))))))
 
 (defun* do-dep (operation c collect op dep)
@@ -1934,5 +1851,5 @@
 (defmethod perform ((operation operation) (c source-file))
   (sysdef-error
-   "required method PERFORM not implemented for operation ~A, component ~A"
+   "~@<required method PERFORM not implemented for operation ~A, component ~A~@:>"
    (class-of operation) (class-of c)))
 
@@ -1957,5 +1874,5 @@
                :initform *compile-file-failure-behaviour*)
    (flags :initarg :flags :accessor compile-op-flags
-          :initform nil)))
+          :initform #-ecl nil #+ecl '(:system-p t))))
 
 (defun output-file (operation component)
@@ -1966,9 +1883,14 @@
 
 (defmethod perform :before ((operation compile-op) (c source-file))
-   (loop :for file :in (asdf:output-files operation c)
-     :for pathname = (if (typep file 'logical-pathname)
-                         (translate-logical-pathname file)
-                         file)
-     :do (ensure-directories-exist pathname)))
+  (map nil #'ensure-directories-exist (output-files operation c)))
+
+#+ecl
+(defmethod perform :after ((o compile-op) (c cl-source-file))
+  ;; Note how we use OUTPUT-FILES to find the binary locations
+  ;; This allows the user to override the names.
+  (let* ((files (output-files o c))
+         (object (first files))
+         (fasl (second files)))
+    (c:build-fasl fasl :lisp-files (list object))))
 
 (defmethod perform :after ((operation operation) (c component))
@@ -1976,6 +1898,8 @@
         (get-universal-time)))
 
-(defvar *compile-op-compile-file-function* 'compile-file*
-  "Function used to compile lisp files.")
+(declaim (ftype (function ((or pathname string)
+                           &rest t &key (:output-file t) &allow-other-keys)
+                          (values t t t))
+                compile-file*))
 
 ;;; perform is required to check output-files to find out where to put
@@ -1990,10 +1914,10 @@
         (*compile-file-failure-behaviour* (operation-on-failure operation)))
     (multiple-value-bind (output warnings-p failure-p)
-        (apply *compile-op-compile-file-function* source-file :output-file output-file
+        (apply #'compile-file* source-file :output-file output-file
                (compile-op-flags operation))
       (when warnings-p
         (case (operation-on-warnings operation)
           (:warn (warn
-                  "COMPILE-FILE warned while performing ~A on ~A."
+                  "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>"
                   operation c))
           (:error (error 'compile-warned :component c :operation operation))
@@ -2002,5 +1926,5 @@
         (case (operation-on-failure operation)
           (:warn (warn
-                  "COMPILE-FILE failed while performing ~A on ~A."
+                  "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>"
                   operation c))
           (:error (error 'compile-failed :component c :operation operation))
@@ -2012,6 +1936,8 @@
   (declare (ignorable operation))
   (let ((p (lispize-pathname (component-pathname c))))
-    #-broken-fasl-loader (list (compile-file-pathname p))
-    #+broken-fasl-loader (list p)))
+    #-:broken-fasl-loader
+    (list (compile-file-pathname p #+ecl :type #+ecl :object)
+          #+ecl (compile-file-pathname p :type :fasl))
+    #+:broken-fasl-loader (list p)))
 
 (defmethod perform ((operation compile-op) (c static-file))
@@ -2039,5 +1965,9 @@
 
 (defmethod perform ((o load-op) (c cl-source-file))
-  (map () #'load (input-files o c)))
+  (map () #'load
+       #-ecl (input-files o c)
+       #+ecl (loop :for i :in (input-files o c)
+               :unless (string= (pathname-type i) "fas")
+               :collect (compile-file-pathname (lispize-pathname i)))))
 
 (defmethod perform-with-restarts (operation component)
@@ -2132,8 +2062,8 @@
   (let ((what-would-load-op-do (cdr (assoc 'load-op
                                            (component-in-order-to c)))))
-    (mapcar #'(lambda (dep)
-                (if (eq (car dep) 'load-op)
-                    (cons 'load-source-op (cdr dep))
-                    dep))
+    (mapcar (lambda (dep)
+              (if (eq (car dep) 'load-op)
+                  (cons 'load-source-op (cdr dep))
+                  dep))
             what-would-load-op-do)))
 
@@ -2198,10 +2128,10 @@
                 :report
                 (lambda (s)
-		  (errfmt s "Retry ~A." (operation-description op component))))
+                  (format s "~@<Retry ~A.~@:>" (operation-description op component))))
               (accept ()
                 :report
                 (lambda (s)
-		  (errfmt s "Continue, treating ~A as having been successful."
-			  (operation-description op component)))
+                  (format s "~@<Continue, treating ~A as having been successful.~@:>"
+                          (operation-description op component)))
                 (setf (gethash (type-of op)
                                (component-operation-times component))
@@ -2281,7 +2211,5 @@
   (let* ((file-pathname (load-pathname))
          (directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
-    (or (and pathname-supplied-p
-             (merge-pathnames* (coerce-pathname pathname :type :directory)
-                               directory-pathname))
+    (or (and pathname-supplied-p (merge-pathnames* pathname directory-pathname))
         directory-pathname
         (default-directory))))
@@ -2326,5 +2254,5 @@
            (or (module-default-component-class parent)
                (find-class *default-component-class*)))
-      (sysdef-error "don't recognize component type ~A" type)))
+      (sysdef-error "~@<don't recognize component type ~A~@:>" type)))
 
 (defun* maybe-add-tree (tree op1 op2 c)
@@ -2383,6 +2311,6 @@
          ;; methods will not be for this particular gf
          ;; But this is hardly performance-critical
-         #'(lambda (m)
-             (remove-method (symbol-function name) m))
+         (lambda (m)
+           (remove-method (symbol-function name) m))
          (component-inline-methods component)))
   ;; clear methods, then add the new ones
@@ -2585,5 +2513,5 @@
 (defun* system-relative-pathname (system name &key type)
   (merge-pathnames*
-   (coerce-pathname name :type type)
+   (merge-component-name-type name :type type)
    (system-source-directory system)))
 
@@ -2596,11 +2524,11 @@
 
 (defparameter *implementation-features*
-  '((:abcl :armedbear)
-    (:acl :allegro)
-    (:mcl :digitool) ; before clozure, so it won't get preempted by ccl
+  '((:acl :allegro)
+    (:lw :lispworks)
+    (:digitool) ; before clozure, so it won't get preempted by ccl
     (:ccl :clozure)
     (:corman :cormanlisp)
-    (:lw :lispworks)
-    :clisp :cmu :ecl :gcl :sbcl :scl :symbolics))
+    (:abcl :armedbear)
+    :sbcl :cmu :clisp :gcl :ecl :scl))
 
 (defparameter *os-features*
@@ -2610,6 +2538,5 @@
     (:macosx :darwin :darwin-target :apple)
     :freebsd :netbsd :openbsd :bsd
-    :unix
-    :genera))
+    :unix))
 
 (defparameter *architecture-features*
@@ -2623,6 +2550,5 @@
     (:sparc32 :sparc)
     (:arm :arm-target)
-    (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7)
-    :imach))
+    (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7)))
 
 (defun* lisp-version-string ()
@@ -2642,5 +2568,5 @@
                       (if (member :64bit *features*) "-64bit" ""))
     #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
-    #+clisp (subseq s 0 (position #\space s)) ; strip build information (date, etc.)
+    #+clisp (subseq s 0 (position #\space s))
     #+clozure (format nil "~d.~d-f~d" ; shorten for windows
                       ccl::*openmcl-major-version*
@@ -2648,4 +2574,5 @@
                       (logand ccl::fasl-version #xFF))
     #+cmu (substitute #\- #\/ s)
+    #+digitool (subseq s 8)
     #+ecl (format nil "~A~@[-~A~]" s
                   (let ((vcs-id (ext:lisp-implementation-vcs-id)))
@@ -2653,13 +2580,10 @@
                       (subseq vcs-id 0 8))))
     #+gcl (subseq s (1+ (position #\space s)))
-    #+genera (multiple-value-bind (major minor) (sct:get-system-version "System")
-               (format nil "~D.~D" major minor))
     #+lispworks (format nil "~A~@[~A~]" s
                         (when (member :lispworks-64bit *features*) "-64bit"))
     ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; f-f-v redundant w/ version
-    #+mcl (subseq s 8) ; strip the leading "Version "
-    #+(or cormanlisp sbcl scl) s
-    #-(or allegro armedbear clisp clozure cmu cormanlisp
-          ecl gcl genera lispworks mcl sbcl scl) s))
+    #+(or cormanlisp mcl sbcl scl) s
+    #-(or allegro armedbear clisp clozure cmu cormanlisp digitool
+          ecl gcl lispworks mcl sbcl scl) s))
 
 (defun* first-feature (features)
@@ -2693,13 +2617,13 @@
           (os   (maybe-warn (first-feature *os-features*)
                             "No os feature found in ~a." *os-features*))
-          (arch (or #-clisp
-                    (maybe-warn (first-feature *architecture-features*)
-                                "No architecture feature found in ~a."
-                                *architecture-features*)))
+          (arch #+clisp "" #-clisp
+                (maybe-warn (first-feature *architecture-features*)
+                            "No architecture feature found in ~a."
+                            *architecture-features*))
           (version (maybe-warn (lisp-version-string)
                                "Don't know how to get Lisp implementation version.")))
       (substitute-if
-       #\_ #'(lambda (x) (find x " /:\\(){}[]$#`'\""))
-       (format nil "~(~a~@{~@[-~a~]~}~)" lisp version os arch)))))
+       #\_ (lambda (x) (find x " /:\\(){}[]$#`'\""))
+       (format nil "~(~@{~a~^-~}~)" lisp version os arch)))))
 
 
@@ -2708,14 +2632,14 @@
 
 (defparameter *inter-directory-separator*
-  #+asdf-unix #\:
-  #-asdf-unix #\;)
+  #+(or unix cygwin) #\:
+  #-(or unix cygwin) #\;)
 
 (defun* user-homedir ()
-  (truenamize (pathname-directory-pathname (user-homedir-pathname))))
+  (truename (user-homedir-pathname)))
 
 (defun* try-directory-subpath (x sub &key type)
   (let* ((p (and x (ensure-directory-pathname x)))
          (tp (and p (probe-file* p)))
-         (sp (and tp (merge-pathnames* (coerce-pathname sub :type type) p)))
+         (sp (and tp (merge-pathnames* (merge-component-name-type sub :type type) p)))
          (ts (and sp (probe-file* sp))))
     (and ts (values sp ts))))
@@ -2728,5 +2652,5 @@
            :for dir :in (split-string dirs :separator ":")
            :collect (try dir "common-lisp/"))
-       #+asdf-windows
+       #+(and (or win32 windows mswindows mingw32) (not cygwin))
         ,@`(#+lispworks ,(try (sys:get-folder-path :common-appdata) "common-lisp/config/")
             ;;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
@@ -2737,10 +2661,9 @@
    #'null
    (append
-    #+asdf-windows
+    #+(and (or win32 windows mswindows mingw32) (not cygwin))
     (flet ((try (x sub) (try-directory-subpath x sub :type :directory)))
       `(,@`(#+lispworks ,(try (sys:get-folder-path :local-appdata) "common-lisp/config/")
            ;;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
         ,(try (getenv "ALLUSERSPROFILE") "Application Data/common-lisp/config/"))))
-    #+asdf-unix
     (list #p"/etc/common-lisp/"))))
 (defun* in-first-directory (dirs x)
@@ -2811,5 +2734,5 @@
   (apply 'directory pathname-spec
          (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
-                             #+clozure '(:follow-links nil)
+                             #+ccl '(:follow-links nil)
                              #+clisp '(:circle t :if-does-not-exist :ignore)
                              #+(or cmu scl) '(:follow-links nil :truenamep nil)
@@ -2859,5 +2782,5 @@
     (or
      (try (getenv "XDG_CACHE_HOME") "common-lisp" :implementation)
-     #+asdf-windows
+     #+(and (or win32 windows mswindows mingw32) (not cygwin))
      (try (getenv "APPDATA") "common-lisp" "cache" :implementation)
      '(:home ".cache" "common-lisp" :implementation))))
@@ -2874,10 +2797,10 @@
         (list
          (stable-sort (copy-list new-value) #'>
-                      :key #'(lambda (x)
-                               (etypecase (car x)
-                                 ((eql t) -1)
-                                 (pathname
-                                  (let ((directory (pathname-directory (car x))))
-                                    (if (listp directory) (length directory) 0))))))))
+                      :key (lambda (x)
+                             (etypecase (car x)
+                               ((eql t) -1)
+                               (pathname
+                                (let ((directory (pathname-directory (car x))))
+                                  (if (listp directory) (length directory) 0))))))))
   new-value)
 
@@ -2918,5 +2841,5 @@
               ((eql :implementation) (implementation-identifier))
               ((eql :implementation-type) (string-downcase (implementation-type)))
-              #+asdf-unix
+              #-(and (or win32 windows mswindows mingw32) (not cygwin))
               ((eql :uid) (princ-to-string (get-uid)))))
          (d (if (or (pathnamep x) (not directory)) r (ensure-directory-pathname r)))
@@ -2989,5 +2912,5 @@
                       (member :default-directory :*/ :**/ :*.*.*
                         :implementation :implementation-type
-                        #+asdf-unix :uid)))))
+                        #-(and (or win32 windows mswindows mingw32) (not cygwin)) :uid)))))
     (or (typep x 'boolean)
         (absolute-component-p x)
@@ -3081,6 +3004,5 @@
     ;; Some implementations have precompiled ASDF systems,
     ;; so we must disable translations for implementation paths.
-    #+sbcl ,(let ((h (getenv "SBCL_HOME")))
-                 (when (plusp (length h)) `((,(truenamize h) ,*wild-inferiors*) ())))
+    #+sbcl ,(let ((h (getenv "SBCL_HOME"))) (when (plusp (length h)) `(,h ())))
     #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; not needed: no precompiled ASDF system
     #+clozure ,(ignore-errors (list (wilden (let ((*default-pathname-defaults* #p"")) (truename #p"ccl:"))) ())) ; not needed: no precompiled ASDF system
@@ -3093,6 +3015,6 @@
     :enable-user-cache))
 
-(defparameter *output-translations-file* (coerce-pathname "asdf-output-translations.conf"))
-(defparameter *output-translations-directory* (coerce-pathname "asdf-output-translations.conf.d/"))
+(defparameter *output-translations-file* #p"asdf-output-translations.conf")
+(defparameter *output-translations-directory* #p"asdf-output-translations.conf.d/")
 
 (defun* user-output-translations-pathname ()
@@ -3122,5 +3044,5 @@
      (process-output-translations (validate-output-translations-directory pathname)
                                   :inherit inherit :collect collect))
-    ((probe-file* pathname)
+    ((probe-file pathname)
      (process-output-translations (validate-output-translations-file pathname)
                                   :inherit inherit :collect collect))
@@ -3185,11 +3107,8 @@
    :test 'equal :from-end t))
 
-(defvar *output-translations-parameter* nil)
-
-(defun* initialize-output-translations (&optional (parameter *output-translations-parameter*))
+(defun* initialize-output-translations (&optional parameter)
   "read the configuration, initialize the internal configuration variable,
 return the configuration"
-  (setf *output-translations-parameter* parameter
-        (output-translations) (compute-output-translations parameter)))
+  (setf (output-translations) (compute-output-translations parameter)))
 
 (defun* disable-output-translations ()
@@ -3267,5 +3186,5 @@
 
 (defun* delete-file-if-exists (x)
-  (when (and x (probe-file* x))
+  (when (and x (probe-file x))
     (delete-file x)))
 
@@ -3360,5 +3279,5 @@
 ;;;; http://www.wotsit.org/list.asp?fc=13
 
-#+(and asdf-windows (not clisp))
+#+(and (or win32 windows mswindows mingw32) (not cygwin) (not clisp))
 (progn
 (defparameter *link-initial-dword* 76)
@@ -3470,9 +3389,10 @@
 (defun directory-has-asd-files-p (directory)
   (ignore-errors
-    (and (directory* (merge-pathnames* *wild-asd* directory)) t)))
+    (directory* (merge-pathnames* *wild-asd* directory))
+    t))
 
 (defun subdirectories (directory)
   (let* ((directory (ensure-directory-pathname directory))
-         #-(or cormanlisp genera)
+         #-cormanlisp
          (wild (merge-pathnames*
                 #-(or abcl allegro lispworks scl)
@@ -3481,19 +3401,15 @@
                 directory))
          (dirs
-          #-(or cormanlisp genera)
+          #-cormanlisp
           (ignore-errors
-            (directory* wild . #.(or #+clozure '(:directories t :files nil)
-                                     #+mcl '(:directories t))))
-          #+cormanlisp (cl::directory-subdirs directory)
-          #+genera (fs:directory-list directory))
-         #+(or abcl allegro genera lispworks scl)
+            (directory* wild . #.(or #+ccl '(:directories t :files nil)
+                                     #+digitool '(:directories t))))
+          #+cormanlisp (cl::directory-subdirs directory))
+         #+(or abcl allegro lispworks scl)
          (dirs (remove-if-not #+abcl #'extensions:probe-directory
                               #+allegro #'excl:probe-directory
                               #+lispworks #'lw:file-directory-p
-                              #+genera #'(lambda (x) (getf (cdr x) :directory))
-                              #-(or abcl allegro genera lispworks) #'directory-pathname-p
-                              dirs))
-         #+genera
-         (dirs (mapcar #'(lambda (x) (ensure-directory-pathname (first x))) dirs)))
+                              #-(or abcl allegro lispworks) #'directory-pathname-p
+                              dirs)))
     dirs))
 
@@ -3590,10 +3506,10 @@
     default-source-registry))
 
-(defparameter *source-registry-file* (coerce-pathname "source-registry.conf"))
-(defparameter *source-registry-directory* (coerce-pathname "source-registry.conf.d/"))
+(defparameter *source-registry-file* #p"source-registry.conf")
+(defparameter *source-registry-directory* #p"source-registry.conf.d/")
 
 (defun* wrapping-source-registry ()
   `(:source-registry
-    #+sbcl (:tree ,(truenamize (getenv "SBCL_HOME")))
+    #+sbcl (:tree ,(getenv "SBCL_HOME"))
     :inherit-configuration
     #+cmu (:tree #p"modules:")))
@@ -3602,7 +3518,7 @@
     `(:source-registry
       #+sbcl (:directory ,(merge-pathnames* ".sbcl/systems/" (user-homedir)))
-      (:directory ,(default-directory))
+      (:directory ,(truenamize (directory-namestring *default-pathname-defaults*)))
       ,@(let*
-         #+asdf-unix
+         #+(or unix cygwin)
          ((datahome
            (or (getenv "XDG_DATA_HOME")
@@ -3611,5 +3527,5 @@
            (or (getenv "XDG_DATA_DIRS") "/usr/local/share:/usr/share"))
           (dirs (cons datahome (split-string datadirs :separator ":"))))
-         #+asdf-windows
+         #+(and (or win32 windows mswindows mingw32) (not cygwin))
          ((datahome (getenv "APPDATA"))
           (datadir
@@ -3618,5 +3534,5 @@
                             "Application Data"))
           (dirs (list datahome datadir)))
-         #-(or asdf-unix asdf-windows)
+         #-(or unix win32 windows mswindows mingw32 cygwin)
          ((dirs ()))
          (loop :for dir :in dirs
@@ -3649,5 +3565,5 @@
        (process-source-registry (validate-source-registry-directory pathname)
                                 :inherit inherit :register register)))
-    ((probe-file* pathname)
+    ((probe-file pathname)
      (let ((*here-directory* (pathname-directory-pathname pathname)))
        (process-source-registry (validate-source-registry-file pathname)
@@ -3705,6 +3621,6 @@
           ,parameter
           ,@*default-source-registries*)
-        :register #'(lambda (directory &key recurse exclude)
-                      (collect (list directory :recurse recurse :exclude exclude)))))
+        :register (lambda (directory &key recurse exclude)
+                    (collect (list directory :recurse recurse :exclude exclude)))))
      :test 'equal :from-end t)))
 
@@ -3719,9 +3635,6 @@
          :recurse recurse :exclude exclude :collect #'collect)))))
 
-(defvar *source-registry-parameter* nil)
-
-(defun* initialize-source-registry (&optional (parameter *source-registry-parameter*))
-  (setf *source-registry-parameter* parameter
-        (source-registry) (compute-source-registry parameter)))
+(defun* initialize-source-registry (&optional parameter)
+  (setf (source-registry) (compute-source-registry parameter)))
 
 ;; Checks an initial variable to see whether the state is initialized
@@ -3756,7 +3669,7 @@
       ((style-warning #'muffle-warning)
        (missing-component (constantly nil))
-       (error #'(lambda (e)
-                  (errfmt *error-output* "ASDF could not load ~(~A~) because ~A.~%"
-                          name e))))
+       (error (lambda (e)
+                (format *error-output* "ASDF could not load ~(~A~) because ~A.~%"
+                        name e))))
     (let* ((*verbose-out* (make-broadcast-stream))
            (system (find-system (string-downcase name) nil)))
@@ -3782,4 +3695,15 @@
 ;;;; See https://bugs.launchpad.net/asdf/+bug/485687
 ;;;;
+;;;; TODO: debug why it's not enough to upgrade from ECL <= 9.11.1
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  #+ecl ;; Support upgrade from before ECL went to 1.369
+  (when (fboundp 'compile-op-system-p)
+    (defmethod compile-op-system-p ((op compile-op))
+      (getf :system-p (compile-op-flags op)))
+    (defmethod initialize-instance :after ((op compile-op)
+                                           &rest initargs
+                                           &key system-p &allow-other-keys)
+      (declare (ignorable initargs))
+      (when system-p (appendf (compile-op-flags op) (list :system-p system-p))))))
 
 ;;; If a previous version of ASDF failed to read some configuration, try again.