debugging memory allocations

[Duncan Coutts]

All,

I'm looking for advice on how to figure out why some piece of code is
allocating memory when I think it ought to be able to work in constant
space.

In these cases we cannot turn on traditional profiling since that would
interfere with the optimisations we are relying on to eliminate most of
the other memory allocations.

Would looking at the core files help? What would I be looking for?

Here's a simple version that I would expect to run in constance space.

pixbufSetGreen :: Pixbuf -> IO ()
pixbufSetGreen pixbuf = do
  ptr <- pixbufGetPixels pixbuf
  sequence_ 
    [ do pokeByteOff ptr (y*384+3*x)   (0  ::Word8)
         pokeByteOff ptr (y*384+3*x+1) (128::Word8)
         pokeByteOff ptr (y*384+3*x+2) (96 ::Word8)
    | y <- [0..127]
    , x <- [0..127] ]

(Don't worry about all those random constants, it's just test code!)

I thought this might be the case since in ghc's Data.Array.Base we have
some similar style code:

{-# INLINE newArray #-}
        -- The INLINE is crucial, because until we know at least which monad
        -- we are in, the code below allocates like crazy.  So inline it,
        -- in the hope that the context will know the monad.
newArray (l,u) init = do
        marr <- newArray_ (l,u)
        sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
        return marr

Note of course that in my example we know exactly which monad we're using.

Here is the real example code I was writing when I found that it was
using lots of cpu cycles and +RTS -B -RTS beeps lots and lots.

Compiled using -O (-O2 is the same) -fglasgow-exts with ghc-6.2.2.

pixbufSetPixelsRGB8 :: Pixbuf -> (Int -> Int -> (# Word8, Word8, Word8 #)) -> IO ()
pixbufSetPixelsRGB8 pixbuf setPixel = do
  -- TODO assert that the format is RGB8
  rowStride <- pixbufGetRowstride pixbuf
  width <- pixbufGetWidth pixbuf
  height <- pixbufGetHeight pixbuf
  let loop ptr y | y == height = return ()
                 | otherwise = do
        let rowLoop ptr x | x == width = return ()
                          | otherwise =
              case setPixel x y of
                (# red, green, blue #) -> do
                  pokeByteOff ptr 0 red
                  pokeByteOff ptr 1 green
                  pokeByteOff ptr 2 blue
                  rowLoop (ptr `plusPtr` 3) (x+1)
        rowLoop ptr 0
        loop (ptr `plusPtr` rowStride) (y+1)

  pixelsPtr <- pixbufGetPixels pixbuf
  loop pixelsPtr 0

It was being called like so:

setWierdColour :: Int -> Pixbuf -> IO ()
setWierdColour counter pixbuf =
  let val = fromIntegral counter in
  pixbufSetPixelsRGB8 pixbuf (\x y -> (# fromIntegral x + val
                                       , fromIntegral y + val
                                       , fromIntegral x + fromIntegral y + val #))

Duncan