Commit caacd1d6 authored by rwbarton's avatar rwbarton Committed by Ben Gamari
Browse files

Don't eagerly blackhole single-entry thunks (#10414)

In a parallel program they can actually be entered more than once,
leading to deadlock.

Reviewers: austin, simonmar

Subscribers: michaelt, thomie, bgamari

Differential Revision: https://phabricator.haskell.org/D1040

GHC Trac Issues: #10414

Conflicts:
	testsuite/tests/codeGen/should_run/all.T
parent 07a1f32e
......@@ -754,6 +754,16 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
-- was on. But it didn't work, and it wasn't strictly necessary
-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
-- is unconditionally disabled. -- krc 1/2007
--
--
-- A single-entry (non-updatable) thunk can actually be entered
-- more than once in a parallel program, if work is duplicated
-- by two threads both entering the same updatable thunk before
-- the other has blackholed it. So, we must not eagerly
-- blackhole non-updatable thunks, or the second thread to
-- enter one will become blocked indefinitely. (They are not
-- blackholed by lazy blackholing either, since they have no
-- associated update frame.) See Trac #10414.
-- Static closures are never themselves black-holed.
......@@ -766,7 +776,7 @@ blackHoleOnEntry cl_info
= case closureLFInfo cl_info of
LFReEntrant _ _ _ _ -> False
LFLetNoEscape -> False
LFThunk _ _no_fvs _updatable _ _ -> True
LFThunk _ _no_fvs updatable _ _ -> updatable
_other -> panic "blackHoleOnEntry" -- Should never happen
isStaticClosure :: ClosureInfo -> Bool
......
......@@ -165,6 +165,7 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
/tests/codeGen/should_run/SizeOfSmallArray
/tests/codeGen/should_run/StaticArraySize
/tests/codeGen/should_run/StaticByteArraySize
/tests/codeGen/should_run/T10414
/tests/codeGen/should_run/T10521
/tests/codeGen/should_run/T10521b
/tests/codeGen/should_run/T1852
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Exts
newtype Eval a = Eval {runEval :: State# RealWorld -> (# State# RealWorld, a #)}
-- inline sequence :: [Eval a] -> Eval [a]
well_sequenced :: [Eval a] -> Eval [a]
well_sequenced = foldr cons nil where
cons e es = Eval $ \s -> case runEval e s of
(# s', a #) -> case runEval es s' of
(# s'', as #) -> (# s'', a : as #)
nil = Eval $ \s -> (# s, [] #)
-- seemingly demonic use of spark#
ill_sequenced :: [Eval a] -> Eval [a]
ill_sequenced as = Eval $ spark# (case well_sequenced as of
Eval f -> case f realWorld# of (# _, a' #) -> a')
-- 'parallelized' version of (show >=> show >=> show >=> show >=> show)
main :: IO ()
main = putStrLn ((layer . layer . layer . layer . layer) (:[]) 'y')
where
layer :: (Char -> String) -> (Char -> String)
layer f = (\(Eval x) -> case x realWorld# of (# _, as #) -> concat as)
. well_sequenced -- [Eval String] -> Eval [String]
. map ill_sequenced -- [[Eval Char]] -> [Eval String];
-- 'map well_sequenced' is fine
. map (map (\x -> Eval $ \s -> (# s, x #))) -- wrap each Char in Eval
. chunk' -- String -> [String]
. concatMap f
. show -- add single quotes
chunk' :: String -> [String]
chunk' [] = []
chunk' xs = as : chunk' bs where (as,bs) = splitAt 3 xs
-- this doesn't work:
-- chunk (a:b:c:xs) = [a,b,c]:chunk xs
-- chunk xs = [xs]
'\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''y''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\'''\'''\'''\\''\\''\'''\'''\\''\'''\'''\'''\\''\'''\''
......@@ -129,5 +129,7 @@ test('T9013', omit_ways(['ghci']), # ghci doesn't support unboxed tuples
compile_and_run, [''])
test('T9340', normal, compile_and_run, [''])
test('cgrun074', normal, compile_and_run, [''])
test('T10414', [only_ways(['threaded2']), extra_ways(['threaded2'])],
compile_and_run, ['-feager-blackholing'])
test('T10521', normal, compile_and_run, [''])
test('T10521b', normal, compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment