2

I wrote a set of utility functions around the bindings-fluidsynth library:

module FSUtilities where

import Control.Monad
import System.Directory
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Bindings.FluidSynth

newtype Settings = Settings (ForeignPtr C'fluid_settings_t)

newtype Synth = Synth (ForeignPtr C'fluid_synth_t)

type Channel = Int
type Key = Int
type Velocity = Int

initSynth :: IO Synth
initSynth = createSettings >>=
            changeSettingStr "audio.driver" "alsa" >>=
            changeSettingInt "synth.polyphony" 64 >>=
            (\s -> createSynth s >>= createDriver s) >>=
            loadSF "GS.sf2"

createSettings :: IO Settings
createSettings =
    c'new_fluid_settings >>=
    newForeignPtr p'delete_fluid_settings >>= (pure $!) . Settings

changeSettingStr :: String -> String -> Settings -> IO Settings
changeSettingStr k v (Settings s) =
    withForeignPtr s $ \ptr ->
          withCAString k $ \cstr ->
              withCAString v $ \cstr' ->
                  c'fluid_settings_setstr ptr cstr cstr' >>
    (pure $! Settings s)

changeSettingInt :: String -> Int -> Settings -> IO Settings
changeSettingInt k v (Settings s) =
    withForeignPtr s $ \ptr ->
          withCAString k $ \cstr ->
              c'fluid_settings_setint ptr cstr (fromIntegral v) >>
    (pure $! Settings s)

createSynth :: Settings -> IO Synth
createSynth (Settings s) =
    withForeignPtr s c'new_fluid_synth >>=
    newForeignPtr p'delete_fluid_synth >>= (pure $!) . Synth

createDriver :: Settings -> Synth -> IO Synth
createDriver (Settings set) (Synth syn) =
    withForeignPtr set $ \ptr ->
        withForeignPtr syn $ \ptr' ->
            c'new_fluid_audio_driver ptr ptr' >>=
    newForeignPtr p'delete_fluid_audio_driver >>
    (pure $! Synth syn)

loadSF :: String -> Synth -> IO Synth
loadSF path (Synth syn) =
    withForeignPtr syn $ \s ->
      makeAbsolute path >>= \p ->
        withCAString p $ \p' ->
          c'fluid_synth_sfload s p' 1 >>=
    \c -> if c == (-1) then error    "loadSF: Could not load SoundFont"
                       else putStrLn "loadSF: SoundFont loaded" >>
                            (pure $! Synth syn)

noteOn :: Channel -> Key -> Velocity -> Synth -> IO ()
noteOn c k v (Synth ptr) =
    withForeignPtr ptr $ \syn ->
        c'fluid_synth_noteon syn c' k' v' >> pure ()
            where c' = fromIntegral c
                  k' = fromIntegral k
                  v' = fromIntegral v

justPlay :: Channel -> Key -> IO ()
justPlay c k = initSynth >>= noteOn c k 127

justPlay' :: Channel -> Key -> IO Synth
justPlay' c k = initSynth >>= \s -> noteOn c k 127 s >> pure s

The justPlay and justPlay' functions serve to illustrate the issue. When I call justPlay from ghci, I get random segfaults (not consistently, around 30% of the time), while justPlay' never does that (but swiftly fills up my system's memory after a bunch of calls, due to dangling Synths. I think this is because I'm not cleaning up after myself when the Synth is no longer referenced, but I thought the call to newForeignPtr with a finalizer function at the creation of Synth was supposed to take care of that automatically.

I'm new to Haskell and I don't know C, so I'm trying to feel my way through this. What's the proper way to handle such a situation?

leftaroundabout
  • 117,950
  • 5
  • 174
  • 319
aplainzetakind
  • 490
  • 2
  • 8
  • 3
    Frankly, if you're new to Haskell _and_ don't know C, then it doesn't seem very prudent to start right with a nontrivial FFI binding, which combines the pitfalls of both languages. – leftaroundabout Nov 29 '17 at 00:09
  • This example is far from minimal, so it's hard to see what the problem is (esp. since each of these C functions will have their own requirements for what the lifetime of their pointer arguments may be). But one very obvious thing which stands out is `c'new_fluid_audio_driver ptr ptr' >>= newForeignPtr p'delete_fluid_audio_driver >> ...` - here you create a pointer with the foreign call and immediately discard it! – user2407038 Nov 29 '17 at 00:54
  • @user2407038 Sorry I can't isolate the issue further because all of these calls are necessary to initialize fluidsynth and even attempt to get sound. I discarded the `newForeignPtr` line you mentioned, because I really don't use its output, but that didn't change anything. I'm pretty sure it's about the `Synth` pointers not being freed properly. When a function that plays a sound passes on the `Synth` it used, I get no segfaults, but if I `return ()` at the end of the playing function, things break. Note the type signatures of `justPlay` and `justPlay'`. – aplainzetakind Nov 29 '17 at 03:07

1 Answers1

2

It is hard to say what exactly couses the crash, but there is at least one obviuosly wrong thing. Occurding to the documentation:

Other users of a synthesizer instance, such as audio and MIDI drivers, should be deleted prior to freeing the FluidSynth instance.

In your case the order of finalizers is not defined, so synthesizer could be deleted before driver. Probably other objects also has restrictions on their life circle.

To explicitly finalize foreign pointer use finalizeForeignPtr.

Yuras
  • 13,856
  • 1
  • 45
  • 58