Adding measurement of garbage collection time

benchmark-init-modes.el

@@ -78,8 +78,11 @@
    ("ms" 7 (lambda (a b) (< (string-to-number (aref (cadr a) 2))
                             (string-to-number (aref (cadr b) 2))))
     :right-align t)
-   ("total ms" 7 (lambda (a b) (< (string-to-number (aref (cadr a) 3))
-                                  (string-to-number (aref (cadr b) 3))))
+   ("gc ms" 7 (lambda (a b) (< (string-to-number (aref (cadr a) 3))
+                               (string-to-number (aref (cadr b) 3))))
+    :right-align t)
+   ("total ms" 7 (lambda (a b) (< (string-to-number (aref (cadr a) 4))
+                                  (string-to-number (aref (cadr b) 4))))
     :right-align t)]
   "Benchmark list format.")
 
@@ -121,9 +124,12 @@
        (let ((name (cdr (assq :name value)))
              (type (symbol-name (cdr (assq :type value))))
              (duration (round (cdr (assq :duration value))))
-             (duration-adj (round (cdr (assq :duration-adj value)))))
+             (duration-adj (round (cdr (assq :duration-adj value))))
+             (gc-duration-adj (round (cdr (assq :gc-duration-adj value)))))
          (push (list name `[,name ,type ,(number-to-string duration-adj)
-                                  ,(number-to-string duration)]) entries)))
+                                  ,(number-to-string gc-duration-adj)
+                                  ,(number-to-string duration)])
+               entries)))
      (cdr (benchmark-init/flatten benchmark-init/display-root)))
     entries))
 
@@ -156,13 +162,16 @@ defaults to `benchmark-init/durations-tree'."
   "Print PADDING followed by NODE."
   (let ((name (benchmark-init/node-name node))
         (type (symbol-name (benchmark-init/node-type node)))
-        (duration (benchmark-init/node-duration-adjusted node)))
+        (duration (benchmark-init/node-duration-adjusted node))
+        (gc-duration (benchmark-init/node-gc-duration-adjusted node)))
     (insert padding "["
             (propertize (format "%s" name)
                         'face 'benchmark-init/name-face)
             " " (propertize (format "%s" type)
                             'face 'benchmark-init/type-face)
-            " " (propertize (format "%dms" (round duration))
+            " " (propertize (format "%dms gc:%dms"
+                                    (round duration)
+                                    (round gc-duration))
                             'face 'benchmark-init/duration-face)
             "]\n")))
 

benchmark-init.el

@@ -75,12 +75,13 @@
 `type' Entry type, such as 'require or 'load.
 `duration' Duration in milliseconds.
 `children' Nodes loaded by this one."
-  name type duration children)
+  name type duration gc-duration children)
 
 (defvar benchmark-init/durations-tree (make-benchmark-init/node
                                        :name 'benchmark-init/root
                                        :type nil
                                        :duration 0
+                                       :gc-duration 0
                                        :children nil)
   "Recorded durations stored in a tree.")
 
@@ -93,11 +94,12 @@
   "Calculate the number of milliseconds that have elapsed between B and A."
   (* 1000.0 (float-time (time-subtract b a))))
 
 (defun benchmark-init/flatten (node)
   "Flatten NODE into a property list."
   (let ((node-alist `((:name . ,(benchmark-init/node-name node))
                       (:type . ,(benchmark-init/node-type node))
                       (:duration . ,(benchmark-init/node-duration node))
+                      (:gc-duration-adj . ,(benchmark-init/node-gc-duration-adjusted node))
                       (:duration-adj . ,(benchmark-init/node-duration-adjusted
                                          node))))
         (children (benchmark-init/node-children node))
@@ -113,25 +115,41 @@
 
 (defun benchmark-init/node-duration-adjusted (node)
   "Duration of NODE with child durations removed."
-  (let ((duration (benchmark-init/node-duration node))
-        (child-durations (benchmark-init/sum-node-durations
-                          (benchmark-init/node-children node))))
-    (if (benchmark-init/node-root-p node) child-durations
-      (- duration child-durations))))
+  (let* ((children (benchmark-init/node-children node))
+         (duration (benchmark-init/node-duration node))
+         (child-durations (benchmark-init/sum-node-durations children)))
+    (if (benchmark-init/node-root-p node)
+        (- child-durations (benchmark-init/sum-node-gc-durations children))
+      (- duration child-durations (benchmark-init/node-gc-duration node)))))
 
 (defun benchmark-init/sum-node-durations (nodes)
   "Return the sum of NODES durations."
   (let ((accum 0))
     (dolist (node nodes accum)
       (setq accum (+ (benchmark-init/node-duration node) accum)))))
 
+(defun benchmark-init/node-gc-duration-adjusted (node)
+  "GC duration of NODE with child durations removed."
+  (let ((gc-duration (benchmark-init/node-gc-duration node))
+        (child-gc-durations (benchmark-init/sum-node-gc-durations
+                             (benchmark-init/node-children node))))
+    (if (benchmark-init/node-root-p node) child-gc-durations
+      (- gc-duration child-gc-durations))))
+
+(defun benchmark-init/sum-node-gc-durations (nodes)
+  "Return the sum of NODES gc durations."
+  (let ((accum 0))
+    (dolist (node nodes accum)
+      (setq accum (+ (benchmark-init/node-gc-duration node) accum)))))
+
 ;; Benchmark helpers
 
 (defun benchmark-init/begin-measure (name type)
   "Begin measuring NAME of TYPE."
   (let ((parent benchmark-init/current-node)
         (node (make-benchmark-init/node :name name :type type
                                         :duration (current-time)
+                                        :gc-duration gc-elapsed
                                         :children nil)))
     (setq benchmark-init/current-node node)
     parent))
@@ -141,9 +159,14 @@
   (let ((node benchmark-init/current-node)
         (duration (benchmark-init/time-subtract-millis
                    (current-time)
-                   (benchmark-init/node-duration benchmark-init/current-node))))
+                   (benchmark-init/node-duration benchmark-init/current-node)))
+        (gc-duration (* 1000
+                        (- gc-elapsed
+                           (benchmark-init/node-gc-duration
+                            benchmark-init/current-node)))))
     (when (funcall should-record-p)
-      (setf (benchmark-init/node-duration node) duration)
+      (setf (benchmark-init/node-duration node) duration
+            (benchmark-init/node-gc-duration node) gc-duration)
       (push node (benchmark-init/node-children parent)))
     (setq benchmark-init/current-node parent)))