[commit: nofib] master: Add the spectral-norm shootout benchmark (2fcb391)
Johan Tibell
johan.tibell at gmail.com
Tue Feb 5 21:41:34 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/nofib
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2fcb3915132c691be0e3246dc136fbd8b47c4da1
>---------------------------------------------------------------
commit 2fcb3915132c691be0e3246dc136fbd8b47c4da1
Author: Johan Tibell <johan.tibell at gmail.com>
Date: Tue Feb 5 11:46:35 2013 -0800
Add the spectral-norm shootout benchmark
>---------------------------------------------------------------
.gitignore | 3 +-
shootout/Makefile | 2 +-
shootout/spectral-norm/Main.hs | 110 ++++++++++++++++++++
.../{fannkuch-redux => spectral-norm}/Makefile | 8 +-
shootout/spectral-norm/spectral-norm.faststdout | 1 +
shootout/spectral-norm/spectral-norm.stdout | 1 +
6 files changed, 119 insertions(+), 6 deletions(-)
diff --git a/.gitignore b/.gitignore
index c25cc51..32e5c30 100644
--- a/.gitignore
+++ b/.gitignore
@@ -51,8 +51,9 @@ real/scs/scs
real/symalg/symalg
real/veritas/veritas
-shootout/fannkuch-redux/fannkuck-redux
+shootout/fannkuch-redux/fannkuch-redux
shootout/pidigits/pidigits
+shootout/spectral-norm/spectral-norm
spectral/ansi/ansi
spectral/atom/atom
diff --git a/shootout/Makefile b/shootout/Makefile
index 406998d..fe0072a 100644
--- a/shootout/Makefile
+++ b/shootout/Makefile
@@ -1,7 +1,7 @@
TOP = ..
include $(TOP)/mk/boilerplate.mk
-SUBDIRS = fannkuch-redux pidigits
+SUBDIRS = fannkuch-redux pidigits spectral-norm
include $(TOP)/mk/target.mk
diff --git a/shootout/spectral-norm/Main.hs b/shootout/spectral-norm/Main.hs
new file mode 100644
index 0000000..ed6c022
--- /dev/null
+++ b/shootout/spectral-norm/Main.hs
@@ -0,0 +1,110 @@
+--
+-- The Computer Language Benchmarks Game
+-- http://benchmarksgame.alioth.debian.org/
+--
+-- Modified by Ryan Trinkle: 1) change from divInt# to uncheckedIShiftRA#
+-- 2) changed -optc-O to -optc-O3
+-- 3) added -optc-ffast-math
+-- Translation from Clean by Don Stewart
+-- Parallelized by Louis Wasserman
+--
+-- Should be compiled with:
+-- -threaded -funbox-strict-fields -O2 -fvia-c -optc-O3
+-- -fexcess-precision -optc-ffast-math
+-- Should be run with:
+-- +RTS -N<number of cores>
+
+import System.Environment
+import Foreign.Marshal.Array
+import Foreign
+import Text.Printf
+import Control.Concurrent
+import Control.Monad
+import GHC.Base
+import GHC.Conc
+
+type Reals = Ptr Double
+
+main = do
+ n <- getArgs >>= readIO . head
+ allocaArray n $ \ u -> allocaArray n $ \ v -> do
+ forM_ [0..n-1] $ \i -> pokeElemOff u i 1 >> pokeElemOff v i 0
+
+ powerMethod 10 n u v
+ printf "%.9f\n" =<< eigenvalue n u v 0 0 0
+
+------------------------------------------------------------------------
+
+eigenvalue :: Int -> Reals -> Reals -> Int -> Double -> Double -> IO Double
+eigenvalue !n !u !v !i !vBv !vv
+ | i < n = do ui <- peekElemOff u i
+ vi <- peekElemOff v i
+ eigenvalue n u v (i+1) (vBv + ui * vi) (vv + vi * vi)
+ | otherwise = return $! sqrt $! vBv / vv
+
+------------------------------------------------------------------------
+
+-- Essentially borrowed from the Java implementation.
+data CyclicBarrier = Cyclic !Int !(MVar (Int, [MVar ()]))
+
+await :: CyclicBarrier -> IO ()
+await (Cyclic k waitsVar) = do
+ (x, waits) <- takeMVar waitsVar
+ if x <= 1 then do
+ mapM_ (`putMVar` ()) waits
+ putMVar waitsVar (k, [])
+ else do
+ var <- newEmptyMVar
+ putMVar waitsVar (x-1,var:waits)
+ takeMVar var
+
+newCyclicBarrier :: Int -> IO CyclicBarrier
+newCyclicBarrier k = liftM (Cyclic k) (newMVar (k, []))
+
+powerMethod :: Int -> Int -> Reals -> Reals -> IO ()
+powerMethod z n u v = allocaArray n $ \ !t -> do
+ let chunk = (n + numCapabilities - 1) `quotInt` numCapabilities
+ !barrier <- newCyclicBarrier $! (n + chunk - 1) `quotInt` chunk
+ let timesAtAv !s !d l r = do
+ timesAv n s t l r
+ await barrier
+ timesAtv n t d l r
+ await barrier
+ let thread !l !r = foldr (>>) (return ()) $ replicate z $ do
+ timesAtAv u v l r
+ timesAtAv v u l r
+ let go l = case l + chunk of
+ r | r < n -> forkIO (thread l r) >> go r
+ | otherwise -> thread l n
+ go 0
+
+timesAv :: Int -> Reals -> Reals -> Int -> Int -> IO ()
+timesAv !n !u !au !l !r = go l where
+ go :: Int -> IO ()
+ go !i = when (i < r) $ do
+ let avsum !j !acc
+ | j < n = do
+ !uj <- peekElemOff u j
+ avsum (j+1) (acc + ((aij i j) * uj))
+ | otherwise = pokeElemOff au i acc >> go (i+1)
+ avsum 0 0
+
+timesAtv :: Int -> Reals -> Reals -> Int -> Int -> IO ()
+timesAtv !n !u !a !l !r = go l
+ where
+ go :: Int -> IO ()
+ go !i = when (i < r) $ do
+ let atvsum !j !acc
+ | j < n = do !uj <- peekElemOff u j
+ atvsum (j+1) (acc + ((aij j i) * uj))
+ | otherwise = pokeElemOff a i acc >> go (i+1)
+ atvsum 0 0
+
+--
+-- manually unbox the inner loop:
+-- aij i j = 1 / fromIntegral ((i+j) * (i+j+1) `div` 2 + i + 1)
+--
+aij (I# i) (I# j) = D# (
+ case i +# j of
+ n -> 1.0## /## int2Double#
+ (((n *# (n+#1#)) `uncheckedIShiftRA#` 1#) +# (i +# 1#)))
diff --git a/shootout/fannkuch-redux/Makefile b/shootout/spectral-norm/Makefile
similarity index 57%
copy from shootout/fannkuch-redux/Makefile
copy to shootout/spectral-norm/Makefile
index facb262..fd5dbfb 100644
--- a/shootout/fannkuch-redux/Makefile
+++ b/shootout/spectral-norm/Makefile
@@ -2,10 +2,10 @@ TOP = ../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
-FAST_OPTS = 10
-NORM_OPTS = 11
-SLOW_OPTS = 12 # official shootout setting
+FAST_OPTS = 500
+NORM_OPTS = 3000
+SLOW_OPTS = 5500 # official shootout setting
# The benchmark game also uses -fllvm, which we can't since it might
# not be available on the developer's machine.
-HC_OPTS += -XBangPatterns -O2
+HC_OPTS += -XBangPatterns -XMagicHash -O2 -fexcess-precision
diff --git a/shootout/spectral-norm/spectral-norm.faststdout b/shootout/spectral-norm/spectral-norm.faststdout
new file mode 100644
index 0000000..50f033a
--- /dev/null
+++ b/shootout/spectral-norm/spectral-norm.faststdout
@@ -0,0 +1 @@
+1.274224153
diff --git a/shootout/spectral-norm/spectral-norm.stdout b/shootout/spectral-norm/spectral-norm.stdout
new file mode 100644
index 0000000..50f033a
--- /dev/null
+++ b/shootout/spectral-norm/spectral-norm.stdout
@@ -0,0 +1 @@
+1.274224153
More information about the ghc-commits
mailing list