diff options
Diffstat (limited to 'libraries/base/GHC/Event/Windows.hsc')
| -rw-r--r-- | libraries/base/GHC/Event/Windows.hsc | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc index bb58f4d1cd..a695df71d2 100644 --- a/libraries/base/GHC/Event/Windows.hsc +++ b/libraries/base/GHC/Event/Windows.hsc @@ -529,12 +529,13 @@ withOverlappedEx :: forall a. Manager -> String -- ^ Handle name -> HANDLE -- ^ Windows handle associated with the operation. + -> Bool -> Word64 -- ^ Value to use for the @OVERLAPPED@ -- structure's Offset/OffsetHigh members. -> StartIOCallback Int -> CompletionCallback (IOResult a) -> IO (IOResult a) -withOverlappedEx mgr fname h offset startCB completionCB = do +withOverlappedEx mgr fname h async offset startCB completionCB = do signal <- newEmptyIOPort :: IO (IOPort (IOResult a)) let signalReturn a = failIfFalse_ (dbgMsg "signalReturn") $ writeIOPort signal (IOSuccess a) @@ -552,7 +553,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- function will block until done so it can call completionCB at the end -- we can safely use dynamic memory management here and so reduce the -- possibility of memory errors. - withRequest offset callbackData $ \hs_lpol cdData -> do + withRequest async offset callbackData $ \hs_lpol cdData -> do let ptr_lpol = hs_lpol `plusPtr` cdOffset let lpol = castPtr hs_lpol -- We need to add the payload before calling startCBResult, the reason being @@ -625,11 +626,11 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- Normally we'd have to clear lpol with 0 before this call, -- however the statuses we're interested in would not get to here -- so we can save the memset call. - finished <- FFI.getOverlappedResult h lpol False + finished <- FFI.getOverlappedResult h lpol (not async) + lasterr <- getLastError debugIO $ "== " ++ show (finished) status <- FFI.overlappedIOStatus lpol debugIO $ "== >< " ++ show (status) - lasterr <- getLastError -- This status indicated that we have finished early and so we -- won't have a request enqueued. Handle it inline. let done_early = status == #{const STATUS_SUCCESS} @@ -779,7 +780,8 @@ withOverlappedEx mgr fname h offset startCB completionCB = do unless :: Bool -> IO () -> IO () unless p a = if p then a else return () --- Safe version of function +-- Safe version of function of withOverlappedEx that assumes your handle is +-- set up for asynchronous access. withOverlapped :: String -> HANDLE -> Word64 -- ^ Value to use for the @OVERLAPPED@ @@ -789,7 +791,7 @@ withOverlapped :: String -> IO (IOResult a) withOverlapped fname h offset startCB completionCB = do mngr <- getSystemManager - withOverlappedEx mngr fname h offset startCB completionCB + withOverlappedEx mngr fname h True offset startCB completionCB ------------------------------------------------------------------------ -- Helper to check if an error code implies an operation has completed. |