diff --git a/find-system.lisp b/find-system.lisp
index 8203a30c4f2df27e5734d6c8f31990498ba60b31..7b56b083c3cb25acbaed13ccabcb05a8e0610334 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -256,9 +256,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
       (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))
+        (dolist (o `(,@(when (primary-system-p component) '(define-op))
                        prepare-op compile-op load-op))
           (setf (gethash (make-operation o) times) 0))))))
 
diff --git a/system.lisp b/system.lisp
index d2d7cfb94af682d4c5db7615de5e8f7f0112d0e6..94f71a05c6b6619f40a6aaa96f57ad85cdb81914 100644
--- a/system.lisp
+++ b/system.lisp
@@ -18,7 +18,7 @@
    #:mailto #:system-mailto
    #:long-name #:system-long-name
    #:source-control #:system-source-control
-   #:coerce-name #:primary-system-name #:coerce-filename
+   #:coerce-name #:primary-system-name #:primary-system-p #:coerce-filename
    #:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system
 (in-package :asdf/system)
 
@@ -123,11 +123,21 @@ a SYMBOL (designing its name, downcased), or a STRING (designing itself)."
       (string name)
       (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
 
-  (defun primary-system-name (name)
+  (defun primary-system-name (system-designator)
     "Given a system designator NAME, return the name of the corresponding primary system,
 after which the .asd file is named. That's the first component when dividing the name
-as a string by / slashes."
-    (first (split-string (coerce-name name) :separator "/")))
+as a string by / slashes. A component designates its system."
+    (etypecase system-designator
+      (string (if-let (p (position #\/ system-designator))
+                (subseq system-designator 0 p) system-designator))
+      (component (primary-system-name (coerce-name (component-system system-designator))))))
+
+  (defun primary-system-p (system)
+    "Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.
+Also return NIL if system is neither a SYSTEM nor a string designating one."
+    (typecase system
+      (string (not (find #\/ system)))
+      (system (primary-system-p (coerce-name system)))))
 
   (defun coerce-filename (name)
     "Coerce a system designator NAME into a string suitable as a filename component.