[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/elisp-benchmarks c10f416: * benchmarks/pack-unpack.el:
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/elisp-benchmarks c10f416: * benchmarks/pack-unpack.el: New file. |
|
Date: |
Wed, 17 Mar 2021 18:36:25 -0400 (EDT) |
branch: externals/elisp-benchmarks
commit c10f4162ea9945e4b3a9e53dafa8f3587ac1ad7f
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`.
---
benchmarks/nbody.el | 9 +--
benchmarks/pack-unpack.el | 129 +++++++++++++++++++++++++++++++++++
benchmarks/pcase.el | 9 ++-
elisp-benchmarks.el | 169 ++++++++++++++++++++++++----------------------
4 files changed, 230 insertions(+), 86 deletions(-)
diff --git a/benchmarks/nbody.el b/benchmarks/nbody.el
index e53e50d..6871ca4 100644
--- a/benchmarks/nbody.el
+++ b/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/benchmarks/pack-unpack.el b/benchmarks/pack-unpack.el
new file mode 100644
index 0000000..85aa2ca
--- /dev/null
+++ b/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/benchmarks/pcase.el b/benchmarks/pcase.el
index 110027a..bca5de2 100644
--- a/benchmarks/pcase.el
+++ b/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.el b/elisp-benchmarks.el
index 112aa49..51023d6 100644
--- a/elisp-benchmarks.el
+++ b/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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/elisp-benchmarks c10f416: * benchmarks/pack-unpack.el: New file.,
Stefan Monnier <=