From ca106a41343233e3e2e1d6393b97ff6de67e01c4 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 20 Jul 2010 18:53:32 -0400 Subject: [PATCH] Replaced the safe specialized nbody benchmark by the unsafe version. --- collects/meta/props | 11 -- .../tests/racket/benchmarks/shootout/auto.rkt | 1 - .../benchmarks/shootout/nbody-vec-unsafe.rkt | 169 ----------------- .../racket/benchmarks/shootout/nbody-vec.rkt | 117 ++++++------ .../tests/racket/benchmarks/shootout/run.rkt | 1 - .../typed/nbody-vec-unsafe-non-optimizing.rkt | 1 - .../typed/nbody-vec-unsafe-optimizing.rkt | 1 - .../shootout/typed/nbody-vec-unsafe.rktl | 170 ------------------ .../benchmarks/shootout/typed/nbody-vec.rktl | 115 ++++++------ 9 files changed, 117 insertions(+), 469 deletions(-) delete mode 100644 collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt delete mode 100644 collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-non-optimizing.rkt delete mode 100644 collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-optimizing.rkt delete mode 100644 collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe.rktl diff --git a/collects/meta/props b/collects/meta/props index 6640211b23..a4f5a51282 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1532,7 +1532,6 @@ path/s is either such a string or a list of them. "collects/tests/racket/benchmarks/shootout/meteor.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/nbody-generic.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/nbody-vec-generic.rkt" drdr:command-line (racket "-t" * "--" "10") -"collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/nbody-vec.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/nbody.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/nestedloop.rkt" drdr:command-line (racket "-t" * "--" "2") @@ -1545,7 +1544,6 @@ path/s is either such a string or a list of them. "collects/tests/racket/benchmarks/shootout/recursive.rkt" drdr:command-line (racket "-t" * "--" "2") "collects/tests/racket/benchmarks/shootout/run.rkt" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/spectralnorm-generic.rkt" drdr:command-line (racket "-t" * "--" "25") -"collects/tests/racket/benchmarks/shootout/spectralnorm-unsafe.rkt" drdr:command-line (racket * "5") "collects/tests/racket/benchmarks/shootout/spectralnorm.rkt" drdr:command-line (racket "-t" * "--" "25") "collects/tests/racket/benchmarks/shootout/spellcheck.rkt" drdr:command-line (mzc *) "collects/tests/racket/benchmarks/shootout/strcat.rkt" drdr:command-line (racket "-t" * "--" "25") @@ -1591,9 +1589,6 @@ path/s is either such a string or a list of them. "collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/mandelbrot-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "15") "collects/tests/racket/benchmarks/shootout/typed/mandelbrot-optimizing.rkt" drdr:command-line (racket "-t" * "--" "15") -"collects/tests/racket/benchmarks/shootout/typed/mandelbrot-unsafe-non-optimizing.rkt" drdr:command-line #f -"collects/tests/racket/benchmarks/shootout/typed/mandelbrot-unsafe-optimizing.rkt" drdr:command-line #f -"collects/tests/racket/benchmarks/shootout/typed/mandelbrot-unsafe.rktl" drdr:command-line (racket * "3") "collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/matrix.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/meteor-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "10") @@ -1610,9 +1605,6 @@ path/s is either such a string or a list of them. "collects/tests/racket/benchmarks/shootout/typed/nbody-vec-generic.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/nbody-vec-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "10") "collects/tests/racket/benchmarks/shootout/typed/nbody-vec-optimizing.rkt" drdr:command-line (racket "-t" * "--" "10") -"collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "10") -"collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-optimizing.rkt" drdr:command-line (racket "-t" * "--" "10") -"collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/nbody-vec.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/nbody.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/nestedloop-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "2") @@ -1649,9 +1641,6 @@ path/s is either such a string or a list of them. "collects/tests/racket/benchmarks/shootout/typed/spectralnorm-generic.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/spectralnorm-non-optimizing.rkt" drdr:command-line (racket "-t" * "--" "25") "collects/tests/racket/benchmarks/shootout/typed/spectralnorm-optimizing.rkt" drdr:command-line (racket "-t" * "--" "25") -"collects/tests/racket/benchmarks/shootout/typed/spectralnorm-unsafe-non-optimizing.rkt" drdr:command-line (racket * "5") -"collects/tests/racket/benchmarks/shootout/typed/spectralnorm-unsafe-optimizing.rkt" drdr:command-line (racket * "5") -"collects/tests/racket/benchmarks/shootout/typed/spectralnorm-unsafe.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/spectralnorm.rktl" drdr:command-line #f "collects/tests/racket/benchmarks/shootout/typed/spellcheck-non-optimizing.rkt" drdr:command-line (mzc *) "collects/tests/racket/benchmarks/shootout/typed/spellcheck-optimizing.rkt" drdr:command-line (mzc *) diff --git a/collects/tests/racket/benchmarks/shootout/auto.rkt b/collects/tests/racket/benchmarks/shootout/auto.rkt index 63b18eabf1..24a4799261 100755 --- a/collects/tests/racket/benchmarks/shootout/auto.rkt +++ b/collects/tests/racket/benchmarks/shootout/auto.rkt @@ -129,7 +129,6 @@ exec racket -qu "$0" ${1+"$@"} nbody-generic nbody-vec nbody-vec-generic - nbody-vec-unsafe nestedloop nothing nsieve diff --git a/collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt b/collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt deleted file mode 100644 index c0cacef496..0000000000 --- a/collects/tests/racket/benchmarks/shootout/nbody-vec-unsafe.rkt +++ /dev/null @@ -1,169 +0,0 @@ -#lang racket/base - -;; The Computer Language Benchmarks Game -;; http://shootout.alioth.debian.org/ -;; -;; Imperative-style implementation based on the SBCL implementation by -;; Patrick Frankenberger and Juho Snellman, but using only native Scheme -;; idioms like 'named let' and 'do' special form. -;; -;; Contributed by Anthony Borla, then converted for Racket -;; by Matthew Flatt and Brent Fulgham -;; Made unsafe and optimized by Sam TH -#| -Correct output N = 1000 is - --0.169075164 --0.169087605 -|# - -(require racket/cmdline racket/require - (only-in racket/flonum flvector) - (for-syntax racket/base) - (filtered-in - (lambda (name) - (regexp-replace - #rx"unsafe-fl" name "fl")) - racket/unsafe/ops)) - -;; ------------------------------ -;; define planetary masses, initial positions & velocity - -(define +pi+ 3.141592653589793) ;; define locally to enable inlining -(define +days-per-year+ 365.24) - -(define +solar-mass+ (* 4 +pi+ +pi+)) - -(define +dt+ 0.01) - -(define make-body flvector) -(define-syntax-rule (deffield n getter setter) - (begin (define-syntax-rule (getter b) (flvector-ref b n)) - (define-syntax-rule (setter b x) (flvector-set! b n x)))) -(deffield 0 body-x set-body-x!) -(deffield 1 body-y set-body-y!) -(deffield 2 body-z set-body-z!) -(deffield 3 body-vx set-body-vx!) -(deffield 4 body-vy set-body-vy!) -(deffield 5 body-vz set-body-vz!) -(deffield 6 body-mass set-body-mass!) - -(define *sun* - (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+)) - -(define *jupiter* - (make-body 4.84143144246472090 - -1.16032004402742839 - -1.03622044471123109e-1 - (fl* 1.66007664274403694e-3 +days-per-year+) - (fl* 7.69901118419740425e-3 +days-per-year+) - (fl* -6.90460016972063023e-5 +days-per-year+) - (fl* 9.54791938424326609e-4 +solar-mass+))) - -(define *saturn* - (make-body 8.34336671824457987 - 4.12479856412430479 - -4.03523417114321381e-1 - (fl* -2.76742510726862411e-3 +days-per-year+) - (fl* 4.99852801234917238e-3 +days-per-year+) - (fl* 2.30417297573763929e-5 +days-per-year+) - (fl* 2.85885980666130812e-4 +solar-mass+))) - -(define *uranus* - (make-body 1.28943695621391310e1 - -1.51111514016986312e1 - -2.23307578892655734e-1 - (fl* 2.96460137564761618e-03 +days-per-year+) - (fl* 2.37847173959480950e-03 +days-per-year+) - (fl* -2.96589568540237556e-05 +days-per-year+) - (fl* 4.36624404335156298e-05 +solar-mass+))) - -(define *neptune* - (make-body 1.53796971148509165e+01 - -2.59193146099879641e+01 - 1.79258772950371181e-01 - (fl* 2.68067772490389322e-03 +days-per-year+) - (fl* 1.62824170038242295e-03 +days-per-year+) - (fl* -9.51592254519715870e-05 +days-per-year+) - (fl* 5.15138902046611451e-05 +solar-mass+))) - -(define *system* (vector *sun* *jupiter* *saturn* *uranus* *neptune*)) -(define *system-size* 5) -;; ------------------------------- -(define (offset-momentum) - (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) - (if (unsafe-fx= i *system-size*) - (begin - (set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) - (set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) - (set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) - (let ([i1 (unsafe-vector-ref *system* i)]) - (loop-i (unsafe-fx+ i 1) - (fl+ px (fl* (body-vx i1) (body-mass i1))) - (fl+ py (fl* (body-vy i1) (body-mass i1))) - (fl+ pz (fl* (body-vz i1) (body-mass i1)))))))) - -;; ------------------------------- -(define (energy) - (let loop-o ([o 0] [e 0.0]) - (if (unsafe-fx= o *system-size*) - e - (let* ([o1 (unsafe-vector-ref *system* o)] - [e (fl+ e (fl* (fl* 0.5 (body-mass o1)) - (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) - (fl* (body-vy o1) (body-vy o1))) - (fl* (body-vz o1) (body-vz o1)))))]) - (let loop-i ([i (unsafe-fx+ o 1)] [e e]) - (if (unsafe-fx= i *system-size*) - (loop-o (unsafe-fx+ o 1) e) - (let* ([i1 (unsafe-vector-ref *system* i)] - [dx (fl- (body-x o1) (body-x i1))] - [dy (fl- (body-y o1) (body-y i1))] - [dz (fl- (body-z o1) (body-z i1))] - [dist (flsqrt (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz)))] - [e (fl- e (fl/ (fl* (body-mass o1) (body-mass i1)) dist))]) - (loop-i (unsafe-fx+ i 1) e)))))))) - -;; ------------------------------- -(define (advance) - (let loop-o ([o 0]) - (unless (unsafe-fx= o *system-size*) - (let* ([o1 (unsafe-vector-ref *system* o)]) - (let loop-i ([i (unsafe-fx+ o 1)] - [vx (body-vx o1)] - [vy (body-vy o1)] - [vz (body-vz o1)]) - (if (unsafe-fx< i *system-size*) - (let* ([i1 (unsafe-vector-ref *system* i)] - [dx (fl- (body-x o1) (body-x i1))] - [dy (fl- (body-y o1) (body-y i1))] - [dz (fl- (body-z o1) (body-z i1))] - [dist2 (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz))] - [mag (fl/ +dt+ (fl* dist2 (flsqrt dist2)))] - [dxmag (fl* dx mag)] - [dymag (fl* dy mag)] - [dzmag (fl* dz mag)] - [om (body-mass o1)] - [im (body-mass i1)]) - (set-body-vx! i1 (fl+ (body-vx i1) (fl* dxmag om))) - (set-body-vy! i1 (fl+ (body-vy i1) (fl* dymag om))) - (set-body-vz! i1 (fl+ (body-vz i1) (fl* dzmag om))) - (loop-i (unsafe-fx+ i 1) - (fl- vx (fl* dxmag im)) - (fl- vy (fl* dymag im)) - (fl- vz (fl* dzmag im)))) - (begin (set-body-vx! o1 vx) - (set-body-vy! o1 vy) - (set-body-vz! o1 vz) - (set-body-x! o1 (fl+ (body-x o1) (fl* +dt+ vx))) - (set-body-y! o1 (fl+ (body-y o1) (fl* +dt+ vy))) - (set-body-z! o1 (fl+ (body-z o1) (fl* +dt+ vz))))))) - (loop-o (unsafe-fx+ o 1))))) - -;; ------------------------------- - -(let ([n (command-line #:args (n) (string->number n))]) - (offset-momentum) - (printf "~a\n" (real->decimal-string (energy) 9)) - (for ([i (in-range n)]) (advance)) - (printf "~a\n" (real->decimal-string (energy) 9))) diff --git a/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt b/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt index fcda261dbe..c0cacef496 100644 --- a/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt +++ b/collects/tests/racket/benchmarks/shootout/nbody-vec.rkt @@ -9,7 +9,7 @@ ;; ;; Contributed by Anthony Borla, then converted for Racket ;; by Matthew Flatt and Brent Fulgham - +;; Made unsafe and optimized by Sam TH #| Correct output N = 1000 is @@ -17,16 +17,22 @@ Correct output N = 1000 is -0.169087605 |# -(require racket/cmdline - racket/flonum) +(require racket/cmdline racket/require + (only-in racket/flonum flvector) + (for-syntax racket/base) + (filtered-in + (lambda (name) + (regexp-replace + #rx"unsafe-fl" name "fl")) + racket/unsafe/ops)) ;; ------------------------------ ;; define planetary masses, initial positions & velocity -(define +pi+ 3.141592653589793) +(define +pi+ 3.141592653589793) ;; define locally to enable inlining (define +days-per-year+ 365.24) -(define +solar-mass+ (* 4.0 +pi+ +pi+)) +(define +solar-mass+ (* 4 +pi+ +pi+)) (define +dt+ 0.01) @@ -49,51 +55,50 @@ Correct output N = 1000 is (make-body 4.84143144246472090 -1.16032004402742839 -1.03622044471123109e-1 - (* 1.66007664274403694e-3 +days-per-year+) - (* 7.69901118419740425e-3 +days-per-year+) - (* -6.90460016972063023e-5 +days-per-year+) - (* 9.54791938424326609e-4 +solar-mass+))) + (fl* 1.66007664274403694e-3 +days-per-year+) + (fl* 7.69901118419740425e-3 +days-per-year+) + (fl* -6.90460016972063023e-5 +days-per-year+) + (fl* 9.54791938424326609e-4 +solar-mass+))) (define *saturn* (make-body 8.34336671824457987 4.12479856412430479 -4.03523417114321381e-1 - (* -2.76742510726862411e-3 +days-per-year+) - (* 4.99852801234917238e-3 +days-per-year+) - (* 2.30417297573763929e-5 +days-per-year+) - (* 2.85885980666130812e-4 +solar-mass+))) + (fl* -2.76742510726862411e-3 +days-per-year+) + (fl* 4.99852801234917238e-3 +days-per-year+) + (fl* 2.30417297573763929e-5 +days-per-year+) + (fl* 2.85885980666130812e-4 +solar-mass+))) (define *uranus* (make-body 1.28943695621391310e1 -1.51111514016986312e1 -2.23307578892655734e-1 - (* 2.96460137564761618e-03 +days-per-year+) - (* 2.37847173959480950e-03 +days-per-year+) - (* -2.96589568540237556e-05 +days-per-year+) - (* 4.36624404335156298e-05 +solar-mass+))) + (fl* 2.96460137564761618e-03 +days-per-year+) + (fl* 2.37847173959480950e-03 +days-per-year+) + (fl* -2.96589568540237556e-05 +days-per-year+) + (fl* 4.36624404335156298e-05 +solar-mass+))) (define *neptune* (make-body 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 - (* 2.68067772490389322e-03 +days-per-year+) - (* 1.62824170038242295e-03 +days-per-year+) - (* -9.51592254519715870e-05 +days-per-year+) - (* 5.15138902046611451e-05 +solar-mass+))) + (fl* 2.68067772490389322e-03 +days-per-year+) + (fl* 1.62824170038242295e-03 +days-per-year+) + (fl* -9.51592254519715870e-05 +days-per-year+) + (fl* 5.15138902046611451e-05 +solar-mass+))) (define *system* (vector *sun* *jupiter* *saturn* *uranus* *neptune*)) (define *system-size* 5) - ;; ------------------------------- (define (offset-momentum) (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) - (if (= i *system-size*) + (if (unsafe-fx= i *system-size*) (begin - (set-body-vx! (vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) - (set-body-vy! (vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) - (set-body-vz! (vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) - (let ([i1 (vector-ref *system* i)]) - (loop-i (add1 i) + (set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) + (set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) + (set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) + (let ([i1 (unsafe-vector-ref *system* i)]) + (loop-i (unsafe-fx+ i 1) (fl+ px (fl* (body-vx i1) (body-mass i1))) (fl+ py (fl* (body-vy i1) (body-mass i1))) (fl+ pz (fl* (body-vz i1) (body-mass i1)))))))) @@ -101,63 +106,59 @@ Correct output N = 1000 is ;; ------------------------------- (define (energy) (let loop-o ([o 0] [e 0.0]) - (if (= o *system-size*) + (if (unsafe-fx= o *system-size*) e - (let* ([o1 (vector-ref *system* o)] - [e (+ e (fl* 0.5 - (fl* (body-mass o1) - (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) - (fl* (body-vy o1) (body-vy o1))) - (fl* (body-vz o1) (body-vz o1))))))]) - (let loop-i ([i (add1 o)] [e e]) - (if (= i *system-size*) - (loop-o (add1 o) e) - (let* ([i1 (vector-ref *system* i)] + (let* ([o1 (unsafe-vector-ref *system* o)] + [e (fl+ e (fl* (fl* 0.5 (body-mass o1)) + (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) + (fl* (body-vy o1) (body-vy o1))) + (fl* (body-vz o1) (body-vz o1)))))]) + (let loop-i ([i (unsafe-fx+ o 1)] [e e]) + (if (unsafe-fx= i *system-size*) + (loop-o (unsafe-fx+ o 1) e) + (let* ([i1 (unsafe-vector-ref *system* i)] [dx (fl- (body-x o1) (body-x i1))] [dy (fl- (body-y o1) (body-y i1))] [dz (fl- (body-z o1) (body-z i1))] [dist (flsqrt (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz)))] [e (fl- e (fl/ (fl* (body-mass o1) (body-mass i1)) dist))]) - (loop-i (add1 i) e)))))))) + (loop-i (unsafe-fx+ i 1) e)))))))) ;; ------------------------------- (define (advance) (let loop-o ([o 0]) - (unless (= o *system-size*) - (let* ([o1 (vector-ref *system* o)] - [o1x (body-x o1)] - [o1y (body-y o1)] - [o1z (body-z o1)] - [om (body-mass o1)]) - (let loop-i ([i (add1 o)] + (unless (unsafe-fx= o *system-size*) + (let* ([o1 (unsafe-vector-ref *system* o)]) + (let loop-i ([i (unsafe-fx+ o 1)] [vx (body-vx o1)] [vy (body-vy o1)] [vz (body-vz o1)]) - (if (< i *system-size*) - (let* ([i1 (vector-ref *system* i)] - [dx (fl- o1x (body-x i1))] - [dy (fl- o1y (body-y i1))] - [dz (fl- o1z (body-z i1))] + (if (unsafe-fx< i *system-size*) + (let* ([i1 (unsafe-vector-ref *system* i)] + [dx (fl- (body-x o1) (body-x i1))] + [dy (fl- (body-y o1) (body-y i1))] + [dz (fl- (body-z o1) (body-z i1))] [dist2 (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz))] [mag (fl/ +dt+ (fl* dist2 (flsqrt dist2)))] [dxmag (fl* dx mag)] [dymag (fl* dy mag)] [dzmag (fl* dz mag)] - [im (body-mass i1)]) + [om (body-mass o1)] + [im (body-mass i1)]) (set-body-vx! i1 (fl+ (body-vx i1) (fl* dxmag om))) (set-body-vy! i1 (fl+ (body-vy i1) (fl* dymag om))) (set-body-vz! i1 (fl+ (body-vz i1) (fl* dzmag om))) - (loop-i (add1 i) + (loop-i (unsafe-fx+ i 1) (fl- vx (fl* dxmag im)) (fl- vy (fl* dymag im)) (fl- vz (fl* dzmag im)))) (begin (set-body-vx! o1 vx) (set-body-vy! o1 vy) (set-body-vz! o1 vz) - (set-body-x! o1 (fl+ o1x (fl* +dt+ vx))) - (set-body-y! o1 (fl+ o1y (fl* +dt+ vy))) - (set-body-z! o1 (fl+ o1z (fl* +dt+ vz))))))) - (loop-o (add1 o))))) + (set-body-x! o1 (fl+ (body-x o1) (fl* +dt+ vx))) + (set-body-y! o1 (fl+ (body-y o1) (fl* +dt+ vy))) + (set-body-z! o1 (fl+ (body-z o1) (fl* +dt+ vz))))))) + (loop-o (unsafe-fx+ o 1))))) ;; ------------------------------- diff --git a/collects/tests/racket/benchmarks/shootout/run.rkt b/collects/tests/racket/benchmarks/shootout/run.rkt index 55786793e4..a328ccb8d7 100644 --- a/collects/tests/racket/benchmarks/shootout/run.rkt +++ b/collects/tests/racket/benchmarks/shootout/run.rkt @@ -30,7 +30,6 @@ ("nbody-generic" "3000000") ("nbody-vec" "3000000") ("nbody-vec-generic" "3000000") - ("nbody-vec-unsafe" "3000000") ("nestedloop" "33") ("nothing" "") ("nsieve" "12") diff --git a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-non-optimizing.rkt b/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-non-optimizing.rkt deleted file mode 100644 index 76c7f4ba0a..0000000000 --- a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-non-optimizing.rkt +++ /dev/null @@ -1 +0,0 @@ -#lang s-exp "wrapper.rkt" diff --git a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-optimizing.rkt b/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-optimizing.rkt deleted file mode 100644 index 76c7f4ba0a..0000000000 --- a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe-optimizing.rkt +++ /dev/null @@ -1 +0,0 @@ -#lang s-exp "wrapper.rkt" diff --git a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe.rktl b/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe.rktl deleted file mode 100644 index a57e1ff568..0000000000 --- a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec-unsafe.rktl +++ /dev/null @@ -1,170 +0,0 @@ -;; The Computer Language Benchmarks Game -;; http://shootout.alioth.debian.org/ -;; -;; Imperative-style implementation based on the SBCL implementation by -;; Patrick Frankenberger and Juho Snellman, but using only native Scheme -;; idioms like 'named let' and 'do' special form. -;; -;; Contributed by Anthony Borla, then converted for Racket -;; by Matthew Flatt and Brent Fulgham -;; Made unsafe and optimized by Sam TH -#| -Correct output N = 1000 is - --0.169075164 --0.169087605 -|# - -(require racket/cmdline racket/require - (only-in racket/flonum flvector) - (for-syntax racket/base) - (filtered-in - (lambda (name) - (regexp-replace - #rx"unsafe-fl" name "fl")) - racket/unsafe/ops)) - -;; ------------------------------ -;; define planetary masses, initial positions & velocity - -(define +pi+ 3.141592653589793) ;; define locally to enable inlining -(define +days-per-year+ 365.24) - -(define +solar-mass+ (* 4.0 +pi+ +pi+)) - -(define +dt+ 0.01) - -(define make-body flvector) -(define-syntax-rule (deffield n getter setter) - (begin (define-syntax-rule (getter b) (flvector-ref b n)) - (define-syntax-rule (setter b x) (flvector-set! b n x)))) -(deffield 0 body-x set-body-x!) -(deffield 1 body-y set-body-y!) -(deffield 2 body-z set-body-z!) -(deffield 3 body-vx set-body-vx!) -(deffield 4 body-vy set-body-vy!) -(deffield 5 body-vz set-body-vz!) -(deffield 6 body-mass set-body-mass!) - -(define *sun* - (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+)) - -(define *jupiter* - (make-body 4.84143144246472090 - -1.16032004402742839 - -1.03622044471123109e-1 - (fl* 1.66007664274403694e-3 +days-per-year+) - (fl* 7.69901118419740425e-3 +days-per-year+) - (fl* -6.90460016972063023e-5 +days-per-year+) - (fl* 9.54791938424326609e-4 +solar-mass+))) - -(define *saturn* - (make-body 8.34336671824457987 - 4.12479856412430479 - -4.03523417114321381e-1 - (fl* -2.76742510726862411e-3 +days-per-year+) - (fl* 4.99852801234917238e-3 +days-per-year+) - (fl* 2.30417297573763929e-5 +days-per-year+) - (fl* 2.85885980666130812e-4 +solar-mass+))) - -(define *uranus* - (make-body 1.28943695621391310e1 - -1.51111514016986312e1 - -2.23307578892655734e-1 - (fl* 2.96460137564761618e-03 +days-per-year+) - (fl* 2.37847173959480950e-03 +days-per-year+) - (fl* -2.96589568540237556e-05 +days-per-year+) - (fl* 4.36624404335156298e-05 +solar-mass+))) - -(define *neptune* - (make-body 1.53796971148509165e+01 - -2.59193146099879641e+01 - 1.79258772950371181e-01 - (fl* 2.68067772490389322e-03 +days-per-year+) - (fl* 1.62824170038242295e-03 +days-per-year+) - (fl* -9.51592254519715870e-05 +days-per-year+) - (fl* 5.15138902046611451e-05 +solar-mass+))) - -(define *system* (vector *sun* *jupiter* *saturn* *uranus* *neptune*)) -(define *system-size* 5) -;; ------------------------------- -(: offset-momentum ( -> Void)) -(define (offset-momentum) - (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) - (if (unsafe-fx= i *system-size*) - (begin - (set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) - (set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) - (set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) - (let ([i1 (unsafe-vector-ref *system* i)]) - (loop-i (unsafe-fx+ i 1) - (fl+ px (fl* (body-vx i1) (body-mass i1))) - (fl+ py (fl* (body-vy i1) (body-mass i1))) - (fl+ pz (fl* (body-vz i1) (body-mass i1)))))))) - -;; ------------------------------- -(: energy ( -> Float)) -(define (energy) - (let loop-o ([o 0] [e 0.0]) - (if (unsafe-fx= o *system-size*) - e - (let* ([o1 (unsafe-vector-ref *system* o)] - [e (fl+ e (fl* (fl* 0.5 (body-mass o1)) - (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) - (fl* (body-vy o1) (body-vy o1))) - (fl* (body-vz o1) (body-vz o1)))))]) - (let loop-i ([i (unsafe-fx+ o 1)] [e e]) - (if (unsafe-fx= i *system-size*) - (loop-o (unsafe-fx+ o 1) e) - (let* ([i1 (unsafe-vector-ref *system* i)] - [dx (fl- (body-x o1) (body-x i1))] - [dy (fl- (body-y o1) (body-y i1))] - [dz (fl- (body-z o1) (body-z i1))] - [dist (flsqrt (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz)))] - [e (fl- e (fl/ (fl* (body-mass o1) (body-mass i1)) dist))]) - (loop-i (unsafe-fx+ i 1) e)))))))) - -;; ------------------------------- -(: advance ( -> Void)) -(define (advance) - (let loop-o ([o 0]) - (unless (unsafe-fx= o *system-size*) - (let* ([o1 (unsafe-vector-ref *system* o)]) - (let loop-i ([i (unsafe-fx+ o 1)] - [vx (body-vx o1)] - [vy (body-vy o1)] - [vz (body-vz o1)]) - (if (unsafe-fx< i *system-size*) - (let* ([i1 (unsafe-vector-ref *system* i)] - [dx (fl- (body-x o1) (body-x i1))] - [dy (fl- (body-y o1) (body-y i1))] - [dz (fl- (body-z o1) (body-z i1))] - [dist2 (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz))] - [mag (fl/ +dt+ (fl* dist2 (flsqrt dist2)))] - [dxmag (fl* dx mag)] - [dymag (fl* dy mag)] - [dzmag (fl* dz mag)] - [om (body-mass o1)] - [im (body-mass i1)]) - (set-body-vx! i1 (fl+ (body-vx i1) (fl* dxmag om))) - (set-body-vy! i1 (fl+ (body-vy i1) (fl* dymag om))) - (set-body-vz! i1 (fl+ (body-vz i1) (fl* dzmag om))) - (loop-i (unsafe-fx+ i 1) - (fl- vx (fl* dxmag im)) - (fl- vy (fl* dymag im)) - (fl- vz (fl* dzmag im)))) - (begin (set-body-vx! o1 vx) - (set-body-vy! o1 vy) - (set-body-vz! o1 vz) - (set-body-x! o1 (fl+ (body-x o1) (fl* +dt+ vx))) - (set-body-y! o1 (fl+ (body-y o1) (fl* +dt+ vy))) - (set-body-z! o1 (fl+ (body-z o1) (fl* +dt+ vz))))))) - (loop-o (unsafe-fx+ o 1))))) - -;; ------------------------------- - -(let ([n (command-line #:args (n) (assert (string->number (assert n string?)) exact-integer?))]) - (offset-momentum) - (printf "~a\n" (real->decimal-string (energy) 9)) - (for ([i (in-range n)]) (advance)) - (printf "~a\n" (real->decimal-string (energy) 9))) diff --git a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec.rktl b/collects/tests/racket/benchmarks/shootout/typed/nbody-vec.rktl index fe78b7b436..a57e1ff568 100644 --- a/collects/tests/racket/benchmarks/shootout/typed/nbody-vec.rktl +++ b/collects/tests/racket/benchmarks/shootout/typed/nbody-vec.rktl @@ -7,7 +7,7 @@ ;; ;; Contributed by Anthony Borla, then converted for Racket ;; by Matthew Flatt and Brent Fulgham - +;; Made unsafe and optimized by Sam TH #| Correct output N = 1000 is @@ -15,13 +15,19 @@ Correct output N = 1000 is -0.169087605 |# -(require racket/cmdline - racket/flonum) +(require racket/cmdline racket/require + (only-in racket/flonum flvector) + (for-syntax racket/base) + (filtered-in + (lambda (name) + (regexp-replace + #rx"unsafe-fl" name "fl")) + racket/unsafe/ops)) ;; ------------------------------ ;; define planetary masses, initial positions & velocity -(define +pi+ 3.141592653589793) +(define +pi+ 3.141592653589793) ;; define locally to enable inlining (define +days-per-year+ 365.24) (define +solar-mass+ (* 4.0 +pi+ +pi+)) @@ -47,52 +53,51 @@ Correct output N = 1000 is (make-body 4.84143144246472090 -1.16032004402742839 -1.03622044471123109e-1 - (* 1.66007664274403694e-3 +days-per-year+) - (* 7.69901118419740425e-3 +days-per-year+) - (* -6.90460016972063023e-5 +days-per-year+) - (* 9.54791938424326609e-4 +solar-mass+))) + (fl* 1.66007664274403694e-3 +days-per-year+) + (fl* 7.69901118419740425e-3 +days-per-year+) + (fl* -6.90460016972063023e-5 +days-per-year+) + (fl* 9.54791938424326609e-4 +solar-mass+))) (define *saturn* (make-body 8.34336671824457987 4.12479856412430479 -4.03523417114321381e-1 - (* -2.76742510726862411e-3 +days-per-year+) - (* 4.99852801234917238e-3 +days-per-year+) - (* 2.30417297573763929e-5 +days-per-year+) - (* 2.85885980666130812e-4 +solar-mass+))) + (fl* -2.76742510726862411e-3 +days-per-year+) + (fl* 4.99852801234917238e-3 +days-per-year+) + (fl* 2.30417297573763929e-5 +days-per-year+) + (fl* 2.85885980666130812e-4 +solar-mass+))) (define *uranus* (make-body 1.28943695621391310e1 -1.51111514016986312e1 -2.23307578892655734e-1 - (* 2.96460137564761618e-03 +days-per-year+) - (* 2.37847173959480950e-03 +days-per-year+) - (* -2.96589568540237556e-05 +days-per-year+) - (* 4.36624404335156298e-05 +solar-mass+))) + (fl* 2.96460137564761618e-03 +days-per-year+) + (fl* 2.37847173959480950e-03 +days-per-year+) + (fl* -2.96589568540237556e-05 +days-per-year+) + (fl* 4.36624404335156298e-05 +solar-mass+))) (define *neptune* (make-body 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 - (* 2.68067772490389322e-03 +days-per-year+) - (* 1.62824170038242295e-03 +days-per-year+) - (* -9.51592254519715870e-05 +days-per-year+) - (* 5.15138902046611451e-05 +solar-mass+))) + (fl* 2.68067772490389322e-03 +days-per-year+) + (fl* 1.62824170038242295e-03 +days-per-year+) + (fl* -9.51592254519715870e-05 +days-per-year+) + (fl* 5.15138902046611451e-05 +solar-mass+))) (define *system* (vector *sun* *jupiter* *saturn* *uranus* *neptune*)) (define *system-size* 5) - ;; ------------------------------- (: offset-momentum ( -> Void)) (define (offset-momentum) (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) - (if (= i *system-size*) + (if (unsafe-fx= i *system-size*) (begin - (set-body-vx! (vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) - (set-body-vy! (vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) - (set-body-vz! (vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) - (let ([i1 (vector-ref *system* i)]) - (loop-i (add1 i) + (set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) + (set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) + (set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) + (let ([i1 (unsafe-vector-ref *system* i)]) + (loop-i (unsafe-fx+ i 1) (fl+ px (fl* (body-vx i1) (body-mass i1))) (fl+ py (fl* (body-vy i1) (body-mass i1))) (fl+ pz (fl* (body-vz i1) (body-mass i1)))))))) @@ -101,64 +106,60 @@ Correct output N = 1000 is (: energy ( -> Float)) (define (energy) (let loop-o ([o 0] [e 0.0]) - (if (= o *system-size*) + (if (unsafe-fx= o *system-size*) e - (let* ([o1 (vector-ref *system* o)] - [e (+ e (fl* 0.5 - (fl* (body-mass o1) - (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) - (fl* (body-vy o1) (body-vy o1))) - (fl* (body-vz o1) (body-vz o1))))))]) - (let loop-i ([i (add1 o)] [e e]) - (if (= i *system-size*) - (loop-o (add1 o) e) - (let* ([i1 (vector-ref *system* i)] + (let* ([o1 (unsafe-vector-ref *system* o)] + [e (fl+ e (fl* (fl* 0.5 (body-mass o1)) + (fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) + (fl* (body-vy o1) (body-vy o1))) + (fl* (body-vz o1) (body-vz o1)))))]) + (let loop-i ([i (unsafe-fx+ o 1)] [e e]) + (if (unsafe-fx= i *system-size*) + (loop-o (unsafe-fx+ o 1) e) + (let* ([i1 (unsafe-vector-ref *system* i)] [dx (fl- (body-x o1) (body-x i1))] [dy (fl- (body-y o1) (body-y i1))] [dz (fl- (body-z o1) (body-z i1))] [dist (flsqrt (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz)))] [e (fl- e (fl/ (fl* (body-mass o1) (body-mass i1)) dist))]) - (loop-i (add1 i) e)))))))) + (loop-i (unsafe-fx+ i 1) e)))))))) ;; ------------------------------- (: advance ( -> Void)) (define (advance) (let loop-o ([o 0]) - (unless (= o *system-size*) - (let* ([o1 (vector-ref *system* o)] - [o1x (body-x o1)] - [o1y (body-y o1)] - [o1z (body-z o1)] - [om (body-mass o1)]) - (let loop-i ([i (add1 o)] + (unless (unsafe-fx= o *system-size*) + (let* ([o1 (unsafe-vector-ref *system* o)]) + (let loop-i ([i (unsafe-fx+ o 1)] [vx (body-vx o1)] [vy (body-vy o1)] [vz (body-vz o1)]) - (if (< i *system-size*) - (let* ([i1 (vector-ref *system* i)] - [dx (fl- o1x (body-x i1))] - [dy (fl- o1y (body-y i1))] - [dz (fl- o1z (body-z i1))] + (if (unsafe-fx< i *system-size*) + (let* ([i1 (unsafe-vector-ref *system* i)] + [dx (fl- (body-x o1) (body-x i1))] + [dy (fl- (body-y o1) (body-y i1))] + [dz (fl- (body-z o1) (body-z i1))] [dist2 (fl+ (fl+ (fl* dx dx) (fl* dy dy)) (fl* dz dz))] [mag (fl/ +dt+ (fl* dist2 (flsqrt dist2)))] [dxmag (fl* dx mag)] [dymag (fl* dy mag)] [dzmag (fl* dz mag)] - [im (body-mass i1)]) + [om (body-mass o1)] + [im (body-mass i1)]) (set-body-vx! i1 (fl+ (body-vx i1) (fl* dxmag om))) (set-body-vy! i1 (fl+ (body-vy i1) (fl* dymag om))) (set-body-vz! i1 (fl+ (body-vz i1) (fl* dzmag om))) - (loop-i (add1 i) + (loop-i (unsafe-fx+ i 1) (fl- vx (fl* dxmag im)) (fl- vy (fl* dymag im)) (fl- vz (fl* dzmag im)))) (begin (set-body-vx! o1 vx) (set-body-vy! o1 vy) (set-body-vz! o1 vz) - (set-body-x! o1 (fl+ o1x (fl* +dt+ vx))) - (set-body-y! o1 (fl+ o1y (fl* +dt+ vy))) - (set-body-z! o1 (fl+ o1z (fl* +dt+ vz))))))) - (loop-o (add1 o))))) + (set-body-x! o1 (fl+ (body-x o1) (fl* +dt+ vx))) + (set-body-y! o1 (fl+ (body-y o1) (fl* +dt+ vy))) + (set-body-z! o1 (fl+ (body-z o1) (fl* +dt+ vz))))))) + (loop-o (unsafe-fx+ o 1))))) ;; -------------------------------