Function: profiler-calltree-build-unified

profiler-calltree-build-unified is a byte-compiled function defined in profiler.el.gz.

Signature

(profiler-calltree-build-unified TREE LOG)

Source Code

;; Defined in /usr/src/emacs/lisp/profiler.el.gz
(defun profiler-calltree-build-unified (tree log)
  ;; Let's try to unify all those partial backtraces into a single
  ;; call tree.  First, we record in fun-map all the functions that appear
  ;; in `log' and where they appear.
  (let ((fun-map (make-hash-table :test 'profiler-function-equal))
        (parent-map (make-hash-table :test 'eq))
        (leftover-tree (profiler-make-calltree
                        :entry '... :parent tree)))
    (push leftover-tree (profiler-calltree-children tree))
    (maphash
     (lambda (backtrace _count)
       (let ((max (length backtrace)))
         ;; Don't record the head elements in there, since we want to use this
         ;; fun-map to find parents of partial backtraces, but parents only
         ;; make sense if they have something "above".
         (dotimes (i (1- max))
           (let ((f (aref backtrace i)))
             (when f
               (push (cons i backtrace) (gethash f fun-map)))))))
     log)
    ;; Then, for each partial backtrace, try to find a parent backtrace
    ;; (i.e. a backtrace that describes (part of) the truncated part of
    ;; the partial backtrace).  For a partial backtrace like "[f3 f2 f1]" (f3
    ;; is deeper), any backtrace that includes f1 could be a parent; and indeed
    ;; the counts of this partial backtrace could each come from a different
    ;; parent backtrace (some of which may not even be in `log').  So we should
    ;; consider each backtrace that includes f1 and give it some percentage of
    ;; `count'.  But we can't know for sure what percentage to give to each
    ;; possible parent.
    ;; The "right" way might be to give a percentage proportional to the counts
    ;; already registered for that parent, or some such statistical principle.
    ;; But instead, we will give all our counts to a single "best
    ;; matching" parent.  So let's look for the best matching parent, and store
    ;; the result in parent-map.
    ;; Using the "best matching parent" is important also to try and avoid
    ;; stitching together backtraces that can't possibly go together.
    ;; For example, when the head is `apply' (or `mapcar', ...), we want to
    ;; make sure we don't just use any parent that calls `apply', since most of
    ;; them would never, in turn, cause apply to call the subsequent function.
    (maphash
     (lambda (backtrace _count)
       (let* ((max (1- (length backtrace)))
              (head (aref backtrace max))
              (best-parent nil)
              (best-match (1+ max))
              (parents (gethash head fun-map)))
         (pcase-dolist (`(,i . ,parent) parents)
           (when t ;; (<= (- max i) best-match) ;Else, it can't be better.
             (let ((match max)
                   (imatch i))
               (cl-assert (>= match imatch))
               (cl-assert (function-equal (aref backtrace max)
                                          (aref parent i)))
               (while (progn
                        (decf imatch) (decf match)
                        (when (> imatch 0)
                          (function-equal (aref backtrace match)
                                          (aref parent imatch)))))
               (when (< match best-match)
                 (cl-assert (<= (- max i) best-match))
                 ;; Let's make sure this parent is not already our child: we
                 ;; don't want cycles here!
                 (let ((valid t)
                       (tmp-parent parent))
                   (while (setq tmp-parent
                                (if (eq tmp-parent backtrace)
                                    (setq valid nil)
                                  (cdr (gethash tmp-parent parent-map)))))
                   (when valid
                     (setq best-match match)
                     (setq best-parent (cons i parent))))))))
         (puthash backtrace best-parent parent-map)))
     log)
    ;; Now we have a single parent per backtrace, so we have a unified tree.
    ;; Let's build the actual call-tree from it.
    (maphash
     (lambda (backtrace count)
       (let ((node tree)
             (parents (list (cons -1 backtrace)))
             (tmp backtrace)
             (max (length backtrace)))
         (while (setq tmp (gethash tmp parent-map))
           (push tmp parents)
           (setq tmp (cdr tmp)))
         (when (aref (cdar parents) (1- max))
           (incf (profiler-calltree-count leftover-tree) count)
           (setq node leftover-tree))
         (pcase-dolist (`(,i . ,parent) parents)
           (let ((j (1- max)))
             (while (> j i)
               (let ((f (aref parent j)))
                 (decf j)
                 (when f
                   (let ((child (profiler-calltree-find node f)))
                     (unless child
                       (setq child (profiler-make-calltree
                                    :entry f :parent node))
                       (push child (profiler-calltree-children node)))
                     (incf (profiler-calltree-count child) count)
                     (setq node child)))))))))
     log)))