Fix up smp benchees.
authorDavid Terei <davidterei@gmail.com>
Sat, 14 Jan 2012 02:18:31 +0000 (18:18 -0800)
committerDavid Terei <davidterei@gmail.com>
Sat, 14 Jan 2012 02:18:31 +0000 (18:18 -0800)
14 files changed:
smp/callback001/Main.hs
smp/callback001/Makefile
smp/callback001/callback001.stdout
smp/callback001/cbits.c
smp/callback001/cbits.h
smp/callback002/Main.hs
smp/callback002/Makefile
smp/callback002/cbits.c
smp/callback002/cbits.h
smp/chan/Makefile
smp/chan/chan.hs
smp/systolic/Main.hs
smp/tchan/Makefile [new file with mode: 0644]
smp/tchan/tchan.hs [moved from smp/chan/tchan.hs with 100% similarity]

index 8408631..493fd0f 100644 (file)
@@ -1,43 +1,43 @@
-{-# OPTIONS_GHC -fffi #-}\r
--- This benchmark is also ffi014 in the test suite.\r
-\r
--- This program behaves unpredictably with the non-threaded RTS,\r
--- because depending on when the context switches happen it might end\r
--- up building a deep stack of callbacks.  When this happens, the run\r
--- queue gets full of threads that have finished but cannot exit\r
--- because they do not belong to the topmost call to schedule(), and\r
--- the scheduler repeatedly traverses the run queue full of these\r
--- zombie threads.\r
-\r
-module Main where\r
-\r
-import Control.Concurrent\r
-import Control.Monad\r
-import Foreign.Ptr\r
-import Data.IORef\r
-import System.Environment\r
-import System.IO\r
-\r
-main = do\r
-  [s] <- getArgs\r
-  let n = read s :: Int\r
-  sem <- newQSemN 0\r
-  let fork = if rtsSupportsBoundThreads then forkOS else forkIO\r
-  replicateM n (putStr "." >> hFlush stdout >> fork (thread sem) >> thread sem)\r
-  waitQSemN sem (n*2)\r
-\r
-\r
-thread sem = do\r
-  var <- newIORef 0\r
-  let f = modifyIORef var (1+)\r
-  callC =<< mkFunc f\r
-  signalQSemN sem 1\r
-\r
-type FUNC  =  IO ()\r
-\r
-foreign import ccall unsafe "wrapper"\r
-   mkFunc :: FUNC -> IO (FunPtr FUNC)\r
-\r
-foreign import ccall threadsafe "cbits.h callC"\r
-   callC:: FunPtr FUNC -> IO ()\r
-\r
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- This benchmark is also ffi014 in the test suite.
+
+-- This program behaves unpredictably with the non-threaded RTS,
+-- because depending on when the context switches happen it might end
+-- up building a deep stack of callbacks.  When this happens, the run
+-- queue gets full of threads that have finished but cannot exit
+-- because they do not belong to the topmost call to schedule(), and
+-- the scheduler repeatedly traverses the run queue full of these
+-- zombie threads.
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import Foreign.Ptr
+import Data.IORef
+import System.Environment
+import System.IO
+
+main = do
+  [s] <- getArgs
+  let n = read s :: Int
+  sem <- newQSemN 0
+  let fork = if rtsSupportsBoundThreads then forkOS else forkIO
+  replicateM n (putStr "." >> hFlush stdout >> fork (thread sem) >> thread sem)
+  waitQSemN sem (n*2)
+
+
+thread sem = do
+  var <- newIORef 0
+  let f = modifyIORef var (1+)
+  callC =<< mkFunc f
+  signalQSemN sem 1
+
+type FUNC  =  IO ()
+
+foreign import ccall unsafe "wrapper"
+   mkFunc :: FUNC -> IO (FunPtr FUNC)
+
+foreign import ccall safe "cbits.h callC"
+   callC:: FunPtr FUNC -> IO ()
+
index 12a9c09..ecf283e 100644 (file)
@@ -5,6 +5,5 @@ FAST_OPTS = 100
 NORM_OPTS = 500
 SLOW_OPTS = 2000
 
-OBJS += Main_stub.o
-
 include $(TOP)/mk/target.mk
+
index 712af36..ec9d47c 100644 (file)
@@ -1 +1 @@
-....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
\ No newline at end of file
+....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
index ef96c23..7f65c94 100644 (file)
@@ -1,6 +1,6 @@
-#include "cbits.h"\r
-\r
-void callC( FUNC* f) {\r
-   int i;\r
-   for(i=0;i<1000;i++) f();\r
-}\r
+#include "cbits.h"
+
+void callC( FUNC* f) {
+   int i;
+   for(i=0;i<1000;i++) f();
+}
index d0d8517..f81a6ff 100644 (file)
@@ -1,3 +1,3 @@
-typedef void FUNC();\r
-\r
-void callC( FUNC* f);\r
+typedef void FUNC();
+
+void callC( FUNC* f);
index d0ad9c9..6f05dd9 100644 (file)
@@ -1,28 +1,28 @@
-{-# OPTIONS_GHC -fffi #-}\r
--- Measure raw callback performance.\r
-\r
-module Main where\r
-\r
-import Control.Concurrent\r
-import Control.Monad\r
-import Foreign\r
-import Foreign.C\r
-import Data.IORef\r
-import System.Environment\r
-import System.IO\r
-\r
-main = do\r
-  [s] <- getArgs\r
-  poke pcount (fromIntegral (read s))\r
-  callC =<< mkFunc (return ())\r
-\r
-type FUNC  =  IO ()\r
-\r
-foreign import ccall "&count" pcount :: Ptr CInt\r
-\r
-foreign import ccall unsafe "wrapper"\r
-   mkFunc :: FUNC -> IO (FunPtr FUNC)\r
-\r
-foreign import ccall threadsafe "cbits.h callC"\r
-   callC:: FunPtr FUNC -> IO ()\r
-\r
+{-# LANGUAGE ForeignFunctionInterface #-}
+-- Measure raw callback performance.
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import Foreign
+import Foreign.C
+import Data.IORef
+import System.Environment
+import System.IO
+
+main = do
+  [s] <- getArgs
+  poke pcount (fromIntegral (read s))
+  callC =<< mkFunc (return ())
+
+type FUNC  =  IO ()
+
+foreign import ccall "&count" pcount :: Ptr CInt
+
+foreign import ccall unsafe "wrapper"
+   mkFunc :: FUNC -> IO (FunPtr FUNC)
+
+foreign import ccall safe "cbits.h callC"
+   callC:: FunPtr FUNC -> IO ()
+
index 5ad0b5c..4725670 100644 (file)
@@ -5,6 +5,5 @@ FAST_OPTS = 300000
 NORM_OPTS = 3000000
 SLOW_OPTS = 30000000
 
-OBJS += Main_stub.o
-
 include $(TOP)/mk/target.mk
+
index 47ac47f..9e49378 100644 (file)
@@ -1,8 +1,8 @@
-#include "cbits.h"\r
-\r
-int count;\r
-\r
-void callC( FUNC* f) {\r
-   int i;\r
-   for(i=0;i<count;i++) f();\r
-}\r
+#include "cbits.h"
+
+int count;
+
+void callC( FUNC* f) {
+   int i;
+   for(i=0;i<count;i++) f();
+}
index d0d8517..f81a6ff 100644 (file)
@@ -1,3 +1,3 @@
-typedef void FUNC();\r
-\r
-void callC( FUNC* f);\r
+typedef void FUNC();
+
+void callC( FUNC* f);
index 29bb516..f8899d7 100644 (file)
@@ -6,3 +6,4 @@ NORM_OPTS = 5000000
 SLOW_OPTS = 50000000
 
 include $(TOP)/mk/target.mk
+
index a3cef46..76d8dcc 100644 (file)
@@ -19,3 +19,4 @@ main = do
   a <- forkIO $ forM_ [1..n] $ \i -> writeChan c i
   b <- forkIO $ do forM_ [1..n] $ \i -> readChan c; putMVar m ()
   takeMVar m
+
index 03a9504..002becb 100644 (file)
@@ -1,45 +1,45 @@
--------------------------------------------------------------------------------\r
---- $Id: Bench1.hs#4 2005/06/14 01:10:17 REDMOND\\satnams $\r
--------------------------------------------------------------------------------\r
-\r
-module Main\r
-where\r
-import System.Time\r
-import System.Random\r
-import Control.Concurrent\r
-\r
-systolicFilter :: [Double] -> [Double] -> [Double]\r
-systolicFilter weights inputStream\r
-  = [sum [a*x | (a,x) <- zip weights xs]\r
-              | xs <- staggerBy (length weights) inputStream]\r
-\r
-staggerBy n list | length list <= n = []\r
-staggerBy n list\r
-  = take n list : staggerBy n (tail list)\r
-\r
-applyFilter rgen resultMV\r
-  = do let weights = take 10 (randomRs (0.0, 10.0) rgen)\r
-       let inputStream = take 2000 (randomRs (0.0, 100.0) rgen)\r
-       let result = last (systolicFilter weights inputStream)\r
-       putMVar resultMV result\r
\r
-rgens 0 _ = []\r
-rgens n rgen\r
-  = nextGen : rgens (n-1) nextGen\r
-    where\r
-    (_, nextGen) = split rgen\r
-\r
-instances = 1000\r
-\r
-main  \r
-  = do putStrLn "SMP Systolic Filter Benchmarks"\r
-       dones <- sequence (replicate instances newEmptyMVar)\r
-       rgen1 <- getStdGen\r
-       let gens = rgens instances rgen1\r
-       t1 <- getClockTime\r
-       sequence [forkIO (applyFilter (gens!!i) (dones!!i)) |\r
-                 i <- [0..instances-1]]\r
-       rs <- sequence [takeMVar (dones!!i) | i <- [0..instances-1]]\r
-       sequence [putStrLn (show (rs!!i)) | i <- [0..instances-1]]\r
-       t2 <- getClockTime\r
+-------------------------------------------------------------------------------
+--- $Id: Bench1.hs#4 2005/06/14 01:10:17 REDMOND\\satnams $
+-------------------------------------------------------------------------------
+
+module Main
+where
+import System.Time
+import System.Random
+import Control.Concurrent
+
+systolicFilter :: [Double] -> [Double] -> [Double]
+systolicFilter weights inputStream
+  = [sum [a*x | (a,x) <- zip weights xs]
+              | xs <- staggerBy (length weights) inputStream]
+
+staggerBy n list | length list <= n = []
+staggerBy n list
+  = take n list : staggerBy n (tail list)
+
+applyFilter rgen resultMV
+  = do let weights = take 10 (randomRs (0.0, 10.0) rgen)
+       let inputStream = take 2000 (randomRs (0.0, 100.0) rgen)
+       let result = last (systolicFilter weights inputStream)
+       putMVar resultMV result
+rgens 0 _ = []
+rgens n rgen
+  = nextGen : rgens (n-1) nextGen
+    where
+    (_, nextGen) = split rgen
+
+instances = 1000
+
+main  
+  = do putStrLn "SMP Systolic Filter Benchmarks"
+       dones <- sequence (replicate instances newEmptyMVar)
+       rgen1 <- getStdGen
+       let gens = rgens instances rgen1
+       t1 <- getClockTime
+       sequence [forkIO (applyFilter (gens!!i) (dones!!i)) |
+                 i <- [0..instances-1]]
+       rs <- sequence [takeMVar (dones!!i) | i <- [0..instances-1]]
+       sequence [putStrLn (show (rs!!i)) | i <- [0..instances-1]]
+       t2 <- getClockTime
        putStrLn ("Time: " ++ (timeDiffToString (diffClockTimes t2 t1)))
\ No newline at end of file
diff --git a/smp/tchan/Makefile b/smp/tchan/Makefile
new file mode 100644 (file)
index 0000000..95246ff
--- /dev/null
@@ -0,0 +1,10 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+FAST_OPTS = 100000
+NORM_OPTS = 5000000
+SLOW_OPTS = 50000000
+
+SRC_HC_OPTS += -package stm
+
+include $(TOP)/mk/target.mk
similarity index 100%
rename from smp/chan/tchan.hs
rename to smp/tchan/tchan.hs