Benchmark driver script
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Sun, 17 May 2009 12:08:27 +0000 (12:08 +0000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Sun, 17 May 2009 12:08:27 +0000 (12:08 +0000)
dph-common/Data/Array/Parallel/PArray.hs
examples/Makefile
examples/README
examples/dotp/DotP.hs
examples/dotp/dotp-c.c
examples/dotp/prim.hs
examples/dotp/vect.hs
examples/runbench.hs [new file with mode: 0644]
examples/smvm/README
examples/smvm/smvm-c.c
examples/sumsq/sumsq-c.c

index 10ebdf7..a7646fe 100644 (file)
@@ -1,8 +1,9 @@
 module Data.Array.Parallel.PArray (
   PArray, Elt, Random(..),
 
-  length, empty, replicate, singleton,
-  zip, unzip, enumFromTo, fromList, nf
+  length, empty, replicate, singleton, (!:),
+  zip, unzip, enumFromTo, fromList, nf,
+  fromUArrPA'
 ) where
 
 import Data.Array.Parallel.Lifted.PArray
@@ -54,6 +55,10 @@ singleton :: Elt a => a -> PArray a
 {-# INLINE singleton #-}
 singleton = singletonPA_v pa
 
+(!:) :: Elt a => PArray a -> Int -> a
+{-# INLINE (!:) #-}
+(!:) = indexPA_v pa
+
 zip :: (Elt a, Elt b) => PArray a -> PArray b -> PArray (a,b)
 {-# INLINE zip #-}
 zip = zipPA_v pa pa
index 67085ed..bf5816c 100644 (file)
@@ -2,6 +2,8 @@
 # we currently don't have all benchmarks working
 SUBDIRS = sumsq dotp smvm
 
+DRIVER = runbench.hs
+
 .PHONY: all bench clean
 
 all: bench
@@ -9,6 +11,7 @@ all: bench
          echo $(MAKE) -C $$i;    \
          $(MAKE) -C $$i;         \
        done
+       chmod a+x $(DRIVER)
 
 bench:
        $(MAKE) -C lib
index ecdf5e9..4e06cc9 100644 (file)
@@ -1,32 +1,40 @@
-NDP benchmarks
+DPH benchmarks
 ==============
 
-This directory contains several NDP benchmarks:
+This directory contains several DPH benchmarks.  Currently, only the following 
+are working:
 
-concomp    - connected components in undirected graphs
-dotp       - dot product of two vectors
-primes     - sieve of Eratosthenes
+sumsq     - parallel version of `sum [x * x | x <- [1..n]]'
+dotp       - dot product of two dense vectors
 smvm       - sparse matrix/vector multiplication
 
-Options
--------
+For more details and benchmark results, see
+
+  http://hackage.haskell.org/trac/ghc/wiki/DataParallel/BenchmarkStatus
+
+
+Benchmark driver
+----------------
+
+This directory contains a benchmark driver `runbench.hs', which runs all 
+available benchmarks on a set of standard configuartions while choosing the 
+number of threads in dependence on the capabilities of the hardware.
+
+
+Options of the benchmark framework
+----------------------------------
 
 The following options are common to all benchmarks:
 
   --runs=N                Repeat each benchmark N times
   -r N
 
-  --seq=N                 Simulate N threads
-  -s N
-
-  --algo=ALGORITHM        Use the specified algorithm (if the benchmark
-  -a ALGORITHM            implements multiple algorithms)
-
-  --verbose=N             Set the verbosity level
-  -v N
+  --verbose[=N]           Set the verbosity level
+  -v[N]
 
   --help                  Show a help screen
 
+
 Running benchmarks
 ------------------
 
@@ -35,7 +43,8 @@ For parallel benchmarks, you usually want to use
   benchmark --runs=<R> <INPUT> +RTS -N<N>
 
 Here, N is the number of threads to use and R the number of times the
-benchmark should be repeated (you probably want something between 3 and 10).
+benchmark should be repeated (you probably want something between 3 and 10).  
+Some benchmarks require further <INPUT>, some don't.
 
 The output will look as follows:
 
@@ -52,6 +61,3 @@ specified, i.e., --threads and +RTS -N can be omitted.
 
 At higher verbosity levels, more information (in particular, the timings of
 the individual runs) will be displayed.
-
-
-
index d79ffaa..05424e4 100644 (file)
@@ -144,6 +144,9 @@ zipT f (Time cpu1 wall1) (Time cpu2 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 '/'
@@ -159,18 +162,24 @@ dotp (Gang n as rs) xss yss
       mapM takeMVar rs
 
 main = do
-         [arg] <- getArgs
-         let n   = read arg
-             xs  = replicateA n 5
-             ys  = replicateA n 6
-             xss = splitA numCapabilities xs
-             yss = splitA numCapabilities ys
-         gang <- forkGang numCapabilities
+         [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 ()
-         t1 <- getTime
-         dotp gang xss yss
-         t2 <- getTime
-         print $ t2 `minus` t1
+         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
index 8a4d0c8..58a015e 100644 (file)
@@ -177,8 +177,7 @@ print_timeval( const struct timeval *t )
 
 int main( int argc, char *argv[] )
 {
-  int elems;
-  int threads;
+  int elems, threads, runs;
   struct timeval start, finish;
   struct rusage start_ru, finish_ru;
 
@@ -187,8 +186,10 @@ int main( int argc, char *argv[] )
   Arr *xss;
   Arr *yss;
 
-  elems   = atoi( argv[1] );
+  runs    = atoi( argv[1] );   /* FIXME: runs currently ignored */
   threads = atoi( argv[2] );
+  elems   = atoi( argv[3] );
+  printf ("N = %d; P = %d, R = %d: ", elems, threads, runs);
 
   replicateA( &xs, elems, 5 );
   replicateA( &ys, elems, 6 );
@@ -208,5 +209,7 @@ int main( int argc, char *argv[] )
 
   print_timeval( &finish ); putchar( '/' ); print_timeval( &finish_ru.ru_utime);
   putchar( '\n' );
+
+  return 0;
 }
 
index de5fbc4..c90d0ca 100644 (file)
@@ -13,9 +13,14 @@ generateVector :: Int -> IO (U.Array Double)
 generateVector n =
   do
     rg <- R.newStdGen
-    let vec = U.randomRs n (-100, 100) rg
+    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 =
index 6b7137b..9e80534 100644 (file)
@@ -4,18 +4,31 @@ import Control.Exception (evaluate)
 import System.Console.GetOpt
 import qualified System.Random as R
 
-import Data.Array.Parallel.PArray (PArray, randomRs, nf)
+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
 
-generateVector :: Int -> IO (PArray Double)
-generateVector n =
+generateVectorU :: Int -> IO (U.Array Double)
+generateVectorU n =
   do
     rg <- R.newStdGen
-    let vec = randomRs n (-100, 100) rg
-    evaluate (nf vec)
+    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 =
diff --git a/examples/runbench.hs b/examples/runbench.hs
new file mode 100644 (file)
index 0000000..2c1c860
--- /dev/null
@@ -0,0 +1,288 @@
+#!/usr/bin/env runhaskell
+
+{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}
+
+-- DPH benchmark driver
+-- 
+-- It runs all available benchmarks sequential and in parallel.  Parallel
+-- execution starts with a single thread and then steps through powers of two
+-- up to the number of hardware threads supported by the benchmark hardware.
+-- (Hardware threads are the number of cores times the number of hardware
+-- thread contexts per core.)
+--
+-- The driver needs to query the host for simple hardware specs.  These
+-- queries are OS-dependent and currently only implemented for Mac OS X and
+-- Solaris.  Please send patches adding support for other architectures to
+--
+--   glasgow-haskell-users@haskell.org
+--
+-- Hardware specifics should be restricted to the function 'getHardwareSpec'.
+
+
+import Prelude hiding (catch, seq)
+
+import Control.Exception  (IOException, catch)
+import Control.Monad      (liftM)
+import Data.Char          (toLower)
+import Data.List          (intercalate)
+import System.Environment (getProgName, getArgs)
+import System.Exit
+import System.FilePath
+import System.Process     (readProcess, system)
+import Text.Printf
+
+
+-- Constants
+-- ---------
+
+noOfRuns :: Int
+noOfRuns = 3    -- average over that many runs of a single implementation
+
+
+-- Hardware
+-- --------
+
+data HardwareSpec = HW { uname    :: String  -- machine identification
+                       , ncores   :: Int     -- number of cores
+                       , nthreads :: Int     -- numbers of hardware threads/core
+                       }
+
+getHardwareSpec :: IO HardwareSpec
+getHardwareSpec
+  = do
+      uname <- liftM (filter (/= '\n')) $ readProcess "uname" ["-npsr"] ""
+      case uname of
+        'D':'a':'r':'w':'i':'n':_ -> do
+          ncpu <- do
+                    ncpu <- readProcess "sysctl" ["hw.ncpu"] ""
+                    case ncpu of
+                      'h':'w':'.':'n':'c':'p':'u':':':' ':n -> 
+                        return (read n :: Int)
+                          `catch` \(e :: IOException) -> fatal (show e)
+                      _ -> fatal $ "sysctl hw.ncpu" ++ ncpu
+          return $ HW { uname = uname, ncores = ncpu, nthreads = 1 }
+        'S':'u':'n':'O':'S':_ -> do
+          fatal "not implemented yet"
+        _ -> fatal $ "uname:" ++ uname
+
+
+-- Benchmarks
+-- ----------
+
+-- Specification of a single benchmark (that consists of multiple
+-- implementations)
+--
+data BenchmarkSpec = BM { name :: String        -- description
+                        , dir  :: FilePath      -- benchmark directory
+                        , dph  :: [ImpSpec]     -- DPH benchmarks
+                        , seq  :: [ImpSpec]     -- sequential non-DPH benchmarks
+                        , par  :: [ImpSpec]     -- parallel non-DPH benchmarks
+                        }
+
+-- A single implementation of a benchmark
+--
+-- This may be a DPH implementation that we run with both dph-seq and dph-par,
+-- or it may be a sequential or parallel non-DPH program (in Haskell or a
+-- reference language, typically C).  The arguments of a parallel non-DPH
+-- program must contain '%d' twice as placeholder, first for the number of OS
+-- threads and second for the number of runs to average over.  The arguments of
+-- a sequential non-DPH program must contain '%d' for the number of runs.
+--
+-- Executables are assumed to be in the benchmark directory in subdirectories
+-- 'seq/', 'par/', and 'other/' for sequential versions of DPH benchmarks,
+-- parallel versions of DPH benchmarks, and non-DPH benchmarks, respectively.
+--
+data ImpSpec = Imp { impName :: String          -- implementation description
+                   , impCmd  :: String          -- executable (in benchmark dir)
+                   , impArgs :: [String]        -- arguments
+                   }
+
+selectBenchmarks :: [BenchmarkSpec] -> [String] -> IO [BenchmarkSpec]
+selectBenchmarks bspecs []   = return bspecs
+selectBenchmarks bspecs reqs = mapM selectBenchmark reqs
+  where
+    selectBenchmark req | bspec:_ <- filter (match req) bspecs = return bspec
+                        | otherwise
+                        = fatal ("unknown benchmark '" ++ req ++ "' " ++
+                                 "(available: " ++ avail ++ ")")
+                        where
+                          avail = intercalate " " (map name bspecs)
+
+                          match req bspec 
+                            = map toLower req == map toLower (name bspec)
+
+runBenchmarks :: HardwareSpec -> [BenchmarkSpec] -> IO ()
+runBenchmarks hw = mapM_ (runBenchmark hw)
+
+runBenchmark :: HardwareSpec -> BenchmarkSpec -> IO ()
+runBenchmark hw bm
+  = do
+      printf "\n"
+      putStrLn (dash ("-- Benchmark: " ++ name bm ++ " "))
+      mapM_ runDphSeq (dph bm)
+      mapM_ runDphPar (dph bm)
+      mapM_ runSeq (seq bm)
+      mapM_ runPar (par bm)
+      putStrLn dashAll
+  where
+    baseDir     = dir bm
+    threads     = takeWhile (<= (ncores hw * nthreads hw)) powersOfTwo
+    powersOfTwo = 1 : map (*2) powersOfTwo
+
+    runDphSeq (Imp { impName = name, impCmd = cmd, impArgs = args })
+      = runSequential ("DPH " ++ name) (seqDir </> cmd) (seqDphExtraArg:args)
+
+    runDphPar (Imp { impName = name, impCmd = cmd, impArgs = args })
+      = runParallel threads ("DPH " ++ name) (parDir </> cmd) 
+                    (parDphExtraArg:args)
+
+    runSeq (Imp { impName = name, impCmd = cmd, impArgs = args })
+      = runSequential name (otherDir </> cmd) args
+
+    runPar (Imp { impName = name, impCmd = cmd, impArgs = args })
+      = runParallel threads name (otherDir </> cmd) args
+
+    seqDir   = baseDir </> "seq"
+    parDir   = baseDir </> "par"
+    otherDir = baseDir </> "other"
+
+    seqDphExtraArg = "-r %d"
+    parDphExtraArg = "-r %d +RTS -N%d -RTS"
+
+-- Run a sequential implementation.
+--
+-- The arguments must contain '%d' once as a placeholder for the number of runs.
+--
+runSequential :: String -> FilePath -> [String] -> IO ()
+runSequential name cmd args
+  = do
+      printf ">> %s [sequential]\n" name
+      systemWithCheck $ printf ("%s " ++ intercalate " " args) cmd noOfRuns
+
+-- Run a parallel implementation on a sequence of thread configurations.
+--
+runParallel :: [Int] -> String -> FilePath -> [String] -> IO ()
+runParallel threads name cmd args = mapM_ (runParallelN name cmd args) threads
+
+-- Run a parallel implementation with the specified number of OS threads.
+--
+-- The arguments must contain '%d' twice, first as a placeholder for the
+-- number of threads and second for the number of runs.
+--
+runParallelN name cmd args n
+  = do
+      printf ">> %s [P = %d]\n" name n
+      systemWithCheck $ printf ("%s " ++ intercalate " " args) cmd noOfRuns n
+
+
+-- Utilities
+-- ---------
+
+fatal :: String -> IO a
+fatal msg
+  = do
+      name <- getProgName
+      putStrLn $ name ++ ": fatal error: " ++ msg
+      exitFailure
+
+dash :: String -> String
+dash s = s ++ take (79 - length s) (repeat '-')
+
+dashAll :: String
+dashAll = dash ""
+
+systemWithCheck :: String -> IO ()
+systemWithCheck cmd 
+  = do
+--      printf "Invoking '%s'\n" cmd
+      ec <- system cmd
+      case ec of
+        ExitSuccess   -> return ()
+        ExitFailure c -> printf "execution failed (exit %d)\n" c
+
+
+-- Main script
+-- -----------
+
+main 
+  = do
+      args        <- getArgs
+      benchsToRun <- selectBenchmarks benchmarks args
+      hw          <- getHardwareSpec
+
+      putStrLn (dash "-- Data Parallel Haskell benchmarks ")
+      printf "** Host               : %s\n" (uname hw)
+      printf "** Cores              : %d\n" (ncores hw)
+      printf "** Threads/core       : %d\n" (nthreads hw)
+      printf "** Runs/implementation: %d\n" noOfRuns
+      putStrLn dashAll
+
+      runBenchmarks hw benchsToRun
+  where
+    benchmarks = [ sumsq, dotp, smvm ]
+
+    sumsq = BM { name = "SumSq"
+               , dir  = "sumsq"
+               , dph  = [ Imp { impName = "primitives"
+                              , impCmd  = "prim"
+                              , impArgs = [ tenMillion ] 
+                              } 
+                        , Imp { impName = "vectorised"
+                              , impCmd  = "sumsq"
+                              , impArgs = [ tenMillion ] 
+                              } 
+                        ]
+               , seq  = [ Imp { impName = "ref C"
+                              , impCmd  = "sumsq-c"
+                              , impArgs = [ "%d", tenMillion ]
+                              } 
+                        ]
+               , par  = [ {- no parallel reference implementation -} ]
+               }
+
+    dotp = BM { name = "DotP"
+              , dir  = "dotp"
+              , dph  = [ Imp { impName = "primitives"
+                             , impCmd  = "prim"
+                             , impArgs = [ hundredMillion ] 
+                             } 
+                       , Imp { impName = "vectorised"
+                             , impCmd  = "dotp"
+                             , impArgs = [ hundredMillion ] 
+                             } 
+                       ]
+              , seq  = [ {- no sequential reference implementation -} ]
+              , par  = [ Imp { impName = "ref Haskell"
+                             , impCmd  = "DotP"
+                             , impArgs = [ "%d +RTS -N%d -RTS", hundredMillion ]
+                             }
+                       , Imp { impName = "ref C"
+                             , impCmd  = "dotp-c"
+                             , impArgs = [ "%d %d", hundredMillion ]
+                             } 
+                       ]
+              }
+
+    smvm = BM { name = "SMVM"
+              , dir  = "smvm"
+              , dph  = [ Imp { impName = "primitives"
+                             , impCmd  = "prim"
+                             , impArgs = [ testmat ] 
+                             } 
+                       , Imp { impName = "vectorised"
+                             , impCmd  = "smvm"
+                             , impArgs = [ testmat ] 
+                             } 
+                       ]
+              , seq  = [ Imp { impName = "ref C"
+                             , impCmd  = "smvm-c"
+                             , impArgs = [ "%d", testmat ]
+                             } 
+                       ]
+              , par  = [ {- no parallel reference implementation -} ]
+              }
+           where
+             testmat = "smvm" </> "test.mat" 
+
+    tenMillion     = "10000000"
+    hundredMillion = "100000000"
index d64b012..7ce074f 100644 (file)
@@ -25,7 +25,7 @@ quite a long time as it is not optimised at all.
 Sequential C benchmark
 ----------------------
 
-smvm-c FILE
+smvm-c RUNS FILE
 
 Benchmark
 ---------
index 390e238..167f02c 100644 (file)
@@ -65,10 +65,11 @@ HsDouble checksum( Array * arr )
                        
 int main( int argc, char * argv[] )
 {
-  int file;
+  int file, runs;
   clock_t start, finish;
 
-  file = open( argv[1], O_RDONLY );
+  runs = atoi( argv[1] );      // FIXME: runs are ignored
+  file = open( argv[2], O_RDONLY );
   load( file, &lengths, sizeof(HsInt) );
   load( file, &indices, sizeof(HsInt) );
   load( file, &values,  sizeof(HsDouble) );
@@ -85,5 +86,7 @@ int main( int argc, char * argv[] )
 
   printf( "%ld %Lf\n", (long int)((finish-start) / (CLOCKS_PER_SEC/1000)),
                           (long double)(checksum(&result)) );
+
+  return 0;
 }
 
index c1bda7f..bb711f1 100644 (file)
@@ -19,18 +19,24 @@ HsInt compute(HsInt n)
 
 int main( int argc, char * argv[] )
 {
-  HsInt result, n;
-  clock_t start, finish;
-
-  n = atoi( argv[1] );
-  printf( "n = %ld \n", (long)n );
-
-  start = clock();
-  result = compute( n ); 
-  finish = clock();
+  HsInt result, n, r, i;
+  clock_t start, finish, acc;
+
+  n = atoi( argv[2] );
+  r = atoi( argv[1] );
+  printf( "n = %ld; r = %ld \n", (long)n, (long)r );
+
+  acc = 0;
+  for (i = 0; i < r; i++) {
+    start = clock();
+    result = compute( n ); 
+    finish = clock();
+    acc += finish - start;
+  }
 
   printf( "time = %ld; value = %ld\n", 
-         (long int)((finish-start) / (CLOCKS_PER_SEC/1000)),
+         (long int)((acc/r) / (CLOCKS_PER_SEC/1000)),
          (long)result);
+  return 0;
 }