source: project/chicken/branches/inlining/benchmarks/cscbench.scm @ 15323

Last change on this file since 15323 was 15323, checked in by felix winkelmann, 10 years ago

more intelligent inlining; standard-extension procedure in setup-api

File size: 5.7 KB
Line 
1;;;; cscbench - Compile and run benchmarks - felix -*- Scheme -*-
2;
3; - Usage: cscbench [-debug] [-cc=<path>] [-csc=<path>] [-chicken=<path>] OPTION ...
4
5(require-extension srfi-1 utils posix regex)
6
7(define ignored-files '("cscbench.scm" "cscbench.scm~"))
8(define flonum-files '("fft" "maze" "nbody"))
9(define cc "gcc")
10(define chicken "chicken")
11(define csc "csc")
12
13(define (abort-run) #f)
14
15(define run
16  (let ([secrx (regexp "^ *([-.+e0-9]*(\\.[0-9]*)?) seconds elapsed$")])
17    (lambda ()
18      (system* "./tmpfile >tmpfile.out")
19      (with-input-from-file "tmpfile.out"
20        (lambda ()
21          (let loop ([line (read-line)])
22            (if (eof-object? line) 
23                (abort-run)
24                (let ([m (string-match secrx line)])
25                  (if m
26                      (string->number (second m)) 
27                      (loop (read-line)) ) ) ) ) ) ) ) ) )
28
29(define (display-l str len pad)
30  (let ([slen (string-length str)])
31    (display (substring str 0 (min slen len)))
32    (display (make-string (max 0 (- len slen)) pad)) ) )
33
34(define (display-r str len pad)
35  (let ([slen (string-length str)])
36    (display (make-string (max 0 (- len slen)) pad))
37    (display (substring str 0 (min slen len))) ) )
38
39(define display-f-4.3
40  (let ([florx (regexp "^([-+e0-9]*)(\\.([0-9]*))?$")])
41    (lambda (n)
42      (let* ([m (string-match florx (number->string n))]
43             [is (second m)]
44             [fs (fourth m)] )
45        (display-r is 4 #\space)
46        (display #\.)
47        (display-r (or fs "0") 3 #\0) ) ) ) )
48
49(define (display-size n)
50  (display-r 
51   (string-append (number->string (quotient n 1024)) "k") 
52   10 #\space))
53
54(define (compile-and-run file decls options coptions unsafe)
55  (with-output-to-file "bench.log" (cut print "\n==================" file) append:)
56  (system* "~A ~A -quiet -no-warnings -heap-size 16m -output-file tmpfile.c -debug xop ~A ~A 2>&1 >>bench.log"
57           chicken file decls options)
58  (system* "~a ~a -s -I.. tmpfile.c -o tmpfile ../lib~achicken.a -lm"
59           cc coptions
60           (if unsafe "u" ""))
61  (let ((time (call-with-current-continuation
62               (lambda (abort)
63                 (set! abort-run (cut abort #f))
64                 (let ((runs
65                        (butlast
66                         (cdr
67                          (sort 
68                           (map (lambda _ (run)) (iota 5))
69                           <)))))
70                   (/ (apply + runs) 3)))))
71        (size (file-size "tmpfile")))
72    (display #\space)
73    (cond (time
74            (display-f-4.3 time)
75            (values time size))
76          (else
77            (display "FAILED")
78            (values 9999.9 size)))))
79
80(define (dflush x)
81  (display x)
82  (flush-output) )
83
84(define (main options)
85  (call/cc
86   (lambda (return)
87     (let loop ((opts options))
88       (cond ((null? opts) (return #f))
89             ((string=? "-debug" (car opts)) 
90              (set! system*
91                (let ([system* system*])
92                  (lambda args
93                    (let ([s (apply sprintf args)])
94                      (printf "system: ~A~%" s)
95                      (system* s) ) ) ) ) )
96             ((string-match "-cc=(.*)" (car opts)) =>
97              (lambda (m) (set! cc (second m))))
98             ((string-match "-csc=(.*)" (car opts)) =>
99              (lambda (m) (set! csc (second m))))
100             ((string-match "-chicken=(.*)" (car opts)) =>
101              (lambda (m) (set! chicken (second m))))
102             (else
103              (set! options opts)
104              (return #f)))
105       (loop (cdr opts)))))
106  (set! cc (string-trim-both (with-input-from-pipe "csc -cc-name" read-line)))
107  (delete-file* "tmpfile.scm")
108  (delete-file* "bench.log")
109  (system* "~A -version" chicken)
110  (dflush "\nCC:\n")
111  (if (eq? (build-platform) 'sun)
112      (system (conc cc " -V"))
113      (system* "~A -v" cc) )
114  (dflush "\nCFLAGS:\n")
115  (system* "echo `~a -cflags`" csc)
116  (display "\nRunning benchmarks ...\n\n  (averaging over 5 runs, dropping highest and lowest, binaries are statically linked and stripped,\n")
117  (display "   compiler log will be written to \"bench.log\")\n")
118  (display "\n                     (runtime)                                  (code size)\n")
119  (display "\n                     base       fast     unsafe        max      base      fast    unsafe       max")
120  (display "\n                  ----------------------------------------------------------------------------------\n")
121  (let ((sum-base 0.0)
122        (sum-fast 0.0)
123        (sum-unsafe 0.0)
124        (sum-max 0.0)
125        (size-base 0)
126        (size-fast 0)
127        (size-unsafe 0)
128        (size-max 0))
129    (for-each
130     (lambda (file)
131       (let* ([name (pathname-file file)]
132              [options (string-intersperse options " ")] 
133              (t 0))
134         (display-l name 16 #\space)
135         (flush-output)
136         (set!-values 
137          (t size-base)
138          (compile-and-run              ; base
139           file
140           "-debug-level 0 -optimize-level 1" 
141           options "" #f))
142         (set! sum-base (+ sum-base t))
143         (dflush "  ")
144         (set!-values 
145          (t size-fast)
146          (compile-and-run              ; fast but safe
147           file
148           "-debug-level 0 -optimize-level 3 -lambda-lift" 
149           options "" #f))
150         (set! sum-fast (+ sum-fast t))
151         (dflush "  ")
152         (set!-values
153          (t size-unsafe)
154          (compile-and-run              ; fast and unsafe
155           file
156           "-debug-level 0 -optimize-level 4 -block -disable-interrupts -lambda-lift" 
157           options "" #t))
158         (set! sum-unsafe (+ sum-unsafe t))
159         (dflush "  ")
160         (cond ((member name flonum-files)
161                (display "         "))
162               (else
163                (set!-values
164                 (t size-max)
165                 (compile-and-run file "-benchmark-mode" options "" #t) ) ; maximal speed
166                (set! sum-max (+ sum-max t))))
167         (display-size size-base)
168         (display-size size-fast)
169         (display-size size-unsafe)
170         (display-size size-max)
171         (newline)
172         (flush-output)))
173     (lset-difference string=? (sort (glob "*.scm") string<?) ignored-files))
174    (display "\nTOTAL            ")
175    (display-f-4.3 sum-base)
176    (display "   ")
177    (display-f-4.3 sum-fast)
178    (display "   ")
179    (display-f-4.3 sum-unsafe)
180    (display "   ")
181    (display-f-4.3 sum-max)
182    (newline)
183    0))
184
185(main (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.