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 _______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users@haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users