From e225c624c6bc7099da8e2092d76563e43b7ba3f2 Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 22 Apr 2005 17:00:49 +0000 Subject: [PATCH 1/1] [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. --- GHC/ConsoleHandler.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) 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 */ -- 1.7.10.4