Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC
Commits:
d99bb8e1 by mangoiv at 2026-05-20T14:52:56+02:00
rts: cast Sp_plusW to StgPtr to appease gcc
- - - - -
8fde70d7 by mangoiv at 2026-05-20T14:52:56+02:00
rts: disable out of bounds array warning for sometimes inlined rts function
- - - - -
b4ef6088 by Duncan Coutts at 2026-05-20T14:56:06+02:00
Handle heap allocation failure in I/O primops
The current I/O managers do not use allocateMightFail, but future ones
will. To support this properly we need to be able to return to the
primop with a failure. We simply use a bool return value.
Currently however, we will just throw an exception rather than calling
the GC because that's what all the other primops do too.
For the general issue of primops invoking GC and retrying, see
https://gitlab.haskell.org/ghc/ghc/-/issues/24105
(cherry picked from commit 62ae97de67f8cc59fc702e26a9e29eda1f84d461)
- - - - -
3319b7da by Luite Stegeman at 2026-05-20T14:56:59+02:00
Windows: remove StgAsyncIOResult and fix crash/leaks
In stg_block_async{_void}, a stack slot was reserved for
an StgAsyncIOResult. This slot would be filled by the IO
manager upon completion of the async call.
However, if the blocked thread was interrupted by an async
exception, we would end up in an invalid state:
- If the blocked computation was never re-entered, the
StgAsyncIOResult would never be freed.
- If the blocked computation was re-entered, the thread would
find an unitialized stack slot for the StgAsyncIOResult,
leading to a crash reading its fields, or freeing the pointer.
We fix this by removing the StgAsyncIOResult altogether and writing
the result directly to the stack.
Fixes #26341
(cherry picked from commit fcf092dda534cc38637d1f7920aa0dae58fe5273)
- - - - -
20 changed files:
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/Threads.c
- rts/include/rts/storage/ClosureMacros.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MiscClosures.h
- rts/win32/AsyncMIO.c
- rts/win32/AsyncMIO.h
- + testsuite/tests/concurrent/should_run/T26341.hs
- + testsuite/tests/concurrent/should_run/T26341.stdout
- + testsuite/tests/concurrent/should_run/T26341a.hs
- + testsuite/tests/concurrent/should_run/T26341a.stdout
- + testsuite/tests/concurrent/should_run/T26341b.hs
- + testsuite/tests/concurrent/should_run/T26341b.stdout
- testsuite/tests/concurrent/should_run/all.T
- utils/deriveConstants/Main.hs
Changes:
=====================================
rts/HeapStackCheck.cmm
=====================================
@@ -706,38 +706,24 @@ stg_block_throwto (P_ tso, P_ exception)
}
#if defined(mingw32_HOST_OS)
-INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ ares )
+INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ len, W_ errCode )
return ()
{
- W_ len, errC;
-
- len = TO_W_(StgAsyncIOResult_len(ares));
- errC = TO_W_(StgAsyncIOResult_errCode(ares));
- ccall free(ares "ptr");
- return (len, errC);
+ return (len, errCode);
}
stg_block_async
{
- Sp_adj(-2);
- Sp(0) = stg_block_async_info;
- BLOCK_GENERIC;
-}
+ W_ eintr;
+ (eintr) = ccall rts_EINTR();
-/* Used by threadDelay implementation; it would be desirable to get rid of
- * this free()'ing void return continuation.
- */
-INFO_TABLE_RET ( stg_block_async_void, RET_SMALL, W_ info_ptr, W_ ares )
- return ()
-{
- ccall free(ares "ptr");
- return ();
-}
-
-stg_block_async_void
-{
- Sp_adj(-2);
- Sp(0) = stg_block_async_void_info;
+ // Fill the stack frame with values that indicate that the operation
+ // has been interrupted. The IO manager will overwrite these with the
+ // actual results if the async operation completes.
+ Sp_adj(-3);
+ Sp(0) = stg_block_async_info;
+ Sp(1) = -1; // len: -1 indicates error
+ Sp(2) = eintr; // errCode: interrupted
BLOCK_GENERIC;
}
=====================================
rts/IOManager.c
=====================================
@@ -561,10 +561,8 @@ void scavengeTSOIOManager(StgTSO *tso)
*/
/* case IO_MANAGER_WIN32_LEGACY:
- * BlockedOn{Read,Write,DoProc} uses block_info.async_result
- * The StgAsyncIOResult async_result is allocated on the C heap.
- * It'd probably be better if it used the GC heap. If it did we'd
- * scavenge it here.
+ * BlockedOn{Read,Write,DoProc} uses block_info.async_reqID
+ * which is a plain integer, so nothing to scavenge.
*/
default:
@@ -707,7 +705,7 @@ void awaitCompletedTimeoutsOrIO(Capability *cap)
}
-void syncIOWaitReady(Capability *cap,
+bool syncIOWaitReady(Capability *cap,
StgTSO *tso,
IOReadOrWrite rw,
HsInt fd)
@@ -724,7 +722,7 @@ void syncIOWaitReady(Capability *cap,
tso->block_info.fd = fd;
RELEASE_STORE(&tso->why_blocked, why_blocked);
appendToIOBlockedQueue(cap, tso);
- break;
+ return true;
}
#endif
default:
@@ -747,7 +745,7 @@ void syncIOCancel(Capability *cap, StgTSO *tso)
case IO_MANAGER_WIN32_LEGACY:
removeThreadFromDeQueue(cap, &cap->iomgr->blocked_queue_hd,
&cap->iomgr->blocked_queue_tl, tso);
- abandonWorkRequest(tso->block_info.async_result->reqID);
+ abandonWorkRequest(tso->block_info.async_reqID);
break;
#endif
default:
@@ -761,7 +759,7 @@ static void insertIntoSleepingQueue(Capability *cap, StgTSO *tso, LowResTime tar
#endif
-void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
+bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
{
debugTrace(DEBUG_iomanager, "thread %ld waiting for %lld us", tso->id, us_delay);
ASSERT(tso->why_blocked == NotBlocked);
@@ -773,7 +771,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
tso->block_info.target = target;
RELEASE_STORE(&tso->why_blocked, BlockedOnDelay);
insertIntoSleepingQueue(cap, tso, target);
- break;
+ return true;
}
#endif
#if defined(IOMGR_ENABLED_WIN32_LEGACY)
@@ -782,12 +780,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
* would make the primops more consistent.
*/
{
- StgAsyncIOResult *ares = stgMallocBytes(sizeof(StgAsyncIOResult),
- "syncDelay");
- ares->reqID = addDelayRequest(us_delay);
- ares->len = 0;
- ares->errCode = 0;
- tso->block_info.async_result = ares;
+ tso->block_info.async_reqID = addDelayRequest(us_delay);
/* Having all async-blocked threads reside on the blocked_queue
* simplifies matters, so set the status to OnDoProc and put the
@@ -795,7 +788,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay)
*/
RELEASE_STORE(&tso->why_blocked, BlockedOnDoProc);
appendToIOBlockedQueue(cap, tso);
- break;
+ return true;
}
#endif
default:
=====================================
rts/IOManager.h
=====================================
@@ -282,13 +282,20 @@ typedef enum { IORead, IOWrite } IOReadOrWrite;
/* Synchronous operations: I/O and delays. As synchronous operations they
* necessarily operate on threads. The thread is suspended until the operation
* completes.
+ *
+ * These are called from CMM primops. The ones returing int can perform heap
+ * allocation, which might fail. They return 0 on success, or n > 0 on heap
+ * allocation failure, needing n words. The CMM primops should invoke the
+ * GC to free up at least n words and then retry the operation.
*/
-void syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
+/* Result is true on success, or false on allocation failure. */
+bool syncIOWaitReady(Capability *cap, StgTSO *tso, IOReadOrWrite rw, HsInt fd);
void syncIOCancel(Capability *cap, StgTSO *tso);
-void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay);
+/* Result is true on success, or false on allocation failure. */
+bool syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay);
void syncDelayCancel(Capability *cap, StgTSO *tso);
=====================================
rts/Interpreter.c
=====================================
@@ -468,7 +468,7 @@ slow_spw(void *Sp, StgStack *cur_stack, StgWord offset_words){
}
// 2b. Access the element if there is no underflow frame, it must be right
// at the top of the stack.
- else if(Sp_plusW(offset_words) < (StgPtr)(cur_stack->stack + cur_stack->stack_size)) {
+ else if((StgPtr)Sp_plusW(offset_words) < (StgPtr)(cur_stack->stack + cur_stack->stack_size)) {
// Still inside the stack chunk
return Sp_plusW(offset_words);
} else {
@@ -1832,7 +1832,7 @@ run_BCO:
threadStackUnderflow(cap, cap->r.rCurrentTSO);
LOAD_STACK_POINTERS;
by -= sp_to_uf;
- } else if (Sp_plusW(by) < (StgPtr)(stk->stack + stk->stack_size)) {
+ } else if ((StgPtr)Sp_plusW(by) < (StgPtr)(stk->stack + stk->stack_size)) {
// we're within the first stack chunk, this chunk has
// no underflow frame
break;
=====================================
rts/PrimOps.cmm
=====================================
@@ -2561,54 +2561,55 @@ stg_whereFromzh (P_ clos, W_ buf)
stg_waitReadzh ( W_ fd )
{
- ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
- /* IORead */ 0::I32, fd);
- jump stg_block_noregs();
+ CBool ok; /* Ok, or heap alloc failure. */
+
+ (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
+ /* IORead */ 0::I32, fd);
+ if (ok != 0::CBool) (likely: True) {
+ jump stg_block_noregs();
+ } else {
+ jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ }
}
stg_waitWritezh ( W_ fd )
{
- ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
- /* IOWrite */ 1::I32, fd);
- jump stg_block_noregs();
+ CBool ok; /* Ok, or heap alloc failure. */
+
+ (ok) = ccall syncIOWaitReady(MyCapability() "ptr", CurrentTSO "ptr",
+ /* IOWrite */ 1::I32, fd);
+ if (ok != 0::CBool) (likely: True) {
+ jump stg_block_noregs();
+ } else {
+ jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ }
}
stg_delayzh ( W_ us_delay )
{
- ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay);
+ CBool ok; /* Ok, or heap alloc failure. */
- /* Annoyingly, we cannot be consistent with how we wait and resume the
- * blocked thread. The reason is that the win32 legacy I/O manager
- * allocates a StgAsyncIOResult struct on the C heap which has to be
- * freed when the thread resumes. It's a bit awkward to arrange to
- * allocate it on the GC heap instead, so that's how it is for now. Sigh.
- */
-#if defined(mingw32_HOST_OS)
- jump stg_block_async_void();
-#else
- jump stg_block_noregs();
-#endif
+ (ok) = ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay);
+
+ if (ok != 0::CBool) (likely: True) {
+ jump stg_block_noregs();
+ } else {
+ jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ }
}
#if defined(mingw32_HOST_OS)
stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf )
{
- W_ ares;
CInt reqID;
#if defined(THREADED_RTS)
ccall barf("asyncRead# on threaded RTS") never returns;
#else
- /* could probably allocate this on the heap instead */
- ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult,
- "stg_asyncReadzh");
(reqID) = ccall addIORequest(fd, 0/*FALSE*/,is_sock,len,buf "ptr");
- StgAsyncIOResult_reqID(ares) = reqID;
- StgAsyncIOResult_len(ares) = 0;
- StgAsyncIOResult_errCode(ares) = 0;
- StgTSO_block_info(CurrentTSO) = ares;
+ StgTSO_block_info(CurrentTSO) = reqID;
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32;
@@ -2620,21 +2621,14 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf )
stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf )
{
- W_ ares;
CInt reqID;
#if defined(THREADED_RTS)
ccall barf("asyncWrite# on threaded RTS") never returns;
#else
- ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult,
- "stg_asyncWritezh");
(reqID) = ccall addIORequest(fd, 1/*TRUE*/,is_sock,len,buf "ptr");
-
- StgAsyncIOResult_reqID(ares) = reqID;
- StgAsyncIOResult_len(ares) = 0;
- StgAsyncIOResult_errCode(ares) = 0;
- StgTSO_block_info(CurrentTSO) = ares;
+ StgTSO_block_info(CurrentTSO) = reqID;
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32;
@@ -2646,21 +2640,14 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf )
stg_asyncDoProczh ( W_ proc, W_ param )
{
- W_ ares;
CInt reqID;
#if defined(THREADED_RTS)
ccall barf("asyncDoProc# on threaded RTS") never returns;
#else
- /* could probably allocate this on the heap instead */
- ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult,
- "stg_asyncDoProczh");
(reqID) = ccall addDoProcRequest(proc "ptr",param "ptr");
- StgAsyncIOResult_reqID(ares) = reqID;
- StgAsyncIOResult_len(ares) = 0;
- StgAsyncIOResult_errCode(ares) = 0;
- StgTSO_block_info(CurrentTSO) = ares;
+ StgTSO_block_info(CurrentTSO) = reqID;
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32);
%release StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I32;
=====================================
rts/RtsSymbols.c
=====================================
@@ -30,6 +30,7 @@
#include