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 . + +;;; 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)