> This is a very nice function but unfortunately it still
> doesn't quite work, because
> of the delay in executing the interrupt action. (I write
> having applied the
> patch and tried the function out with a little program of my
> own.) I suppose it is
> not so bad that
> allowInterupts action handler
> may delay the handler for a few moments. However what IS bad
> is that if the
> action terminates before the interrupt gets processed, the
> whole program
> is embarassingly terminated with a "Fail: interrupted".
> (This has just happened.)
> I suppose it is possible to work around this particular
> problem by modifying
> allowInterrupts to use an MVar to see if the action has
> terminated yet.
> (Or is it? How do you avoid a race condition?) But this
> isn't exactly ideal.
> So could there be an IO action which yields until all pending
> interrupt
> handlers have finished?
Hmm, good points. The delay before running the signal handler shouldn't be
too long, unless you have *lots* of running threads. To fix this, we'd need
priorities in our scheduler, which I don't have any plans to implement in
the near future, but it would be nice nonetheless.
Ok, I think the following code fixes up the race conditions. The idea is to
have a semaphore which says that the main thread is ready to service an
interrupt. The main thread also attempts to grab the semaphore before
exiting the handler; this way any pending interrupts will either service (if
they grab the semaphore first), or block and eventually be garbage collected
(if they attempt to grab the semaphore after the main thread).
This code is untested, BTW.
main = allowInterrupts
(getLine >> putStr "Ok.")
(putStr "Interrupted")
handler :: ThreadId -> MVar () -> IO ()
handler parent handler_ready = do
takeMVar handler_ready
raiseInThread parent (ErrorCall "interrupted")
allowInterrupts :: IO a -> IO a -> IO a
allowInterrupts action on_interrupt
= do tso <- myThreadId
handler_ready <- newEmptyMVar
(do
putMVar handler_ready ()
old <- installHandler sigINT (Catch (handler tso handler_ready))
Nothing
res <- action
takeMVar handler_ready
installHandler sigINT old Nothing
return res
) `catchAllIO`
( \ e -> case e of
ErrorCall "interrupted" -> on_interrupt
_other -> throw e)
Cheers,
Simon
