[cmucl-cvs] CMUCL commit: src/contrib/asdf (asdf.lisp)

Raymond Toy rtoy at common-lisp.net
Thu Mar 24 16:40:59 UTC 2011

    Date: Thursday, March 24, 2011 @ 12:40:59
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/contrib/asdf

Modified: asdf.lisp

Update to upstream released version 2.013.

 asdf.lisp |  870 +++++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 520 insertions(+), 350 deletions(-)

Index: src/contrib/asdf/asdf.lisp
diff -u src/contrib/asdf/asdf.lisp:1.11 src/contrib/asdf/asdf.lisp:1.12
--- src/contrib/asdf/asdf.lisp:1.11	Wed Dec  8 18:57:02 2010
+++ src/contrib/asdf/asdf.lisp	Thu Mar 24 12:40:59 2011
@@ -1,5 +1,5 @@
-;;; -*- mode: common-lisp; package: asdf; -*-
-;;; This is ASDF: Another System Definition Facility.
+;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
+;;; This is ASDF 2.013: Another System Definition Facility.
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel at common-lisp.net>.
@@ -10,9 +10,9 @@
 ;;; trouble using it, or find bugs, you may want to check at the
 ;;; 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 HEAD
-;;; is the latest development version, whereas the revision tagged
-;;; RELEASE may be slightly older but is considered `stable'
+;;; 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'
 ;;; (This is the MIT / X Consortium license as taken from
@@ -47,7 +47,7 @@
 #+xcvb (module ())
-(cl:in-package :cl-user)
+(cl:in-package #-genera :common-lisp-user #+genera :future-common-lisp-user)
 #+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
@@ -55,14 +55,16 @@
   ;;; make package if it doesn't exist yet.
   ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
   (unless (find-package :asdf)
-    (make-package :asdf :use '(:cl)))
+    (make-package :asdf :use '(:common-lisp)))
   ;;; Implementation-dependent tweaks
   ;; (declaim (optimize (speed 2) (debug 2) (safety 3))) ; NO: rely on the implementation defaults.
   (setf excl::*autoload-package-name-alist*
         (remove "asdf" excl::*autoload-package-name-alist*
                 :test 'equalp :key 'car))
-  #+ecl (require :cmp))
+  #+(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*))
 (in-package :asdf)
@@ -74,25 +76,35 @@
   (defvar *asdf-version* nil)
   (defvar *upgraded-p* nil)
   (let* (;; For bug reporting sanity, please always bump this version when you modify this file.
+         ;; 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 local modification of an official release
-         ;; "2.345.6.7" would be your local modification of a development version
-         (asdf-version "2.011")
+         ;; "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")
          (existing-asdf (fboundp 'find-system))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
     (unless (and existing-asdf already-there)
       (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))
-          ((unlink-package (package)
+          ((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)
              (let ((u (find-package package)))
                (when u
-                 (ensure-unintern u
-                   (loop :for s :being :each :present-symbol :in u :collect s))
+                 (ensure-unintern u (present-symbols u))
                  (loop :for p :in (package-used-by-list u) :do
                    (unuse-package u p))
                  (delete-package u))))
@@ -146,7 +158,7 @@
              (let ((formerly-exported-symbols nil)
                    (bothly-exported-symbols nil)
                    (newly-exported-symbols nil))
-               (loop :for sym :being :each :external-symbol :in package :do
+               (do-external-symbols (sym package)
                  (if (member sym export :test 'string-equal)
                      (push sym bothly-exported-symbols)
                      (push sym formerly-exported-symbols)))
@@ -184,7 +196,8 @@
            (#:perform #:explain #:output-files #:operation-done-p
             #:perform-with-restarts #:component-relative-pathname
             #:system-source-file #:operate #:find-component #:find-system
-            #:apply-output-translations #:translate-pathname* #:resolve-location)
+            #:apply-output-translations #:translate-pathname* #:resolve-location
+            #:compile-file*)
            (#:*asdf-revision* #:around #:asdf-method-combination
             #:split #:make-collector
@@ -276,6 +289,7 @@
+            #:*output-translations-parameter*
@@ -285,6 +299,7 @@
+            #:*source-registry-parameter*
@@ -306,6 +321,7 @@
             ;; #:length=n-p
             ;; #:find-symbol*
+            #:coerce-pathname
             ;; #:remove-keys
@@ -317,6 +333,7 @@
+	#+genera (import 'scl:boolean :asdf)
         (setf *asdf-version* asdf-version
               *upgraded-p* (if existing-version
                                (cons existing-version *upgraded-p*)
@@ -328,7 +345,7 @@
 (defun asdf-version ()
   "Exported interface to the version of ASDF currently installed. A string.
 You can compare this string with e.g.:
 (defvar *resolve-symlinks* t
@@ -403,6 +420,41 @@
   (when pathname
     (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 , at 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
 does not have an absolute directory, then the HOST and DEVICE come from the DEFAULTS.
@@ -411,19 +463,7 @@
   (when (null defaults) (return-from merge-pathnames* specified))
   (let* ((specified (pathname specified))
          (defaults (pathname defaults))
-         (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 , at directory))
-            ((or (null directory)
-                 (and (consp directory) (member (first directory) '(:absolute :relative))))
-             directory)
-            (t
-             (error "Unrecognized directory component ~S in pathname ~S" directory specified))))
+         (directory (normalize-pathname-directory-component (pathname-directory specified)))
          (name (or (pathname-name specified) (pathname-name defaults)))
          (type (or (pathname-type specified) (pathname-type defaults)))
          (version (or (pathname-version specified) (pathname-version defaults))))
@@ -433,28 +473,30 @@
                (if (typep p 'logical-pathname) #'ununspecific #'identity)))
       (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)))
              (values (pathname-host specified)
                      (pathname-device specified)
                      (unspecific-handler specified)))
-            ((:relative)
+            ((nil :relative)
              (values (pathname-host defaults)
                      (pathname-device defaults)
-                     (if (pathname-directory defaults)
-                         (append (pathname-directory defaults) (cdr directory))
-                         directory)
+                     (merge-pathname-directory-components directory (pathname-directory defaults))
                      (unspecific-handler defaults))))
         (make-pathname :host host :device device :directory directory
                        :name (funcall unspecific-handler name)
                        :type (funcall unspecific-handler type)
                        :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.
@@ -467,9 +509,15 @@
 (defun* last-char (s)
   (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 #'format *verbose-out* format-string format-args))
+  (apply #'errfmt *verbose-out* format-string format-args))
 (defun* split-string (string &key max (separator '(#\Space #\Tab)))
   "Split STRING into a list of components separated by
@@ -496,7 +544,7 @@
          ;; Giving :unspecific as argument to make-pathname is not portable.
          ;; See CLHS make-pathname and
          ;; We only use it on implementations that support it.
-         (or #+(or ccl ecl gcl lispworks sbcl) :unspecific)))
+         (or #+(or clozure gcl lispworks sbcl) :unspecific)))
     (destructuring-bind (name &optional (type unspecific))
         (split-string filename :max 2 :separator ".")
       (if (equal name "")
@@ -533,7 +581,8 @@
                   (values :absolute (cdr components)))
                 (values :relative nil))
           (values :relative components))
-      (setf components (remove "" components :test #'equal))
+      (setf components (remove-if #'(lambda (x) (member x '("" ".") :test #'equal)) components))
+      (setf components (substitute :back ".." components :test #'equal))
         ((equal last-comp "")
          (values relative components nil)) ; "" already removed
@@ -553,16 +602,27 @@
     :unless (eq k key)
     :append (list k v)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ccl:define-entry-point (_getenv "getenv") ((name :string)) :string))
 (defun* getenv (x)
-  (#+(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))
+  (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"))
 (defun* directory-pathname-p (pathname)
   "Does PATHNAME represent a directory?
@@ -600,6 +660,11 @@
                    :name nil :type nil :version nil
                    :defaults pathspec))))
+(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))
        (eq :absolute (car (pathname-directory (pathname pathspec))))))
@@ -627,7 +692,7 @@
      :until (eq form eof)
      :collect form)))
-#-(and (or win32 windows mswindows mingw32) (not cygwin))
   #+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601)
                   '(ffi:clines "#include <sys/types.h>" "#include <unistd.h>"))
@@ -667,13 +732,13 @@
    (string (probe-file* (parse-namestring p)))
    (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 'logical-pathname) (return p))
+    (when (typep p '(or null logical-pathname)) (return p))
     (let* ((p (merge-pathnames* p))
            (directory (pathname-directory p)))
       (when (typep p 'logical-pathname) (return p))
@@ -705,7 +770,9 @@
 (defun* resolve-symlinks (path)
   #-allegro (truenamize path)
-  #+allegro (excl:pathname-resolve-symbolic-links path))
+  #+allegro (if (typep path 'logical-pathname)
+                path
+                (excl:pathname-resolve-symbolic-links path)))
 (defun* default-directory ()
   (truenamize (pathname-directory-pathname *default-pathname-defaults*)))
@@ -713,24 +780,32 @@
 (defun* lispize-pathname (input-file)
   (make-pathname :type "lisp" :defaults input-file))
+(defparameter *wild-file*
+  (make-pathname :name :wild :type :wild :version :wild :directory nil))
+(defparameter *wild-directory*
+  (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil))
+(defparameter *wild-inferiors*
+  (make-pathname :directory '(:relative :wild-inferiors) :name nil :type nil :version nil))
 (defparameter *wild-path*
-  (make-pathname :directory '(:relative :wild-inferiors)
-                 :name :wild :type :wild :version :wild))
+  (merge-pathnames *wild-file* *wild-inferiors*))
 (defun* wilden (path)
   (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))
-         (foo (make-pathname :directory '(:absolute "FOO") :defaults root))
-         (separator (last-char (namestring foo)))
+         (separator (directory-separator-for-host root))
          (root-namestring (namestring root))
           (substitute-if #\/
-                         (lambda (x) (or (eql x #\:)
-                                         (eql x separator)))
+                         #'(lambda (x) (or (eql x #\:)
+                                           (eql x separator)))
     (multiple-value-bind (relative path filename)
         (component-name-to-pathname-components root-string :force-directory t)
@@ -849,24 +924,21 @@
 ;;;; -------------------------------------------------------------------------
 ;;; 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)
       `(defmethod update-instance-for-redefined-class :after
            ((m module) added deleted plist &key)
          (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))
-         (when (and (typep m 'system) (member 'source-file added))
-           (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) 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*))))))))
 ;;;; -------------------------------------------------------------------------
 ;;;; Classes, Conditions
@@ -886,7 +958,10 @@
                 error-component error-operation
                 module-components module-components-by-name
-                circular-dependency-components)
+                circular-dependency-components
+                condition-arguments condition-form
+                condition-format condition-location
+                coerce-name)
          (ftype (function (t t) t) (setf module-components-by-name)))
@@ -894,26 +969,26 @@
   ((format-control :initarg :format-control :reader format-control)
    (format-arguments :initarg :format-arguments :reader format-arguments))
   (:report (lambda (c s)
-             (apply #'format s (format-control c) (format-arguments c)))))
+               (apply #'errfmt s (format-control c) (format-arguments c)))))
 (define-condition load-system-definition-error (system-definition-error)
   ((name :initarg :name :reader error-name)
    (pathname :initarg :pathname :reader error-pathname)
    (condition :initarg :condition :reader error-condition))
   (:report (lambda (c s)
-             (format s "~@<Error while trying to load definition for system ~A from pathname ~A: ~A~@:>"
-                     (error-name c) (error-pathname c) (error-condition c)))))
+	     (errfmt 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)
-             (format s "~@<Circular dependency: ~S~@:>" (circular-dependency-components c)))))
+	     (errfmt 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)
-             (format s "~@<Error while defining system: multiple components are given same name ~A~@:>"
-                     (duplicate-names-name c)))))
+	     (errfmt s "Error while defining system: multiple components are given same name ~A"
+		     (duplicate-names-name c)))))
 (define-condition missing-component (system-definition-error)
   ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
@@ -933,19 +1008,37 @@
   ((component :reader error-component :initarg :component)
    (operation :reader error-operation :initarg :operation))
   (:report (lambda (c s)
-             (format s "~@<erred while invoking ~A on ~A~@:>"
-                     (error-operation c) (error-component c)))))
+               (errfmt 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) ())
 (define-condition compile-warned (compile-error) ())
+(define-condition invalid-configuration ()
+  ((form :reader condition-form :initarg :form)
+   (location :reader condition-location :initarg :location)
+   (format :reader condition-format :initarg :format)
+   (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))))))
+(define-condition invalid-source-registry (invalid-configuration warning)
+  ((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~]~@{ ~@?~}")))
 (defclass component ()
   ((name :accessor component-name :initarg :name :documentation
          "Component name: designator for a string composed of portable pathname characters")
    (version :accessor component-version :initarg :version)
-   ;; 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
+   (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.
    (load-dependencies :accessor component-load-dependencies :initform nil)
    ;; In the ASDF object model, dependencies exist between *actions*
    ;; (an action is a pair of operation and component). They are represented
@@ -964,6 +1057,7 @@
    ;; it needn't be recompiled just because one of these dependencies
    ;; 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)
    (do-first :initform nil :initarg :do-first
@@ -991,13 +1085,13 @@
 (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))))
 ;;;; methods: conditions
 (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)))
 (defun* sysdef-error (format &rest arguments)
@@ -1007,13 +1101,13 @@
 ;;;; methods: components
 (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)
             (coerce-name (missing-parent c)))))
 (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)
           (when (missing-parent c)
@@ -1090,9 +1184,10 @@
 (defclass system (module)
-  ((description :accessor system-description :initarg :description)
-   (long-description
-    :accessor system-long-description :initarg :long-description)
+  (;; 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)
    (author :accessor system-author :initarg :author)
    (maintainer :accessor system-maintainer :initarg :maintainer)
    (licence :accessor system-licence :initarg :licence
@@ -1141,7 +1236,7 @@
     (component (component-name name))
     (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)
   (gethash (coerce-name name) *defined-systems*))
@@ -1151,22 +1246,19 @@
 Note that this does NOT in any way cause the code of the system to be unloaded."
   ;; There is no "unload" operation in Common Lisp, and a general such operation
   ;; cannot be portably written, considering how much CL relies on side-effects
-  ;; of global data structures.
-  ;; Note that this does a setf gethash instead of a remhash
-  ;; this way there remains a hint in the *defined-systems* table
-  ;; that the system was loaded at some point.
-  (setf (gethash (coerce-name name) *defined-systems*) nil))
+  ;; to global data structures.
+  (remhash (coerce-name name) *defined-systems*))
 (defun* map-systems (fn)
   "Apply FN to each defined system.
 FN should be a function of one argument. It will be
 called with an object of type asdf:system."
-  (maphash (lambda (_ datum)
-             (declare (ignore _))
-             (destructuring-bind (_ . def) datum
+  (maphash #'(lambda (_ datum)
                (declare (ignore _))
-               (funcall fn def)))
+               (destructuring-bind (_ . def) datum
+                 (declare (ignore _))
+                 (funcall fn def)))
 ;;; for the sake of keeping things reasonably neat, we adopt a
@@ -1178,7 +1270,7 @@
 (defun* system-definition-pathname (system)
   (let ((system-name (coerce-name system)))
-     (some (lambda (x) (funcall x system-name))
+     (some #'(lambda (x) (funcall x system-name))
      (let ((system-pair (system-registered-p system-name)))
        (and system-pair
@@ -1207,15 +1299,15 @@
               :defaults defaults :version :newest :case :local
               :name name
               :type "asd")))
-        (when (probe-file file)
+        (when (probe-file* file)
           (return file)))
-      #+(and (or win32 windows mswindows mingw32) (not cygwin) (not clisp))
+      #+(and asdf-windows (not clisp))
       (let ((shortcut
               :defaults defaults :version :newest :case :local
               :name (concatenate 'string name ".asd")
               :type "lnk")))
-        (when (probe-file shortcut)
+        (when (probe-file* shortcut)
           (let ((target (parse-windows-shortcut shortcut)))
             (when target
               (return (pathname target)))))))))
@@ -1237,8 +1329,8 @@
                             (let* ((*print-circle* nil)
-                                    (format nil
-                                            "~@<While searching for system ~S: ~S evaluated to ~S which is not a directory.~@:>"
+                                    (errfmt nil
+                                            "While searching for system ~S: ~S evaluated to ~S which is not a directory."
                                             system dir defaults)))
                               (error message))
                           (remove-entry-from-registry ()
@@ -1246,8 +1338,8 @@
                             (push dir to-remove))
                           (coerce-entry-to-directory ()
                             :report (lambda (s)
-                                      (format s "Coerce entry to ~a, replace ~a and continue."
-                                              (ensure-directory-pathname defaults) dir))
+				      (errfmt s "Coerce entry to ~a, replace ~a and continue."
+					      (ensure-directory-pathname defaults) dir))
                             (push (cons dir (ensure-directory-pathname defaults)) to-replace))))))))
         ;; cleanup
         (dolist (dir to-remove)
@@ -1279,7 +1371,7 @@
   ;; and we can survive and we will continue the planning
   ;; as if the file were very old.
   ;; (or should we treat the case in a different, special way?)
-  (or (and pathname (probe-file pathname) (file-write-date pathname))
+  (or (and pathname (probe-file* pathname) (file-write-date pathname))
         (when (and pathname *asdf-verbose*)
           (warn "Missing FILE-WRITE-DATE for ~S: treating it as zero."
@@ -1289,27 +1381,34 @@
 (defmethod find-system (name &optional (error-p t))
   (find-system (coerce-name name) error-p))
+(defun load-sysdef (name pathname)
+  ;; Tries to load system definition with canonical NAME from PATHNAME.
+  (let ((package (make-temporary-package)))
+    (unwind-protect
+         (handler-bind
+             ((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~%"
+              pathname package)
+             (load pathname)))
+      (delete-package package))))
 (defmethod find-system ((name string) &optional (error-p t))
   (catch 'find-system
-    (let* ((in-memory (system-registered-p name))
+    (let* ((in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
            (on-disk (system-definition-pathname name)))
       (when (and on-disk
                  (or (not in-memory)
-                     (< (car in-memory) (safe-file-write-date on-disk))))
-        (let ((package (make-temporary-package)))
-          (unwind-protect
-               (handler-bind
-                   ((error (lambda (condition)
-                             (error 'load-system-definition-error
-                                    :name name :pathname on-disk
-                                    :condition condition))))
-                 (let ((*package* package))
-                   (asdf-message
-                    "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%"
-                    on-disk *package*)
-                   (load on-disk)))
-            (delete-package package))))
-      (let ((in-memory (system-registered-p name)))
+                     ;; don't reload if it's already been loaded,
+                     ;; or its filestamp is in the future which means some clock is skewed
+                     ;; and trying to load might cause an infinite loop.
+                     (< (car in-memory) (safe-file-write-date on-disk) (get-universal-time))))
+        (load-sysdef name on-disk))
+      (let ((in-memory (system-registered-p name))) ; try again after loading from disk
            (when on-disk
@@ -1319,7 +1418,7 @@
            (error 'missing-component :requires name)))))))
 (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)))
@@ -1340,7 +1439,8 @@
       (throw 'find-system system))))
 (defun* sysdef-find-asdf (name)
-  (find-system-fallback name "asdf")) ;; :version *asdf-version* wouldn't be updated when ASDF is updated.
+  ;; Bug: :version *asdf-version* won't be updated when ASDF is updated.
+  (find-system-fallback name "asdf" :version *asdf-version*))
 ;;;; -------------------------------------------------------------------------
@@ -1397,6 +1497,20 @@
   (source-file-explicit-type component))
 (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
   ;; merge-pathnames with non-default hosts,  e.g. for logical-pathnames.
@@ -1405,10 +1519,10 @@
   ;; (b) later merge relative pathnames with CL:MERGE-PATHNAMES instead of
   (etypecase name
-    (pathname
+    ((or null pathname)
-     (merge-component-name-type (string-downcase name) :type type :defaults defaults))
+     (coerce-pathname (string-downcase name) :type type :defaults defaults))
      (multiple-value-bind (relative path filename)
          (component-name-to-pathname-components name :force-directory (eq type :directory)
@@ -1429,7 +1543,7 @@
                           :host host :device device)))))))
 (defmethod component-relative-pathname ((component component))
-  (merge-component-name-type
+  (coerce-pathname
    (or (slot-value component 'relative-pathname)
        (component-name component))
    :type (source-file-type component (component-system component))
@@ -1537,18 +1651,18 @@
 (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=))
 (defmethod input-files ((operation operation) (c component))
   (let ((parent (component-parent c))
         (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))))
         ;; no previous operations needed?  I guess we work with the
         ;; original source file, then
@@ -1602,8 +1716,8 @@
          ;; than one second of filesystem time (or just crosses the
          ;; second). So that's cool.
-          (every #'probe-file in-files)
-          (every #'probe-file out-files)
+          (every #'probe-file* in-files)
+          (every #'probe-file* out-files)
           (>= (earliest-out) (latest-in))))))))
@@ -1650,14 +1764,13 @@
                              required-op required-c required-v))
       (retry ()
         :report (lambda (s)
-                  (format s "~@<Retry loading component ~S.~@:>"
-                          (component-find-path required-c)))
+		  (errfmt s "Retry loading component ~S." required-c))
         (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)
   ;; type of arguments uncertain:
@@ -1820,7 +1933,7 @@
 (defmethod perform ((operation operation) (c source-file))
-   "~@<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)))
 (defmethod perform ((operation operation) (c module))
@@ -1843,7 +1956,7 @@
    (on-failure :initarg :on-failure :accessor operation-on-failure
                :initform *compile-file-failure-behaviour*)
    (flags :initarg :flags :accessor compile-op-flags
-          :initform #-ecl nil #+ecl '(:system-p t))))
+          :initform nil)))
 (defun output-file (operation component)
   "The unique output file of performing OPERATION on COMPONENT"
@@ -1852,25 +1965,18 @@
     (first files)))
 (defmethod perform :before ((operation compile-op) (c source-file))
-  (map nil #'ensure-directories-exist (output-files operation c)))
-(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))))
+   (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)))
 (defmethod perform :after ((operation operation) (c component))
   (setf (gethash (type-of operation) (component-operation-times c))
-(declaim (ftype (function ((or pathname string)
-                           &rest t &key (:output-file t) &allow-other-keys)
-                          (values t t t))
-                compile-file*))
+(defvar *compile-op-compile-file-function* 'compile-file*
+  "Function used to compile lisp files.")
 ;;; perform is required to check output-files to find out where to put
 ;;; its answers, in case it has been overridden for site policy
@@ -1883,19 +1989,19 @@
         (*compile-file-warnings-behaviour* (operation-on-warnings operation))
         (*compile-file-failure-behaviour* (operation-on-failure operation)))
     (multiple-value-bind (output warnings-p failure-p)
-        (apply #'compile-file* source-file :output-file output-file
+        (apply *compile-op-compile-file-function* 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))
           (:ignore nil)))
       (when failure-p
         (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))
           (:ignore nil)))
@@ -1905,10 +2011,8 @@
 (defmethod output-files ((operation compile-op) (c cl-source-file))
   (declare (ignorable operation))
   (let ((p (lispize-pathname (component-pathname c))))
-    #-:broken-fasl-loader
-    (list (compile-file-pathname p #+ecl :type #+ecl :object)
-          #+ecl (compile-file-pathname p :type :fasl))
-    #+:broken-fasl-loader (list p)))
+    #-broken-fasl-loader (list (compile-file-pathname p))
+    #+broken-fasl-loader (list p)))
 (defmethod perform ((operation compile-op) (c static-file))
   (declare (ignorable operation c))
@@ -1934,11 +2038,7 @@
 (defclass load-op (basic-load-op) ())
 (defmethod perform ((o load-op) (c cl-source-file))
-  (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)))))
+  (map () #'load (input-files o c)))
 (defmethod perform-with-restarts (operation component)
   (perform operation component))
@@ -2031,10 +2131,10 @@
   (declare (ignorable o))
   (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))
 (defmethod operation-done-p ((o load-source-op) (c source-file))
@@ -2097,12 +2197,12 @@
               (retry ()
                 (lambda (s)
-                  (format s "~@<Retry ~A.~@:>" (operation-description op component))))
+		  (errfmt s "Retry ~A." (operation-description op component))))
               (accept ()
                 (lambda (s)
-                  (format s "~@<Continue, treating ~A as having been successful.~@:>"
-                          (operation-description op component)))
+		  (errfmt s "Continue, treating ~A as having been successful."
+			  (operation-description op component)))
                 (setf (gethash (type-of op)
                                (component-operation-times component))
@@ -2180,7 +2280,9 @@
   ;; 3. taken from the *default-pathname-defaults* via default-directory
   (let* ((file-pathname (load-pathname))
          (directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
-    (or (and pathname-supplied-p (merge-pathnames* pathname directory-pathname))
+    (or (and pathname-supplied-p
+             (merge-pathnames* (coerce-pathname pathname :type :directory)
+                               directory-pathname))
@@ -2223,7 +2325,7 @@
       (and (eq type :file)
            (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)
   "Add the node C at /OP1/OP2 in TREE, unless it's there already.
@@ -2280,8 +2382,8 @@
          ;; this is inefficient as most of the stored
          ;; 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
   (setf (component-inline-methods component) nil))
@@ -2408,7 +2510,7 @@
     #+clisp                     ;XXX not exactly *verbose-out*, I know
-    (ext:run-shell-command  command :output :terminal :wait t)
+    (or (ext:run-shell-command  command :output :terminal :wait t) 0)
     (nth-value 1
@@ -2482,7 +2584,7 @@
 (defun* system-relative-pathname (system name &key type)
-   (merge-component-name-type name :type type)
+   (coerce-pathname name :type type)
    (system-source-directory system)))
@@ -2493,13 +2595,13 @@
 ;;; Initially stolen from SLIME's SWANK, hacked since.
 (defparameter *implementation-features*
-  '((:acl :allegro)
-    (:lw :lispworks)
-    (:digitool) ; before clozure, so it won't get preempted by ccl
+  '((:abcl :armedbear)
+    (:acl :allegro)
+    (:mcl :digitool) ; before clozure, so it won't get preempted by ccl
     (:ccl :clozure)
     (:corman :cormanlisp)
-    (:abcl :armedbear)
-    :sbcl :cmu :clisp :gcl :ecl :scl))
+    (:lw :lispworks)
+    :clisp :cmu :ecl :gcl :sbcl :scl :symbolics))
 (defparameter *os-features*
   '((:win :windows :mswindows :win32 :mingw32) ;; shorten things on windows
@@ -2507,7 +2609,8 @@
     (:linux :linux-target) ;; for GCL at least, must appear before :bsd.
     (:macosx :darwin :darwin-target :apple)
     :freebsd :netbsd :openbsd :bsd
-    :unix))
+    :unix
+    :genera))
 (defparameter *architecture-features*
   '((:amd64 :x86-64 :x86_64 :x8664-target)
@@ -2519,7 +2622,8 @@
     (:sparc32 :sparc)
     (:arm :arm-target)
-    (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7)))
+    (:java :java-1.4 :java-1.5 :java-1.6 :java-1.7)
+    :imach))
 (defun* lisp-version-string ()
   (let ((s (lisp-implementation-version)))
@@ -2537,24 +2641,26 @@
                        (:+ics ""))
                       (if (member :64bit *features*) "-64bit" ""))
     #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
-    #+clisp (subseq s 0 (position #\space s))
+    #+clisp (subseq s 0 (position #\space s)) ; strip build information (date, etc.)
     #+clozure (format nil "~d.~d-f~d" ; shorten for windows
                       (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)))
                     (when (>= (length vcs-id) 8)
                       (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
-    #+(or cormanlisp mcl sbcl scl) s
-    #-(or allegro armedbear clisp clozure cmu cormanlisp digitool
-          ecl gcl lispworks mcl sbcl scl) s))
+    #+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))
 (defun* first-feature (features)
@@ -2586,31 +2692,31 @@
           (os   (maybe-warn (first-feature *os-features*)
                             "No os feature found in ~a." *os-features*))
-          (arch (maybe-warn (first-feature *architecture-features*)
-                            "No architecture feature found in ~a."
-                            *architecture-features*))
+          (arch (or #-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.")))
-       #\_ (lambda (x) (find x " /:\\(){}[]$#`'\""))
-       (format nil "~(~@{~a~^-~}~)" lisp version os arch)))))
+       #\_ #'(lambda (x) (find x " /:\\(){}[]$#`'\""))
+       (format nil "~(~a~@{~@[-~a~]~}~)" lisp version os arch)))))
 ;;; ---------------------------------------------------------------------------
 ;;; Generic support for configuration files
 (defparameter *inter-directory-separator*
-  #+(or unix cygwin) #\:
-  #-(or unix cygwin) #\;)
+  #+asdf-unix #\:
+  #-asdf-unix #\;)
 (defun* user-homedir ()
-  (truename (user-homedir-pathname)))
+  (truenamize (pathname-directory-pathname (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* (merge-component-name-type sub :type type) p)))
+         (sp (and tp (merge-pathnames* (coerce-pathname sub :type type) p)))
          (ts (and sp (probe-file* sp))))
     (and ts (values sp ts))))
 (defun* user-configuration-directories ()
@@ -2621,7 +2727,7 @@
        ,@(loop :with dirs = (getenv "XDG_CONFIG_DIRS")
            :for dir :in (split-string dirs :separator ":")
            :collect (try dir "common-lisp/"))
-       #+(and (or win32 windows mswindows mingw32) (not cygwin))
+       #+asdf-windows
         ,@`(#+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
            ,(try (getenv "APPDATA") "common-lisp/config/"))
@@ -2630,11 +2736,12 @@
-    #+(and (or win32 windows mswindows mingw32) (not cygwin))
+    #+asdf-windows
     (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)
   (loop :for dir :in dirs
@@ -2649,40 +2756,88 @@
     (or (member x kw)
         (and (length=n-p x 1) (member (car x) kw)))))
+(defun* report-invalid-form (reporter &rest args)
+  (etypecase reporter
+    (null
+     (apply 'error 'invalid-configuration args))
+    (function
+     (apply reporter args))
+    ((or symbol string)
+     (apply 'error reporter args))
+    (cons
+     (apply 'apply (append reporter args)))))
+(defvar *ignored-configuration-form* nil)
 (defun* validate-configuration-form (form tag directive-validator
-                                    &optional (description tag))
+                                    &key location invalid-form-reporter)
   (unless (and (consp form) (eq (car form) tag))
-    (error "Error: Form doesn't specify ~A ~S~%" description form))
-  (loop :with inherit = 0
-    :for directive :in (cdr form) :do
-    (if (configuration-inheritance-directive-p directive)
-        (incf inherit)
-        (funcall directive-validator directive))
+    (setf *ignored-configuration-form* t)
+    (report-invalid-form invalid-form-reporter :form form :location location)
+    (return-from validate-configuration-form nil))
+  (loop :with inherit = 0 :with ignore-invalid-p = nil :with x = (list tag)
+    :for directive :in (cdr form)
+    :when (cond
+            ((configuration-inheritance-directive-p directive)
+             (incf inherit) t)
+            ((eq directive :ignore-invalid-entries)
+             (setf ignore-invalid-p t) t)
+            ((funcall directive-validator directive)
+             t)
+            (ignore-invalid-p
+             nil)
+            (t
+             (setf *ignored-configuration-form* t)
+             (report-invalid-form invalid-form-reporter :form directive :location location)
+             nil))
+    :do (push directive x)
     (unless (= inherit 1)
-      (error "One and only one of ~S or ~S is required"
-             :inherit-configuration :ignore-inherited-configuration)))
-  form)
+      (report-invalid-form invalid-form-reporter
+             :arguments (list "One and only one of ~S or ~S is required"
+                              :inherit-configuration :ignore-inherited-configuration)))
+    (return (nreverse x))))
-(defun* validate-configuration-file (file validator description)
+(defun* validate-configuration-file (file validator &key description)
   (let ((forms (read-file-forms file)))
     (unless (length=n-p forms 1)
       (error "One and only one form allowed for ~A. Got: ~S~%" description forms))
-    (funcall validator (car forms))))
+    (funcall validator (car forms) :location file)))
 (defun* hidden-file-p (pathname)
   (equal (first-char (pathname-name pathname)) #\.))
-(defun* validate-configuration-directory (directory tag validator)
+(defun* directory* (pathname-spec &rest keys &key &allow-other-keys)
+  (apply 'directory pathname-spec
+         (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
+                             #+clozure '(:follow-links nil)
+                             #+clisp '(:circle t :if-does-not-exist :ignore)
+                             #+(or cmu scl) '(:follow-links nil :truenamep nil)
+                             #+sbcl (when (find-symbol "RESOLVE-SYMLINKS" "SB-IMPL") '(:resolve-symlinks nil))))))
+(defun* validate-configuration-directory (directory tag validator &key invalid-form-reporter)
+  "Map the VALIDATOR across the .conf files in DIRECTORY, the TAG will
+be applied to the results to yield a configuration form.  Current
+values of TAG include :source-registry and :output-translations."
   (let ((files (sort (ignore-errors
-                        (directory (make-pathname :name :wild :type "conf" :defaults directory)
-                                   #+sbcl :resolve-symlinks #+sbcl nil)))
+                        (directory* (make-pathname :name :wild :type "conf" :defaults directory))))
                      #'string< :key #'namestring)))
       ,@(loop :for file :in files :append
-          (mapcar validator (read-file-forms file)))
+          (loop :with ignore-invalid-p = nil
+            :for form :in (read-file-forms file)
+            :when (eq form :ignore-invalid-entries)
+              :do (setf ignore-invalid-p t)
+            :else
+              :when (funcall validator form)
+                :collect form
+              :else
+                :when ignore-invalid-p
+                  :do (setf *ignored-configuration-form* t)
+                :else
+                  :do (report-invalid-form invalid-form-reporter :form form :location file)))
@@ -2703,7 +2858,7 @@
   (flet ((try (x &rest sub) (and x `(,x , at sub))))
      (try (getenv "XDG_CACHE_HOME") "common-lisp" :implementation)
-     #+(and (or win32 windows mswindows mingw32) (not cygwin))
+     #+asdf-windows
      (try (getenv "APPDATA") "common-lisp" "cache" :implementation)
      '(:home ".cache" "common-lisp" :implementation))))
 (defvar *system-cache*
@@ -2718,11 +2873,12 @@
   (setf *output-translations*
          (stable-sort (copy-list new-value) #'>
-                      :key (lambda (x)
-                             (etypecase (car x)
-                               ((eql t) -1)
-                               (pathname
-                                (length (pathname-directory (car x)))))))))
+                      :key #'(lambda (x)
+                               (etypecase (car x)
+                                 ((eql t) -1)
+                                 (pathname
+                                  (let ((directory (pathname-directory (car x))))
+                                    (if (listp directory) (length directory) 0))))))))
 (defun* output-translations-initialized-p ()
@@ -2756,9 +2912,12 @@
                        (merge-pathnames* cdr car)))))
               ((eql :default-directory)
                (relativize-pathname-directory (default-directory)))
+              ((eql :*/) *wild-directory*)
+              ((eql :**/) *wild-inferiors*)
+              ((eql :*.*.*) *wild-file*)
               ((eql :implementation) (implementation-identifier))
               ((eql :implementation-type) (string-downcase (implementation-type)))
-              #-(and (or win32 windows mswindows mingw32) (not cygwin))
+              #+asdf-unix
               ((eql :uid) (princ-to-string (get-uid)))))
          (d (if (or (pathnamep x) (not directory)) r (ensure-directory-pathname r)))
          (s (if (or (pathnamep x) (not wilden)) d (wilden d))))
@@ -2766,6 +2925,11 @@
       (error "pathname ~S is not relative to ~S" s super))
     (merge-pathnames* s super)))
+(defvar *here-directory* nil
+  "This special variable is bound to the currect directory during calls to
+PROCESS-SOURCE-REGISTRY in order that we be able to interpret the :here
 (defun* resolve-absolute-location-component (x &key directory wilden)
   (let* ((r
           (etypecase x
@@ -2788,6 +2952,11 @@
                (let ((p (make-pathname :directory '(:relative))))
                  (if wilden (wilden p) p))))
             ((eql :home) (user-homedir))
+            ((eql :here)
+             (resolve-location (or *here-directory*
+                                   ;; give semantics in the case of use interactively
+                                   :default-directory)
+                          :directory t :wilden nil))
             ((eql :user-cache) (resolve-location *user-cache* :directory t :wilden nil))
             ((eql :system-cache) (resolve-location *system-cache* :directory t :wilden nil))
             ((eql :default-directory) (default-directory))))
@@ -2812,8 +2981,17 @@
         :finally (return path))))
 (defun* location-designator-p (x)
-  (flet ((componentp (c) (typep c '(or string pathname keyword))))
-    (or (typep x 'boolean) (componentp x) (and (consp x) (every #'componentp x)))))
+  (flet ((absolute-component-p (c)
+           (typep c '(or string pathname
+                      (member :root :home :here :user-cache :system-cache :default-directory))))
+         (relative-component-p (c)
+           (typep c '(or string pathname
+                      (member :default-directory :*/ :**/ :*.*.*
+                        :implementation :implementation-type
+                        #+asdf-unix :uid)))))
+    (or (typep x 'boolean)
+        (absolute-component-p x)
+        (and (consp x) (absolute-component-p (first x)) (every #'relative-component-p (rest x))))))
 (defun* location-function-p (x)
@@ -2826,47 +3004,43 @@
             (length=n-p (second x) 2)))))
 (defun* validate-output-translations-directive (directive)
-  (unless
-      (or (member directive '(:inherit-configuration
-                              :ignore-inherited-configuration
-                              :enable-user-cache :disable-cache nil))
-          (and (consp directive)
-               (or (and (length=n-p directive 2)
-                        (or (and (eq (first directive) :include)
-                                 (typep (second directive) '(or string pathname null)))
-                            (and (location-designator-p (first directive))
-                                 (or (location-designator-p (second directive))
-                                     (location-function-p (second directive))))))
-                   (and (length=n-p directive 1)
-                        (location-designator-p (first directive))))))
-    (error "Invalid directive ~S~%" directive))
-  directive)
+  (or (member directive '(:enable-user-cache :disable-cache nil))
+      (and (consp directive)
+           (or (and (length=n-p directive 2)
+                    (or (and (eq (first directive) :include)
+                             (typep (second directive) '(or string pathname null)))
+                        (and (location-designator-p (first directive))
+                             (or (location-designator-p (second directive))
+                                 (location-function-p (second directive))))))
+               (and (length=n-p directive 1)
+                    (location-designator-p (first directive)))))))
-(defun* validate-output-translations-form (form)
+(defun* validate-output-translations-form (form &key location)
-   "output translations"))
+   :location location :invalid-form-reporter 'invalid-output-translation))
 (defun* validate-output-translations-file (file)
-   file 'validate-output-translations-form "output translations"))
+   file 'validate-output-translations-form :description "output translations"))
 (defun* validate-output-translations-directory (directory)
-   directory :output-translations 'validate-output-translations-directive))
+   directory :output-translations 'validate-output-translations-directive
+   :invalid-form-reporter 'invalid-output-translation))
-(defun* parse-output-translations-string (string)
+(defun* parse-output-translations-string (string &key location)
     ((or (null string) (equal string ""))
      '(:output-translations :inherit-configuration))
     ((not (stringp string))
      (error "environment string isn't: ~S" string))
     ((eql (char string 0) #\")
-     (parse-output-translations-string (read-from-string string)))
+     (parse-output-translations-string (read-from-string string) :location location))
     ((eql (char string 0) #\()
-     (validate-output-translations-form (read-from-string string)))
+     (validate-output-translations-form (read-from-string string) :location location))
       :with inherit = nil
@@ -2906,7 +3080,8 @@
     ;; Some implementations have precompiled ASDF systems,
     ;; so we must disable translations for implementation paths.
-    #+sbcl ,(let ((h (getenv "SBCL_HOME"))) (when (plusp (length h)) `(,h ())))
+    #+sbcl ,(let ((h (getenv "SBCL_HOME")))
+                 (when (plusp (length h)) `((,(truenamize h) ,*wild-inferiors*) ())))
     #+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
     ;; All-import, here is where we want user stuff to be:
@@ -2917,8 +3092,8 @@
     ;; We enable the user cache by default, and here is the place we do:
-(defparameter *output-translations-file* #p"asdf-output-translations.conf")
-(defparameter *output-translations-directory* #p"asdf-output-translations.conf.d/")
+(defparameter *output-translations-file* (coerce-pathname "asdf-output-translations.conf"))
+(defparameter *output-translations-directory* (coerce-pathname "asdf-output-translations.conf.d/"))
 (defun* user-output-translations-pathname ()
   (in-user-configuration-directory *output-translations-file* ))
@@ -2946,7 +3121,7 @@
     ((directory-pathname-p pathname)
      (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))
@@ -2974,7 +3149,7 @@
          (process-output-translations-directive '(t t) :collect collect))
          (inherit-output-translations inherit :collect collect))
-        ((:ignore-inherited-configuration nil)
+        ((:ignore-inherited-configuration :ignore-invalid-entries nil)
       (let ((src (first directive))
             (dst (second directive)))
@@ -2997,9 +3172,7 @@
                    (let* ((trudst (make-pathname
                                    :defaults (if dst (resolve-location dst :directory t :wilden t) trusrc)))
-                          (wilddst (make-pathname
-                                    :name :wild :type :wild :version :wild
-                                    :defaults trudst)))
+                          (wilddst (merge-pathnames* *wild-file* trudst)))
                      (funcall collect (list wilddst t))
                      (funcall collect (list trusrc trudst)))))))))))
@@ -3011,10 +3184,13 @@
       `(wrapping-output-translations ,parameter ,@*default-output-translations*) :collect #'c))
    :test 'equal :from-end t))
-(defun* initialize-output-translations (&optional parameter)
+(defvar *output-translations-parameter* nil)
+(defun* initialize-output-translations (&optional (parameter *output-translations-parameter*))
   "read the configuration, initialize the internal configuration variable,
 return the configuration"
-  (setf (output-translations) (compute-output-translations parameter)))
+  (setf *output-translations-parameter* parameter
+        (output-translations) (compute-output-translations parameter)))
 (defun* disable-output-translations ()
   "Initialize output translations in a way that maps every file to itself,
@@ -3090,7 +3266,7 @@
    :defaults x))
 (defun* delete-file-if-exists (x)
-  (when (and x (probe-file x))
+  (when (and x (probe-file* x))
     (delete-file x)))
 (defun* compile-file* (input-file &rest keys &key output-file &allow-other-keys)
@@ -3160,21 +3336,19 @@
   (when (null map-all-source-files)
     (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on ECL and CLISP"))
   (let* ((fasl-type (pathname-type (compile-file-pathname "foo.lisp")))
-         (wild-inferiors (make-pathname :directory '(:relative :wild-inferiors)))
-         (mapped-files (make-pathname
-                        :name :wild :version :wild
-                        :type (if map-all-source-files :wild fasl-type)))
+         (mapped-files (if map-all-source-files *wild-file*
+                           (make-pathname :name :wild :version :wild :type fasl-type)))
           (if centralize-lisp-binaries
                 ,@(when include-per-user-information
                         (cdr (pathname-directory (user-homedir))))
-                :implementation ,wild-inferiors)
-              `(:root ,wild-inferiors :implementation))))
+                :implementation ,*wild-inferiors*)
+              `(:root ,*wild-inferiors* :implementation))))
        , at source-to-target-mappings
-       ((:root ,wild-inferiors ,mapped-files)
+       ((:root ,*wild-inferiors* ,mapped-files)
         (, at destination-directory ,mapped-files))
        (t t)
@@ -3185,7 +3359,7 @@
 ;;;; Jesse Hager: The Windows Shortcut File Format.
 ;;;; http://www.wotsit.org/list.asp?fc=13
-#+(and (or win32 windows mswindows mingw32) (not cygwin) (not clisp))
+#+(and asdf-windows (not clisp))
 (defparameter *link-initial-dword* 76)
 (defparameter *link-guid* #(1 20 2 0 0 0 0 0 192 0 0 0 0 0 0 70))
@@ -3294,38 +3468,33 @@
   (make-pathname :directory nil :name :wild :type "asd" :version :newest))
 (defun directory-has-asd-files-p (directory)
-  (and (ignore-errors
-         (directory (merge-pathnames* *wild-asd* directory)
-                    #+sbcl #+sbcl :resolve-symlinks nil
-                    #+ccl #+ccl :follow-links nil
-                    #+clisp #+clisp :circle t))
-       t))
+  (ignore-errors
+    (and (directory* (merge-pathnames* *wild-asd* directory)) t)))
 (defun subdirectories (directory)
   (let* ((directory (ensure-directory-pathname directory))
-         #-cormanlisp
+         #-(or cormanlisp genera)
          (wild (merge-pathnames*
                 #-(or abcl allegro lispworks scl)
-                (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil)
+                *wild-directory*
                 #+(or abcl allegro lispworks scl) "*.*"
-          #-cormanlisp
+          #-(or cormanlisp genera)
-            (directory wild .
-              #.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
-                    #+ccl '(:follow-links nil :directories t :files nil)
-                    #+clisp '(:circle t :if-does-not-exist :ignore)
-                    #+(or cmu scl) '(:follow-links nil :truenamep nil)
-                    #+digitool '(:directories t)
-                    #+sbcl '(:resolve-symlinks nil))))
-          #+cormanlisp (cl::directory-subdirs directory))
-         #+(or abcl allegro lispworks scl)
+            (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)
          (dirs (remove-if-not #+abcl #'extensions:probe-directory
                               #+allegro #'excl:probe-directory
                               #+lispworks #'lw:file-directory-p
-                              #-(or abcl allegro lispworks) #'directory-pathname-p
-                              dirs)))
+                              #+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)))
 (defun collect-sub*directories (directory collectp recursep collector)
@@ -3346,39 +3515,40 @@
 (defun* validate-source-registry-directive (directive)
-  (unless
-      (or (member directive '(:default-registry (:default-registry)) :test 'equal)
-          (destructuring-bind (kw &rest rest) directive
-            (case kw
-              ((:include :directory :tree)
-               (and (length=n-p rest 1)
-                    (location-designator-p (first rest))))
-              ((:exclude :also-exclude)
-               (every #'stringp rest))
-              (null rest))))
-    (error "Invalid directive ~S~%" directive))
-  directive)
+  (or (member directive '(:default-registry))
+      (and (consp directive)
+           (let ((rest (rest directive)))
+             (case (first directive)
+               ((:include :directory :tree)
+                (and (length=n-p rest 1)
+                     (location-designator-p (first rest))))
+               ((:exclude :also-exclude)
+                (every #'stringp rest))
+               ((:default-registry)
+                (null rest)))))))
-(defun* validate-source-registry-form (form)
+(defun* validate-source-registry-form (form &key location)
-   form :source-registry 'validate-source-registry-directive "a source registry"))
+   form :source-registry 'validate-source-registry-directive
+   :location location :invalid-form-reporter 'invalid-source-registry))
 (defun* validate-source-registry-file (file)
-   file 'validate-source-registry-form "a source registry"))
+   file 'validate-source-registry-form :description "a source registry"))
 (defun* validate-source-registry-directory (directory)
-   directory :source-registry 'validate-source-registry-directive))
+   directory :source-registry 'validate-source-registry-directive
+   :invalid-form-reporter 'invalid-source-registry))
-(defun* parse-source-registry-string (string)
+(defun* parse-source-registry-string (string &key location)
     ((or (null string) (equal string ""))
      '(:source-registry :inherit-configuration))
     ((not (stringp string))
      (error "environment string isn't: ~S" string))
     ((find (char string 0) "\"(")
-     (validate-source-registry-form (read-from-string string)))
+     (validate-source-registry-form (read-from-string string) :location location))
       :with inherit = nil
@@ -3419,35 +3589,35 @@
-(defparameter *source-registry-file* #p"source-registry.conf")
-(defparameter *source-registry-directory* #p"source-registry.conf.d/")
+(defparameter *source-registry-file* (coerce-pathname "source-registry.conf"))
+(defparameter *source-registry-directory* (coerce-pathname "source-registry.conf.d/"))
 (defun* wrapping-source-registry ()
-    #+sbcl (:tree ,(getenv "SBCL_HOME"))
+    #+sbcl (:tree ,(truenamize (getenv "SBCL_HOME")))
     #+cmu (:tree #p"modules:")))
 (defun* default-source-registry ()
   (flet ((try (x sub) (try-directory-subpath x sub :type :directory)))
       #+sbcl (:directory ,(merge-pathnames* ".sbcl/systems/" (user-homedir)))
-      (:directory ,(truenamize (directory-namestring *default-pathname-defaults*)))
+      (:directory ,(default-directory))
-         #+(or unix cygwin)
+         #+asdf-unix
            (or (getenv "XDG_DATA_HOME")
                (try (user-homedir) ".local/share/")))
            (or (getenv "XDG_DATA_DIRS") "/usr/local/share:/usr/share"))
           (dirs (cons datahome (split-string datadirs :separator ":"))))
-         #+(and (or win32 windows mswindows mingw32) (not cygwin))
+         #+asdf-windows
          ((datahome (getenv "APPDATA"))
            #+lispworks (sys:get-folder-path :local-appdata)
            #-lispworks (try (getenv "ALLUSERSPROFILE")
                             "Application Data"))
           (dirs (list datahome datadir)))
-         #-(or unix win32 windows mswindows mingw32 cygwin)
+         #-(or asdf-unix asdf-windows)
          ((dirs ()))
          (loop :for dir :in dirs
            :collect `(:directory ,(try dir "common-lisp/systems/"))
@@ -3475,11 +3645,13 @@
 (defmethod process-source-registry ((pathname pathname) &key inherit register)
     ((directory-pathname-p pathname)
-     (process-source-registry (validate-source-registry-directory pathname)
-                              :inherit inherit :register register))
-    ((probe-file pathname)
-     (process-source-registry (validate-source-registry-file pathname)
-                              :inherit inherit :register register))
+     (let ((*here-directory* (truenamize pathname)))
+       (process-source-registry (validate-source-registry-directory pathname)
+                                :inherit inherit :register register)))
+    ((probe-file* pathname)
+     (let ((*here-directory* (pathname-directory-pathname pathname)))
+       (process-source-registry (validate-source-registry-file pathname)
+                                :inherit inherit :register register)))
      (inherit-source-registry inherit :register register))))
 (defmethod process-source-registry ((string string) &key inherit register)
@@ -3527,13 +3699,14 @@
 (defun* flatten-source-registry (&optional parameter)
    (while-collecting (collect)
-     (inherit-source-registry
-      `(wrapping-source-registry
-        ,parameter
-        ,@*default-source-registries*)
-      :register (lambda (directory &key recurse exclude)
-                  (collect (list directory :recurse recurse :exclude exclude)))))
-   :test 'equal :from-end t))
+     (let ((*default-pathname-defaults* (default-directory)))
+       (inherit-source-registry
+        `(wrapping-source-registry
+          ,parameter
+          ,@*default-source-registries*)
+        :register #'(lambda (directory &key recurse exclude)
+                      (collect (list directory :recurse recurse :exclude exclude)))))
+     :test 'equal :from-end t)))
 ;; Will read the configuration and initialize all internal variables,
 ;; and return the new configuration.
@@ -3545,8 +3718,11 @@
          :recurse recurse :exclude exclude :collect #'collect)))))
-(defun* initialize-source-registry (&optional parameter)
-  (setf (source-registry) (compute-source-registry parameter)))
+(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)))
 ;; Checks an initial variable to see whether the state is initialized
 ;; or cleared. In the former case, return current configuration; in
@@ -3579,9 +3755,9 @@
       ((style-warning #'muffle-warning)
        (missing-component (constantly nil))
-       (error (lambda (e)
-                (format *error-output* "ASDF could not load ~(~A~) because ~A.~%"
-                        name e))))
+       (error #'(lambda (e)
+                  (errfmt *error-output* "ASDF could not load ~(~A~) because ~A.~%"
+                          name e))))
     (let* ((*verbose-out* (make-broadcast-stream))
            (system (find-system (string-downcase name) nil)))
       (when system
@@ -3605,17 +3781,11 @@
 ;;;; Things to do in case we're upgrading from a previous version of ASDF.
 ;;;; 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.
+(when *ignored-configuration-form*
+  (clear-configuration)
+  (setf *ignored-configuration-form* nil))
 ;;;; -----------------------------------------------------------------
 ;;;; Done!

More information about the cmucl-cvs mailing list