Trying to figure out a segfault caused by haskeline.

From what I understand this is happening in the Foreign.C.String module but
Hey everyone, I'm looking for help with a seg fault that takes out both my ghci and darcs as well as anything that uses haskeline. A bug on the haskeline trac hasn't gotten any response so I figured I might as well figure this out myself and get ghci up and running again. Using the test program below I get the same segmentation fault, so I run it using gdb and get the following, Program received signal SIGSEGV, Segmentation fault. 0x000000000053fdce in base_ForeignziCziString_zdwa_info () My knowledge of this is very limited from here on out so here is what I was able to get together. On the 20th call of base_ForeignziCziString_zdwa_info r14 is 0 so 0x000000000053fdce <+22>: movsbq (%r14),%rax produces the segfault. thats as much as I know. Anyone have advice on where to go next? System info: Distribution: gentoo amd64 Ghc version: currently 6.12.1 (though the segfault happends on any of the ones with haskeline) Haskeline version: 0.6.2.2 Here is the test program ---------------------------------------------------------------------------------------------------- module Main where import System.Console.Haskeline import System.Environment {-- Testing the line-input functions and their interaction with ctrl-c signals. Usage: ./Test (line input) ./Test chars (character input) --} mySettings :: Settings IO mySettings = defaultSettings {historyFile = Just "myhist"} main :: IO () main = do args <- getArgs let inputFunc = case args of ["chars"] -> fmap (fmap (\c -> [c])) . getInputChar _ -> getInputLine runInputT mySettings $ withInterrupt $ loop inputFunc 0 where loop inputFunc n = do minput <- handleInterrupt (return (Just "Caught interrupted")) $ inputFunc (show n ++ ":") case minput of Nothing -> return () Just "quit" -> return () Just "q" -> return () Just s -> do outputStrLn ("line " ++ show n ++ ":" ++ s) loop inputFunc (n+1) ------------------------------------------------------------------------------------------------------------------------ Syfran

On Mon, Mar 29, 2010 at 7:37 PM, ryan winkelmaier
Hey everyone,
I'm looking for help with a seg fault that takes out both my ghci and darcs as well as anything that uses haskeline. A bug on the haskeline trac hasn't gotten any response so I figured I might as well figure this out myself and get ghci up and running again.
Using the test program below I get the same segmentation fault, so I run it using gdb and get the following,
Program received signal SIGSEGV, Segmentation fault. 0x000000000053fdce in base_ForeignziCziString_zdwa_info ()
My knowledge of this is very limited from here on out so here is what I was able to get together.
On the 20th call of base_ForeignziCziString_zdwa_info r14 is 0 so
0x000000000053fdce <+22>: movsbq (%r14),%rax
produces the segfault.
From what I understand this is happening in the Foreign.C.String module but thats as much as I know. Anyone have advice on where to go next?
You can use gdb to get a stack trace. It's a stack trace in a mixture of FFI, the GHC RTS, and your compiled haskell but it can still help you figure out where it happened. It's something like: gdb --args testprog <any flags you need>
run # Wait for the segfault where
The 'where' should give you a C stack trace. Once you know the stack trace, you can work backwards from there. You might also try using the ghci debugger to see if you can step through the evaluation and see which line you're on in Haskell land when the segfault is delivered. You could also try strace/dtruss to figure if there are system calls involved. The last time I had a problem like this, a foreign pointer was freeing memory allocated in the Haskell heap while C code was trying to dereference the pointer. It seems that in 6.10.2 there was a positive change that made finalizers run during garbage collection. The library I was using seemed to have issues with that change to the RTS. Fixing the finalizers to run later seemed to fix it. I hope that helps, Jason
participants (2)
-
Jason Dagit
-
ryan winkelmaier