FunPtr callbacks broken?

[Jeremy Shaw]

Hello,

I am trying to use FunPtr for a callback from C, but I seem to be
getting the error:

simplejack: schedule: re-entered unsafely.
   Perhaps a 'foreign import unsafe' should be 'safe'?

Am I misusing something? Or is this a compiler bug? Google indicated
that the last time someone had this problem it was a compiler bug...

Here is the test program. It requires jack to be running
(http://jackit.sf.net) and I built it with:

ghc --make -fglasgow-exts SimpleJack.hs -o simplejack  -ljack

{{{

module Main where

import Foreign.C
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable
import Foreign.Marshal.Array
import Foreign.Marshal.Utils


data JackClient
data JackPort

-- typedef int  (*JackProcessCallback)(jack_nframes_t nframes, void *arg);
type JackProcessCallbackFunction = (CUInt -> StablePtr () -> IO CInt)
data JackProcessCallback = JackProcessCallback JackProcessCallbackFunction

foreign import ccall safe "wrapper" mkJackProcessCallback :: JackProcessCallbackFunction -> IO (FunPtr JackProcessCallbackFunction)
foreign import ccall safe "jack/jack.h jack_client_new" cjackClientNew :: CString -> IO (Ptr JackClient)
foreign import ccall safe "jack/jack.h jack_activate" jackActivate :: Ptr JackClient -> IO CInt
foreign import ccall safe "jack/jack.h jack_set_process_callback" cjackSetProcessCallback :: Ptr JackClient -> FunPtr JackProcessCallbackFunction -> StablePtr () -> IO ()


jackClientNew :: String -> IO (Ptr JackClient)
jackClientNew name =
    withCString name $ cjackClientNew

jackSetProcessCallback :: Ptr JackClient -> JackProcessCallbackFunction -> IO ()
jackSetProcessCallback client f =
    do cf <- mkJackProcessCallback f
       cjackSetProcessCallback client cf (castPtrToStablePtr nullPtr)

main =
    do client <- jackClientNew "Jack"
       if (client == nullPtr)
	  then error "jackClientNew Failed"
	  else putStrLn "jackClientNew succeeded."

       jackSetProcessCallback client simpleCallback
       ret <- jackActivate client
       if (ret /= 0)
	  then error "jackActivate failed."
	  else putStrLn "jackActivate succeeded."
       getLine
       loop


loop = loop

simpleCallback :: JackProcessCallbackFunction
simpleCallback nframes _ =
   do putStrLn ("callback: " ++ show nframes)
      return 0

}}}

Here is the sample output of a session -- note that things work ok if
the main program is blocking on getLine, but once it goes into the
loop, it fails immediately. If I expand the loop to do more stuff --
it seems to run longer but still eventually crashes.

{{{
jackClientNew succeeded.
jackActivate succeeded.
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
callback: 1024
<<I pressed enter here>>
simplejack: schedule: re-entered unsafely.
   Perhaps a 'foreign import unsafe' should be 'safe'?
}}}


Note: it crashes even if the callback is just:

simpleCallback nframes _ = return 0

Thanks!
Jeremy Shaw.