GitLab

Rodrigo Mesquita pushed to branch wip/romes/27131 at Glasgow Haskell Compiler / GHC

Commits:

dbf1e298

by Rodrigo Mesquita at 2026-04-01T15:45:21+01:00

New rts Message to {set,unset} TSO flags

This commit introduces stg_MSG_SET_TSO_FLAG_info and
stg_MSG_UNSET_TSO_FLAG_info, which allows setting flags of a TSO other
than yourself.

This is especially useful/necessary to set breakpoints and toggle
breakpoints of different threads, which is needed to safely implement
features like pausing, toggling step-out, toggling step-in per thread,
etc.

Fixes #27131

7 changed files:

rts/Interpreter.c
rts/Messages.c
rts/StgMiscClosures.cmm
rts/Threads.c
rts/Threads.h
rts/include/rts/storage/Closures.h
rts/include/stg/MiscClosures.h

Changes:

rts/Interpreter.c

@@ -416,12 +416,22 @@ void rts_disableStopNextBreakpointAll(void)
  void rts_enableStopNextBreakpoint(StgTSO* tso)
+ {
 -    tso->flags |= TSO_STOP_NEXT_BREAKPOINT;
 +#if defined(THREADED_RTS)
 +  Capability* cap = rts_unsafeGetMyCapability();
 +  setThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT);
 +#else
 +  tso->flags |= TSO_STOP_NEXT_BREAKPOINT;
 +#endif
+ }
  void rts_disableStopNextBreakpoint(StgTSO* tso)
+ {
 -    tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
 +#if defined(THREADED_RTS)
 +  Capability* cap = rts_unsafeGetMyCapability();
 +  unsetThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT);
 +#else
 +  tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
 +#endif
+ }
  /* ---------------------------------------------------------------------------
@@ -430,12 +440,22 @@ void rts_disableStopNextBreakpoint(StgTSO* tso)
  void rts_enableStopAfterReturn(StgTSO* tso)
+ {
 +#if defined(THREADED_RTS)
 +  Capability* cap = rts_unsafeGetMyCapability();
 +  setThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN);
 +#else
    tso->flags |= TSO_STOP_AFTER_RETURN;
 +#endif
+ }
  void rts_disableStopAfterReturn(StgTSO* tso)
+ {
 +#if defined(THREADED_RTS)
 +  Capability* cap = rts_unsafeGetMyCapability();
 +  unsetThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN);
 +#else
    tso->flags &= ~TSO_STOP_AFTER_RETURN;
 +#endif
+ }
  /*

rts/Messages.c

@@ -35,7 +35,9 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
              i != &stg_MSG_TRY_WAKEUP_info &&
              i != &stg_IND_info && // can happen if a MSG_BLACKHOLE is revoked
              i != &stg_WHITEHOLE_info &&
 -            i != &stg_MSG_CLONE_STACK_info) {
 +            i != &stg_MSG_CLONE_STACK_info &&
 +            i != &stg_MSG_SET_TSO_FLAG_info &&
 +            i != &stg_MSG_UNSET_TSO_FLAG_info) {
              barf("sendMessage: %p", i);
+         }
+     }
@@ -137,6 +139,16 @@ loop:
          MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m;
          handleCloneStackMessage(cap, cloneStackMessage);
+     }
 +    else if(i == &stg_MSG_SET_TSO_FLAG_info){
 +        MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
 +        u->tso->flags |= u->flag;
 +        return;
 +    }
 +    else if(i == &stg_MSG_UNSET_TSO_FLAG_info){
 +        MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
 +        u->tso->flags &= ~u->flag;
 +        return;
 +    }
      else
+     {
          barf("executeMessage: %p", i);

rts/StgMiscClosures.cmm

@@ -855,6 +855,12 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL")
  INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_STACK")
  { ccall pbarf("stg_MSG_CLONE_STACK object (%p) entered!", R1 "ptr") never returns; }
 +INFO_TABLE_CONSTR(stg_MSG_SET_TSO_FLAG,2,1,0,PRIM,"MSG_SET_TSO_FLAG","MSG_SET_TSO_FLAG")
 +{ foreign "C" barf("stg_MSG_SET_TSO_FLAG object (%p) entered!", R1) never returns; }
++
 +INFO_TABLE_CONSTR(stg_MSG_UNSET_TSO_FLAG,2,1,0,PRIM,"MSG_UNSET_TSO_FLAG","MSG_UNSET_TSO_FLAG")
 +{ foreign "C" barf("stg_MSG_UNSET_TSO_FLAG object (%p) entered!", R1) never returns; }
++
  /* ----------------------------------------------------------------------------
     END_TSO_QUEUE

rts/Threads.c

@@ -376,6 +376,38 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to)
      tryWakeupThread(from, tso);
+ }
 +/* ----------------------------------------------------------------------------
 +   {set,unset}ThreadFlag
++
 +   sets or unsets a flag in a given TSO
 +   ------------------------------------------------------------------------- */
++
 +#if defined(THREADED_RTS)
 +static void
 +updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info);
++
 +void setThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
 +{
 +    updThreadFlag(from, tso, flag, &stg_MSG_SET_TSO_FLAG_info);
 +}
++
 +void unsetThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
 +{
 +    updThreadFlag(from, tso, flag, &stg_MSG_UNSET_TSO_FLAG_info);
 +}
++
 +static void
 +updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info)
 +{
 +    MessageUpdTSOFlag *msg;
 +    msg = (MessageUpdTSOFlag *)allocate(from,sizeofW(MessageUpdTSOFlag));
 +    msg->tso  = tso;
 +    msg->flag = flag;
 +    SET_HDR(msg, info, CCS_SYSTEM);
 +    sendMessage(from, tso->cap, (Message*)msg);
 +}
 +#endif
++
  /* ----------------------------------------------------------------------------
     awakenBlockedQueue

rts/Threads.h

@@ -19,6 +19,11 @@ void checkBlockingQueues (Capability *cap, StgTSO *tso);
  void tryWakeupThread     (Capability *cap, StgTSO *tso);
  void migrateThread       (Capability *from, StgTSO *tso, Capability *to);
 +#if defined(THREADED_RTS)
 +void setThreadFlag       (Capability *from, StgTSO *tso, StgWord32 flag);
 +void unsetThreadFlag     (Capability *from, StgTSO *tso, StgWord32 flag);
 +#endif
++
  // Wakes up a thread on a Capability (probably a different Capability
  // from the one held by the current Task).
  //

rts/include/rts/storage/Closures.h

@@ -620,6 +620,12 @@ typedef struct MessageCloneStack_ {
      StgTSO    *tso;
  } MessageCloneStack;
 +typedef struct MessageUpdTSOFlag_ {
 +    StgHeader header;
 +    Message   *link;
 +    StgTSO    *tso;
 +    StgWord32 flag;
 +} MessageUpdTSOFlag;
  /* ----------------------------------------------------------------------------
     Compact Regions

rts/include/stg/MiscClosures.h

@@ -152,6 +152,8 @@ RTS_ENTRY(stg_MSG_TRY_WAKEUP);
  RTS_ENTRY(stg_MSG_THROWTO);
  RTS_ENTRY(stg_MSG_BLACKHOLE);
  RTS_ENTRY(stg_MSG_CLONE_STACK);
 +RTS_ENTRY(stg_MSG_SET_TSO_FLAG);
 +RTS_ENTRY(stg_MSG_UNSET_TSO_FLAG);
  RTS_ENTRY(stg_MSG_NULL);
  RTS_ENTRY(stg_MVAR_TSO_QUEUE);
  RTS_ENTRY(stg_catch);