[Git][ghc/ghc][wip/romes/step-out] More fixes and improvements; it now works but behaviour is not finished

27 May 2025


      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
More fixes and improvements; it now works but behaviour is not finished

- - - - -


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:

=====================================
compiler/GHC/Driver/Config.hs
=====================================
@@ -33,7 +33,7 @@ initSimpleOpts dflags = SimpleOpts
 data EvalStep
   -- | ... at every breakpoint tick
   = EvalStepSingle
-  -- | ... after every return stmt
+  -- | ... after any return stmt
   | EvalStepOut
   -- | ... only on explicit breakpoints
   | EvalStepNone


=====================================
compiler/GHC/Runtime/Eval/Types.hs
=====================================
@@ -47,7 +47,7 @@ data SingleStep
    -- | :step [expr]
    | SingleStep
 
-   -- | :stepout [expr]
+   -- | :stepout
    | StepOut
 
    -- | :steplocal [expr]


=====================================
ghc/GHCi/UI.hs
=====================================
@@ -247,7 +247,7 @@ ghciCommands = map mkCmd [
   ("sprint",    keepGoing sprintCmd,            completeExpression),
   ("step",      keepGoing stepCmd,              completeIdentifier),
   ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
-  ("stepout",   keepGoing stepOutCmd,           completeIdentifier),
+  ("stepout",   keepGoing stepOutCmd,           noCompletion),
   ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
   ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
   ("trace",     keepGoing traceCmd,             completeExpression),
@@ -3796,10 +3796,7 @@ stepCmd arg = withSandboxOnly ":step" $ step arg
   step expression = runStmt expression GHC.SingleStep >> return ()
 
 stepOutCmd :: GhciMonad m => String -> m ()
-stepOutCmd arg = withSandboxOnly ":stepout" $ step arg
-  where
-  step []         = doContinue GHC.StepOut
-  step expression = stepCmd expression
+stepOutCmd _ = withSandboxOnly ":stepout" $ doContinue GHC.StepOut
 
 stepLocalCmd :: GhciMonad m => String -> m ()
 stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg


=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -202,7 +202,7 @@ doSeq ref = do
 resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ())
 resumeSeq hvref = do
     ResumeContext{..} <- localRef hvref
-    withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar $
+    withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
       mask_ $ do
         putMVar resumeBreakMVar () -- this awakens the stopped thread...
         redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar
@@ -231,7 +231,7 @@ sandboxIO opts io = do
   -- We are running in uninterruptibleMask
   breakMVar <- newEmptyMVar
   statusMVar <- newEmptyMVar
-  withBreakAction opts breakMVar statusMVar $ do
+  withBreakAction opts breakMVar statusMVar Nothing $ do
     let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io
     if useSandboxThread opts
        then do
@@ -326,8 +326,8 @@ tryEval io = do
 -- resets everything when the computation has stopped running.  This
 -- is a not-very-good way to ensure that only the interactive
 -- evaluation should generate breakpoints.
-withBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
-withBreakAction opts breakMVar statusMVar act
+withBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> Maybe ThreadId {-^ If resuming, the current threadId -} -> IO a -> IO a
+withBreakAction opts breakMVar statusMVar mtid act
  = bracket setBreakAction resetBreakAction (\_ -> act)
  where
    setBreakAction = do
@@ -336,8 +336,10 @@ withBreakAction opts breakMVar statusMVar act
      when (breakOnException opts) $ poke exceptionFlag 1
      when (singleStep opts) rts_enableStopNextBreakpointAll
      when (stepOut opts) $ do
-      ThreadId tid <- myThreadId
-      rts_enableStopAfterReturn tid
+      case mtid of
+        Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped
+        Just (ThreadId tid) -> do
+          rts_enableStopAfterReturn tid
      return stablePtr
         -- Breaking on exceptions is not enabled by default, since it
         -- might be a bit surprising.  The exception flag is turned off
@@ -369,10 +371,9 @@ withBreakAction opts breakMVar statusMVar act
      poke breakPointIOAction noBreakStablePtr
      poke exceptionFlag 0
      rts_disableStopNextBreakpointAll
-
-     ThreadId tid <- myThreadId
-     rts_disableStopAfterReturn tid
-
+     case mtid of
+      Just (ThreadId tid) -> rts_disableStopAfterReturn tid
+      _                   -> pure ()
      freeStablePtr stablePtr
 
 resumeStmt
@@ -380,7 +381,7 @@ resumeStmt
   -> IO (EvalStatus [HValueRef])
 resumeStmt opts hvref = do
   ResumeContext{..} <- localRef hvref
-  withBreakAction opts resumeBreakMVar resumeStatusMVar $
+  withBreakAction opts resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $
     mask_ $ do
       putMVar resumeBreakMVar () -- this awakens the stopped thread...
       redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar


=====================================
rts/Debugger.cmm
=====================================
@@ -29,8 +29,8 @@ import CLOSURE stg_stop_after_ret_frame_info;
  *
  * See Note [Debugger: Step-out] for details.
  */
-INFO_TABLE_RET (stg_stop_after_ret_frame, RET_SMALL)
-    return (/* no return values */)
+INFO_TABLE_RET (stg_stop_after_ret_frame, RET_SMALL, W_ info_ptr)
+    /* no args => explicit stack */
 {
 
     /* 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)
     StgTSO_flags(CurrentTSO) =
        %lobits32( TO_W_(StgTSO_flags(CurrentTSO)) | TSO_STOP_NEXT_BREAKPOINT );
 
-
     /* After enabling the single step mode, execution is resumed by returning
-     * to the frame this one intercepted. */
+     * to the frame this one intercepted.
+     *
+     * Note: Arguments passed to the frame we intercepted must be propagated,
+     * and the floating point registers untouched! See Note [Frames intercepting frames].
+     */
+    Sp = Sp + SIZEOF_StgStopAfterRetFrame;
+    jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
 }


=====================================
rts/Interpreter.c
=====================================
@@ -562,7 +562,7 @@ interpretBCO (Capability* cap)
     if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) {
 
       StgPtr frame;
-      frame = cap->r.rCurrentTSO->stackobj->sp;
+      frame = Sp;
 
       // Insert the stg_stop_after_ret_frame after the first frame that is NOT a
       // case continuation BCO.
@@ -573,18 +573,23 @@ interpretBCO (Capability* cap)
       while (*frame == (W_)&stg_CASE_CONT_BCO_info) {
         frame += stack_frame_sizeW((StgClosure *)frame);
       }
-      // New frame goes right after the first non-case-cont frame
+      // New frame goes /right after the first/ non-case-cont frame
       frame += stack_frame_sizeW((StgClosure *)frame);
 
       // TODO: Handle stack bottom edge case!? if frame == STACK BOTTOM...
 
       // Make space for the new frame
+      memmove((W_*)Sp - sizeofW(StgStopAfterRetFrame), Sp, (uint8_t*)frame - (uint8_t*)Sp);
       Sp_subW(sizeofW(StgStopAfterRetFrame));
-      memmove(frame-sizeof(StgStopAfterRetFrame), frame, (uint8_t*)cap->r.rCurrentTSO->stackobj->sp - (uint8_t*)frame);
+
+      // Point to newly opened space
+      frame -= sizeofW(StgStopAfterRetFrame);
 
       // Then write it.
       ((StgStopAfterRetFrame*)frame)->header.info = &stg_stop_after_ret_frame_info;
 
+      // TODO: Write profiling info if needed
+
       // Frame was pushed, mark as done to not do it again
       cap->r.rCurrentTSO->flags &= ~TSO_STOP_AFTER_RETURN;
     }
@@ -640,7 +645,6 @@ interpretBCO (Capability* cap)
     //
     // [1] An StgBCO's info table pointer may also be stg_CASE_CONT_BCO_info.
     //      See Note [Case continuation BCOs].
-    //
     else if (SpW(0) == (W_)&stg_apply_interp_info) {
         obj = UNTAG_CLOSURE((StgClosure *)ReadSpW(1));
         Sp_addW(2);


=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -53,21 +53,12 @@ INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL,
 {
 
     /*
-
     !!!!!!!!!!!!!!!!!
     !!! IMPORTANT !!!
     !!!!!!!!!!!!!!!!!
 
     The body of this function MUST NOT use any floating-point
-    or vector registers. DO NOT add any e.g. debug printing logic that
-    has any chance whatsoever of using floating-point or vector registers.
-    If you DO want to edit the function in such a way that it may use
-    vector registers, you will need to define multiple different copies
-    of this function, as we do e.g. for stg_stack_underflow_frame
-    (see Jumps.h).
-
-    See Note [realArgRegsCover] in GHC.Cmm.CallConv for more details.
-
+    or vector registers. See Note [Frames intercepting frames].
     */
 
     unwind Sp = W_[Sp + SIZEOF_StgOrigThunkInfoFrame];
@@ -75,6 +66,30 @@ INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL,
     jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
 }
 
+/*
+Note [Frames intercepting frames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A frame which "intercepts" the following frame (to do additional work or
+manipulate the stack, such as `stg_orig_thunk_info_frame` or
+`stg_stop_after_ret_frame`) must take care to passthrough all the registers and
+arguments when it returns to the next frame. This is done by jumping with
+GP_ARG_REGS as in:
+
+    jump %ENTRY_CODE(Sp(0)) GP_ARG_REGS; // NB. all GP arg regs live!
+
+However, special care must be taken when these arguments are propagated:
+
+The body of such a function MUST NOT use any floating-point
+or vector registers. DO NOT add any e.g. debug printing logic that
+has any chance whatsoever of using floating-point or vector registers.
+If you DO want to edit the function in such a way that it may use
+vector registers, you will need to define multiple different copies
+of the function, as we do e.g. for stg_stack_underflow_frame
+(see Jumps.h).
+
+See Note [realArgRegsCover] in GHC.Cmm.CallConv for more details.
+*/
+
 /* ----------------------------------------------------------------------------
    Restore a saved cost centre
    ------------------------------------------------------------------------- */


=====================================
utils/deriveConstants/Main.hs
=====================================
@@ -518,6 +518,8 @@ wanteds os = concat
 
           ,closureFieldGcptr C "StgInd" "indirectee"
 
+          ,closureSize  C "StgStopAfterRetFrame"
+
           ,closureSize  C "StgMutVar"
           ,closureField C "StgMutVar" "var"
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2b30a12d81ff8948b13366a048e29...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2b30a12d81ff8948b13366a048e29...
You're receiving this email because of your account on gitlab.haskell.org.

    

Rodrigo Mesquita (＠alt-romes)

tags

participants (1)