Commit 11b3e5a7 authored by dterei's avatar dterei

Fix up smp benchees.

parent 41da4071
{-# 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 ()
......@@ -5,6 +5,5 @@ FAST_OPTS = 100
NORM_OPTS = 500
SLOW_OPTS = 2000
OBJS += Main_stub.o
include $(TOP)/mk/target.mk
....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
\ No newline at end of file
....................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................
#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();
}
typedef void FUNC();
void callC( FUNC* f);
typedef void FUNC();
void callC( FUNC* f);
{-# 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 ()
......@@ -5,6 +5,5 @@ FAST_OPTS = 300000
NORM_OPTS = 3000000
SLOW_OPTS = 30000000
OBJS += Main_stub.o
include $(TOP)/mk/target.mk
#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();
}
typedef void FUNC();
void callC( FUNC* f);
typedef void FUNC();
void callC( FUNC* f);
......@@ -6,3 +6,4 @@ NORM_OPTS = 5000000
SLOW_OPTS = 50000000
include $(TOP)/mk/target.mk
......@@ -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
-------------------------------------------------------------------------------
--- $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
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
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment