cgit.sxemacs.org Git - packages/blob - xemacs-packages/xemacs-devel/bench.el

   1 ;;; bench.el --- benchmarking utility for emacsen
   2
   3 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
   4 ;; $Id: bench.el,v 1.4 2001-09-08 11:01:26 adrian Exp $
   5 ;; $Source: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/xemacs-devel/bench.el,v $
   6 ;; $Revision: 1.4 $
   7 ;; $Author: adrian $
   8 ;; $Date: 2001-09-08 11:01:26 $
   9
  10 ;; Author: Shane Holder <holder@rsn.hp.com>
  11 ;; Adapted-By: Steve Baur <steve@xemacs.org>
  12 ;; Further adapted by: Shane Holder <holder@rsn.hp.com>
  13 ;; Keywords: internal, maint
  14
  15 ;; This file is part of XEmacs.
  16
  17 ;; XEmacs is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by
  19 ;; the Free Software Foundation; either version 2, or (at your option)
  20 ;; any later version.
  21
  22 ;; XEmacs is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 ;; General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  29 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  30 ;; 02111-1307, USA.
  31
  32 ;;; Commentary:
  33
  34 ;; Adapted from Shane Holder's bench.el by steve@xemacs.org.
  35
  36 ;; To run
  37 ;; Extract the shar file in /tmp, or modify bench-lisp-file to
  38 ;; point to the gnus.el file.
  39 ;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file
  40 ;; M-x byte-compile-file "/tmp/bench.el"
  41 ;; M-x load-file "/tmp/bench.elc"
  42 ;; In the scratch buffer (bench 1)
  43
  44
  45 ;; All bench marks must be named bench-mark-<something>
  46 ;; Results are put in bench-mark-<something-times which is a list of
  47 ;;  times for the runs.
  48 ;; If the bench mark is not simple then there needs to be a
  49 ;;  corresponding bench-handler-<something>
  50
  51 ;;; Code:
  52
  53 ;; Use elp to profile benchmarks
  54 (require 'cl)                           ;Emacs doesn't have when and cdar
  55
  56 ;-----------------------------------------------------------------------------
  57 (defvar bench-mark-hanoi-times nil)
  58
  59 (defun bench-handler-hanoi (times)
  60   (let ((start-time))
  61   (while (> times 0)
  62 ;    (setq start-time (bench-get-time))
  63     (bench-mark-hanoi)
  64 ;    (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times ))
  65     (setq times (- times 1))))
  66 )
  67
  68 (defun bench-mark-hanoi ()
  69   "How long to complete the tower of hanoi."
  70   (hanoi 4))
  71
  72 ;-----------------------------------------------------------------------------
  73 (defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock")
  74
  75 (defun bench-handler-font-lock (times)
  76   (setq bench-mark-font-lock-buffer (find-file bench-lisp-file))
  77   (while (> times 0)
  78     (bench-mark-font-lock)
  79     (font-lock-mode)                    ; Turn it off
  80     (setq times (- times 1)))
  81   (kill-buffer bench-mark-font-lock-buffer)
  82 )
  83
  84 (defun bench-mark-font-lock ()
  85   "How long to fonitfy a large file."
  86   (font-lock-fontify-buffer)
  87 )
  88
  89 ;-----------------------------------------------------------------------------
  90 (defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling")
  91
  92 (defun bench-handler-scrolling (times)
  93   (setq bench-mark-scrolling-buffer (find-file bench-lisp-file))
  94   (set-buffer bench-mark-scrolling-buffer)
  95 ;  (setq scroll-step 1)
  96   (font-lock-mode -1)
  97   (goto-char (point-min))               ;Start at point min
  98   (let ((temp-times times))
  99     (while (> temp-times 0)
 100       (bench-mark-scrolling-down)
 101       (bench-mark-scrolling-up)
 102       (setq temp-times (- temp-times 1))))
 103
 104   (font-lock-fontify-buffer)
 105
 106   (goto-char (point-min))               ;Start at point min
 107   (let ((temp-times times))
 108     (while (> temp-times 0)
 109       (bench-mark-scrolling-down-fontified)
 110       (bench-mark-scrolling-up-fontified)
 111       (setq temp-times (- temp-times 1))))
 112   (kill-buffer bench-mark-scrolling-buffer)
 113 )
 114
 115 (defun bench-mark-scrolling-down ()
 116   "How long does it take to scroll down through a large file.
 117 Expect point to be at point min"
 118   (let ((buffer-read-only t))
 119     (while (< (point) (point-max))
 120       (next-line 1)
 121       (sit-for 0))))
 122
 123 (defun bench-mark-scrolling-up ()
 124   "How long does it take to scroll up through a large fontified ile."
 125   (let ((buffer-read-only t))
 126     (while (> (point) (point-min))
 127       (previous-line 1)
 128       (sit-for 0))))
 129
 130 (defun bench-mark-scrolling-down-fontified ()
 131   "How long does it take to scroll down through a large fontified file."
 132   (let ((buffer-read-only t))
 133     (goto-char (point-min))
 134     (while (< (point) (point-max))
 135       (next-line 1)
 136       (sit-for 0))))
 137
 138 (defun bench-mark-scrolling-up-fontified ()
 139   "How long does it take to scroll up through a large fontified ile."
 140   (let ((buffer-read-only t))
 141     (while (> (point) (point-min))
 142       (previous-line 1)
 143       (sit-for 0))))
 144
 145 ;-----------------------------------------------------------------------------
 146
 147 (defun bench-handler-make-frames (times)
 148   (let ((temp-times times)
 149         (frame))
 150     (while (> temp-times 0)
 151       (setq frame (bench-mark-make-frame)) ;Make frame
 152       (bench-mark-delete-frame frame)   ;Delete frame
 153       (setq temp-times (- temp-times 1))))
 154
 155   (let ((temp-times times)
 156         (frames))
 157     (while (> temp-times 0)
 158       (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames
 159       (setq temp-times (- temp-times 1)))
 160
 161     (setq temp-times times)
 162
 163     (while (> temp-times 0)
 164       (bench-mark-delete-multiple-frames (car frames))  ;Delete frames
 165       (setq frames (cdr frames))
 166       (setq temp-times (- temp-times 1))))
 167
 168 )
 169
 170 (defun bench-mark-make-frame ()
 171   "How quickly can emacs create a new frame."
 172   (make-frame))
 173
 174 (defun bench-mark-delete-frame (frame)
 175   "How quickly can emacs create a new frame."
 176   (delete-frame frame))
 177
 178 (defun bench-mark-make-multiple-frames ()
 179   "How quickly can emacs create a new frame."
 180   (make-frame))
 181
 182 (defun bench-mark-delete-multiple-frames (frame)
 183   "How quickly can emacs create a new frame."
 184   (delete-frame frame))
 185
 186
 187 ;-----------------------------------------------------------------------------
 188 (defconst bench-mark-make-words-buffer nil)
 189 (defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*")
 190 (defconst bench-mark-make-words-number-of-words 10000)
 191
 192 (defun bench-handler-make-words (times)
 193   (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name))
 194   (set-buffer bench-mark-make-words-buffer)
 195   (while (> times 0)
 196     (bench-mark-make-words)
 197     (erase-buffer)
 198     (setq times (- times 1)))
 199   (kill-buffer bench-mark-make-words-buffer)
 200 )
 201
 202 (defun bench-mark-make-words ()
 203   "How long does it take to generate lots of random words."
 204   (let ((tmp-words bench-mark-make-words-number-of-words))
 205     (while (not (= tmp-words 0))
 206       (let ((word-len (random 10)))
 207         (while (not (= word-len 0))
 208           (insert (+ ?a (random 25)))
 209           (setq word-len (- word-len 1))))
 210       (insert "\n")
 211       (setq tmp-words (- tmp-words 1)))))
 212
 213 ;-----------------------------------------------------------------------------
 214 (defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*")
 215 (defconst bench-mark-sort-words-buffer nil)
 216 (defconst bench-mark-sort-words-number-words 10000)
 217
 218 (defun bench-handler-sort-words (times)
 219   (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name))
 220   (switch-to-buffer bench-mark-sort-words-buffer)
 221   (while (> times 0)
 222     (bench-pre-sort-words)                      ;Generate the random words
 223     (bench-mark-sort-words)                     ;Sort those puppies
 224     (erase-buffer)
 225     (setq times (- times 1)))
 226   (kill-buffer bench-mark-sort-words-buffer)
 227 )
 228
 229 (defun bench-pre-sort-words ()
 230   "How long does it take to generate lots of random words."
 231   (let ((tmp-words bench-mark-sort-words-number-words))
 232     (while (not (= tmp-words 0))
 233       (let ((word-len (random 10)))
 234         (while (not (= word-len 0))
 235           (insert (+ ?a (random 25)))
 236           (setq word-len (- word-len 1))))
 237       (insert "\n")
 238       (setq tmp-words (- tmp-words 1)))))
 239
 240 (defun bench-mark-sort-words ()
 241   (sort-lines nil (point-min) (point-max))
 242 )
 243
 244 ;-----------------------------------------------------------------------------
 245 ; Byte compile a file
 246 (defun bench-handler-byte-compile (times)
 247   (while (> times 0)
 248     (bench-mark-byte-compile)
 249     (setq times (- times 1)))
 250 )
 251
 252 (defun bench-mark-byte-compile ()
 253   "How long does it take to byte-compile a large lisp file"
 254   (byte-compile-file bench-lisp-file)
 255 )
 256
 257 ;-----------------------------------------------------------------------------
 258 ; Run through a loop
 259
 260 (defconst bench-mark-loop-count 250000)
 261
 262 (defun bench-handler-loop (times)
 263   (while (> times 0)
 264     (bench-mark-loop)
 265     (setq times (- times 1)))
 266 )
 267
 268 (defun bench-mark-loop ()
 269   "How long does it take to run through a loop."
 270   (let ((count bench-mark-loop-count))
 271     (let ((i 0) (gcount 0))
 272       (while (< i count)
 273         (increment)
 274         (setq i (1+ i)))
 275       (message "gcount = %d" gcount))))
 276
 277 (defun increment ()
 278   "Increment a variable for bench-mark-loop."
 279   (setq gcount (1+ gcount)))
 280
 281 ;-----------------------------------------------------------------------------
 282 (defconst bench-mark-large-list-list-size 500000
 283   "Size of list to use in small list creation/garbage collection")
 284 (defconst bench-mark-large-list-num-lists 10)
 285
 286 (defun bench-handler-large-list (times)
 287   (let ((tmp-foo bench-mark-large-list-num-lists))
 288     (while (> tmp-foo 0)
 289       (bench-mark-large-list)
 290       (setq tmp-foo (- tmp-foo 1))))
 291 )
 292
 293 (defun bench-mark-large-list ()
 294   (make-list bench-mark-large-list-list-size '1)
 295 )
 296
 297 ;-----------------------------------------------------------------------------
 298 (defun bench-mark-large-list-garbage-collect (times)
 299   (garbage-collect)
 300 )
 301
 302 ;-----------------------------------------------------------------------------
 303 (defconst bench-mark-small-list-list-size 10
 304   "Size of list to use in small list creation/garbage collection")
 305
 306 (defconst bench-mark-small-list-num-lists 100000
 307   "Number of lists to use in small list creation/garbage collections")
 308
 309 (defun bench-handler-small-list (times)
 310   (let ((tmp-foo bench-mark-small-list-num-lists))
 311     (while (> tmp-foo 0)
 312       (bench-mark-small-list)
 313       (setq tmp-foo (- tmp-foo 1)))
 314 ))
 315
 316 (defun bench-mark-small-list ()
 317   (make-list bench-mark-small-list-list-size '1)
 318 )
 319
 320 ;-----------------------------------------------------------------------------
 321 (defun bench-mark-small-list-garbage-collect (times)
 322   (garbage-collect)
 323 )
 324
 325 ;-----------------------------------------------------------------------------
 326 (defconst bench-mark-insert-into-empty-buffer-num-words 100000)
 327
 328 (defun bench-handler-insert-into-empty-buffer (times)
 329   (set-buffer (get-buffer-create "*tmp*"))
 330   (bench-mark-insert-into-empty-buffer)
 331   (erase-buffer)
 332   (kill-buffer "*tmp*")
 333 )
 334
 335 (defun bench-mark-insert-into-empty-buffer ()
 336   (let ((a bench-mark-insert-into-empty-buffer-num-words))
 337     (while (> a 0)
 338       (insert "0123456789\n")
 339       (setq a (1- a))))
 340 )
 341
 342 ;=============================================================================
 343 (defconst bench-version (let ((rcsvers "$Revision: 1.4 $"))
 344                           (substring rcsvers 11 (- (length rcsvers) 2)))
 345   "*Version number of bench.el")
 346
 347 (defconst bench-large-lisp-file (expand-file-name
 348                                  "bench-large.el" (temp-directory))
 349   "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
 350
 351 (defconst bench-small-lisp-file (expand-file-name
 352                                  "bench-small.el" (temp-directory))
 353   "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
 354
 355 (defconst bench-lisp-file bench-large-lisp-file)
 356
 357 (defconst bench-pre-bench-hook nil
 358   "Hook for individual bench mark initialization.")
 359
 360 (defconst bench-post-bench-hook nil
 361   "Hook for individual bench mark statistic collection.")
 362
 363 (defconst bench-mark-function-alist
 364   '(
 365     (bench-handler-hanoi . "Tower of Hanoi")
 366     (bench-handler-font-lock               . "Font Lock")
 367     (bench-handler-scrolling               . "Large File scrolling")
 368     (bench-handler-make-frames             . "Frame Creation")
 369     (bench-handler-make-words              . "Generate Words")
 370     (bench-handler-sort-words              . "Sort Buffer")
 371     (bench-handler-byte-compile            . "Large File bytecompilation")
 372     (bench-handler-loop                    . "Loop Computation")
 373     (bench-handler-large-list              . "Make a Few Large Size List")
 374     (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List")
 375     (bench-handler-small-list              . "Make Several Small Size List")
 376     (bench-mark-small-list-garbage-collect  . "Garbage Collection Small Size List")
 377     (bench-handler-insert-into-empty-buffer . "Text Insertion")
 378 ))
 379
 380 (defconst bench-enabled-profiling nil
 381   "If non-nil and the underlying emacs supports it, do function profiling.")
 382
 383 (defconst bench-mark-profile-buffer "*Profile*"
 384   "Buffer used for collection of profiling data.")
 385
 386 (setq gc-cons-threshold 40000000)
 387
 388 (defconst bench-small-frame-alist '((height . 24) (width . 80)))
 389 (defconst bench-medium-frame-alist '((height . 48) (width . 80)))
 390 (defconst bench-large-frame-alist '((height . 72) (width . 80)))
 391
 392 (defsubst bench-get-time ()
 393   ;; Stolen from elp
 394   ;; get current time in seconds and microseconds. I throw away the
 395   ;; most significant 16 bits of seconds since I doubt we'll ever want
 396   ;; to profile lisp on the order of 18 hours. See notes at top of file.
 397   (let ((now (current-time)))
 398     (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
 399
 400 (defun bench-init ()
 401   "Initialize profiling for bench marking package."
 402   (if (fboundp 'start-profiling)
 403       (let ((buf (get-buffer-create bench-mark-profile-buffer)))
 404         (erase-buffer buf)
 405         (when (profiling-active-p)
 406           (stop-profiling)
 407           (clear-profiling-info)))
 408     (message "Profiling not available in this XEmacs.")
 409     (sit-for 2)))
 410
 411 (defun bench-test-init ()
 412   "Initialize profiling for bench marking package."
 413   (if (fboundp 'start-profiling)
 414       (let ((buf (get-buffer-create bench-mark-profile-buffer)))
 415         (erase-buffer buf)
 416         (when (profiling-active-p)
 417           (stop-profiling)
 418           (clear-profiling-info)))
 419     (message "Profiling not available in this XEmacs.")
 420     (sit-for 2))
 421   (setq bench-lisp-file bench-small-lisp-file)
 422   (setq bench-mark-make-words-number-of-words 100)
 423   (setq bench-mark-sort-words-number-of-words 100)
 424   (setq bench-mark-loop-count 10000)
 425   (setq bench-mark-large-list-list-size 500)
 426   (setq bench-mark-small-list-num-lists 100)
 427   (setq bench-mark-insert-into-empty-buffer-num-words 100)
 428
 429 )
 430
 431 (defun bench-profile-start (test-name)
 432   "Turn on profiling for test `test-name'."
 433   (when (and bench-enabled-profiling
 434              (fboundp 'start-profiling))
 435     (when (profiling-active-p)
 436       (stop-profiling))
 437     (let ((buf (get-buffer-create bench-mark-profile-buffer)))
 438       (save-excursion
 439         (set-buffer buf)
 440         (insert "Test `" test-name "'\n")
 441         (start-profiling)))))
 442
 443 (defun bench-profile-stop (test-name)
 444   "Turn off profiling for test `test-name'."
 445   (when (and bench-enabled-profiling
 446              (fboundp 'stop-profiling))
 447     (stop-profiling)
 448     (let ((buf (get-buffer-create bench-mark-profile-buffer)))
 449       (save-excursion
 450         (set-buffer buf)
 451         (insert (with-output-to-string
 452                  (pretty-print-profiling-info)) "\n")))
 453     (clear-profiling-info)))
 454
 455 (add-hook 'bench-pre-bench-hook 'bench-profile-start)
 456 (add-hook 'bench-post-bench-hook 'bench-profile-stop)
 457
 458 (defun bench-post ()
 459 "Post processing of elp results"
 460 ; I can't figure out a good way to sort the lines numerically.
 461 ; If someone comes up with a good way, let me know.
 462   (goto-char (point-min))
 463   (next-line 2)
 464   (sort-lines nil (point) (point-max))
 465   (mail-results (current-buffer))
 466 )
 467
 468 (defun bench (arg)
 469   "Run a series of benchmarks."
 470   (interactive "p")
 471   (elp-instrument-package "bench-mark") ;Only instrument functions
 472                                         ;beginning with bench-mark
 473   (bench-init)
 474   (if (fboundp 'byte-optimize)          ;Turn off byte-compile optimization in XEmacs
 475       (setq byte-optimize nil))
 476   (if (fboundp 'menu-bar-mode)
 477       (menu-bar-mode -1))                       ;Turn off menu-bar
 478   (let ((benches bench-mark-function-alist))
 479     (while benches
 480       (let ((test-name (cdar benches)))
 481         (run-hook-with-args 'bench-pre-bench-hook test-name)
 482         (message "Running %s - %s." (symbol-name (caar benches)) test-name)
 483         (funcall (caar benches) arg)
 484         (setq benches (cdr benches))
 485         (run-hook-with-args 'bench-post-bench-hook test-name))
 486       ))
 487   (elp-results)
 488   (bench-post)
 489 )
 490
 491 (defun bench-test (arg)
 492   "Run all the tests but with smaller values so the tests run quicker.
 493 This way I don't have to sit around to see if the tests complete"
 494   (interactive "p")
 495   (elp-instrument-package "bench-mark") ;Only instrument functions
 496                                         ;beginning with bench-mark
 497   (bench-test-init)
 498   (if (fboundp 'byte-optimize)          ;Turn off byte-compile optimization in XEmacs
 499       (setq byte-optimize nil))
 500   (if (fboundp 'menu-bar-mode)
 501       (menu-bar-mode -1))                       ;Turn off menu-bar
 502   (let ((benches bench-mark-function-alist))
 503     (while benches
 504       (let ((test-name (cdar benches)))
 505         (run-hook-with-args 'bench-pre-bench-hook test-name)
 506         (message "Running %s - %s." (symbol-name (caar benches)) test-name)
 507         (funcall (caar benches) arg)
 508         (setq benches (cdr benches))
 509         (run-hook-with-args 'bench-post-bench-hook test-name))
 510       ))
 511   (elp-results)
 512   (bench-post)
 513 )
 514
 515
 516 (defconst bench-send-results-to "holder@rsn.hp.com")
 517 (defconst bench-subject "Bench Mark Results")
 518 (defconst bench-system-form (format "
 519
 520 Please fill in as much of the following as you can
 521 and then hit C-cC-c to send.
 522
 523 CPU Manufacturer (Intel,HP,DEC,etc.):
 524 CPU Type (Pentium,Alpha):
 525 CPU Speed:
 526 RAM (in meg):
 527 Emacs Version: %s
 528 Emacs (version): %s
 529 Compile line:
 530 Bench Version: %s
 531 " emacs-version (emacs-version) bench-version))
 532
 533 (defun mail-results (buffer)
 534   (mail nil bench-send-results-to bench-subject)
 535   (sit-for 0)
 536   (goto-char (point-max))
 537   (insert bench-system-form)
 538   (insert-buffer buffer)
 539 )
 540 ;;; bench.el ends here