Rodrigo Mesquita pushed to branch wip/romes/per-thread-step-in at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
    ... ... @@ -624,6 +624,7 @@ data TsoFlags
    624 624 
       | TsoMarked
    625 625 
       | TsoSqueezed
    626 626 
       | TsoAllocLimit
    627 
    +  | TsoStopNextBreakpoint
    627 628 
       | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug
    628 629 
       deriving (Eq, Show, Generic, Ord)
    629 630

  • libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
    ... ... @@ -87,6 +87,7 @@ parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset
    87 87 
                     | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)
    88 88 
                     | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)
    89 89 
                     | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)
    90 
    +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
    90 91 
     parseTsoFlags 0 = []
    91 92 
     parseTsoFlags w = [TsoFlagsUnknownValue w]
    92 93

  • libraries/ghci/GHCi/Run.hs
    1 1 
     {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
    2 
    -    UnboxedTuples, LambdaCase #-}
    2 
    +    UnboxedTuples, LambdaCase, UnliftedFFITypes #-}
    3 3 
     {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    4 4
    5 5 
     -- |
    ... ... @@ -396,13 +396,21 @@ abandonStmt hvref = do
    396 396 
       _ <- takeMVar resumeStatusMVar
    397 397 
       return ()
    398 398
    399 
    -foreign import ccall "&rts_stop_next_breakpoint" stepFlag      :: Ptr CInt
    399 
    +foreign import ccall unsafe "rts_enableStopNextBreakpointAll"
    400 
    +  rts_enableStopNextBreakpointAll :: IO ()
    401 
    +
    402 
    +foreign import ccall unsafe "rts_disableStopNextBreakpointAll"
    403 
    +  rts_disableStopNextBreakpointAll :: IO ()
    404 
    +
    400 405 
     foreign import ccall "&rts_stop_on_exception"    exceptionFlag :: Ptr CInt
    401 406
    407 
    +-- | Enables the single step mode for all threads, thus stopping at any
    408 
    +-- existing breakpoint.
    402 409 
     setStepFlag :: IO ()
    403 
    -setStepFlag = poke stepFlag 1
    410 
    +setStepFlag = rts_enableStopNextBreakpointAll
    411 
    +
    404 412 
     resetStepFlag :: IO ()
    405 
    -resetStepFlag = poke stepFlag 0
    413 
    +resetStepFlag = rts_disableStopNextBreakpointAll
    406 414
    407 415 
     type BreakpointCallback
    408 416 
          = Addr#   -- pointer to the breakpoint tick module name

  • rts/Interpreter.c
    ... ... @@ -243,7 +243,24 @@ allocate_NONUPD (Capability *cap, int n_words)
    243 243 
         return allocate(cap, stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
    244 244 
     }
    245 245
    246 
    -int rts_stop_next_breakpoint = 0;
    246 
    +// Enable "TSO_STOP_NEXT_BREAKPOINT" on all TSOs
    247 
    +void rts_enableStopNextBreakpointAll()
    248 
    +{
    249 
    +  for (unsigned int j = 0; j < getNumCapabilities(); ++j) {
    250 
    +    Capability *cap = getCapability(j);
    251 
    +    cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT;
    252 
    +  }
    253 
    +}
    254 
    +
    255 
    +// Disable "TSO_STOP_NEXT_BREAKPOINT" on all TSOs
    256 
    +void rts_disableStopNextBreakpointAll()
    257 
    +{
    258 
    +  for (unsigned int j = 0; j < getNumCapabilities(); ++j) {
    259 
    +    Capability *cap = getCapability(j);
    260 
    +    cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT;
    261 
    +  }
    262 
    +}
    263 
    +
    247 264 
     int rts_stop_on_exception = 0;
    248 265
    249 266 
     #if defined(INTERP_STATS)
    ... ... @@ -1250,7 +1267,7 @@ run_BCO:
    1250 1267 
                 int arg8_cc;
    1251 1268 
     #endif
    1252 1269 
                 StgArrBytes *breakPoints;
    1253 
    -            int returning_from_break;
    1270 
    +            int returning_from_break, stop_next_breakpoint;
    1254 1271
    1255 1272 
                 // the io action to run at a breakpoint
    1256 1273 
                 StgClosure *ioAction;
    ... ... @@ -1280,6 +1297,11 @@ run_BCO:
    1280 1297 
                 returning_from_break =
    1281 1298 
                     cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
    1282 1299
    1300 
    +            // check whether this thread is set to stop at the immediate next
    1301 
    +            // breakpoint
    1302 
    +            stop_next_breakpoint =
    1303 
    +                cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
    1304 
    +
    1283 1305 
     #if defined(PROFILING)
    1284 1306 
                 cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
    1285 1307 
                                               (CostCentre*)BCO_LIT(arg8_cc));
    ... ... @@ -1290,21 +1312,22 @@ run_BCO:
    1290 1312 
                 if (!returning_from_break)
    1291 1313 
                 {
    1292 1314 
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    1315 
    +
    1293 1316
    1294 1317 
                    // stop the current thread if either the
    1295 
    -               // "rts_stop_next_breakpoint" flag is true OR if the
    1318 
    +               // "TSO_STOP_NEXT_BREAKPOINT" flag is true OR if the
    1296 1319 
                    // ignore count for this particular breakpoint is zero
    1297 1320 
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
    1298 
    -               if (rts_stop_next_breakpoint == false && ignore_count > 0)
    1321 
    +               if (stop_next_breakpoint == false && ignore_count > 0)
    1299 1322 
                    {
    1300 1323 
                       // decrement and write back ignore count
    1301 1324 
                       ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
    1302 1325 
                    }
    1303 
    -               else if (rts_stop_next_breakpoint == true || ignore_count == 0)
    1326 
    +               else if (stop_next_breakpoint == true || ignore_count == 0)
    1304 1327 
                    {
    1305 1328 
                       // make sure we don't automatically stop at the
    1306 1329 
                       // next breakpoint
    1307 
    -                  rts_stop_next_breakpoint = false;
    1330 
    +                  cap->r.rCurrentTSO->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
    1308 1331
    1309 1332 
                       // allocate memory for a new AP_STACK, enough to
    1310 1333 
                       // store the top stack frame plus an

  • rts/RtsSymbols.c
    ... ... @@ -906,7 +906,8 @@ extern char **environ;
    906 906 
           SymI_HasProto(revertCAFs)                                         \
    907 907 
           SymI_HasProto(RtsFlags)                                           \
    908 908 
           SymI_NeedsDataProto(rts_breakpoint_io_action)                     \
    909 
    -      SymI_NeedsDataProto(rts_stop_next_breakpoint)                     \
    909 
    +      SymI_NeedsDataProto(rts_enableStopNextBreakpoint)                 \
    910 
    +      SymI_NeedsDataProto(rts_disableStopNextBreakpoint)                \
    910 911 
           SymI_NeedsDataProto(rts_stop_on_exception)                        \
    911 912 
           SymI_HasProto(stopTimer)                                          \
    912 913 
           SymI_HasProto(n_capabilities)                                     \

  • rts/include/rts/Constants.h
    ... ... @@ -328,6 +328,12 @@
    328 328 
      */
    329 329 
     #define TSO_ALLOC_LIMIT 256
    330 330
    331 
    +/*
    332 
    + * Enables step-in mode for this thread -- it will stop at the immediate next
    333 
    + * breakpoint found.
    334 
    + */
    335 
    +#define TSO_STOP_NEXT_BREAKPOINT 512
    336 
    +
    331 337 
     /*
    332 338 
      * The number of times we spin in a spin lock before yielding (see
    333 339 
      * #3758).  To tune this value, use the benchmark in #3758: run the

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