darcs - benchmark

1 (in-package :cl-smoke.benchmark)

3 (defun timing (function &rest arguments)

4 (let ((timings))

5 (apply #'sb-ext:call-with-timing

6 #'(lambda (&rest args)

7 (setf timings args))

8 function

9 arguments)

10 (list :processor-cycles (getf timings :processor-cycles)

11 :system-run-time-us (getf timings :system-run-time-us)

12 :user-run-time-us (getf timings :user-run-time-us))))

14 (defun print-header (stream data)

15 (dolist (d (alexandria:plist-alist (first data)))

16 (format stream "~A " (first d)))

17 (format stream "~%"))

19 (defun write-R-table (data file)

20 (with-open-file (out file :direction :output)

21 (print-header out data)

22 (dolist (d data)

23 (dolist (e (alexandria:plist-alist d))

24 (format out "~S~T" (rest e)))

25 (format out "~%"))))

27 (defun write-lisp-info (file)

28 (write-R-table

29 `((:type ,(lisp-implementation-type)

30 :version ,(lisp-implementation-version)

31 :arch ,(machine-type)

32 :os ,(software-type)

33 :os-version ,(software-version)

34 :cl-smoke-version ,(format nil "~{~A~^.~}"

35 (asdf:component-version (asdf:find-system :cl-smoke.smoke)))))

36 file))

38 (defun benchmark (function iterations)

39 (let ((data))

40 (dotimes (n 3)

41 (funcall function iterations)) ;; startup

42 (dotimes (n 20 data)

43 (tg:gc :full t)

44 (push (nconc (list :iterations iterations)

45 (timing function iterations))

46 data))))

48 (defun run-compare (name function cxx-function iterations multiplier)

49 (format t "running ~A." name)

50 (let ((data (prog1 (benchmark function iterations) (princ ".")))

51 (cxx-data (prog1 (benchmark cxx-function (* multiplier iterations))

52 (princ ".")))

53 (file (make-pathname :defaults name

54 :type "dat")))

55 (write-R-table data file)

56 (write-R-table cxx-data

57 (make-pathname :defaults file

58 :name (concatenate 'string

59 "cxx-"

60 (pathname-name file)))))

61 (terpri))

63 (defun run (&optional construct)

64 (write-lisp-info "info.dat")

65 (run-compare "signal-slot" #'signal-slot

66 #'cl-smoke-benchmark-signal-slot 1000 1000)

67 (run-compare "inline-call" #'inline-call

68 #'cl-smoke-benchmark-byte-array-size 10000 3000)

69 (run-compare "simple-call" #'simple-call

70 #'cl-smoke-benchmark-simple-call 10000 3000)

71 (run-compare "simple-call-compile-time" #'simple-call-compile-time

72 #'cl-smoke-benchmark-simple-call 10000 1000)

73 (when construct

74 (with-benchmark-cxx-construct ((* 50 1000))

75 (run-compare "construct" #'construct

76 #'cl-smoke-benchmark-construct 1000 50))))