Commit 668c35de authored by dterei's avatar dterei

Remove Dph benchmarks as too difficult to get working

parent a8ffa9de
# Boring file regexps:
### compiler and interpreter intermediate files
# haskell (ghc) interfaces
*.hi
*.hi-boot
*.o-boot
# object files
*.o
*.o.cmd
# profiling haskell
*.p_hi
*.p_o
# haskell program coverage resp. profiling info
*.tix
*.prof
# fortran module files
*.mod
# linux kernel
*.ko.cmd
*.mod.c
# *.ko files aren't boring by default because they might
# be Korean translations rather than kernel modules
# \.ko$
# python, emacs, java byte code
*.pyc
*.pyo
*.elc
*.class
# objects and libraries; lo and la are libtool things
*.obj
*.a
*.exe
*.so
*.lo
*.la
# compiled zsh configuration files
*.zwc
# Common LISP output files for CLISP and CMUCL
*.fas
*.fasl
*.sparcf
*.x86f
### build and packaging systems
# cabal intermediates
*.installed-pkg-config*
*.setup-config*
# standard cabal build dir, might not be boring for everybody
# ^dist(/|$)
# autotools
autom4te.cache
config.log
config.status
# microsoft web expression, visual studio metadata directories
*_vti_cnf
*_vti_pvt
# gentoo tools
*.revdep-rebuild.*
# generated dependencies
.depend
### version control systems
# cvs
CVS/
.cvsignore
# cvs, emacs locks
.#
# rcs
RCS/
*,v
# subversion
*.svn
# mercurial
*.hg
# bzr
*.bzr
# sccs
SCCS/
# darcs
_darcs/
*.darcsrepo/
.darcs-temp-mail
*.swp
*.swo
### miscellaneous
# backup files
*~
*.bak
*.BAK
# patch originals and rejects
*.orig
*.rej
# X server
.serverauth.*
# image spam
Thumbs.db
# vi, emacs tags
tags/
TAGS/
#(^|/)\.[^/]
# core dumps
*.core
# partial broken files (KIO copy operations)
*.part
# mac os finder
*.DS_Store
# Erlang
*.dump
*.beam
#fibon-benchmarks
dist/
repa-bot/
repa-examples/
Repa/Blur/Blur
Repa/Blur/out.bmp
Repa/Canny/Canny
Repa/Canny/out.bmp
Repa/FFT3d/FFT3d
Repa/FFT3d/output000.bmp
Repa/FFT3d/output001.bmp
Repa/FFT3d/output002.bmp
Repa/FFT3d/output003.bmp
Repa/FFT3d/output004.bmp
Repa/FFT3d/output005.bmp
Repa/FFT3d/output006.bmp
Repa/FFT3d/output007.bmp
Repa/FFT3d/output008.bmp
Repa/FFT3d/output009.bmp
Repa/FFT3d/output010.bmp
Repa/FFT3d/output011.bmp
Repa/FFT3d/output012.bmp
Repa/FFT3d/output013.bmp
Repa/FFT3d/output014.bmp
Repa/FFT3d/output015.bmp
Repa/FFT3d/output016.bmp
Repa/FFT3d/output017.bmp
Repa/FFT3d/output018.bmp
Repa/FFT3d/output019.bmp
Repa/FFT3d/output020.bmp
Repa/FFT3d/output021.bmp
Repa/FFT3d/output022.bmp
Repa/FFT3d/output023.bmp
Repa/FFT3d/output024.bmp
Repa/FFT3d/output025.bmp
Repa/FFT3d/output026.bmp
Repa/FFT3d/output027.bmp
Repa/FFT3d/output028.bmp
Repa/FFT3d/output029.bmp
Repa/FFT3d/output030.bmp
Repa/FFT3d/output031.bmp
Repa/FFT3d/output032.bmp
Repa/FFT3d/output033.bmp
Repa/FFT3d/output034.bmp
Repa/FFT3d/output035.bmp
Repa/FFT3d/output036.bmp
Repa/FFT3d/output037.bmp
Repa/FFT3d/output038.bmp
Repa/FFT3d/output039.bmp
Repa/FFT3d/output040.bmp
Repa/FFT3d/output041.bmp
Repa/FFT3d/output042.bmp
Repa/FFT3d/output043.bmp
Repa/FFT3d/output044.bmp
Repa/FFT3d/output045.bmp
Repa/FFT3d/output046.bmp
Repa/FFT3d/output047.bmp
Repa/FFT3d/output048.bmp
Repa/FFT3d/output049.bmp
Repa/FFT3d/output050.bmp
Repa/FFT3d/output051.bmp
Repa/FFT3d/output052.bmp
Repa/FFT3d/output053.bmp
Repa/FFT3d/output054.bmp
Repa/FFT3d/output055.bmp
Repa/FFT3d/output056.bmp
Repa/FFT3d/output057.bmp
Repa/FFT3d/output058.bmp
Repa/FFT3d/output059.bmp
Repa/FFT3d/output060.bmp
Repa/FFT3d/output061.bmp
Repa/FFT3d/output062.bmp
Repa/FFT3d/output063.bmp
Repa/FFT3d/output064.bmp
Repa/FFT3d/output065.bmp
Repa/FFT3d/output066.bmp
Repa/FFT3d/output067.bmp
Repa/FFT3d/output068.bmp
Repa/FFT3d/output069.bmp
Repa/FFT3d/output070.bmp
Repa/FFT3d/output071.bmp
Repa/FFT3d/output072.bmp
Repa/FFT3d/output073.bmp
Repa/FFT3d/output074.bmp
Repa/FFT3d/output075.bmp
Repa/FFT3d/output076.bmp
Repa/FFT3d/output077.bmp
Repa/FFT3d/output078.bmp
Repa/FFT3d/output079.bmp
Repa/FFT3d/output080.bmp
Repa/FFT3d/output081.bmp
Repa/FFT3d/output082.bmp
Repa/FFT3d/output083.bmp
Repa/FFT3d/output084.bmp
Repa/FFT3d/output085.bmp
Repa/FFT3d/output086.bmp
Repa/FFT3d/output087.bmp
Repa/FFT3d/output088.bmp
Repa/FFT3d/output089.bmp
Repa/FFT3d/output090.bmp
Repa/FFT3d/output091.bmp
Repa/FFT3d/output092.bmp
Repa/FFT3d/output093.bmp
Repa/FFT3d/output094.bmp
Repa/FFT3d/output095.bmp
Repa/FFT3d/output096.bmp
Repa/FFT3d/output097.bmp
Repa/FFT3d/output098.bmp
Repa/FFT3d/output099.bmp
Repa/FFT3d/output100.bmp
Repa/FFT3d/output101.bmp
Repa/FFT3d/output102.bmp
Repa/FFT3d/output103.bmp
Repa/FFT3d/output104.bmp
Repa/FFT3d/output105.bmp
Repa/FFT3d/output106.bmp
Repa/FFT3d/output107.bmp
Repa/FFT3d/output108.bmp
Repa/FFT3d/output109.bmp
Repa/FFT3d/output110.bmp
Repa/FFT3d/output111.bmp
Repa/FFT3d/output112.bmp
Repa/FFT3d/output113.bmp
Repa/FFT3d/output114.bmp
Repa/FFT3d/output115.bmp
Repa/FFT3d/output116.bmp
Repa/FFT3d/output117.bmp
Repa/FFT3d/output118.bmp
Repa/FFT3d/output119.bmp
Repa/FFT3d/output120.bmp
Repa/FFT3d/output121.bmp
Repa/FFT3d/output122.bmp
Repa/FFT3d/output123.bmp
Repa/FFT3d/output124.bmp
Repa/FFT3d/output125.bmp
Repa/FFT3d/output126.bmp
Repa/FFT3d/output127.bmp
Repa/FFTHighPass2d/FFTHighPass2d
Repa/FFTHighPass2d/out.bmp
Repa/Laplace/Laplace
Repa/Laplace/laplace.bmp
Repa/MMult/MMult
Repa/Sobel/Sobel
Repa/Sobel/out.bmp
Repa/Volume/Volume
Repa/Volume/out.bmp
Repa/Volume/out.w16
Shootout/BinaryTrees/BinaryTrees
Shootout/ChameneosRedux/ChameneosRedux
Shootout/Fannkuch/Fannkuch
Shootout/Mandelbrot/Mandelbrot
Shootout/Nbody/Nbody
Shootout/Pidigits/Pidigits
Shootout/SpectralNorm/SpectralNorm
Hackage/Agum/Agum
Hackage/Bzlib/Bzlib
Hackage/Bzlib/Codec/Compression/BZip/Stream.hs
Hackage/Bzlib/Codec/Compression/BZip/Stream_hsc.c
Hackage/Bzlib/mito.aa.bz2.roundtrip
Hackage/Cpsa/Cpsa
Hackage/Crypto/Crypto
Hackage/Fgl/Fgl
Hackage/Fst/Fst
Hackage/Funsat/Funsat
Hackage/Gf/BeschFre.gfo
Hackage/Gf/Cat.gfo
Hackage/Gf/CatEng.gfo
Hackage/Gf/CatFre.gfo
Hackage/Gf/CatRomance.gfo
Hackage/Gf/Common.gfo
Hackage/Gf/CommonRomance.gfo
Hackage/Gf/CommonX.gfo
Hackage/Gf/DiffFre.gfo
Hackage/Gf/DiffRomance.gfo
Hackage/Gf/Eng.gfo
Hackage/Gf/EngDescr.gfo
Hackage/Gf/EngReal.gfo
Hackage/Gf/Fre.gfo
Hackage/Gf/Fre.hs
Hackage/Gf/Fre.pgf
Hackage/Gf/FreDescr.gfo
Hackage/Gf/FreReal.gfo
Hackage/Gf/Gf
Hackage/Gf/IrregEng.gfo
Hackage/Gf/IrregEngAbs.gfo
Hackage/Gf/IrregFre.gfo
Hackage/Gf/IrregFreAbs.gfo
Hackage/Gf/MorphoEng.gfo
Hackage/Gf/MorphoFre.gfo
Hackage/Gf/ParadigmsEng.gfo
Hackage/Gf/ParamX.gfo
Hackage/Gf/PhonoFre.gfo
Hackage/Gf/Predef.gfo
Hackage/Gf/Prelude.gfo
Hackage/Gf/ResEng.gfo
Hackage/Gf/ResFre.gfo
Hackage/Gf/ResRomance.gfo
Hackage/Gf/src/compiler/GF/Grammar/Lexer.hs
Hackage/Gf/src/compiler/GF/Grammar/Parser.hs
Hackage/HaLeX/HaLeX
Hackage/Happy/Bio.hs
Hackage/Happy/ErlParser.hs
Hackage/Happy/Happy
Hackage/Happy/HaskellParser.hs
Hackage/Happy/TestInput.hs
Hackage/Hgalib/Hgalib
Hackage/Palindromes/Palindromes
Hackage/Pappy/Pappy
Hackage/QuickCheck/QuickCheck
Hackage/Regex/Regex
Hackage/Simgi/Simgi
Hackage/Simgi/mersenne-random-pure64/System/Random/Mersenne/Pure64/Base.hs
Hackage/Simgi/mersenne-random-pure64/System/Random/Mersenne/Pure64/Base_hsc.c
Hackage/Simgi/oregonator_output.dat
Hackage/TernaryTrees/TernaryTrees
Hackage/TernaryTrees/olivertwist.txt.bin
Hackage/Xsact/Xsact
Name: Dotp
Version: 0.1
Stability: Experimental
Category: Benchmarking
Build-type: Simple
Cabal-version: >=1.2
Executable Dotp
Main-is: vect.hs
Hs-Source-Dirs: src ../_DphLib
Build-depends: base == 4.*,
dph-prim-par,
old-time,
dph-par,
random
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Fibon.Benchmarks.Dph.Dotp.Fibon.Instance(
mkInstance
)
where
import Fibon.BenchmarkInstance
sharedConfig = BenchmarkInstance {
flagConfig = FlagConfig {
configureFlags = ["--ghc-option=-threaded"]
, buildFlags = []
, runFlags = []
}
, stdinInput = Nothing
, output = [(Stdout, Diff "Dotp.stdout.expected")]
, exeName = "Dotp"
}
flgCfg = flagConfig sharedConfig
mkInstance Test = sharedConfig {
flagConfig = flgCfg {runFlags = ["100"]}
}
mkInstance Ref = sharedConfig {
flagConfig = flgCfg {runFlags = ["50000000"]}
}
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
SRCS = ../_DphLib/Bench/Time.hs \
../_DphLib/Bench/Options.hs \
../_DphLib/Bench/Benchmark.hs \
src/DotPVect.hs \
src/vect.hs
PROG_ARGS += 50000000
HC_OPTS += -threaded -isrc -i../_DphLib -package base -package dph-par -package dph-prim-par -package old-time -package random
include $(TOP)/mk/target.mk
Dot product
===========
DPH benchmarks
~~~~~~~~~~~~~~
DotPPrim.hs & prim.hs -- using primitives of package dph directly
DotPVect.hs & vect.hs -- vectorised DPH code
Both benchmarks are compiled against both the seq and par flavour of
package dph (with executables in the subdirectories seq/ and par/,
respectively).
Reference benchmarks
~~~~~~~~~~~~~~~~~~~~
DotP.hs -- multi-threaded reference implementation in Haskell
dot-c.c -- multi-threaded reference implementation in C
Legacy code
~~~~~~~~~~~
The legacy/ directory has an old, sequential Haskell implementation of dot
product timing a variety of Haskell arrays and a sequential C implementation.
\ No newline at end of file
{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
module Main
where
import GHC.Prim (
Double#, ByteArray#, MutableByteArray#, RealWorld,
newByteArray#, unsafeFreezeByteArray#,
readDoubleArray#, writeDoubleArray#, indexDoubleArray#)
import GHC.Base ( Int(..), (+#) )
import GHC.Float ( Double(..) )
import GHC.ST ( ST(..), runST )
import GHC.Conc ( forkOnIO, numCapabilities )
import Data.Array.Base (dOUBLE_SCALE)
import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, putMVar )
import Control.Monad ( zipWithM_ )
import System.Environment ( getArgs )
import System.CPUTime
import System.Time
-- Arrays
-- ------
data Arr = Arr !Int !Int ByteArray#
data MArr s = MArr !Int (MutableByteArray# s)
lengthA :: Arr -> Int
lengthA (Arr _ n _) = n
indexA :: Arr -> Int -> Double
indexA (Arr (I# i#) _ arr#) (I# j#) = D# (indexDoubleArray# arr# (i# +# j#))
sliceA :: Arr -> Int -> Int -> Arr
sliceA (Arr i _ arr#) j n = Arr (i+j) n arr#
newMA :: Int -> ST s (MArr s)
newMA n@(I# n#) = ST $ \s1# ->
case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
(# s2#, MArr n marr# #) }
unsafeFreezeMA :: MArr s -> ST s Arr
unsafeFreezeMA (MArr n marr#) = ST $ \s1# ->
case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, Arr 0 n arr# #) }
writeMA :: MArr s -> Int -> Double -> ST s ()
writeMA (MArr _ marr#) (I# i#) (D# d#) = ST $ \s# ->
case writeDoubleArray# marr# i# d# s# of { s2# -> (# s2#, () #) }
replicateA :: Int -> Double -> Arr
replicateA n d = runST (
do
marr <- newMA n
fill marr
unsafeFreezeMA marr
)
where
fill marr = fill' 0
where
fill' i | i < n = do
writeMA marr i d
fill' (i+1)
| otherwise = return ()
dotpA :: Arr -> Arr -> Double
dotpA !xs !ys = go 0 0
where
n = lengthA xs
go i !r | i < n = go (i+1) (r + indexA xs i * indexA ys i)
| otherwise = r
-- Parallel arrays
-- ---------------
splitLen :: Int -> Int -> [Int]
splitLen threads n = replicate m (l+1) ++ replicate (threads - m) l
where
l = n `div` threads
m = n `mod` threads
splitA :: Int -> Arr -> [Arr]
splitA threads arr = zipWith (sliceA arr) (scanl (+) 0 lens) lens
where
lens = splitLen threads (lengthA arr)
-- Gangs
-- -----
data Gang = Gang Int [MVar (Arr, Arr)] [MVar Double]
worker :: MVar (Arr, Arr) -> MVar Double -> IO ()
worker arg res
= do
(xs, ys) <- takeMVar arg
putMVar res $! dotpA xs ys
forkGang :: Int -> IO Gang
forkGang n
= do
as <- sequence $ replicate n newEmptyMVar
rs <- sequence $ replicate n newEmptyMVar
zipWithM_ forkOnIO [0..] $ zipWith worker as rs
return $ Gang n as rs
-- Timing
-- ------
data Time = Time { cpu_time :: Integer
, wall_time :: Integer
}
type TimeUnit = Integer -> Integer
picoseconds :: TimeUnit
picoseconds = id
milliseconds :: TimeUnit
milliseconds n = n `div` 1000000000
seconds :: TimeUnit
seconds n = n `div` 1000000000000
cpuTime :: TimeUnit -> Time -> Integer
cpuTime f = f . cpu_time
wallTime :: TimeUnit -> Time -> Integer
wallTime f = f . wall_time
getTime :: IO Time
getTime =
do
cpu <- getCPUTime
TOD sec pico <- getClockTime
return $ Time cpu (pico + sec * 1000000000000)
zipT :: (Integer -> Integer -> Integer) -> Time -> Time -> Time
zipT f (Time cpu1 wall1) (Time cpu2 wall2) =
Time (f cpu1 cpu2) (f wall1 wall2)
minus :: Time -> Time -> Time
minus = zipT (-)
fromTime :: Time -> (Integer, Integer)
fromTime t = (wallTime milliseconds t, cpuTime milliseconds t)
instance Show Time where
showsPrec n t = showsPrec n (wallTime milliseconds t)
. showChar '/'
. showsPrec n (cpuTime milliseconds t)
-- Benchmark
-- ---------
dotp :: Gang -> [Arr] -> [Arr] -> IO [Double]
dotp (Gang n as rs) xss yss
= do
zipWithM_ putMVar as $ zip xss yss
mapM takeMVar rs
main = do
[arg1, arg2] <- getArgs
let n = read arg2
runs = read arg1
xs = replicateA n 5
ys = replicateA n 6
xss = splitA numCapabilities xs
yss = splitA numCapabilities ys
eval xss `seq` eval yss `seq` return ()
let oneRun = do
gang <- forkGang numCapabilities
t1 <- getTime
dotp gang xss yss
t2 <- getTime
return $ fromTime (t2 `minus` t1)
times <- sequence (replicate runs oneRun)
let (walls, cpus) = unzip times
putStrLn $ show (sum walls `div` toInteger runs) ++ "/" ++
show (sum cpus `div` toInteger runs)
return ()
where
eval (x:xs) = x `seq` eval xs
eval [] = ()
module DotPPrim where
import Data.Array.Parallel.Unlifted as U
dotp :: U.Array Double -> U.Array Double -> Double
{-# NOINLINE dotp #-}
dotp v w = U.sum (U.zipWith (*) v w)
{-# LANGUAGE ParallelArrays #-}
{-# OPTIONS -fvectorise #-}
module DotPVect ( dotp ) where
import Data.Array.Parallel.Prelude
import Data.Array.Parallel.Prelude.Double as D
import qualified Prelude
dotp :: PArray Double -> PArray Double -> Double
{-# NOINLINE dotp #-}
dotp v w = dotp' (fromPArrayP v) (fromPArrayP w)
dotp' :: [:Double:] -> [:Double:] -> Double
dotp' v w = D.sumP (zipWithP (*) v w)
import DotPPrim ( dotp )
import Control.Exception (evaluate)
import System.Console.GetOpt
import qualified System.Random as R
import qualified Data.Array.Parallel.Unlifted as U
import Bench.Benchmark
import Bench.Options
generateVector :: Int -> IO (U.Array Double)
generateVector n =
do
rg <- R.newStdGen
let -- The std random function is too slow to generate really big vectors
-- with. Instead, we generate a short random vector and repeat that.
randvec = U.randomRs k (-100, 100) rg
vec = U.map (\i -> randvec U.!: (i `mod` k)) (U.enumFromTo 0 (n-1))
evaluate vec
return vec
where
k = 1000
generateVectors :: Int -> IO (Point (U.Array Double, U.Array Double))
generateVectors n =
do
v <- generateVector n
w <- generateVector n
return $ ("N = " ++ show n) `mkPoint` (v,w)
main = ndpMain "Dot product"
"[OPTION] ... SIZES ..."
run [] ()
run opts () sizes =
case map read sizes of
[] -> failWith ["No sizes specified"]
szs -> do
benchmark opts (uncurry dotp)
(map generateVectors szs)
(`seq` ()) show
return ()
import DotPVect ( dotp )
import Control.Exception (evaluate)
import System.Console.GetOpt
import qualified System.Random as R
import qualified Data.Array.Parallel.Unlifted as U
import qualified Data.Array.Parallel.PArray as P
import Data.Array.Parallel.PArray (PArray)
import Bench.Benchmark
import Bench.Options
generateVectorU :: Int -> IO (U.Array Double)
generateVectorU n =
do
rg <- R.newStdGen
let -- The std random function is too slow to generate really big vectors
-- with. Instead, we generate a short random vector and repeat that.
randvec = U.randomRs k (-100, 100) rg
vec = U.map (\i -> randvec U.!: (i `mod` k)) (U.enumFromTo 0 (n-1))
evaluate vec
return vec
where
k = 1000
generateVector :: Int -> IO (PArray Double)
generateVector n
= do
vec <- generateVectorU n
return $ P.fromUArrPA' vec
generateVectors :: Int -> IO (Point (PArray Double, PArray Double))
generateVectors n =
do