diff --git a/.gitignore b/.gitignore
index c81e48de03f1d8c319b09058f1f55b9482b0a752..a4a40c84a619cecc0ba09f5692e396efb7478ada 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,7 +12,6 @@ test/conf.d/
 test/dir1/
 test/dir2/
 
-
 # We build these at various stages in the make process
 LICENSE
 website/output/
@@ -21,9 +20,9 @@ tmp/
 lift-local.config
 *.dribble
 *.fasl
-*.dfsl 
-*.cfsl 
-*.fas 
+*.dfsl
+*.cfsl
+*.fas
 *.lib
 *.o
 *.*fsl
diff --git a/GNUmakefile b/GNUmakefile
index 2043cf5d9319f12b1ea0f10f5bbf455e848f7f44..2ea0973212131d2f61bd56ad0230754981c21641 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,6 +1,6 @@
 system	 	:= "asdf"
 #user 		:= $(shell basename `echo "$home"`)
-user := "gking"
+user := "frideau"
 webhome_private := $(user)@common-lisp.net:/project/asdf/public_html/
 webhome_public	:= "http://common-lisp.net/project/asdf/"
 clnet_home      := "/project/asdf/public_html/"
@@ -38,7 +38,7 @@ website-copy: FORCE
 	bin/rsync-cp.sh tmp/asdf.lisp $(webhome_private)
 
 clean_dirs = $(sourceDirectory)
-clean_extensions = fasl dfsl cfsl fasl fas lib dx32fsl lx64fsl lx32fsl
+clean_extensions = fasl dfsl cfsl fasl fas lib dx32fsl lx64fsl lx32fsl o
 
 clean: FORCE
 	@for dir in $(clean_dirs); do \
@@ -63,4 +63,4 @@ test-all: FORCE
 	sbcl --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \
 		--eval "(write-test-web-pages)" --eval "(quit)"
 
-FORCE:
\ No newline at end of file
+FORCE:
diff --git a/README.asdf-output-translations b/README.asdf-output-translations
new file mode 100644
index 0000000000000000000000000000000000000000..61b702999d48e06b83ee33fa57ee110e9a5fe89d
--- /dev/null
+++ b/README.asdf-output-translations
@@ -0,0 +1,288 @@
+========================
+ASDF Output Translations
+========================
+
+This file specifies how ASDF stores "binary" outputs for its operations,
+typically Lisp FASL files, but also any other files
+that may be generated, e.g. C files and executables from CFFI-GROVEL.
+
+Configurations
+==============
+
+Configurations specify mappings from source locations to binary locations.
+
+  1- An application may explicitly initialize the output-translations
+     configuration using the `Configuration API`_ below,
+     in which case this takes precedence.
+     It may itself compute this configuration from the command-line,
+     from a script, from its own configuration file, etc.
+
+  2- The source registry will be configured from
+     the environment variable ``ASDF_OUTPUT_TRANSLATIONS`` if it exists.
+
+  3- The source registry will be configured from
+     user configuration file
+	``~/.config/common-lisp/asdf-output-translations.conf``
+     if it exists.
+
+  4- The source registry will be configured from
+     user configuration directory
+	``~/.config/common-lisp/asdf-output-translations.conf.d/``
+     if it exists.
+
+  5- The source registry will be configured from
+     system configuration file
+	``/etc/common-lisp/asdf-output-translations.conf``
+     if it exists.
+
+  6- The source registry will be configured from
+     system configuration directory
+	``/etc/common-lisp/asdf-output-translations.conf.d/``
+     if it exists.
+
+Each of these configurations is specified as a SEXP
+in a trival domain-specific language (defined below).
+Additionally, a more shell-friendly syntax is available
+for the environment variable (defined yet below).
+
+Each of these configurations is only used if the previous
+configuration explicitly or implicitly specifies that it
+includes its inherited configuration.
+
+Additionally, some implementation-specific directories
+may be automatically added to whatever mappings are specified
+in configuration files, no matter if the last one inherits or not.
+
+
+Backward Compatibility
+======================
+
+We purposefully do NOT provide backward compatibility with earlier versions of
+asdf-binary-locations (8 Sept 2009),
+common-lisp-controller (7.00) or
+cl-launch (2.35),
+each of which had similar general capabilities.
+Future versions of same packages (if any)
+will hopefully use the new ASDF API as defined below.
+
+These previous programs' API was not designed
+for easy configuration by the end-user
+in an easy way with configuration files,
+and their previous API didn't fit the new paradigm.
+
+But this incompatibility won't inconvenience many people.
+Indeed, few people use and customize these packages;
+these people are experts who can trivially adapt to the new configuration.
+Most people are not experts, could not properly configure these features
+(except inasmuch as the default configuration of
+common-lisp-controller and/or cl-launch
+might have been doing the right thing for some users),
+and yet will experience software that "just works",
+as configured by the system distributor, or by default.
+
+Nevertheless, if you want to use the old ASDF-Binary-Locations
+(the one available as an extension to load of top of ASDF,
+not the one built into a few old versions of ASDF),
+it may still work if you just make sure you do not configure the new
+builtin ASDF-Output-Translations.
+But if you configure both ASDF's new builtin and ASDF-Binary-Locations
+(or an old common-lisp-controller or cl-launch),
+you may experience "interesting" issues, so don't do it.
+
+
+Configuration DSL
+=================
+
+Here is the grammar of the SEXP DSL for asdf-output-translations configuration:
+
+;; A configuration is single SEXP starting with keyword :source-registry
+;; followed by a list of directives.
+CONFIGURATION := (:output-translations DIRECTIVE ...)
+
+;; A directive is one of the following:
+DIRECTIVE :=
+    ;; include a configuration file or directory
+    (:include PATHNAME-DESIGNATOR) |
+
+    ;; Your configuration expression MUST contain
+    ;; exactly one of either of these:
+    :inherit-configuration | ; splices contents of inherited configuration
+    :ignore-inherited-configuration | ; drop contents of inherited configuration
+
+    ;; enable global cache in ~/.common-lisp/cache/sbcl-1.0.35-x86-64/ or something.
+    :enable-user-cache |
+    ;; Disable global cache. Map / to /
+    :disable-cache |
+
+    ;; add a single directory to be scanned (no recursion)
+    (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR)
+
+
+DIRECTORY-DESIGNATOR :=
+    ABSOLUTE-COMPONENT-DESIGNATOR |
+    (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...)
+
+ABSOLUTE-COMPONENT-DESIGNATOR :=
+    STRING | ;; namestring (directory is assumed, better be absolute or bust, ``/**/*.*`` added)
+    PATHNAME | ;; pathname (better be an absolute directory or bust)
+    :HOME | ;; designates the user-homedir-pathname ~/
+    :USER-CACHE | ;; designates the default location for the user cache
+    :SYSTEM-CACHE | ;; designates the default location for the system cache
+    :ROOT | ;; the root of the filesystem hierarchy
+    :CURRENT-DIRECTORY ;; the current directory
+
+RELATIVE-COMPONENT-DESIGNATOR :=
+    STRING | ;; namestring, directory is assumed. If the last component, ``/**/*.*`` is added
+    PATHNAME | ;; pathname unless last component, directory is assumed.
+    :IMPLEMENTATION | ;; a directory based on implementation, e.g. sbcl-1.0.32.30-linux-x86-64
+    :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl
+    :CURRENT-DIRECTORY | ;; all components of the current directory, without the :absolute
+    :UID | ;; current UID -- not available on Windows
+    :USER ;; current USER name -- NOT IMPLEMENTED(!)
+
+Relative components better be either relative
+or subdirectories of the path before them, or bust.
+
+The last component, if not a pathname, is notionally completed by ``/**/*.*``.
+You can specify more fine-grained patterns by using a pathname object,
+e.g. ``#p"some/path/**/foo*/bar-*.fasl"``
+
+You may use ``#+features`` to customize the configuration file.
+
+The second designator of a mapping may be ``NIL``, indicating that files are not mapped
+to anything but themselves (same as if the second designator was the same as the first).
+
+``:include`` statements cause the search to recurse with the path specifications
+from the file specified.
+
+An ``:inherit-configuration`` statement cause the search to recurse with the path
+specifications from the next configuration
+(see section Configurations_ above).
+
+:enable-user-cache is the same as ``(:root :user-cache)``.
+:disable-cache is the same as ``(:root :root)``.
+:user-cache uses the contents of variable ``asdf::*user-cache*``
+which by default is the same as using
+``(:home ".cache" "common-lisp" :implementation)``.
+:system-cache uses the contents of variable ``asdf::*system-cache*``
+which by default is the same as using
+``(:root "var" "cache" "common-lisp" :uid :implementation-type)``
+
+
+Configuration Directories
+=========================
+
+Configuration directories consist in files each contains
+a list of directives without any enclosing ``(:asdf-output-translations ...)`` form.
+The files will be sorted by namestring as if by ``#'string<`` and
+the lists of directives of these files with be concatenated in order.
+An implicit ``:inherit-configuration`` will be included
+at the end of the list.
+
+This allows for packaging software that has file granularity
+(e.g. Debian's ``dpkg`` or some future version of ``clbuild``)
+to easily include configuration information about distributed software.
+
+Directories may be included by specifying a directory pathname
+or namestring in an ``:include`` directive, e.g.::
+	(:include "/foo/bar/")
+
+
+Shell-friendly syntax for configuration
+=======================================
+
+When considering environment variable ``ASDF_OUTPUT_TRANSLATIONS``
+ASDF will skip to next configuration if it's an empty string.
+It will ``READ`` the string as a SEXP in the DSL
+if it begins with a paren ``(``
+and it will be interpreted as a colon-separated list of directories.
+Directories should come in pairs, each pair indicating a :map directive.
+
+The magic empty entry indicates the splicing of inherited configuration
+rather than one of entry in a mapping pair.
+
+
+Semantics of Output Translations
+================================
+
+From the specified configuration, a list of mappings is extracted
+in a straightforward way:
+mappings are collected in order, recursing through
+included or inherited configuration as specified.
+To this list is prepended some implementation-specific mappings,
+and is appended a global default.
+
+The list is then compiled to a mapping table as follows:
+for each entry, in order, resolve the first designated directory
+into an actual directory pathname for source locations.
+If no mapping was specified yet for that location,
+resolve the second designated directory to an output location directory
+add a mapping to the table mapping the source location to the output location,
+and add another mapping from the output location to itself
+(unless a mapping already exists for the output location).
+
+Based on the table, a mapping function is defined,
+mapping source pathnames to output pathnames:
+given a source pathname, locate the longest matching prefix
+in the source column of the mapping table.
+Replace that prefix by the corresponding output column
+in the same row of the table, and return the result.
+If no match is found, return the source pathname.
+(A global default mapping the filesystem root to itself
+may ensure that there will always be a match,
+with same fall-through semantics).
+
+Caching Results
+===============
+
+The implementation is allowed to either eagerly compute the information
+from the configurations and file system, or to lazily re-compute it
+every time, or to cache any part of it as it goes.
+To explicitly flush any information cached by the system, use the API below.
+
+
+Output location API
+===================
+
+The specified functions are exported from package ASDF.
+
+(initialize-output-translations)
+   will read the configuration and initialize all internal variables.
+
+(clear-output-translations)
+   undoes any output location configuration
+   and clears any cache for the mapping algorithm.
+   You might want to call that before you
+   dump an image that would be resumed with a different configuration,
+   and return an empty configuration.
+   Note that this does not include clearing information about
+   systems defined in the current image, only about
+   where to look for systems not yet defined.
+
+(ensure-output-translations)
+   checks whether output translations have been initialized.
+   If not, initialize them.
+   This function will be called before any attempt to operate on a system.
+   If your application wants to override the provided defaults,
+   it will have to use the below function process-output-translations.
+
+(apply-output-translations PATHNAME)
+   Applies the configured output location translations to PATHNAME
+   (calls ensure-output-translations for the translations).
+
+
+Credits
+=======
+
+Thanks a lot to Bjorn Lindberg and Gary King for ASDF-Binary-Locations,
+and to Peter van Eynde for Common Lisp Controller.
+
+All bad design ideas and implementation bugs are to mine, not theirs.
+But so are good design ideas and elegant implementation tricks.
+
+ -- Francois-Rene Rideau <fare@tunes.org>
+
+..
+  ;;; Local Variables:
+  ;;; mode: rst
+  ;;; End:
diff --git a/README.source-registry b/README.source-registry
index a22fd664ab67fd04411a940388362998c6eb130a..c17028b0b64b22511494a8acd9ac462eaa98c370 100644
--- a/README.source-registry
+++ b/README.source-registry
@@ -49,6 +49,15 @@ in a trival domain-specific language (defined below).
 Additionally, a more shell-friendly syntax is available
 for the environment variable (defined yet below).
 
+Each of these configurations is only used if the previous
+configuration explicitly or implicitly specifies that it
+includes its inherited configuration.
+
+Additionally, some implementation-specific directories
+may be automatically prepended to whatever directories are specified
+in configuration files, no matter if the last one inherits or not.
+
+
 
 Backward Compatibility
 ======================
@@ -92,11 +101,11 @@ DIRECTIVE :=
 
     ;; Your configuration expression MUST contain
     ;; exactly one of either of these:
-    (:inherit-configuration) | ; splices contents of inherited configuration
-    (:ignore-inherited-configuration) ; drop contents of inherited configuration
+    :inherit-configuration | ; splices contents of inherited configuration
+    :ignore-inherited-configuration | ; drop contents of inherited configuration
 
     ;; This directive specifies that some default must be spliced.
-    (:default-registry)
+    :default-registry
 
 PATTERN := a string without wildcards, that will be matched exactly
 	against the name of a any subdirectory in the directory component
@@ -113,7 +122,7 @@ the lists of directives of these files with be concatenated in order.
 An implicit ``:inherit-configuration`` will be included
 at the end of the list.
 
-This allows for packaging software with has file granularity
+This allows for packaging software that has file granularity
 (e.g. Debian's ``dpkg`` or some future version of ``clbuild``)
 to easily include configuration information about distributed software.
 
@@ -283,6 +292,15 @@ for the sake of keeping ASDF no more complex than strictly necessary.
   down a filesystem tree in the environment variable.
   It isn't that Lisp friendly either.
 
+TODO
+====
+
+* Integrate into the rest of the documentation.
+* Add examples
+* Add proper defaults.
+* Get inspired by the XDG base directory specification?
+ http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
+
 
 Credits
 =======
@@ -294,4 +312,4 @@ Thanks to Rommel Martinez for the initial implementation attempt.
 All bad design ideas and implementation bugs are to mine, not theirs.
 But so are good design ideas and elegant implementation tricks.
 
- -- Francois-Rene Rideau <fare@tunes.org>, Sun, 24 Jan 2010 20:54:19 -0500
+ -- Francois-Rene Rideau <fare@tunes.org>, Mon, 22 Feb 2010 00:07:33 -0500
diff --git a/asdf-ecl.lisp b/asdf-ecl.lisp
index 7fd2c8fb1636348c079617828fea2f643e9d48fd..ae8459f13af5eff99bfc57a5c89b48e5ad1888f0 100644
--- a/asdf-ecl.lisp
+++ b/asdf-ecl.lisp
@@ -16,32 +16,12 @@
 ;;;
 ;;; COMPILE-OP / LOAD-OP
 ;;;
-;;; We change these operations to produce both FASL files and the
+;;; In ECL, these operations produce both FASL files and the
 ;;; object files that they are built from. Having both of them allows
 ;;; us to later on reuse the object files for bundles, libraries,
 ;;; standalone executables, etc.
 ;;;
 
-(defmethod initialize-instance :after ((instance compile-op) &key &allow-other-keys)
-  (setf (slot-value instance 'flags) '(:system-p t)))
-
-(defmethod output-files ((o compile-op) (c cl-source-file))
-  (list (compile-file-pathname (component-pathname c) :type :object)
-        (compile-file-pathname (component-pathname c) :type :fasl)))
-
-(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* ((input (output-files o c))
-         (output (compile-file-pathname (first input) :type :fasl)))
-    (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=))))
-
-(defmethod perform ((o load-op) (c cl-source-file))
-  (loop for i in (input-files o c)
-       unless (string= (pathname-type i) "fas")
-       collect (let ((output (compile-file-pathname i)))
-                 (load output))))
-
 ;;;
 ;;; BUNDLE-OP
 ;;;
diff --git a/asdf.lisp b/asdf.lisp
index bd415f1fb051dc837def4ba200181389142c0268..bdab44dfc8a1547a9eef28914981f110a0ddb993 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,14 +1,10 @@
+;;; -*- mode: common-lisp; package: asdf; -*-
 ;;; This is asdf: Another System Definition Facility.
-;;; hash - $Format:%H$
 ;;;
-;;; Local Variables:
-;;; mode: lisp
-;;; End:
-;;;
-;;; Feedback, bug reports, and patches are all welcome: please mail to
-;;; <asdf-devel@common-lisp.net>.  But note first that the canonical
-;;; source for asdf is presently on common-lisp.net at
-;;; <URL:http://common-lisp.net/project/asdf/>
+;;; Feedback, bug reports, and patches are all welcome:
+;;; please mail to <asdf-devel@common-lisp.net>.
+;;; Note first that the canonical source for asdf is presently
+;;; <URL:http://common-lisp.net/project/asdf/>.
 ;;;
 ;;; If you obtained this copy from anywhere else, and you experience
 ;;; trouble using it, or find bugs, you may want to check at the
@@ -46,121 +42,189 @@
 ;;;
 ;;; -- LICENSE END
 
-;;; the problem with writing a defsystem replacement is bootstrapping:
-;;; we can't use defsystem to compile it.  Hence, all in one file
+;;; The problem with writing a defsystem replacement is bootstrapping:
+;;; we can't use defsystem to compile it.  Hence, all in one file.
 
 #+xcvb (module ())
 
-(defpackage #:asdf
-  (:documentation "Another System Definition Facility")
-  (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command
-           #:system-definition-pathname #:find-component ; miscellaneous
-           #:compile-system #:load-system #:test-system
-           #:compile-op #:load-op #:load-source-op
-           #:test-op
-           #:operation                 ; operations
-           #:feature                 ; sort-of operation
-           #:version                 ; metaphorically sort-of an operation
-
-           #:input-files #:output-files #:perform ; operation methods
-           #:operation-done-p #:explain
-
-           #:component #:source-file
-           #:c-source-file #:cl-source-file #:java-source-file
-           #:static-file
-           #:doc-file
-           #:html-file
-           #:text-file
-           #:source-file-type
-           #:module                     ; components
-           #:system
-           #:unix-dso
-
-           #:module-components          ; component accessors
-           #:component-pathname
-           #:component-relative-pathname
-           #:component-name
-           #:component-version
-           #:component-parent
-           #:component-property
-           #:component-system
-
-           #:component-depends-on
-
-           #:system-description
-           #:system-long-description
-           #:system-author
-           #:system-maintainer
-           #:system-license
-           #:system-licence
-           #:system-source-file
-           #:system-relative-pathname
-           #:map-systems
-
-           #:operation-on-warnings
-           #:operation-on-failure
+(cl:in-package :cl-user)
+
+(declaim (optimize (speed 3) (debug 2) (safety 2)))
+
+#+ecl (require 'cmp)
+
+;;;; Create packages in a way that is compatible with hot-upgrade.
+;;;; See https://bugs.launchpad.net/asdf/+bug/485687
+;;;; See more at the end of the file.
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (labels ((rename-away (package)
+             (loop :with name = (package-name package)
+               :for i :from 1 :for n = (format nil "~A.~D" name i)
+               :unless (find-package n) :do (rename-package package name)))
+           (ensure-exists (name nicknames)
+             (let* ((previous
+                     (remove-duplicates
+                      (remove-if
+                       #'null
+                       (mapcar #'find-package (cons name nicknames)))
+                      :from-end t)))
+               (cond
+                 (previous
+                  (map () #'rename-away (cdr previous))
+                  (rename-package (car previous) name nicknames)
+                  (car previous))
+                 (t
+                  (make-package name :nicknames nicknames)))))
+           (remove-symbol (symbol package)
+             (let ((sym (find-symbol (string symbol) package)))
+               (when sym
+                 (unexport sym package)
+                 (unintern sym package))))
+           (ensure-unintern (package symbols)
+             (dolist (sym symbols) (remove-symbol sym package)))
+           (ensure-use (package use)
+             (dolist (used use)
+               (do-external-symbols (sym used)
+                 (unless (eq sym (find-symbol (string sym) package))
+                   (remove-symbol sym package)))
+               (use-package used package)))
+           (ensure-export (package export)
+             (let ((syms (loop :for x :in export :collect
+                           (intern (string x) package))))
+               (do-external-symbols (sym package)
+                 (unless (member sym syms)
+                   (remove-symbol sym package)))
+               (dolist (sym syms)
+                 (export sym package))))
+           (ensure-package (name &key nicknames use export unintern)
+             (let* ((p (ensure-exists name nicknames)))
+               (ensure-use p use)
+               (ensure-unintern p unintern)
+               (ensure-export p export)
+               p)))
+    (ensure-package
+     ':asdf-utilities
+     :nicknames '(#:asdf-extensions)
+     :use '(#:common-lisp)
+     :export
+     '(#:absolute-pathname-p
+       #:aif
+       #:appendf
+       #:asdf-message
+       #:coerce-name
+       #:directory-pathname-p
+       #:ends-with
+       #:ensure-directory-pathname
+       #:getenv
+       #:get-uid
+       #:length=n-p
+       #:make-collector
+       #:pathname-directory-pathname
+       #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname
+       #:read-file-forms
+       #:remove-keys
+       #:remove-keyword
+       #:resolve-symlinks
+       #:split
+       #:component-name-to-pathname-components
+       #:system-registered-p
+       #:truenamize))
+    (ensure-package
+     ':asdf
+     :use '(:common-lisp :asdf-utilities)
+     :unintern '(#:*asdf-revision*)
+     :export
+     '(#:defsystem #:oos #:operate #:find-system #:run-shell-command
+       #:system-definition-pathname #:find-component ; miscellaneous
+       #:compile-system #:load-system #:test-system
+       #:compile-op #:load-op #:load-source-op
+       #:test-op
+       #:operation                 ; operations
+       #:feature                 ; sort-of operation
+       #:version                 ; metaphorically sort-of an operation
+
+       #:input-files #:output-files #:perform ; operation methods
+       #:operation-done-p #:explain
+
+       #:component #:source-file
+       #:c-source-file #:cl-source-file #:java-source-file
+       #:static-file
+       #:doc-file
+       #:html-file
+       #:text-file
+       #:source-file-type
+       #:module                     ; components
+       #:system
+       #:unix-dso
+
+       #:module-components          ; component accessors
+       #:component-pathname
+       #:component-relative-pathname
+       #:component-name
+       #:component-version
+       #:component-parent
+       #:component-property
+       #:component-system
+
+       #:component-depends-on
+
+       #:system-description
+       #:system-long-description
+       #:system-author
+       #:system-maintainer
+       #:system-license
+       #:system-licence
+       #:system-source-file
+       #:system-relative-pathname
+       #:map-systems
+
+       #:operation-on-warnings
+       #:operation-on-failure
 
                                         ;#:*component-parent-pathname*
-           #:*system-definition-search-functions*
-           #:*central-registry*         ; variables
-           #:*compile-file-warnings-behaviour*
-           #:*compile-file-failure-behaviour*
-           #:*resolve-symlinks*
-
-           #:asdf-version
-
-           #:operation-error #:compile-failed #:compile-warned #:compile-error
-           #:error-name
-           #:error-pathname
-           #:missing-definition
-           #:error-component #:error-operation
-           #:system-definition-error
-           #:missing-component
-           #:missing-component-of-version
-           #:missing-dependency
-           #:missing-dependency-of-version
-           #:circular-dependency        ; errors
-           #:duplicate-names
-
-           #:try-recompiling
-           #:retry
-           #:accept                     ; restarts
-           #:coerce-entry-to-directory
-           #:remove-entry-from-registry
-
-           #:standard-asdf-method-combination
-           #:around                     ; protocol assistants
-
-           #:*source-to-target-mappings*
-           #:*default-toplevel-directory*
-           #:*centralize-lisp-binaries*
-           #:*include-per-user-information*
-           #:*map-all-source-files*
-           #:output-files-for-system-and-operation
-           #:*enable-asdf-binary-locations*
-           #:implementation-specific-directory-name
-
-           #:initialize-source-registry
-           #:clear-source-registry
-           #:ensure-source-registry
-           #:process-source-registry)
-  (:intern #:coerce-name
-           #:getenv
-           #:system-registered-p
-           #:asdf-message
-           #:resolve-symlinks
-           #:pathname-sans-name+type)
-  (:use :cl))
-
-(defpackage #:asdf-extensions
-  (:use #:common-lisp #:asdf)
-  (:import-from #:asdf
-                #:coerce-name
-                #:getenv
-                #:system-registered-p
-                #:asdf-message
-                #:resolve-symlinks
-                #:pathname-sans-name+type))
+       #:*system-definition-search-functions*
+       #:*central-registry*         ; variables
+       #:*compile-file-warnings-behaviour*
+       #:*compile-file-failure-behaviour*
+       #:*resolve-symlinks*
+
+       #:asdf-version
+
+       #:operation-error #:compile-failed #:compile-warned #:compile-error
+       #:error-name
+       #:error-pathname
+       #:missing-definition
+       #:error-component #:error-operation
+       #:system-definition-error
+       #:missing-component
+       #:missing-component-of-version
+       #:missing-dependency
+       #:missing-dependency-of-version
+       #:circular-dependency        ; errors
+       #:duplicate-names
+
+       #:try-recompiling
+       #:retry
+       #:accept                     ; restarts
+       #:coerce-entry-to-directory
+       #:remove-entry-from-registry
+
+       #:standard-asdf-method-combination
+       #:around                     ; protocol assistants
+
+       #:initialize-output-translations
+       #:clear-output-translations
+       #:ensure-output-translations
+       #:apply-output-translations
+       #:compile-file-pathname*
+
+       #:*default-source-registries*
+       #:initialize-source-registry
+       #:compute-source-registry
+       #:clear-source-registry
+       #:ensure-source-registry
+       #:process-source-registry))))
 
 #+nil
 (error "The author of this file habitually uses #+nil to comment out ~
@@ -173,10 +237,16 @@
 ;;;; User-visible parameters
 ;;;;
 (defparameter *asdf-version*
+  ;; This parameter isn't actually user-visible
+  ;; -- please use the exported function ASDF:ASDF-VERSION below.
   ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
-  (subseq "VERSION:1.502" (1+ (length "VERSION"))))
+  (subseq "VERSION:1.625" (1+ (length "VERSION"))))
 
 (defun asdf-version ()
+  "Exported interface to the version of ASDF currently installed. A string.
+
+Not officially supported:
+you can compare this string with ASDF::VERSION-SATISFIES."
   *asdf-version*)
 
 (defvar *resolve-symlinks* t
@@ -193,6 +263,14 @@ Defaults to `t`.")
 (defparameter +asdf-methods+
   '(perform explain output-files operation-done-p))
 
+#+allegro
+(eval-when (:compile-toplevel :execute)
+  (defparameter *acl-warn-save*
+                (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
+                  excl:*warn-on-nested-reader-conditionals*))
+  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
+    (setf excl:*warn-on-nested-reader-conditionals* nil)))
+
 ;;;; -------------------------------------------------------------------------
 ;;;; Cleanups before hot-upgrade.
 ;;;; Things to do in case we're upgrading from a previous version of ASDF.
@@ -202,7 +280,11 @@ Defaults to `t`.")
 ;;;; * define methods on UPDATE-INSTANCE-FOR-REDEFINED-CLASS
 ;;;;   for each of the classes we define that has changed incompatibly.
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (fmakunbound 'system-source-file)
+  (when (and (fboundp 'system-source-file)
+             (not (typep (fdefinition 'system-source-file) 'generic-function)))
+    (fmakunbound 'system-source-file))
+  (map () 'fmakunbound '(process-source-registry inherit-source-registry
+                         process-source-registry-directive))
   #+ecl
   (when (find-class 'compile-op nil)
     (defmethod update-instance-for-redefined-class :after
@@ -273,7 +355,11 @@ be overridden by around methods added by a system developer.")
   (:documentation "Extracts the pathname applicable for a particular component."))
 
 (defgeneric component-relative-pathname (component)
-  (:documentation "Extracts the relative pathname applicable for a particular component."))
+  (:documentation "Returns a pathname for the component argument intended to be
+interpreted relative to the pathname of that component's parent.
+Despite the function's name, the return value may be an absolute
+pathname, because an absolute pathname may be interpreted relative to
+another pathname in a degenerate way."))
 
 (defgeneric component-property (component property))
 
@@ -293,9 +379,28 @@ system."))
    "Recursively chase the operation's parent pointer until we get to
 the head of the tree"))
 
-(defgeneric component-visited-p (operation component))
-
-(defgeneric visit-component (operation component data))
+(defgeneric component-visited-p (operation component)
+  (:documentation "Returns the value stored by a call to
+VISIT-COMPONENT, if that has been called, otherwise NIL.
+This value stored will be a cons cell, the first element
+of which is a computed key, so not interesting.  The
+CDR wil be the DATA value stored by VISIT-COMPONENT; recover
+it as \(cdr \(component-visited-p op c\)\).
+  In the current form of ASDF, the DATA value retrieved is
+effectively a boolean, indicating whether some operations are
+to be performed in order to do OPERATION X COMPONENT.  If the
+data value is NIL, the combination had been explored, but no
+operations needed to be performed."))
+
+(defgeneric visit-component (operation component data)
+  (:documentation "Record DATA as being associated with OPERATION
+and COMPONENT.  This is a side-effecting function:  the association
+will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
+OPERATION\).
+  No evidence that DATA is ever interesting, beyond just being
+non-NIL.  Using the data field is probably very risky; if there is
+already a record for OPERATION X COMPONENT, DATA will be quietly
+discarded instead of recorded."))
 
 (defgeneric (setf visiting-component) (new-value operation component))
 
@@ -358,9 +463,17 @@ structure will mirror that of the source."))
 
 (defun pathname-sans-name+type (pathname)
   "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
-and NIL NAME and TYPE components"
+and NIL NAME and TYPE components.
+Issue: doesn't override the VERSION component.
+
+Deprecated. Use PATHNAME-DIRECTORY-PATHNAME instead."
   (make-pathname :name nil :type nil :defaults pathname))
 
+(defun pathname-directory-pathname (pathname)
+  "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
+and NIL NAME, TYPE and VERSION components"
+  (make-pathname :name nil :type nil :version nil :defaults pathname))
+
 (define-modify-macro appendf (&rest args)
   append "Append onto list")
 
@@ -368,7 +481,7 @@ and NIL NAME and TYPE components"
   (declare (dynamic-extent format-args))
   (apply #'format *verbose-out* format-string format-args))
 
-;;; with apologies to christophe rhodes ...
+;;; with apologies to Christophe Rhodes ...
 (defun split (string &optional max (ws '(#\Space #\Tab)))
   (flet ((is-ws (char) (find char ws)))
     (nreverse
@@ -382,13 +495,30 @@ and NIL NAME and TYPE components"
          (unless end (return list))
          (setf start (1+ end)))))))
 
-(defun split-path-string (s &optional force-directory)
+(defun component-name-to-pathname-components (s &optional force-directory)
+  "Splits the path string S, returning three values:
+A flag that is either :absolute or :relative, indicating
+   how the rest of the values are to be interpreted.
+A directory path --- a list of strings, suitable for
+   use with MAKE-PATHNAME when prepended with the flag
+   value.
+A filename with type extension, possibly NIL in the
+   case of a directory pathname.
+FORCE-DIRECTORY forces S to be interpreted as a directory
+pathname \(third return value will be NIL, final component
+of S will be treated as part of the directory path.
+
+The intention of this function is to support structured component names,
+e.g., \(:file \"foo/bar\"\), which will be unpacked to relative
+pathnames."
   (check-type s string)
   (let* ((components (split s nil "/"))
          (last-comp (car (last components))))
     (multiple-value-bind (relative components)
         (if (equal (first components) "")
-          (values :absolute (cdr components))
+            (if (and (plusp (length s)) (eql (char s 0) #\/))
+                (values :absolute (cdr components))
+                (values :relative nil))
           (values :relative components))
       (cond
         ((equal last-comp "")
@@ -423,7 +553,7 @@ and NIL NAME and TYPE components"
   #+cmu
   (cdr (assoc (intern x :keyword) ext:*environment-list*))
   #+lispworks
-  (lispworks:environment-xiable x)
+  (lispworks:environment-variable x)
   #+allegro
   (sys:getenv x)
   #+gcl
@@ -431,11 +561,34 @@ and NIL NAME and TYPE components"
   #+ecl
   (si:getenv x))
 
+(defun directory-pathname-p (pathname)
+  "Does `pathname` represent a directory?
+
+A directory-pathname is a pathname _without_ a filename. The three
+ways that the filename components can be missing are for it to be `nil`,
+`:unspecific` or the empty string.
+
+Note that this does _not_ check to see that `pathname` points to an
+actually-existing directory."
+  (flet ((check-one (x)
+           (not (null (member x '(nil :unspecific "")
+                              :test 'equal)))))
+    (and (check-one (pathname-name pathname))
+         (check-one (pathname-type pathname)))))
+
 (defun ensure-directory-pathname (pathspec)
   "Converts the non-wild pathname designator PATHSPEC to directory form."
   (cond
    ((stringp pathspec)
-    (pathname (concatenate 'string pathspec "/")))
+    (pathname
+     (let ((lastchar (aref pathspec (1- (length pathspec)))))
+       (cond ((or (eql lastchar #\;) (eql lastchar #\/)) pathspec)
+             ((find #\; pathspec)
+              (concatenate 'string pathspec ";"))
+             (t
+              ;; guess it's a string that's not a logical
+              ;; pathname string
+              (concatenate 'string pathspec "/"))))))
    ((not (pathnamep pathspec))
     (error "Invalid pathname designator ~S" pathspec))
    ((wild-pathname-p pathspec)
@@ -449,6 +602,9 @@ and NIL NAME and TYPE components"
                    :name nil :type nil :version nil
                    :defaults pathspec))))
 
+(defun absolute-pathname-p (pathspec)
+  (eq :absolute (car (pathname-directory (pathname pathspec)))))
+
 (defun length=n-p (x n) ;is it that (= (length x) n) ?
   (check-type n (integer 0 *))
   (loop
@@ -465,6 +621,72 @@ and NIL NAME and TYPE components"
     (and (<= 0 start)
          (string-equal s suffix :start1 start))))
 
+(defun make-collector ()
+  (let ((acc ()))
+    (values (lambda (x) (push x acc))
+            (lambda () (reverse acc)))))
+
+(defun read-file-forms (file)
+  (with-open-file (in file)
+    (loop :with eof = (list nil)
+     :for form = (read in nil eof)
+     :until (eq form eof)
+     :collect form)))
+
+#-windows
+(progn
+#+clisp (defun get-uid () (posix:uid))
+#+sbcl (defun get-uid () (sb-unix:unix-getuid))
+#+cmu (defun get-uid () (unix:unix-getuid))
+#+ecl (defun get-uid () (ffi:c-inline () () :int "getuid()" :one-liner t))
+#+allegro (defun get-uid () (excl.osi:getuid))
+#-(or cmu sbcl clisp allegro ecl)
+(defun get-uid ()
+  (let ((uid-string
+         (with-output-to-string (asdf::*VERBOSE-OUT*)
+           (asdf:run-shell-command "id -ur"))))
+    (with-input-from-string (stream uid-string)
+      (read-line stream)
+      (handler-case (parse-integer (read-line stream))
+        (error () (error "Unable to find out user ID")))))))
+
+(defun truenamize (p)
+  "Resolve as much of a pathname as possible"
+  (block :t
+    (setf p (translate-logical-pathname (merge-pathnames p)))
+    (ignore-errors (return-from :t (truename p)))
+    (let ((host (pathname-host p))
+          (device (pathname-device p))
+          (directory (pathname-directory p)))
+      (when (or (atom directory) (not (eq :absolute (car directory))))
+        (return-from :t p))
+      (let ((sofar (ignore-errors
+                     (truename (make-pathname :host host :device device
+                                              :directory '(:absolute))))))
+        (unless sofar (return-from :t p))
+        (loop :for component :in (cdr directory)
+          :for rest :on (cdr directory)
+          :for more = (ignore-errors
+                        (truename
+                         (merge-pathnames
+                          (make-pathname :directory `(:relative ,component))
+                          sofar))) :do
+          (if more
+              (setf sofar more)
+              (return-from :t
+                (merge-pathnames
+                 (make-pathname :host nil :device nil
+                                :directory `(:relative ,@rest)
+                                :defaults p)
+                 sofar)))
+          :finally
+          (return-from :t
+            (merge-pathnames
+             (make-pathname :host nil :device nil
+                            :directory nil
+                            :defaults p)
+             sofar)))))))
+
 ;;;; -------------------------------------------------------------------------
 ;;;; Classes, Conditions
 
@@ -595,19 +817,22 @@ and NIL NAME and TYPE components"
 (defun component-parent-pathname (component)
   (aif (component-parent component)
        (component-pathname it)
-       *default-pathname-defaults*))
+       (truename *default-pathname-defaults*)))
 
 (defmethod component-relative-pathname ((component module))
-  (or (slot-value component 'relative-pathname)
-      (multiple-value-bind (relative path)
-          (split-path-string (component-name component) t)
-        (make-pathname
-         :directory `(,relative ,@path)
-         :host (pathname-host (component-parent-pathname component))))))
+  (let ((specified-pathname (or (slot-value component 'relative-pathname)
+                                (component-name component))))
+    (if (pathnamep specified-pathname)
+        specified-pathname
+        (multiple-value-bind (relative path)
+            (component-name-to-pathname-components specified-pathname t)
+          (make-pathname
+           :directory `(,relative ,@path)
+           :host (pathname-host (component-parent-pathname component)))))))
 
 (defmethod component-pathname ((component component))
-  (let ((*default-pathname-defaults* (component-parent-pathname component)))
-    (merge-pathnames (component-relative-pathname component))))
+  (merge-pathnames (component-relative-pathname component)
+                   (component-parent-pathname component)))
 
 (defmethod component-property ((c component) property)
   (cdr (assoc property (slot-value c 'properties) :test #'equal)))
@@ -636,8 +861,11 @@ and NIL NAME and TYPE components"
 (defmethod version-satisfies ((c component) version)
   (unless (and version (slot-boundp c 'version))
     (return-from version-satisfies t))
+  (version-satisfies (component-version c) version))
+
+(defmethod version-satisfies ((cver string) version)
   (let ((x (mapcar #'parse-integer
-                   (split (component-version c) nil '(#\.))))
+                   (split cver nil '(#\.))))
         (y (mapcar #'parse-integer
                    (split version nil '(#\.)))))
     (labels ((bigger (x y)
@@ -687,7 +915,7 @@ called with an object of type asdf:system."
 ;;; for the sake of keeping things reasonably neat, we adopt a
 ;;; convention that functions in this list are prefixed SYSDEF-
 
-(defvar *system-definition-search-functions*
+(defparameter *system-definition-search-functions*
   '(sysdef-central-registry-search))
 
 (defun system-definition-pathname (system)
@@ -712,21 +940,6 @@ which evaluates to a pathname. For example:
                 #p\"/usr/share/common-lisp/systems/\"))
 ")
 
-(defun directory-pathname-p (pathname)
-  "Does `pathname` represent a directory?
-
-A directory-pathname is a pathname _without_ a filename. The three
-ways that the filename components can be missing are for it to be `nil`,
-`:unspecific` or the empty string.
-
-Note that this does _not_ check to see that `pathname` points to an
-actually-existing directory."
-  (flet ((check-one (x)
-           (not (null (member x '(nil :unspecific "")
-                              :test 'equal)))))
-    (and (check-one (pathname-name pathname))
-         (check-one (pathname-type pathname)))))
-
 (defun sysdef-central-registry-search (system)
   (let ((name (coerce-name system))
         (to-remove nil)
@@ -796,7 +1009,11 @@ to `~a` which is not a directory.~@:>"
            ;; that's the case, well, that's not good, but as long as
            ;; the operation is otherwise considered to be done we
            ;; could continue and survive.
-  (or (file-write-date pathname) 0))
+  (or (file-write-date pathname)
+      (progn
+        (warn "Missing FILE-WRITE-DATE for ~S: treating it as zero."
+              pathname)
+        0)))
 
 (defun find-system (name &optional (error-p t))
   (let* ((name (coerce-name name))
@@ -844,6 +1061,7 @@ to `~a` which is not a directory.~@:>"
 
 ;;; a component with no parent is a system
 (defmethod find-component ((module (eql nil)) name &optional version)
+  (declare (ignorable module))
   (let ((m (find-system name nil)))
     (if (and m (version-satisfies m version)) m)))
 
@@ -866,7 +1084,7 @@ to `~a` which is not a directory.~@:>"
 
 (defun merge-component-relative-pathname (pathname name type)
   (multiple-value-bind (relative path filename)
-      (split-path-string name)
+      (component-name-to-pathname-components name)
   (merge-pathnames
    (or pathname (make-pathname :directory `(,relative ,@path)))
    (if type
@@ -874,10 +1092,15 @@ to `~a` which is not a directory.~@:>"
        filename))))
 
 (defmethod component-relative-pathname ((component source-file))
-  (merge-component-relative-pathname
-   (slot-value component 'relative-pathname)
-   (component-name component)
-   (source-file-type component (component-system component))))
+  ;; This binding of *default-pathname-defaults* is required notably because
+  ;; it will provide the default host to the above make-pathname, which may
+  ;; crucially matter to e.g. people somehow using logical-pathnames.
+  (let ((*default-pathname-defaults*
+         (component-pathname (component-parent component))))
+    (merge-component-relative-pathname
+     (slot-value component 'relative-pathname)
+     (component-name component)
+     (source-file-type component (component-system component)))))
 
 ;;;; -------------------------------------------------------------------------
 ;;;; Operations
@@ -885,7 +1108,11 @@ to `~a` which is not a directory.~@:>"
 ;;; one of these is instantiated whenever #'operate is called
 
 (defclass operation ()
-  ((forced :initform nil :initarg :force :accessor operation-forced)
+  (
+   ;; what is the TYPE of this slot?  seems like it should be boolean,
+   ;; but TRAVERSE checks to see if it's a list of component names...
+   ;; [2010/02/07:rpg]
+   (forced :initform nil :initarg :force :accessor operation-forced)
    (original-initargs :initform nil :initarg :original-initargs
                       :accessor operation-original-initargs)
    (visited-nodes :initform nil :accessor operation-visited-nodes)
@@ -900,7 +1127,7 @@ to `~a` which is not a directory.~@:>"
 (defmethod shared-initialize :after ((operation operation) slot-names
                                      &key force
                                      &allow-other-keys)
-  (declare (ignore slot-names force))
+  (declare (ignorable operation slot-names force))
   ;; empty method to disable initarg validity checking
   )
 
@@ -914,6 +1141,9 @@ to `~a` which is not a directory.~@:>"
 
 
 (defun make-sub-operation (c o dep-c dep-o)
+  "C is a component, O is an operation, DEP-C is another
+component, and DEP-O, confusingly enough, is an operation
+class specifier, not an operation."
   (let* ((args (copy-list (operation-original-initargs o)))
          (force-p (getf args :force)))
     ;; note explicit comparison with T: any other non-NIL force value
@@ -989,44 +1219,59 @@ to `~a` which is not a directory.~@:>"
 (defmethod input-files ((operation operation) (c module)) nil)
 
 (defmethod operation-done-p ((o operation) (c component))
-  (flet ((fwd-or-return-t (file)
-           (let ((date (safe-file-write-date file)))
-             (cond
-               (date)
-               (t
-                (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~
-                       operation ~S on component ~S as done.~@:>"
-                      file o c)
-                (return-from operation-done-p t))))))
-    (let ((out-files (output-files o c))
-          (in-files (input-files o c)))
-      (cond ((and (not in-files) (not out-files))
-             ;; arbitrary decision: an operation that uses nothing to
-             ;; produce nothing probably isn't doing much
-             t)
-            ((not out-files)
-             (let ((op-done
-                    (gethash (type-of o)
-                             (component-operation-times c))))
-               (and op-done
-                    (>= op-done
-                        (apply #'max
-                               (mapcar #'fwd-or-return-t in-files))))))
-            ((not in-files) nil)
-            (t
-             (and
-              (every #'probe-file out-files)
-              (> (apply #'min (mapcar #'safe-file-write-date out-files))
-                 (apply #'max (mapcar #'fwd-or-return-t in-files)))))))))
+  (let ((out-files (output-files o c))
+        (in-files (input-files o c))
+        (op-time (gethash (type-of o) (component-operation-times c))))
+    (flet ((earliest-out ()
+             (reduce #'min (mapcar #'safe-file-write-date out-files)))
+           (latest-in ()
+             (reduce #'max (mapcar #'safe-file-write-date in-files))))
+      (cond
+        ((and (not in-files) (not out-files))
+         ;; arbitrary decision: an operation that uses nothing to
+         ;; produce nothing probably isn't doing much.
+         ;; e.g. operations on systems, modules that have no immediate action,
+         ;; but are only meaningful through traversed dependencies
+         t)
+        ((not out-files)
+         ;; an operation without output-files is probably meant
+         ;; for its side-effects in the current image,
+         ;; assumed to be idem-potent,
+         ;; e.g. LOAD-OP or LOAD-SOURCE-OP of some CL-SOURCE-FILE.
+         (and op-time
+              (>= op-time (latest-in))))
+        ((not in-files)
+         ;; an operation without output-files and no input-files
+         ;; is probably meant for its side-effects on the file-system,
+         ;; assumed to have to be done everytime.
+         ;; (I don't think there is any such case in ASDF unless extended)
+         nil)
+        (t
+         ;; an operation with both input and output files is assumed
+         ;; as computing the latter from the former,
+         ;; assumed to have been done if the latter are all older
+         ;; than the former.
+         ;; e.g. COMPILE-OP of some CL-SOURCE-FILE.
+         (and
+          (every #'probe-file in-files)
+          (every #'probe-file out-files)
+          (and (> (earliest-out) (latest-in)))))))))
+
 
 ;;; So you look at this code and think "why isn't it a bunch of
 ;;; methods".  And the answer is, because standard method combination
 ;;; runs :before methods most->least-specific, which is back to front
 ;;; for our purposes.
 
+(defvar *forcing* nil
+  "This dynamically-bound variable is used to force operations in
+recursive calls to traverse.")
+
 (defmethod traverse ((operation operation) (c component))
-  (let ((forced nil))
+  (let ((forced nil))                   ;return value -- everyone side-effects onto this
     (labels ((%do-one-dep (required-op required-c required-v)
+               ;; returns a partial plan that results from performing required-op
+               ;; on required-c, possibly with a required-vERSION
                (let* ((dep-c (or (find-component
                                   (component-parent c)
                                   ;; XXX tacky.  really we should build the
@@ -1044,15 +1289,17 @@ to `~a` which is not a directory.~@:>"
                       (op (make-sub-operation c operation dep-c required-op)))
                  (traverse op dep-c)))
              (do-one-dep (required-op required-c required-v)
+               ;; this function is a thin, error-handling wrapper around
+               ;; %do-one-dep.  Returns a partial plan per that function.
                (loop
-                  (restart-case
-                      (return (%do-one-dep required-op required-c required-v))
-                    (retry ()
-                      :report (lambda (s)
-                                (format s "~@<Retry loading component ~S.~@:>"
-                                        required-c))
-                      :test
-                      (lambda (c)
+                 (restart-case
+                     (return (%do-one-dep required-op required-c required-v))
+                   (retry ()
+                     :report (lambda (s)
+                               (format s "~@<Retry loading component ~S.~@:>"
+                                       required-c))
+                     :test
+                     (lambda (c)
 #|
                         (print (list :c1 c (typep c 'missing-dependency)))
                         (when (typep c 'missing-dependency)
@@ -1060,10 +1307,17 @@ to `~a` which is not a directory.~@:>"
                                        (equalp (missing-requires c)
                                                required-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))))))))
              (do-dep (op dep)
+               ;; type of arguments uncertain:  op seems to at least potentially be a
+               ;; symbol, rather than an operation
+               ;; dep is either a list of component names (?) or (we hope) a single
+               ;; component name.
+               ;; handle a single dependency, returns nothing of interest --- side-
+               ;; effects onto the FORCED variable, which is scoped over TRAVERSE
                (cond ((eq op 'feature)
                       (or (member (car dep) *features*)
                           (error 'missing-dependency
@@ -1071,6 +1325,10 @@ to `~a` which is not a directory.~@:>"
                                  :requires (car dep))))
                      (t
                       (dolist (d dep)
+                        ;; structured dependencies --- this parses keywords
+                        ;; the keywords could be broken out and cleanly (extensibly)
+                        ;; processed by EQL methods, but for the pervasive side-effecting
+                        ;; onto FORCED
                         (cond ((consp d)
                                (cond ((string-equal
                                        (symbol-name (first d))
@@ -1078,6 +1336,9 @@ to `~a` which is not a directory.~@:>"
                                       (appendf
                                        forced
                                        (do-one-dep op (second d) (third d))))
+                                     ;; this particular subform is not documented, indeed
+                                     ;; clashes with the documentation, since it assumes a
+                                     ;; third component
                                      ((and (string-equal
                                             (symbol-name (first d))
                                             "FEATURE")
@@ -1087,7 +1348,7 @@ to `~a` which is not a directory.~@:>"
                                        forced
                                        (do-one-dep op (second d) (third d))))
                                      (t
-                                      (error "Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature>), or a name" d))))
+                                      (error "Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature> [version]), or a name" d))))
                               (t
                                (appendf forced (do-one-dep op d nil)))))))))
       (aif (component-visited-p operation c)
@@ -1098,49 +1359,76 @@ to `~a` which is not a directory.~@:>"
           (error 'circular-dependency :components (list c)))
       (setf (visiting-component operation c) t)
       (unwind-protect
-           (progn
-             (loop :for (required-op . deps) :in
-               (component-depends-on operation c)
-               :do (do-dep required-op deps))
-             ;; constituent bits
-             (let ((module-ops
-                    (when (typep c 'module)
-                      (let ((at-least-one nil)
-                            (forced nil)
-                            (error nil))
-                        (dolist (kid (module-components c))
-                          (handler-case
-                              (appendf forced (traverse operation kid))
-                            (missing-dependency (condition)
-                              (if (eq (module-if-component-dep-fails c)
-                                      :fail)
-                                  (error condition))
-                              (setf error condition))
-                            (:no-error (c)
-                              (declare (ignore c))
-                              (setf at-least-one t))))
-                        (when (and (eq (module-if-component-dep-fails c)
-                                       :try-next)
-                                   (not at-least-one))
-                          (error error))
-                        forced))))
-               ;; now the thing itself
-               (when (or forced module-ops
-                         (not (operation-done-p operation c))
-                         (let ((f (operation-forced
-                                   (operation-ancestor operation))))
-                           (and f (or (not (consp f))
-                                      (member (component-name
-                                               (operation-ancestor operation))
-                                              (mapcar #'coerce-name f)
-                                              :test #'string=)))))
-                 (let ((do-first (cdr (assoc (class-name (class-of operation))
-                                             (component-do-first c)))))
-                   (loop :for (required-op . deps) :in do-first
-                     :do (do-dep required-op deps)))
-                 (setf forced (append (delete 'pruned-op forced :key #'car)
-                                      (delete 'pruned-op module-ops :key #'car)
-                                      (list (cons operation c)))))))
+          (progn
+            ;; first we check and do all the dependencies for the
+            ;; module.  Operations planned in this loop will show up
+            ;; in the contents of the FORCED variable, and are consumed
+            ;; downstream (watch out for the shadowing FORCED variable
+            ;; around the DOLIST below!)
+            (let ((*forcing* nil))
+              ;; upstream dependencies are never forced to happen just because
+              ;; the things that depend on them are....
+              (loop :for (required-op . deps) :in
+                                              (component-depends-on operation c)
+                    :do (do-dep required-op deps)))
+            ;; constituent bits
+            (let ((module-ops
+                   (when (typep c 'module)
+                     (let ((at-least-one nil)
+                           (forced nil)
+                           ;; this is set based on the results of the
+                           ;; dependencies and whether we are in the
+                           ;; context of a *forcing* call...
+                           (must-operate (or *forcing*
+                                             ;; inter-system dependencies do NOT trigger
+                                             ;; building components
+                                             (and
+                                              (not (typep c 'system))
+                                              forced)))
+                           (error nil))
+                       (dolist (kid (module-components c))
+                           (handler-case
+                               (let ((*forcing* must-operate))
+                                 (appendf forced (traverse operation kid)))
+                             (missing-dependency (condition)
+                               (when (eq (module-if-component-dep-fails c)
+                                       :fail)
+                                   (error condition))
+                               (setf error condition))
+                             (:no-error (c)
+                               (declare (ignore c))
+                               (setf at-least-one t))))
+                       (when (and (eq (module-if-component-dep-fails c)
+                                      :try-next)
+                                  (not at-least-one))
+                         (error error))
+                       forced))))
+              ;; now the thing itself
+              ;; the test here is a bit oddly written.  FORCED here doesn't
+              ;; mean that this operation is forced on this component, but that
+              ;; something upstream of this component has been forced.
+              (when (or forced module-ops
+                        *forcing*
+                        (not (operation-done-p operation c))
+                        (let ((f (operation-forced
+                                  (operation-ancestor operation))))
+                          ;; does anyone fully understand the following condition?
+                          ;; if so, please add a comment to explain it...
+                          (and f (or (not (consp f))
+                                     (member (component-name
+                                              (operation-ancestor operation))
+                                             (mapcar #'coerce-name f)
+                                             ;; this was string=, but for the benefit
+                                             ;; of mlisp, we use string-equal for this
+                                             ;; purpose.
+                                             :test #'string-equal)))))
+                (let ((do-first (cdr (assoc (class-name (class-of operation))
+                                            (component-do-first c)))))
+                  (loop :for (required-op . deps) :in do-first
+                        :do (do-dep required-op deps)))
+                (setf forced (append (delete 'pruned-op forced :key #'car)
+                                     (delete 'pruned-op module-ops :key #'car)
+                                     (list (cons operation c)))))))
         (setf (visiting-component operation c) nil))
       (visit-component operation c (and forced t))
       forced)))
@@ -1167,11 +1455,20 @@ to `~a` which is not a directory.~@:>"
                 :initform *compile-file-warnings-behaviour*)
    (on-failure :initarg :on-failure :accessor operation-on-failure
                :initform *compile-file-failure-behaviour*)
-   (flags :initarg :system-p :accessor compile-op-flags :initform nil)))
+   (flags :initarg :flags :accessor compile-op-flags
+          :initform #-ecl nil #+ecl '(:system-p t))))
 
 (defmethod perform :before ((operation compile-op) (c source-file))
   (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* ((input (output-files o c))
+         (output (compile-file-pathname (first input) :type :fasl)))
+    (c:build-fasl output :lisp-files (remove "fas" input :key #'pathname-type :test #'string=))))
+
 (defmethod perform :after ((operation operation) (c component))
   (setf (gethash (type-of operation) (component-operation-times c))
         (get-universal-time)))
@@ -1203,7 +1500,10 @@ to `~a` which is not a directory.~@:>"
         (error 'compile-error :component c :operation operation)))))
 
 (defmethod output-files ((operation compile-op) (c cl-source-file))
-  #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c)))
+  #-:broken-fasl-loader
+  (list #-ecl (compile-file-pathname (component-pathname c))
+        #+ecl (compile-file-pathname (component-pathname c) :type :object)
+        #+ecl (compile-file-pathname (component-pathname c) :type :fasl))
   #+:broken-fasl-loader (list (component-pathname c)))
 
 (defmethod perform ((operation compile-op) (c static-file))
@@ -1224,7 +1524,11 @@ to `~a` which is not a directory.~@:>"
 (defclass load-op (basic-load-op) ())
 
 (defmethod perform ((o load-op) (c cl-source-file))
-  (mapcar #'load (input-files o c)))
+  #-ecl (mapcar #'load (input-files o c))
+  #+ecl (loop :for i :in (input-files o c)
+          :unless (string= (pathname-type i) "fas")
+          :collect (let ((output (compile-file-pathname i)))
+                     (load output))))
 
 (defmethod perform around ((o load-op) (c cl-source-file))
   (let ((state :initial))
@@ -1398,18 +1702,24 @@ created with the same initargs as the original one.
   (setf (documentation 'operate 'function)
         operate-docstring))
 
-(defun load-system (system &rest args &key force (verbose t) version)
-  "Shorthand for `(operate 'asdf:load-op system)`. See [operate][] for details."
+(defun load-system (system &rest args &key force (verbose t) version
+                    &allow-other-keys)
+  "Shorthand for `(operate 'asdf:load-op system)`. See [operate][] for
+details."
   (declare (ignore force verbose version))
   (apply #'operate 'load-op system args))
 
-(defun compile-system (system &rest args &key force (verbose t) version)
-  "Shorthand for `(operate 'asdf:compile-op system)`. See [operate][] for details."
+(defun compile-system (system &rest args &key force (verbose t) version
+                       &allow-other-keys)
+  "Shorthand for `(operate 'asdf:compile-op system)`. See [operate][]
+for details."
   (declare (ignore force verbose version))
   (apply #'operate 'compile-op system args))
 
-(defun test-system (system &rest args &key force (verbose t) version)
-  "Shorthand for `(operate 'asdf:test-op system)`. See [operate][] for details."
+(defun test-system (system &rest args &key force (verbose t) version
+                    &allow-other-keys)
+  "Shorthand for `(operate 'asdf:test-op system)`. See [operate][] for
+details."
   (declare (ignore force verbose version))
   (apply #'operate 'test-op system args))
 
@@ -1429,7 +1739,7 @@ created with the same initargs as the original one.
   ;; implementations, the latter has *already resolved it.
   (or (and pathname-supplied-p pathname)
       (when *load-pathname*
-        (pathname-sans-name+type
+        (pathname-directory-pathname
          (if *resolve-symlinks*
              (resolve-symlinks *load-truename*)
              *load-pathname*)))
@@ -1717,255 +2027,457 @@ output to `*verbose-out*`.  Returns the shell's exit code."
                  :type nil
                  :defaults (system-source-file system-name)))
 
+(defun relativize-directory (directory)
+  (if (eq (car directory) :absolute)
+      (cons :relative (cdr directory))
+      directory))
+
+(defun relativize-pathname-directory (pathspec)
+  (let ((p (pathname pathspec)))
+    (make-pathname
+     :directory (relativize-directory (pathname-directory p))
+     :defaults p)))
+
 (defun system-relative-pathname (system pathname &key name type)
   (let ((directory (pathname-directory pathname)))
     (merge-pathnames
      (make-pathname :name (or name (pathname-name pathname))
                     :type (or type (pathname-type pathname))
-                    :directory (if (eq (car directory) :absolute)
-                                   (cons :relative (cdr directory))
-                                   directory))
+                    :directory (relativize-directory directory))
      (system-source-directory system))))
 
+
 ;;; ---------------------------------------------------------------------------
-;;; asdf-binary-locations
+;;; implementation-identifier
 ;;;
-;;; this bit of code was stolen from Bjorn Lindberg and then it grew!
-;;; see http://www.cliki.net/asdf%20binary%20locations
-;;; and http://groups.google.com/group/comp.lang.lisp/msg/bd5ea9d2008ab9fd
-;;; ---------------------------------------------------------------------------
-;;; Portions of this code were once from SWANK / SLIME
-
-(defparameter *centralize-lisp-binaries* nil
-  "If true, compiled lisp files without an explicit mapping (see
-\\*source-to-target-mappings\\*) will be placed in subdirectories of
-\\*default-toplevel-directory\\*. If false, then compiled lisp files
-without an explicitly mapping will be placed in subdirectories of
-their sources.")
-
-(defparameter *enable-asdf-binary-locations* nil
-  "
-If true, then compiled lisp files will be placed into a directory
-computed from the Lisp version, Operating System and computer archetecture.
-See [implementation-specific-directory-name][] for details.")
-
-
-(defparameter *default-toplevel-directory*
-  (merge-pathnames
-   (make-pathname :directory '(:relative ".cache" "common-lisp"))
-   (truename (user-homedir-pathname)))
-  "If \\*centralize-lisp-binaries\\* is true, then compiled lisp files without an explicit mapping \(see \\*source-to-target-mappings\\*\) will be placed in subdirectories of \\*default-toplevel-directory\\*.")
-
-(defparameter *include-per-user-information*
-  nil
-  "When \\*centralize-lisp-binaries\\* is true this variable controls whether or not to customize the output directory based on the current user. It can be nil, t or a string. If it is nil \(the default\), then no additional information will be added to the output directory. If it is t, then the user's name \(as taken from the return value of #'user-homedir-pathname\) will be included into the centralized path (just before the lisp-implementation directory). Finally, if \\*include-per-user-information\\* is a string, then this string will be included in the output-directory.")
-
-(defparameter *map-all-source-files*
-  nil
-  "If true, then all subclasses of source-file will have their output locations mapped by ASDF-Binary-Locations. If nil (the default), then only subclasses of cl-source-file will be mapped.")
-
-(defvar *source-to-target-mappings*
-  #-sbcl
-  nil
-  #+sbcl
-  (list (list (princ-to-string (getenv "SBCL_HOME")) nil))
-  "The \\*source-to-target-mappings\\* variable specifies mappings from source to target. If the target is nil, then it means to not map the source to anything. I.e., to leave it as is. This has the effect of turning off ASDF-Binary-Locations for the given source directory. Examples:
-
-    ;; compile everything in .../src and below into .../cmucl
-    '((\"/nfs/home/compbio/d95-bli/share/common-lisp/src/\"
-       \"/nfs/home/compbio/d95-bli/lib/common-lisp/cmucl/\"))
-
-    ;; leave SBCL innards alone (SBCL specific)
-    (list (list (princ-to-string (sb-ext:posix-getenv \"SBCL_HOME\")) nil))
-")
+;;; produce a string to identify current implementation.
+;;; Initially stolen from SLIME's SWANK, hacked since.
 
 (defparameter *implementation-features*
-  '(:allegro :lispworks :sbcl :ccl :openmcl :cmu :clisp
+  '(:allegro :lispworks :sbcl :clozure :digitool :cmu :clisp
     :corman :cormanlisp :armedbear :gcl :ecl :scl))
 
 (defparameter *os-features*
-  '(:windows :mswindows :win32 :mingw32
-    :solaris :sunos
+  '((:windows :mswindows :win32 :mingw32)
+    (:solaris :sunos)
     :macosx :darwin :apple
     :freebsd :netbsd :openbsd :bsd
     :linux :unix))
 
 (defparameter *architecture-features*
-  '(:amd64 (:x86-64 :x86_64 :x8664-target) :i686 :i586 :pentium3
-    :i486 (:i386 :pc386 :iapx386) (:x86 :x8632-target) :pentium4
-    :hppa64 :hppa :ppc64 :ppc32 :powerpc :ppc :sparc64 :sparc))
+  '((:x86-64 :amd64 :x86_64 :x8664-target)
+    (:x86 :i686 :i586 :pentium3 :i486 :i386 :pc386 :iapx386 :x8632-target :pentium4)
+    :hppa64 :hppa :ppc64 (:ppc32 :ppc :powerpc) :sparc64 :sparc))
 
-;; note to gwking: this is in slime, system-check, and system-check-server too
 (defun lisp-version-string ()
-  #+cmu       (substitute #\- #\/
-                          (substitute #\_ #\Space
-                                      (lisp-implementation-version)))
-  #+scl       (lisp-implementation-version)
-  #+sbcl      (lisp-implementation-version)
-  #+ecl       (reduce (lambda (x str) (substitute #\_ str x))
-                      '(#\Space #\: #\( #\))
-                      :initial-value (lisp-implementation-version))
-  #+gcl       (let ((s (lisp-implementation-version))) (subseq s 4))
-  #+openmcl   (format nil "~d.~d~@[-~d~]"
+  (let ((s (lisp-implementation-version)))
+    (declare (ignorable s))
+    #+(or scl sbcl ecl armedbear cormanlisp mcl) s
+    #+cmu (substitute #\- #\/ s)
+    #+clozure (format nil "~d.~d~@[-~d~]"
                       ccl::*openmcl-major-version*
                       ccl::*openmcl-minor-version*
                       #+ppc64-target 64
                       #-ppc64-target nil)
-  #+lispworks (format nil "~A~@[~A~]"
-                      (lisp-implementation-version)
-                      (when (member :lispworks-64bit *features*) "-64bit"))
-  #+allegro   (format nil
+    #+lispworks (format nil "~A~@[~A~]" s
+                        (when (member :lispworks-64bit *features*) "-64bit"))
+    #+allegro (format nil
                       "~A~A~A~A"
                       excl::*common-lisp-version-number*
-                                        ; ANSI vs MoDeRn
-                      ;; thanks to Robert Goldman and Charley Cox for
-                      ;; an improvement to my hack
+                      ;; ANSI vs MoDeRn - thanks to Robert Goldman and Charley Cox
                       (if (eq excl:*current-case-mode*
                               :case-sensitive-lower) "M" "A")
                       ;; Note if not using International ACL
                       ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm
                       (excl:ics-target-case
-                        (:-ics "8")
-                        (:+ics ""))
+                       (:-ics "8")
+                       (:+ics ""))
                       (if (member :64bit *features*) "-64bit" ""))
-  #+clisp     (let ((s (lisp-implementation-version)))
-                (subseq s 0 (position #\space s)))
-  #+armedbear (lisp-implementation-version)
-  #+cormanlisp (lisp-implementation-version)
-  #+digitool   (subseq (lisp-implementation-version) 8))
-
-
-(defparameter *implementation-specific-directory-name* nil)
-
-(defun implementation-specific-directory-name ()
-  "Return a name that can be used as a directory name that is
-unique to a Lisp implementation, Lisp implementation version,
-operating system, and hardware architecture."
-  (and *enable-asdf-binary-locations*
-       (list
-        (or *implementation-specific-directory-name*
-            (setf *implementation-specific-directory-name*
-                  (labels
-                      ((fp (thing)
-                         (etypecase thing
-                           (symbol
-                            (let ((feature (find thing *features*)))
-                              (when feature (return-from fp feature))))
-                           ;; allows features to be lists of which the first
-                           ;; member is the "main name", the rest being aliases
-                           (cons
-                            (dolist (subf thing)
-                              (let ((feature (find subf *features*)))
-                                (when feature (return-from fp (first thing))))))))
-                       (first-of (features)
-                         (loop :for f :in features
-                           :when (fp f) :return :it))
-                       (maybe-warn (value fstring &rest args)
-                         (cond (value)
-                               (t (apply #'warn fstring args)
-                                  "unknown"))))
-                    (let ((lisp (maybe-warn (first-of *implementation-features*)
-                                            "No implementation feature found in ~a."
-                                            *implementation-features*))
-                          (os   (maybe-warn (first-of *os-features*)
-                                            "No os feature found in ~a." *os-features*))
-                          (arch (maybe-warn (first-of *architecture-features*)
-                                            "No architecture feature found in ~a."
-                                            *architecture-features*))
-                          (version (maybe-warn (lisp-version-string)
-                                               "Don't know how to get Lisp ~
+    #+(or clisp gcl) (subseq s 0 (position #\space s))
+    #+digitool (subseq s 8)))
+
+(defun first-feature (features)
+  (labels
+      ((fp (thing)
+         (etypecase thing
+           (symbol
+            (let ((feature (find thing *features*)))
+              (when feature (return-from fp feature))))
+           ;; allows features to be lists of which the first
+           ;; member is the "main name", the rest being aliases
+           (cons
+            (dolist (subf thing)
+              (when (find subf *features*) (return-from fp (first thing))))))
+         nil))
+    (loop :for f :in features
+      :when (fp f) :return :it)))
+
+(defun implementation-type ()
+  (first-feature *implementation-features*))
+
+(defun implementation-identifier ()
+  (labels
+      ((maybe-warn (value fstring &rest args)
+         (cond (value)
+               (t (apply #'warn fstring args)
+                  "unknown"))))
+    (let ((lisp (maybe-warn (implementation-type)
+                            "No implementation feature found in ~a."
+                            *implementation-features*))
+          (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*))
+          (version (maybe-warn (lisp-version-string)
+                               "Don't know how to get Lisp ~
                                           implementation version.")))
-                      (format nil "~(~@{~a~^-~}~)" lisp version os arch))))))))
-
-(defun pathname-prefix-p (prefix pathname)
-  (let ((prefix-ns (namestring prefix))
-        (pathname-ns (namestring pathname)))
-    (= (length prefix-ns)
-       (mismatch prefix-ns pathname-ns))))
-
-(defgeneric output-files-for-system-and-operation
-  (system operation component source possible-paths)
-  (:documentation "Returns the directory where the componets output files should be placed. This may depends on the system, the operation and the component. The ASDF default input and outputs are provided in the source and possible-paths parameters."))
-
-(defun source-to-target-resolved-mappings ()
-  "Answer `*source-to-target-mappings*` with additional entries made
-by resolving sources that are symlinks.
-
-As ASDF sometimes resolves symlinks to compute source paths, we must
-follow that.  For example, if SBCL is installed under a symlink, and
-SBCL_HOME is set through that symlink, the default rule above
-preventing SBCL contribs from being mapped elsewhere will not be
-applied by the plain `*source-to-target-mappings*`."
-  (loop :for mapping :in asdf:*source-to-target-mappings*
-    :for (source target) = mapping
-    :for true-source = (and source (resolve-symlinks source))
-    :if (equal source true-source) :collect mapping
-    :else :append (list mapping (list true-source target))))
-
-(defmethod output-files-for-system-and-operation
-           ((system system) operation component source possible-paths)
-  (declare (ignore operation component))
-  (output-files-using-mappings
-   source possible-paths (source-to-target-resolved-mappings)))
-
-(defmethod output-files-using-mappings (source possible-paths path-mappings)
-  (mapcar
-   (lambda (path)
-     (loop :for (from to) :in path-mappings
-       :when (pathname-prefix-p from source)
-       :return
-       (if to
-           (merge-pathnames
-            (make-pathname :type (pathname-type path))
-            (merge-pathnames (enough-namestring source from)
-                             to))
-           path)
-       :finally
-       (return
-         ;; Instead of just returning the path when we
-         ;; don't find a mapping, we stick stuff into
-         ;; the appropriate binary directory based on
-         ;; the implementation
-         (if *centralize-lisp-binaries*
-             (merge-pathnames
-              (make-pathname
-               :type (pathname-type path)
-               :directory `(:relative
-                            ,@(cond ((eq *include-per-user-information* t)
-                                     (cdr (pathname-directory
-                                           (user-homedir-pathname))))
-                                    ((not (null *include-per-user-information*))
-                                     (list *include-per-user-information*)))
-                            ,@(implementation-specific-directory-name)
-                            ,@(rest (pathname-directory path)))
-               :defaults path)
-              *default-toplevel-directory*)
-             (make-pathname
-              :type (pathname-type path)
-              :directory (append
-                          (pathname-directory path)
-                          (implementation-specific-directory-name))
-              :defaults path)))))
-   possible-paths))
-
-(defmethod output-files
-    :around ((operation compile-op) (component source-file))
-  (if (or *map-all-source-files*
-            (typecase component
-              (cl-source-file t)
-              (t nil)))
-    (let ((source (component-pathname component))
-          (paths (call-next-method)))
-      (output-files-for-system-and-operation
-       (component-system component) operation component source paths))
-    (call-next-method)))
+      (substitute-if
+       #\_ (lambda (x) (find x " /:\\(){}[]$#`'\""))
+       (format nil "~(~@{~a~^-~}~)" lisp version os arch)))))
+
+
+
+;;; ---------------------------------------------------------------------------
+;;; Generic support for configuration files
+(defun user-configuration-directory ()
+  (merge-pathnames #p".config/" (user-homedir-pathname)))
+(defun system-configuration-directory ()
+  #p"/etc/")
+
+(defun configuration-inheritance-directive-p (x)
+  (let ((kw '(:inherit-configuration :ignore-inherited-configuration)))
+    (or (member x kw)
+        (and (length=n-p x 1) (member (car x) kw)))))
+
+(defun validate-configuration-form (form tag directive-validator
+                                    &optional (description tag))
+  (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))
+    :finally
+    (unless (= inherit 1)
+      (error "One and only one of ~S or ~S is required"
+             :inherit-configuration :ignore-inherited-configuration)))
+  form)
+
+(defun validate-configuration-file (file validator 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))))
+
+(defun validate-configuration-directory (directory tag validator)
+  (let ((files (sort (ignore-errors
+                       (directory (merge-pathnames
+                                   (make-pathname :name :wild :type :wild)
+                                   directory)
+                                  #+sbcl :resolve-symlinks #+sbcl nil))
+                     #'string< :key #'namestring)))
+    `(,tag
+      ,@(loop :for file :in files :append
+          (mapcar validator (read-file-forms file)))
+      :inherit-configuration)))
+
+
+;;; ---------------------------------------------------------------------------
+;;; asdf-output-translations
+;;;
+;;; this code is heavily inspired from
+;;; asdf-binary-translations, common-lisp-controller and cl-launch.
+;;; ---------------------------------------------------------------------------
+
+(defvar *output-translations* ()
+  "Either NIL (for uninitialized), or a list of one element,
+said element itself being a sorted list of mappings.
+Each mapping is a pair of a source pathname and destination pathname,
+and the order is by decreasing length of namestring of the source pathname.")
+
+(defvar *user-cache* '(:home ".cache" "common-lisp" :implementation))
+(defvar *system-cache* '(:root "var" "cache" "common-lisp" :uid :implementation))
+
+(defun output-translations ()
+  (car *output-translations*))
+
+(defun (setf output-translations) (x)
+  (setf *output-translations*
+        (list
+         (stable-sort (copy-list x) #'>
+                      :key (lambda (x) (length (pathname-directory (car x))))))))
+
+(defun output-translations-initialized-p ()
+  (and *output-translations* t))
+
+(defun clear-output-translations ()
+  "Undoes any initialization of the output translations.
+You might want to call that before you dump an image that would be resumed
+with a different configuration, so the configuration would be re-read then."
+  (setf *output-translations* '())
+  (values))
+
+(defparameter *wild-path*
+  (make-pathname :directory '(:relative :wild-inferiors)
+                 :name :wild :type :wild :version nil))
+
+(defun wilden (path)
+  (merge-pathnames *wild-path* path))
+
+(defun resolve-absolute-location-component (x wildenp)
+  (let* ((r
+          (etypecase x
+            (pathname x)
+            (string (ensure-directory-pathname x))
+            ((eql :home) (user-homedir-pathname))
+            ((eql :user-cache) (resolve-location *user-cache* nil))
+            ((eql :system-cache) (resolve-location *system-cache* nil))
+            ((eql :current-directory) (truenamize *default-pathname-defaults*))
+            ((eql :root) (make-pathname :directory '(:absolute)))))
+         (s (if (and wildenp (not (pathnamep x)))
+                (wilden r)
+                r)))
+    (unless (absolute-pathname-p s)
+      (error "Not an absolute pathname ~S" s))
+    s))
+
+(defun resolve-relative-location-component (super x &optional wildenp)
+  (let* ((r (etypecase x
+              (pathname x)
+              (string x)
+              ((eql :current-directory)
+               (relativize-pathname-directory
+                (truenamize *default-pathname-defaults*)))
+              ((eql :implementation) (implementation-identifier))
+              ((eql :implementation-type) (implementation-type))
+              ((eql :uid) (princ-to-string (get-uid)))))
+         (d (if (pathnamep x) r (ensure-directory-pathname r)))
+         (s (if (and wildenp (not (pathnamep x)))
+                (wilden d)
+                d)))
+    (when (and (absolute-pathname-p s) (not (pathname-match-p s (wilden super))))
+      (error "pathname ~S is not relative to ~S" s super))
+    (merge-pathnames s super)))
+
+(defun resolve-location (x &optional wildenp)
+  (if (atom x)
+      (resolve-absolute-location-component x wildenp)
+      (loop :with path = (resolve-absolute-location-component (car x) nil)
+        :for (component . morep) :on (cdr x)
+        :do (setf path (resolve-relative-location-component
+                        path component (and wildenp (not morep))))
+        :finally (return path))))
+
+(defun location-designator-p (x)
+  (flet ((componentp (c) (typep c '(or string pathname keyword))))
+    (or (componentp x) (and (consp x) (every #'componentp x)))))
+
+(defun validate-output-translations-directive (directive)
+  (unless
+      (or (member directive '(:inherit-configuration
+                              :ignore-inherited-configuration
+                              :enable-user-cache :disable-cache))
+          (and (consp directive)
+               (or (and (length=n-p directive 2)
+                        (or (and (eq (first directive) :include)
+                                 (typep (second directive) '(or string pathname)))
+                            (and (location-designator-p (first directive))
+                                 (or (location-designator-p (second directive))
+                                     (null (second directive))))))
+                   (and (length=n-p directive 1)
+                        (location-designator-p (first directive))))))
+    (error "Invalid directive ~S~%" directive))
+  directive)
+
+(defun validate-output-translations-form (form)
+  (validate-configuration-form
+   form
+   :output-translations
+   'validate-output-translations-directive
+   "output translations"))
+
+(defun validate-output-translations-file (file)
+  (validate-configuration-file
+   file 'validate-output-translations-form "output translations"))
+
+(defun validate-output-translations-directory (directory)
+  (validate-configuration-directory
+   directory :output-translations 'validate-output-translations-directive))
+
+(defun parse-output-translations-string (string)
+  (cond
+    ((or (null string) (equal string ""))
+     '(:output-translations :inherit-configuration))
+    ((not (stringp string))
+     (error "environment string isn't: ~S" string))
+    ((find (char string 0) "\"(")
+     (validate-output-translations-form (read-from-string string)))
+    (t
+     (loop
+      :with inherit = nil
+      :with directives = ()
+      :with start = 0
+      :with end = (length string)
+      :with source = nil
+      :for i = (or (position #\: string :start start) end) :do
+      (let ((s (subseq string start i)))
+        (cond
+          (source
+           (push (list source (if (equal "" s) nil s)) directives)
+           (setf source nil))
+          ((equal "" s)
+           (when inherit
+             (error "only one inherited configuration allowed: ~S" string))
+           (setf inherit t)
+           (push :inherit-configuration directives))
+          (t
+           (setf source s)))
+        (setf start (1+ i))
+        (when (>= start end)
+          (when source
+            (error "Uneven number of components in source to destination mapping ~S" string))
+          (unless inherit
+            (push :ignore-inherited-configuration directives))
+          (return `(:output-translations ,@(nreverse directives)))))))))
+
+(defparameter *default-output-translations*
+  '(implementation-output-translations
+    user-output-translations-pathname
+    user-output-translations-directory-pathname
+    system-output-translations-pathname
+    system-output-translations-directory-pathname))
+
+(defparameter *implementation-output-translations*
+  `(:output-translations
+   ;; If clozure had any precompiled ASDF system, we'd use that:
+   ; #+clozure (,(ccl::ccl-directory) ())
+   ;; SBCL *does* have precompiled ASDF system, so we use this:
+   #+sbcl (,(getenv "SBCL_HOME") ())
+   ;; All-import, here is where we want user stuff to be:
+   :inherit-configuration
+   ;; If we want to enable the user cache by default, here would be the place:
+   :enable-user-cache
+   ))
+
+(defun implementation-output-translations ()
+  *implementation-output-translations*)
+
+(defparameter *output-translations-file* #p"common-lisp/asdf-output-translations.conf")
+(defparameter *output-translations-directory* #p"common-lisp/asdf-output-translations.conf.d/")
+
+(defun user-output-translations-pathname ()
+  (merge-pathnames *output-translations-file* (user-configuration-directory)))
+(defun system-output-translations-pathname ()
+  (merge-pathnames *output-translations-file* (system-configuration-directory)))
+(defun user-output-translations-directory-pathname ()
+  (merge-pathnames *output-translations-directory* (user-configuration-directory)))
+(defun system-output-translations-directory-pathname ()
+  (merge-pathnames *output-translations-directory* (system-configuration-directory)))
+(defun environment-output-translations ()
+  (getenv "ASDF_OUTPUT_TRANSLATIONS"))
+
+(defgeneric process-output-translations (spec &key inherit collect))
+(defmethod process-output-translations ((x symbol) &key
+                                        (inherit *default-output-translations*)
+                                        collect)
+  (process-output-translations (funcall x) :inherit inherit :collect collect))
+(defmethod process-output-translations ((pathname pathname) &key
+                                        (inherit *default-output-translations*)
+                                        collect)
+  (cond
+    ((directory-pathname-p pathname)
+     (process-output-translations (validate-output-translations-directory pathname)
+                                  :inherit inherit :collect collect))
+    ((probe-file pathname)
+     (process-output-translations (validate-output-translations-file pathname)
+                                  :inherit inherit :collect collect))
+    (t
+     (inherit-output-translations inherit :collect collect))))
+(defmethod process-output-translations ((string string) &key
+                                        (inherit *default-output-translations*)
+                                        collect)
+  (process-output-translations (parse-output-translations-string string)
+                               :inherit inherit :collect collect))
+(defmethod process-output-translations ((x null) &key
+                                    (inherit *default-output-translations*)
+                                    collect)
+  (declare (ignorable x))
+  (inherit-output-translations inherit :collect collect))
+(defmethod process-output-translations ((form cons) &key
+                                        (inherit *default-output-translations*)
+                                        collect)
+  (multiple-value-bind (collect result)
+      (if collect
+          (values collect (constantly nil))
+          (make-collector))
+    (dolist (directive (cdr (validate-output-translations-form form)))
+      (process-output-translations-directive directive :inherit inherit :collect collect))
+    (funcall result)))
+
+(defun inherit-output-translations (inherit &key collect)
+  (when inherit
+    (process-output-translations (first inherit) :collect collect :inherit (rest inherit))))
+
+(defun process-output-translations-directive (directive &key inherit collect)
+  (if (atom directive)
+      (ecase directive
+        ((:enable-user-cache)
+         (process-output-translations-directive '(:root :user-cache) :collect collect))
+        ((:disable-cache)
+         (process-output-translations-directive '(:root :root) :collect collect))
+        ((:inherit-configuration)
+         (inherit-output-translations inherit :collect collect))
+        ((:ignore-inherited-configuration)
+         nil))
+      (let ((src (first directive))
+            (dst (second directive)))
+        (if (eq src :include)
+            (process-output-translations (pathname dst) :inherit nil :collect collect)
+            (let* ((trusrc (truenamize (resolve-location src t)))
+                   (trudst (if dst (resolve-location dst t) trusrc)))
+              (funcall collect (list trusrc trudst)))))))
+
+;; Will read the configuration and initialize all internal variables,
+;; and return the new configuration.
+(defun initialize-output-translations
+    (&optional (translations *default-output-translations*))
+  (setf (output-translations)
+        (inherit-output-translations translations)))
+
+;; checks an initial variable to see whether the state is initialized
+;; or cleared. In the former case, return current configuration; in
+;; the latter, initialize.  ASDF will call this function at the start
+;; of (asdf:find-system).
+(defun ensure-output-translations ()
+  (if (output-translations-initialized-p)
+      (output-translations)
+      (initialize-output-translations)))
+
+(defun apply-output-translations (path)
+  (ensure-output-translations)
+  (setf path (truenamize path))
+  (loop :for (source destination) :in (car *output-translations*)
+    :when (pathname-match-p path source)
+    :return (translate-pathname path source destination)
+    :finally (return path)))
+
+(defmethod output-files :around ((op operation) (c component))
+  "Method to rewrite output files to fasl-root"
+  (mapcar #'apply-output-translations (call-next-method)))
+
+(defun compile-file-pathname* (input-file &rest keys)
+  (apply-output-translations
+   (apply #'compile-file-pathname
+          (truenamize (merge-pathnames (make-pathname :type "lisp") input-file))
+          keys)))
 
 ;;;; -----------------------------------------------------------------
 ;;;; Windows shortcut support.  Based on:
 ;;;;
 ;;;; Jesse Hager: The Windows Shortcut File Format.
 ;;;; http://www.wotsit.org/list.asp?fc=13
-;;;; -----------------------------------------------------------------
 
 (defparameter *link-initial-dword* 76)
 (defparameter *link-guid* #(1 20 2 0 0 0 0 0 192 0 0 0 0 0 0 70))
@@ -2094,68 +2606,39 @@ with a different configuration, so the configuration would be re-read then."
                          (when target
                            (return (pathname target))))))))))))))
 
-(defun read-file-forms (file)
-  (with-open-file (in file)
-    (loop :with eof = (list nil)
-     :for form = (read in nil eof)
-     :until (eq form eof)
-     :collect form)))
-
 (defun validate-source-registry-directive (directive)
   (unless
-   (destructuring-bind (kw &rest rest) directive
-     (case kw
-       ((:include :directory :tree)
-        (and (length=n-p rest 1)
-             (typep (car rest) '(or pathname string))))
-       ((:exclude)
-        (every #'stringp rest))
-       ((:default-registry :inherit-configuration :ignore-inherited-configuration)
-        (null rest))))
-   (error "Invalid directive ~S~%" directive))
+      (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)
+                    (typep (car rest) '(or pathname string))))
+              ((:exclude)
+               (every #'stringp rest))
+              (null rest))))
+    (error "Invalid directive ~S~%" directive))
   directive)
 
 (defun validate-source-registry-form (form)
-  (unless (and (consp form) (eq (car form) :source-registry))
-    (error "Error: Form is not a source registry ~S~%" form))
-  (loop :with inherit = 0
-        :for directive :in (cdr form) :do
-        (unless (consp directive)
-          (error "invalid directive ~S" directive))
-        (when (member (car directive)
-                      '(:inherit-configuration :ignore-inherited-configuration))
-          (incf inherit))
-        (validate-source-registry-directive directive)
-        :finally
-        (unless (= inherit 1)
-          (error "One and only one of :inherit-configuration or :ignore-inherited-configuration is required")))
-  form)
+  (validate-configuration-form
+   form :source-registry 'validate-source-registry-directive "a source registry"))
 
 (defun validate-source-registry-file (file)
-  (let ((forms (read-file-forms file)))
-    (unless (length=n-p forms 1)
-      (error "One and only one form allowed for source registry. Got: ~S~%" forms))
-    (validate-source-registry-form (car forms))))
+  (validate-configuration-file
+   file 'validate-source-registry-form "a source registry"))
 
 (defun validate-source-registry-directory (directory)
-  (let ((files (sort (ignore-errors
-                       (directory (merge-pathnames
-                                   (make-pathname :name :wild :type :wild)
-                                   directory)
-                                  #+sbcl :resolve-symlinks #+sbcl nil))
-                     #'string< :key #'namestring)))
-    `(:source-registry
-      ,@(loop :for file :in files :append
-          (mapcar #'validate-source-registry-directive (read-file-forms file)))
-      (:inherit-configuration))))
+  (validate-configuration-directory
+   directory :source-registry 'validate-source-registry-directive))
 
 (defun parse-source-registry-string (string)
   (cond
     ((or (null string) (equal string ""))
-     '(:source-registry (:inherit-configuration)))
+     '(:source-registry :inherit-configuration))
     ((not (stringp string))
      (error "environment string isn't: ~S" string))
-    ((eql (char string 0) #\()
+    ((eql (char string 0) "\"(")
      (validate-source-registry-form (read-from-string string)))
     (t
      (loop
@@ -2170,7 +2653,7 @@ with a different configuration, so the configuration would be re-read then."
           (when inherit
             (error "only one inherited configuration allowed: ~S" string))
           (setf inherit t)
-          (push '(:inherit-configuration) directives))
+          (push ':inherit-configuration directives))
          ((ends-with s "//")
           (push `(:tree ,(subseq s 0 (1- (length s)))) directives))
          (t
@@ -2181,132 +2664,108 @@ with a different configuration, so the configuration would be re-read then."
              (push '(:ignore-inherited-configuration) directives))
            (return `(:source-registry ,@(nreverse directives)))))))))
 
-(defun collect-asd-subdirectories (directory &key (exclude *default-exclusions*) collect)
-  (let* ((files (ignore-errors
-                  (directory (merge-pathnames #P"**/*.asd" directory)
-                             #+sbcl #+sbcl :resolve-symlinks nil
-                             #+clisp #+clisp :circle t)))
-         (dirs (remove-duplicates (mapcar #'pathname-sans-name+type files) :test #'equal)))
-    (loop
-     :for dir :in dirs
-     :unless (loop :for x :in exclude
-                   :thereis (find x (pathname-directory dir) :test #'equal))
-     :do (funcall collect dir))))
+(defun register-asd-directory (directory &key recurse exclude collect)
+  (if (not recurse)
+      (funcall collect (ensure-directory-pathname directory))
+      (let* ((files (ignore-errors
+                      (directory (merge-pathnames #P"**/*.asd" directory)
+                                 #+sbcl #+sbcl :resolve-symlinks nil
+                                 #+clisp #+clisp :circle t)))
+             (dirs (remove-duplicates (mapcar #'pathname-directory-pathname files)
+                                      :test #'equal)))
+        (loop
+          :for dir :in dirs
+          :unless (loop :for x :in exclude
+                    :thereis (find x (pathname-directory dir) :test #'equal))
+          :do (funcall collect dir)))))
 
 (defparameter *default-source-registries*
-  '(process-environment-source-registry
-    process-user-source-registry
-    process-user-source-registry-directory
-    process-system-source-registry
-    process-system-source-registry-directory
-    process-default-source-registry))
-
-(defun user-configuration-pathname ()
-  (merge-pathnames ".config/" (user-homedir-pathname)))
-(defun system-configuration-pathname ()
-  #p"/etc/")
-(defun source-registry-under (directory)
-  (merge-pathnames "common-lisp/source-registry.conf" directory))
-(defun user-source-registry-pathname ()
-  (source-registry-under (user-configuration-pathname)))
-(defun system-source-registry-pathname ()
-  (source-registry-under (system-configuration-pathname)))
-(defun source-registry-directory-under (directory)
-  (merge-pathnames "common-lisp/source-registry.conf.d/" directory))
-(defun user-source-registry-directory-pathname ()
-  (source-registry-directory-under (user-configuration-pathname)))
-(defun system-source-registry-directory-pathname ()
-  (source-registry-directory-under (system-configuration-pathname)))
-
-(defun process-environment-source-registry (&key inherit collect)
-  (process-source-registry (getenv "CL_SOURCE_REGISTRY")
-                           :inherit inherit :collect collect))
-(defun process-user-source-registry (&key inherit collect)
-  (process-source-registry (user-source-registry-pathname)
-                           :inherit inherit :collect collect))
-(defun process-user-source-registry-directory (&key inherit collect)
-  (process-source-registry (user-source-registry-directory-pathname)
-                           :inherit inherit :collect collect))
-(defun process-system-source-registry (&key inherit collect)
-  (process-source-registry (system-source-registry-pathname)
-                           :inherit inherit :collect collect))
-(defun process-system-source-registry-directory (&key inherit collect)
-  (process-source-registry (system-source-registry-directory-pathname)
-                           :inherit inherit :collect collect))
-(defun process-default-source-registry (&key inherit collect)
-  (declare (ignore inherit collect))
-  nil)
-
-(defgeneric process-source-registry (spec &key inherit collect))
-(defmethod process-source-registry ((pathname pathname) &key
-                                    (inherit *default-source-registries*)
-                                    collect)
+  '(environment-source-registry
+    user-source-registry
+    user-source-registry-directory
+    system-source-registry
+    system-source-registry-directory))
+
+(defparameter *source-registry-file* #p"common-lisp/source-registry.conf")
+(defparameter *source-registry-directory* #p"common-lisp/source-registry.conf.d/")
+
+(defun user-source-registry ()
+  (merge-pathnames *source-registry-file* (user-configuration-directory)))
+(defun system-source-registry ()
+  (merge-pathnames *source-registry-file* (system-configuration-directory)))
+(defun user-source-registry-directory ()
+  (merge-pathnames *source-registry-directory* (user-configuration-directory)))
+(defun system-source-registry-directory ()
+  (merge-pathnames *source-registry-directory* (system-configuration-directory)))
+(defun environment-source-registry ()
+  (getenv "CL_SOURCE_REGISTRY"))
+
+(defgeneric process-source-registry (spec &key inherit register))
+(defmethod process-source-registry ((x symbol) &key inherit register)
+  (process-source-registry (funcall x) :inherit inherit :register register))
+(defmethod process-source-registry ((pathname pathname) &key inherit register)
   (cond
     ((directory-pathname-p pathname)
      (process-source-registry (validate-source-registry-directory pathname)
-                              :inherit inherit :collect collect))
+                              :inherit inherit :register register))
     ((probe-file pathname)
      (process-source-registry (validate-source-registry-file pathname)
-                              :inherit inherit :collect collect))
+                              :inherit inherit :register register))
     (t
-     (inherit-source-registry inherit :collect collect))))
-(defmethod process-source-registry ((string string) &key
-                                    (inherit *default-source-registries*)
-                                    collect)
+     (inherit-source-registry inherit :register register))))
+(defmethod process-source-registry ((string string) &key inherit register)
   (process-source-registry (parse-source-registry-string string)
-                           :inherit inherit :collect collect))
-(defmethod process-source-registry ((x null) &key
-                                    (inherit *default-source-registries*)
-                                    collect)
-  (inherit-source-registry inherit :collect collect))
-
-(defun make-collector ()
-  (let ((acc ()))
-    (values (lambda (x) (push x acc))
-            (lambda () (reverse acc)))))
-
-(defmethod process-source-registry ((form cons) &key
-                                    (inherit *default-source-registries*)
-                                    collect)
-  (multiple-value-bind (collect result)
-      (if collect
-          (values collect (constantly nil))
-        (make-collector))
-    (let ((*default-exclusions* *default-exclusions*))
-      (dolist (directive (cdr (validate-source-registry-form form)))
-        (process-source-registry-directive directive :inherit inherit :collect collect)))
-    (funcall result)))
-
-(defun inherit-source-registry (inherit &key collect)
+                           :inherit inherit :register register))
+(defmethod process-source-registry ((x null) &key inherit register)
+  (declare (ignorable x))
+  (inherit-source-registry inherit :register register))
+(defmethod process-source-registry ((form cons) &key inherit register)
+  (let ((*default-exclusions* *default-exclusions*))
+    (dolist (directive (cdr (validate-source-registry-form form)))
+      (process-source-registry-directive directive :inherit inherit :register register))))
+
+(defun inherit-source-registry (inherit &key register)
   (when inherit
-    (funcall (first inherit) :collect collect :inherit (rest inherit))))
+    (process-source-registry (first inherit) :register register :inherit (rest inherit))))
 
-(defun process-source-registry-directive (directive &key inherit collect)
-  (destructuring-bind (kw &rest rest) directive
+(defun process-source-registry-directive (directive &key inherit register)
+  (destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive))
     (ecase kw
       ((:include)
        (destructuring-bind (pathname) rest
-         (process-source-registry (pathname pathname) :inherit inherit :collect collect)))
+         (process-source-registry (pathname pathname) :inherit nil :register register)))
       ((:directory)
        (destructuring-bind (pathname) rest
-         (funcall collect (ensure-directory-pathname pathname))))
+         (funcall register pathname)))
       ((:tree)
        (destructuring-bind (pathname) rest
-         (collect-asd-subdirectories pathname :collect collect)))
+         (funcall register pathname :recurse t :exclude *default-exclusions*)))
       ((:exclude)
        (setf *default-exclusions* rest))
       ((:default-registry)
        (default-registry))
       ((:inherit-configuration)
-       (inherit-source-registry inherit :collect collect))
+       (inherit-source-registry inherit :register register))
       ((:ignore-inherited-configuration)
        nil))))
 
 ;; Will read the configuration and initialize all internal variables,
 ;; and return the new configuration.
-(defun initialize-source-registry ()
-  (setf (source-registry)
-        (inherit-source-registry *default-source-registries*)))
+(defun compute-source-registry (&optional parameter)
+  (multiple-value-bind (collect result) (make-collector)
+    (inherit-source-registry
+     (list*
+      parameter
+      *default-source-registries*)
+     :register
+     (lambda (directory &key recurse exclude)
+       (register-asd-directory
+        directory
+        :recurse recurse :exclude exclude :collect collect)))
+    (funcall result)))
+
+(defun initialize-source-registry (&optional parameter)
+  (setf (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
@@ -2368,16 +2827,28 @@ with a different configuration, so the configuration would be re-read then."
   #+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)))))
+      (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))))))
 
 ;;;; -----------------------------------------------------------------
 ;;;; Done!
 (when *load-verbose*
   (asdf-message ";; ASDF, version ~a" (asdf-version)))
 
+#+allegro
+(eval-when (:compile-toplevel :execute)
+  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
+    (setf excl:*warn-on-nested-reader-conditionals* *acl-warn-save*)))
+
 (pushnew :asdf *features*)
 ;;(pushnew :asdf2 *features*) ;; do that when we reach version 2
 
 (provide :asdf)
 
-;;;; The End.
+;;; Local Variables:
+;;; mode: lisp
+;;; End:
diff --git a/asdf.texinfo b/asdf.texinfo
index ddefe017e1f7ad3f944194ff865f5ffc4d1b46b1..ccee58764bdb44576a84a378e5af33ab67585b75 100644
--- a/asdf.texinfo
+++ b/asdf.texinfo
@@ -14,7 +14,7 @@
 This manual describes asdf, a system definition facility for Common
 Lisp programs and libraries.
 
-asdf Copyright @copyright{} 2001-2007 Daniel Barlow and contributors
+asdf Copyright @copyright{} 2001-2010 Daniel Barlow and contributors
 
 This manual Copyright @copyright{} 2001-2007 Daniel Barlow and
 contributors
@@ -65,6 +65,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 @insertcopying
 
 @menu
+
 * Introduction::
 * Using asdf to load systems::
 * Defining systems with defsystem::
@@ -96,6 +97,7 @@ Defining systems with defsystem
 * The defsystem grammar::
 * Other code in .asd files::
 
+
 The object model of asdf
 
 * Operations::
@@ -453,7 +455,7 @@ option := :components component-list
         | :default-component-class
         | :perform method-form
         | :explain method-form
-        | :output-files  method-form
+        | :output-files method-form
         | :operation-done-p method-form
         | :depends-on ( {dependency-def}* )
         | :serial [ t | nil ]
@@ -461,8 +463,7 @@ option := :components component-list
 
 component-list := ( {component-def}* )
 
-component-def  := simple-component-name
-                | ( component-type name {option}* )
+component-def  := ( component-type name {option}* )
 
 component-type := :module | :file | :system | other-component-type
 
@@ -1282,8 +1283,6 @@ location of the system's source file and the relative pathname. For example
 @comment  node-name,  next,  previous,  up
 @chapter Getting the latest version
 
-@emph{FIXME:  Need to revise this to give information about the git repository.}
-
 Decide which version you want.  HEAD is the newest version and
 usually OK, whereas RELEASE is for cautious people (e.g. who already
 have systems using asdf that they don't want broken), a slightly older
@@ -1396,6 +1395,68 @@ interfere.
 
 ASDF bugs are tracked on launchpad: @url{https://launchpad.net/asdf}.
 
+@item ``I want to put my module's files at the top level.  How do I do this?''
+
+By default, the files contained in an asdf module go
+in a subdirectory with the same name as the module.
+However, this can be overridden by adding a @code{:pathname} argument
+to the module description.
+For example, here is how it is done
+in the spatial-trees ASDF system definition:
+
+@example
+(asdf:defsystem :spatial-trees
+  :components
+  ((:module base
+            :pathname ""
+            :components
+            ((:file "package")
+             (:file "basedefs" :depends-on ("package"))
+             (:file "rectangles" :depends-on ("package"))))
+   (:module tree-impls
+            :depends-on (base)
+            :pathname ""
+            :components
+            ((:file "r-trees")
+             (:file "greene-trees" :depends-on ("r-trees"))
+             (:file "rstar-trees" :depends-on ("r-trees"))
+             (:file "rplus-trees" :depends-on ("r-trees"))
+             (:file "x-trees" :depends-on ("r-trees" "rstar-trees"))))
+   (:module viz
+            :depends-on (base)
+            :pathname ""
+            :components
+            ((:static-file "spatial-tree-viz.lisp")))
+   (:module tests
+            :depends-on (base)
+            :pathname ""
+            :components
+            ((:static-file "spatial-tree-test.lisp")))
+   (:static-file "LICENCE")
+   (:static-file "TODO")))
+@end example
+
+All of the files in the @code{tree-impls} module are at the top level,
+instead of in a @code{tree-impls/} subdirectory.
+
+Note that the argument to @code{:pathname} can be either a pathname object or a string.
+A pathname object can be constructed with the @code{#p"foo/bar/"} syntax,
+but this is discouraged because the results of parsing a namestring are not portable.
+A pathname can only be portably constructed with such syntax as
+@code{#.(make-pathname :directory '(:relative "foo" "bar"))},
+and similarly the current directory can only be portably specified as
+@code{#.(make-pathname :directory '(:relative))}.
+However, as of ASDF 1.624, you can portably use a string to denote a pathname.
+The string will be parsed as a @code{/}-separated path from the current directory,
+such that the empty string @code{""} denotes the current directory, and
+@code{"foo/bar"} (no trailing @code{/} required in the case of modules)
+portably denotes the same subdirectory as above.
+When files are specified, the last @code{/}-separated component is interpreted
+either as the name component of a pathname
+(if the component class specifies a pathname type),
+or as a name component plus optional dot-separated type component
+(if the component class doesn't specifies a pathname type).
+
 @end itemize
 
 @node  TODO list, missing bits in implementation, FAQ, Top
@@ -1612,4 +1673,3 @@ probably will be again soon ]
 
 
 @bye
-
diff --git a/build.xcvb b/build.xcvb
index 6b2129ee3f4b5b3d4ad3f043c6b4f28ed89ece2f..bfe06b719ffeb669387e672929eed900d40b9669 100644
--- a/build.xcvb
+++ b/build.xcvb
@@ -1,9 +1,9 @@
 #+xcvb
 (module
- (:fullname "asdf"
+ (:fullname "/asdf"
   :author ("Daniel Barlow and contributors")
   :licence "MIT" ;; MIT-style license. See asdf.lisp
   :description "ASDF"
   :long-description "Another System Definition Facility."
-  :depends-on ("asdf")
+  :depends-on ("asdf" (:when (:featurep :ecl) "asdf-ecl"))
   :build-image nil))
diff --git a/test/compile-asdf.lisp b/test/compile-asdf.lisp
index 60bca6d2e53efe29e3f8d276a3c3206937efae52..dc171c2c95e2945fb0e58066843a9fcf44a7d40b 100644
--- a/test/compile-asdf.lisp
+++ b/test/compile-asdf.lisp
@@ -1,18 +1,26 @@
 (in-package #:common-lisp-user)
 
-(load "test/script-support.lisp")
+(load (merge-pathnames "script-support" *load-pathname*))
 
-(cond ((probe-file "asdf.lisp")
+(cond ((probe-file *asdf-lisp*)
+       (ensure-directories-exist *asdf-fasl*)
        (multiple-value-bind (result warnings-p errors-p)
-           (compile-file "asdf.lisp")
+           ;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
+           (handler-bind ((style-warning
+                           #'(lambda (w)
+                               (princ w *error-output*)
+                               (muffle-warning w))))
+             (compile-file *asdf-lisp*
+                           :output-file *asdf-fasl*))
          (declare (ignore result))
-         (cond (warnings-p 
-                (leave-lisp "Testuite failed: ASDF compiled with warnings" 1))
-               (errors-p 
-                (leave-lisp "Testuite failed: ASDF compiled with ERRORS" 2))
+         (cond (warnings-p
+                ;;; ECL gives warnings that it shouldn't!
+                #+ecl (leave-lisp "ASDF compiled with warnings. Please fix ECL." 0)
+                #-ecl
+                (leave-lisp "Testsuite failed: ASDF compiled with warnings" 1))
+               (errors-p
+                (leave-lisp "Testsuite failed: ASDF compiled with ERRORS" 2))
                (t
                 (leave-lisp "ASDF compiled cleanly" 0)))))
       (t
        (leave-lisp "Testsuite failed: unable to find ASDF source" 3)))
-       
-                     
\ No newline at end of file
diff --git a/test/dweinreb-tests.lisp b/test/dweinreb-tests.lisp
index ba0585558f600129a72978b287f0cf2fceb6b054..891f18a63877676964387674ec30ab3ebb5b9215 100644
--- a/test/dweinreb-tests.lisp
+++ b/test/dweinreb-tests.lisp
@@ -15,7 +15,7 @@ http://ilc2009.scheming.org/
   (already-compiled :initarg :already-compiled :reader test-already-compiled)
   (expected :initarg :expected :reader test-expected)))
 
-(defmacro define-test (test-name system-name 
+(defmacro define-test (test-name system-name
                        &key operation-name already-compiled expected)
  `(progn
     (push ',test-name *all-tests*)
@@ -34,7 +34,7 @@ http://ilc2009.scheming.org/
 
 (defmethod asdf:operation-done-p ((o asdf:compile-op) (c test-file))
  (declare (ignorable o))
- (member (asdf:component-name c) (test-already-compiled *test*) 
+ (member (asdf:component-name c) (test-already-compiled *test*)
           :test #'string=))
 
 (defmethod asdf:operation-done-p ((o asdf:operation) (c test-file))
@@ -70,7 +70,7 @@ http://ilc2009.scheming.org/
                 (first steps) *steps*)))
      ;(format t "~2%STEPS: ~S~3%" *steps*)
      (dolist (expectation (test-expected *test*))
-        (destructuring-bind (op file &rest at) 
+        (destructuring-bind (op file &rest at)
             expectation
           ;(format t "~2%Expectation: ~S~3%" expectation)
           (check-type file string)
@@ -81,8 +81,8 @@ http://ilc2009.scheming.org/
                  (fail "~S was not ~A" file op)
                  (loop for (relationship file2) on at by #'cddr do
                    (check-type file2 string)
-                   (let* ((op2 (ecase relationship 
-                                 (:after-loading :loaded) 
+                   (let* ((op2 (ecase relationship
+                                 (:after-loading :loaded)
                                  (:after-compiling :compiled)))
                           (pos2 (position (cons op2 file2) *steps*
                                           :test #'equal)))
@@ -92,7 +92,7 @@ http://ilc2009.scheming.org/
                            ((< pos pos2)
                             (fail "Wrong order between ~A of ~S and ~A of ~S"
                                   op file op2 file2))))))))
-            (:did-not-compile 
+            (:did-not-compile
              (when (member (cons :compiled file) *steps*)
                (fail "~A compiled but should not have" file)))
             (:did-not-load
@@ -147,7 +147,7 @@ http://ilc2009.scheming.org/
  :operation-name asdf:load-op
  :already-compiled ()
  :expected ((:compiled "a" :after-compiling "g" :after-compiling "k"
-                        :after-compiling "h" :after-loading "g" 
+                        :after-compiling "h" :after-loading "g"
                         :after-loading "k" :after-loading "h")
              (:loaded "a" :after-compiling "a")
              (:compiled "b")
@@ -213,7 +213,7 @@ http://ilc2009.scheming.org/
 (asdf:defsystem system-5
  :components ((:test-file "a")
                (:test-file "b" :depends-on ("a")
-                               :in-order-to ((asdf:compile-op 
+                               :in-order-to ((asdf:compile-op
                                               (asdf:load-op "a"))))))
 
 (define-test test-5 system-5
diff --git a/test/file3-only.asd b/test/file3-only.asd
new file mode 100644
index 0000000000000000000000000000000000000000..aea6aaa2bbcee1e4adc0f0837cc0f08e026ca42f
--- /dev/null
+++ b/test/file3-only.asd
@@ -0,0 +1,3 @@
+;;; -*- Lisp -*-
+(asdf:defsystem file3-only
+    :components ((:file "file3")))
diff --git a/test/graveyard/test-preferences-1.script b/test/graveyard/test-preferences-1.script
index 2e0b245c0e26db9d5ff4fd99557791f78e5e2173..f2055eb3e1ed8568d0abac9ed2f041a4a9d3717b 100644
--- a/test/graveyard/test-preferences-1.script
+++ b/test/graveyard/test-preferences-1.script
@@ -1,7 +1,7 @@
 ;;; -*- Lisp -*-
 (load "script-support")
 (load "../asdf")
-(exit-on-error 
+(exit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (in-package :asdf)
  (setf asdf::*load-preference-files* t)
diff --git a/test/graveyard/test-preferences-system-1.asd b/test/graveyard/test-preferences-system-1.asd
index d8f6444afb0aea492ba7c23f7bdba966be77e952..2a36330547a544b35c11bf5e043e50ccfeb502d1 100644
--- a/test/graveyard/test-preferences-system-1.asd
+++ b/test/graveyard/test-preferences-system-1.asd
@@ -1,7 +1,7 @@
 ;;; -*- Lisp -*-
 (in-package #:common-lisp)
 
-(defpackage #:test-preferences-1-asdf-system 
+(defpackage #:test-preferences-1-asdf-system
   (:use #:common-lisp #:asdf))
 (in-package #:asdf)
 
@@ -10,23 +10,23 @@
   ((:file "test-preferences-1"))
   :in-order-to ((test-op (load-op test-preferences-system-1))))
 
-(defmethod operation-done-p 
+(defmethod operation-done-p
            ((o test-op)
             (c (eql (find-system 'test-preferences-system-1))))
   (values nil))
 
 (defmethod load-preferences
-           ((system (eql (find-system 'test-preferences-system-1))) 
+           ((system (eql (find-system 'test-preferences-system-1)))
             (operation test-op))
-  ;; the default load-preferences does nothing for anything other than a 
+  ;; the default load-preferences does nothing for anything other than a
   ;; basic-load-op. So, ... we hack it
   (load (make-pathname
          :name "test-preferences-system-test"
          :type "lisp"
          :defaults *default-pathname-defaults*)))
 
-(defmethod preference-file-for-system/operation 
-           ((system (eql (find-system 'test-preferences-system-1))) 
+(defmethod preference-file-for-system/operation
+           ((system (eql (find-system 'test-preferences-system-1)))
             (operation load-op))
   (make-pathname
    :name "test-preferences-system-load"
diff --git a/test/graveyard/test6.script b/test/graveyard/test6.script
index 5cc6c6d8a46a59f5cbb4a0a4674295e731c1ebb9..59b2b49a9ad5fdf386467adc70963c9a2821ca7c 100644
--- a/test/graveyard/test6.script
+++ b/test/graveyard/test6.script
@@ -9,11 +9,11 @@
 
 (exit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (defmethod asdf:preference-file-for-system/operation 
+ (defmethod asdf:preference-file-for-system/operation
            ((system (eql (asdf:find-system 'test1))) operation)
-  (merge-pathnames (make-pathname :name "test1" :type "preferences")))     
+  (merge-pathnames (make-pathname :name "test1" :type "preferences")))
  (asdf:operate 'asdf:load-op 'test1)
  (assert (null *test6*)))
 
- 
- 
+
+
diff --git a/test/graveyard/test7.script b/test/graveyard/test7.script
index 5f2e89cf057e605d68e04556b94c2232cfe7bec9..76c2cc8079e8b93da85b309f2af2328349cb2f89 100644
--- a/test/graveyard/test7.script
+++ b/test/graveyard/test7.script
@@ -9,12 +9,12 @@
 
 (exit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (defmethod asdf:preference-file-for-system/operation 
+ (defmethod asdf:preference-file-for-system/operation
            ((system (eql (asdf:find-system 'test1))) operation)
-  (merge-pathnames (make-pathname :name "test1" :type "preferences")))     
+  (merge-pathnames (make-pathname :name "test1" :type "preferences")))
  (setf asdf::*load-preference-files* t)
  (asdf:operate 'asdf:load-op 'test1)
  (assert (eq *test6* :yes)))
 
- 
- 
+
+
diff --git a/test/in-progress.lisp b/test/in-progress.lisp
index fbfd9e88f20dd27c49fd8a5be11a6554b825a2c4..d04e5e27f72de1913129aa1dc17601cd3e91c283 100644
--- a/test/in-progress.lisp
+++ b/test/in-progress.lisp
@@ -5,7 +5,7 @@
  (let ((*system-definition-search-functions*
         '(sysdef-central-registry-search))
        (*central-registry* (list "/tmp/ok-1/" "/tmp/bad" "/tmp/ok-2/")))
-   (handler-bind 
+   (handler-bind
        ((error (lambda (c)
                  (when (find-restart 'remove-entry-from-registry)
                    (invoke-restart 'remove-entry-from-registry)))))
@@ -19,7 +19,7 @@
  (let ((*system-definition-search-functions*
         '(sysdef-central-registry-search))
        (*central-registry* (list "/tmp/ok-1/" "/tmp/bad" "/tmp/ok-2/")))
-   (handler-bind 
+   (handler-bind
        ((error (lambda (c)
                  (when (find-restart 'coerce-entry-to-directory)
                    (invoke-restart 'coerce-entry-to-directory)))))
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 9c6d584d48f3431b2e99284c6a53342dc202eeb3..a170ec7b34155e0e05da711e3a2d835304354616 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -6,15 +6,29 @@
 # - quit with exit status >0 if an unhandled error occurs
 
 export CL_SOURCE_REGISTRY="$PWD"
+unset DEBUG_ASDF_TEST
+
+while getopts "duh" OPTION
+do
+    case $OPTION in
+        d)
+            export DEBUG_ASDF_TEST=t
+            ;;
+        u)
+            usage
+            exit 1
+            ;;
+        h)
+            usage
+            exit 1
+            ;;
+    esac
+done
+shift $(($OPTIND - 1))
 
 if [ x"$1" = "xhelp" ]; then
-    echo "$0 [lisp invocation] [scripts-regex]"
-    echo " - read lisp forms one at a time from matching scripts"
-    echo " - quit with exit status 0 on getting eof"
-    echo " - quit with exit status >0 if an unhandled error occurs"
-    echo " you need to supply the .script in the second argument"
-    echo " lisps include sbcl, clisp, allegro and allegromodern"
-    exit -1
+    usage
+    exit 1
 fi
 
 if [ -z "$2" ]; then
@@ -25,24 +39,38 @@ fi
 
 sok=1
 
+usage () {
+    echo "$0 [lisp invocation] [scripts-regex]"
+    echo " - read lisp forms one at a time from matching scripts"
+    echo " - quit with exit status 0 on getting eof"
+    echo " - quit with exit status >0 if an unhandled error occurs"
+    echo " you need to supply the .script in the second argument"
+    echo " lisps include sbcl, clisp, allegro and allegromodern"
+    echo "OPTIONS:"
+    echo "    -d -- debug mode"
+    echo "    -u -h -- show this message."
+}
+
 do_tests() {
-rm -f *.$2 || true
-( cd .. && echo '(load "test/compile-asdf.lisp")' | $1  )
-if [ $? -eq 0 ] ; then
+  command=$1 eval=$2 fasl_ext=$3
+  rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true
+  ( cd .. && $command $eval '(load "test/compile-asdf.lisp")' )
+  if [ $? -eq 0 ] ; then
+    echo "Compiled OK"
     test_count=0
     test_pass=0
     test_fail=0
     failed_list=""
-    for i in $scripts ; 
-    do 
+    for i in $scripts ;
+    do
       echo "Testing: $i" >&2
       test_count=`expr "$test_count" + 1`
-      rm -f *.$2 || true
-      if  $1 < $i ; then
-        echo "Using $1, $i passed" >&2
+      rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true
+      if $command $eval "(load \"$i\")" ; then
+        echo "Using $command, $i passed" >&2
 	test_pass=`expr "$test_pass" + 1`
       else
-        echo "Using $1, $i failed" >&2
+        echo "Using $command, $i failed" >&2
 	test_fail=`expr "$test_fail" + 1`
 	failed_list="$failed_list $i"
         sok=0
@@ -50,7 +78,7 @@ if [ $? -eq 0 ] ; then
     done
     echo >&2
     echo "-#---------------------------------------" >&2
-    echo "Using $1" >&2
+    echo "Using $command" >&2
     echo "Ran $test_count tests: " >&2
     echo "  $test_pass passing and $test_fail failing" >&2
     if [ $test_fail -eq 0 ] ; then
@@ -60,7 +88,7 @@ if [ $? -eq 0 ] ; then
     fi
     echo "-#---------------------------------------" >&2
     echo >&2
-fi
+  fi
 }
 
 # terminate on error
@@ -75,23 +103,31 @@ case "$lisp" in
   sbcl)
     if type sbcl ; then
       fasl_ext="fasl"
-      command="sbcl --userinit /dev/null --sysinit /dev/null --noinform --noprogrammer"
+      command="sbcl --noinform --userinit /dev/null --sysinit /dev/null"
+      nodebug="--disable-debugger"
+      eval="--eval"
     fi ;;
   clisp)
     if type clisp ; then
 	fasl_ext="fas"
 	command=`which clisp`
-	command="$command -norc -ansi -I - "
+	command="$command -norc -ansi -I "
+        nodebug="-on-error exit"
+        eval="-x"
     fi ;;
   allegro)
     if type alisp ; then
 	fasl_ext="fasl"
-	command="alisp -q -batch "
+	command="alisp -q "
+        nodebug="-batch"
+        eval="-e"
     fi ;;
   allegromodern)
     if type mlisp ; then
 	fasl_ext="fasl"
-	command="mlisp -q -batch "
+	command="mlisp -q"
+        nodebug="-batch"
+        eval="-e"
     fi ;;
   ccl)
     if type ccl ; then
@@ -104,34 +140,53 @@ case "$lisp" in
           i?86|ppc) fasl_bits=32 ;;
         esac
         fasl_ext="${fasl_os}${fasl_bits}fsl"
-	command="ccl --no-init --quiet --batch "
+	command="ccl --no-init --quiet"
+        nodebug="--batch"
+        eval="--eval"
     fi ;;
   cmucl)
     if type lisp ; then
 	fasl_ext="x86f"
-	command="lisp -batch -noinit"
+	command="lisp -noinit"
+        nodebug="-batch"
+        eval="-eval"
+    fi ;;
+  ecl)
+    if type ecl ; then
+	fasl_ext="fas"
+	command=`which ecl`
+	command="$command -norc"
+        eval="-eval"
+    fi ;;
+  lispworks)
+    if type lispworks ; then
+	fasl_ext="ofasl"
+	command=`which ecl`
+	command="$command -siteinit - -init -"
+        eval="-eval"
     fi ;;
 esac
 
-create_asds () {
-    mkdir -p {conf.d,dir1,dir2/{dir3,dir4}}
-    for i in dir1 dir2; do touch "$i"/test.asd; done
-    for i in dir3 dir4; do (cd dir2/$i; touch test.asd); done
+if [ -z "${DEBUG_ASDF_TEST}" ] ; then
+  command="$command $nodebug"
+fi
+
+create_config () {
+    mkdir -p ../tmp/test-source-registry-conf.d ../tmp/test-asdf-output-translations-conf.d
 }
 
 clean_up () {
-    rm -rf {conf.d,dir?}
+    rm -rf ../tmp/test-source-registry-conf.d ../tmp/test-asdf-output-translations-conf.d
 }
 
-
 if [ -z "$command" ] ; then
     echo "Error: cannot find or do not know how to run Lisp named $lisp"
 else
-    create_asds
+    create_config
     mkdir -p results
     echo $command
     thedate=`date "+%Y-%m-%d"`
-    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
+    do_tests "$command" "$eval" "$fasl_ext" 2>&1 | \
+	tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
     clean_up
 fi
- 
diff --git a/test/script-support.lisp b/test/script-support.lisp
index af482dc3a9462d715ddce43f621e1be517cb34be..37c63eb8684e2ebaaf865cdbac11f5ae2126ab2a 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -1,11 +1,12 @@
 (in-package #:common-lisp-user)
 
+(defvar *asdf-lisp* (truename (merge-pathnames "../asdf.lisp" *load-truename*)))
+(defvar *asdf-fasl* (compile-file-pathname (merge-pathnames "tmp/" *asdf-lisp*)))
+(defun load-asdf () (load *asdf-fasl*))
+
 #+allegro
 (setf excl:*warn-on-nested-reader-conditionals* nil)
 
-#+common-lisp-controller
-(setf common-lisp-controller:*redirect-fasl-files-to-cache* nil)
-
 ;;; code adapted from cl-launch (any errors in transcription are mine!)
 ;; http://www.cliki.net/cl-launch
 (defun leave-lisp (message return)
@@ -17,7 +18,7 @@
   (ext:quit return)
   #+(or cmu scl)
   (unix:unix-exit code)
-  #+ecl 
+  #+ecl
   (si:quit return)
   #+gcl
   (lisp:quit code)
@@ -27,13 +28,21 @@
   (ccl::quit return)
   #+sbcl
   (sb-ext:quit :unix-status return)
-
   (error "Don't know how to quit Lisp; wanting to use exit code ~a" return))
 
+
 (defmacro quit-on-error (&body body)
-  `(handler-case 
-      (progn ,@body
-             (leave-lisp "~&Script succeeded~%" 0))
-    (error (c)
-      (format *error-output* "~a" c)
-      (leave-lisp "~&Script failed~%" 1))))
+  `(call-quitting-on-error (lambda () ,@body)))
+
+(defun call-quitting-on-error (thunk)
+  "Unless the environment variable DEBUG_ASDF_TEST
+is bound, write a message and exit on an error.  If
+*asdf-test-debug* is true, enter the debugger."
+  (handler-bind
+      ((error (lambda (c)
+                (format *error-output* "~a" c)
+                (if (ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST"))
+                    (break)
+                    (leave-lisp "~&Script failed~%" 1)))))
+    (funcall thunk)
+    (leave-lisp "~&Script succeeded~%" 0)))
diff --git a/test/static-and-serial.asd b/test/static-and-serial.asd
index 5e4e2a616a5b5e3aa918d32740e57273bc9d83f1..2e4842aa04676f9a363d4b4058392794804c8e44 100644
--- a/test/static-and-serial.asd
+++ b/test/static-and-serial.asd
@@ -1,5 +1,5 @@
 #|
-make sure that serial t and static-files don't cause full rebuilds all 
+make sure that serial t and static-files don't cause full rebuilds all
 the time...
 |#
 
diff --git a/test/test-force.script b/test/test-force.script
index 4d211c66caff5c61968ba4fd46b362f83d39197a..ee35beaad8dfbbf1de00dd70acebf2fb83cb9bf2 100644
--- a/test/test-force.script
+++ b/test/test-force.script
@@ -1,20 +1,23 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
+(load-asdf)
 
+(quit-on-error
+ (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (asdf:operate 'asdf:load-op 'test-force)
- (defvar file1-date (file-write-date (compile-file-pathname "file1"))))
 
-(quit-on-error 
- ;; unforced, date should stay same
- (sleep 1)
- (asdf:operate 'asdf:load-op 'test-force)
- (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
+  (let* ((file1 (asdf:compile-file-pathname* "file1"))
+         (file1-date (file-write-date file1)))
+
+    (assert file1)
+    (assert file1-date)
+
+    ;; unforced, date should stay same
+    (sleep 1)
+    (asdf:operate 'asdf:load-op 'test-force)
+    (assert (equal (file-write-date file1) file1-date))
 
- ;; forced, it should be later
- (sleep 1)
- (asdf:operate 'asdf:load-op 'test-force :force t)
- (assert (> (file-write-date (compile-file-pathname "file1")) file1-date))
- )
\ No newline at end of file
+    ;; forced, it should be later
+    (sleep 1)
+    (asdf:operate 'asdf:load-op 'test-force :force t)
+    (assert (> (file-write-date file1) file1-date))))
diff --git a/test/test-module-depend.asd b/test/test-module-depend.asd
new file mode 100644
index 0000000000000000000000000000000000000000..721d7fadb856ccf6c455a23aef43af09826d65cb
--- /dev/null
+++ b/test/test-module-depend.asd
@@ -0,0 +1,11 @@
+(asdf:defsystem :test-module-depend
+  :components ((:file "file1")
+               (:module "quux"
+                        :pathname #p""
+                        :depends-on ("file1")
+                        :components ((:file "file2")
+                                     (:module "file3mod"
+                                              :pathname #p""
+                                              :components
+                                              ((:file "file3")))))))
+
diff --git a/test/test-module-depend.script b/test/test-module-depend.script
new file mode 100644
index 0000000000000000000000000000000000000000..4a810369f9167fccd1d2df41279359120b939f6f
--- /dev/null
+++ b/test/test-module-depend.script
@@ -0,0 +1,31 @@
+;;; -*- Lisp -*-
+(load "script-support")
+(load-asdf)
+
+(quit-on-error
+ (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ (asdf:operate 'asdf:load-op 'test-module-depend)
+
+ ;; test that it compiled
+ (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1")))
+
+ (assert (and file1-date (file-write-date (asdf:compile-file-pathname* "file2"))))
+
+ ;; and loaded
+ (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
+
+
+ ;; now touch file1 and check that file2 _is_ also recompiled
+ ;; this will only work if the cross-module (intra-system)
+ ;; dependency bug is fixed.
+
+ (let ((before (file-write-date (asdf:compile-file-pathname* "file2"))))
+   (asdf::run-shell-command "touch file1.lisp")
+   (sleep 1)
+   (asdf:operate 'asdf:load-op 'test-module-depend)
+   (assert (>  (file-write-date (asdf:compile-file-pathname* "file2")) before))
+   ;; does this properly go to the second level?
+   (assert (>  (file-write-date (asdf:compile-file-pathname* "file3")) before))
+   ))
+
+
diff --git a/test/test-module-excessive-depend.asd b/test/test-module-excessive-depend.asd
new file mode 100644
index 0000000000000000000000000000000000000000..c7575cd225652ac6f953866960ecfc7fc0298d46
--- /dev/null
+++ b/test/test-module-excessive-depend.asd
@@ -0,0 +1,39 @@
+(defpackage :tmed-asd
+    (:use #:asdf :common-lisp))
+
+(in-package :tmed-asd)
+
+(defsystem :test-module-excessive-depend
+    :components ((:file "file1")
+                 (:module "quux"
+                          :pathname #p""
+                          :depends-on ("file1")
+                          :components ((:file "file2")))))
+
+(defun find-file2 ()
+  (find-component (find-quux) "file2"))
+
+(defun find-quux ()
+  (find-component
+   (find-system :test-module-excessive-depend)
+   "quux"))
+
+(defmethod component-depends-on ((op load-op)
+                                 (c (eql (find-file2))))
+  (cons (cons 'load-op (list "file3-only"))
+        (call-next-method)))
+
+(defmethod component-depends-on ((op compile-op)
+                                 (c (eql (find-file2))))
+  (cons (cons 'load-op (list "file3-only"))
+        (call-next-method)))
+
+(defmethod find-component :around ((m (eql (find-quux)))
+                                   (c string) &optional version)
+  "FIND-COMPONENT on a component is a no-op --- it's already found."
+  (if (string-equal c "file3-only")
+      (asdf:find-system c)
+      (call-next-method)))
+
+
+
diff --git a/test/test-module-excessive-depend.script b/test/test-module-excessive-depend.script
new file mode 100644
index 0000000000000000000000000000000000000000..b06a561ef946b9b4f648781eb7368a361d0fd5f6
--- /dev/null
+++ b/test/test-module-excessive-depend.script
@@ -0,0 +1,65 @@
+;;; -*- Lisp -*-
+(load "script-support")
+(load-asdf)
+
+;;;---------------------------------------------------------------------------
+;;; Here's what we are trying to test.  Let us say we have a system X that
+;;; contains a file, "file1" and a module, "quux" that depends on file 1.  In
+;;; turn, "quux" contains "file2" which depends on loading another system, Y
+;;; (note that this dependency cannot be recorded using only the defsystem
+;;; grammar; we must use an ancillary method definition).  If we over-force
+;;; actions, then the recompiling of "file1" will force "quux" to be loaded,
+;;; forcing "file2" load and in turn forcing the reload and recompilation of Y.
+;;; If operations are done properly, a change to file1 will force recompilation
+;;; and reloading of "file2," but /not/ of system Y.
+;;;---------------------------------------------------------------------------
+
+
+(quit-on-error
+ (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
+
+ ;; test that it compiled
+ (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1")))
+ (defvar file2-date (file-write-date (asdf:compile-file-pathname* "file2")))
+ (defvar file3-date (file-write-date (asdf:compile-file-pathname* "file3")))
+
+ (unless (and file1-date file2-date file3-date)
+   (error "Failed to compile one of the three files that should be compiled for this test: ~{~a~}"
+          (mapcar #'cdr
+                  (remove-if #'car
+                             (pairlis (list file1-date file2-date file3-date)
+                                      '("file1" "file2" "file3"))))))
+
+ ;; and loaded
+ (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
+ (assert (eval (intern (symbol-name '#:*file3*) :test-package)))
+
+
+ ;; now touch file1 and check that file2 _is_ also recompiled
+ ;; but that file3 is _not_ recompiled.
+ ;; this will only work if the cross-module (intra-system)
+ ;; dependency bug is fixed and the excessive compilation bug is fixed.
+
+ (let ((before file2-date))
+   (asdf::run-shell-command "touch file1.lisp")
+   (sleep 1)
+   (let ((plan (asdf::traverse
+                (make-instance 'asdf:load-op)
+                (asdf:find-system 'test-module-excessive-depend)))
+         (file3-only (asdf:find-system 'file3-only)))
+;;;    (format t "~%Operation plan is:~%")
+;;;    (pprint plan)
+;;;    (format t "Target system is: ~a" file3-only)
+     (when (find file3-only plan :key #'cdr)
+       (error "Excessive operations on file3-only system.  Bad propagation of dependencies.")))
+   (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
+   (assert (>  (file-write-date (asdf:compile-file-pathname* "file2")) before))
+   (assert (>  (file-write-date (asdf:compile-file-pathname* "file2")) before))
+   )
+ (unless (= (file-write-date (asdf:compile-file-pathname* "file3"))
+            file3-date)
+   (error "Excessive compilation of file3.lisp:  traverse bug."))
+ )
+
+
diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script
index 310c94aa09a0e0fde93806123afbf3a075557b23..fee40aa9257afa82e383fdcb8c6f811d36c971ec 100644
--- a/test/test-module-pathnames.script
+++ b/test/test-module-pathnames.script
@@ -1,8 +1,8 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 
-(quit-on-error 
+(quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (asdf:load-system 'test-module-pathnames)
  (flet ((submodule (module name)
@@ -23,7 +23,7 @@
               (pathname-foo (asdf:component-relative-pathname static))
               '((:relative "level2") "static" "file"))
              nil
-             "Didn't get the name of static.file right"))) 
+             "Didn't get the name of static.file right")))
  (assert (find-package :test-package) nil
          "package test-package not found")
  (assert (find-symbol (symbol-name '*file-tmp*) :test-package) nil
@@ -32,8 +32,8 @@
          nil "symbol `*file-tmp*` has wrong value")
 
 #| ; must be adapted to ABL
- (assert (probe-file (merge-pathnames 
-                      (make-pathname 
+ (assert (probe-file (merge-pathnames
+                      (make-pathname
                        :name "file1"
                        :type (pathname-type (compile-file-pathname "x"))
                        :directory '(:relative "sources" "level1"))))
@@ -47,8 +47,8 @@
 
 #| ; must be adapted to ABL
 
- (assert (probe-file (merge-pathnames 
-                      (make-pathname 
+ (assert (probe-file (merge-pathnames
+                      (make-pathname
                        :name "file2"
                        :type (pathname-type (compile-file-pathname "x"))
                        :directory '(:relative "sources" "level1" "level2"))))
diff --git a/test/test-nested-components-1.asd b/test/test-nested-components-1.asd
index fad0ef4e67316d2b1675f4aff7d3264b02313726..5e8b6af5921e1ec76d3c4a3a76551750afa2cd23 100644
--- a/test/test-nested-components-1.asd
+++ b/test/test-nested-components-1.asd
@@ -28,28 +28,28 @@
 (in-package #:test-nested-components.system)
 
 (defsystem test-nested-components-a
-  :components 
+  :components
   ((:module "nested-components"
             :pathname ""
             :components ((:file "test-nested-1")))))
 
 (defsystem test-nested-components-b
   :pathname ""
-  :components 
+  :components
   ((:file "test-nested-1")))
 
 (defsystem db-agraph-preflight
-  :components 
+  :components
   ((:module "preflight-checks"
             :components ((:file "preflight")))))
 
 (defsystem db-agraph-preflight-2
   :pathname "preflight-checks"
-  :components 
+  :components
   ((:file "preflight")))
 
 #|
 newer traverse always fails
-older traverse fails when db-agraph-preflight is evaluated, ok 
-  when loaded or compiled 
-|#
\ No newline at end of file
+older traverse fails when db-agraph-preflight is evaluated, ok
+  when loaded or compiled
+|#
diff --git a/test/test-nested-components.script b/test/test-nested-components.script
index 7e16b5abf77a47d899f9e0e6c0608e2333a7e2f5..beaaf7b5dc3352257fd2ee56fdb5ecc06066f87f 100644
--- a/test/test-nested-components.script
+++ b/test/test-nested-components.script
@@ -3,13 +3,13 @@
 ;;; check that added nesting via modules doesn't confuse ASDF
 
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package #:common-lisp-user)
 
-(quit-on-error 
+(quit-on-error
  (setf asdf:*central-registry* nil)
  (load (merge-pathnames "test-nested-components-1.asd"))
- (print 
+ (print
   (list
    :a
    (asdf::traverse (make-instance 'asdf:compile-op)
@@ -28,7 +28,7 @@
  (asdf:oos 'asdf:compile-op 'test-nested-components-a)
  (asdf:oos 'asdf:compile-op 'test-nested-components-b)
 
- (print 
+ (print
   (list
    (asdf::traverse (make-instance 'asdf:load-op)
                    (asdf:find-system 'test-nested-components-a))
@@ -56,7 +56,7 @@
    . #<ASDF:MODULE "preflight-checks" {11B799A9}>)
   (#<ASDF:LOAD-OP NIL {11D04FE9}>
    . #<ASDF:SYSTEM "test-nested-components-a" {11AEDD59}>))
- 
+
  ((#<ASDF:COMPILE-OP NIL {11E4D9B1}>
    . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>)
   (#<ASDF:COMPILE-OP NIL {11E4D9B1}>
@@ -65,4 +65,4 @@
    . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>)
   (#<ASDF:LOAD-OP NIL {11E4A911}>
    . #<ASDF:SYSTEM "test-nested-components-b" {11C92819}>)))
-|#
\ No newline at end of file
+|#
diff --git a/test/test-package.script b/test/test-package.script
index 7fe534d673497a6388fdc51fc0739c79270dd173..861fbc1a6d6160ef1e406d17857c9132be89a36b 100644
--- a/test/test-package.script
+++ b/test/test-package.script
@@ -1,14 +1,9 @@
-(in-package :cl-user)
 ;;; -*- Lisp -*-
+(in-package :cl-user)
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (quit-on-error 
-
  (defun module () 1)
-
  (load "test-package.asd")
-
  (defclass module () ())
-
- (load "test-package.asd")
-)
+ (load "test-package.asd"))
diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script
index 0975bb1a61e716d6ae42f033c214702a43b6c390..d0d0e228b2021b1c5424c6e0853107d745121cf1 100644
--- a/test/test-retry-loading-component-1.script
+++ b/test/test-retry-loading-component-1.script
@@ -3,31 +3,36 @@
 ;;; test asdf:try-recompiling restart
 
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 ;(trace asdf::find-component)
 ;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
 ;#+allegro
 ;(trace excl.osi:command-output)
 (defvar *caught-error* nil)
-(quit-on-error 
+(quit-on-error
+ ;;(format t "trlc1 1~%")
  (when (probe-file "try-reloading-dependency.asd")
    (asdf:run-shell-command "rm -f ~A"
                            (namestring "try-reloading-dependency.asd")))
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (setf asdf::*defined-systems* (asdf::make-defined-systems-table))
- (handler-bind ((error (lambda (c) 
+ ;;(format t "trlc1 2~%")
+ (handler-bind ((error (lambda (c)
                          (format t "~&Caught error ~s" c)
                          (setf *caught-error* t)
                          (asdf:run-shell-command
                           "cp try-reloading-dependency.hidden try-reloading-dependency.asd")
+                         ;;(format t "trlc1 5~%")
                          (multiple-value-bind (name mode)
                              (find-symbol (symbol-name 'retry) :asdf)
                            (assert (eq mode :external) nil "Mode of ~s was not external" name)
+                           ;;(format t "trlc1 6~%")
                            (let ((restart (find-restart name c)))
+                             ;;(format t "trlc1 7~%")
                              (assert restart)
                              (format t "~&restart: ~S~&" restart)
                              (when restart (invoke-restart restart)))))))
+   ;;(format t "trlc1 3~%")
    (asdf:oos 'asdf:load-op 'try-reloading-1))
- (assert *caught-error*)
- )
-
+ ;;(format t "trlc1 4~%")
+ (assert *caught-error*))
diff --git a/test/test-source-registry.s b/test/test-source-registry.s
index 61ce457a391f20118024a8077a2d62ee968333f3..51b348217b1723c98d4a434f015912ecd87271dc 100644
--- a/test/test-source-registry.s
+++ b/test/test-source-registry.s
@@ -12,7 +12,7 @@
   (merge-pathnames path defaults))
 
 (defun ensure-recursive-directory (path)
-  (concatenate 
+  (concatenate
    'string
    (namestring
     (ensure-directory-pathname path))
diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script
index cd100f034cef0532e5d4505aa3c545789b550224..4915cf5e4b6d30a78d477ffdca8b98f3d3f011d9 100644
--- a/test/test-static-and-serial.script
+++ b/test/test-static-and-serial.script
@@ -1,18 +1,16 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
+(load-asdf)
+(quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
 
+ ;;(trace asdf:operation-done-p asdf::safe-file-write-date)
  (asdf:operate 'asdf:load-op 'static-and-serial)
- (defvar file1-date (file-write-date (compile-file-pathname "file1"))))
+ (let* ((file1 (asdf:compile-file-pathname* "file1"))
+        (file1-date (file-write-date file1))
+        (asdf::*defined-systems* (make-hash-table :test 'equal))) ;; cheat
 
-(quit-on-error 
- ;; cheat
- (setf asdf::*defined-systems* (make-hash-table :test 'equal))
-  
- ;; date should stay same
- (sleep 1)
- (asdf:operate 'asdf:load-op 'static-and-serial)
- (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
- )
\ No newline at end of file
+   ;; date should stay same
+   (sleep 1)
+   (asdf:operate 'asdf:load-op 'static-and-serial)
+   (assert (= (file-write-date file1) file1-date))))
diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script
index 0ddeefd597bede224484668676494c5baf78b7ef..9480c292374c4b09b458fabd1ab3b688d5f2c5ba 100644
--- a/test/test-touch-system-1.script
+++ b/test/test-touch-system-1.script
@@ -4,8 +4,8 @@
 ;;; system that can be found using *system-definition-search-functions*
 
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
+(load-asdf)
+(quit-on-error
  (flet ((system-load-time (name)
           (let ((data (asdf::system-registered-p name)))
             (when data
diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script
index 82717fbaca41c5d3df1d6106d878850113e4c2a0..04b9019551e67765d3194b893ad4c9b30aca67b5 100644
--- a/test/test-touch-system-2.script
+++ b/test/test-touch-system-2.script
@@ -4,8 +4,8 @@
 ;;; system that canNOT be found using *system-definition-search-functions*
 
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
+(load-asdf)
+(quit-on-error
  (flet ((system-load-time (name)
           (let ((data (asdf::system-registered-p name)))
             (when data
diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script
index 9dbc9a974ae5b98bd179085183c14cbd98cdf2d8..ac1ad293ce1ad454e470021f4e8196e2c7d98f3c 100644
--- a/test/test-try-recompiling-1.script
+++ b/test/test-try-recompiling-1.script
@@ -3,15 +3,15 @@
 ;;; test asdf:try-recompiling restart
 
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (defvar *caught-error* nil)
 
-(quit-on-error 
+(quit-on-error
  (asdf:run-shell-command "rm -f ~A"
-                         (namestring 
+                         (namestring
                           (compile-file-pathname "try-recompiling-1")))
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (handler-bind ((error (lambda (c) 
+ (handler-bind ((error (lambda (c)
                          (setf *caught-error* t)
                          (multiple-value-bind (name mode)
                              (find-symbol
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 66569fa56ebc5f4384775d70be5d63c263db44ca..9475d2b127b50e739fb40255e43c10497b8f8362 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -1,6 +1,6 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package :asdf)
 (cl-user::quit-on-error
 
@@ -23,4 +23,22 @@
    (make-pathname :name nil :type "bar" :directory '(:absolute "tmp"))
    (make-pathname :name "." :type nil :directory '(:absolute "tmp"))
    (make-pathname :name "." :type "" :directory '(:absolute "tmp")))))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "" t))
+               '(:relative nil nil)))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "" nil))
+               '(:relative nil nil)))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "/" t))
+               '(:absolute nil nil)))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "/" nil))
+               '(:absolute nil nil)))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "/aa/ba" t))
+               '(:absolute ("aa" "ba") nil)))
+(assert (equal (multiple-value-list (component-name-to-pathname-components "/aa/ba" nil))
+               '(:absolute ("aa") "ba")))
+(assert
+ (asdf::version-satisfies (asdf:asdf-version) (asdf:asdf-version)))
+(assert
+ (asdf::version-satisfies (asdf:asdf-version) "1.608"))
+(assert
+ (not (asdf::version-satisfies (asdf:asdf-version) "666")))
 )
diff --git a/test/test-version.script b/test/test-version.script
index 783cec887414e47d0cc6b4bf677c71bfc15346a7..d1d11488556382742c87edbedb0252775c9ddad2 100644
--- a/test/test-version.script
+++ b/test/test-version.script
@@ -1,6 +1,6 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (setf asdf:*central-registry* '(*default-pathname-defaults*))
 
 (defpackage :test-version-system
@@ -8,7 +8,7 @@
 
 (in-package :test-version-system)
 
-(cl-user::quit-on-error 
+(cl-user::quit-on-error
  (defsystem :versioned-system-1
    :pathname #.*default-pathname-defaults*
    :version "1.0")
diff --git a/test/test1.asd b/test/test1.asd
index 6d50d3c1a59766b91feedfd234ccb47e774e275f..b1d7bff01ba773a9cb74fa0cb5ba5de5da61427d 100644
--- a/test/test1.asd
+++ b/test/test1.asd
@@ -1,5 +1,5 @@
 ;;; -*- Lisp -*-
-(asdf:defsystem test1   
+(asdf:defsystem test1
     :components ((:file "file2" :in-order-to ((compile-op (load-op "file1"))))
                  (:file "file1")))
 
diff --git a/test/test1.script b/test/test1.script
index 7708ce483ed50ec622496ce3586e527058b1af56..d22190c73bee4bbd38710471ab8f706b561fff61 100644
--- a/test/test1.script
+++ b/test/test1.script
@@ -1,38 +1,39 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
+(load-asdf)
+
+(quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (asdf:operate 'asdf:load-op 'test1)
 
  ;; test that it compiled
- (defvar file1-date (file-write-date (compile-file-pathname "file1"))))
+ (let* ((file1 (asdf:compile-file-pathname* "file1"))
+        (file2 (asdf:compile-file-pathname* "file2"))
+        (file1-date (file-write-date file1)))
 
-(quit-on-error 
- (assert (and file1-date (file-write-date (compile-file-pathname "file2")))))
+   (format t "~&test1 1: ~S ~S~%" file1 file1-date)
+   (assert file1-date)
+   (assert (file-write-date file2))
 
-;; and loaded
-(assert test-package::*file1*)
+   ;; and loaded
+   (assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
 
-(quit-on-error 
- ;; now remove one output file and check that the other is _not_
- ;; recompiled
- (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines
+   ;; now remove one output file and check that the other is _not_
+   ;; recompiled
+   (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines
 
- (asdf::run-shell-command "rm -f ~A"
-                          (namestring (compile-file-pathname "file2")))
- (asdf:operate 'asdf:load-op 'test1)
- (assert (= file1-date (file-write-date (compile-file-pathname "file1"))))
- (assert (file-write-date (compile-file-pathname "file2")))
+   (asdf::run-shell-command "rm -f ~A" (namestring file2))
+   (asdf:operate 'asdf:load-op 'test1)
+   (assert (= file1-date (file-write-date file1)))
+   (assert (file-write-date file2))
 
- ;; now touch file1 and check that file2 _is_ also recompiled
+   ;; now touch file1 and check that file2 _is_ also recompiled
 
- ;; XXX run-shell-command loses if *default-pathname-defaults* is not the
- ;; unix cwd.  this is not a problem for run-tests.sh, but can be in general
+   ;; XXX run-shell-command loses if *default-pathname-defaults* is not the
+   ;; unix cwd.  this is not a problem for run-tests.sh, but can be in general
 
- (let ((before (file-write-date (compile-file-pathname "file2"))))
-   (asdf::run-shell-command "touch file1.lisp")
-   (sleep 1)
-   (asdf:operate 'asdf:load-op 'test1)
-   (assert (>  (file-write-date (compile-file-pathname "file2")) before)))
- )
\ No newline at end of file
+   (let ((before (file-write-date file2)))
+     (asdf::run-shell-command "touch file1.lisp")
+     (sleep 1)
+     (asdf:operate 'asdf:load-op 'test1)
+     (assert (>  (file-write-date file2) before)))))
diff --git a/test/test2.script b/test/test2.script
index dda94476a5a95afe16a7b49dc1bace8c60d43a3a..4fcfb09360d70eda16e6af05e4ae8bfd929ea3ab 100644
--- a/test/test2.script
+++ b/test/test2.script
@@ -1,26 +1,29 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
+(load-asdf)
+(quit-on-error
+ (format t "test2 1~%")
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
                                         ;(trace asdf::perform)
                                         ;(trace asdf::find-component)
                                         ;(trace asdf::traverse)
  (asdf:oos 'asdf:load-op 'test2b1)
- (assert (and (probe-file (compile-file-pathname "file3"))
-              (probe-file (compile-file-pathname "file4"))))
- (handler-case 
+ (format t "test2 2~%")
+ (assert (and (probe-file (asdf:compile-file-pathname* (truename "file3.lisp")))
+              (probe-file (asdf:compile-file-pathname* (truename "file4.lisp")))))
+ (format t "test2 3~%")
+ (handler-case
      (asdf:oos 'asdf:load-op 'test2b2)
    (asdf:missing-dependency (c)
      (format t "load failed as expected: - ~%~A~%" c))
    (:no-error (c)
      (declare (ignore c))
      (error "should have failed, oops")))
- (handler-case 
+ (format t "test2 4~%")
+ (handler-case
      (asdf:oos 'asdf:load-op 'test2b3)
    (asdf:missing-dependency (c)
      (format t "load failed as expected: - ~%~A~%" c))
-   (:no-error (c) 
+   (:no-error (c)
      (declare (ignore c))
-     (error "should have failed, oops")))
- )
\ No newline at end of file
+     (error "should have failed, oops"))))
diff --git a/test/test2b1.asd b/test/test2b1.asd
index 21b8fc09ffaf9d2efccf1691748aa7742aeb0bd7..bc94d5d9dcbe389bbc37e18a48de831210707325 100644
--- a/test/test2b1.asd
+++ b/test/test2b1.asd
@@ -4,5 +4,3 @@
     :components ((:file "file2" :in-order-to ((compile-op (load-op "file1"))))
                  (:file "file1"))
     :in-order-to ((load-op (load-op (version test2a "1.1")))))
-
-
diff --git a/test/test3.script b/test/test3.script
index d2a2b44d5adbef83cb7e9d4706d53c1c63889dea..5fe09acd9ab05761b7bebbb0dcd2c92121db7b94 100644
--- a/test/test3.script
+++ b/test/test3.script
@@ -2,20 +2,20 @@
 #+(or f1 f2)
     (error "This test cannot run if :f1 or :f2 are on *features*")
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package :asdf)
-(cl-user::quit-on-error 
- (let ((fasl1 (compile-file-pathname (merge-pathnames "file1")))
-       (fasl2 (compile-file-pathname (merge-pathnames "file2"))))
+(cl-user::quit-on-error
+ (let ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp")))
+       (fasl2 (asdf:compile-file-pathname* (truename "file2.lisp"))))
      (asdf:run-shell-command "rm -f ~A ~A"
                              (namestring fasl1)
                              (namestring fasl2))
      (setf asdf:*central-registry* '(*default-pathname-defaults*))
-     (handler-case 
+     (handler-case
          (asdf:oos 'asdf:load-op 'test3)
        (asdf:missing-dependency (c)
          (format t "first test failed as expected: - ~%~A~%" c))
-       (:no-error (c) 
+       (:no-error (c)
          (declare (ignore c))
          (error "should have failed, oops")))
      (pushnew :f1 *features*)
@@ -26,5 +26,4 @@
      (setf *features* (cons :f2 (cdr *features*)))
      (asdf:oos 'asdf:load-op 'test3)
      (assert (probe-file fasl2))
-     (assert (not (probe-file fasl1)))
-     ))
+     (assert (not (probe-file fasl1)))))
diff --git a/test/test4.script b/test/test4.script
index 0c549fb86558517dc5cc13c67ec39349cf9b0f08..4488347f9671ef8b38029388d3a69f551e3010f9 100644
--- a/test/test4.script
+++ b/test/test4.script
@@ -1,9 +1,9 @@
 ;;; -*- Lisp -*-
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package :asdf)
-(cl-user::quit-on-error 
+(cl-user::quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (assert (not (component-property (find-system 'test3) :foo)))
  (assert (equal (component-property (find-system 'test3) :prop1) "value"))
diff --git a/test/test5.not-implemented b/test/test5.not-implemented
index 33c8870e7f437d4e42a26fc850c69072660166d9..cf06f1337c6bb862b279147066df9c6a1e4bd428 100644
--- a/test/test5.not-implemented
+++ b/test/test5.not-implemented
@@ -4,7 +4,7 @@
 
 (load "script-support")
 (load "../asdf")
-(exit-on-error 
+(exit-on-error
  (asdf:run-shell-command "rm ~A ~A"
 			 (namestring (compile-file-pathname "file1"))
 			 (namestring (compile-file-pathname "file2")))
diff --git a/test/test8.script b/test/test8.script
index bf07b217f4728ad97b9faec1a3fadc95b9953fea..50f00f949755c8b2e5c289607b6862954ac17cdc 100644
--- a/test/test8.script
+++ b/test/test8.script
@@ -3,12 +3,12 @@
 ;;; make sure we get a missing-component error
 
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package #:common-lisp-user)
 
-(quit-on-error 
+(quit-on-error
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
- (handler-case 
+ (handler-case
      (asdf:oos 'asdf:load-op 'system-does-not-exist)
    (asdf:missing-component-of-version (c)
      (declare (ignore c))
diff --git a/test/test9.script b/test/test9.script
index f819c49f84146590626cf2889a54ce16cf8e8b92..35b3cc78b19dc42863ea792696ef5e6df100b6f9 100644
--- a/test/test9.script
+++ b/test/test9.script
@@ -3,18 +3,18 @@
 ;;; make sure we get a missing-component-of-version error
 
 (load "script-support")
-(load "../asdf")
+(load-asdf)
 (in-package #:common-lisp-user)
 
-(quit-on-error 
+(quit-on-error
  (setf asdf:*central-registry* nil)
  (load (merge-pathnames "test9-1.asd"))
  (load (merge-pathnames "test9-2.asd"))
- (handler-case 
+ (handler-case
      (asdf:oos 'asdf:load-op 'test9-1)
    (asdf:missing-component-of-version (c)
      (format t "got missing-component-of-version as expected: - ~%~A~%" c))
-   (:no-error (c) 
+   (:no-error (c)
     (declare (ignore c))
     (error "should have failed, oops"))))
 
diff --git a/test/wild-module.script b/test/wild-module.script
index c45a95bfb5486c3cde37e5dcce6f67dd3c00d04f..997203b1182760e333eb87be5b11ff966d477eae 100644
--- a/test/wild-module.script
+++ b/test/wild-module.script
@@ -1,9 +1,8 @@
 ;;; -*- Lisp -*-
 (load "script-support")
-(load "../asdf")
-(quit-on-error 
-
- (load "../asdf")
+(load-asdf)
+(quit-on-error
+ (load-asdf)
  (load "../wild-modules")
 
  (setf asdf:*central-registry* '(*default-pathname-defaults*))