all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [ELPA][PATCH] elisp-benchmarks: add dhrystone and nbody
@ 2020-03-14 17:46 Luca Nassi
  2020-03-14 19:28 ` Andrea Corallo
  0 siblings, 1 reply; 5+ messages in thread
From: Luca Nassi @ 2020-03-14 17:46 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 697 bytes --]

Hi all,

I would like to submit patches for the elisp-benchmarks package, to
which I have added two new tests:

- dhrystone: a very famous synthetic benchmark, translated from C
- nbody: simulation of the solar system, translated from CL

The original sources of both benchmarks are linked in comments of the
attached patches.

On the license side, nbody was translated from the same source as
pidigits, which has already been checked and included in the package,
while I was not able to find precise information about dhrystone,
besides it being "in public domain".

By the way, I have recently completed myself the procedure for copyright
assignment.

Thanks in advance for the feedback,

Luca


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: dhrystone.patch --]
[-- Type: text/x-patch, Size: 10636 bytes --]

diff --git a/benchmarks/dhrystone.el b/benchmarks/dhrystone.el
new file mode 100644
index 0000000..123ed19
--- /dev/null
+++ b/benchmarks/dhrystone.el
@@ -0,0 +1,305 @@
+;; -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Porting to elisp of the famous Dhrystone benchmark
+;;
+;; Adapted from C version:
+;; https://github.com/Keith-S-Thompson/dhrystone/blob/master/v2.2/dry.c
+
+(require 'cl-lib)
+
+(cl-defstruct dhry-record
+  discr
+  variant)
+
+(cl-defstruct dhry-var-1
+  enum-comp
+  int-comp
+  str-comp)
+
+(cl-defstruct dhry-var-2
+  e-comp-2
+  str-2-comp)
+
+(cl-defstruct dhry-var-3
+  ch-1-comp
+  ch-2-comp)
+
+(defvar dhry-ptr-glob)
+(defvar dhry-next-ptr-glob)
+(defvar dhry-int-glob)
+(defvar dhry-bool-glob)
+(defvar dhry-ch-1-glob)
+(defvar dhry-ch-2-glob)
+(defvar dhry-arr-1-glob)
+(defvar dhry-arr-2-glob)
+
+(defun dhry-structassign (dst src)
+  (setf (cdr dst) (cdr src))
+  (let ((src-record (car src))
+	(dst-record (car dst)))
+    (setf (dhry-record-discr dst-record)
+	  (dhry-record-discr src-record))
+    (let ((type (dhry-record-discr src-record))
+	  (src-variant (dhry-record-variant src-record))
+	  (dst-variant (dhry-record-variant dst-record)))
+      (cl-case type
+	(0
+	 (setf (dhry-var-1-int-comp dst-variant)
+	       (dhry-var-1-int-comp src-variant))
+	 (setf (dhry-var-1-enum-comp dst-variant)
+	       (dhry-var-1-enum-comp src-variant))
+	 (store-substring (dhry-var-1-str-comp dst-variant)
+			  0
+			  (dhry-var-1-str-comp src-variant)))
+	(1
+	 (setf (dhry-var-2-e-comp-2 dst-variant)
+	       (dhry-var-2-e-comp-2 src-variant))
+	 (store-substring (dhry-var-2-str-2-comp dst-variant)
+			  0
+			  (dhry-var-2-str-2-comp src-variant)))
+	(2
+	 (setf (dhry-var-3-ch-1-comp dst-variant)
+	       (dhry-var-3-ch-1-comp src-variant))
+	 (setf (dhry-var-3-ch-2-comp dst-variant)
+	       (dhry-var-3-ch-2-comp src-variant)))))))
+
+(defun dhry-proc-1 (ptr-val-par)
+  (let ((next-record (cdr ptr-val-par)))
+    (dhry-structassign (cdr ptr-val-par) dhry-ptr-glob)
+    (setf (dhry-var-1-int-comp (dhry-record-variant (car ptr-val-par))) 5)
+    (setf (dhry-var-1-int-comp (dhry-record-variant (car next-record)))
+	  (dhry-var-1-int-comp (dhry-record-variant (car ptr-val-par))))
+    (setf (cdr next-record) (dhry-proc-3 (cdr next-record)))
+    (if (= (dhry-record-discr (car next-record)) 0)
+	(progn
+	  (setf (dhry-var-1-int-comp (dhry-record-variant (car next-record))) 6)
+	  (setf (dhry-var-1-enum-comp (dhry-record-variant (car next-record)))
+		(dhry-proc-6 (dhry-var-1-enum-comp (dhry-record-variant (car ptr-val-par)))))
+	  (setf (cdr next-record) (cdr dhry-ptr-glob))
+	  (setf (dhry-var-1-int-comp (dhry-record-variant (car next-record)))
+		(dhry-proc-7 (dhry-var-1-int-comp (dhry-record-variant (car next-record))) 10)))
+      (dhry-structassign ptr-val-par (cdr ptr-val-par)))))
+
+(defun dhry-proc-2 (int-par-ref)
+  (let (int-loc enum-loc)
+    (setq int-loc (+ int-par-ref 10))
+    (cl-loop when (= dhry-ch-1-glob ?A)
+	     do (cl-decf int-loc)
+	        (setq int-par-ref (- int-loc dhry-int-glob))
+	        (setq enum-loc 0)
+	     while (/= enum-loc 0))
+    int-par-ref))
+
+(defun dhry-proc-3 (ptr-ref-par)
+  (let ((ret ptr-ref-par))
+    (when dhry-ptr-glob
+      (setq ret (cdr dhry-ptr-glob)))
+    (setf (dhry-var-1-int-comp (dhry-record-variant (car dhry-ptr-glob))) (dhry-proc-7 10 dhry-int-glob))
+    ret))
+
+(defun dhry-proc-4 ()
+  (let (bool-loc)
+    (setq bool-loc (= dhry-ch-1-glob ?A))
+    (setq dhry-bool-glob (or bool-loc dhry-bool-glob))
+    (setq dhry-ch-2-glob ?B)))
+
+(defun dhry-proc-5 ()
+  (setq dhry-ch-1-glob ?A)
+  (setq dhry-bool-glob nil))
+
+(defun dhry-proc-6 (enum-val-par)
+  (let (enum-ref-par)
+    (setq enum-ref-par enum-val-par)
+    (unless (dhry-func-3 enum-val-par)
+      (setq enum-ref-par 3))
+    (cl-case enum-val-par
+      (0
+       (setq enum-ref-par 0))
+      (1
+       (if (> dhry-int-glob 100)
+	   (setq enum-ref-par 0)
+	 (setq enum-ref-par 3)))
+      (2
+       (setq enum-ref-par 1))
+      (3
+       nil)
+      (4
+       (setq enum-ref-par 2)))
+    enum-ref-par))
+
+(defun dhry-proc-7 (int-1-par-val int-2-par-val)
+  (let (int-loc)
+    (setq int-loc (+ int-1-par-val 2))
+    (+ int-2-par-val int-loc)))
+
+(defun dhry-proc-8 (arr-1-par-ref arr-2-par-ref int-1-par-val int-2-par-val)
+  (let (int-loc)
+    (setq int-loc (+ int-1-par-val 5))
+    (setf (aref arr-1-par-ref int-loc) int-2-par-val)
+    (setf (aref arr-1-par-ref (1+ int-loc)) (aref arr-1-par-ref int-loc))
+    (setf (aref arr-1-par-ref (+ int-loc 30)) int-loc)
+    (cl-loop for int-index from int-loc to (1+ int-loc)
+	     do (setf (aref (aref arr-2-par-ref int-loc) int-index) int-loc))
+    (cl-incf (aref (aref arr-2-par-ref int-loc) (1- int-loc)))
+    (setf (aref (aref arr-2-par-ref (+ int-loc 20)) int-loc) (aref arr-1-par-ref int-loc))
+    (setq dhry-int-glob 5)))
+
+(defun dhry-func-1 (ch-1-par-val ch-2-par-val)
+  (let (ch-1-loc ch-2-loc)
+    (setq ch-1-loc ch-1-par-val)
+    (setq ch-2-loc ch-1-loc)
+    (if (/= ch-2-loc ch-2-par-val)
+	0
+      (setq dhry-ch-1-glob ch-1-loc)
+      1)))
+
+(defun dhry-func-2 (str-1-par-ref str-2-par-ref)
+  (let (int-loc ch-loc)
+    (setq int-loc 2)
+    (while (<= int-loc 2)
+      (if (= (dhry-func-1 (aref str-1-par-ref int-loc)
+			  (aref str-2-par-ref (1+ int-loc)))
+	     0)
+	  (progn
+	    (setq ch-loc ?A)
+	    (cl-incf int-loc))))
+    (if (and (>= ch-loc ?W) (< ch-loc ?Z))
+	(setq int-loc 7))
+    (if (= ch-loc ?R)
+	t
+      (if (string> str-1-par-ref str-2-par-ref)
+	  (progn
+	    (cl-incf int-loc 7)
+	    (setq dhry-int-glob int-loc)
+	    t)
+	nil))))
+
+(defun dhry-func-3 (enum-par-val)
+  (let (enum-loc)
+    (setq enum-loc enum-par-val)
+    (if (= enum-loc 2)
+	t
+      nil)))
+
+(defun dhrystone (number-of-runs &optional check)
+  (let (int-1-loc
+	int-2-loc
+	int-3-loc
+	enum-loc
+	(str-1-loc (make-string 30 0))
+	(str-2-loc (make-string 30 0)))
+    ;; initialization (pre-allocate to avoid consing in the loop)
+    (setq dhry-ptr-glob (list (make-dhry-record) (make-dhry-record)))
+    (setf (dhry-record-discr (car dhry-ptr-glob)) 0)
+    (setf (dhry-record-variant (car dhry-ptr-glob))
+	  (make-dhry-var-1
+	   :enum-comp 2
+	   :int-comp 40
+	   :str-comp "DHRYSTONE PROGRAM, SOME STRING"))
+    (setf (dhry-record-variant (cadr dhry-ptr-glob))
+	  (make-dhry-var-1
+	   :str-comp (make-string 30 0)))
+    (setq dhry-int-glob 0)
+    (setq dhry-bool-glob nil)
+    (setq dhry-ch-1-glob 0)
+    (setq dhry-ch-2-glob 0)
+    (setq dhry-arr-1-glob (make-vector 50 0))
+    (setq dhry-arr-2-glob (make-vector 50 0))
+    (dotimes (i 50)
+      (setf (aref dhry-arr-2-glob i) (make-vector 50 0)))
+    (setf (aref (aref dhry-arr-2-glob 8) 7) 10)
+    (store-substring str-1-loc 0 "DHRYSTONE PROGRAM, 1'ST STRING")
+    ;; dhrystone loop
+    (dotimes (run-index number-of-runs)
+      (dhry-proc-5)
+      (dhry-proc-4)
+      (setq int-1-loc 2)
+      (setq int-2-loc 3)
+      (store-substring str-2-loc 0 "DHRYSTONE PROGRAM, 2'ND STRING")
+      (setq enum-loc 1)
+      (setq dhry-bool-glob (not (dhry-func-2 str-1-loc str-2-loc)))
+      (while (< int-1-loc int-2-loc)
+	(setq int-3-loc (- (* 5 int-1-loc) int-2-loc))
+	(setq int-3-loc (dhry-proc-7 int-1-loc int-2-loc))
+	(cl-incf int-1-loc))
+      (dhry-proc-8 dhry-arr-1-glob dhry-arr-2-glob int-1-loc int-3-loc)
+      (dhry-proc-1 dhry-ptr-glob)
+      (cl-loop for ch-index from ?A to dhry-ch-2-glob
+               when (= enum-loc (dhry-func-1 ch-index ?C))
+	       do (setq enum-loc (dhry-proc-6 0))
+	          (store-substring str-2-loc 0 "DHRYSTONE PROGRAM, 3'RD STRING")
+	          (setq int-2-loc run-index)
+	          (setq dhry-int-glob run-index))
+      (setq int-2-loc (* int-2-loc int-1-loc))
+      (setq int-1-loc (/ int-2-loc int-3-loc))
+      (setq int-2-loc (- (* 7 (- int-2-loc int-3-loc)) int-1-loc))
+      (setq int-1-loc (dhry-proc-2 int-1-loc)))
+    ;; check results
+    (when check
+      (cl-flet ((result-compare (name val ref)
+		  (unless (equal val ref)
+		    (error "%s: %s, expected: %s" name val ref))))
+	(result-compare "Int_Glob"
+			dhry-int-glob 5)
+	(result-compare "Bool_Glob"
+			dhry-bool-glob t)
+	(result-compare "Ch_1_Glob"
+			dhry-ch-1-glob ?A)
+	(result-compare "Ch_2_Glob"
+			dhry-ch-2-glob ?B)
+	(result-compare "Arr_1_Glob[8]"
+			(aref dhry-arr-1-glob 8) 7)
+	(result-compare "Arr_2_Glob[8][7]"
+			(aref (aref dhry-arr-2-glob 8) 7) (+ number-of-runs 10))
+	(result-compare "Ptr_Glob->Discr"
+			(dhry-record-discr (car dhry-ptr-glob)) 0)
+	(result-compare "Ptr_Glob->var_1->Enum_Comp"
+			(dhry-var-1-enum-comp (dhry-record-variant (car dhry-ptr-glob))) 2)
+	(result-compare "Ptr-Glob->var_1->Int_Comp"
+			(dhry-var-1-int-comp (dhry-record-variant (car dhry-ptr-glob))) 17)
+	(result-compare "Ptr_Glob->var_1->Str_Comp"
+			(dhry-var-1-str-comp (dhry-record-variant (car dhry-ptr-glob))) "DHRYSTONE PROGRAM, SOME STRING")
+	(result-compare "Next_Ptr_Glob->Discr"
+			(dhry-record-discr (cadr dhry-ptr-glob)) 0)
+	(result-compare "Next_Ptr_Glob->var_1->Enum_Comp"
+			(dhry-var-1-enum-comp (dhry-record-variant (cadr dhry-ptr-glob))) 1)
+	(result-compare "Next_Ptr_Glob->var_1->Int_Comp"
+			(dhry-var-1-int-comp (dhry-record-variant (cadr dhry-ptr-glob))) 18)
+	(result-compare "Next_Ptr_Glob->var_1->Str_Comp"
+			(dhry-var-1-str-comp (dhry-record-variant (cadr dhry-ptr-glob))) "DHRYSTONE PROGRAM, SOME STRING")
+	(result-compare "Int_1_Loc"
+			int-1-loc 5)
+	(result-compare "Int_2_Loc"
+			int-2-loc 13)
+	(result-compare "Int_3_Loc"
+			int-3-loc 7)
+	(result-compare "Enum_Loc"
+			enum-loc 1)
+	(result-compare "Str_1_Loc"
+			str-1-loc "DHRYSTONE PROGRAM, 1'ST STRING")
+	(result-compare "Str_2_Loc"
+			str-2-loc "DHRYSTONE PROGRAM, 2'ND STRING")))))
+
+(defun elb-dhrystone-entry ()
+  (dhrystone 1000000))
+
+(provide 'elb-dhrystone)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: nbody.patch --]
[-- Type: text/x-patch, Size: 4608 bytes --]

diff --git a/benchmarks/nbody.el b/benchmarks/nbody.el
new file mode 100644
index 0000000..7b1b2eb
--- /dev/null
+++ b/benchmarks/nbody.el
@@ -0,0 +1,142 @@
+;; -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Adapted to elisp from CL version from:
+;; https://benchmarksgame-team.pages.debian.net/benchmarksgame/program/nbody-sbcl-2.html
+
+(require 'cl-lib)
+
+(defconst elb-days-per-year 365.24)
+(defconst elb-solar-mass (* 4 pi pi))
+
+(cl-defstruct (elb-body (:type vector)
+			(:conc-name nil)
+			(:constructor make-elb-body (x y z vx vy vz mass)))
+  x y z
+  vx vy vz
+  mass)
+
+(defvar elb-jupiter
+  (make-elb-body 4.84143144246472090
+		 -1.16032004402742839
+		 -1.03622044471123109e-1
+		 (* 1.66007664274403694e-3 elb-days-per-year)
+		 (* 7.69901118419740425e-3 elb-days-per-year)
+		 (* -6.90460016972063023e-5  elb-days-per-year)
+		 (* 9.54791938424326609e-4 elb-solar-mass)))
+
+(defvar elb-saturn
+  (make-elb-body 8.34336671824457987
+		 4.12479856412430479
+		 -4.03523417114321381e-1
+		 (* -2.76742510726862411e-3 elb-days-per-year)
+		 (* 4.99852801234917238e-3 elb-days-per-year)
+		 (* 2.30417297573763929e-5 elb-days-per-year)
+		 (* 2.85885980666130812e-4 elb-solar-mass)))
+
+(defvar elb-uranus
+  (make-elb-body 1.28943695621391310e1
+		 -1.51111514016986312e1
+		 -2.23307578892655734e-1
+		 (* 2.96460137564761618e-03 elb-days-per-year)
+		 (* 2.37847173959480950e-03 elb-days-per-year)
+		 (* -2.96589568540237556e-05 elb-days-per-year)
+		 (* 4.36624404335156298e-05 elb-solar-mass)))
+
+(defvar elb-neptune
+  (make-elb-body 1.53796971148509165e+01
+		 -2.59193146099879641e+01
+		 1.79258772950371181e-01
+		 (* 2.68067772490389322e-03 elb-days-per-year)
+		 (* 1.62824170038242295e-03 elb-days-per-year)
+		 (* -9.51592254519715870e-05 elb-days-per-year)
+		 (* 5.15138902046611451e-05 elb-solar-mass)))
+
+(defvar elb-sun
+  (make-elb-body 0.0 0.0 0.0 0.0 0.0 0.0 elb-solar-mass))
+
+(defun elb-applyforces (a b dt)
+  (let* ((dx (- (x a) (x b)))
+	 (dy (- (y a) (y b)))
+	 (dz (- (z a) (z b)))
+	 (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))
+	 (mag (/ dt (* distance distance distance)))
+	 (dxmag (* dx mag))
+	 (dymag (* dy mag))
+	 (dzmag (* dz mag)))
+    (cl-decf (vx a) (* dxmag (mass b)))
+    (cl-decf (vy a) (* dymag (mass b)))
+    (cl-decf (vz a) (* dzmag (mass b)))
+    (cl-incf (vx b) (* dxmag (mass a)))
+    (cl-incf (vy b) (* dymag (mass a)))
+    (cl-incf (vz b) (* dzmag (mass a))))
+  nil)
+
+(defun elb-advance (system dt)
+  (cl-loop for (a . rest) on system
+	   do (dolist (b rest)
+		(elb-applyforces a b dt)))
+  (dolist (b system)
+    (cl-incf (x b) (* dt (vx b)))
+    (cl-incf (y b) (* dt (vy b)))
+    (cl-incf (z b) (* dt (vz b))))
+  nil)
+
+(defun elb-energy (system)
+  (let ((e 0.0))
+    (cl-loop for (a . rest) on system do
+	     (cl-incf e (* 0.5
+			   (mass a)
+			   (+ (* (vx a) (vx a))
+			      (* (vy a) (vy a))
+			      (* (vz a) (vz a)))))
+	     (dolist (b rest)
+	       (let* ((dx (- (x a) (x b)))
+		      (dy (- (y a) (y b)))
+		      (dz (- (z a) (z b)))
+		      (dist (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))))
+		 (cl-decf e (/ (* (mass a) (mass b)) dist)))))
+    e))
+
+(defun elb-offset-momentum (system)
+  (let ((px 0.0)
+	(py 0.0)
+	(pz 0.0))
+    (dolist (p system)
+      (cl-incf px (* (vx p) (mass p)))
+      (cl-incf py (* (vy p) (mass p)))
+      (cl-incf pz (* (vz p) (mass p))))
+    (setf (vx (car system)) (/ (- px) elb-solar-mass)
+	  (vy (car system)) (/ (- py) elb-solar-mass)
+	  (vz (car system)) (/ (- pz) elb-solar-mass))
+    nil))
+
+(defun elb-nbody (n)
+  (let ((system (list elb-sun elb-jupiter elb-saturn elb-uranus elb-neptune)))
+    (elb-offset-momentum system)
+    (dotimes (_ n)
+      (elb-advance system 0.01))
+    (elb-energy system)))
+
+(defun elb-nbody-entry ()
+  (elb-nbody 300000))
+
+(provide 'elb-nbody)

^ permalink raw reply related	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2020-03-15 10:57 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-03-14 17:46 [ELPA][PATCH] elisp-benchmarks: add dhrystone and nbody Luca Nassi
2020-03-14 19:28 ` Andrea Corallo
2020-03-14 19:59   ` Stefan Monnier
2020-03-14 22:55     ` Andrea Corallo
2020-03-15 10:57     ` Luca Nassi

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.