diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index d5a0118b7c..0cb247fc19 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3485,6 +3485,7 @@ completion-pcm--hilit-commonality
     (let* ((re (completion-pcm--pattern->regex pattern 'group))
            (point-idx (completion-pcm--pattern-point-idx pattern))
            (case-fold-search completion-ignore-case)
+           (score (make-vector 3 0))
            last-md)
       (mapcar
        (lambda (str)
@@ -3531,37 +3532,17 @@ completion-pcm--hilit-commonality
                 ;;    (SUM_across_i(hole_i_contrib) + 1) * len
                 ;;
                 ;; , where "len" is the string's length.
-                (score-numerator 0)
-                (score-denominator 0)
-                (last-b 0)
-                (update-score-and-face
-                 (lambda (a b)
-                   "Update score and face given match range (A B)."
-                   (add-face-text-property a b
-                                           'completions-common-part
-                                           nil str)
-                   (setq
-                    score-numerator   (+ score-numerator (- b a)))
-                   (unless (or (= a last-b)
-                               (zerop last-b)
-                               (= a (length str)))
-                     (setq
-                      score-denominator (+ score-denominator
-                                           1
-                                           (expt (- a last-b 1)
-                                                 (/ 1.0
-                                                    flex-score-match-tightness)))))
-                   (setq
-                    last-b              b))))
+                )
+           (fillarray score 0)
            (while md
-             (funcall update-score-and-face from (pop md))
+             (completion-pcm--update-score-and-face str from (pop md) score)
              (setq from (pop md)))
            ;; If `pattern' doesn't have an explicit trailing any, the
            ;; regex `re' won't produce match data representing the
            ;; region after the match.  We need to account to account
            ;; for that extra bit of match (bug#42149).
            (unless (= from match-end)
-             (funcall update-score-and-face from match-end))
+             (completion-pcm--update-score-and-face str from match-end score))
            (if (> (length str) pos)
                (add-face-text-property
                 pos (1+ pos)
@@ -3570,10 +3551,35 @@ completion-pcm--hilit-commonality
            (unless (zerop (length str))
              (put-text-property
               0 1 'completion-score
-              (/ score-numerator (* end (1+ score-denominator)) 1.0) str)))
+              (/ (completion-pcm--score-numerator score)
+                 (* end (1+ (completion-pcm--score-denominator score)))
+                 1.0)
+              str)))
          str)
        completions))))
 
+(cl-defstruct (completion-pcm--score (:type vector))
+  (numerator 0) (denominator 0) (last-b 0))
+
+(defun completion-pcm--update-score-and-face (str a b score)
+  "Update score and face in STR given match range (A B)."
+  (add-face-text-property a b
+                          'completions-common-part
+                          nil str)
+  (let ((last-b (completion-pcm--score-last-b score)))
+    (setf (completion-pcm--score-numerator score)
+          (+ (completion-pcm--score-numerator score) (- b a)))
+    (unless (or (= a last-b)
+                (zerop last-b)
+                (= a (length str)))
+      (setf (completion-pcm--score-denominator score)
+            (+ (completion-pcm--score-denominator score)
+               1
+               (expt (- a last-b 1)
+                     (/ 1.0
+                        flex-score-match-tightness)))))
+    (setf (completion-pcm--score-last-b score) b)))
+
 (defun completion-pcm--find-all-completions (string table pred point
                                                     &optional filter)
   "Find all completions for STRING at POINT in TABLE, satisfying PRED.
@@ -3980,7 +3986,7 @@ completion-flex-all-completions
                   string table pred point
                   #'completion-flex--make-flex-pattern)))
       (when all
-        (nconc (completion-pcm--hilit-commonality pattern all)
+        (nconc (benchmark-progn (completion-pcm--hilit-commonality pattern all))
                (length prefix))))))
 
 ;; Initials completion