source: project/chicken/trunk/cscbench.scm @ 6488

Last change on this file since 6488 was 6488, checked in by felix winkelmann, 12 years ago
  • fixed bug in C_apply (uninit'd variable in unsafe runtime lib)
  • benchmarks use built-in plists, now
File size: 3.7 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 flonum-files '("fft" "maze"))
8
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 fs 3 #\0) ) ) ) )
47
48(define (compile-and-run file decls options coptions unsafe)
49  (system* "~A ~A -quiet -no-warnings -heap-size 8m -output-file tmpfile.c ~A ~A"
50           chicken file decls options)
51  (system* "~a ~a -static -I.. tmpfile.c -o tmpfile ../lib~achicken.a -lm"
52           cc coptions (if unsafe "u" ""))
53  (let ([time (call-with-current-continuation
54               (lambda (abort)
55                 (set! abort-run (cut abort #f))
56                 (/ (+ (run) (run) (run)) 3) ) ) ] )
57    (display #\space)
58    (cond (time
59            (display-f-4.3 time)
60            time)
61          (else
62            (display "FAILED")
63            9999.9))))
64
65(define (dflush x)
66  (display x)
67  (flush-output) )
68
69(define (main options)
70  (when (and (pair? options) (string=? "-debug" (car options)))
71    (set! options (cdr options))
72    (set! system*
73      (let ([system* system*])
74        (lambda args
75          (let ([s (apply sprintf args)])
76            (printf "system: ~A~%" s)
77            (system* s) ) ) ) ) )
78  (and-let* ([(pair? options)]
79             [m (string-match "-cc=(.*)" (car options))] )
80    (set! options (cdr options))
81    (set! cc (second m)) )
82  (delete-file* "tmpfile.scm")
83  (system* "~A -version" chicken)
84  (dflush "\nCC:\n")
85  (if (eq? (build-platform) 'sun)
86      (system (conc cc " -V"))
87      (system* "~A -v" cc) )
88  (dflush "\nCFLAGS:\n")
89  (system* "echo `../csc -cflags`")
90  (display "\n                  base       unsafe     max\n")
91  (let ((sum-base 0.0)
92        (sum-unsafe 0.0)
93        (sum-max 0.0))
94  (for-each
95   (lambda (file)
96     (let* ([name (pathname-file file)]
97            [options (string-intersperse options " ")] )
98       (display-l name 16 #\space)
99       (flush-output)
100       (set! sum-base (+ sum-base (compile-and-run file "-debug-level 0 -optimize-level 1 -lambda-lift" options "" #f)))
101       (dflush "  ")
102       (set! sum-unsafe (+ sum-unsafe (compile-and-run file "-debug-level 0 -optimize-level 3 -block -disable-interrupts -lambda-lift" options "" #t)))
103       (dflush "  ")
104       (unless (member name flonum-files)
105         (set! sum-max (+ sum-max (compile-and-run file "-benchmark-mode" options "" #t) )))
106       (newline)
107       (flush-output) ) )
108   (lset-difference string=? (sort (glob "*.scm") string<?) '("plists.scm")))
109  (display "\nTOTAL            ")
110  (display-f-4.3 sum-base)
111  (display "   ")
112  (display-f-4.3 sum-unsafe)
113  (display "   ")
114  (display-f-4.3 sum-max)
115  (newline)
116 0))
117
118(main (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.