Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • rts/CloneStack.c
    ... ... @@ -84,15 +84,31 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) {
    84 84 
       sendMessage(srcCapability, tso->cap, (Message *)msg);
    85 85 
     }
    86 86
    87 
    -void handleCloneStackMessage(MessageCloneStack *msg){
    88 
    -  StgStack* newStackClosure = cloneStack(msg->tso->cap, msg->tso->stackobj);
    87 
    +// The cap argument is the capability which is handling the CloneStack message
    88 
    +void handleCloneStackMessage(Capability *cap, MessageCloneStack *msg){
    89 
    +  // We must check that the current owner of the thread we want to clone the stack for
    90 
    +  // is still this capability.
    91 
    +  Capability *owner = RELAXED_LOAD(&msg->tso->cap);
    92 
    +  if (owner != cap) {
    93 
    +    // The target TSO may have migrated after the message was queued on the old
    94 
    +    // capability. In that case we must forward the request to the current
    95 
    +    // owner; otherwise we would race with another capability mutating the
    96 
    +    // stack while we clone it.
    97 
    +    sendMessage(cap, owner, (Message *)msg);
    98 
    +    return;
    99 
    +  }
    100 
    +
    101 
    +  // At this point the executing capability owns the TSO, so it is the only
    102 
    +  // capability that may safely inspect the live stack and the one whose
    103 
    +  // allocator we must use for the cloned StgStack closure.
    104 
    +  StgStack* newStackClosure = cloneStack(cap, msg->tso->stackobj);
    89 105
    90 106 
       // Lift StackSnapshot# to StackSnapshot by applying it's constructor.
    91 107 
       // This is necessary because performTryPutMVar() puts the closure onto the
    92 108 
       // stack for evaluation and stacks can not be evaluated (entered).
    93 
    -  HaskellObj result = rts_apply(msg->tso->cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure);
    109 
    +  HaskellObj result = rts_apply(cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure);
    94 110
    95 
    -  bool putMVarWasSuccessful = performTryPutMVar(msg->tso->cap, msg->result, result);
    111 
    +  bool putMVarWasSuccessful = performTryPutMVar(cap, msg->result, result);
    96 112
    97 113 
       if(!putMVarWasSuccessful) {
    98 114 
         barf("Can't put stack cloning result into MVar.");

  • rts/CloneStack.h
    ... ... @@ -17,7 +17,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar);
    17 17 
     #include "BeginPrivate.h"
    18 18
    19 19 
     #if defined(THREADED_RTS)
    20 
    -void handleCloneStackMessage(MessageCloneStack *msg);
    20 
    +void handleCloneStackMessage(Capability *cap, MessageCloneStack *msg);
    21 21 
     #endif
    22 22
    23 23 
     #include "EndPrivate.h"

  • rts/Messages.c
    ... ... @@ -135,7 +135,7 @@ loop:
    135 135 
         }
    136 136 
         else if(i == &stg_MSG_CLONE_STACK_info){
    137 137 
             MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m;
    138 
    -        handleCloneStackMessage(cloneStackMessage);
    138 
    +        handleCloneStackMessage(cap, cloneStackMessage);
    139 139 
         }
    140 140 
         else
    141 141 
         {

  • testsuite/tests/rts/all.T
    ... ... @@ -587,6 +587,15 @@ test('cloneMyStack_retBigStackFrame', [req_c, extra_files(['cloneStackLib.c']),
    587 587
    588 588 
     test('cloneThreadStack', [req_c, only_ways(['threaded1']), extra_ways(['threaded1']), extra_files(['cloneStackLib.c']), req_ghc_with_threaded_rts], compile_and_run, ['cloneStackLib.c -threaded'])
    589 589
    590 
    +test('cloneThreadStackMigrating',
    591 
    +  [ ignore_stdout
    592 
    +  , only_ways(['threaded1'])
    593 
    +  , extra_ways(['threaded1'])
    594 
    +  , extra_run_opts('+RTS -N -DS -RTS')
    595 
    +  , req_ghc_with_threaded_rts
    596 
    +  , req_target_smp
    597 
    +  ], compile_and_run, ['-threaded -debug -rtsopts'])
    598 
    +
    590 599 
     test('decodeMyStack',
    591 600 
       [ omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented
    592 601 
       , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack output.

  • testsuite/tests/rts/cloneThreadStackMigrating.hs
    1 
    +module Main where
    2 
    +
    3 
    +import Control.Concurrent
    4 
    +import Control.Monad
    5 
    +import GHC.Exts.Stack
    6 
    +import GHC.Stack.CloneStack
    7 
    +
    8 
    +numWorkers :: Int
    9 
    +numWorkers = 100
    10 
    +
    11 
    +startN :: Int
    12 
    +startN = 10
    13 
    +
    14 
    +runForMicros :: Int
    15 
    +runForMicros = 1000000
    16 
    +
    17 
    +fib :: Int -> Int
    18 
    +fib 0 = 1
    19 
    +fib 1 = 1
    20 
    +fib n = fib (n - 1) + fib (n - 2)
    21 
    +
    22 
    +workerThread :: Int -> IO ()
    23 
    +workerThread n = do
    24 
    +  fib n `seq` pure ()
    25 
    +  workerThread (n + 1)
    26 
    +
    27 
    +cloneThread :: ThreadId -> IO ()
    28 
    +cloneThread tid = forever $ do
    29 
    +  snapshot <- cloneThreadStack tid
    30 
    +  stack <- decodeStack snapshot
    31 
    +  stack `seq` pure ()
    32 
    +
    33 
    +main :: IO ()
    34 
    +main = do
    35 
    +  tids <- replicateM numWorkers (forkIO $ workerThread startN)
    36 
    +  mapM_ (forkIO . cloneThread) tids
    37 
    +  threadDelay runForMicros

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help