repos
/
benchmark
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Benchmark overload resolution at compile time.
Annotate for file benchmark.lisp
2009-05-25 tobias
1
(in-package :cl-smoke.benchmark)
14:59:32 '
2
'
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)
2009-06-19 tobias
10
(list :processor-cycles (getf timings :processor-cycles)
15:31:27 '
11
:system-run-time-us (getf timings :system-run-time-us)
'
12
:user-run-time-us (getf timings :user-run-time-us))))
2009-05-25 tobias
13
14:59:32 '
14
(defun print-header (stream data)
'
15
(dolist (d (alexandria:plist-alist (first data)))
'
16
(format stream "~A " (first d)))
'
17
(format stream "~%"))
'
18
'
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 "~%"))))
'
26
2009-06-19 tobias
27
(defun write-lisp-info (file)
15:31:27 '
28
(write-R-table
'
29
`((:type ,(lisp-implementation-type)
2010-01-10 tobias
30
:version ,(lisp-implementation-version)
10:16:40 '
31
:arch ,(machine-type)
'
32
:os ,(software-type)
'
33
:os-version ,(software-version)
'
34
:cl-smoke-version ,(mb.sysdef::version-string (mb.sysdef:version-of (mb.sysdef:find-system :smoke)))))
2009-06-19 tobias
35
file))
2009-05-25 tobias
36
2009-06-19 tobias
37
(defun benchmark (function iterations)
2009-05-25 tobias
38
(let ((data))
2009-06-19 tobias
39
(dotimes (n 3)
15:31:27 '
40
(funcall function iterations)) ;; startup
2009-05-25 tobias
41
(dotimes (n 20 data)
2009-07-08 tobias
42
(tg:gc :full t)
2009-06-19 tobias
43
(push (nconc (list :iterations iterations)
15:31:27 '
44
(timing function iterations))
2009-05-25 tobias
45
data))))
14:59:32 '
46
2009-06-19 tobias
47
(defun run-compare (name function cxx-function iterations multiplier)
15:31:27 '
48
(format t "running ~A." name)
'
49
(let ((data (prog1 (benchmark function iterations) (princ ".")))
'
50
(cxx-data (prog1 (benchmark cxx-function (* multiplier iterations))
'
51
(princ ".")))
2009-05-25 tobias
52
(file (make-pathname :defaults name
14:59:32 '
53
:type "dat")))
'
54
(write-R-table data file)
'
55
(write-R-table cxx-data
'
56
(make-pathname :defaults file
'
57
:name (concatenate 'string
'
58
"cxx-"
2009-06-19 tobias
59
(pathname-name file)))))
15:31:27 '
60
(terpri))
2009-05-25 tobias
61
2009-06-19 tobias
62
(defun run (&optional construct)
15:31:27 '
63
(write-lisp-info "info.dat")
'
64
(run-compare "signal-slot" #'signal-slot
2009-07-08 tobias
65
#'cl-smoke-benchmark-signal-slot 1000 1000)
2009-05-25 tobias
66
(run-compare "inline-call" #'inline-call
2009-07-08 tobias
67
#'cl-smoke-benchmark-byte-array-size 10000 3000)
2009-05-25 tobias
68
(run-compare "simple-call" #'simple-call
2009-07-08 tobias
69
#'cl-smoke-benchmark-simple-call 10000 3000)
15:34:16 '
70
(run-compare "simple-call-compile-time" #'simple-call-compile-time
'
71
#'cl-smoke-benchmark-simple-call 10000 3000)
2009-06-19 tobias
72
(when construct
15:31:27 '
73
(with-benchmark-cxx-construct ((* 50 1000))
'
74
(run-compare "construct" #'construct
'
75
#'cl-smoke-benchmark-construct 1000 50))))