Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2 https://github.com/ghc/ghc/commit/a23a87e98cb365a586e4e236977aa678040ed95d >--------------------------------------------------------------- commit a23a87e98cb365a586e4e236977aa678040ed95d Author: KC Sivaramakrishnan <chand...@cs.purdue.edu> Date: Tue May 7 19:59:29 2013 -0400 Minor comment edit to TysPrim. Exposing isSContBound* from LwConc.Substrate. >--------------------------------------------------------------- compiler/prelude/TysPrim.lhs | 2 +- libraries/base/LwConc/Substrate.hs | 60 +++++++++++++++++------- tests/Benchmarks/Sieve/ConcurrentListStealing.hs | 16 +++---- tests/Benchmarks/Sieve/Makefile | 2 +- 4 files changed, 54 insertions(+), 26 deletions(-) diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 584a35f..46137bc 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -654,7 +654,7 @@ threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep %************************************************************************ %* * -\subsection[TysPrim-HEC]{The ``HEC'' type} +\subsection[TysPrim-SCont]{The ``SCont'' type} %* * %************************************************************************ diff --git a/libraries/base/LwConc/Substrate.hs b/libraries/base/LwConc/Substrate.hs index bbc80bf..199a376 100644 --- a/libraries/base/LwConc/Substrate.hs +++ b/libraries/base/LwConc/Substrate.hs @@ -54,7 +54,6 @@ module LwConc.Substrate , newSCont -- IO () -> IO SCont , getSCont -- PTM SCont , getSContIO -- IO SCont -, getSContId -- SCont -> PTM Int ------------------------------------------------------------------------------ -- Switch @@ -87,7 +86,9 @@ module LwConc.Substrate #ifdef __GLASGOW_HASKELL__ , newBoundSCont -- IO () -> IO SCont -, isCurrentThreadBound -- IO Bool +, isCurrentSContBound -- IO Bool +, isSContBound -- SCont -> IO Bool +, isSContBoundPTM -- SCont -> PTM Bool , rtsSupportsBoundThreads -- Bool #endif @@ -158,6 +159,7 @@ import GHC.Exception import GHC.Base import GHC.Prim import GHC.IO +import qualified GHC.Foreign import Control.Monad ( when ) #endif @@ -356,6 +358,37 @@ initSContStatus = SContSwitched Yielded data SCont = SCont SCont# +{- +instance Show SCont where + showsPrec d t = + showString "SCont " . + showsPrec d (getSContId (id2SCont t)) + +foreign import ccall unsafe "rts_getThreadId" getSContId :: SCont# -> CInt + +id2SCont :: SCont -> SCont# +id2SCont (SCont t) = t + +foreign import ccall unsafe "cmp_thread" cmp_scont :: SCont# -> SCont# -> CInt +-- Returns -1, 0, 1 + +cmpSCont :: SCont -> SCont -> Ordering +cmpSCont t1 t2 = + case cmp_scont (id2SCont t1) (id2SCont t2) of + -1 -> LT + 0 -> EQ + _ -> GT -- must be 1 + +instance Eq SCont where + t1 == t2 = + case t1 `cmpSCont` t2 of + EQ -> True + _ -> False + +instance Ord SCont where + compare = cmpSCont +-} + {-# INLINE newSCont #-} newSCont :: IO () -> IO SCont newSCont x = do @@ -396,11 +429,6 @@ switch arg = atomically $ do -- At this point we expect currentSCont status to not be Running switchTo targetSCont -{-# INLINE getSContId #-} -getSContId :: SCont -> PTM Int -getSContId (SCont sc) = PTM $ \s -> - case getSContId# sc s of (# s, i #) -> (# s, (I# i) #) - ----------------------------------------------------------------------------------- -- SCont-local Storage (SLS) ----------------------------------------------------------------------------------- @@ -526,7 +554,7 @@ debugPrint s = do _ <- withCStringLen (s ++ "\n") $ ---------------------------------------------------------------------------- -- | 'True' if bound threads are supported. --- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound' +-- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentSContBound' -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will -- fail. foreign import ccall rtsSupportsBoundThreads :: Bool @@ -534,19 +562,19 @@ foreign import ccall rtsSupportsBoundThreads :: Bool -- | Returns 'True' if the calling thread is /bound/, that is, if it is -- safe to use foreign libraries that rely on thread-local state from the -- calling thread. -isCurrentThreadBound :: IO Bool -isCurrentThreadBound = IO $ \ s# -> +isCurrentSContBound :: IO Bool +isCurrentSContBound = IO $ \ s# -> case isCurrentThreadBound# s# of (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #) -isThreadBound :: SCont -> IO Bool -isThreadBound (SCont sc) = IO $ \ s# -> +isSContBound :: SCont -> IO Bool +isSContBound (SCont sc) = IO $ \ s# -> case isThreadBound# sc s# of (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #) -isThreadBoundPTM :: SCont -> PTM Bool -isThreadBoundPTM (SCont sc) = PTM $ \ s# -> +isSContBoundPTM :: SCont -> PTM Bool +isSContBoundPTM (SCont sc) = PTM $ \ s# -> case isThreadBound# sc s# of (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #) @@ -585,7 +613,7 @@ newBoundSCont action0 when (err /= 0) $ fail "Cannot create OS thread." -- Wait for initialization let wait = do { - r <- isThreadBound s; + r <- isSContBound s; if r then return () @@ -612,7 +640,7 @@ newBoundSCont action0 ---------------------------------------------------------------------------- --- Spinning up more schedulers (Experimental) +-- Spinning up more capabilities (Experimental) -- Given a bound thread, assigns it a free capability. If there are no free -- capabilities, this call will never return! diff --git a/tests/Benchmarks/Sieve/ConcurrentListStealing.hs b/tests/Benchmarks/Sieve/ConcurrentListStealing.hs index fb2cfcb..2d77907 100644 --- a/tests/Benchmarks/Sieve/ConcurrentListStealing.hs +++ b/tests/Benchmarks/Sieve/ConcurrentListStealing.hs @@ -46,21 +46,21 @@ newtype Sched = Sched (Array Int (PVar [SCont], PVar [SCont])) _INL_(yieldControlAction) yieldControlAction :: Sched -> PTM () yieldControlAction !(Sched pa) = do - cc <- getCurrentCapability + myCap <- getCurrentCapability let (_,end) = bounds pa - -- Try to pick work for local queue first. If the queue is empty, check other - -- queues. If every queue is empty, put the capability to sleep. - let l::[Int] = cc:(filter (\i -> i /= cc) [0..end]) - res <- foldM maybeSkip Nothing l + -- Try to pick work for local queue first. If the queue is empty, check other + -- queues. If every queue is empty, put the capability to sleep. + let l::[Int] = myCap:(filter (\i -> i /= myCap) [0..end]) + res <- foldM (maybeSkip myCap) Nothing l case res of Nothing -> sleepCapability Just x -> switchTo x where - maybeSkip mx cc = case mx of - Nothing -> checkQ cc + maybeSkip myCap mx cc = case mx of + Nothing -> checkQ cc myCap Just x -> return $ Just x - checkQ cc = do + checkQ cc myCap = do let !(frontRef, backRef)= pa ! cc front <- readPVar frontRef case front of diff --git a/tests/Benchmarks/Sieve/Makefile b/tests/Benchmarks/Sieve/Makefile index 3f5d8be..68eee63 100644 --- a/tests/Benchmarks/Sieve/Makefile +++ b/tests/Benchmarks/Sieve/Makefile @@ -3,7 +3,7 @@ TARGET := sieve-vanilla.bin sieve-lwc.bin sieve-TMVar.bin sieve-vanilla-TMVar.bi include ../../config.mk TOP := ../../../ -GHC_OPTS_EXTRA=-threaded -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -O2 -optc-O3 +GHC_OPTS_EXTRA=--make -threaded -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -O2 -optc-O3 PROFILE_FLAGS := -DPROFILE_ENABLED -prof -auto-all -fprof-auto _______________________________________________ ghc-commits mailing list ghc-commits@haskell.org http://www.haskell.org/mailman/listinfo/ghc-commits
