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

Commits:

9 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_ProfilingDisabled.hsc
    ... ... @@ -87,6 +87,9 @@ 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 
    +#if __GLASGOW_HASKELL__ >= 913
    91 
    +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
    92 
    +#endif
    90 93 
     parseTsoFlags 0 = []
    91 94 
     parseTsoFlags w = [TsoFlagsUnknownValue w]
    92 95

  • libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc
    ... ... @@ -87,6 +87,9 @@ 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 
    +#if __GLASGOW_HASKELL__ >= 913
    91 
    +                | isSet (#const TSO_STOP_NEXT_BREAKPOINT) w = TsoStopNextBreakpoint : parseTsoFlags (unset (#const TSO_STOP_NEXT_BREAKPOINT) w)
    92 
    +#endif
    90 93 
     parseTsoFlags 0 = []
    91 94 
     parseTsoFlags w = [TsoFlagsUnknownValue w]
    92 95

  • libraries/ghc-heap/tests/parse_tso_flags.hs
    ... ... @@ -13,5 +13,6 @@ main = do
    13 13 
         assertEqual (parseTsoFlags 64) [TsoMarked]
    14 14 
         assertEqual (parseTsoFlags 128) [TsoSqueezed]
    15 15 
         assertEqual (parseTsoFlags 256) [TsoAllocLimit]
    16 
    +    assertEqual (parseTsoFlags 512) [TsoStopNextBreakpoint]
    16 17
    17 18 
         assertEqual (parseTsoFlags 6) [TsoLocked, TsoBlockx]

  • 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,9 +243,25 @@ 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 
    +// A global toggle for single-step mode.
    247 
    +// Unlike `TSO_STOP_NEXT_BREAKPOINT`, which sets single-step mode per-thread,
    248 
    +// `rts_stop_next_breakpoint` globally enables single-step mode. If enabled, we
    249 
    +// will stop at the immediate next breakpoint regardless of what thread it is in.
    246 250 
     int rts_stop_next_breakpoint = 0;
    247 251 
     int rts_stop_on_exception = 0;
    248 252
    253 
    +// Enable the global single step mode
    254 
    +void rts_enableStopNextBreakpointAll()
    255 
    +{
    256 
    +  rts_stop_next_breakpoint = 1;
    257 
    +}
    258 
    +
    259 
    +// Disable the global single step mode
    260 
    +void rts_disableStopNextBreakpointAll()
    261 
    +{
    262 
    +  rts_stop_next_breakpoint = 0;
    263 
    +}
    264 
    +
    249 265 
     #if defined(INTERP_STATS)
    250 266
    251 267 
     #define N_CODES 128
    ... ... @@ -1250,7 +1266,7 @@ run_BCO:
    1250 1266 
                 int arg8_cc;
    1251 1267 
     #endif
    1252 1268 
                 StgArrBytes *breakPoints;
    1253 
    -            int returning_from_break;
    1269 
    +            int returning_from_break, stop_next_breakpoint;
    1254 1270
    1255 1271 
                 // the io action to run at a breakpoint
    1256 1272 
                 StgClosure *ioAction;
    ... ... @@ -1280,6 +1296,13 @@ run_BCO:
    1280 1296 
                 returning_from_break =
    1281 1297 
                     cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
    1282 1298
    1299 
    +            // check whether this thread is set to stop at the immediate next
    1300 
    +            // breakpoint -- either by the global `rts_stop_next_breakpoint`
    1301 
    +            // flag, or by the local `TSO_STOP_NEXT_BREAKPOINT`
    1302 
    +            stop_next_breakpoint =
    1303 
    +              rts_stop_next_breakpoint ||
    1304 
    +                cap->r.rCurrentTSO->flags & TSO_STOP_NEXT_BREAKPOINT;
    1305 
    +
    1283 1306 
     #if defined(PROFILING)
    1284 1307 
                 cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
    1285 1308 
                                               (CostCentre*)BCO_LIT(arg8_cc));
    ... ... @@ -1291,20 +1314,20 @@ run_BCO:
    1291 1314 
                 {
    1292 1315 
                    breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
    1293 1316
    1294 
    -               // stop the current thread if either the
    1295 
    -               // "rts_stop_next_breakpoint" flag is true OR if the
    1296 
    -               // ignore count for this particular breakpoint is zero
    1317 
    +               // stop the current thread if either `stop_next_breakpoint` is
    1318 
    +               // true OR if the ignore count for this particular breakpoint is zero
    1297 1319 
                    StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
    1298 
    -               if (rts_stop_next_breakpoint == false && ignore_count > 0)
    1320 
    +               if (stop_next_breakpoint == false && ignore_count > 0)
    1299 1321 
                    {
    1300 1322 
                       // decrement and write back ignore count
    1301 1323 
                       ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
    1302 1324 
                    }
    1303 
    -               else if (rts_stop_next_breakpoint == true || ignore_count == 0)
    1325 
    +               else if (stop_next_breakpoint == true || ignore_count == 0)
    1304 1326 
                    {
    1305 1327 
                       // make sure we don't automatically stop at the
    1306 1328 
                       // next breakpoint
    1307 
    -                  rts_stop_next_breakpoint = false;
    1329 
    +                  rts_stop_next_breakpoint = 0;
    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/Interpreter.h
    ... ... @@ -11,3 +11,6 @@
    11 11 
     RTS_PRIVATE Capability *interpretBCO (Capability* cap);
    12 12 
     void interp_startup ( void );
    13 13 
     void interp_shutdown ( void );
    14 
    +
    15 
    +void rts_enableStopNextBreakpointAll  ();
    16 
    +void rts_disableStopNextBreakpointAll ();

  • 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_enableStopNextBreakpointAll)              \
    910 
    +      SymI_NeedsDataProto(rts_disableStopNextBreakpointAll)             \
    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 in this thread.
    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