[commit: ghc] ghc-7.8: Fix scavenge_stack crash (#9045) (ce6ab2d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/ce6ab2ddaec4d0440f9720279eb596f5932d9605/ghc

>---------------------------------------------------------------

commit ce6ab2ddaec4d0440f9720279eb596f5932d9605
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Mon Apr 28 16:36:29 2014 +0100

    Fix scavenge_stack crash (#9045)
    
    The new stg_gc_prim_p_ll stack frame was missing an info table.  This
    is a regression since 7.6, because this stuff was part of a cleanup
    that happened in 7.7.
    
    (cherry picked from commit ab8bb4893be1896303f30d0f1adff8ea9c2470f6)


>---------------------------------------------------------------

ce6ab2ddaec4d0440f9720279eb596f5932d9605
 rts/HeapStackCheck.cmm       |    5 +++--
 testsuite/tests/rts/T9045.hs |   22 ++++++++++++++++++++++
 testsuite/tests/rts/all.T    |    5 +++++
 3 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index d826529..12bcfb2 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -196,7 +196,8 @@ stg_gc_prim_n (W_ arg, W_ fun)
     jump fun(arg);
 }
 
-stg_gc_prim_p_ll_ret
+INFO_TABLE_RET(stg_gc_prim_p_ll, RET_SMALL, W_ info, P_ arg, W_ fun)
+    /* explicit stack */
 {
     W_ fun;
     P_ arg;
@@ -216,7 +217,7 @@ stg_gc_prim_p_ll
     Sp_adj(-3);
     Sp(2) = fun;
     Sp(1) = arg;
-    Sp(0) = stg_gc_prim_p_ll_ret;
+    Sp(0) = stg_gc_prim_p_ll_info;
     jump stg_gc_noregs [];
 }
 
diff --git a/testsuite/tests/rts/T9045.hs b/testsuite/tests/rts/T9045.hs
new file mode 100644
index 0000000..1e581ef
--- /dev/null
+++ b/testsuite/tests/rts/T9045.hs
@@ -0,0 +1,22 @@
+-- This is nofib/smp/threads006.  It fails in GHC 7.8.2 with a GC crash.
+
+{-# OPTIONS_GHC -O2 #-}
+import System.IO
+import System.Environment
+import System.CPUTime
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Exception
+
+main :: IO ()
+main = do
+    hSetBuffering stdout NoBuffering
+    [nthreads] <- fmap (map read) getArgs
+    tids <- replicateM nthreads . mask $ \_ -> forkIO $ return ()
+    m <- newEmptyMVar
+    -- do it in a subthread to avoid bound-thread overhead
+    forkIO $ do mapM_ killThread tids; putMVar m ()
+    takeMVar m
+    return ()
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index f7c4986..102a671 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -207,3 +207,8 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']),
                  # T8124_stub.h before compiling T8124_c.c, which
                  # needs it.
                compile_and_run, ['T8124_c.c -no-hs-main'])
+
+# +RTS -A8k makes it fail faster
+# The ghci way gets confused by the RTS options
+test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, [''])
+