andros
05f0cb444c
The README already pointed to run-bench.sh and run-bench-hires.sh as the way to reproduce the performance tables; add them under bench/ along with gl-bench.el (the five workloads) and a README describing the methodology. The scripts are relocatable: the binary is taken from $EMACS, gl-bench.el is found relative to the script, and results go to a temporary directory.
141 lines
6.1 KiB
EmacsLisp
141 lines
6.1 KiB
EmacsLisp
;;; gl-bench.el --- redisplay throughput: stock vs GPU backend -*- lexical-binding:t -*-
|
|
|
|
;; This file is part of the emacs-gpu benchmark harness. It drives the
|
|
;; same five workloads with the GPU backend enabled or disabled and
|
|
;; appends the results to a per-mode log file.
|
|
|
|
;; Environment variables (all optional):
|
|
;; GL_MODE "gpu" | "vanilla" selects which line to write and,
|
|
;; for "gpu", calls `gpu-enable-for-frame'. Default
|
|
;; "vanilla".
|
|
;; GL_BENCH_COLS frame width in columns (default 160).
|
|
;; GL_BENCH_ROWS frame height in rows (default 48).
|
|
;; GL_BENCH_OUT directory for the log files (default the system
|
|
;; temporary directory).
|
|
;;
|
|
;; Results are appended to GL_BENCH_OUT/gl-bench-<mode>.txt, one line per
|
|
;; workload: "NAME frames=N sec=S fps=F ms=M". The runner scripts
|
|
;; (run-bench.sh, run-bench-hires.sh) parse those lines.
|
|
|
|
;;; Code:
|
|
|
|
(require 'benchmark)
|
|
|
|
(defun gl-bench-out-dir ()
|
|
"Directory where the per-mode result files are written."
|
|
(or (getenv "GL_BENCH_OUT") temporary-file-directory))
|
|
|
|
(defun gl-bench-log (fmt &rest args)
|
|
"Append the formatted line to the result file for the current mode."
|
|
(let ((mode (or (getenv "GL_MODE") "vanilla")))
|
|
(write-region (concat (apply #'format fmt args) "\n") nil
|
|
(expand-file-name (format "gl-bench-%s.txt" mode)
|
|
(gl-bench-out-dir))
|
|
'append 'silent)))
|
|
|
|
(defun gl-bench-code-buffer ()
|
|
"Return a buffer with 8000 lines of font-locked Emacs Lisp."
|
|
(let ((buf (get-buffer-create "*bench-code*")))
|
|
(with-current-buffer buf
|
|
(emacs-lisp-mode) (erase-buffer)
|
|
(dotimes (i 8000)
|
|
(insert (format "(defun func-%d (a b c) ; line %d lorem ipsum dolor sit\n"
|
|
i i))
|
|
(insert (format " (let ((x (+ a b)) (y \"a string value %d\")) (* x c %d)))\n"
|
|
i i)))
|
|
(font-lock-ensure) (goto-char (point-min)))
|
|
buf))
|
|
|
|
(defun gl-bench-img-buffer (img)
|
|
"Return a buffer with 60 copies of the PNG file IMG interleaved with text."
|
|
(let ((buf (get-buffer-create "*bench-img*")))
|
|
(with-current-buffer buf
|
|
(fundamental-mode) (erase-buffer)
|
|
(dotimes (i 60)
|
|
(insert (format "image block %d of the scrolling benchmark\n" i))
|
|
(insert-image (create-image img 'png nil))
|
|
(insert "\n\n"))
|
|
(goto-char (point-min)))
|
|
buf))
|
|
|
|
(defun gl-bench-top ()
|
|
"Scroll back to the top of the current buffer and redisplay."
|
|
(goto-char (point-min))
|
|
(set-window-start (selected-window) (point-min))
|
|
(redisplay t))
|
|
|
|
(defun gl-bench-frames (n thunk)
|
|
"Call THUNK N times, force a redisplay each, return elapsed seconds."
|
|
(let ((t0 (float-time)))
|
|
(dotimes (_ n) (funcall thunk) (redisplay t))
|
|
(- (float-time) t0)))
|
|
|
|
(defun gl-bench-scroller ()
|
|
"Scroll one line, wrapping to the top at end of buffer."
|
|
(condition-case nil (scroll-up 1)
|
|
(end-of-buffer (gl-bench-top))))
|
|
|
|
(defun gl-bench-run ()
|
|
"Run the five workloads and log a result line for each."
|
|
(condition-case err
|
|
(let* ((f (selected-frame))
|
|
(mode (or (getenv "GL_MODE") "vanilla"))
|
|
(img (expand-file-name "bench-img.png" (gl-bench-out-dir))))
|
|
(menu-bar-mode -1) (tool-bar-mode -1)
|
|
(when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))
|
|
(blink-cursor-mode -1)
|
|
(set-frame-size f
|
|
(string-to-number (or (getenv "GL_BENCH_COLS") "160"))
|
|
(string-to-number (or (getenv "GL_BENCH_ROWS") "48")))
|
|
(switch-to-buffer (gl-bench-code-buffer))
|
|
(delete-other-windows) (gl-bench-top) (message nil)
|
|
(sit-for 0.5)
|
|
(when (and (string= mode "gpu") (fboundp 'gpu-enable-for-frame))
|
|
(gpu-enable-for-frame f) (redisplay t) (sit-for 0.3))
|
|
(gl-bench-log "# mode=%s device=%s frame=%dx%d" mode
|
|
(and (fboundp 'gpu-device-name) (gpu-device-name))
|
|
(frame-pixel-width f) (frame-pixel-height f))
|
|
;; Warm-up: fill the glyph atlas and caches before measuring.
|
|
(gl-bench-frames 80 #'gl-bench-scroller) (gl-bench-top)
|
|
;; 1. line scroll (1 line/frame) -- text-heavy, cairo is competitive
|
|
(let* ((n 800) (s (gl-bench-frames n #'gl-bench-scroller)))
|
|
(gl-bench-log "line-scroll frames=%d sec=%.3f fps=%.1f ms=%.3f"
|
|
n s (/ n s) (* 1000 (/ s n))))
|
|
(gl-bench-top)
|
|
;; 2. page scroll (whole window/frame) -- more new glyphs per frame
|
|
(let* ((n 400)
|
|
(s (gl-bench-frames n (lambda ()
|
|
(condition-case nil (scroll-up) (end-of-buffer (gl-bench-top)))))))
|
|
(gl-bench-log "page-scroll frames=%d sec=%.3f fps=%.1f ms=%.3f"
|
|
n s (/ n s) (* 1000 (/ s n))))
|
|
(gl-bench-top)
|
|
;; 3. full-frame redraw (everything repainted each frame)
|
|
(let* ((n 300)
|
|
(s (gl-bench-frames n (lambda () (redraw-frame f)))))
|
|
(gl-bench-log "full-redraw frames=%d sec=%.3f fps=%.1f ms=%.3f"
|
|
n s (/ n s) (* 1000 (/ s n))))
|
|
;; 4. typing (one self-insert + redisplay per frame)
|
|
(let ((buf (get-buffer-create "*bench-type*")))
|
|
(with-current-buffer buf (erase-buffer) (emacs-lisp-mode))
|
|
(switch-to-buffer buf) (redisplay t)
|
|
(let* ((n 600)
|
|
(s (gl-bench-frames n (lambda ()
|
|
(insert (char-to-string (+ ?a (random 26))))
|
|
(when (> (current-column) 150) (insert "\n"))))))
|
|
(gl-bench-log "typing frames=%d sec=%.3f fps=%.1f ms=%.3f"
|
|
n s (/ n s) (* 1000 (/ s n)))))
|
|
;; 5. image scroll (GPU should win here)
|
|
(when (file-exists-p img)
|
|
(switch-to-buffer (gl-bench-img-buffer img)) (delete-other-windows)
|
|
(gl-bench-top)
|
|
(let* ((n 500) (s (gl-bench-frames n #'gl-bench-scroller)))
|
|
(gl-bench-log "image-scroll frames=%d sec=%.3f fps=%.1f ms=%.3f"
|
|
n s (/ n s) (* 1000 (/ s n)))))
|
|
(gl-bench-log "DONE"))
|
|
(error (gl-bench-log "ERR %S" err)))
|
|
(kill-emacs 0))
|
|
|
|
(run-with-timer 1.0 nil #'gl-bench-run)
|
|
|
|
;;; gl-bench.el ends here
|