diff --git a/find-system.lisp b/find-system.lisp index c33d116572331d2619d959c1ec615069979160d4..8203a30c4f2df27e5734d6c8f31990498ba60b31 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -246,5 +246,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (load-asd pathname :name name))))) ;; Try again after having loaded from disk if needed (or (registered-system name) - (when error-p (error 'missing-component :requires name)))))))) + (when error-p (error 'missing-component :requires name))))))) + + ;; Resolved forward reference for asdf/system-registry. + (defun mark-component-preloaded (component) + "Mark a component as preloaded." + (let ((component (find-component component nil :registered t))) + ;; Recurse to children, so asdf/plan will hopefully be happy. + (map () 'mark-component-preloaded (component-children component)) + ;; Mark the timestamps of the common lisp-action operations as 0. + (let ((times (component-operation-times component))) + (dolist (o `(,@(when (and (typep component 'system) + (equal (coerce-name component) (primary-system-name component))) + '(define-op)) + prepare-op compile-op load-op)) + (setf (gethash (make-operation o) times) 0)))))) diff --git a/operate.lisp b/operate.lisp index 051afe5582919a8f077d5e13aa21b823dbdefda5..8c2a21d4b438366155b2066912dcd6e939f91a5b 100644 --- a/operate.lisp +++ b/operate.lisp @@ -272,17 +272,4 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (upgrade-configuration) ;; If we were in the middle of an operation, be sure to restore the system being defined. (dolist (s systems-being-defined) (find-system s nil)))) - (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf) - - ;; The following function's symbol is from asdf/find-system. - ;; It is defined here to resolve what would otherwise be forward package references. - (defun mark-component-preloaded (component) - "Mark a component as preloaded." - (let ((component (find-component component nil :registered t))) - ;; Recurse to children, so asdf/plan will hopefully be happy. - (map () 'mark-component-preloaded (component-children component)) - ;; Mark the timestamps of the common lisp-action operations as 0. - (let ((times (component-operation-times component))) - (dolist (o '(load-op compile-op prepare-op)) - (setf (gethash (make-operation o) times) 0)))))) - + (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)) diff --git a/system-registry.lisp b/system-registry.lisp index a6a647bd9ebc84ca57d0143715a21e46df6c20fa..c2c023d1e7f855d18cbfc7301dc460154b6838a8 100644 --- a/system-registry.lisp +++ b/system-registry.lisp @@ -15,7 +15,7 @@ #:find-system-if-being-defined #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* - #:mark-component-preloaded ;; forward reference to asdf/operate + #:mark-component-preloaded ;; forward reference to asdf/find-system #:sysdef-immutable-system-search #:register-immutable-system #:*immutable-systems* #:*defined-systems* #:clear-defined-systems ;; defined in source-registry, but specially mentioned here: @@ -81,7 +81,7 @@ called with an object of type asdf:system." (defvar *preloaded-systems* (make-hash-table :test 'equal) "Registration table for preloaded systems.") - (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/operate + (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/find-system (defun make-preloaded-system (name keys) "Make a preloaded system of given NAME with build information from KEYS"