X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FConc%2FSync.lhs;h=370bfd91352bba9e88a65c177fbe93a2eb659be9;hb=6685444335fe57d5d86b61965989e45f34fddf0e;hp=b4de53a636086be076c38bea6996565bc353f7ee;hpb=41e8fba828acbae1751628af50849f5352b27873;p=ghc-base.git

diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index b4de53a..370bfd9 100644
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -42,6 +42,7 @@ module GHC.Conc.Sync
         , forkOnIO      -- :: Int -> IO a -> IO ThreadId
         , forkOnIOUnmasked
         , numCapabilities -- :: Int
+        , getNumCapabilities -- :: IO Int
         , numSparks      -- :: IO Int
         , childHandler  -- :: Exception -> IO ()
         , myThreadId    -- :: IO ThreadId
@@ -55,6 +56,7 @@ module GHC.Conc.Sync
 
         , ThreadStatus(..), BlockReason(..)
         , threadStatus  -- :: ThreadId -> IO ThreadStatus
+        , threadCapability
 
         -- * TVars
         , STM(..)
@@ -207,9 +209,7 @@ can migrate between CPUs according to the scheduling policy).
 know in advance how best to distribute the threads.
 
 The `Int` argument specifies the CPU number; it is interpreted modulo
-'numCapabilities' (note that it actually specifies a capability number
-rather than a CPU number, but to a first approximation the two are
-equivalent).
+the value returned by 'getNumCapabilities'.
 -}
 forkOnIO :: Int -> IO () -> IO ThreadId
 forkOnIO (I# cpu) action = IO $ \ s ->
@@ -226,10 +226,35 @@ forkOnIOUnmasked cpu io = forkOnIO cpu (unsafeUnmask io)
 -- Haskell threads that can run truly simultaneously at any given
 -- time, and is typically set to the number of physical CPU cores on
 -- the machine.
+-- 
+-- Strictly speaking it is better to use 'getNumCapabilities', because
+-- the number of capabilities might vary at runtime.
+--
 numCapabilities :: Int
-numCapabilities = unsafePerformIO $  do
-                    n <- peek n_capabilities
-                    return (fromIntegral n)
+numCapabilities = unsafePerformIO $ getNumCapabilities
+
+{- |
+Returns the number of Haskell threads that can run truly
+simultaneously (on separate physical processors) at any given time.
+The CPU number passed to `forkOnIO` is interpreted modulo this
+value.
+
+An implementation in which Haskell threads are mapped directly to
+OS threads might return the number of physical processor cores in
+the machine, and 'forkOnIO' would be implemented using the OS's
+affinity facilities.  An implementation that schedules Haskell
+threads onto a smaller number of OS threads (like GHC) would return
+the number of such OS threads that can be running simultaneously.
+
+GHC notes: this returns the number passed as the argument to the
+@+RTS -N@ flag.  In current implementations, the value is fixed
+when the program starts and never changes, but it is possible that
+in the future the number of capabilities might vary at runtime.
+-}
+getNumCapabilities :: IO Int
+getNumCapabilities = do
+   n <- peek n_capabilities
+   return (fromIntegral n)
 
 -- | Returns the number of sparks currently in the local spark pool
 numSparks :: IO Int
@@ -402,19 +427,28 @@ data ThreadStatus
 threadStatus :: ThreadId -> IO ThreadStatus
 threadStatus (ThreadId t) = IO $ \s ->
    case threadStatus# t s of
-     (# s', stat #) -> (# s', mk_stat (I# stat) #)
+    (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #)
    where
         -- NB. keep these in sync with includes/Constants.h
      mk_stat 0  = ThreadRunning
      mk_stat 1  = ThreadBlocked BlockedOnMVar
      mk_stat 2  = ThreadBlocked BlockedOnBlackHole
-     mk_stat 3  = ThreadBlocked BlockedOnException
-     mk_stat 7  = ThreadBlocked BlockedOnSTM
+     mk_stat 6  = ThreadBlocked BlockedOnSTM
+     mk_stat 10 = ThreadBlocked BlockedOnForeignCall
      mk_stat 11 = ThreadBlocked BlockedOnForeignCall
-     mk_stat 12 = ThreadBlocked BlockedOnForeignCall
+     mk_stat 12 = ThreadBlocked BlockedOnException
      mk_stat 16 = ThreadFinished
      mk_stat 17 = ThreadDied
      mk_stat _  = ThreadBlocked BlockedOnOther
+
+-- | returns the number of the capability on which the thread is currently
+-- running, and a boolean indicating whether the thread is locked to
+-- that capability or not.  A thread is locked to a capability if it
+-- was created with @forkOnIO@.
+threadCapability :: ThreadId -> IO (Int, Bool)
+threadCapability (ThreadId t) = IO $ \s ->
+   case threadStatus# t s of
+     (# s', _, cap#, locked# #) -> (# s', (I# cap#, locked# /=# 0#) #)
 \end{code}