Re: FFI, signals and exceptions

26 Aug 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.
With:

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

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) {
                        break;
                    }
                }
            }
            if (task != NULL) {
                pthread_cancel(task->id);
                task->cap = NULL;
                task->stopped = rtsTrue;
            }
            return THROWTO_SUCCESS;
    #else
            blockedThrowTo(cap,target,msg);
            return THROWTO_BLOCKED;
    #endif
        }

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?

Cheers,
Edward

Re: FFI, signals and exceptions

Edward Z. Yang