summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--libraries/base/GHC/Conc/Windows.hs5
-rw-r--r--libraries/base/GHC/Event/Windows.hsc54
-rw-r--r--libraries/base/GHC/Event/Windows/ManagedThreadPool.hs11
-rw-r--r--libraries/base/GHC/Event/Windows/Thread.hs5
-rw-r--r--libraries/base/GHC/IO/Handle/Lock/Windows.hsc3
5 files changed, 31 insertions, 47 deletions
diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs
index 800fc57cdd..5be07065e6 100644
--- a/libraries/base/GHC/Conc/Windows.hs
+++ b/libraries/base/GHC/Conc/Windows.hs
@@ -49,11 +49,6 @@ import qualified GHC.Conc.IOCP as WINIO
import GHC.Event.Windows.ConsoleEvent
import GHC.IO.SubSystem ((<!>))
import GHC.Ptr
-import GHC.Read (Read)
-import GHC.Real (div, fromIntegral)
-import GHC.Show (Show)
-import GHC.Word (Word32, Word64)
-import GHC.Windows
import Unsafe.Coerce ( unsafeCoerceUnlifted )
-- ----------------------------------------------------------------------------
diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc
index 0bcfa3389c..a041ce0409 100644
--- a/libraries/base/GHC/Event/Windows.hsc
+++ b/libraries/base/GHC/Event/Windows.hsc
@@ -78,33 +78,36 @@ module GHC.Event.Windows (
#include <Rts.h>
#include "winio_structs.h"
+-- There doesn't seem to be GHC.* import for these
+import Control.Concurrent.MVar (modifyMVar)
+import {-# SOURCE #-} Control.Concurrent (forkOS)
+import Data.Semigroup.Internal (stimesMonoid)
+import Data.Foldable (mapM_, length, forM_)
+import Data.Maybe (isJust, maybe)
+
import GHC.Event.Windows.Clock (Clock, Seconds, getClock, getTime)
import GHC.Event.Windows.FFI (LPOVERLAPPED, OVERLAPPED_ENTRY(..))
import GHC.Event.Windows.ManagedThreadPool
import GHC.Event.Internal.Types
+import GHC.Event.Unique
+import GHC.Event.TimeOut
+import GHC.Event.Windows.ConsoleEvent
import qualified GHC.Event.Windows.FFI as FFI
import qualified GHC.Event.PSQ as Q
import qualified GHC.Event.IntTable as IT
import qualified GHC.Event.Internal as I
-import {-# SOURCE #-} Control.Concurrent
-import Control.Concurrent.MVar
-import Control.Exception as E
-import Data.IORef
-import Data.Foldable (mapM_, length, forM_)
-import Data.Maybe
-import Data.Word
-import Data.Semigroup.Internal (stimesMonoid)
-import Data.OldList (deleteBy)
+import GHC.MVar
+import GHC.Exception as E
+import GHC.IORef
+import GHC.Maybe
+import GHC.Word
+import GHC.OldList (deleteBy)
import Foreign
import qualified GHC.Event.Array as A
import GHC.Base
-import GHC.Conc.Sync (forkIO, showThreadId,
- ThreadId(..), ThreadStatus(..),
- threadStatus, sharedCAF)
-import GHC.Event.Unique
-import GHC.Event.TimeOut
-import GHC.Event.Windows.ConsoleEvent
+import GHC.Conc.Sync
+import GHC.IO
import GHC.IOPort
import GHC.Num
import GHC.Real
@@ -112,19 +115,19 @@ import GHC.Enum (maxBound)
import GHC.Windows
import GHC.List (null)
import GHC.Ptr
-import System.IO.Unsafe (unsafePerformIO)
import Text.Show
--- if defined(DEBUG)
-#if 1
+#if defined(DEBUG)
import Foreign.C
import System.Posix.Internals (c_write)
-import GHC.Conc.Sync (myThreadId, labelThread)
+import GHC.Conc.Sync (myThreadId)
#endif
import qualified GHC.Windows as Win32
+#if defined(DEBUG_TRACE)
import {-# SOURCE #-} Debug.Trace (traceEventIO)
+#endif
-- Note [WINIO Manager design]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -673,7 +676,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do
-- the pointer.
debugIO $ "## Waiting for cancellation record... "
_ <- FFI.getOverlappedResult h lpol True
- let oldDataPtr = exchangePtr ptr_lpol nullReq
+ oldDataPtr <- exchangePtr ptr_lpol nullReq
-- Check if we have to free and cleanup pointer
when (oldDataPtr == cdData) $
do free oldDataPtr
@@ -1044,11 +1047,11 @@ processCompletion Manager{..} n delay = do
++ " offset: " ++ show cdOffset
++ " cdData: " ++ show cdDataCheck
++ " at idx " ++ show idx
- let oldDataPtr = exchangePtr ptr_lpol nullReq
+ oldDataPtr <- exchangePtr ptr_lpol nullReq :: IO (Ptr CompletionData)
debugIO $ ":: oldDataPtr " ++ show oldDataPtr
- when (oldDataPtr /= nullPtr && oldDataPtr /= nullReq) $
+ when (oldDataPtr /= nullPtr) $
do debugIO $ "exchanged: " ++ show oldDataPtr
- payload <- peek oldDataPtr
+ payload <- peek oldDataPtr :: IO CompletionData
let !cb = cdCallback payload
free oldDataPtr
reqs <- removeRequest
@@ -1185,13 +1188,10 @@ foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)
foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c)
c_readIOManagerEvent :: IO Word32
-foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c)
- c_sendIOManagerEvent :: Word32 -> IO ()
-
foreign import ccall unsafe "rtsSupportsBoundThreads" threadedIOMgr :: Bool
-- | Sleep for n ms
-foreign import stdcall unsafe "Sleep" sleepBlock :: Int -> IO ()
+foreign import WINDOWS_CCONV unsafe "Sleep" sleepBlock :: Int -> IO ()
-- ---------------------------------------------------------------------------
-- I/O manager event notifications
diff --git a/libraries/base/GHC/Event/Windows/ManagedThreadPool.hs b/libraries/base/GHC/Event/Windows/ManagedThreadPool.hs
index 11c1259257..94e498b58e 100644
--- a/libraries/base/GHC/Event/Windows/ManagedThreadPool.hs
+++ b/libraries/base/GHC/Event/Windows/ManagedThreadPool.hs
@@ -26,6 +26,7 @@ module GHC.Event.Windows.ManagedThreadPool
, startThreadPool
, notifyRunning
, notifyWaiting
+ , monitorThreadPool
) where
import Control.Concurrent.MVar
@@ -34,15 +35,9 @@ import Foreign
import GHC.Base
import GHC.Num ((-), (+))
import GHC.Real (fromIntegral)
-import GHC.Show
-import GHC.Windows
import qualified GHC.Event.Array as A
-import qualified GHC.Windows as Win32
import GHC.IO.Handle.Internals (debugIO)
-import GHC.Conc.Sync (forkIO, showThreadId,
- ThreadId(..), ThreadStatus(..),
- threadStatus, sharedCAF)
-import System.IO.Unsafe (unsafePerformIO)
+import GHC.Conc.Sync (ThreadId(..))
import GHC.RTS.Flags
------------------------------------------------------------------------
@@ -79,7 +74,7 @@ startThreadPool job = do
monitorThreadPool :: MVar () -> IO ()
monitorThreadPool monitor = do
- active <- takeMVar monitor
+ _active <- takeMVar monitor
return ()
diff --git a/libraries/base/GHC/Event/Windows/Thread.hs b/libraries/base/GHC/Event/Windows/Thread.hs
index 479f6d6b34..57faa9de80 100644
--- a/libraries/base/GHC/Event/Windows/Thread.hs
+++ b/libraries/base/GHC/Event/Windows/Thread.hs
@@ -9,12 +9,9 @@ module GHC.Event.Windows.Thread (
import GHC.Conc.Sync
import GHC.Base
+import GHC.Event.Windows
import GHC.IO
import GHC.IOPort
-import GHC.Real
-
-import GHC.Event.Windows.Clock
-import GHC.Event.Windows
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning = wakeupIOManager
diff --git a/libraries/base/GHC/IO/Handle/Lock/Windows.hsc b/libraries/base/GHC/IO/Handle/Lock/Windows.hsc
index f223209da6..f1e54125bb 100644
--- a/libraries/base/GHC/IO/Handle/Lock/Windows.hsc
+++ b/libraries/base/GHC/IO/Handle/Lock/Windows.hsc
@@ -30,10 +30,7 @@ import GHC.IO.FD
import GHC.IO.Handle.FD
import GHC.IO.Handle.Types (Handle)
import GHC.IO.Handle.Lock.Common (LockMode(..))
-import GHC.IO.Handle.Windows (handleToHANDLE)
-import GHC.IO.Handle.Lock.Common (LockMode(..), FileLockingNotSupported(..))
import GHC.IO.SubSystem
-import GHC.Ptr
import GHC.Windows
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
View Lorry Controller Status