source: project/chicken/trunk/benchmarks/cscbench.scm @ 15050

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

bumped version to 4.0.8

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