Changeset 14714

Timestamp:

07/18/14 17:03:20 (7 years ago)

Author:

Mark Evenson

Message:

ASDF 3.1.2.9

changeset: 2488:0a1ded36af37
bookmark: master
tag: default/master
tag: tip
user: Francois-Rene Rideau <tunes@…>
summary: Tweak the debian changelog.

Location:

trunk/abcl

Files:

• doc/asdf/asdf.texinfo (modified) (9 diffs)
• src/org/armedbear/lisp/asdf.lisp (modified) (38 diffs)

trunk/abcl/doc/asdf/asdf.texinfo

@@ -910 +910 @@
 @end defun
 
+@vindex *image-dump-hook*
 This function is pushed onto the @code{uiop:*image-dump-hook*} by default,
 which means that if you save an image using @code{uiop:dump-image},
@@ -2389 +2390 @@
 @end itemize
 
+@cindex ASDF-USER package
 When system definitions are loaded from @file{.asd} files,
-a new scratch package is created for them to load into,
-so that different systems do not overwrite each others operations.
-The user may also wish to (and is recommended to)
-include @code{defpackage} and @code{in-package} forms
-in his system definition files, however,
-so that they can be loaded manually if need be.
+they are implicitly loaded into the @code{ASDF-USER} package,
+which uses @code{ASDF}, @code{UIOP} and @code{UIOP/COMMON-LISP}@footnote{
+Note that between releases 2.27 and 3.0.3, only @code{UIOP/PACKAGE},
+not all of @code{UIOP}, was used; if you want your code to work
+with releases earlier than 3.1.2, you may have to explicitly define a package
+that uses @code{UIOP}, or use proper package prefix to your symbols, as in
+@code{uiop:version<}.}
+Programmers who do anything non-trivial in a @file{.asd} file,
+such as defining new variables, functions or classes,
+should include @code{defpackage} and @code{in-package} forms in this file,
+so they will not overwrite each others' extensions.
+Such forms might also help the files behave identically
+if loaded manually with @code{cl:load} for development or debugging,
+though we recommend you use the function @code{asdf::load-asd} instead,
+which the @code{slime-asdf} contrib knows about.
 
 The default value of @code{*system-definition-search-functions*}
-is a list of two functions.
+is a list of three functions.
 The first function looks in each of the directories given
 by evaluating members of @code{*central-registry*}
-for a file whose name is the name of the system and whose type is @file{asd}.
-The first such file is returned,
+for a file whose name is the name of the system and whose type is @file{asd};
+the first such file is returned,
 whether or not it turns out to actually define the appropriate system.
 The second function does something similar,
-for the directories specified in the @code{source-registry}.
-Hence, it is strongly advised to define a system
-@var{foo} in the corresponding file @var{foo.asd}.
+for the directories specified in the @code{source-registry},
+but searches the filesystem only once and caches its results.
+The third function makes the @code{package-inferred-system} extension work,
+@pxref{The package-inferred-system extension}.
+
+Because of the way these search functions are defined,
+you should put the definition for a system
+@var{foo} in a file named @file{foo.asd},
+in a directory that is
+in the central registry or
+which can be found using the
+source registry configuration.
+
+@c FIXME: Move this discussion to the system definition grammar, or somewhere else.
+@anchor{System names}
+@cindex System names
+@cindex Primary system name
+@findex primary-system-name
+It is often useful to define multiple systems in a same file,
+but ASDF can only locate a system's definition file based on the system
+name.
+For this reason,
+ASDF 3's system search algorithm has been extended to
+allow a file @file{foo.asd} to contain
+secondary systems named @var{foo/bar}, @var{foo/baz}, @var{foo/quux}, etc.,
+in addition to the primary system named @var{foo}.
+The first component of a system name,
+separated by the slash character, @code{/},
+is called the primary name of a system.
+The primary name may be
+extracted by function @code{asdf::primary-system-name};
+when ASDF 3 is told to find a system whose name has a slash,
+it will first attempt to load the corresponding primary system,
+and will thus see any such definitions, and/or any
+definition of a @code{package-inferred-system}.@footnote{
+ASDF 2.26 and earlier versions
+do not support this primary system name convention.
+With these versions of ASDF
+you must explicitly load @file{foo.asd}
+before you can use system @var{foo/bar} defined therein,
+e.g. using @code{(asdf:find-system "foo")}.
+We do not support ASDF 2, and recommend that you should upgrade to ASDF 3.
+}
+If your file @file{foo.asd} also defines systems
+that do not follow this convention, e.g., a system named @var{foo-test},
+ASDF will not be able to automatically locate a definition for these systems,
+and will only see their definition
+if you explicitly find or load the primary system
+using e.g. @code{(asdf:find-system "foo")} before you try to use them.
+We strongly recommend against this practice,
+though it is currently supported for backward compatibility.
+
+@end defun
+
+@defun primary-system-name name
+
+Internal (not exported) function, @code{asdf::primary-system-name}.
+Returns the primary system name (the portion before
+the slash, @code{/}, in a secondary system name) from @var{name}.
+
+@end defun
+
+@defun locate-system name
+
+This function should typically @emph{not} be invoked directly.  It is
+exported as part of the API only for programmers who wish to provide
+their own @code{*system-definition-search-functions*}.
+
+Given a system @var{name} designator,
+try to locate where to load the system definition from.
+@c (This does not include the loading of the system definition,
+@c which is done by @code{find-system},
+@c or the loading of the system itself, which is done by @code{load-system};
+@c however, for systems the definition of which has already been loaded,
+@c @code{locate-system} may return an object of class @code{system}.)
+Returns five values: @var{foundp}, @var{found-system}, @var{pathname},
+@var{previous}, and @var{previous-time}.
+@var{foundp} is true when a system was found,
+either a new as yet unregistered one, or a previously registered one.
+The @var{found-system} return value
+will be a @code{system} object, if a system definition is found in your
+source registry.
+@c This system may be registered (by @code{register-system}) or may not, if
+@c it's preloaded code.  Fare writes:
+@c In the case of preloaded code, as for "asdf", "uiop", etc.,
+@c themselves, the system objects are not registered until after they are
+@c initially located by sysdef-preloaded-system-search as a fallback when
+@c no source code was found.
+The system definition will @emph{not} be
+loaded if it hasn't been loaded already.
+@var{pathname} when not null is a path from which to load the system,
+either associated with @var{found-system}, or with the @var{previous} system.
+If @var{previous} is not null, it will be a @emph{previously loaded}
+@code{system} object of the same name (note that the system
+@emph{definition} is previously-loaded: the system itself may or may not be).
+@var{previous-time} when not null is
+the timestamp of the previous system definition file, at the
+time when the @var{previous} system definition was loaded.
+
+For example, if your current registry has @file{foo.asd} in
+@file{/current/path/to/foo.asd},
+but system @code{foo} was previously loaded from @file{/previous/path/to/foo.asd}
+then @var{locate-system} will return the following values:
+@enumerate
+@item
+@var{foundp} will be @code{T},
+@item
+@var{found-system} will be @code{NIL},
+@item
+@var{pathname} will be @code{#p"/current/path/to/foo.asd"},
+@item
+@var{previous} will be an object of type @code{SYSTEM} with
+@code{system-source-file} slot value of 
+@code{#p"/previous/path/to/foo.asd"}
+@item
+@var{previous-time} will be the timestamp of
+@code{#p"/previous/path/to/foo.asd"} at the time it was loaded.
+@end enumerate
 @end defun
 
@@ -2726 +2852 @@
 component classes and specializing methods on the new component class.
 
-@emph{FIXME: this should perhaps be explained more throughly,
-not only by example ...}
+@c FIXME: this should perhaps be explained more throughly,
+@c not only by example ...
 
 As an example, suppose we have some implementation-dependent
@@ -2770 +2896 @@
 @c here....  Also needs to be revised to be coherent.
 
-To be successfully buildable, this graph of actions but be acyclic.
-If, as a user, extender or implementer of ASDF, you fail
-to keep the dependency graph without cycles,
-ASDF will fail loudly as it eventually finds one.
+To be successfully build-able, this graph of actions must be acyclic.
+If, as a user, extender or implementer of ASDF, you introduce
+a cycle into the dependency graph,
+ASDF will fail loudly.
 To clearly distinguish the direction of dependencies,
 ASDF 3 uses the words @emph{requiring} and @emph{required}
@@ -2964 +3090 @@
 because it is easier to setup in a portable way across users and implementations.
 
-Addtionally, some people dislike truename,
+Additionally, some people dislike truename,
 either because it is very slow on their system, or
 because they are using content-addressed storage where the truename of a file
@@ -3252 +3378 @@
 ASDF will skip to next configuration if it's an empty string.
 It will @code{READ} the string as a SEXP in the DSL
-if it begins with a paren @code{(}
-and it will be interpreted much like @code{TEXINPUTS}
-list of paths, where
+if it begins with a paren @code{(},
+otherwise it will be interpreted much like @code{TEXINPUTS},
+as a list of paths, where
 
   * paths are separated
@@ -3710 +3836 @@
              ;; the pathname to be translated and the matching
              ;; DIRECTORY-DESIGNATOR
-    LAMBDA   ;; A form which evalutates to a function taking two arguments:
+    LAMBDA   ;; A form which evaluates to a function taking two arguments:
              ;; the pathname to be translated and the matching
              ;; DIRECTORY-DESIGNATOR
@@ -3771 +3897 @@
 If the @code{translate-pathname} mechanism cannot achieve a desired
 translation, the user may provide a function which provides the
-required algorithim.  Such a translation function is specified by
+required algorithm.  Such a translation function is specified by
 supplying a list as the second @code{directory-designator}
 the first element of which is the keyword @code{:function},
@@ -5614 +5740 @@
 
 @bye
+
+@c  LocalWords:  clbuild tarballs defsystem Quicklisp initarg uiop fasl
+@c  LocalWords:  namestring initargs fasls

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

@@ -1 +1 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
-;;; This is ASDF 3.1.2.2: Another System Definition Facility.
+;;; This is ASDF 3.1.2.9: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
@@ -403 +403 @@
                        (t (push name intern)))))))
         (labels ((sort-names (names)
-                   (sort names #'string<))
+                   (sort (copy-list names) #'string<))
                  (table-keys (table)
                    (loop :for k :being :the :hash-keys :of table :collect k))
@@ -846 +846 @@
 (uiop/package:define-package :uiop/common-lisp
   (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl)
-  (:use #-genera :common-lisp #+genera :future-common-lisp :uiop/package)
-  (:reexport :common-lisp)
+  (:use :uiop/package)
+  (:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
   (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf)
   #+allegro (:intern #:*acl-warn-save*)
@@ -856 +856 @@
    #:make-broadcast-stream #:file-namestring)
   #+genera (:shadowing-import-from :scl #:boolean)
-  #+genera (:export #:boolean #:ensure-directories-exist)
+  #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence)
   #+mcl (:shadow #:user-homedir-pathname))
 (in-package :uiop/common-lisp)
@@ -936 +936 @@
 #+genera
 (eval-when (:load-toplevel :compile-toplevel :execute)
+  (unless (fboundp 'lambda)
+    (defmacro lambda (&whole form &rest bvl-decls-and-body)
+      (declare (ignore bvl-decls-and-body)(zwei::indentation 1 1))
+      `#',(cons 'lisp::lambda (cdr form))))
   (unless (fboundp 'ensure-directories-exist)
     (defun ensure-directories-exist (path)
-      (fs:create-directories-recursively (pathname path)))))
+      (fs:create-directories-recursively (pathname path))))
+  (unless (fboundp 'read-sequence)
+    (defun read-sequence (sequence stream &key (start 0) end)
+      (scl:send stream :string-in nil sequence start end)))
+  (unless (fboundp 'write-sequence)
+    (defun write-sequence (sequence stream &key (start 0) end)
+      (scl:send stream :string-out sequence start end)
+      sequence)))
 
 #.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick
@@ -1214 +1225 @@
 ;;; Characters
 (with-upgradability () ;; base-char != character on ECL, LW, SBCL, Genera. LW also has SIMPLE-CHAR.
-  (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char)))
+  (defconstant +non-base-chars-exist-p+ #.(not (subtypep 'character 'base-char)))
   #-scl ;; In SCL, all characters seem to be 16-bit base-char, but this flag gets set somehow???
   (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*)))
@@ -1391 +1402 @@
       (function fun)
       ((or boolean keyword character number pathname) (constantly fun))
-      (hash-table (lambda (x) (gethash x fun)))
+      (hash-table #'(lambda (x) (gethash x fun)))
       (symbol (fdefinition fun))
       (cons (if (eq 'lambda (car fun))
@@ -1751 +1762 @@
     "The operating system of the current host"
     (first-feature
-     '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
+     '(:cygwin
+       (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first!
        (:linux :linux :linux-target) ;; for GCL at least, must appear before :bsd
        (:macosx :macosx :darwin :darwin-target :apple) ; also before :bsd
-       (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd) :unix
+       (:solaris :solaris :sunos)
+       (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
+       :unix
        :genera)))
 
@@ -2553 +2567 @@
 when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
     (let ((sub (when maybe-subpath (pathname maybe-subpath)))
-    (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
+          (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
       (or (and base (subpathp sub base)) sub)))
 
@@ -3298 +3312 @@
     #+cormanlisp (win32:delete-directory directory-pathname)
     #+ecl (si:rmdir directory-pathname)
+    #+genera (fs:delete-directory directory-pathname)
     #+lispworks (lw:delete-directory directory-pathname)
     #+mkcl (mkcl:rmdir directory-pathname)
@@ -3304 +3319 @@
                `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
     #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
-    #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks mkcl sbcl scl xcl)
+    #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
     (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera
 
@@ -3338 +3353 @@
               'delete-filesystem-tree directory-pathname))
          (:ignore nil)))
-      #-(or allegro cmu clozure sbcl scl)
+      #-(or allegro cmu clozure genera sbcl scl)
       ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp,
        ;; except on implementations where we can prevent DIRECTORY from following symlinks;
@@ -3348 +3363 @@
                               directory-pathname :if-does-not-exist if-does-not-exist)
        #+clozure (ccl:delete-directory directory-pathname)
-       #+genera (error "~S not implemented on ~S" 'delete-directory-tree (implementation-type))
+       #+genera (fs:delete-directory directory-pathname :confirm nil)
        #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil))
                   `(,dd directory-pathname :recursive t) ;; requires SBCL 1.0.44 or later
@@ -3996 +4011 @@
            (afterf (gensym "AFTER")))
       `(flet (,@(when before
-                  `((,beforef (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname))) ,@before)))
+                  `((,beforef (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname)))
+                       ,@(when after `((declare (ignorable ,pathname))))
+                       ,@before)))
               ,@(when after
                   (assert pathnamep)
@@ -4121 +4138 @@
     #+ecl (si:quit code)
     #+gcl (system:quit code)
-    #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code)
+    #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
     #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
     #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
@@ -4145 +4162 @@
     #+abcl
     (loop :for i :from 0
-    :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
-      (safe-format! stream "~&~D: ~A~%" i frame))
+          :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
+            (safe-format! stream "~&~D: ~A~%" i frame))
     #+allegro
     (let ((*terminal-io* stream)
@@ -4170 +4187 @@
     #+(or ecl mkcl)
     (let* ((top (si:ihs-top))
-     (repeats (if count (min top count) top))
-     (backtrace (loop :for ihs :from 0 :below top
+           (repeats (if count (min top count) top))
+           (backtrace (loop :for ihs :from 0 :below top
                             :collect (list (si::ihs-fun ihs)
                                            (si::ihs-env ihs)))))
       (loop :for i :from 0 :below repeats
-      :for frame :in (nreverse backtrace) :do
-        (safe-format! stream "~&~D: ~S~%" i frame)))
+            :for frame :in (nreverse backtrace) :do
+              (safe-format! stream "~&~D: ~S~%" i frame)))
     #+gcl
     (let ((*debug-io* stream))
       (ignore-errors
        (with-safe-io-syntax ()
-   (if condition
-       (conditions::condition-backtrace condition)
-       (system::simple-backtrace)))))
+         (if condition
+             (conditions::condition-backtrace condition)
+             (system::simple-backtrace)))))
     #+lispworks
     (let ((dbg::*debugger-stack*
@@ -4197 +4214 @@
     #+xcl
     (loop :for i :from 0 :below (or count most-positive-fixnum)
-    :for frame :in (extensions:backtrace-as-list) :do
-      (safe-format! stream "~&~D: ~S~%" i frame)))
+          :for frame :in (extensions:backtrace-as-list) :do
+            (safe-format! stream "~&~D: ~S~%" i frame)))
 
   (defun print-backtrace (&rest keys &key stream count condition)
@@ -4298 +4315 @@
       #-(or sbcl allegro)
       (unless (eq *image-dumped-p* :executable)
-  ;; LispWorks command-line processing isn't transparent to the user
-  ;; unless you create a standalone executable; in that case,
-  ;; we rely on cl-launch or some other script to set the arguments for us.
-  #+lispworks (return *command-line-arguments*)
-  ;; On other implementations, on non-standalone executables,
-  ;; we trust cl-launch or whichever script starts the program
-  ;; to use -- as a delimiter between implementation arguments and user arguments.
-  #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
+        ;; LispWorks command-line processing isn't transparent to the user
+        ;; unless you create a standalone executable; in that case,
+        ;; we rely on cl-launch or some other script to set the arguments for us.
+        #+lispworks (return *command-line-arguments*)
+        ;; On other implementations, on non-standalone executables,
+        ;; we trust cl-launch or whichever script starts the program
+        ;; to use -- as a delimiter between implementation arguments and user arguments.
+        #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
       (rest arguments)))
 
@@ -4340 +4357 @@
 Then, comes the restore process itself:
 First, call each function in the RESTORE-HOOK,
-in the order they were registered with REGISTER-RESTORE-HOOK.
+in the order they were registered with REGISTER-IMAGE-RESTORE-HOOK.
 Second, evaluate the prelude, which is often Lisp text that is read,
 as per EVAL-INPUT.
@@ -4385 +4402 @@
                                 #+clozure prepend-symbols #+clozure (purify t)
                                 #+sbcl compression
-                                #+(and sbcl windows) application-type)
+                                #+(and sbcl os-windows) application-type)
     "Dump an image of the current Lisp environment at pathname FILENAME, with various options.
 
@@ -4459 +4476 @@
               ;;--- only save runtime-options for standalone executables
               (when executable (list :toplevel #'restore-image :save-runtime-options t))
-              #+(and sbcl windows) ;; passing :application-type :gui will disable the console window.
+              #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window.
               ;; the default is :console - only works with SBCL 1.1.15 or later.
               (when application-type (list :application-type application-type)))))
@@ -5296 +5313 @@
     (%wait-process-result
      (apply '%run-program (%normalize-system-command command) :wait t keys))
-    #+(or abcl cormanlisp clisp ecl gcl (and lispworks os-windows) mkcl xcl)
+    #+(or abcl cormanlisp clisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
     (let ((%command (%redirected-system-command command input output error-output directory)))
       #+(and lispworks os-windows)
@@ -5313 +5330 @@
                 (ext:system %command))
         #+gcl (system:system %command)
+        #+genera (error "~S not supported on Genera, cannot run ~S"
+                        '%system %command)
         #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
         #+mkcl (mkcl:system %command)
@@ -6343 +6362 @@
 be applied to the results to yield a configuration form.  Current
 values of TAG include :source-registry and :output-translations."
-    (let ((files (sort (ignore-errors
+    (let ((files (sort (ignore-errors ;; SORT w/o COPY-LIST is OK: DIRECTORY returns a fresh list
                         (remove-if
                          'hidden-pathname-p
@@ -6640 +6659 @@
          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
-         (asdf-version "3.1.2.2")
+         (asdf-version "3.1.2.9")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
@@ -6652 +6671 @@
 (when-upgrading ()
   (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
-    ;; NB: it's too late to do anything about functions in UIOP!
-    ;; If you introduce some critically incompatibility there, you must change name.
+          ;; NB: it's too late to do anything about functions in UIOP!
+          ;; If you introduce some critically incompatibility there, you must change name.
           '(#:component-relative-pathname #:component-parent-pathname ;; component
             #:source-file-type
             #:find-system #:system-source-file #:system-relative-pathname ;; system
-      #:find-component ;; find-component
-      #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
-      #:component-depends-on #:operation-done-p #:component-depends-on
-      #:traverse ;; backward-interface
+            #:find-component ;; find-component
+            #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
+            #:component-depends-on #:operation-done-p #:component-depends-on
+            #:traverse ;; backward-interface
             #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
-      #:operate  ;; operate
-      #:parse-component-form ;; defsystem
-      #:apply-output-translations ;; output-translations
-      #:process-output-translations-directive
-      #:inherit-source-registry #:process-source-registry ;; source-registry
-      #:process-source-registry-directive
-      #:trivial-system-p)) ;; bundle
-  (redefined-classes
+            #:operate  ;; operate
+            #:parse-component-form ;; defsystem
+            #:apply-output-translations ;; output-translations
+            #:process-output-translations-directive
+            #:inherit-source-registry #:process-source-registry ;; source-registry
+            #:process-source-registry-directive
+            #:trivial-system-p)) ;; bundle
+        (redefined-classes
           ;; redefining the classes causes interim circularities
-    ;; with the old ASDF during upgrade, and many implementations bork
+          ;; with the old ASDF during upgrade, and many implementations bork
           '((#:compile-concatenated-source-op (#:operation) ()))))
     (loop :for name :in redefined-functions
@@ -6679 +6698 @@
               #-clisp (fmakunbound sym)))
     (labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf))
-       (find-symbol* s p nil)))
-       (asyms (l) (mapcar #'asym l)))
+                         (find-symbol* s p nil)))
+             (asyms (l) (mapcar #'asym l)))
       (loop* :for (name superclasses slots) :in redefined-classes
-       :for sym = (find-symbol* name :asdf nil)
-       :when (and sym (find-class sym))
-       :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
+             :for sym = (find-symbol* name :asdf nil)
+             :when (and sym (find-class sym))
+             :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
 
 
@@ -7145 +7164 @@
   (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
            #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache
-     #:do-asdf-cache #:normalize-namestring
-           #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
+           #:do-asdf-cache #:normalize-namestring
+           #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*
+           #:clear-configuration-and-retry #:retry))
 (in-package :asdf/cache)
 
@@ -7182 +7202 @@
       (if (and *asdf-cache* (not override))
           (funcall fun)
-          (let ((*asdf-cache* (make-hash-table :test 'equal)))
-            (funcall fun)))))
+          (loop
+            (restart-case
+                (let ((*asdf-cache* (make-hash-table :test 'equal)))
+                  (return (funcall fun)))
+              (retry ()
+                :report (lambda (s)
+                          (format s (compatfmt "~@<Retry ASDF operation.~@:>"))))
+              (clear-configuration-and-retry ()
+                :report (lambda (s)
+                          (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>")))
+                (clear-configuration)))))))
 
   (defmacro with-asdf-cache ((&key key override) &body body)
@@ -7310 +7339 @@
     ;; Invalidate all systems but ASDF itself, if registered.
     (loop :for name :being :the :hash-keys :of *defined-systems*
-    :unless (equal name "asdf")
-      :do (clear-defined-system name)))
+          :unless (equal name "asdf")
+            :do (clear-defined-system name)))
 
   (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
@@ -7564 +7593 @@
 FOUNDP is true when a system was found,
 either a new unregistered one or a previously registered one.
-FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is
-PATHNAME when not null is a path from where to load the system,
+FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed.
+PATHNAME when not null is a path from which to load the system,
 either associated with FOUND-SYSTEM, or with the PREVIOUS system.
 PREVIOUS when not null is a previously loaded SYSTEM object of same name.
 PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
-    (with-asdf-cache (:key `(locate-system ,name))
-      (let* ((name (coerce-name name))
-             (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
-             (previous (cdr in-memory))
-             (previous (and (typep previous 'system) previous))
-             (previous-time (car in-memory))
-             (found (search-for-system-definition name))
-             (found-system (and (typep found 'system) found))
-             (pathname (ensure-pathname
-                        (or (and (typep found '(or pathname string)) (pathname found))
-                            (and found-system (system-source-file found-system))
-                            (and previous (system-source-file previous)))
-                        :want-absolute t :resolve-symlinks *resolve-symlinks*))
-             (foundp (and (or found-system pathname previous) t)))
-        (check-type found (or null pathname system))
-        (unless (check-not-old-asdf-system name pathname)
-          (cond
-            (previous (setf found nil pathname nil))
-            (t
-             (setf found (sysdef-preloaded-system-search "asdf"))
-             (assert (typep found 'system))
-             (setf found-system found pathname nil))))
-        (values foundp found-system pathname previous previous-time))))
+    (let* ((name (coerce-name name))
+           (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
+           (previous (cdr in-memory))
+           (previous (and (typep previous 'system) previous))
+           (previous-time (car in-memory))
+           (found (search-for-system-definition name))
+           (found-system (and (typep found 'system) found))
+           (pathname (ensure-pathname
+                      (or (and (typep found '(or pathname string)) (pathname found))
+                          (and found-system (system-source-file found-system))
+                          (and previous (system-source-file previous)))
+                      :want-absolute t :resolve-symlinks *resolve-symlinks*))
+           (foundp (and (or found-system pathname previous) t)))
+      (check-type found (or null pathname system))
+      (unless (check-not-old-asdf-system name pathname)
+        (cond
+          (previous (setf found nil pathname nil))
+          (t
+           (setf found (sysdef-preloaded-system-search "asdf"))
+           (assert (typep found 'system))
+           (setf found-system found pathname nil))))
+      (values foundp found-system pathname previous previous-time)))
 
   (defmethod find-system ((name string) &optional (error-p t))
@@ -7598 +7626 @@
         (unless (equal name primary-name)
           (find-system primary-name nil)))
-      (loop
-        (restart-case
-            (multiple-value-bind (foundp found-system pathname previous previous-time)
-                (locate-system name)
-              (when (and found-system (eq found-system previous)
-                         (or (first (gethash `(find-system ,name) *asdf-cache*))
-                             (and *immutable-systems* (gethash name *immutable-systems*))))
-                (return found-system))
-              (assert (eq foundp (and (or found-system pathname previous) t)))
-              (let ((previous-pathname (and previous (system-source-file previous)))
-                    (system (or previous found-system)))
-                (when (and found-system (not previous))
-                  (register-system found-system))
-                (when (and system pathname)
-                  (setf (system-source-file system) pathname))
-                (when (and pathname
-                           (let ((stamp (get-file-stamp pathname)))
-                             (and stamp
-                                  (not (and previous
-                                            (or (pathname-equal pathname previous-pathname)
-                                                (and pathname previous-pathname
-                                                     (pathname-equal
-                                                      (physicalize-pathname pathname)
-                                                      (physicalize-pathname previous-pathname))))
-                                            (stamp<= stamp previous-time))))))
-                  ;; only load when it's a pathname that is different or has newer content, and not an old asdf
-                  (load-asd pathname :name name)))
-              (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
-                (return
-                  (cond
-                    (in-memory
-                     (when pathname
-                       (setf (car in-memory) (get-file-stamp pathname)))
-                     (cdr in-memory))
-                    (error-p
-                     (error 'missing-component :requires name))))))
-          (reinitialize-source-registry-and-retry ()
-            :report (lambda (s)
-                      (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
-      (unset-asdf-cache-entry `(locate-system ,name))
-            (initialize-source-registry)))))))
-
+      (or (and *immutable-systems* (gethash name *immutable-systems*)
+               (cdr (system-registered-p name)))
+          (multiple-value-bind (foundp found-system pathname previous previous-time)
+              (locate-system name)
+            (assert (eq foundp (and (or found-system pathname previous) t)))
+            (let ((previous-pathname (and previous (system-source-file previous)))
+                  (system (or previous found-system)))
+              (when (and found-system (not previous))
+                (register-system found-system))
+              (when (and system pathname)
+                (setf (system-source-file system) pathname))
+              (when (and pathname
+                         (let ((stamp (get-file-stamp pathname)))
+                           (and stamp
+                                (not (and previous
+                                          (or (pathname-equal pathname previous-pathname)
+                                              (and pathname previous-pathname
+                                                   (pathname-equal
+                                                    (physicalize-pathname pathname)
+                                                    (physicalize-pathname previous-pathname))))
+                                          (stamp<= stamp previous-time))))))
+                ;; only load when it's a pathname that is different or has newer content, and not an old asdf
+                (load-asd pathname :name name)))
+            (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
+              (cond
+                (in-memory
+                 (when pathname
+                   (setf (car in-memory) (get-file-stamp pathname)))
+                 (cdr in-memory))
+                (error-p
+                 (error 'missing-component :requires name))
+                (t ;; not found: don't keep negative cache, see lp#1335323
+                 (unset-asdf-cache-entry `(locate-system ,name))
+                 (return-from find-system nil)))))))))
 ;;;; -------------------------------------------------------------------------
 ;;;; Finding components
@@ -7749 +7769 @@
                      (eq (missing-required-by c) component)
                      (equal (missing-requires c) name))))
-    (unless (component-parent component)
-      (let ((name (coerce-name name)))
-        (unset-asdf-cache-entry `(find-system ,name))
-        (unset-asdf-cache-entry `(locate-system ,name))))))))
+          (unless (component-parent component)
+            (let ((name (coerce-name name)))
+              (unset-asdf-cache-entry `(find-system ,name))
+              (unset-asdf-cache-entry `(locate-system ,name))))))))
 
 
@@ -9050 +9070 @@
 
   (defmethod component-depends-on ((o prepare-op) (s system))
-    `((,*load-system-operation* ,@(component-sideway-dependencies s))))
+    (loop :for (o . cs) :in (call-next-method)
+          :collect (cons (if (eq o 'load-op) *load-system-operation* o) cs)))
 
   (defclass build-op (non-propagating-operation) ()
@@ -9061 +9082 @@
 that will load the system in the current image, and its typically LOAD-OP."))
   (defmethod component-depends-on ((o build-op) (c component))
-    `((,(or (component-build-operation c) *load-system-operation*) ,c)))
+    `((,(or (component-build-operation c) *load-system-operation*) ,c)
+      ,@(call-next-method)))
 
   (defun make (system &rest keys)
@@ -11224 +11246 @@
    #:operation-definition-warning #:operation-definition-error
 
-   #:try-recompiling
+   #:try-recompiling ; restarts
    #:retry
-   #:accept                     ; restarts
+   #:accept
    #:coerce-entry-to-directory
    #:remove-entry-from-registry
+   #:clear-configuration-and-retry
+
 
    #:*encoding-detection-hook*
@@ -11264 +11288 @@
    #:system-source-registry
    #:user-source-registry-directory
-   #:system-source-registry-directory))
+   #:system-source-registry-directory
+   ))
 
 ;;;; ---------------------------------------------------------------------------