Rodrigo Mesquita pushed to branch wip/romes/27131 at Glasgow Haskell Compiler / GHC
Commits:
-
321f7a7f
by Rodrigo Mesquita at 2026-03-31T14:28:45+01:00
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:
| ... | ... | @@ -416,12 +416,12 @@ void rts_disableStopNextBreakpointAll(void) |
| 416 | 416 | |
| 417 | 417 | void rts_enableStopNextBreakpoint(StgTSO* tso)
|
| 418 | 418 | {
|
| 419 | - tso->flags |= TSO_STOP_NEXT_BREAKPOINT;
|
|
| 419 | + setThreadFlag(_, tso, TSO_STOP_NEXT_BREAKPOINT);
|
|
| 420 | 420 | }
|
| 421 | 421 | |
| 422 | 422 | void rts_disableStopNextBreakpoint(StgTSO* tso)
|
| 423 | 423 | {
|
| 424 | - tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
|
|
| 424 | + unsetThreadFlag(_, tso, TSO_STOP_NEXT_BREAKPOINT);
|
|
| 425 | 425 | }
|
| 426 | 426 | |
| 427 | 427 | /* ---------------------------------------------------------------------------
|
| ... | ... | @@ -430,12 +430,12 @@ void rts_disableStopNextBreakpoint(StgTSO* tso) |
| 430 | 430 | |
| 431 | 431 | void rts_enableStopAfterReturn(StgTSO* tso)
|
| 432 | 432 | {
|
| 433 | - tso->flags |= TSO_STOP_AFTER_RETURN;
|
|
| 433 | + setThreadFlag(_, tso, TSO_STOP_AFTER_RETURN);
|
|
| 434 | 434 | }
|
| 435 | 435 | |
| 436 | 436 | void rts_disableStopAfterReturn(StgTSO* tso)
|
| 437 | 437 | {
|
| 438 | - tso->flags &= ~TSO_STOP_AFTER_RETURN;
|
|
| 438 | + unsetThreadFlag(_, tso, TSO_STOP_AFTER_RETURN);
|
|
| 439 | 439 | }
|
| 440 | 440 | |
| 441 | 441 | /*
|
| ... | ... | @@ -137,6 +137,16 @@ loop: |
| 137 | 137 | MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m;
|
| 138 | 138 | handleCloneStackMessage(cap, cloneStackMessage);
|
| 139 | 139 | }
|
| 140 | + else if(i == &stg_MSG_SET_TSO_FLAG_info){
|
|
| 141 | + MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
|
|
| 142 | + u->tso->flags |= u->flag;
|
|
| 143 | + return;
|
|
| 144 | + }
|
|
| 145 | + else if(i == &stg_MSG_UNSET_TSO_FLAG_info){
|
|
| 146 | + MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
|
|
| 147 | + u->tso->flags &= ~u->flag;
|
|
| 148 | + return;
|
|
| 149 | + }
|
|
| 140 | 150 | else
|
| 141 | 151 | {
|
| 142 | 152 | barf("executeMessage: %p", i);
|
| ... | ... | @@ -855,6 +855,12 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL") |
| 855 | 855 | INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_STACK")
|
| 856 | 856 | { ccall pbarf("stg_MSG_CLONE_STACK object (%p) entered!", R1 "ptr") never returns; }
|
| 857 | 857 | |
| 858 | +INFO_TABLE_CONSTR(stg_MSG_SET_TSO_FLAG,3,0,0,PRIM,"MSG_SET_TSO_FLAG","MSG_SET_TSO_FLAG")
|
|
| 859 | +{ foreign "C" barf("stg_MSG_SET_TSO_FLAG object (%p) entered!", R1) never returns; }
|
|
| 860 | + |
|
| 861 | +INFO_TABLE_CONSTR(stg_MSG_UNSET_TSO_FLAG,3,0,0,PRIM,"MSG_UNSET_TSO_FLAG","MSG_UNSET_TSO_FLAG")
|
|
| 862 | +{ foreign "C" barf("stg_MSG_UNSET_TSO_FLAG object (%p) entered!", R1) never returns; }
|
|
| 863 | + |
|
| 858 | 864 | /* ----------------------------------------------------------------------------
|
| 859 | 865 | END_TSO_QUEUE
|
| 860 | 866 |
| ... | ... | @@ -376,6 +376,32 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to) |
| 376 | 376 | tryWakeupThread(from, tso);
|
| 377 | 377 | }
|
| 378 | 378 | |
| 379 | +/* ----------------------------------------------------------------------------
|
|
| 380 | + {set,unset}ThreadFlag
|
|
| 381 | + |
|
| 382 | + sets or unsets a flag in a given TSO
|
|
| 383 | + ------------------------------------------------------------------------- */
|
|
| 384 | + |
|
| 385 | +void setThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
|
|
| 386 | +{
|
|
| 387 | + updThreadFlag(from, tso, flag, &stg_MSG_SET_TSO_FLAG_info);
|
|
| 388 | +}
|
|
| 389 | +void unsetThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
|
|
| 390 | +{
|
|
| 391 | + updThreadFlag(from, tso, flag, &stg_MSG_UNSET_TSO_FLAG_info);
|
|
| 392 | +}
|
|
| 393 | + |
|
| 394 | +static void
|
|
| 395 | +updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, StgInfoTable* info)
|
|
| 396 | +{
|
|
| 397 | + MessageUpdTSOFlag *msg;
|
|
| 398 | + msg = (MessageUpdTSOFlag *)allocate(from,sizeofW(MessageUpdTSOFlag));
|
|
| 399 | + msg->tso = tso;
|
|
| 400 | + msg->flag = flag;
|
|
| 401 | + SET_HDR(msg, info, CCS_SYSTEM);
|
|
| 402 | + sendMessage(cap, tso->cap, (Message*)msg);
|
|
| 403 | +}
|
|
| 404 | + |
|
| 379 | 405 | /* ----------------------------------------------------------------------------
|
| 380 | 406 | awakenBlockedQueue
|
| 381 | 407 |
| ... | ... | @@ -19,6 +19,9 @@ void checkBlockingQueues (Capability *cap, StgTSO *tso); |
| 19 | 19 | void tryWakeupThread (Capability *cap, StgTSO *tso);
|
| 20 | 20 | void migrateThread (Capability *from, StgTSO *tso, Capability *to);
|
| 21 | 21 | |
| 22 | +void setThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag);
|
|
| 23 | +void unsetThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag);
|
|
| 24 | + |
|
| 22 | 25 | // Wakes up a thread on a Capability (probably a different Capability
|
| 23 | 26 | // from the one held by the current Task).
|
| 24 | 27 | //
|
| ... | ... | @@ -620,6 +620,12 @@ typedef struct MessageCloneStack_ { |
| 620 | 620 | StgTSO *tso;
|
| 621 | 621 | } MessageCloneStack;
|
| 622 | 622 | |
| 623 | +typedef struct MessageUpdTSOFlag_ {
|
|
| 624 | + StgHeader header;
|
|
| 625 | + Message *link;
|
|
| 626 | + StgTSO *tso;
|
|
| 627 | + StgWord32 flag;
|
|
| 628 | +} MessageUpdTSOFlag;
|
|
| 623 | 629 | |
| 624 | 630 | /* ----------------------------------------------------------------------------
|
| 625 | 631 | Compact Regions
|
| ... | ... | @@ -152,6 +152,8 @@ RTS_ENTRY(stg_MSG_TRY_WAKEUP); |
| 152 | 152 | RTS_ENTRY(stg_MSG_THROWTO);
|
| 153 | 153 | RTS_ENTRY(stg_MSG_BLACKHOLE);
|
| 154 | 154 | RTS_ENTRY(stg_MSG_CLONE_STACK);
|
| 155 | +RTS_ENTRY(stg_MSG_SET_TSO_FLAG);
|
|
| 156 | +RTS_ENTRY(stg_MSG_UNSET_TSO_FLAG);
|
|
| 155 | 157 | RTS_ENTRY(stg_MSG_NULL);
|
| 156 | 158 | RTS_ENTRY(stg_MVAR_TSO_QUEUE);
|
| 157 | 159 | RTS_ENTRY(stg_catch);
|