diff --git a/plan.lisp b/plan.lisp
index 6a6f66932619e2767ef2b0518810e8029060c98c..6d85bac197fca85432b3c4f73f2df21fdaecfc09 100644
--- a/plan.lisp
+++ b/plan.lisp
@@ -10,7 +10,7 @@
         :asdf/system :asdf/system-registry :asdf/find-component :asdf/forcing)
   (:export
    #:plan #:plan-traversal #:sequential-plan #:*plan-class*
-   #:action-status #:status-stamp #:status-done-p #:status-keep-p #:status-need-p
+   #:action-status #:status-stamp #:status-index #:status-done-p #:status-keep-p #:status-need-p
    #:+status-good+ #:+status-todo+ #:+status-void+
    #:system-out-of-date #:action-up-to-date-p
    #:circular-dependency #:circular-dependency-actions
@@ -63,7 +63,11 @@
      (stamp
       :type (or integer boolean) :initarg :stamp :reader status-stamp
       :documentation "STAMP associated with the ACTION if it has been completed already
-in some previous image, or T if it needs to be done."))
+in some previous image, or T if it needs to be done.")
+     (index
+      :type (or integer null) :initarg :index :initform nil :reader status-index
+      :documentation "INDEX associated with the ACTION in the current session,
+or NIL if no the status is considered outside of a specific plan."))
     (:documentation "Status of an action in a plan"))
 
   ;; STAMP   KEEP-P DONE-P NEED-P     symbol bitmap  previously   currently
@@ -101,18 +105,19 @@ in some previous image, or T if it needs to be done."))
     (make-instance 'action-status :bits +void-bits+ :stamp nil)))
 
 (with-upgradability ()
-  (defun make-action-status (&key bits stamp)
+  (defun make-action-status (&key bits stamp index)
     (check-type bits (integer 0 7))
     (check-type stamp (or integer boolean))
+    (check-type index (or integer null))
     (assert (eq (null stamp) (zerop (logand bits #.(logior +keep-bit+ +done-bit+)))) ()
             "Bad action-status :bits ~S :stamp ~S" bits stamp)
-    (case bits
-      (+void-bits+ +status-void+)
-      (+todo-bits+ +status-todo+)
-      (otherwise
-       (if (and (= bits +good-bits+) (eq stamp t))
-           +status-good+
-           (make-instance 'action-status :bits bits :stamp stamp)))))
+    (block nil
+      (when (null index)
+        (case bits
+          (#.+void-bits+ (return +status-void+))
+          (#.+todo-bits+ (return +status-todo+))
+          (#.+good-bits+ (when (eq stamp t) (return +status-good+)))))
+      (make-instance 'action-status :bits bits :stamp stamp :index index)))
 
   (defun status-keep-p (status)
     (plusp (logand (status-bits status) #.+keep-bit+)))
@@ -125,7 +130,8 @@ in some previous image, or T if it needs to be done."))
     "Return the latest status earlier than both status1 and status2"
     (make-action-status
      :bits (logand (status-bits status1) (status-bits status2))
-     :stamp (latest-stamp (status-stamp status1) (status-stamp status2))))
+     :stamp (latest-stamp (status-stamp status1) (status-stamp status2))
+     :index (or (status-index status1) (status-index status2))))
 
   (defun mark-status-needed (status)
     "Return the same status but with the need bit set"
@@ -133,7 +139,8 @@ in some previous image, or T if it needs to be done."))
         status
         (make-action-status
          :bits (logior (status-bits status) +need-bit+)
-         :stamp (status-stamp status))))
+         :stamp (status-stamp status)
+         :index (status-index status))))
 
   (defmethod print-object ((status action-status) stream)
     (print-unreadable-object (status stream :type t)
@@ -336,7 +343,8 @@ initialized with SEED."
        :bits (logior (if stamp #.+keep-bit+ 0)
                      (if done-p #.+done-bit+ 0)
                      (if need-p #.+need-bit+ 0))
-       :stamp stamp)))
+       :stamp stamp
+       :index (incf (total-action-count *asdf-session*)))))
 
   ;; TRAVERSE-ACTION, in the context of a given PLAN object that accumulates dependency data,
   ;; visits the action defined by its OPERATION and COMPONENT arguments,
@@ -528,4 +536,5 @@ return a list of the components involved in building the desired action."
             (setf (action-status plan o c)
                   (make-action-status
                    :bits (logior (status-bits perform-status) +done-bit+)
-                   :stamp (status-stamp perform-status)))))))))
+                   :stamp (status-stamp perform-status)
+                   :index (status-index plan-status)))))))))