[Haskell-cafe] FFI woes!
Robert Dockins
robdockins at fastmail.fm
Sat Dec 18 20:24:47 EST 2004
> Well that shouldn't affect the functionality. The weak pointer was
> only a way of attatching a finalizer to the Playback object. It is
> true that I should probably wrap up the the SoundPlaybackRaw inside
> the SoundPlayback as well, to save CPU, but it shouldn't matter for
> the core functionality.
I'm not sure I understand.
> If I were okay with that I'd just spawn a new one for
> each Playback, which would be considerably cleaner I think than having
> a single loop with some sort of master database of playbacks...
I think both of these are cleaner than starting a new thread at finalize
time.
At any rate, here is a quick hack of mine that I think does what you
want, using a master clean up thread that is only awake when songs are
"playing". Feel free to play with/use it at will. Note it doesn't
guarantee that every song is freed.
module Main where
import List
import Monad
import Random
import Foreign
import GHC.ForeignPtr
import System.Mem
import System.Mem.Weak
import Control.Concurrent
import Control.Concurrent.MVar
-- pretend these are foreign imports that really do things...
newSong :: String -> IO (Ptr ())
newSong name = return nullPtr
songDone :: Ptr () -> IO Bool
songDone p = do x <- getStdRandom( randomR (1,100) )
if x >= (85::Int)
then return True
else return False
freeSong :: Ptr () -> IO ()
freeSong p = return ()
--------------------
newtype Song = Song (ForeignPtr ())
data LibState =
LibState
{ listMV :: MVar [Ptr ()]
, waitMV :: MVar Bool
, killMV :: MVar ()
}
songFinalizer :: LibState -> Ptr () -> IO ()
songFinalizer libstate p =
do modifyMVar_ (listMV libstate) (return . (p:))
tryPutMVar (waitMV libstate) False
return ()
mkSong :: LibState -> String -> IO Song
mkSong libstate name =
do p <- newSong name
f <- newConcForeignPtr p (songFinalizer libstate p)
return (Song f)
cleanupThread :: MVar [Ptr ()] -> MVar Bool -> MVar () -> IO ()
cleanupThread listMVar waitMVar killMVar =
let loop l =
do shouldDie <- takeMVar waitMVar
putStrLn "cleanup thread awoken..."
l' <- swapMVar listMVar []
when (null l' && not shouldDie) (threadDelay 1000000)
notdone <- filterM
(\x -> do d <- songDone x
if d
then putStrLn "freeing song..." >>
freeSong x >> return False
else return True
)
(l ++ l')
unless (null notdone) (tryPutMVar waitMVar False >> return ())
if shouldDie
then return notdone
else loop notdone
in do putStrLn "starting cleanup loop"
l <- loop []
putStrLn "done with cleanup loop"
sequence_ (map (\x -> freeSong x >> putStrLn "freeing song late...")
l)
putMVar killMVar ()
initLib :: IO LibState
initLib =
do listMVar <- newMVar []
waitMVar <- newEmptyMVar
killMVar <- newEmptyMVar
putStrLn "starting cleanup thread"
forkIO (cleanupThread listMVar waitMVar killMVar)
let libstate = LibState
{ listMV = listMVar
, waitMV = waitMVar
, killMV = killMVar
}
return libstate
shutdownLib :: LibState -> IO ()
shutdownLib libstate =
do putMVar (waitMV libstate) True
takeMVar (killMV libstate)
main =
do
libstate <- initLib
putStrLn "doing stuff"
s <- mkSong libstate "my crazy song"
let x = last $ takeWhile (< 10000000) $ iterate (+1) 1
putStrLn (show x)
putStrLn "done with stuff"
shutdownLib libstate
putStrLn "bye"
More information about the Haskell-Cafe
mailing list