
Hi all, me again :) I keep trying to get my program to run through with all my data, but once it hits around 2 or 2 1/2 gb of memory allocated (according to top), it seg faults and emits a rather sizeable (2.5 gb) core dump. Rather than sending around my 5k line program, here's a simple one which exhibits the same problem: -- UseMemory.hs module Main where import Control.Monad import Control.Monad.ST import Data.Array.ST import System mkArrays :: Int -> Int -> ST s (STArray s Int (STArray s Int Int)) mkArrays src dst = newArray_ (0,src) >>= \arr -> mapM_ (\i -> newArray (0,dst) i >>= writeArray arr i) [0..src] >> return arr sumArrays :: STArray s Int (STArray s Int Int) -> ST s Int sumArrays arr = foldM (\s i -> readArray arr i >>= \arr' -> foldM (\s j -> readArray arr' j >>= return . (s+)) s [0..snd (bounds arr')]) 0 [0..snd (bounds arr)] main = do [ssize,dsize] <- getArgs print $ runST (mkArrays (read ssize) (read dsize) >>= sumArrays) I compile with -O2 -fvia-c, and then run: 9:52am enescu:TryMPI/ ./UseMemory 1 20000 +RTS -K128m 20001 9:53am enescu:TryMPI/ ./UseMemory 1 2000000 +RTS -K128m -A64m 2000001 9:54am enescu:TryMPI/ ./UseMemory 100 2000000 +RTS -K128m -A64m Segmentation fault 1858.28u 51.66s 35:26.02 89.8% (The -A is because if you don't increase the GC size, the program executes ridiculously slowly.) Unfortunately, this behavior is entirely predictable; no matter what arguments you use, once it gets to about 2.2 gb of memory usage it dies. (This is running on a solaris 2.8 machine with 8gb main memory, about 5 or 6gb free.) Could someone explain to me what's going on here? - Hal -- Hal Daume III "Computer science is no more about computers | hdaume@isi.edu than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume
participants (1)
-
Hal Daume III