blob: 136508ff6d8c537b658d6fa160d60cfccdab1928 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
-- A reduced version of the original test case
{-# LANGUAGE ForeignFunctionInterface #-}
import Control.Concurrent
import Control.Monad
import Foreign.C.Types
import Foreign.Ptr
main :: IO ()
main = do
mv <- newEmptyMVar
-- Fork a thread to continually dereference a stable pointer...
void $ forkIO $ f 1 1000000 >> putMVar mv ()
-- ...while we keep enlarging the stable pointer table
f 65536 1
void $ takeMVar mv
where
f nWraps nApplies = replicateM_ nWraps $ do
-- Each call to wrap creates a stable pointer
wrappedPlus <- wrap (+)
c_applyFun nApplies wrappedPlus 1 2
type CIntFun = CInt -> CInt -> CInt
foreign import ccall "wrapper"
wrap :: CIntFun -> IO (FunPtr CIntFun)
foreign import ccall "apply_fun"
c_applyFun :: CInt -> FunPtr CIntFun -> CInt -> CInt -> IO CInt
|
