From: sof <unknown>
Date: Fri, 22 Apr 2005 17:00:49 +0000 (+0000)
Subject: [project @ 2005-04-22 17:00:49 by sof]
X-Git-Tag: arity-anal-branch-point~1
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e225c624c6bc7099da8e2092d76563e43b7ba3f2;hp=002864325037f03891f46044319ed2ccc372f240;p=haskell-directory.git

[project @ 2005-04-22 17:00:49 by sof]
[mingw only]
Better handling of I/O request abortions upon throwing an exception
to a Haskell thread. As was, a thread blocked on an I/O request was
simply unblocked, but its corresponding worker thread wasn't notified
that the request had been abandoned.

This manifested itself in GHCi upon Ctrl-C being hit at the prompt -- the
worker thread blocked waiting for input on stdin prior to Ctrl-C would
stick around even though its corresponding Haskell thread had been
thrown an Interrupted exception. The upshot was that the worker would
consume the next character typed in after Ctrl-C, but then just dropping
it. Dealing with this turned out to be even more interesting due to
Win32 aborting any console reads when Ctrl-C/Break events are delivered.

The story could be improved upon (at the cost of portability) by making
the Scheduler able to abort worker thread system calls; as is, requests
are cooperatively abandoned. Maybe later.

Also included are other minor tidyups to Ctrl-C handling under mingw.

Merge to STABLE.
---

diff --git a/GHC/ConsoleHandler.hs b/GHC/ConsoleHandler.hs
index 945be3c..77ea7b4 100644
--- a/GHC/ConsoleHandler.hs
+++ b/GHC/ConsoleHandler.hs
@@ -84,9 +84,13 @@ installHandler handler =
 
    toHandler hdlr ev = do
       case toConsoleEvent ev of
-        Just x  -> hdlr x
+	 -- see rts/win32/ConsoleHandler.c for comments as to why
+	 -- rts_ConsoleHandlerDone is called here.
+        Just x  -> hdlr x >> rts_ConsoleHandlerDone ev
 	Nothing -> return () -- silently ignore..
 
-foreign import ccall unsafe "Signals.h stg_InstallConsoleEvent" 
+foreign import ccall unsafe "RtsExternal.h rts_InstallConsoleEvent" 
   rts_installHandler :: CInt -> Ptr (StablePtr (CInt -> IO ())) -> IO CInt
+foreign import ccall unsafe "RtsExternal.h rts_ConsoleHandlerDone"
+  rts_ConsoleHandlerDone :: CInt -> IO ()
 #endif /* mingw32_HOST_OS */