[commit: ghc] ghc-lwc2: Minor comment edit to TysPrim. Exposing isSContBound* from LwConc.Substrate. (a23a87e)
Sivaramakrishnan Krishnamoorthy Chandrasekaran
t-sichan at microsoft.com
Wed May 8 07:50:36 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2
https://github.com/ghc/ghc/commit/a23a87e98cb365a586e4e236977aa678040ed95d
>---------------------------------------------------------------
commit a23a87e98cb365a586e4e236977aa678040ed95d
Author: KC Sivaramakrishnan <chandras at 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
More information about the ghc-commits
mailing list