[commit: ghc] ghc-lwc2: Moved debugPrint (skips IOManager) to LwConc.Substrate (c5b1aee)

[Sivaramakrishnan Krishnamoorthy Chandrasekaran]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : ghc-lwc2

https://github.com/ghc/ghc/commit/c5b1aeee7c5a66ca83227d6fa65c6277d785eb87

>---------------------------------------------------------------

commit c5b1aeee7c5a66ca83227d6fa65c6277d785eb87
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Sun May 5 12:45:11 2013 -0400

    Moved debugPrint (skips IOManager) to LwConc.Substrate

>---------------------------------------------------------------

 libraries/base/GHC/IO/Handle/Internals.hs |  5 -----
 libraries/base/LwConc/Substrate.hs        | 17 +++++++++++++++--
 tests/Benchmarks/Sieve/Makefile           |  2 +-
 tests/Benchmarks/Sieve/sieve-vanilla.hs   |  2 +-
 4 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index 875d31e..bbb3c19 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -52,7 +52,6 @@ module GHC.IO.Handle.Internals (
   HandleFinalizer, handleFinalizer,
 
   debugIO,
-  debugPrint,
  ) where
 
 import GHC.IO
@@ -805,10 +804,6 @@ debugIO s
          return ()
  | otherwise = return ()
 
-debugPrint :: String -> IO ()
-debugPrint s = do _ <- withCStringLen (s ++ "\n") $
-                     \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
-                  return ()
 
 -- ----------------------------------------------------------------------------
 -- Text input/output
diff --git a/libraries/base/LwConc/Substrate.hs b/libraries/base/LwConc/Substrate.hs
index 52ccd90..7b1d608 100644
--- a/libraries/base/LwConc/Substrate.hs
+++ b/libraries/base/LwConc/Substrate.hs
@@ -159,7 +159,6 @@ import GHC.Base
 import GHC.Prim
 import GHC.IO
 import Control.Monad    ( when )
-import GHC.IO.Handle.Internals
 #endif
 
 import System.IO
@@ -167,7 +166,11 @@ import GHC.Conc (yield, childHandler, getNumCapabilities)
 import Data.Typeable
 import Data.Dynamic
 import Foreign.StablePtr
+
 import Foreign.C.Types
+import Foreign.Safe
+import Foreign.C
+import System.Posix.Internals hiding (FD)
 
 #include "Typeable.h"
 
@@ -435,7 +438,8 @@ getYieldControlAction = do
 {-# INLINE yieldControlActionRts #-}
 yieldControlActionRts :: SCont -> IO () -- used by RTS
 yieldControlActionRts sc = Exception.catch (atomically $ do
-  -- mySC is the upcall thread. Set its status to Completed.
+	-- mySC is the upcall thread. Set its status to Completed. We will try to
+	-- reuse this upcall thread. See prepareUpcallThread* in rts/Upcalls.c
   mySC <- getSCont
   setSContSwitchReason mySC Completed
   stat <- getSContStatus sc
@@ -508,6 +512,15 @@ defaultExceptionHandler e = do
     yca
 
 
+-----------------------------------------------------------------------------------
+-- debugging
+-----------------------------------------------------------------------------------
+
+debugPrint :: String -> IO ()
+debugPrint s = do _ <- withCStringLen (s ++ "\n") $
+                     \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
+                  return ()
+
 ----------------------------------------------------------------------------
 -- Bound threads
 ----------------------------------------------------------------------------
diff --git a/tests/Benchmarks/Sieve/Makefile b/tests/Benchmarks/Sieve/Makefile
index dee0445..96e57da 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=-O2 -threaded -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -eventlog -optc-O3 -debug
+GHC_OPTS_EXTRA=-O2 -threaded -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -optc-O3 -debug
 
 PROFILE_FLAGS := -DPROFILE_ENABLED -prof -auto-all -fprof-auto
 
diff --git a/tests/Benchmarks/Sieve/sieve-vanilla.hs b/tests/Benchmarks/Sieve/sieve-vanilla.hs
index ef6cc94..42e0d01 100644
--- a/tests/Benchmarks/Sieve/sieve-vanilla.hs
+++ b/tests/Benchmarks/Sieve/sieve-vanilla.hs
@@ -12,7 +12,7 @@ generate mOut = mapM_ (putMVar mOut) [2..]
 primeFilter :: MVar Int -> MVar Int -> Int -> IO ()
 primeFilter mIn mOut prime = do
   tid <- myThreadId
-  labelThread tid $ "ThrPrime:" ++ show prime
+  -- labelThread tid $ "ThrPrime:" ++ show prime
   forever $ do
     i <- takeMVar mIn
     when (i `mod` prime /= 0) (putMVar mOut i)