suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more readable mandelbrot-unsafe; minor benchmark harness fixes

Browse Source 
svn: r17915
This commit is contained in:
Matthew Flatt 2010-01-31 14:58:26 +00:00
parent a5da3f327f
commit e8c97a5102
4 changed files with 34 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/mzscheme/benchmarks/common/auto.ss
View File

@ -456,7 +456,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
run-guile
extract-guile-times
void
'(dynamic dynamic2))
'(ctak))
))
(define obsolte-impls '(mzscheme3m mzschemecgc mzscheme-j mzschemecgc-j mzschemecgc-tl mzc mz-old))

2
collects/tests/mzscheme/benchmarks/common/guile-prelude.sch
View File

@ -15,7 +15,7 @@
(display " system: ")
(display (msecs (- (tms:stime end) (tms:stime start))))
(display " real: ")
(display (msecs (- (tms:stime end) (tms:stime start))))
(display (msecs (- (tms:clock end) (tms:clock start))))
(display " gc: ")
(display (msecs (- end-gc start-gc)))
(newline)))))

23
collects/tests/mzscheme/benchmarks/common/index-template.html
View File

@ -12,8 +12,8 @@
fastest run shown on the left. So, by
default, <font color=forestgreen><b>1</b></font> is the fastest,
but select any implementation to normalize the table with respect
to that implementation's speed. A <tt>-</tt> appears when a
benchmark didn't run in an implementation for some reason (possibly
to that implementation&rsquo;s speed. A <tt>-</tt> appears when a
benchmark didn&rsquo;t run in an implementation for some reason (possibly
not a good one).</p>
<p><font color="gray" size="-1">
@ -21,12 +21,12 @@ The <a href="../log2/Benchmarks.html">compilers-only page</a> shows
just the compilers among the tested implementations. For those
results, the small gray numbers are (relative) compile times, where
the compile time for the <tt>nothing</tt> benchmark is subtracted from
every other benchmark's compile time.</font></p>
every other benchmark&rsquo;s compile time.</font></p>
<p>Run times are averaged over three runs for compilers or one run for
interpreters. All reported times are CPU time (system plus user).
The times are based on the output of the
implementation's <tt>time</tt> syntactic form or similar
implementation&rsquo;s <tt>time</tt> syntactic form or similar
functions.</p>
<p>Machine:
@ -40,24 +40,23 @@ every other benchmark's compile time.</font></p>
<li> Chicken (4.3.0): <tt>-no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift</tt></li>
<li> Gambit (4.6.0): <tt>(declare (block) (standard-bindings) (extended-bindings) (safe) (interrupts-enabled))</tt>,
compiled and run with <tt>-:m10000</tt></li>
<li> Guile (1.8.7): <tt>load</tt></li>
<li> Guile (1.9.7): <tt>load</tt></li>
<li> Ikarus (0.0.4-rc1+ rev 1870): in R6RS library</li>
<li> Larceny (0.97): in R6RS library</li>
<li> MIT (7.7.90+): <tt>(declare (usual-integrations))</tt>; run with <tt>--heap 12000</tt></li>
<li> Petite Chez (7.4d): <tt>load</tt>
<li> PLT (4.2.4): in <tt>module</tt>; for benchmarks that use <tt>set-car!</tt> and <tt>set-cdr!</tt>,
PLT's R5RS support is used</li>
PLT&rsquo;s R5RS support is used</li>
<li> Scheme48 (1.8): <tt>load</tt> after <tt>,bench on</tt></li>
</ul>
These configurations are all &ldquo;safe mode,&rdquo; but they allow a
compiler to assume that built-in Scheme functions are not redefined
and that no top-level defintion is ever changed. Such assumptions
correspond to putting the benchmark in an R6RS library.</P>
<p>In general, we attempt to use the various implementations in a compentent way,
but not in a sophisticated way. For example, we do not tweak
inlining parameters or specify fixnum arithmetic (where appropriate),
which could produce significant improvements from some compilers.</p>
correspond to putting the benchmark in an R6RS library. We attempt to
use the various implementations in a compentent way, but not in a
sophisticated way. For example, we do not tweak inlining parameters or
specify fixnum arithmetic (where appropriate), which could produce
significant improvements from some compilers.</p>
<p>For more benchmarks and a more sophisticated use of a few compilers,
including fixnum- and flonum-specific arithmetic as well as unsafe modes,

37
collects/tests/mzscheme/benchmarks/shootout/mandelbrot-unsafe.ss
View File

@ -4,10 +4,15 @@
;;
;; Derived from the Chicken variant, which was
;; Contributed by Anthony Borla
;;
;; This version uses unsafe operations
#lang scheme/base
(require scheme/cmdline
scheme/unsafe/ops)
scheme/require (for-syntax scheme/base)
(filtered-in
(lambda (name) (regexp-replace #rx"unsafe-" name ""))
scheme/unsafe/ops))
(define +limit-sqr+ 4.0)
@ -16,15 +21,15 @@
;; -------------------------------
(define (mandelbrot x y n ci)
(let ((cr (unsafe-fl- (unsafe-fl/ (unsafe-fl* 2.0 (unsafe-fx->fl x)) (unsafe-fx->fl n)) 1.5)))
(let ((cr (fl- (fl/ (fl* 2.0 (fx->fl x)) (fx->fl n)) 1.5)))
(let loop ((i 0) (zr 0.0) (zi 0.0))
(if (unsafe-fx> i +iterations+)
(if (fx> i +iterations+)
1
(cond
((unsafe-fl> (unsafe-fl+ (unsafe-fl* zr zr) (unsafe-fl* zi zi)) +limit-sqr+) 0)
(else (loop (unsafe-fx+ 1 i)
(unsafe-fl+ (unsafe-fl- (unsafe-fl* zr zr) (unsafe-fl* zi zi)) cr)
(unsafe-fl+ (unsafe-fl* 2.0 (unsafe-fl* zr zi)) ci))))))))
((fl> (fl+ (fl* zr zr) (fl* zi zi)) +limit-sqr+) 0)
(else (loop (fx+ 1 i)
(fl+ (fl- (fl* zr zr) (fl* zi zi)) cr)
(fl+ (fl* 2.0 (fl* zr zi)) ci))))))))
;; -------------------------------
@ -35,23 +40,23 @@
(let loop-y ((y 0))
(when (unsafe-fx< y n)
(when (fx< y n)
(let ([ci (unsafe-fl- (unsafe-fl/ (unsafe-fl* 2.0 (unsafe-fx->fl y)) (unsafe-fx->fl n)) 1.0)])
(let ([ci (fl- (fl/ (fl* 2.0 (fx->fl y)) (fx->fl n)) 1.0)])
(let loop-x ((x 0) (bitnum 0) (byteacc 0))
(if (unsafe-fx< x n)
(let ([bitnum (unsafe-fx+ 1 bitnum)]
[byteacc (unsafe-fx+ (unsafe-fxlshift byteacc 1)
(if (fx< x n)
(let ([bitnum (fx+ 1 bitnum)]
[byteacc (fx+ (fxlshift byteacc 1)
(mandelbrot x y n ci))])
(cond
((unsafe-fx= bitnum 8)
((fx= bitnum 8)
(write-byte byteacc out)
(loop-x (unsafe-fx+ 1 x) 0 0))
(loop-x (fx+ 1 x) 0 0))
[else (loop-x (unsafe-fx+ 1 x) bitnum byteacc)]))
[else (loop-x (fx+ 1 x) bitnum byteacc)]))
(begin
(when (positive? bitnum)