Lightweight Concurrency in GHC KC Sivaramakrishnan Tim Harris Simon Marlow Simon Peyton Jones 1
GHC: Concurrency and Parallelism MVars Safe foreign forkIO calls Bound threads Asynchronous Par Monad exceptions STM 2
Concurrency landscape in GHC Haskell Code RTS (C Code) preemptive, STM MVar round-robin scheduler + LWT Safe Black work-sharing Scheduler FFI Holes a nd more… OS Thread pool Capability N Capability 0
Idea Haskell Code Haskell Code LWT STM+ MVar+ Scheduler+ RTS (C Code) Concurrency Substrate STM MVar LWT Safe Black Scheduler FFI Holes RTS (C Safe Black a nd more… Code) FFI Holes OS Thread pool OS Thread pool Capability N Capability 0 Capability 0 Capability N 4
Where do these What should live in the new Contributions this be? design? Haskell Code Haskell Code LWT STM+ MVar+ Scheduler+ RTS (C Code) Concurrency Substrate STM MVar LWT Safe Black Scheduler FFI Holes RTS (C Safe Black a nd more… Code) FFI Holes OS Thread pool OS Thread pool How to unify these? Capability N Capability 0 Capability 0 Capability N 5
Concurrency Substrate • One-shot continuations ---------------- PTM ---------------- (SCont) and primitive data PTM a transactional memory data PVar a instance Monad PTM (PTM) atomically :: PTM a -> IO a • PTM is a bare-bones TM newPVar :: a -> PTM (PVar a) readPVar :: PVar a -> PTM a – Better composability than writePVar :: PVar a -> a -> PTM () CAS ---------------- SCont -------------- data SCont -- Stack Continuations newSCont :: IO () -> IO SCont switch :: (SCont -> PTM SCont) -> IO () getCurrentSCont :: PTM SCont switchTo :: SCont -> PTM () 6
Switch PTM! Current SCont switch :: (SCont -> PTM SCont) -> IO () SCont to switch to 7
Abstract Scheduler Interface Haskell Code LWT MVar+ STM+ Scheduler+ How to unify these? Concurrency Substrate Safe Black FFI Holes • Primitive scheduler actions – SCont { scheduleSContAction :: SCont -> PTM (), yieldControlAction :: PTM ()} – Expected from every user-level thread 8
Primitive Scheduler Actions (1) scheduleSContAction :: SCont -> PTM () yieldControlAction :: PTM () scheduleSContAction sc = do yieldControlAction = do sched :: PVar [SCont] <- -- get sched sched :: PVar [SCont] <- -- get sched contents :: [SCont] <- readPVar sched contents :: [SCont] <- readPVar sched writePVar $ contents ++ [sc] case contents of x:tail -> do { writePVar $ contents tail; switchTo x -- DOES NOT RETURN } otherwise - > … 9
Primitive Scheduler Actions (2) scheduleSContAction :: SCont -> PTM () yieldControlAction :: PTM () scheduleSContAction sc = do yieldControlAction = do sched :: PVar [SCont] <- -- get sched sched :: PVar [SCont] <- -- get sched contents :: [SCont] <- readPVar sched contents :: [SCont] <- readPVar sched writePVar $ contents ++ [sc] case contents of x:tail -> do { writePVar $ contents tail; switchTo x -- DOES NOT RETURN Substrate } otherwise - > … Primitives getScheduleSContAction getYieldControlAction :: SCont -> PTM (SCont -> PTM()) :: SCont -> PTM (PTM ()) setScheduleSContAction setScheduleSContAction :: SCont -> (SCont -> PTM()) -> PTM() :: SCont -> PTM () -> PTM () 10
Primitive Scheduler Actions (3) scheduleSContAction :: SCont -> PTM () yieldControlAction :: PTM () scheduleSContAction sc = do yieldControlAction = do sched :: PVar [SCont] <- -- get sched sched :: PVar [SCont] <- -- get sched contents :: [SCont] <- readPVar sched contents :: [SCont] <- readPVar sched writePVar $ contents ++ [sc] case contents of x:tail -> do { writePVar $ contents tail; switchTo x -- DOES NOT RETURN Substrate } otherwise - > … Primitives getScheduleSContAction getYieldControlAction :: SCont -> PTM (SCont -> PTM()) :: SCont -> PTM (PTM ()) setScheduleSContAction setScheduleSContAction :: SCont -> (SCont -> PTM()) -> PTM() :: SCont -> PTM () -> PTM () getSSA = getScheduleSContAction getYCA = getYieldControlAction setSSA = setScheduleScontAction setYCA = setYieldControlAction Helper functions 11
Building Concurrency Primitives (1) yield :: IO () yield = atomically $ do s :: SCont <- getCurrentSCont -- Add current SCont to scheduler ssa :: (SCont -> PTM ()) <- getSSA s enque :: PTM () <- ssa s enque -- Switch to next scont from scheduler switchToNext :: PTM () <- getYCA s switchToNext 12
Building Concurrency Primitives (2) forkIO :: IO () -> IO SCont forkIO f = do ns <- newSCont f atomically $ do { s :: SCont <- getCurrentSCont; -- Initialize new sconts scheduler actions ssa :: (SCont -> PTM ()) <- getSSA s; setSSA ns ssa; yca :: PTM () <- getYCA s; setYCA ns yca; -- Add to new scont current scheduler enqueAct :: PTM () <- ssa ns; enqueAct } return ns 13
Building MVars newtype MVar a = MVar (PVar (ST a)) An MVar is either empty or data ST a = Full a [(a, PTM())] full and has a single hole | Empty [(PVar a, PTM())] takeMVar :: MVar a -> IO a takeMVar (MVar ref) = do hole <- atomically $ newPVar undefined atomically $ do st <- readPVar ref case st of Empty ts -> do s <- getCurrentSCont ssa :: (SCont -> PTM ()) <- getSSA s wakeup :: PTM () <- ssa s writePVar ref $ v where v = Empty $ ts++[(hole, wakeup)] switchToNext <- getYCA s switchToNext Full x ((x', wakeup :: PTM ()):ts) -> do writePVar hole x writePVar ref $ Full x' ts wakeup otherwise - > … atomically $ readPVar hole 14
Building MVars newtype MVar a = MVar (PVar (ST a)) An MVar is either empty or data ST a = Full a [(a, PTM())] full and has a single hole | Empty [(PVar a, PTM())] takeMVar :: MVar a -> IO a takeMVar (MVar ref) = do Result will be here hole <- atomically $ newPVar undefined atomically $ do st <- readPVar ref case st of Empty ts -> do s <- getCurrentSCont ssa :: (SCont -> PTM ()) <- getSSA s wakeup :: PTM () <- ssa s writePVar ref $ v where v = Empty $ ts++[(hole, wakeup)] switchToNext <- getYCA s switchToNext Full x ((x', wakeup :: PTM ()):ts) -> do writePVar hole x writePVar ref $ Full x' ts wakeup otherwise - > … atomically $ readPVar hole 15
Building MVars newtype MVar a = MVar (PVar (ST a)) An MVar is either empty or data ST a = Full a [(a, PTM())] full and has a single hole | Empty [(PVar a, PTM())] takeMVar :: MVar a -> IO a takeMVar (MVar ref) = do Result will be here hole <- atomically $ newPVar undefined atomically $ do st <- readPVar ref case st of If the mvar is empty Empty ts -> do (1) Append hole & wakeup s <- getCurrentSCont ssa :: (SCont -> PTM ()) <- getSSA s info to mvar list ( getSSA! ) wakeup :: PTM () <- ssa s (2) Yield control to scheduler writePVar ref $ v ( getYCA! ) where v = Empty $ ts++[(hole, wakeup)] switchToNext <- getYCA s switchToNext Full x ((x', wakeup :: PTM ()):ts) -> do writePVar hole x writePVar ref $ Full x' ts wakeup otherwise - > … atomically $ readPVar hole 16
Building MVars newtype MVar a = MVar (PVar (ST a)) An MVar is either empty or data ST a = Full a [(a, PTM())] full and has a single hole | Empty [(PVar a, PTM())] takeMVar :: MVar a -> IO a takeMVar (MVar ref) = do Result will be here hole <- atomically $ newPVar undefined atomically $ do st <- readPVar ref case st of If the mvar is empty Empty ts -> do (1) Append hole & wakeup s <- getCurrentSCont ssa :: (SCont -> PTM ()) <- getSSA s info to mvar list ( getSSA! ) wakeup :: PTM () <- ssa s (2) Yield control to scheduler writePVar ref $ v ( getYCA! ) where v = Empty $ ts++[(hole, wakeup)] switchToNext <- getYCA s switchToNext Wake up a pending writer, if Full x ((x', wakeup :: PTM ()):ts) -> do writePVar hole x any. wakeup is a PTM ()! writePVar ref $ Full x' ts wakeup otherwise - > … MVar is scheduler agnostic! atomically $ readPVar hole 17
Interaction of C RTS and User-level scheduler • Many “Events” that necessitate actions on the scheduler become apparent only in the C part of the RTS Haskell Code LWT STM+ MVar+ Scheduler+ Concurrency Substrate Safe Black Asynchronous Finalizers FFI Hole exceptions 18
Interaction of C RTS and User-level scheduler • Many “Events” that necessitate actions on the scheduler become apparent only in the C part of the RTS Haskell Code LWT STM+ MVar+ Scheduler+ Concurrency Substrate Re-use primitive scheduler actions! Safe Black Asynchronous Finalizers FFI Hole exceptions Pending upcall Capability X Upcall Thread queue :: [PTM ()] UT 19
Blackholes Capability 0 Capability 1 T1 T2 T3 evaluating.. Thunk Running T Suspended T T Blocked 20
Blackholes Capability 0 Capability 1 T1 T2 T3 thunk “ blackholed ” BH Running T Suspended T T Blocked 21
Blackholes Capability 0 Capability 1 T1 T2 T3 enters blackhole BH Running T Suspended T T Blocked 22
Blackholes Capability 0 Capability 1 T1 T2 T3 BH Running T Suspended T T Blocked 23
Blackholes Capability 0 Capability 1 T1 T2 T3 Yield control BH action Running T Suspended T T Blocked 24
Recommend
More recommend
