Rodrigo Mesquita pushed to branch wip/romes/step-out at Glasgow Haskell Compiler / GHC
Commits:
-
f7d2b30a
by Rodrigo Mesquita at 2025-05-27T17:22:35+01:00
8 changed files:
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Runtime/Eval/Types.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Run.hs
- rts/Debugger.cmm
- rts/Interpreter.c
- rts/StgMiscClosures.cmm
- utils/deriveConstants/Main.hs
Changes:
... | ... | @@ -33,7 +33,7 @@ initSimpleOpts dflags = SimpleOpts |
33 | 33 | data EvalStep
|
34 | 34 | -- | ... at every breakpoint tick
|
35 | 35 | = EvalStepSingle
|
36 | - -- | ... after every return stmt
|
|
36 | + -- | ... after any return stmt
|
|
37 | 37 | | EvalStepOut
|
38 | 38 | -- | ... only on explicit breakpoints
|
39 | 39 | | EvalStepNone
|
... | ... | @@ -47,7 +47,7 @@ data SingleStep |
47 | 47 | -- | :step [expr]
|
48 | 48 | | SingleStep
|
49 | 49 | |
50 | - -- | :stepout [expr]
|
|
50 | + -- | :stepout
|
|
51 | 51 | | StepOut
|
52 | 52 | |
53 | 53 | -- | :steplocal [expr]
|
... | ... | @@ -247,7 +247,7 @@ ghciCommands = map mkCmd [ |
247 | 247 | ("sprint", keepGoing sprintCmd, completeExpression),
|
248 | 248 | ("step", keepGoing stepCmd, completeIdentifier),
|
249 | 249 | ("steplocal", keepGoing stepLocalCmd, completeIdentifier),
|
250 | - ("stepout", keepGoing stepOutCmd, completeIdentifier),
|
|
250 | + ("stepout", keepGoing stepOutCmd, noCompletion),
|
|
251 | 251 | ("stepmodule",keepGoing stepModuleCmd, completeIdentifier),
|
252 | 252 | ("type", keepGoingMulti' typeOfExpr, completeExpression),
|
253 | 253 | ("trace", keepGoing traceCmd, completeExpression),
|
... | ... | @@ -3796,10 +3796,7 @@ stepCmd arg = withSandboxOnly ":step" $ step arg |
3796 | 3796 | step expression = runStmt expression GHC.SingleStep >> return ()
|
3797 | 3797 | |
3798 | 3798 | stepOutCmd :: GhciMonad m => String -> m ()
|
3799 | -stepOutCmd arg = withSandboxOnly ":stepout" $ step arg
|
|
3800 | - where
|
|
3801 | - step [] = doContinue GHC.StepOut
|
|
3802 | - step expression = stepCmd expression
|
|
3799 | +stepOutCmd _ = withSandboxOnly ":stepout" $ doContinue GHC.StepOut
|
|
3803 | 3800 | |
3804 | 3801 | stepLocalCmd :: GhciMonad m => String -> m ()
|
3805 | 3802 | stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
|
... | ... | @@ -202,7 +202,7 @@ doSeq ref = do |
202 | 202 | resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ())
|
203 | 203 | resumeSeq hvref = do
|
204 | 204 | ResumeContext{..} <- localRef hvref
|
205 | - withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar $
|
|
205 | + withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
|
|
206 | 206 | mask_ $ do
|
207 | 207 | putMVar resumeBreakMVar () -- this awakens the stopped thread...
|
208 | 208 | redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
|
... | ... | @@ -231,7 +231,7 @@ sandboxIO opts io = do |
231 | 231 | -- We are running in uninterruptibleMask
|
232 | 232 | breakMVar <- newEmptyMVar
|
233 | 233 | statusMVar <- newEmptyMVar
|
234 | - withBreakAction opts breakMVar statusMVar $ do
|
|
234 | + withBreakAction opts breakMVar statusMVar Nothing $ do
|
|
235 | 235 | let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io
|
236 | 236 | if useSandboxThread opts
|
237 | 237 | then do
|
... | ... | @@ -326,8 +326,8 @@ tryEval io = do |
326 | 326 | -- resets everything when the computation has stopped running. This
|
327 | 327 | -- is a not-very-good way to ensure that only the interactive
|
328 | 328 | -- evaluation should generate breakpoints.
|
329 | -withBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
|
|
330 | -withBreakAction opts breakMVar statusMVar act
|
|
329 | +withBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> Maybe ThreadId {-^ If resuming, the current threadId -} -> IO a -> IO a
|
|
330 | +withBreakAction opts breakMVar statusMVar mtid act
|
|
331 | 331 | = bracket setBreakAction resetBreakAction (\_ -> act)
|
332 | 332 | where
|
333 | 333 | setBreakAction = do
|
... | ... | @@ -336,8 +336,10 @@ withBreakAction opts breakMVar statusMVar act |
336 | 336 | when (breakOnException opts) $ poke exceptionFlag 1
|
337 | 337 | when (singleStep opts) rts_enableStopNextBreakpointAll
|
338 | 338 | when (stepOut opts) $ do
|
339 | - ThreadId tid <- myThreadId
|
|
340 | - rts_enableStopAfterReturn tid
|
|
339 | + case mtid of
|
|
340 | + Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped
|
|
341 | + Just (ThreadId tid) -> do
|
|
342 | + rts_enableStopAfterReturn tid
|
|
341 | 343 | return stablePtr
|
342 | 344 | -- Breaking on exceptions is not enabled by default, since it
|
343 | 345 | -- might be a bit surprising. The exception flag is turned off
|
... | ... | @@ -369,10 +371,9 @@ withBreakAction opts breakMVar statusMVar act |
369 | 371 | poke breakPointIOAction noBreakStablePtr
|
370 | 372 | poke exceptionFlag 0
|
371 | 373 | rts_disableStopNextBreakpointAll
|
372 | - |
|
373 | - ThreadId tid <- myThreadId
|
|
374 | - rts_disableStopAfterReturn tid
|
|
375 | - |
|
374 | + case mtid of
|
|
375 | + Just (ThreadId tid) -> rts_disableStopAfterReturn tid
|
|
376 | + _ -> pure ()
|
|
376 | 377 | freeStablePtr stablePtr
|
377 | 378 | |
378 | 379 | resumeStmt
|
... | ... | @@ -380,7 +381,7 @@ resumeStmt |
380 | 381 | -> IO (EvalStatus [HValueRef])
|
381 | 382 | resumeStmt opts hvref = do
|
382 | 383 | ResumeContext{..} <- localRef hvref
|
383 | - withBreakAction opts resumeBreakMVar resumeStatusMVar $
|
|
384 | + withBreakAction opts resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
|
|
384 | 385 | mask_ $ do
|
385 | 386 | putMVar resumeBreakMVar () -- this awakens the stopped thread...
|
386 | 387 | redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
|
... | ... | @@ -29,8 +29,8 @@ import CLOSURE stg_stop_after_ret_frame_info; |
29 | 29 | *
|
30 | 30 | * See Note [Debugger: Step-out] for details.
|
31 | 31 | */
|
32 | -INFO_TABLE_RET (stg_stop_after_ret_frame, RET_SMALL)
|
|
33 | - return (/* no return values */)
|
|
32 | +INFO_TABLE_RET (stg_stop_after_ret_frame, RET_SMALL, W_ info_ptr)
|
|
33 | + /* no args => explicit stack */
|
|
34 | 34 | {
|
35 | 35 | |
36 | 36 | /* We've entered a stg_stop_after_ret_frame, thus we want to stop at the next
|
... | ... | @@ -40,7 +40,12 @@ INFO_TABLE_RET (stg_stop_after_ret_frame, RET_SMALL) |
40 | 40 | StgTSO_flags(CurrentTSO) =
|
41 | 41 | %lobits32( TO_W_(StgTSO_flags(CurrentTSO)) | TSO_STOP_NEXT_BREAKPOINT );
|
42 | 42 | |
43 | - |
|
44 | 43 | /* After enabling the single step mode, execution is resumed by returning
|
45 | - * to the frame this one intercepted. */
|
|
44 | + * to the frame this one intercepted.
|
|
45 | + *
|
|
46 | + * Note: Arguments passed to the frame we intercepted must be propagated,
|
|
47 | + * and the floating point registers untouched! See Note [Frames intercepting frames].
|
|
48 | + */
|
|
49 | + Sp = Sp + SIZEOF_StgStopAfterRetFrame;
|
|
50 | + jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
|
|
46 | 51 | } |
... | ... | @@ -562,7 +562,7 @@ interpretBCO (Capability* cap) |
562 | 562 | if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
|
563 | 563 | |
564 | 564 | StgPtr frame;
|
565 | - frame = cap->r.rCurrentTSO->stackobj->sp;
|
|
565 | + frame = Sp;
|
|
566 | 566 | |
567 | 567 | // Insert the stg_stop_after_ret_frame after the first frame that is NOT a
|
568 | 568 | // case continuation BCO.
|
... | ... | @@ -573,18 +573,23 @@ interpretBCO (Capability* cap) |
573 | 573 | while (*frame == (W_)&stg_CASE_CONT_BCO_info) {
|
574 | 574 | frame += stack_frame_sizeW((StgClosure *)frame);
|
575 | 575 | }
|
576 | - // New frame goes right after the first non-case-cont frame
|
|
576 | + // New frame goes /right after the first/ non-case-cont frame
|
|
577 | 577 | frame += stack_frame_sizeW((StgClosure *)frame);
|
578 | 578 | |
579 | 579 | // TODO: Handle stack bottom edge case!? if frame == STACK BOTTOM...
|
580 | 580 | |
581 | 581 | // Make space for the new frame
|
582 | + memmove((W_*)Sp - sizeofW(StgStopAfterRetFrame), Sp, (uint8_t*)frame - (uint8_t*)Sp);
|
|
582 | 583 | Sp_subW(sizeofW(StgStopAfterRetFrame));
|
583 | - memmove(frame-sizeof(StgStopAfterRetFrame), frame, (uint8_t*)cap->r.rCurrentTSO->stackobj->sp - (uint8_t*)frame);
|
|
584 | + |
|
585 | + // Point to newly opened space
|
|
586 | + frame -= sizeofW(StgStopAfterRetFrame);
|
|
584 | 587 | |
585 | 588 | // Then write it.
|
586 | 589 | ((StgStopAfterRetFrame*)frame)->header.info = &stg_stop_after_ret_frame_info;
|
587 | 590 | |
591 | + // TODO: Write profiling info if needed
|
|
592 | + |
|
588 | 593 | // Frame was pushed, mark as done to not do it again
|
589 | 594 | cap->r.rCurrentTSO->flags &= ~TSO_STOP_AFTER_RETURN;
|
590 | 595 | }
|
... | ... | @@ -640,7 +645,6 @@ interpretBCO (Capability* cap) |
640 | 645 | //
|
641 | 646 | // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info.
|
642 | 647 | // See Note [Case continuation BCOs].
|
643 | - //
|
|
644 | 648 | else if (SpW(0) == (W_)&stg_apply_interp_info) {
|
645 | 649 | obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1));
|
646 | 650 | Sp_addW(2);
|
... | ... | @@ -53,21 +53,12 @@ INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, |
53 | 53 | {
|
54 | 54 | |
55 | 55 | /*
|
56 | - |
|
57 | 56 | !!!!!!!!!!!!!!!!!
|
58 | 57 | !!! IMPORTANT !!!
|
59 | 58 | !!!!!!!!!!!!!!!!!
|
60 | 59 | |
61 | 60 | The body of this function MUST NOT use any floating-point
|
62 | - or vector registers. DO NOT add any e.g. debug printing logic that
|
|
63 | - has any chance whatsoever of using floating-point or vector registers.
|
|
64 | - If you DO want to edit the function in such a way that it may use
|
|
65 | - vector registers, you will need to define multiple different copies
|
|
66 | - of this function, as we do e.g. for stg_stack_underflow_frame
|
|
67 | - (see Jumps.h).
|
|
68 | - |
|
69 | - See Note [realArgRegsCover] in GHC.Cmm.CallConv for more details.
|
|
70 | - |
|
61 | + or vector registers. See Note [Frames intercepting frames].
|
|
71 | 62 | */
|
72 | 63 | |
73 | 64 | unwind Sp = W_[Sp + SIZEOF_StgOrigThunkInfoFrame];
|
... | ... | @@ -75,6 +66,30 @@ INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, |
75 | 66 | jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
|
76 | 67 | }
|
77 | 68 | |
69 | +/*
|
|
70 | +Note [Frames intercepting frames]
|
|
71 | +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
72 | +A frame which "intercepts" the following frame (to do additional work or
|
|
73 | +manipulate the stack, such as `stg_orig_thunk_info_frame` or
|
|
74 | +`stg_stop_after_ret_frame`) must take care to passthrough all the registers and
|
|
75 | +arguments when it returns to the next frame. This is done by jumping with
|
|
76 | +GP_ARG_REGS as in:
|
|
77 | + |
|
78 | + jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
|
|
79 | + |
|
80 | +However, special care must be taken when these arguments are propagated:
|
|
81 | + |
|
82 | +The body of such a function MUST NOT use any floating-point
|
|
83 | +or vector registers. DO NOT add any e.g. debug printing logic that
|
|
84 | +has any chance whatsoever of using floating-point or vector registers.
|
|
85 | +If you DO want to edit the function in such a way that it may use
|
|
86 | +vector registers, you will need to define multiple different copies
|
|
87 | +of the function, as we do e.g. for stg_stack_underflow_frame
|
|
88 | +(see Jumps.h).
|
|
89 | + |
|
90 | +See Note [realArgRegsCover] in GHC.Cmm.CallConv for more details.
|
|
91 | +*/
|
|
92 | + |
|
78 | 93 | /* ----------------------------------------------------------------------------
|
79 | 94 | Restore a saved cost centre
|
80 | 95 | ------------------------------------------------------------------------- */
|
... | ... | @@ -518,6 +518,8 @@ wanteds os = concat |
518 | 518 | |
519 | 519 | ,closureFieldGcptr C "StgInd" "indirectee"
|
520 | 520 | |
521 | + ,closureSize C "StgStopAfterRetFrame"
|
|
522 | + |
|
521 | 523 | ,closureSize C "StgMutVar"
|
522 | 524 | ,closureField C "StgMutVar" "var"
|
523 | 525 |