scratch/elisp-benchmarks 46d7b2fcc6a 29/54: * benchmarks/pack-unpack.el: New file.

[Pip Cet]

branch: scratch/elisp-benchmarks
commit 46d7b2fcc6abb030e8e862d0e875f2b1d62b5441
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * benchmarks/pack-unpack.el: New file.
    
    * elisp-benchmarks.el (elisp-benchmarks-run): Support multiple
    benchmarks per file.
    
    * benchmarks/nbody.el (elb-solar-mass): Avoid obsolete `pi`.
    * benchmarks/pcase.el (<toplevel>): Use `macroexp-file-name`.
---
 elisp-benchmarks/benchmarks/nbody.el       |   9 +-
 elisp-benchmarks/benchmarks/pack-unpack.el | 129 ++++++++++++++++++++++
 elisp-benchmarks/benchmarks/pcase.el       |   9 +-
 elisp-benchmarks/elisp-benchmarks.el       | 169 +++++++++++++++--------------
 4 files changed, 230 insertions(+), 86 deletions(-)

diff --git a/elisp-benchmarks/benchmarks/nbody.el 
b/elisp-benchmarks/benchmarks/nbody.el
index e53e50daca7..6871ca4cc98 100644
--- a/elisp-benchmarks/benchmarks/nbody.el
+++ b/elisp-benchmarks/benchmarks/nbody.el
@@ -1,6 +1,6 @@
-;; -*- lexical-binding: t; -*-
+;;; benchmarks/nbody.el ---   -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -25,7 +25,7 @@
 (require 'cl-lib)
 
 (defconst elb-days-per-year 365.24)
-(defconst elb-solar-mass (* 4 pi pi))
+(defconst elb-solar-mass (* 4 float-pi float-pi))
 
 (cl-defstruct (elb-body (:type vector)
                        (:conc-name nil)
@@ -139,4 +139,5 @@
 (defun elb-nbody-entry ()
   (elb-nbody 300000))
 
-(provide 'elb-nbody)
+(provide 'benchmarks/nbody)
+;;; benchmarks/nbody.el ends here
diff --git a/elisp-benchmarks/benchmarks/pack-unpack.el 
b/elisp-benchmarks/benchmarks/pack-unpack.el
new file mode 100644
index 00000000000..85aa2caa6da
--- /dev/null
+++ b/elisp-benchmarks/benchmarks/pack-unpack.el
@@ -0,0 +1,129 @@
+;;; benchmarks/pack-unpack.el --- Packing and unpacking binary data  -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(eval-and-compile
+  ;; ¡FIXME!  The GNUmakefile of elpa.git uses:
+  ;;
+  ;;    ... -L $(dir $@) -f batch-byte-compile $<
+  ;;
+  ;; to compile each file.  This is handy for some cases such as files in
+  ;; `contrib' subdirectories but for this `pcase.el' file it causes this
+  ;; `pcase.el' to hide the *real* `pcase.el'.  So we workaround this problem
+  ;; here by removing the offending element from `load-path'.  Yuck!
+  ;;
+  ;; We should probably change GNUmakefile instead so it doesn't forcefully
+  ;; add the directory to `load-path', e.g. make this dependent on the
+  ;; presence of special file like `.dont-add-to-load-path'.
+  (let ((file (if (fboundp 'macroexp-file-name) (macroexp-file-name)
+                  (or load-file-name
+                      (bound-and-true-p byte-compile-current-file)))))
+    (when file
+      (setq load-path (remove (file-name-directory file) load-path)))))
+
+(require 'bindat)
+
+(bindat-defmacro ip () "An IPv4 address"     '(vec 4 byte))
+
+(defconst header-bindat-type
+  (bindat-type
+    (dest-ip ip)
+    (src-ip ip)
+    (dest-port uint 16)
+    (src-port uint 16)))
+
+(defconst data-bindat-type
+  (bindat-type
+    (type u8)
+    (opcode u8)
+    (length uintr 16) ;; little endian order
+    (id strz 8)
+    (data vec length)
+    (_ align 4)))
+
+
+(defconst packet-bindat-type
+  (bindat-type
+    (header type header-bindat-type)
+    (items u8)
+    (_ fill 3)
+    (item repeat items
+          (_ type data-bindat-type))))
+
+(defconst struct-bindat
+  '((header
+     (dest-ip . [192 168 1 100])
+     (src-ip . [192 168 1 101])
+     (dest-port . 284)
+     (src-port . 5408))
+    (items . 2)
+    (item ((type . 2)
+           (opcode . 3)
+           (length . 5)
+           (id . "ABCDEF")
+           (data . [1 2 3 4 5]))
+          ((type . 1)
+           (opcode . 4)
+           (length . 7)
+           (id . "BCDEFG")
+           (data . [6 7 8 9 10 11 12])))))
+
+(defun elb-pack-unpack-entry ()
+  (dotimes (_ 10000)
+    (bindat-unpack packet-bindat-type
+                   (bindat-pack packet-bindat-type struct-bindat))))
+
+;;;; Same code but using the old API
+
+(defconst header-bindat-spec
+  '((dest-ip ip)
+    (src-ip ip)
+    (dest-port u16)
+    (src-port u16)))
+
+(defconst data-bindat-spec
+  '((type u8)
+    (opcode u8)
+    (length u16r) ;; little endian order
+    (id strz 8)
+    (data vec (length))
+    (align 4)))
+
+(defconst packet-bindat-spec
+  '((header struct header-bindat-spec)
+    (items u8)
+    (fill 3)
+    (item repeat (items)
+          (struct data-bindat-spec))))
+
+(defun elb-pack-unpack-old-entry ()
+  (dotimes (_ 10000)
+    (bindat-unpack packet-bindat-spec
+                   (bindat-pack packet-bindat-spec struct-bindat))))
+
+
+
+(provide 'benchmarks/pack-unpack)
+;;; benchmarks/pack-unpack.el ends here
diff --git a/elisp-benchmarks/benchmarks/pcase.el 
b/elisp-benchmarks/benchmarks/pcase.el
index 110027accde..bca5de2283e 100644
--- a/elisp-benchmarks/benchmarks/pcase.el
+++ b/elisp-benchmarks/benchmarks/pcase.el
@@ -1,6 +1,6 @@
 ;;; bench/pcase.el --- Exercise code using pcase  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -30,8 +30,11 @@
   ;; We should probably change GNUmakefile instead so it doesn't forcefully
   ;; add the directory to `load-path', e.g. make this dependent on the
   ;; presence of special file like `.dont-add-to-load-path'. 
-  (when load-file-name
-    (setq load-path (remove (file-name-directory load-file-name) load-path))))
+  (let ((file (if (fboundp 'macroexp-file-name) (macroexp-file-name) ;Emacs≥28
+                (or load-file-name
+                    (bound-and-true-p byte-compile-current-file)))))
+    (when file
+      (setq load-path (remove (file-name-directory file) load-path)))))
 
 ;;; Commentary:
 
diff --git a/elisp-benchmarks/elisp-benchmarks.el 
b/elisp-benchmarks/elisp-benchmarks.el
index 112aa495078..51023d60245 100644
--- a/elisp-benchmarks/elisp-benchmarks.el
+++ b/elisp-benchmarks/elisp-benchmarks.el
@@ -1,6 +1,6 @@
 ;;; elisp-benchmarks.el --- elisp benchmarks collection -*- lexical-binding:t 
-*-
 
-;; Copyright (C) 2019-2020  Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021  Free Software Foundation, Inc.
 
 ;; Author: Andrea Corallo <akrl@sdf.org>
 ;; Maintainer: Andrea Corallo <akrl@sdf.org>
@@ -88,84 +88,95 @@ If non nil SELECTOR is a regexp to match the benchmark 
names to be executed.
 The test is repeated RUNS number of times.  If RUNS is nil `elb-runs' is used 
as
 default.
 RECOMPILE all the benchmark folder when non nil."
-  (interactive)
-  (cl-loop with runs = (or runs elb-runs)
-          repeat runs
-          for i from 1
-          named test-loop
-          with comp-speed = elb-speed
-          with compile-function = (if (featurep 'nativecomp)
-                                      #'native-compile
-                                    #'byte-compile-file)
-          with res = (make-hash-table :test #'equal)
-          with sources = (directory-files elb-bench-directory t "\\.el\\'")
-          with tests = (if selector
-                           (cl-loop for f in sources
-                                    when (string-match selector f)
-                                      collect (file-name-base f))
-                         (mapcar #'file-name-base sources))
-          initially
-          ;; Compile
-          (when recompile
-            (mapc (lambda (f)
-                    (message "Compiling... %s" f)
-                    (funcall compile-function f))
-                  sources))
-          ;; Load
-          (mapc #'load (mapcar (if (featurep 'nativecomp)
-                                   #'comp-el-to-eln-filename
-                                 #'file-name-sans-extension)
-                               sources))
-          (cl-loop for test in tests
-                   do (puthash test () res))
-          do
-          (message "Iteration number: %d" i)
-          (cl-loop for test in tests
-                   for entry-point = (intern (concat "elb-" test "-entry"))
-                   do
-                   (garbage-collect)
-                   (message "Running %s..." test)
-                   (push (eval `(benchmark-run nil (,entry-point)) t)
-                         (gethash test res)))
-          finally
-          (pop-to-buffer elb-result-buffer-name)
-          (erase-buffer)
-          (insert "* Results\n\n")
-          (insert "  |test|non-gc avg (s)|gc avg (s)|gcs avg|tot avg (s)|tot 
avg err (s)\n")
-          (insert "|-\n")
-          (cl-loop for test in tests
-                   for l = (gethash test res)
-                   for test-elapsed = (cl-loop for x in l sum (car x))
-                   for test-gcs = (cl-loop for x in l sum (cadr x))
-                   for test-gc-elapsed = (cl-loop for x in l sum (caddr x))
-                   for test-err = (elb-std-deviation (mapcar #'car l))
-                   do
-                   (insert (apply #'format "|%s|%.2f|%.2f|%d|%.2f" test
-                                  (mapcar (lambda (x) (/ x runs))
-                                          (list (- test-elapsed 
test-gc-elapsed)
-                                                test-gc-elapsed test-gcs
-                                                test-elapsed))))
-                   (insert (format "|%.2f\n" test-err))
-                   summing test-elapsed into elapsed
-                   summing test-gcs into gcs
-                   summing test-gc-elapsed into gc-elapsed
-                   collect test-err into errs
-                   finally
-                   (insert "|-\n")
-                   (insert (apply #'format "|total|%.2f|%.2f|%d|%.2f"
-                                  (mapcar (lambda (x) (/ x runs))
-                                          (list (- elapsed gc-elapsed)
-                                                gc-elapsed gcs elapsed))))
-                   (insert (format "|%.2f\n"
-                                   (sqrt (apply #'+ (mapcar (lambda (x)
-                                                           (expt x 2))
-                                                         errs))))))
-          (org-table-align)
-          (goto-char (point-min))
-          (if noninteractive
-              (message (buffer-string))
-            (org-mode)
-            (outline-show-subtree))))
+  (interactive
+   (when current-prefix-arg
+     (list (read-regexp "Run benchmark matching: "))))
+  (let* ((comp-speed elb-speed)
+        (compile-function (if (fboundp 'native-compile)
+                              #'native-compile
+                            #'byte-compile-file))
+        (res (make-hash-table :test #'equal))
+        (sources (directory-files elb-bench-directory t "\\.el\\'"))
+        (test-sources (if selector
+                          (cl-loop for f in sources
+                                   when (string-match selector f)
+                                   collect f)
+                        sources)))
+    ;; Compile
+    (when recompile
+      (mapc (lambda (f)
+             (message "Compiling... %s" f)
+             (funcall compile-function f))
+           test-sources))
+    ;; Load
+    (mapc #'load (mapcar (if (and (featurep 'nativecomp)
+                                 (fboundp 'comp-el-to-eln-filename))
+                            ;; FIXME: Isn't the elc->eln
+                             ;; remapping fully automatic?
+                            #'comp-el-to-eln-filename
+                          #'file-name-sans-extension)
+                        test-sources))
+    (let ((tests (let ((names '()))
+                  (mapatoms (lambda (s)
+                             (let ((name (symbol-name s)))
+                               (when (string-match
+                                      "\\`elb-\\(.*\\)-entry\\'" name)
+                                 (push (match-string 1 name) names)))))
+                  names)))
+      ;; (cl-loop for test in tests
+      ;;          do (puthash test () res))
+      (cl-loop with runs = (or runs elb-runs)
+              repeat runs
+              for i from 1
+              named test-loop
+              do
+              (message "Iteration number: %d" i)
+              (cl-loop for test in tests
+                       for entry-point = (intern (concat "elb-" test "-entry"))
+                       do
+                       (garbage-collect)
+                       (message "Running %s..." test)
+                       (push (eval `(benchmark-run nil (,entry-point)) t)
+                             (gethash test res)))
+              finally
+              (pop-to-buffer elb-result-buffer-name)
+              (erase-buffer)
+              (insert "* Results\n\n")
+              (insert "  |test|non-gc avg (s)|gc avg (s)|gcs avg|tot avg 
(s)|tot avg err (s)\n")
+              (insert "|-\n")
+              (cl-loop for test in tests
+                       for l = (gethash test res)
+                       for test-elapsed = (cl-loop for x in l sum (car x))
+                       for test-gcs = (cl-loop for x in l sum (cadr x))
+                       for test-gc-elapsed = (cl-loop for x in l sum (caddr x))
+                       for test-err = (elb-std-deviation (mapcar #'car l))
+                       do
+                       (insert (apply #'format "|%s|%.2f|%.2f|%d|%.2f" test
+                                      (mapcar (lambda (x) (/ x runs))
+                                              (list (- test-elapsed 
test-gc-elapsed)
+                                                    test-gc-elapsed test-gcs
+                                                    test-elapsed))))
+                       (insert (format "|%.2f\n" test-err))
+                       summing test-elapsed into elapsed
+                       summing test-gcs into gcs
+                       summing test-gc-elapsed into gc-elapsed
+                       collect test-err into errs
+                       finally
+                       (insert "|-\n")
+                       (insert (apply #'format "|total|%.2f|%.2f|%d|%.2f"
+                                      (mapcar (lambda (x) (/ x runs))
+                                              (list (- elapsed gc-elapsed)
+                                                    gc-elapsed gcs elapsed))))
+                       (insert (format "|%.2f\n"
+                                       (sqrt (apply #'+ (mapcar (lambda (x)
+                                                                  (expt x 2))
+                                                                errs))))))
+              (org-table-align)
+              (goto-char (point-min))
+              (if noninteractive
+                  (message (buffer-string))
+                (org-mode)
+                (outline-show-subtree))))))
 
 (provide 'elisp-benchmarks)
 ;;; elisp-benchmarks.el ends here