HGL indefinite pause with "thread blocked indefinitely" message

As discussed on haskell-cafe <http://article.gmane.org/gmane.comp.lang.haskell.cafe/18064>, the program below sometimes pauses indefinitely when run, and seems to be a result of some kind of deadlock issue.

Behavior has been observed on the following platforms/versions:

1. GNU/Linux (2.6.18 kernel, gcc-4.1.1), ghc-6.6, hgl-3.1, xorg-x11-7.1 (on both single core and multi-core x32).

2. Mac OS X, ghc-6.4.2, x11-1.1 and hgl-3.1.

module Main where

import Graphics.SOE

main = 
  runGraphics (
  do w <- openWindow "Snowflake Fractal" (600, 600)
     fillStar w 300 125 256 (cycle $ enumFrom Blue)
     spaceClose w
  )

spaceClose w =
  do k <- getKey w
     if k == ' ' 
        then closeWindow w
        else spaceClose w


minSize = 2 :: Int

fillStar :: Window -> Int -> Int -> Int -> [Color] -> IO ()
fillStar w x y h clrs | h <= minSize 
  = return ()
fillStar w x y h clrs 
 = do drawInWindow w 
                  (withColor (head clrs) 
                             (polygon [t1p1,t1p2,t1p3,t1p1]))
      drawInWindow w 
                  (withColor (head clrs) 
                             (polygon [t2p1,t2p2,t2p3,t2p1]))
      sequence_ $ map recur [t1p1,t1p2,t1p3,t2p1,t2p2,t2p3]                  
   where tanPiOverSix = tan(pi/6) :: Float
         halfSide = truncate $ tanPiOverSix * fromIntegral h
         hFrag = truncate $ tanPiOverSix * tanPiOverSix * fromIntegral h
         (t1p1,t1p2,t1p3) = 
           ((x, y), (x-halfSide, y+h),(x+halfSide, y+h))
         (t2p1,t2p2,t2p3) = 
           ((x-halfSide, y+hFrag),(x, y+h+hFrag),(x+halfSide, y+hFrag))
         reVert y = y - ((h - hFrag) `div` 3)
         recur pnt = 
           fillStar w (fst pnt) (reVert (snd pnt)) (h`div`3) (tail clrs)

The problematic behavior, observed with ghci and also a ghc-compiled binary -- but not with Hugs (March 2005) -- is that sometimes the rendering pauses at various places and does not continue rendering until some kind of ui event occurs. Moving the mouse or typing any key but space (which exits) causes the rendering to continue.

When the pause occurs, the following message is printed to the console: "thread blocked indefinitely".

Please let me know if you need any further information.

Trac metadata

Trac field	Value
Version	6.6
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system	Multiple
Architecture	Multiple