FFI, signals and exceptions

Edward Z. Yang ezyang at MIT.EDU
Thu Aug 26 12:56:54 EDT 2010

Excerpts from Simon Marlow's message of Thu Aug 26 04:08:06 -0400 2010:
> You don't want to do this for a bound thread (when target->bound != 
> NULL), because the OS thread will have interesting things on its C stack 
> and pthread_cancel discards the entire stack.  A worker thread on the 
> other hand has an uninteresting stack and we can easily make another one.

It seems possible that under certain (limited) circumstances, this would
be desirable behavior: for example, if we truly wanted to destroy the bound
thread-local state and start over from scratch.

> So you don't want to do blockedThrowTo, instead call raiseAsync to raise 
> the exception, and that should put the TSO back on the the run queue.


    raiseAsync(cap, target, msg->exception, rtsFalse, NULL)
    // ....

the thread is successfully able to catch the exception!

        case BlockedOnCCall:
        case BlockedOnCCall_NoUnblockExc:
    #ifdef THREADED_RTS
            Task *task = NULL;
            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
            if (!target->bound) {
                // walk all_tasks to find the correct worker thread
                for (task = all_tasks; task != NULL; task = task->all_link) {
                    if (task->incall->suspended_tso == target) {
            if (task != NULL) {
                task->cap = NULL;
                task->stopped = rtsTrue;
            return THROWTO_SUCCESS;
            return THROWTO_BLOCKED;

Here is a new (working) implementation interruptible:

    interruptible :: a -> IO a -> IO a
    interruptible defaultVal m = do
        mresult <- newEmptyMVar -- transfer exception to caller
        mtid    <- newEmptyMVar
        let install = do
                installIntHandler (Catch ctrlc)
            cleanup oldHandler = do
                _ <- installIntHandler oldHandler
                return ()
            ctrlc = do
                hPutStrLn stderr "Caught signal"
                tid <- readMVar mtid
                throwTo tid E.UserInterrupt
            bracket = reportBracket . E.bracket install cleanup . const
            reportBracket action = do
                putMVar mresult =<< E.catches (liftM Right action)
                    [ E.Handler (\(e :: E.AsyncException) ->
                        return $ case e of
                            E.UserInterrupt -> Right defaultVal
                            _ -> Left (E.toException e)
                    , E.Handler (\(e :: E.SomeException) -> return (Left e))
        putMVar mtid =<< forkIO (bracket m)
        either E.throw return =<< readMVar mresult -- one write only

Do you have any suggestions for stress-testing this code?


More information about the Glasgow-haskell-users mailing list