[GHC] #1081: HGL indefinite pause with "thread blocked indefinitely" message

[GHC]

#1081: HGL indefinite pause with "thread blocked indefinitely" message
-------------------------+--------------------------------------------------
    Reporter:  calvins   |       Owner:                     
        Type:  bug       |      Status:  new                
    Priority:  normal    |   Milestone:                     
   Component:  Compiler  |     Version:  6.6                
    Severity:  normal    |    Keywords:  hgl thread deadlock
  Difficulty:  Unknown   |    Testcase:                     
Architecture:  Multiple  |          Os:  Multiple           
-------------------------+--------------------------------------------------
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.

-- 
Ticket URL: <http://cvs.haskell.org/trac/ghc/ticket/1081>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler