From 11b3e5a7c5e64c2f9d31a7ecedc7f18a00a2ac48 Mon Sep 17 00:00:00 2001
From: David Terei <davidterei@gmail.com>
Date: Fri, 13 Jan 2012 18:18:31 -0800
Subject: [PATCH] Fix up smp benchees.
---
smp/callback001/Main.hs | 86 ++++++++++++++---------------
smp/callback001/Makefile | 3 +-
smp/callback001/callback001.stdout | 2 +-
smp/callback001/cbits.c | 12 ++--
smp/callback001/cbits.h | 6 +-
smp/callback002/Main.hs | 56 +++++++++----------
smp/callback002/Makefile | 3 +-
smp/callback002/cbits.c | 16 +++---
smp/callback002/cbits.h | 6 +-
smp/chan/Makefile | 1 +
smp/chan/chan.hs | 1 +
smp/systolic/Main.hs | 88 +++++++++++++++---------------
smp/tchan/Makefile | 10 ++++
smp/{chan => tchan}/tchan.hs | 0
14 files changed, 150 insertions(+), 140 deletions(-)
create mode 100644 smp/tchan/Makefile
rename smp/{chan => tchan}/tchan.hs (100%)
diff --git a/smp/callback001/Main.hs b/smp/callback001/Main.hs
index 84086319..493fd0f2 100644
--- a/smp/callback001/Main.hs
+++ b/smp/callback001/Main.hs
@@ -1,43 +1,43 @@
-{-# OPTIONS_GHC -fffi #-}
--- 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 threadsafe "cbits.h callC"
- callC:: FunPtr FUNC -> IO ()
-
+{-# 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 ()
+
diff --git a/smp/callback001/Makefile b/smp/callback001/Makefile
index 12a9c090..ecf283e4 100644
--- a/smp/callback001/Makefile
+++ b/smp/callback001/Makefile
@@ -5,6 +5,5 @@ FAST_OPTS = 100
NORM_OPTS = 500
SLOW_OPTS = 2000
-OBJS += Main_stub.o
-
include $(TOP)/mk/target.mk
+
diff --git a/smp/callback001/callback001.stdout b/smp/callback001/callback001.stdout
index 712af36f..ec9d47c3 100644
--- a/smp/callback001/callback001.stdout
+++ b/smp/callback001/callback001.stdout
@@ -1 +1 @@
-....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
\ No newline at end of file
+....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
diff --git a/smp/callback001/cbits.c b/smp/callback001/cbits.c
index ef96c23a..7f65c948 100644
--- a/smp/callback001/cbits.c
+++ b/smp/callback001/cbits.c
@@ -1,6 +1,6 @@
-#include "cbits.h"
-
-void callC( FUNC* f) {
- int i;
- for(i=0;i<1000;i++) f();
-}
+#include "cbits.h"
+
+void callC( FUNC* f) {
+ int i;
+ for(i=0;i<1000;i++) f();
+}
diff --git a/smp/callback001/cbits.h b/smp/callback001/cbits.h
index d0d8517c..f81a6fff 100644
--- a/smp/callback001/cbits.h
+++ b/smp/callback001/cbits.h
@@ -1,3 +1,3 @@
-typedef void FUNC();
-
-void callC( FUNC* f);
+typedef void FUNC();
+
+void callC( FUNC* f);
diff --git a/smp/callback002/Main.hs b/smp/callback002/Main.hs
index d0ad9c98..6f05dd9c 100644
--- a/smp/callback002/Main.hs
+++ b/smp/callback002/Main.hs
@@ -1,28 +1,28 @@
-{-# OPTIONS_GHC -fffi #-}
--- 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 threadsafe "cbits.h callC"
- callC:: FunPtr FUNC -> IO ()
-
+{-# 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 ()
+
diff --git a/smp/callback002/Makefile b/smp/callback002/Makefile
index 5ad0b5c2..47256707 100644
--- a/smp/callback002/Makefile
+++ b/smp/callback002/Makefile
@@ -5,6 +5,5 @@ FAST_OPTS = 300000
NORM_OPTS = 3000000
SLOW_OPTS = 30000000
-OBJS += Main_stub.o
-
include $(TOP)/mk/target.mk
+
diff --git a/smp/callback002/cbits.c b/smp/callback002/cbits.c
index 47ac47f1..9e493784 100644
--- a/smp/callback002/cbits.c
+++ b/smp/callback002/cbits.c
@@ -1,8 +1,8 @@
-#include "cbits.h"
-
-int count;
-
-void callC( FUNC* f) {
- int i;
- for(i=0;i<count;i++) f();
-}
+#include "cbits.h"
+
+int count;
+
+void callC( FUNC* f) {
+ int i;
+ for(i=0;i<count;i++) f();
+}
diff --git a/smp/callback002/cbits.h b/smp/callback002/cbits.h
index d0d8517c..f81a6fff 100644
--- a/smp/callback002/cbits.h
+++ b/smp/callback002/cbits.h
@@ -1,3 +1,3 @@
-typedef void FUNC();
-
-void callC( FUNC* f);
+typedef void FUNC();
+
+void callC( FUNC* f);
diff --git a/smp/chan/Makefile b/smp/chan/Makefile
index 29bb5165..f8899d7d 100644
--- a/smp/chan/Makefile
+++ b/smp/chan/Makefile
@@ -6,3 +6,4 @@ NORM_OPTS = 5000000
SLOW_OPTS = 50000000
include $(TOP)/mk/target.mk
+
diff --git a/smp/chan/chan.hs b/smp/chan/chan.hs
index a3cef465..76d8dcce 100644
--- a/smp/chan/chan.hs
+++ b/smp/chan/chan.hs
@@ -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
+
diff --git a/smp/systolic/Main.hs b/smp/systolic/Main.hs
index 03a95043..002becbd 100644
--- a/smp/systolic/Main.hs
+++ b/smp/systolic/Main.hs
@@ -1,45 +1,45 @@
--------------------------------------------------------------------------------
---- $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
+-------------------------------------------------------------------------------
+--- $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
index 00000000..95246ffa
--- /dev/null
+++ b/smp/tchan/Makefile
@@ -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
diff --git a/smp/chan/tchan.hs b/smp/tchan/tchan.hs
similarity index 100%
rename from smp/chan/tchan.hs
rename to smp/tchan/tchan.hs
--
GitLab