* lisp/emacs-lisp/benchmark.el (benchmark-call): New function

(benchmark-run, benchmark-run-compiled, benchmark): Use it.
(benchmark--adaptive): New internal function.

3 files changed, 74 insertions, 32 deletions

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 8e4b0ebfe96..de98d2206e2 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -1041,7 +1041,8 @@ functions written in Lisp, it cannot profile Emacs primitives.
 @cindex @file{benchmark.el}
 @cindex benchmarking
 You can measure the time it takes to evaluate individual Emacs Lisp
-forms using the @file{benchmark} library.  See the macros
+forms using the @file{benchmark} library.  See the function
+@code{benchmark-call} as well as the macros
 @code{benchmark-run}, @code{benchmark-run-compiled} and
 @code{benchmark-progn} in @file{benchmark.el}.  You can also use the
 @code{benchmark} command for timing forms interactively.
diff --git a/etc/NEWS b/etc/NEWS
index 6fe98dbc123..27a4766a402 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -389,6 +389,11 @@ major mode.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** Benchmark
+*** New function 'benchmark-call' to measure the execution time of a function.
+Additionally, the number of repetitions can be expressed as a minimal duration
+in seconds.
+
 ** Macroexp
 ---
 *** New function 'macroexp-file-name' to know the name of the current file.
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 2a3efbe5a1b..439d3bd363e 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -31,6 +31,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'subr-x))   ;For `named-let'.
+
 (defmacro benchmark-elapse (&rest forms)
   "Return the time in seconds elapsed for execution of FORMS."
   (declare (indent 0) (debug t))
@@ -41,6 +43,61 @@
        (float-time (time-since ,t1)))))
 
 ;;;###autoload
+(defun benchmark-call (func &optional repetitions)
+  "Measure the run time of calling FUNC a number REPETITIONS of times.
+The result is a list (TIME GC GCTIME)
+where TIME is the total time it took, in seconds.
+GCTIME is the amount of time that was spent in the GC
+and GC is the number of times the GC was called.
+
+REPETITIONS can also be a floating point number, in which case it
+specifies a minimum number of seconds that the benchmark execution
+should take.  In that case the return value is prepended with the
+number of repetitions actually used."
+  (if (floatp repetitions)
+      (benchmark--adaptive func repetitions)
+    (unless repetitions (setq repetitions 1))
+    (let ((gc gc-elapsed)
+          (gcs gcs-done)
+          (empty-func (lambda () 'empty-func)))
+      (list
+       (if (> repetitions 1)
+           (- (benchmark-elapse (dotimes (_ repetitions) (funcall func)))
+              (benchmark-elapse (dotimes (_ repetitions) (funcall empty-func))))
+         (- (benchmark-elapse (funcall func))
+            (benchmark-elapse (funcall empty-func))))
+       (- gcs-done gcs)
+       (- gc-elapsed gc)))))
+
+(defun benchmark--adaptive (func time)
+  "Measure the run time of FUNC, calling it enough times to last TIME seconds.
+Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'."
+  (named-let loop ((repetitions 1)
+                   (data (let ((x (list 0))) (setcdr x x) x)))
+    ;; (message "Running %d iteration" repetitions)
+    (let ((newdata (benchmark-call func repetitions)))
+      (if (<= (car newdata) 0)
+          ;; This can happen if we're unlucky, e.g. the process got preempted
+          ;; (or the GC ran) just during the empty-func loop.
+          ;; Just try again, hopefully this won't repeat itself.
+          (progn
+            ;; (message "Ignoring the %d iterations" repetitions)
+            (loop (* 2 repetitions) data))
+        (let* ((sum (cl-mapcar #'+ data (cons repetitions newdata)))
+               (totaltime (nth 1 sum)))
+          (if (>= totaltime time)
+              sum
+            (let* ((iter-time (/ totaltime (car sum)))
+                   (missing-time (- time totaltime))
+                   (missing-iter (/ missing-time iter-time)))
+              ;; `iter-time' is approximate because of effects like the GC,
+              ;; so multiply at most by 10, in case we are wildly off the mark.
+              (loop (max repetitions
+                         (min (ceiling missing-iter)
+                              (* 10 repetitions)))
+                    sum))))))))
+
+;;;###autoload
 (defmacro benchmark-run (&optional repetitions &rest forms)
   "Time execution of FORMS.
 If REPETITIONS is supplied as a number, run FORMS that many times,
@@ -53,20 +110,7 @@ See also `benchmark-run-compiled'."
   (unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
     (setq forms (cons repetitions forms)
           repetitions 1))
-  (let ((i (make-symbol "i"))
-        (gcs (make-symbol "gcs"))
-        (gc (make-symbol "gc")))
-    `(let ((,gc gc-elapsed)
-           (,gcs gcs-done))
-       (list ,(if (or (symbolp repetitions) (> repetitions 1))
-                  ;; Take account of the loop overhead.
-                  `(- (benchmark-elapse (dotimes (,i ,repetitions)
-                                          ,@forms))
-                      (benchmark-elapse (dotimes (,i ,repetitions)
-                                          nil)))
-                `(benchmark-elapse ,@forms))
-             (- gcs-done ,gcs)
-             (- gc-elapsed ,gc)))))
+  `(benchmark-call (lambda () ,@forms) ,repetitions))
 
 ;;;###autoload
 (defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -78,21 +122,7 @@ result.  The overhead of the `lambda's is accounted for."
   (unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
     (setq forms (cons repetitions forms)
           repetitions 1))
-  (let ((i (make-symbol "i"))
-        (gcs (make-symbol "gcs"))
-        (gc (make-symbol "gc"))
-        (code (byte-compile `(lambda () ,@forms)))
-        (lambda-code (byte-compile '(lambda ()))))
-    `(let ((,gc gc-elapsed)
-           (,gcs gcs-done))
-       (list ,(if (or (symbolp repetitions) (> repetitions 1))
-                  ;; Take account of the loop overhead.
-                  `(- (benchmark-elapse (dotimes (,i ,repetitions)
-                                          (funcall ,code)))
-                      (benchmark-elapse (dotimes (,i ,repetitions)
-                                          (funcall ,lambda-code))))
-                `(benchmark-elapse (funcall ,code)))
-             (- gcs-done ,gcs) (- gc-elapsed ,gc)))))
+  `(benchmark-call (byte-compile '(lambda () ,@forms)) ,repetitions))
 
 ;;;###autoload
 (defun benchmark (repetitions form)
@@ -100,9 +130,15 @@ result.  The overhead of the `lambda's is accounted for."
 Interactively, REPETITIONS is taken from the prefix arg, and
 the command prompts for the form to benchmark.
 For non-interactive use see also `benchmark-run' and
-`benchmark-run-compiled'."
+`benchmark-run-compiled'.
+FORM can also be a function in which case we measure the time it takes
+to call it without any argument."
   (interactive "p\nxForm: ")
-  (let ((result (eval `(benchmark-run ,repetitions ,form) t)))
+  (let ((result (benchmark-call (eval (pcase form
+                                        ((or `#',_ `(lambda . ,_)) form)
+                                        (_ `(lambda () ,form)))
+                                      t)
+                                repetitions)))
     (if (zerop (nth 1 result))
         (message "Elapsed time: %fs" (car result))
       (message "Elapsed time: %fs (%fs in %d GCs)" (car result)