haskell - 使用 Haskell 回调函数调用多线程 C FFI 时出现调度错误

Question

下面是一个 Haskell/C FFI 代码，该代码在运行时抛出调度错误(GHC 7.0.3、Mac OS 10.7、x86_64)。我搜索了错误的解释，但没有找到任何相关内容。

C 代码 (mt.c):

#include <pthread.h>
#include <stdio.h>

typedef void(*FunctionPtr)(int);

/* This is our thread function.  It is like main(), but for a thread*/
void *threadFunc(void *arg)
{
  FunctionPtr fn;
  fn = (FunctionPtr) arg;
  fn(1); //call haskell function with a CInt argument to see if it works
}

void create_threads(FunctionPtr* fp, int numThreads )
{
  pthread_t pth[numThreads];  // array of pthreads
  int t;
  for (t=0; t < numThreads;){
    pthread_create(&pth[t],NULL,threadFunc,*(fp + t));
    t++;
  }

  printf("main waiting for all threads to terminate...\n");
  for (t=0; t < numThreads;t++){
    pthread_join(pth[t],NULL);
  }
}

Haskell 代码 (t.hs) - 它使用 Storable Vector 调用上面 mt.c 中的 create_threads FunPtr 到 Haskell 函数 f(将前三个参数应用于 f 后):

{-# LANGUAGE BangPatterns #-}
import Control.Concurrent (forkIO, threadDelay, MVar, newEmptyMVar, putMVar, takeMVar)
import qualified Data.Vector.Storable.Mutable as MSV
import qualified Data.Vector.Storable as SV
import Control.Monad.Primitive (PrimState)
import Control.Monad (mapM, forM_)
import Foreign.Ptr (Ptr, FunPtr)
import Foreign.C.Types (CInt)


type Length = CInt

-- | f is a function that is called back by create_threads in mt.c
f :: MVar Int -> MSV.MVector (PrimState IO) CInt -> Length -> CInt -> IO ()
f m v l x = do
              !i <- takeMVar m
              case (i< fromIntegral l) of
                True -> MSV.unsafeWrite v i x >> print x >> putMVar m (i+1) 
                False -> return () -- overflow

-- a "wrapper" import gives us a converter for converting a Haskell function to a foreign function pointer
foreign import ccall "wrapper"
  wrap :: (CInt -> IO()) -> IO (FunPtr (CInt -> IO()))

foreign import ccall safe "create_threads"
  createThreads :: Ptr (FunPtr (CInt -> IO())) -> CInt -> IO()

main = do
  let threads = [1..4]
  m <- mapM (\x -> newEmptyMVar) $ threads
  -- intialize mvars with 0
  forM_ m $ \x -> putMVar x 0
  let l = 10
  -- intialize vectors of length 10 that will be filled by function f
  v <- mapM (\x -> MSV.new l) threads
  -- create a list of function pointers to partial function - the partial function is obtained by applying first three arguments to         function f
  lf <- mapM (\(x,y) -> wrap (f x y (fromIntegral l))) $ zip m v
  -- convert above function list to a storable vector of function pointers
  let fv = SV.fromList lf
  -- call createThreads with storable vector of function pointers, and number of threads - createThreads will spawn threads which will use  function pointers for callback
  SV.unsafeWith fv $ \x -> createThreads x (fromIntegral $ length threads)

请忽略代码中的不安全部分 - 我的目标是使用 Haskell FFI 和多线程 C 代码来测试回调。当我编译并运行它时，出现以下错误:

$ ghc -O2 t.hs mt.c -lpthread
[1 of 1] Compiling Main             ( t.hs, t.o )
Linking t ...
$ ./t
main waiting for all threads to terminate...
t: schedule: re-entered unsafely.
   Perhaps a 'foreign import unsafe' should be 'safe'?
$ uname -a
Darwin desktop.local 11.2.0 Darwin Kernel Version 11.2.0: Tue Aug  9 20:54:00 PDT 2011; root:xnu-1699.24.8~1/RELEASE_X86_64 x86_64
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.0.3

仅当我让 C 线程回调 haskell 函数 f 时，才会发生计划错误。我想我的代码中更有可能存在错误，而不是某个库或 GHC 中存在错误。因此，我想首先在此处检查有关错误原因的指示。

Answer 1

在这种情况下，发生schedule错误是因为haskell代码是在没有-threaded选项的情况下编译的。

haskell 代码正在调用 C 函数 create_threads，它为 threadFunc C 函数生成多个线程。 threadFunc 回调 Haskell 函数 f。因此，即使 Haskell 代码在编译时没有使用 -threaded 选项，它仍然会导致多个 C 线程执行 f。

GHC 运行时调度程序很好地捕获了在没有线程运行时执行多个线程的这种疏忽，并将其标记为错误。这比神秘的运行时崩溃要好得多。当我检查rts/schedule.c时我意识到了疏忽GHC代码库中的代码，并看到下面的评论。它向我透露了线程运行时未启用的信息:

// Check whether we have re-entered the RTS from Haskell without
 // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
 // call).