[Git][ghc/ghc][wip/romes/27131] New rts Message to {set,unset} TSO flags

1 Apr 2026


      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);



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

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

    

Rodrigo Mesquita (＠alt-romes)

tags

participants (1)