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

Last change on this file since 15346 was 15346, checked in by Kon Lovett, 11 years ago

Rmvd unnecessary '-C' from benchmarks compile ('-I' is a C compiler option). Made compiler format strings glovars w/ "ld" '-s' option rmvd for MacOS X.

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