How to make FFI call interruptible

Question

According to GHC user guide foreign call can be marked interruptible, however, I cannot make it work. I'm using ghc 8.4.3 on GNU/Linux.

See for example this cbits.h:

/* cbits.h */

void loopForever();

cbits.c:

/* cbits.c */

#include <stdio.h>
#include <unistd.h>

#include "cbits.h"

void loopForever()
{
  for (;;)
  {
    printf("Tick\n");
    sleep(1);
  }
}

And finally Test.hs:

-- Test.hs

{-# LANGUAGE InterruptibleFFI #-}

module Main where

import Control.Concurrent
import Control.Concurrent.Async

main :: IO ()
main = race_ loopForever $ do
  threadDelay 2000000
  putStrLn "Finished"

foreign import ccall interruptible "cbits.h"
  loopForever :: IO ()

I compiled it all together with ghc -threaded -o a.out cbits.c Test.hs.

Now, I expected the code to stop after 2 seconds, however it keeps going even after "Finished" is printed. It did mention that This is **usually** enough to cause a blocking system call to return <...> in user guide, so is this the case that my c function is bad in particular, or am I doing something wrong on the Haskell side?

Answer 1

As per the documentation, the way the RTS attempts to interrupt the thread engaged in the foreign call is by sending it a SIGPIPE signal. Since the handler installed by the RTS ignores the signal, the only effect is that -- if the thread is engaged in a long-running system call -- that call is likely to return immediately with an EINTR. Since your foreign function doesn't check the return calls of printf and sleep to see if they were interrupted, the thread goes merrily on its way.

Now in an ideal world, it would be enough to modify your function to check for return values indicating that the functions had been interrupted, like so:

void loopForever()
{
  for (;;)
  {
    if (printf("Tick\n") < 0) break;
    if (sleep(1) != 0) break;
  }
}

Unfortunately, the interface for sleep() is braindead -- if it's interrupted, it returns the number of full seconds left to go, and if this is zero -- which it always is in your function -- it returns zero. Sigh...

You can either switch to usleep which sensibly returns -1 if interrupted, or you can use the trick of setting errno to zero and checking if printf or sleep change it (to EINTR, but you might as well abort on any non-zero number):

/* cbits.c */

#include <errno.h>
#include <stdio.h>
#include <unistd.h>

#include "cbits.h"

void loopForever()
{
  errno = 0;
  while (!errno)
  {
    printf("Tick\n");
    sleep(1);
  }
}

That should do what you want.

Now, depending on your real-world use case, you may find it more helpful to install a SIGPIPE handler, particularly if you expect the thread to be blocked in a long running computation (without any syscalls to interrupt). Just be sure to de-install the handler when you're done. Here's an example:

/* cbits.c */

#include <errno.h>
#include <signal.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>

#include "cbits.h"

volatile sig_atomic_t stop = 0;

void sigpipe_handler()
{
  stop = 1;
}

void loopForever()
{
  struct sigaction oldact, newact;
  bzero(&newact, sizeof(newact));
  newact.sa_handler = sigpipe_handler;
  sigaction(SIGPIPE, &newact, &oldact);
  while (!stop)
  {
    // loop forever until interrupted
  }
  printf("Stopped!");
  sigaction(SIGPIPE, &oldact, NULL);
}