September 2026 - ghc-commits

[Git][ghc/ghc][wip/dcoutts/io-manager-io-primop-exceptions] 10 commits: rts: Fix missing memory barrier in eval_thunk_selector (#27477)
by Duncan Coutts (＠dcoutts) 09 Sep '26

09 Sep '26

Duncan Coutts pushed to branch wip/dcoutts/io-manager-io-primop-exceptions at Glasgow Haskell Compiler / GHC Commits: 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00 Reorder cmm decls in HeapStackCheck for a better logical grouping And put more section headers in to deliniate the groups. We're about to add more here, so better to organise it first. - - - - - 344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00 Add raisePrimIOException and add it to RTS<->ghc-internal API The raisePrimIOException is a new helper function that I/O primops will use to help them report I/O errors. This is implemented in Haskell (since that's a lot easier), but has a calling convention that is easy(ish) to use from Cmm in the I/O primops. So we add it to the RTS API struct, and since we'll use it from Cmm we also need a field accessor macro for cmm (in deriveConstants). See the Note about how we cannot have nice things due to async exceptions and thunks preventing us from using catch. - - - - - cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Add new blocking functions for I/O primops See the Note [Thread blocking for new I/O primops], and the Note [Calling convention for raisePrimIOException]. The point is, it will allow us to report synchronous exceptions from I/O primops, and do so much more flexibly. Previously the I/O managers could only report async exceptions and only nullary exceptions. This was OK historically, but no good as we add more I/O managers and expand the range of I/O operations we support. - - - - - f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Change the encoding of results from the I/O manager to I/O primops Previously we just had async continue or heap overflow. We now extend what we can report with synchronous success, and synchronous failure with an errno. See Note [Encoding of result of I/O manager operations] We don't use these two new cases yet, but we will. In particular an epoll I/O manager needs to be able to report synchronous success or failure for waitRead#/waitWrite#. - - - - - 30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Switch waitRead/Write# to use new blocking return frames and update the I/O managers to set the result before resuming the blocked threads. This makes it possible for I/O managers to report synchronous exceptions from the I/O primops, but that will be done in a subsequent commit. - - - - - a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00 Switch Poll and Select I/O managers to report sync exceptions rather than using raiseAsync with blockedOnBadFD_closure. This uses the new mechanism in the blocking frame return code to report synchronous exceptions. - - - - - 7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00 Remove now-unused blockedOnBadFD It was previously thrown by the select and poll I/O managers, but now they use raisePrimIOException (with an EBADF errno). - - - - - 6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Improve the docs for delay# waitRead# and waitWrite# Document that the waitRead/Write# can throw exceptions (this was true before too), and that all of them are async exception cancellation points. - - - - - 24 changed files: - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/Prelude.h - rts/PrimOps.cmm - rts/include/rts/RtsToHsIface.h - rts/include/stg/MiscClosures.h - rts/posix/Poll.c - rts/posix/Poll.h - rts/posix/Select.c - rts/sm/Evac.c - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - utils/check-exact/ExactPrint.hs - utils/deriveConstants/Main.hs Changes: ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -0,0 +1,10 @@ +section: rts +synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap +description: + On weakly-ordered architectures such as AArch64 programs using + could crash during parallel garbage collection (segmentation fault + or ``internal error: eval_thunk_selector: strange selectee <n>``) or + continue running with silently corrupted heap data, due to a missing + memory barrier in the parallel GC. +mrs: !16488 +issues: #27477 ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3305,21 +3305,28 @@ section "Delay/wait operations" primop DelayOp "delay#" GenPrimOp Int# -> State# s -> State# s - {Sleep specified number of microseconds.} + {Suspend the calling thread for a specified number of microseconds. This + operation is /interruptible/ by async exceptions.} with effect = ReadWriteEffect out_of_line = True primop WaitReadOp "waitRead#" GenPrimOp Int# -> State# s -> State# s - {Block until input is available on specified file descriptor.} + {Suspend the calling thread until input is available (or an I/O error + occurs) on the given file descriptor. This operation can throw exceptions + of type 'IOException'. The operation is also /interruptible/ by async + exceptions.} with effect = ReadWriteEffect out_of_line = True primop WaitWriteOp "waitWrite#" GenPrimOp Int# -> State# s -> State# s - {Block until output is possible on specified file descriptor.} + {Suspend the calling thread until output is possible (or an I/O error + occurs) on the given file descriptor. This operation can throw exceptions + of type 'IOException'. The operation is also /interruptible/ by async + exceptions.} with effect = ReadWriteEffect out_of_line = True ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass) ===================================== compiler/GHC/Hs/Extension/Pass.hs ===================================== @@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a -- but pass-independent, source location type XRecGhc a = GenLocated (Anno a) a +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (HsDocString (GhcPass _)) = SrcSpan type instance Anno HsDocStringChunk = SrcSpan ===================================== libraries/ghc-internal/include/RtsIfaceSymbols.h ===================================== @@ -23,15 +23,11 @@ CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure) -#if defined(mingw32_HOST_OS) -UNDEF_CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure) -#else -CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure) -#endif CLOSURE(GHCziInternalziConcziSync, runSparks_closure) CLOSURE(GHCziInternalziConcziIO, ensureIOManagerIsRunning_closure) CLOSURE(GHCziInternalziConcziIO, interruptIOManager_closure) CLOSURE(GHCziInternalziConcziIO, ioManagerCapabilitiesChanged_closure) +CLOSURE(GHCziInternalziConcziIO, raisePrimIOException_info) CLOSURE(GHCziInternalziConcziSignal, runHandlersPtr_closure) CLOSURE(GHCziInternalziTopHandler, flushStdHandles_closure) CLOSURE(GHCziInternalziTopHandler, runMainIO_closure) ===================================== libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs ===================================== @@ -56,13 +56,19 @@ module GHC.Internal.Conc.IO , win32ConsoleHandler , toWin32ConsoleEvent #endif + , raisePrimIOException -- exported for use within RTS ) where import GHC.Internal.Base import GHC.Internal.Conc.Sync as Sync import GHC.Internal.Err (errorWithoutStackTrace) +import GHC.Internal.Exception (SomeException, Exception(toException)) +import qualified GHC.Internal.Foreign.C.Error as C +import GHC.Internal.Foreign.C.Types (CInt) +import GHC.Internal.Maybe (Maybe(Nothing)) import GHC.Internal.STM as STM -import GHC.Internal.Prim (delay#, waitRead#, waitWrite#) +import GHC.Internal.Prim (Int#, State#, RealWorld, + delay#, waitRead#, waitWrite#, raiseIO#) import GHC.Internal.Real ( fromIntegral ) import GHC.Internal.System.Posix.Types @@ -249,3 +255,39 @@ registerDelay _usecs #if !defined(javascript_HOST_ARCH) foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool #endif + + +-- --------------------------------------------------------------------------- +-- PrimIOException + +-- FIXME: raisePrimIOException throws an IOException, which is not ideal. It is +-- not in a position to fill in most of the information for an IOException. +-- Much better would be to have a new PrimIOException exception type, and for +-- I/O primops to catch that and rethrow with the proper context. In particular +-- we do not have a proper location, since that's fundamantally something from +-- a higher level library. +-- +-- Unfortunately, catching and throwing converts async exceptions to sync ones. +-- This breaks any thunks that, via unsafePerformIO, use such operations. We +-- have tests that check for this, e.g. T26341a T26341b. Catching and rethrowing +-- here would break those tests. +-- +-- See issue #2558, #24189 and #26368. + +-- | Internal helper funtion used by the in-RTS I\/O managers for reporting +-- exceptions. Do not use directly. +-- +-- Do not change the type signature \/ ABI without updating the Cmm callers! +-- There is no signature checking for Cmm to Hs calls. +-- +raisePrimIOException :: Int# -> State# RealWorld -> (# State# RealWorld, a #) +raisePrimIOException errno# s = + let exception :: SomeException + exception = toException + (C.errnoToIOError "threadWaitRead/Write" + (toCErrno errno#) + Nothing Nothing) + in raiseIO# exception s + where + toCErrno :: Int# -> C.Errno + toCErrno e = C.Errno ((fromIntegral :: Int -> CInt) (I# e)) ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs ===================================== @@ -23,14 +23,13 @@ import GHC.Internal.Types () , closeFdWith , threadDelay , registerDelay - , blockedOnBadFD -- used by RTS ) where -- TODO: Use new Windows I/O manager import qualified GHC.Internal.Stack.Types as Rebindable import GHC.Internal.Base -import GHC.Internal.Control.Exception (finally, SomeException, toException) +import GHC.Internal.Control.Exception (finally) import GHC.Internal.Data.Foldable (forM_, mapM_, sequence_) import GHC.Internal.Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import GHC.Internal.Data.Maybe (fromMaybe) @@ -185,10 +184,6 @@ threadWait evt fd = mask_ $ do then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing else return () --- used at least by RTS in 'select()' IO manager backend -blockedOnBadFD :: SomeException -blockedOnBadFD = toException $ errnoToIOError "awaitEvent" eBADF Nothing Nothing - threadWaitSTM :: Event -> Fd -> IO (STM (), IO ()) threadWaitSTM evt fd = mask_ $ do m <- newTVarIO Nothing ===================================== rts/HeapStackCheck.cmm ===================================== @@ -20,6 +20,7 @@ import ReleaseSRWLockExclusives; #if !defined(UnregisterisedCompiler) import CLOSURE g0; import CLOSURE large_alloc_lim; +import CLOSURE ghc_hs_iface; import CLOSURE stg_MSG_THROWTO_info; import CLOSURE stg_MVAR_DIRTY_info; import CLOSURE stg_WHITEHOLE_info; @@ -40,6 +41,8 @@ import CLOSURE stg_ret_l_info; import CLOSURE stg_ret_n_info; import CLOSURE stg_ret_p_info; import CLOSURE stg_stack_save_entries; +import CLOSURE stg_block_io_unit_info; +import CLOSURE stg_block_io_int_info; #endif /* Stack/Heap Check Failure @@ -694,6 +697,37 @@ stg_block_putmvar (P_ mvar, P_ val) } } + +/* ----------------------------------------------------------------------------- + STM-specific waiting + -------------------------------------------------------------------------- */ + +stg_block_stmwait +{ + // When blocking on an MVar we have to be careful to only release + // the lock on the MVar at the very last moment (using + // BLOCK_BUT_FIRST()), since when we release the lock another + // Capability can wake up the thread, which modifies its stack and + // other state. This is not a problem for STM, because STM + // wakeups are non-destructive; the waker simply calls + // tryWakeupThread() which sends a message to the owner + // Capability. So the moment we release this lock we might start + // getting wakeup messages, but that's perfectly harmless. + // + // Furthermore, we *must* release these locks, just in case an + // exception is raised in this thread by + // maybePerformBlockedException() while exiting to the scheduler, + // which will abort the transaction, which needs to obtain a lock + // on all the TVars to remove the thread from the queues. + // + ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); + BLOCK_GENERIC; +} + +/* ----------------------------------------------------------------------------- + Blocks for blackholes and throwto + -------------------------------------------------------------------------- */ + stg_block_blackhole (P_ node) { Sp_adj(-2); @@ -730,6 +764,13 @@ stg_block_throwto (P_ tso, P_ exception) } } +/* ----------------------------------------------------------------------------- + Thread blocking for I/O primops + -------------------------------------------------------------------------- */ + +/* Thread blocking for primops used only by the win32-legacy I/O manager: + * asyncRead, asyncWrite and asyncDoProc. + */ #if defined(mingw32_HOST_OS) INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ len, W_ errCode ) return () @@ -751,32 +792,171 @@ stg_block_async Sp(2) = eintr; // errCode: interrupted BLOCK_GENERIC; } - #endif +/* Note [Thread blocking for new I/O primops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -/* ----------------------------------------------------------------------------- - STM-specific waiting - -------------------------------------------------------------------------- */ +The classic I/O primops are: -stg_block_stmwait + waitRead#, waitWrite# :: Int# -> State# s -> State# s + +Note that they have no result, with wrapper types returning IO (). Each one +simply suspends the calling thread until a condition occurs (I/O or time). + +Despite this external simplicity, internally there is more complexity with a +number of cases to handle: + +At submission time: + - synchronous failure, e.g. bad fd + - synchronous success, e.g. waiting on a regular file, which is always ready + - proceed asynchronously: block thread, return to scheduler + +Later, at I/O completion, I/O error, or async exception time: + - reported failure, e.g. stale fd + - success + +The waitRead/Write# also have non-reported failures, such as I/O errors, +but these are treated as the success case since these primops are defined to +wait for I/O or an error. We only report failures, via exceptions, for cases +where it would be unsafe to proceed with a subsequent I/O operation on the +same fd. In particular this includes when the fd was closed while a thread was +waiting on the fd (since it's very unsafe to read/write an fd that is closed or +worse: has been recycled to refer to a different file). + +The synchronous success and failure cases are handled by the initiating +primops. In the blocking case, it relies on one of these stg_block_ functions, +stack frames, and stack frame info table entry code. The key bits of the +mechanism are: + + - The stg_block_ cmm function sets up the stack frame for the blocked thread. + - The stack frame entries can be overwritten by the I/O manager, e.g. upon I/O + completion or error. + - The stack frame's info table entry code is invoked when the thread is + resumed. + - The entries in the stack frame become arguments to the info table entry code. + - The result(s) returned by the info table entry code _are_ the result(s) of + the I/O primop. + +It is important to keep clear the distinction between the stack frame entries +and the final primop result(s): the stack frame's info table entry code +transforms the former into the latter. + +The convention we follow is that the stack frame contains two fields: + - an outcome, using IOOpOutcome values: in-flight, success, failed, cancelled. + - a result or error code. For outcome success it is a result. For failed it is + the error code (using posix errno codes), while for cancelled and in-flight + outcomes there is no result. + +This outcome+result/failure encoding is exactly the same as the corresponding +fields in the StgAsyncIOOp. One day we might just use the StgAsyncIOOp itself, +once all I/O managers use them. + +The waitRead/waitWrite# primops do not use a result, but later I/O primops will +do. In particular read/write on files return a length, and other I/O primitives +also have a single result. + +So this gives us two block functions and corresponding info tables: + + 1. stg_block_io_unit: with a stack frame containing outcome+result/failure. + On resume, throw exception on failure and otherwise return no args. + This is for primops with result IO (). + + 2. stg_block_io_int: with a stack frame containing outcome+result/failure. + On resume, throw exception on failure and otherwise return result. + This is for primops with result IO Int or IO Word. + + 3. stg_block_io_aiop: in future if we add async I/O primitives that return an + StgAsyncIOOp we would also need versions that return that (since even + submitting async I/O can block if there's too much I/O in flight). + +The stack frame layout used is: + Sp[0] stg_block_io_unit_info or stg_block_io_int_info + Sp[1] outcome + Sp[2] result or error + +C code should use setTsoIOOpOutcome to set this. But update this if the layout +changes! + + +Note [Calling convention for raisePrimIOException] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In cases 1 & 2 we check the outcome and, on failure, we throw an exception. Our +approach is to use a helper function implemeted in generated Haskell code, in +ghc-internal. We need to perform a tail call to this helper function: + + raisePrimIOException :: Int# -> State# s -> (# State# s, a #) + +The calling convention for top-level generated Haskell function like this uses +R2 because it has two arguments -- the Int# and State# -- but the State# +argument has a zero-width repesentation. The cmm call uses R1, R2, ... etc so +to pass in R2 we have to use a dummy first argument which will be passed in R1 +(and ignored). +*/ + +/* stg_block_io_unit_info : the return info table for stg_block_io_unit */ +INFO_TABLE_RET ( stg_block_io_unit, RET_SMALL, W_ info_ptr, + W_ outcome, W_ result ) + return () { - // When blocking on an MVar we have to be careful to only release - // the lock on the MVar at the very last moment (using - // BLOCK_BUT_FIRST()), since when we release the lock another - // Capability can wake up the thread, which modifies its stack and - // other state. This is not a problem for STM, because STM - // wakeups are non-destructive; the waker simply calls - // tryWakeupThread() which sends a message to the owner - // Capability. So the moment we release this lock we might start - // getting wakeup messages, but that's perfectly harmless. - // - // Furthermore, we *must* release these locks, just in case an - // exception is raised in this thread by - // maybePerformBlockedException() while exiting to the scheduler, - // which will abort the transaction, which needs to obtain a lock - // on all the TVars to remove the thread from the queues. - // - ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr"); + if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; + dummyR1 = 0; + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, result); + } else { + /* success or cancelled outcomes */ + return (); + } +} + +/* Blocking for I/O primops with result IO (). + * See Note [Thread blocking for new I/O primops]. + */ +stg_block_io_unit +{ + /* Fill out the stack frame with dummy values. The IO manager will + * overwrite these with the actual results when the I/O operation + * completes, fails, or is cancelled. + */ + Sp_adj(-3); + Sp(0) = stg_block_io_unit_info; + Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight + Sp(2) = 0; // result/errno + BLOCK_GENERIC; +} + +/* stg_block_io_int_info : the return info table for stg_block_io_int */ +INFO_TABLE_RET ( stg_block_io_int, RET_SMALL, W_ info_ptr, + W_ outcome, W_ result ) + return () +{ + if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; + dummyR1 = 0; + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, result); + } else { + /* success or cancelled outcomes */ + return (result); + } +} + +/* Blocking for I/O primops with result IO Int or Word (or rather Int#/Word#). + * See Note [Thread blocking for new I/O primops]. + */ +stg_block_io_int +{ + /* Fill out the stack frame with dummy values. The IO manager will + * overwrite these with the actual results when the I/O operation + * completes, fails, or is cancelled. + */ + Sp_adj(-3); + Sp(0) = stg_block_io_int_info; + Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight + Sp(2) = 0; // result/errno BLOCK_GENERIC; } ===================================== rts/IOManager.c ===================================== @@ -399,21 +399,6 @@ void startIOManager(void) switch (iomgr_type) { -#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_POLL) -#if defined(IOMGR_ENABLED_SELECT) - case IO_MANAGER_SELECT: -#endif -#if defined(IOMGR_ENABLED_POLL) - case IO_MANAGER_POLL: -#endif - /* Make the exception CAF a GC root. See initBuiltinGcRoots for - * similar examples. We throw this exception if a thread tries to - * wait on an invalid FD. - */ - getStablePtr((StgPtr)blockedOnBadFD_closure); - break; -#endif - #if defined(IOMGR_ENABLED_MIO_POSIX) case IO_MANAGER_MIO_POSIX: /* Posix implementation in posix/Signals.c @@ -776,10 +761,10 @@ void interruptIOManager(CapIOManager *iomgr) /* CMM primop. Result is true on success, or false on allocation failure. */ -bool syncIOWaitReady(CapIOManager *iomgr, - StgTSO *tso, - IOReadOrWrite rw, - HsInt fd) +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, + StgTSO *tso, + IOReadOrWrite rw, + HsInt fd) { debugTrace(DEBUG_iomanager, "thread %ld waiting for %s I/O readiness on fd %d", @@ -795,7 +780,7 @@ bool syncIOWaitReady(CapIOManager *iomgr, tso->block_info.fd = fd; appendToIOBlockedQueue(iomgr, tso); RELEASE_STORE(&tso->why_blocked, why_blocked); - return true; + return IOSubmitResultAsyncContinue; } #endif #if defined(IOMGR_ENABLED_POLL) ===================================== rts/IOManager.h ===================================== @@ -325,8 +325,33 @@ typedef enum { IORead = 0, IOWrite = 1 } IOReadOrWrite; * false on heap allocation failure. */ +/* Note [Encoding of result of I/O manager operations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We have quite a bit of information that to return from the I/O manager calls +back to the I/O primops. It (somewhat uncomfortably) fits into a C int. + +We use the following encoding of the result: + + * negative: synchronous failure, with -errno as the result. + * 0: ok, result successful, proceed to async: suspend the TSO. + * 1: synchronous success, return without suspending the TSO. This can occur + for example when waiting on readiness of a regular file (which is always + ready). + * 2: heap overflow + * >2: unallocated status codes +*/ +typedef int IOSubmitResult; + +/* Provide constants for IOSubmitResult */ +enum IOSubmitResultCodes { + /* negative numbers are -errno error codes */ + IOSubmitResultAsyncContinue = 0, + IOSubmitResultSyncSuccess = 1, + IOSubmitResultHeapOverflow = 2 +}; + /* Called from CMM primop */ -bool syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd); +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd); void syncIOCancel(CapIOManager *iomgr, StgTSO *tso); ===================================== rts/IOManagerInternals.h ===================================== @@ -81,5 +81,25 @@ struct _CapIOManager { }; +/* Fill in the outcome and result/error on the TSO's stack frame. + * The TSO must be blocked using one of the stg_block_io_* blocking actions. + * + * Once the thread is resumed (by the scheduler) the code for stg_block_*_info + * will pick up the info from the stack frame and use it to see if there's been + * a failure, and if so to raise a PrimIOException. + * + * See Note [Thread blocking for new I/O primops]. + */ +INLINE_HEADER void setTsoIOOpOutcome (StgTSO *tso, + enum IOOpOutcome outcome, + uint32_t result) +{ + ASSERT((StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_unit_info + || (StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_int_info); + + tso->stackobj->sp[1] = (W_)outcome; + tso->stackobj->sp[2] = (W_)result; +} + #include "EndPrivate.h" ===================================== rts/Prelude.h ===================================== @@ -65,8 +65,6 @@ extern StgClosure ZCMain_main_closure; #define overflowException_closure ghc_hs_iface->overflowException_closure #define divZeroException_closure ghc_hs_iface->divZZeroException_closure -#define blockedOnBadFD_closure ghc_hs_iface->blockedOnBadFD_closure - #define Czh_con_info ghc_hs_iface->Czh_con_info #define Izh_con_info ghc_hs_iface->Izh_con_info #define Fzh_con_info ghc_hs_iface->Fzh_con_info ===================================== rts/PrimOps.cmm ===================================== @@ -2297,32 +2297,60 @@ stg_whereFromzh (P_ clos, W_ buf) Thread I/O blocking primitives -------------------------------------------------------------------------- */ -stg_waitReadzh ( W_ fd ) +stg_handleIOSubmitResult ( CInt result ) { - CBool ok; /* Ok, or heap alloc failure. */ + /* See Note [Encoding of result of I/O manager operations] */ - (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", - CurrentTSO "ptr", - /* IORead */ 0::CInt, fd); - if (ok != 0::CBool) (likely: True) { - jump stg_block_noregs(); - } else { + /* case IOSubmitResultAsyncContinue */ + if (result == 0::CInt) (likely: True) { + /* See Note [Thread blocking for new I/O primops] */ + jump stg_block_io_unit(); + } + + /* case IOSubmitResultSyncSuccess*/ + if (result == 1::CInt) (likely: True) { + /* Success, don't even go via scheduler. */ + return (); + } + + /* negative numbers are -errno error codes */ + if (result < 0::CInt) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; W_ errno; + dummyR1 = 0; + errno = TO_W_(-result); + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, errno); + } + + /* case IOSubmitResultHeapOverflow */ + if (result == 2::CInt) { jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); + } + ccall sbarf("syncIOWaitReady result encoding error") never returns; +} + +stg_waitReadzh ( W_ fd ) +{ + CInt result; + + (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", + CurrentTSO "ptr", + /* IORead */ 0::CInt, fd); + + jump stg_handleIOSubmitResult(result); } stg_waitWritezh ( W_ fd ) { - CBool ok; /* Ok, or heap alloc failure. */ + CInt result; - (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", - CurrentTSO "ptr", - /* IOWrite */ 1::CInt, fd); - if (ok != 0::CBool) (likely: True) { - jump stg_block_noregs(); - } else { - jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); - } + (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", + CurrentTSO "ptr", + /* IOWrite */ 1::CInt, fd); + + jump stg_handleIOSubmitResult(result); } stg_delayzh ( W_ us_delay ) ===================================== rts/include/rts/RtsToHsIface.h ===================================== @@ -28,7 +28,7 @@ typedef struct { StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure - StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure + StgClosure *raisePrimIOException_info; // GHC.Internal.Conc.IO.raisePrimIOException_info StgClosure *runSparks_closure; // GHC.Internal.Conc.Sync.runSparks_closure StgClosure *ensureIOManagerIsRunning_closure; // GHC.Internal.Conc.IO.ensureIOManagerIsRunning_closure StgClosure *interruptIOManager_closure; // GHC.Internal.Conc.IO.interruptIOManager_closure ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -369,6 +369,7 @@ RTS_FUN_DECL(stg_gc_bpp); RTS_RET(stg_gc_fun); RTS_FUN_DECL(__stg_gc_fun); +/* Blocking for various primops */ RTS_FUN_DECL(stg_yield_noregs); RTS_FUN_DECL(stg_yield_to_interpreter); RTS_FUN_DECL(stg_block_noregs); @@ -380,13 +381,19 @@ RTS_RET(stg_block_takemvar); RTS_RET(stg_block_readmvar); RTS_FUN_DECL(stg_block_putmvar); RTS_RET(stg_block_putmvar); +RTS_FUN_DECL(stg_block_stmwait); +RTS_FUN_DECL(stg_block_throwto); +RTS_RET(stg_block_throwto); + +/* Blocking for I/O primops */ +RTS_FUN_DECL(stg_block_io_unit); +RTS_RET(stg_block_io_unit); +RTS_FUN_DECL(stg_block_io_int); +RTS_RET(stg_block_io_int); #if defined(mingw32_HOST_OS) RTS_FUN_DECL(stg_block_async); RTS_RET(stg_block_async); #endif -RTS_FUN_DECL(stg_block_stmwait); -RTS_FUN_DECL(stg_block_throwto); -RTS_RET(stg_block_throwto); /* Entry/exit points from StgStartup.cmm */ ===================================== rts/posix/Poll.c ===================================== @@ -20,7 +20,6 @@ #include "Prelude.h" #include "RtsUtils.h" #include "rts/Time.h" -#include "RaiseAsync.h" #include "Trace.h" #include "Poll.h" @@ -171,14 +170,13 @@ void freeCapabilityIOManagerPoll(CapIOManager *iomgr) } -/* Used to implement syncIOWaitReady. - * Result is true on success, or false on allocation failure. */ -bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd) +/* Used to implement syncIOWaitReady. */ +IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, + IOReadOrWrite rw, HsInt fd) { StgAsyncIOOp *aiop; aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp)); - if (RTS_UNLIKELY(aiop == NULL)) return false; + if (RTS_UNLIKELY(aiop == NULL)) return IOSubmitResultHeapOverflow; SET_HDR(aiop, &stg_ASYNCIOOP_info, iomgr->cap->r.rCCCS); aiop->notify.tso = tso; aiop->notify_type = NotifyTSO; @@ -189,13 +187,12 @@ bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd); } -/* Result is true on success, or false on allocation failure. */ -bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd) +IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, + IOReadOrWrite rw, int fd) { if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) { bool ok = enlargeTables(iomgr); - if (RTS_UNLIKELY(!ok)) return false; + if (RTS_UNLIKELY(!ok)) return IOSubmitResultHeapOverflow; } int ix = insertClosureTable(iomgr->cap, &iomgr->aiop_table, aiop); @@ -216,7 +213,7 @@ bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, .events = rw == IORead ? POLLIN : POLLOUT, .revents = 0 }; - return true; + return IOSubmitResultAsyncContinue; } @@ -226,6 +223,7 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso) ASSERT(aiop->notify_type == NotifyTSO); ASSERT(indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop); ioCancel(iomgr, aiop); + setTsoIOOpOutcome(tso, aiop->outcome, aiop->result); /* We cannot use the normal notifyIOCompletion here. We are in the context * of throwTo, interrupting a thread blocked on IO via an async exception. * We don't put the TSO back on the run queue or change the why_blocked @@ -284,26 +282,18 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) switch (aiop->notify_type) { case NotifyTSO: { - if (aiop->outcome == IOOpOutcomeFailed && aiop->error == EBADF) { - /* The fd is invalid: raise an IOError exception in the blocked - * thread. (See bug #4934 for what happens without this.) - */ - StgTSO *tso = aiop->notify.tso; - debugTrace(DEBUG_iomanager, - "Raising exception in thread %" FMT_StgThreadID - " blocked on an invalid fd", tso->id); - raiseAsync(iomgr->cap, tso, - (StgClosure *)blockedOnBadFD_closure, - false, NULL); - } else { - /* We should be guaranteed that the tso is still on the same - * cap because the tso was not on the run queue of any cap and - * so is not subject to thread migration. - */ - StgTSO *tso = aiop->notify.tso; - pushOnRunQueue(iomgr->cap, tso); - RELEASE_STORE(&tso->why_blocked, NotBlocked); - } + /* We should be guaranteed that the tso is still on the same + * cap because the tso was not on the run queue of any cap and + * so is not subject to thread migration. + */ + StgTSO *tso = aiop->notify.tso; + ASSERT(tso->cap == iomgr->cap); + + /* Fill in the outcome and result/error on the TSO's stack frame */ + setTsoIOOpOutcome(tso, aiop->outcome, aiop->result); + pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); + /* For the TSO case, the aiop was only reachable from the TSO * itself, and thus it is now no longer be reachable at all. */ ===================================== rts/posix/Poll.h ===================================== @@ -20,13 +20,13 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr); void freeCapabilityIOManagerPoll(CapIOManager *iomgr); /* Synchronous I/O and timer operations */ -bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd); +IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, + IOReadOrWrite rw, HsInt fd); void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso); /* Asynchronous operations */ -bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd); +IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, + IOReadOrWrite rw, int fd); void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop); /* Scheduler operations */ ===================================== rts/posix/Select.c ===================================== @@ -15,7 +15,6 @@ #include "Signals.h" #include "Schedule.h" #include "Prelude.h" -#include "RaiseAsync.h" #include "RtsUtils.h" #include "Capability.h" #include "Select.h" @@ -480,13 +479,18 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) IF_DEBUG(scheduler, debugBelch("Killing blocked thread %" FMT_StgThreadID " on bad fd=%i\n", tso->id, fd)); - raiseAsync(iomgr->cap, tso, - (StgClosure *)blockedOnBadFD_closure, false, NULL); + + /* Fill in the outcome and error on the TSO's stack frame */ + setTsoIOOpOutcome(tso, IOOpOutcomeFailed, EBADF); + pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; case RTS_FD_IS_READY: IF_DEBUG(scheduler, debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); + /* Fill in the outcome and result on the TSO's stack frame */ + setTsoIOOpOutcome(tso, IOOpOutcomeSuccess, 0); pushOnRunQueue(iomgr->cap,tso); RELEASE_STORE(&tso->why_blocked, NotBlocked); break; ===================================== rts/sm/Evac.c ===================================== @@ -1361,7 +1361,11 @@ selector_loop: // from-space during marking, for example. We rely on the property // that evacuate() doesn't mind if it gets passed a to-space pointer. - info = RELAXED_LOAD((StgInfoTable**) &selectee->header.info); + // NB. this load must be ordered: the selectee may be updated + // concurrently by another GC thread's unchain_thunk_selectors(), + // which publishes an indirection by writing the indirectee and + // then RELEASE-storing the info pointer. See #27477. + info = ACQUIRE_LOAD((StgInfoTable**) &selectee->header.info); if (IS_FORWARDING_PTR(info)) { // We don't follow pointers into to-space; the constructor ===================================== testsuite/tests/rts/T27477.hs ===================================== @@ -0,0 +1,169 @@ +{-# LANGUAGE BangPatterns #-} + +-- Stress test for #27477: missing ACQUIRE in eval_thunk_selector +-- (rts/sm/Evac.c). +-- +-- With the bug present this test crashes or reports value mismatches +-- within a few seconds on AArch64; on strongly-ordered targets +-- it just passes. + +module Main (main) where + +import Control.Concurrent +import Control.Exception +import Control.Monad +import Data.IORef +import System.Environment +import System.Exit +import System.IO +import System.Mem (performMinorGC) + +data T = T { nxt :: T, val :: !Int } + +-- expected values and the cells that should evaluate to them +type Batch = ([Int], [T]) + +tailD, branchD, branchesPerCell :: Int +tailD = 12 -- shared tail length per cluster +branchD = 3 -- private branch length +branchesPerCell = 2 +-- tailD + branchD must stay below MAX_THUNK_SELECTOR_DEPTH (16) + +{-# NOINLINE spineEnd #-} +spineEnd :: T +spineEnd = errorWithoutStackTrace "spine end reached" + +-- Fully evaluated spine of constructors; cell i from the head has val i+1. +buildSpine :: Int -> IO T +buildSpine len = evaluate (go len (T spineEnd 0)) + where + go :: Int -> T -> T + go 0 acc = acc + go k acc = go (k - 1) (T acc k) + +-- k selector thunks, shallow-first: cell i selects from cell i-1, +-- cell 0 selects from t. If t evaluates to spine cell m (val m+1), +-- cell i evaluates to spine cell m+1+i (val m+2+i). +{-# NOINLINE selChain #-} +selChain :: Int -> T -> [T] +selChain 0 _ = [] +selChain k t = let t' = nxt t in t' : selChain (k - 1) t' + +lenL :: [a] -> Int +lenL = go 0 + where + go !n [] = n + go !n (_ : xs) = go (n + 1) xs + +everyN :: Int -> [a] -> [a] +everyN _ [] = [] +everyN n (x : xs) = x : everyN n (drop (n - 1) xs) + +-- One branch hanging off tail cell tj (which evaluates to val jval): +-- branch cell i evaluates to jval+1+i. Returned deepest-first. +{-# NOINLINE mkBranch #-} +mkBranch :: Int -> T -> IO Batch +mkBranch jval tj = do + let cells = selChain branchD tj + _ <- evaluate (lenL cells) + let expected = [ jval + 1 + i | i <- [0 .. branchD - 1] ] + pure (reverse expected, reverse cells) + +-- A cluster: one private spine, one shared tail of selectors over it, +-- branchesPerCell branches of selectors converging on every tail cell. +-- Neither the spine nor the tail is returned: they must stay reachable +-- only through the branch selectors. +buildCluster :: IO [Batch] +buildCluster = do + sp <- buildSpine (tailD + branchD + 4) + let tails = selChain tailD sp + _ <- evaluate (lenL tails) + bss <- forM (zip [0 ..] tails) $ \(j, tj) -> + replicateM branchesPerCell (mkBranch (j + 2) tj) + pure (concat bss) + +verifyBatch :: IORef Int -> Int -> Batch -> IO () +verifyBatch errs wid (es0, ts0) = go es0 ts0 + where + go (e : es) (t : ts) = do + v <- evaluate (val t) + when (v /= e) $ do + hPutStrLn stderr $ + "MISMATCH worker=" ++ show wid + ++ " expected=" ++ show e ++ " got=" ++ show v + modifyIORef' errs (+ 1) + go es ts + go _ _ = pure () + +-- simple cyclic barrier +newtype Barrier = Barrier (MVar (Int, [MVar ()])) + +newBarrier :: IO Barrier +newBarrier = Barrier <$> newMVar (0, []) + +awaitBarrier :: Barrier -> Int -> IO () +awaitBarrier (Barrier st) total = do + w <- newEmptyMVar + join $ modifyMVar st $ \(k, ws) -> + if k + 1 == total + then pure ((0, []), mapM_ (\m -> putMVar m ()) ws) + else pure ((k + 1, w : ws), takeMVar w) + +worker :: Int -> Int -> Int -> Barrier -> [IORef [Batch]] -> IORef Int -> Int -> IO () +worker rounds clusters nWorkers bar slots errs wid = + forM_ [1 .. rounds] $ \(_r :: Int) -> do + -- build fresh selector clusters, publish them + batches <- concat <$> replicateM clusters buildCluster + writeIORef (slots !! wid) batches + awaitBarrier bar nWorkers + -- root each branch's deepest cell via fresh cons cells in our own + -- nursery (so our GC thread evacuates the shared cells itself), in + -- a per-worker interleaved order so that different GC threads + -- sweep different branches of the same shared tails concurrently + published <- mapM readIORef slots + let allBatches = concat published + ordered + | nWorkers > 1 = + concat [ everyN nWorkers (drop ((wid + k) `mod` nWorkers) allBatches) + | k <- [0 .. nWorkers - 1] ] + | otherwise = allBatches + deepTs = [ t | (_, t : _) <- ordered ] + deepEs = [ e | (e : _, _) <- ordered ] + _ <- evaluate (lenL deepTs) + _ <- evaluate (lenL deepEs) + awaitBarrier bar nWorkers + -- run a parallel GC with everything live + when (wid == 0) performMinorGC + awaitBarrier bar nWorkers + -- force everything and check the values + verifyBatch errs wid (deepEs, deepTs) + awaitBarrier bar nWorkers + +main :: IO () +main = do + hSetBuffering stderr LineBuffering + args <- getArgs + let atDef d i = if length args > i then read (args !! i) else d + rounds = atDef 600 0 + clusters = atDef 48 1 + n <- getNumCapabilities + bar <- newBarrier + slots <- replicateM n (newIORef []) + errs <- newIORef 0 + dones <- forM [0 .. n - 1] $ \i -> do + done <- newEmptyMVar + _ <- forkOn i $ + (worker rounds clusters n bar slots errs i >> putMVar done Nothing) + `catch` \e -> putMVar done (Just (e :: SomeException)) + pure done + results <- mapM takeMVar dones + forM_ results $ \r -> case r of + Just e -> do + hPutStrLn stderr ("worker exception: " ++ show e) + exitWith (ExitFailure 2) + Nothing -> pure () + ec <- readIORef errs + when (ec > 0) $ do + hPutStrLn stderr ("FAILED: " ++ show ec ++ " mismatches") + exitWith (ExitFailure 2) + putStrLn "OK" ===================================== testsuite/tests/rts/T27477.stdout ===================================== @@ -0,0 +1 @@ +OK ===================================== testsuite/tests/rts/all.T ===================================== @@ -720,3 +720,12 @@ test('T27585', , extra_run_opts('+RTS -i0 -RTS') ], compile_and_run, ['-O -rtsopts']) + +test('T27477', + [ extra_run_opts('600 24 +RTS -N4 -A1m -RTS') + , req_ghc_smp + , req_target_smp + , only_ways(['threaded1', 'threaded2']) + ], + compile_and_run, ['-O2']) + ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3404,13 +3404,13 @@ instance ExactPrint (HsCmd GhcPs) where e' <- markAnnotated e return (HsCmdLet (tkLet', tkIn') binds' e') - exact (HsCmdDo (an0,loc) (L l es)) = do + exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" (an1,es') <- markAnnList' an0 $ do - ee <- mapM markAnnotated es + ee <- markAnnotated es return ee - return (HsCmdDo (an1,loc') (L l es')) + return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- @@ -4508,10 +4508,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" ls' <- markAnnotated ls - initStmts' <- markAnnotated initStmts + initStmts' <- mapM markAnnotated initStmts return (initStmts' ++ [ls']) _ -> do - stmts' <- markAnnotated stmts + stmts' <- mapM markAnnotated stmts return stmts' instance ExactPrint [Located HsDocStringChunk] where ===================================== utils/deriveConstants/Main.hs ===================================== @@ -644,6 +644,7 @@ wanteds os = concat ,structField C "HsIface" "divZZeroException_closure" ,structField C "HsIface" "underflowException_closure" ,structField C "HsIface" "overflowException_closure" + ,structField C "HsIface" "raisePrimIOException_info" ,structField C "HsIface" "unpackCStringzh_info" ,structField C "HsIface" "unpackCStringUtf8zh_info" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/578393f9673cb8b173d01b08aee160… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/578393f9673cb8b173d01b08aee160… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/dcoutts/io-manager-io-primop-exceptions] 6 commits: Add new blocking functions for I/O primops
by Duncan Coutts (＠dcoutts) 09 Sep '26

09 Sep '26

Duncan Coutts pushed to branch wip/dcoutts/io-manager-io-primop-exceptions at Glasgow Haskell Compiler / GHC Commits: 2147745b by Duncan Coutts at 2026-09-09T11:02:10+01:00 Add new blocking functions for I/O primops See the Note [Thread blocking for new I/O primops], and the Note [Calling convention for raisePrimIOException]. The point is, it will allow us to report synchronous exceptions from I/O primops, and do so much more flexibly. Previously the I/O managers could only report async exceptions and only nullary exceptions. This was OK historically, but no good as we add more I/O managers and expand the range of I/O operations we support. - - - - - f4fe3c3b by Duncan Coutts at 2026-09-09T11:03:18+01:00 Change the encoding of results from the I/O manager to I/O primops Previously we just had async continue or heap overflow. We now extend what we can report with synchronous success, and synchronous failure with an errno. See Note [Encoding of result of I/O manager operations] We don't use these two new cases yet, but we will. In particular an epoll I/O manager needs to be able to report synchronous success or failure for waitRead#/waitWrite#. - - - - - 35cbe01e by Duncan Coutts at 2026-09-09T11:03:18+01:00 Switch waitRead/Write# to use new blocking return frames and update the I/O managers to set the result before resuming the blocked threads. This makes it possible for I/O managers to report synchronous exceptions from the I/O primops, but that will be done in a subsequent commit. - - - - - 0ceec183 by Duncan Coutts at 2026-09-09T11:03:18+01:00 Switch Poll and Select I/O managers to report sync exceptions rather than using raiseAsync with blockedOnBadFD_closure. This uses the new mechanism in the blocking frame return code to report synchronous exceptions. - - - - - 7d7b4a99 by Duncan Coutts at 2026-09-09T11:03:18+01:00 Remove now-unused blockedOnBadFD It was previously thrown by the select and poll I/O managers, but now they use raisePrimIOException (with an EBADF errno). - - - - - 578393f9 by Duncan Coutts at 2026-09-09T11:03:19+01:00 Improve the docs for delay# waitRead# and waitWrite# Document that the waitRead/Write# can throw exceptions (this was true before too), and that all of them are async exception cancellation points. - - - - - 14 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/Prelude.h - rts/PrimOps.cmm - rts/include/rts/RtsToHsIface.h - rts/include/stg/MiscClosures.h - rts/posix/Poll.c - rts/posix/Poll.h - rts/posix/Select.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3305,21 +3305,28 @@ section "Delay/wait operations" primop DelayOp "delay#" GenPrimOp Int# -> State# s -> State# s - {Sleep specified number of microseconds.} + {Suspend the calling thread for a specified number of microseconds. This + operation is /interruptible/ by async exceptions.} with effect = ReadWriteEffect out_of_line = True primop WaitReadOp "waitRead#" GenPrimOp Int# -> State# s -> State# s - {Block until input is available on specified file descriptor.} + {Suspend the calling thread until input is available (or an I/O error + occurs) on the given file descriptor. This operation can throw exceptions + of type 'IOException'. The operation is also /interruptible/ by async + exceptions.} with effect = ReadWriteEffect out_of_line = True primop WaitWriteOp "waitWrite#" GenPrimOp Int# -> State# s -> State# s - {Block until output is possible on specified file descriptor.} + {Suspend the calling thread until output is possible (or an I/O error + occurs) on the given file descriptor. This operation can throw exceptions + of type 'IOException'. The operation is also /interruptible/ by async + exceptions.} with effect = ReadWriteEffect out_of_line = True ===================================== libraries/ghc-internal/include/RtsIfaceSymbols.h ===================================== @@ -23,11 +23,6 @@ CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure) CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure) -#if defined(mingw32_HOST_OS) -UNDEF_CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure) -#else -CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure) -#endif CLOSURE(GHCziInternalziConcziSync, runSparks_closure) CLOSURE(GHCziInternalziConcziIO, ensureIOManagerIsRunning_closure) CLOSURE(GHCziInternalziConcziIO, interruptIOManager_closure) ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs ===================================== @@ -23,14 +23,13 @@ import GHC.Internal.Types () , closeFdWith , threadDelay , registerDelay - , blockedOnBadFD -- used by RTS ) where -- TODO: Use new Windows I/O manager import qualified GHC.Internal.Stack.Types as Rebindable import GHC.Internal.Base -import GHC.Internal.Control.Exception (finally, SomeException, toException) +import GHC.Internal.Control.Exception (finally) import GHC.Internal.Data.Foldable (forM_, mapM_, sequence_) import GHC.Internal.Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import GHC.Internal.Data.Maybe (fromMaybe) @@ -185,10 +184,6 @@ threadWait evt fd = mask_ $ do then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing else return () --- used at least by RTS in 'select()' IO manager backend -blockedOnBadFD :: SomeException -blockedOnBadFD = toException $ errnoToIOError "awaitEvent" eBADF Nothing Nothing - threadWaitSTM :: Event -> Fd -> IO (STM (), IO ()) threadWaitSTM evt fd = mask_ $ do m <- newTVarIO Nothing ===================================== rts/HeapStackCheck.cmm ===================================== @@ -20,6 +20,7 @@ import ReleaseSRWLockExclusives; #if !defined(UnregisterisedCompiler) import CLOSURE g0; import CLOSURE large_alloc_lim; +import CLOSURE ghc_hs_iface; import CLOSURE stg_MSG_THROWTO_info; import CLOSURE stg_MVAR_DIRTY_info; import CLOSURE stg_WHITEHOLE_info; @@ -40,6 +41,8 @@ import CLOSURE stg_ret_l_info; import CLOSURE stg_ret_n_info; import CLOSURE stg_ret_p_info; import CLOSURE stg_stack_save_entries; +import CLOSURE stg_block_io_unit_info; +import CLOSURE stg_block_io_int_info; #endif /* Stack/Heap Check Failure @@ -791,3 +794,169 @@ stg_block_async } #endif +/* Note [Thread blocking for new I/O primops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The classic I/O primops are: + + waitRead#, waitWrite# :: Int# -> State# s -> State# s + +Note that they have no result, with wrapper types returning IO (). Each one +simply suspends the calling thread until a condition occurs (I/O or time). + +Despite this external simplicity, internally there is more complexity with a +number of cases to handle: + +At submission time: + - synchronous failure, e.g. bad fd + - synchronous success, e.g. waiting on a regular file, which is always ready + - proceed asynchronously: block thread, return to scheduler + +Later, at I/O completion, I/O error, or async exception time: + - reported failure, e.g. stale fd + - success + +The waitRead/Write# also have non-reported failures, such as I/O errors, +but these are treated as the success case since these primops are defined to +wait for I/O or an error. We only report failures, via exceptions, for cases +where it would be unsafe to proceed with a subsequent I/O operation on the +same fd. In particular this includes when the fd was closed while a thread was +waiting on the fd (since it's very unsafe to read/write an fd that is closed or +worse: has been recycled to refer to a different file). + +The synchronous success and failure cases are handled by the initiating +primops. In the blocking case, it relies on one of these stg_block_ functions, +stack frames, and stack frame info table entry code. The key bits of the +mechanism are: + + - The stg_block_ cmm function sets up the stack frame for the blocked thread. + - The stack frame entries can be overwritten by the I/O manager, e.g. upon I/O + completion or error. + - The stack frame's info table entry code is invoked when the thread is + resumed. + - The entries in the stack frame become arguments to the info table entry code. + - The result(s) returned by the info table entry code _are_ the result(s) of + the I/O primop. + +It is important to keep clear the distinction between the stack frame entries +and the final primop result(s): the stack frame's info table entry code +transforms the former into the latter. + +The convention we follow is that the stack frame contains two fields: + - an outcome, using IOOpOutcome values: in-flight, success, failed, cancelled. + - a result or error code. For outcome success it is a result. For failed it is + the error code (using posix errno codes), while for cancelled and in-flight + outcomes there is no result. + +This outcome+result/failure encoding is exactly the same as the corresponding +fields in the StgAsyncIOOp. One day we might just use the StgAsyncIOOp itself, +once all I/O managers use them. + +The waitRead/waitWrite# primops do not use a result, but later I/O primops will +do. In particular read/write on files return a length, and other I/O primitives +also have a single result. + +So this gives us two block functions and corresponding info tables: + + 1. stg_block_io_unit: with a stack frame containing outcome+result/failure. + On resume, throw exception on failure and otherwise return no args. + This is for primops with result IO (). + + 2. stg_block_io_int: with a stack frame containing outcome+result/failure. + On resume, throw exception on failure and otherwise return result. + This is for primops with result IO Int or IO Word. + + 3. stg_block_io_aiop: in future if we add async I/O primitives that return an + StgAsyncIOOp we would also need versions that return that (since even + submitting async I/O can block if there's too much I/O in flight). + +The stack frame layout used is: + Sp[0] stg_block_io_unit_info or stg_block_io_int_info + Sp[1] outcome + Sp[2] result or error + +C code should use setTsoIOOpOutcome to set this. But update this if the layout +changes! + + +Note [Calling convention for raisePrimIOException] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In cases 1 & 2 we check the outcome and, on failure, we throw an exception. Our +approach is to use a helper function implemeted in generated Haskell code, in +ghc-internal. We need to perform a tail call to this helper function: + + raisePrimIOException :: Int# -> State# s -> (# State# s, a #) + +The calling convention for top-level generated Haskell function like this uses +R2 because it has two arguments -- the Int# and State# -- but the State# +argument has a zero-width repesentation. The cmm call uses R1, R2, ... etc so +to pass in R2 we have to use a dummy first argument which will be passed in R1 +(and ignored). +*/ + +/* stg_block_io_unit_info : the return info table for stg_block_io_unit */ +INFO_TABLE_RET ( stg_block_io_unit, RET_SMALL, W_ info_ptr, + W_ outcome, W_ result ) + return () +{ + if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; + dummyR1 = 0; + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, result); + } else { + /* success or cancelled outcomes */ + return (); + } +} + +/* Blocking for I/O primops with result IO (). + * See Note [Thread blocking for new I/O primops]. + */ +stg_block_io_unit +{ + /* Fill out the stack frame with dummy values. The IO manager will + * overwrite these with the actual results when the I/O operation + * completes, fails, or is cancelled. + */ + Sp_adj(-3); + Sp(0) = stg_block_io_unit_info; + Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight + Sp(2) = 0; // result/errno + BLOCK_GENERIC; +} + +/* stg_block_io_int_info : the return info table for stg_block_io_int */ +INFO_TABLE_RET ( stg_block_io_int, RET_SMALL, W_ info_ptr, + W_ outcome, W_ result ) + return () +{ + if (outcome == 2 :: W_ /*IOOpOutcomeFailed*/) (likely: False) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; + dummyR1 = 0; + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, result); + } else { + /* success or cancelled outcomes */ + return (result); + } +} + +/* Blocking for I/O primops with result IO Int or Word (or rather Int#/Word#). + * See Note [Thread blocking for new I/O primops]. + */ +stg_block_io_int +{ + /* Fill out the stack frame with dummy values. The IO manager will + * overwrite these with the actual results when the I/O operation + * completes, fails, or is cancelled. + */ + Sp_adj(-3); + Sp(0) = stg_block_io_int_info; + Sp(1) = 0; // outcome: 0 indicates IOOpOutcomeInFlight + Sp(2) = 0; // result/errno + BLOCK_GENERIC; +} ===================================== rts/IOManager.c ===================================== @@ -399,21 +399,6 @@ void startIOManager(void) switch (iomgr_type) { -#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_POLL) -#if defined(IOMGR_ENABLED_SELECT) - case IO_MANAGER_SELECT: -#endif -#if defined(IOMGR_ENABLED_POLL) - case IO_MANAGER_POLL: -#endif - /* Make the exception CAF a GC root. See initBuiltinGcRoots for - * similar examples. We throw this exception if a thread tries to - * wait on an invalid FD. - */ - getStablePtr((StgPtr)blockedOnBadFD_closure); - break; -#endif - #if defined(IOMGR_ENABLED_MIO_POSIX) case IO_MANAGER_MIO_POSIX: /* Posix implementation in posix/Signals.c @@ -776,10 +761,10 @@ void interruptIOManager(CapIOManager *iomgr) /* CMM primop. Result is true on success, or false on allocation failure. */ -bool syncIOWaitReady(CapIOManager *iomgr, - StgTSO *tso, - IOReadOrWrite rw, - HsInt fd) +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, + StgTSO *tso, + IOReadOrWrite rw, + HsInt fd) { debugTrace(DEBUG_iomanager, "thread %ld waiting for %s I/O readiness on fd %d", @@ -795,7 +780,7 @@ bool syncIOWaitReady(CapIOManager *iomgr, tso->block_info.fd = fd; appendToIOBlockedQueue(iomgr, tso); RELEASE_STORE(&tso->why_blocked, why_blocked); - return true; + return IOSubmitResultAsyncContinue; } #endif #if defined(IOMGR_ENABLED_POLL) ===================================== rts/IOManager.h ===================================== @@ -325,8 +325,33 @@ typedef enum { IORead = 0, IOWrite = 1 } IOReadOrWrite; * false on heap allocation failure. */ +/* Note [Encoding of result of I/O manager operations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We have quite a bit of information that to return from the I/O manager calls +back to the I/O primops. It (somewhat uncomfortably) fits into a C int. + +We use the following encoding of the result: + + * negative: synchronous failure, with -errno as the result. + * 0: ok, result successful, proceed to async: suspend the TSO. + * 1: synchronous success, return without suspending the TSO. This can occur + for example when waiting on readiness of a regular file (which is always + ready). + * 2: heap overflow + * >2: unallocated status codes +*/ +typedef int IOSubmitResult; + +/* Provide constants for IOSubmitResult */ +enum IOSubmitResultCodes { + /* negative numbers are -errno error codes */ + IOSubmitResultAsyncContinue = 0, + IOSubmitResultSyncSuccess = 1, + IOSubmitResultHeapOverflow = 2 +}; + /* Called from CMM primop */ -bool syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd); +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd); void syncIOCancel(CapIOManager *iomgr, StgTSO *tso); ===================================== rts/IOManagerInternals.h ===================================== @@ -81,5 +81,25 @@ struct _CapIOManager { }; +/* Fill in the outcome and result/error on the TSO's stack frame. + * The TSO must be blocked using one of the stg_block_io_* blocking actions. + * + * Once the thread is resumed (by the scheduler) the code for stg_block_*_info + * will pick up the info from the stack frame and use it to see if there's been + * a failure, and if so to raise a PrimIOException. + * + * See Note [Thread blocking for new I/O primops]. + */ +INLINE_HEADER void setTsoIOOpOutcome (StgTSO *tso, + enum IOOpOutcome outcome, + uint32_t result) +{ + ASSERT((StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_unit_info + || (StgPtr *)tso->stackobj->sp[0] == (StgPtr *)&stg_block_io_int_info); + + tso->stackobj->sp[1] = (W_)outcome; + tso->stackobj->sp[2] = (W_)result; +} + #include "EndPrivate.h" ===================================== rts/Prelude.h ===================================== @@ -65,8 +65,6 @@ extern StgClosure ZCMain_main_closure; #define overflowException_closure ghc_hs_iface->overflowException_closure #define divZeroException_closure ghc_hs_iface->divZZeroException_closure -#define blockedOnBadFD_closure ghc_hs_iface->blockedOnBadFD_closure - #define Czh_con_info ghc_hs_iface->Czh_con_info #define Izh_con_info ghc_hs_iface->Izh_con_info #define Fzh_con_info ghc_hs_iface->Fzh_con_info ===================================== rts/PrimOps.cmm ===================================== @@ -2297,32 +2297,60 @@ stg_whereFromzh (P_ clos, W_ buf) Thread I/O blocking primitives -------------------------------------------------------------------------- */ -stg_waitReadzh ( W_ fd ) +stg_handleIOSubmitResult ( CInt result ) { - CBool ok; /* Ok, or heap alloc failure. */ + /* See Note [Encoding of result of I/O manager operations] */ - (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", - CurrentTSO "ptr", - /* IORead */ 0::CInt, fd); - if (ok != 0::CBool) (likely: True) { - jump stg_block_noregs(); - } else { + /* case IOSubmitResultAsyncContinue */ + if (result == 0::CInt) (likely: True) { + /* See Note [Thread blocking for new I/O primops] */ + jump stg_block_io_unit(); + } + + /* case IOSubmitResultSyncSuccess*/ + if (result == 1::CInt) (likely: True) { + /* Success, don't even go via scheduler. */ + return (); + } + + /* negative numbers are -errno error codes */ + if (result < 0::CInt) { + /* See Note [Calling convention for raisePrimIOException] */ + W_ dummyR1; W_ errno; + dummyR1 = 0; + errno = TO_W_(-result); + jump %ENTRY_CODE(HsIface_raisePrimIOException_info(W_[ghc_hs_iface])) + (dummyR1, errno); + } + + /* case IOSubmitResultHeapOverflow */ + if (result == 2::CInt) { jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); + } + ccall sbarf("syncIOWaitReady result encoding error") never returns; +} + +stg_waitReadzh ( W_ fd ) +{ + CInt result; + + (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", + CurrentTSO "ptr", + /* IORead */ 0::CInt, fd); + + jump stg_handleIOSubmitResult(result); } stg_waitWritezh ( W_ fd ) { - CBool ok; /* Ok, or heap alloc failure. */ + CInt result; - (ok) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", - CurrentTSO "ptr", - /* IOWrite */ 1::CInt, fd); - if (ok != 0::CBool) (likely: True) { - jump stg_block_noregs(); - } else { - jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); - } + (result) = ccall syncIOWaitReady(Capability_iomgr(MyCapability()) "ptr", + CurrentTSO "ptr", + /* IOWrite */ 1::CInt, fd); + + jump stg_handleIOSubmitResult(result); } stg_delayzh ( W_ us_delay ) ===================================== rts/include/rts/RtsToHsIface.h ===================================== @@ -28,7 +28,6 @@ typedef struct { StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure - StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure StgClosure *raisePrimIOException_info; // GHC.Internal.Conc.IO.raisePrimIOException_info StgClosure *runSparks_closure; // GHC.Internal.Conc.Sync.runSparks_closure StgClosure *ensureIOManagerIsRunning_closure; // GHC.Internal.Conc.IO.ensureIOManagerIsRunning_closure ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -386,6 +386,10 @@ RTS_FUN_DECL(stg_block_throwto); RTS_RET(stg_block_throwto); /* Blocking for I/O primops */ +RTS_FUN_DECL(stg_block_io_unit); +RTS_RET(stg_block_io_unit); +RTS_FUN_DECL(stg_block_io_int); +RTS_RET(stg_block_io_int); #if defined(mingw32_HOST_OS) RTS_FUN_DECL(stg_block_async); RTS_RET(stg_block_async); ===================================== rts/posix/Poll.c ===================================== @@ -20,7 +20,6 @@ #include "Prelude.h" #include "RtsUtils.h" #include "rts/Time.h" -#include "RaiseAsync.h" #include "Trace.h" #include "Poll.h" @@ -171,14 +170,13 @@ void freeCapabilityIOManagerPoll(CapIOManager *iomgr) } -/* Used to implement syncIOWaitReady. - * Result is true on success, or false on allocation failure. */ -bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd) +/* Used to implement syncIOWaitReady. */ +IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, + IOReadOrWrite rw, HsInt fd) { StgAsyncIOOp *aiop; aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp)); - if (RTS_UNLIKELY(aiop == NULL)) return false; + if (RTS_UNLIKELY(aiop == NULL)) return IOSubmitResultHeapOverflow; SET_HDR(aiop, &stg_ASYNCIOOP_info, iomgr->cap->r.rCCCS); aiop->notify.tso = tso; aiop->notify_type = NotifyTSO; @@ -189,13 +187,12 @@ bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, return asyncIOWaitReadyPoll(iomgr, aiop, rw, fd); } -/* Result is true on success, or false on allocation failure. */ -bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd) +IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, + IOReadOrWrite rw, int fd) { if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) { bool ok = enlargeTables(iomgr); - if (RTS_UNLIKELY(!ok)) return false; + if (RTS_UNLIKELY(!ok)) return IOSubmitResultHeapOverflow; } int ix = insertClosureTable(iomgr->cap, &iomgr->aiop_table, aiop); @@ -216,7 +213,7 @@ bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, .events = rw == IORead ? POLLIN : POLLOUT, .revents = 0 }; - return true; + return IOSubmitResultAsyncContinue; } @@ -226,6 +223,7 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso) ASSERT(aiop->notify_type == NotifyTSO); ASSERT(indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop); ioCancel(iomgr, aiop); + setTsoIOOpOutcome(tso, aiop->outcome, aiop->result); /* We cannot use the normal notifyIOCompletion here. We are in the context * of throwTo, interrupting a thread blocked on IO via an async exception. * We don't put the TSO back on the run queue or change the why_blocked @@ -284,26 +282,18 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) switch (aiop->notify_type) { case NotifyTSO: { - if (aiop->outcome == IOOpOutcomeFailed && aiop->error == EBADF) { - /* The fd is invalid: raise an IOError exception in the blocked - * thread. (See bug #4934 for what happens without this.) - */ - StgTSO *tso = aiop->notify.tso; - debugTrace(DEBUG_iomanager, - "Raising exception in thread %" FMT_StgThreadID - " blocked on an invalid fd", tso->id); - raiseAsync(iomgr->cap, tso, - (StgClosure *)blockedOnBadFD_closure, - false, NULL); - } else { - /* We should be guaranteed that the tso is still on the same - * cap because the tso was not on the run queue of any cap and - * so is not subject to thread migration. - */ - StgTSO *tso = aiop->notify.tso; - pushOnRunQueue(iomgr->cap, tso); - RELEASE_STORE(&tso->why_blocked, NotBlocked); - } + /* We should be guaranteed that the tso is still on the same + * cap because the tso was not on the run queue of any cap and + * so is not subject to thread migration. + */ + StgTSO *tso = aiop->notify.tso; + ASSERT(tso->cap == iomgr->cap); + + /* Fill in the outcome and result/error on the TSO's stack frame */ + setTsoIOOpOutcome(tso, aiop->outcome, aiop->result); + pushOnRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); + /* For the TSO case, the aiop was only reachable from the TSO * itself, and thus it is now no longer be reachable at all. */ ===================================== rts/posix/Poll.h ===================================== @@ -20,13 +20,13 @@ void initCapabilityIOManagerPoll(CapIOManager *iomgr); void freeCapabilityIOManagerPoll(CapIOManager *iomgr); /* Synchronous I/O and timer operations */ -bool syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd); +IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, + IOReadOrWrite rw, HsInt fd); void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso); /* Asynchronous operations */ -bool asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd); +IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, + IOReadOrWrite rw, int fd); void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop); /* Scheduler operations */ ===================================== rts/posix/Select.c ===================================== @@ -15,7 +15,6 @@ #include "Signals.h" #include "Schedule.h" #include "Prelude.h" -#include "RaiseAsync.h" #include "RtsUtils.h" #include "Capability.h" #include "Select.h" @@ -480,13 +479,18 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) IF_DEBUG(scheduler, debugBelch("Killing blocked thread %" FMT_StgThreadID " on bad fd=%i\n", tso->id, fd)); - raiseAsync(iomgr->cap, tso, - (StgClosure *)blockedOnBadFD_closure, false, NULL); + + /* Fill in the outcome and error on the TSO's stack frame */ + setTsoIOOpOutcome(tso, IOOpOutcomeFailed, EBADF); + pushOnRunQueue(iomgr->cap,tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; case RTS_FD_IS_READY: IF_DEBUG(scheduler, debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); + /* Fill in the outcome and result on the TSO's stack frame */ + setTsoIOOpOutcome(tso, IOOpOutcomeSuccess, 0); pushOnRunQueue(iomgr->cap,tso); RELEASE_STORE(&tso->why_blocked, NotBlocked); break; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b201feb5a78d9d2e4b99fb9ed865d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b201feb5a78d9d2e4b99fb9ed865d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/9.12.5-rc4] 9 commits: Never make an absent filler for a constraint type
by Magnus (＠MangoIV) 09 Sep '26

09 Sep '26

Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC Commits: c6e59f2b by Simon Peyton Jones at 2026-09-09T11:54:37+02:00 Never make an absent filler for a constraint type mkAbsentFiller used isTerminatingType to decide, but that is not enough. Consider class Eq a => UC a where {} let u :: UC Int -- UC Int is a "non-terminating type" u = error "Absent" let e :: Eq Int -- Eq Int is a "terminating type" e = $p1UC u We clearly must not make a filler for `e`, because we speculatively evaluate it. But speculatively evaluating `e` forces `u`, so we must not make one for `u` either. Asking isDictTy instead is not enough either, because it does not catch a constraint hidden behind an unreduced type family application: type family F a :: Constraint type instance F W = TC W a :: F W => Int -> Int -- (F W) argument is absent Oops! Entered absent arg Arg: irred Type: F W So play safe and use isPredTy: never make an absent filler for any constraint-kinded type. Fixes #27627 (cherry picked from commit 7bf546fc423e23cb649580016ee494efbfe144ab) - - - - - adb4ddfc by Zubin Duggal at 2026-09-09T11:54:37+02:00 Add tests for absent fillers at dictionary types T27627 a unary class whose superclass is a non-unary class T27627a ...whose superclass is a Constraint-kinded type family T27627b ...whose superclass is a quantified constraint T27627c a unary class applied to itself, (UC (UC (TC a))) T27627e a (forall b. P b) dictionary that loops (cherry picked from commit 5f474953d1880232b5e6c5741f08746e28cd25ab) - - - - - 6b758dcb by Zubin Duggal at 2026-09-09T11:54:37+02:00 An abstract TyCon may hide a unary class A class declared in an hs-boot file is an AbstractTyCon inside the module loop, and compiling the real declaration may reveal it to be a UnaryClassTyCon. - isTerminatingType returned True for such AbstractTyCons - IfaceToCore set the unary flag to False in the DFunId So we could end up speculating bottom dictionaries because inside a module loop we see an UnaryClassTyCon as an AbstractTyCon Use isTerminatingTyCon, which returns False for an abstract TyCon. The Bool in DFunId is now a cache for isTerminatingTyCon, set in mkDFunIdDetails. Fixes #27704 Note by the backporter (mangoiv): we're backporting by the fact that a tycon is a unary type class con IFF it is a type class con and a newtype prior to 9bd7fcc518111a1549c98720c222cdbabd32ed46. (cherry picked from commit db1e0bda5c3209d75133fa9e2560d684f35f950b) - - - - - e1dc869f by Zubin Duggal at 2026-09-09T11:54:37+02:00 Specialise: don't replace dead args with absent fillers specHeader decides an argument is dead by calling isDeadBinder on a binder of the /optimised RHS/, then applies the filler to the /stable unfolding/ template instead. The two may differ, so the argument can be dead in the RHS and not in the template. The specialised function's unfolding then has an absent filler, and any call site that inlines it evaluates the error thunk. Dropping dead args in the specialiser is rarely worth it, to quote Simon, "The later worker/wrapper pass will pick up the dead arg later if it is really dead. Keeps the specialiser simpler." So instead of trying to check if the arg really is dead in the stable unfolding, just drop the logic for dropping dead args in the specialiser altogeher. Fixes #27703 (cherry picked from commit 2b3cdef64bbc535bd72e3dfb512b4cfd10a72ca2) - - - - - d7ad1bc4 by Zubin Duggal at 2026-09-09T11:54:38+02:00 CorePrep: don't speculate a call across an hs-boot edge We take care not to evaluate things that might be bottom, like a looping dictionary group, but our analysis is defeated by boot files. We only track recursion within a module, so two dictionaries that depend on each other across a module loop each look non-recursive, and we might speculate them. Any recursion we cannot see must cross an hs-boot edge, so refuse to speculate calls that cross one. Fixes #27717 (cherry picked from commit 664efc76286c475e0fcd1c1624e847831e7fc07a) - - - - - 85351278 by Ben Gamari at 2026-09-09T11:54:38+02:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 (cherry picked from commit 2ab02c579a9625438f5281a258051cb32ba40004) - - - - - 792f1e70 by Zubin Duggal at 2026-09-09T11:54:38+02:00 DmdAnal: Fix maxDmdType We need to eta expand the smaller DmdType using defaultArgDmd, like in lubDmdType. Introduce zipDmdType as a common combinator to implement both maxDmdType and lubDmdType uniformly. fixes #27626 (cherry picked from commit e31885816b7c597ad89b05da64b21c5a241bf674) - - - - - fb179ef4 by Zubin Duggal at 2026-09-09T11:54:38+02:00 hadrian: Fix links to remaining doc sites to not use the package hash for haddock links In 07267f79d91169f474cacc8bcd38d76a6e97887d we changed hadrian to not include the package hash in the haddock directory. This patch takes care of a few remaining links that were missed in that patch Fixes #27671 (cherry picked from commit 1446bb039a635f2b836be19f062cbffa568fe4c5) - - - - - 329cbb81 by Luite Stegeman at 2026-09-09T11:54:38+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 (cherry picked from commit 06eee015be4e361fe9cb33e8a608ab2ea1386b52) - - - - - 90 changed files: - + changelog.d/27626 - + changelog.d/27627 - + changelog.d/27703 - + changelog.d/27704 - + changelog.d/27717 - + changelog.d/T27455 - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Literal.hs - docs/index.html.in - docs/users_guide/ghc_config.py.in - hadrian/src/Rules/Generate.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - rts/sm/Evac.c - + testsuite/tests/core-to-stg/T27627/Callee.hs - + testsuite/tests/core-to-stg/T27627/Caller.hs - + testsuite/tests/core-to-stg/T27627/Main.hs - + testsuite/tests/core-to-stg/T27627/T27627.stdout - + testsuite/tests/core-to-stg/T27627/all.T - + testsuite/tests/core-to-stg/T27627a/Callee.hs - + testsuite/tests/core-to-stg/T27627a/Caller.hs - + testsuite/tests/core-to-stg/T27627a/Main.hs - + testsuite/tests/core-to-stg/T27627a/T27627a.stdout - + testsuite/tests/core-to-stg/T27627a/all.T - + testsuite/tests/core-to-stg/T27627b/Callee.hs - + testsuite/tests/core-to-stg/T27627b/Caller.hs - + testsuite/tests/core-to-stg/T27627b/Main.hs - + testsuite/tests/core-to-stg/T27627b/T27627b.stdout - + testsuite/tests/core-to-stg/T27627b/all.T - + testsuite/tests/core-to-stg/T27627c/Callee.hs - + testsuite/tests/core-to-stg/T27627c/Caller.hs - + testsuite/tests/core-to-stg/T27627c/Main.hs - + testsuite/tests/core-to-stg/T27627c/T27627c.stdout - + testsuite/tests/core-to-stg/T27627c/all.T - + testsuite/tests/core-to-stg/T27627e.hs - + testsuite/tests/core-to-stg/T27627e.stdout - + testsuite/tests/core-to-stg/T27627f/Callee.hs - + testsuite/tests/core-to-stg/T27627f/Caller.hs - + testsuite/tests/core-to-stg/T27627f/Inst.hs - + testsuite/tests/core-to-stg/T27627f/Main.hs - + testsuite/tests/core-to-stg/T27627f/T27627f.stdout - + testsuite/tests/core-to-stg/T27627f/all.T - + testsuite/tests/core-to-stg/T27704/Callee.hs - + testsuite/tests/core-to-stg/T27704/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704/Main.hs - + testsuite/tests/core-to-stg/T27704/Mid.hs - + testsuite/tests/core-to-stg/T27704/T27704.stdout - + testsuite/tests/core-to-stg/T27704/all.T - + testsuite/tests/core-to-stg/T27704a/Callee.hs - + testsuite/tests/core-to-stg/T27704a/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704a/Main.hs - + testsuite/tests/core-to-stg/T27704a/Mid.hs - + testsuite/tests/core-to-stg/T27704a/T27704a.stdout - + testsuite/tests/core-to-stg/T27704a/all.T - + testsuite/tests/core-to-stg/T27717/Callee.hs - + testsuite/tests/core-to-stg/T27717/Callee.hs-boot - + testsuite/tests/core-to-stg/T27717/Main.hs - + testsuite/tests/core-to-stg/T27717/Mid.hs - + testsuite/tests/core-to-stg/T27717/T27717.stdout - + testsuite/tests/core-to-stg/T27717/Ty.hs - + testsuite/tests/core-to-stg/T27717/all.T - testsuite/tests/core-to-stg/all.T - + testsuite/tests/dmdanal/should_run/M2.hs - + testsuite/tests/dmdanal/should_run/T27626.hs - + testsuite/tests/dmdanal/should_run/T27626.stdout - testsuite/tests/dmdanal/should_run/all.T - testsuite/tests/ghc-e/should_fail/T18441fail7.stderr - testsuite/tests/ghc-e/should_run/ghc-e005.stderr - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - testsuite/tests/simplCore/should_compile/T17966.stderr - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/simplCore/should_compile/spec004.hs - testsuite/tests/simplCore/should_compile/spec004.stderr - + testsuite/tests/simplCore/should_run/T27703/Lib.hs - + testsuite/tests/simplCore/should_run/T27703/Main.hs - + testsuite/tests/simplCore/should_run/T27703/T27703.stdout - + testsuite/tests/simplCore/should_run/T27703/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45b16ebe4a65a1551e1c8da494043c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45b16ebe4a65a1551e1c8da494043c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27724] Make noinline runtime-rep polymorphic
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/T27724 at Glasgow Haskell Compiler / GHC Commits: 66700a12 by Simon Peyton Jones at 2026-09-09T10:46:30+01:00 Make noinline runtime-rep polymorphic - - - - - 4 changed files: - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs Changes: ===================================== compiler/GHC/Builtin/WiredIn/Ids.hs ===================================== @@ -269,8 +269,10 @@ noinlineId :: Id -- See Note [noinlineId magic] noinlineId = pcMiscPrelId noinlineIdName ty info where info = noCafIdInfo - ty = mkSpecForAllTys [alphaTyVar] $ - mkVisFunTyMany alphaTy alphaTy + -- noinline :: forall r (a :: TYPE r). a -> a + ty = mkInfForAllTy runtimeRep1TyVar $ + mkSpecForAllTys [openAlphaTyVar] $ + mkVisFunTyMany openAlphaTy openAlphaTy noinlineConstraintId :: Id -- See Note [noinlineId magic] noinlineConstraintId = pcMiscPrelId noinlineConstraintIdName ty info ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2372,9 +2372,10 @@ simplOutId env fun cont simplOutId env inline_fun cont | inline_fun `hasKey` noinlineIdKey , ApplyToTy { sc_cont = cont1 } <- cont - , ApplyToVal { sc_cont = cont2, sc_arg = the_call, sc_cast = arg_mco - , sc_env = UnSimplified arg_se } <- cont1 - = do { let (encl_app_cont, rest_cont) = splitContArgs cont2 + , ApplyToTy { sc_cont = cont2 } <- cont1 + , ApplyToVal { sc_cont = cont3, sc_arg = the_call, sc_cast = arg_mco + , sc_env = UnSimplified arg_se } <- cont2 + = do { let (encl_app_cont, rest_cont) = splitContArgs cont3 -- push_args just pushes multiple arguments onto the continuation push_args (App fun arg) cont = do { cont' <- pushAppCont arg_se fun arg cont ; push_args fun cont' } @@ -2385,7 +2386,9 @@ simplOutId env inline_fun cont ; let call_env = updMode updModeForNoInline $ arg_se `setInScopeFromE` env ; (floats1, call') <- simplExprF call_env inner_fun call_cont - ; let noinline_expr = Var inline_fun `App` Type (contHoleType rest_cont) + ; let new_call_ty = contHoleType rest_cont + noinline_expr = Var inline_fun `App` Type (getRuntimeRep new_call_ty) + `App` Type new_call_ty `App` mkCastMCo call' arg_mco ; (floats2, res) <- rebuild env noinline_expr rest_cont ; return (floats2 `addFloats` floats1 , res) } ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -63,7 +63,7 @@ import GHC.Core.TyCo.Tidy import GHC.Builtin.WiredIn.Prim ( eqPrimTyCon, eqReprPrimTyCon ) import GHC.Builtin.WiredIn.Types ( heqTyCon ) -import GHC.Builtin.WiredIn.Ids ( noinlineIdName, noinlineConstraintIdName ) +import GHC.Builtin.WiredIn.Ids ( noinlineIdName ) import GHC.Iface.Syntax import GHC.Data.FastString @@ -658,9 +658,10 @@ toIfaceVar :: Id -> IfaceExpr toIfaceVar v | isBootUnfolding (idUnfolding v) = -- See Note [Inlining and hs-boot files] - IfaceApp (IfaceApp (IfaceExt noinline_id) - (IfaceType (toIfaceType ty))) - (IfaceExt name) -- don't use mkIfaceApps, or infinite loop + IfaceExt noinlineIdName `IfaceApp` + IfaceType (toIfaceType rep) `IfaceApp` + IfaceType (toIfaceType ty) `IfaceApp` + IfaceExt name -- Don't use mkIfaceApps, or infinite loop | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) -- Foreign calls have special syntax @@ -670,10 +671,7 @@ toIfaceVar v where name = idName v ty = idType v - noinline_id | isConstraintKind (typeKind ty) = noinlineConstraintIdName - | otherwise = noinlineIdName - - + rep = getRuntimeRep ty --------------------- toIfaceLFInfo :: Name -> LambdaFormInfo -> IfaceLFInfo ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1070,33 +1070,23 @@ cpeApp top_env expr -> CoreExpr -- The thing we are calling -> [ArgInfo] -> UniqSM (Floats, CpeBody) - cpe_app env (Var f) (AIApp Type{} : AIApp arg : args) - | f `hasKey` lazyIdKey -- Replace (lazy a) with a, and - -- See Note [lazyId magic] in GHC.Types.Id.Make - || f `hasKey` noinlineIdKey || f `hasKey` noinlineConstraintIdKey - -- Replace (noinline a) with a - -- See Note [noinlineId magic] in GHC.Types.Id.Make - || f `hasKey` nospecIdKey -- Replace (nospec a) with a - -- See Note [nospecId magic] in GHC.Types.Id.Make - + cpe_app env (Var f) args + | Just (arg, args) <- eliminateMagicCall f args -- NB: keep this in sync with GHC.HsToCore.Pmc.Solver.Types.coreExprAsPmLit, -- as that also needs to see through these magic Ids. - - -- Consider the code: - -- - -- lazy (f x) y - -- - -- We need to make sure that we need to recursively collect arguments on - -- "f x", otherwise we'll float "f x" out (it's not a variable) and - -- end up with this awful -ddump-prep: - -- - -- case f x of f_x { - -- __DEFAULT -> f_x y - -- } - -- - -- rather than the far superior "f x y". Test case is par01. = let (terminal, args') = collect_args arg in cpe_app env terminal (args' ++ args) + -- Why this recursive call? For example, consider the code: + -- lazy (f x) y + -- We need to make sure that we need to recursively collect arguments on + -- "f x", otherwise we'll float "f x" out (it's not a variable) and + -- end up with this awful -ddump-prep: + -- + -- case f x of f_x { + -- __DEFAULT -> f_x y + -- } + -- + -- rather than the far superior "f x y". Test case is par01. -- runRW# magic cpe_app env (Var f) (AIApp _runtimeRep@Type{} : AIApp _type@Type{} : AIApp arg : rest) @@ -1274,6 +1264,22 @@ isLazyExpr (Tick _ e) = isLazyExpr e isLazyExpr (Var f `App` _ `App` _) = f `hasKey` lazyIdKey isLazyExpr _ = False +eliminateMagicCall :: Id -> [ArgInfo] -> Maybe (CoreExpr, [ArgInfo]) +eliminateMagicCall f (AIApp Type{} : AIApp arg : args) + | f `hasKey` lazyIdKey = Just (arg,args) + -- Replace (lazy a) with a, and + -- See Note [lazyId magic] in GHC.Types.Id.Make + | f `hasKey` nospecIdKey = Just (arg,args) + -- Replace (nospec a) with a + -- See Note [nospecId magic] in GHC.Types.Id.Make + +eliminateMagicCall f (AIApp Type{} : AIApp Type{} : AIApp arg : args) + | f `hasKey` noinlineIdKey = Just (arg,args) + -- Replace (noinline a) with a + -- See Note [noinlineId magic] in GHC.Types.Id.Make + +eliminateMagicCall _ _ = Nothing + {- Note [runRW magic] ~~~~~~~~~~~~~~~~~~~~~ Some definitions, for instance @runST@, must have careful control over float out View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66700a12d35b06943293d43b3c4d7c3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66700a12d35b06943293d43b3c4d7c3… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/9.12.5-rc4] rts: Fix missing memory barrier in eval_thunk_selector (#27477)
by Magnus (＠MangoIV) 09 Sep '26

09 Sep '26

Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC Commits: 45b16ebe by Luite Stegeman at 2026-09-09T11:46:00+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 (cherry picked from commit 06eee015be4e361fe9cb33e8a608ab2ea1386b52) - - - - - 5 changed files: - + changelog.d/fix-parallel-gc-selector-race-27477 - rts/sm/Evac.c - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -0,0 +1,10 @@ +section: rts +synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap +description: + On weakly-ordered architectures such as AArch64 programs using + could crash during parallel garbage collection (segmentation fault + or ``internal error: eval_thunk_selector: strange selectee <n>``) or + continue running with silently corrupted heap data, due to a missing + memory barrier in the parallel GC. +mrs: !16488 +issues: #27477 ===================================== rts/sm/Evac.c ===================================== @@ -1360,7 +1360,11 @@ selector_loop: // from-space during marking, for example. We rely on the property // that evacuate() doesn't mind if it gets passed a to-space pointer. - info = RELAXED_LOAD((StgInfoTable**) &selectee->header.info); + // NB. this load must be ordered: the selectee may be updated + // concurrently by another GC thread's unchain_thunk_selectors(), + // which publishes an indirection by writing the indirectee and + // then RELEASE-storing the info pointer. See #27477. + info = ACQUIRE_LOAD((StgInfoTable**) &selectee->header.info); if (IS_FORWARDING_PTR(info)) { // We don't follow pointers into to-space; the constructor ===================================== testsuite/tests/rts/T27477.hs ===================================== @@ -0,0 +1,169 @@ +{-# LANGUAGE BangPatterns #-} + +-- Stress test for #27477: missing ACQUIRE in eval_thunk_selector +-- (rts/sm/Evac.c). +-- +-- With the bug present this test crashes or reports value mismatches +-- within a few seconds on AArch64; on strongly-ordered targets +-- it just passes. + +module Main (main) where + +import Control.Concurrent +import Control.Exception +import Control.Monad +import Data.IORef +import System.Environment +import System.Exit +import System.IO +import System.Mem (performMinorGC) + +data T = T { nxt :: T, val :: !Int } + +-- expected values and the cells that should evaluate to them +type Batch = ([Int], [T]) + +tailD, branchD, branchesPerCell :: Int +tailD = 12 -- shared tail length per cluster +branchD = 3 -- private branch length +branchesPerCell = 2 +-- tailD + branchD must stay below MAX_THUNK_SELECTOR_DEPTH (16) + +{-# NOINLINE spineEnd #-} +spineEnd :: T +spineEnd = errorWithoutStackTrace "spine end reached" + +-- Fully evaluated spine of constructors; cell i from the head has val i+1. +buildSpine :: Int -> IO T +buildSpine len = evaluate (go len (T spineEnd 0)) + where + go :: Int -> T -> T + go 0 acc = acc + go k acc = go (k - 1) (T acc k) + +-- k selector thunks, shallow-first: cell i selects from cell i-1, +-- cell 0 selects from t. If t evaluates to spine cell m (val m+1), +-- cell i evaluates to spine cell m+1+i (val m+2+i). +{-# NOINLINE selChain #-} +selChain :: Int -> T -> [T] +selChain 0 _ = [] +selChain k t = let t' = nxt t in t' : selChain (k - 1) t' + +lenL :: [a] -> Int +lenL = go 0 + where + go !n [] = n + go !n (_ : xs) = go (n + 1) xs + +everyN :: Int -> [a] -> [a] +everyN _ [] = [] +everyN n (x : xs) = x : everyN n (drop (n - 1) xs) + +-- One branch hanging off tail cell tj (which evaluates to val jval): +-- branch cell i evaluates to jval+1+i. Returned deepest-first. +{-# NOINLINE mkBranch #-} +mkBranch :: Int -> T -> IO Batch +mkBranch jval tj = do + let cells = selChain branchD tj + _ <- evaluate (lenL cells) + let expected = [ jval + 1 + i | i <- [0 .. branchD - 1] ] + pure (reverse expected, reverse cells) + +-- A cluster: one private spine, one shared tail of selectors over it, +-- branchesPerCell branches of selectors converging on every tail cell. +-- Neither the spine nor the tail is returned: they must stay reachable +-- only through the branch selectors. +buildCluster :: IO [Batch] +buildCluster = do + sp <- buildSpine (tailD + branchD + 4) + let tails = selChain tailD sp + _ <- evaluate (lenL tails) + bss <- forM (zip [0 ..] tails) $ \(j, tj) -> + replicateM branchesPerCell (mkBranch (j + 2) tj) + pure (concat bss) + +verifyBatch :: IORef Int -> Int -> Batch -> IO () +verifyBatch errs wid (es0, ts0) = go es0 ts0 + where + go (e : es) (t : ts) = do + v <- evaluate (val t) + when (v /= e) $ do + hPutStrLn stderr $ + "MISMATCH worker=" ++ show wid + ++ " expected=" ++ show e ++ " got=" ++ show v + modifyIORef' errs (+ 1) + go es ts + go _ _ = pure () + +-- simple cyclic barrier +newtype Barrier = Barrier (MVar (Int, [MVar ()])) + +newBarrier :: IO Barrier +newBarrier = Barrier <$> newMVar (0, []) + +awaitBarrier :: Barrier -> Int -> IO () +awaitBarrier (Barrier st) total = do + w <- newEmptyMVar + join $ modifyMVar st $ \(k, ws) -> + if k + 1 == total + then pure ((0, []), mapM_ (\m -> putMVar m ()) ws) + else pure ((k + 1, w : ws), takeMVar w) + +worker :: Int -> Int -> Int -> Barrier -> [IORef [Batch]] -> IORef Int -> Int -> IO () +worker rounds clusters nWorkers bar slots errs wid = + forM_ [1 .. rounds] $ \(_r :: Int) -> do + -- build fresh selector clusters, publish them + batches <- concat <$> replicateM clusters buildCluster + writeIORef (slots !! wid) batches + awaitBarrier bar nWorkers + -- root each branch's deepest cell via fresh cons cells in our own + -- nursery (so our GC thread evacuates the shared cells itself), in + -- a per-worker interleaved order so that different GC threads + -- sweep different branches of the same shared tails concurrently + published <- mapM readIORef slots + let allBatches = concat published + ordered + | nWorkers > 1 = + concat [ everyN nWorkers (drop ((wid + k) `mod` nWorkers) allBatches) + | k <- [0 .. nWorkers - 1] ] + | otherwise = allBatches + deepTs = [ t | (_, t : _) <- ordered ] + deepEs = [ e | (e : _, _) <- ordered ] + _ <- evaluate (lenL deepTs) + _ <- evaluate (lenL deepEs) + awaitBarrier bar nWorkers + -- run a parallel GC with everything live + when (wid == 0) performMinorGC + awaitBarrier bar nWorkers + -- force everything and check the values + verifyBatch errs wid (deepEs, deepTs) + awaitBarrier bar nWorkers + +main :: IO () +main = do + hSetBuffering stderr LineBuffering + args <- getArgs + let atDef d i = if length args > i then read (args !! i) else d + rounds = atDef 600 0 + clusters = atDef 48 1 + n <- getNumCapabilities + bar <- newBarrier + slots <- replicateM n (newIORef []) + errs <- newIORef 0 + dones <- forM [0 .. n - 1] $ \i -> do + done <- newEmptyMVar + _ <- forkOn i $ + (worker rounds clusters n bar slots errs i >> putMVar done Nothing) + `catch` \e -> putMVar done (Just (e :: SomeException)) + pure done + results <- mapM takeMVar dones + forM_ results $ \r -> case r of + Just e -> do + hPutStrLn stderr ("worker exception: " ++ show e) + exitWith (ExitFailure 2) + Nothing -> pure () + ec <- readIORef errs + when (ec > 0) $ do + hPutStrLn stderr ("FAILED: " ++ show ec ++ " mismatches") + exitWith (ExitFailure 2) + putStrLn "OK" ===================================== testsuite/tests/rts/T27477.stdout ===================================== @@ -0,0 +1 @@ +OK ===================================== testsuite/tests/rts/all.T ===================================== @@ -639,5 +639,11 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru test('T25560', [req_c_rts, ignore_stderr], compile_and_run, ['']) test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main']) - test('T27123', [when(have_profiling(), extra_ways(['prof']))], compile_and_run, ['-O -package ghc']) +test('T27477', + [ extra_run_opts('600 24 +RTS -N4 -A1m -RTS') + , req_ghc_smp + , req_target_smp + , only_ways(['threaded1', 'threaded2']) + ], + compile_and_run, ['-O2']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45b16ebe4a65a1551e1c8da494043c5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45b16ebe4a65a1551e1c8da494043c5… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/T25450-march-native] Implement -march=native for x86/x86_64
by Simon Jakobi (＠sjakobi) 09 Sep '26

09 Sep '26

Simon Jakobi pushed to branch wip/sjakobi/T25450-march-native at Glasgow Haskell Compiler / GHC Commits: ab0e58e4 by Simon Jakobi at 2026-09-09T11:11:19+02:00 Implement -march=native for x86/x86_64 Add a -march=native flag that probes the host CPU and enables the matching CPU-feature DynFlags, so it affects both the NCG and the LLVM backend. Detected features are folded additively into the existing flags, so explicit -m... options are never disabled. The probe is a small C shim over GCC/Clang's __builtin_cpu_supports. The deviations that remain are documented in compiler/cbits/cpu_features_x86.c. The RTS exports the runtime symbols behind the builtin (__cpu_model & co.) so GHCi's runtime linker can load the ghc library where GHCi links statically, e.g. on Windows or musl. One export, __cpu_indicator_init_local, is a weak reference: only the musl GCC patch carried by Alpine and Gentoo (aports 0013-libgcc_s.patch) makes __builtin_cpu_init call that alias, defining it in static libgcc.a. A strong reference would break the RTS link with other musl toolchains (clang/compiler-rt, unpatched gcc), which lack the alias but also never emit references to it, so their NULL table entry is inert. The flag is registered in expected-undocumented-flags.txt due to #27321. Thanks to @aratamizuki for pointing out the macOS AVX-512 XSAVE quirk and for testing! Closes #25450 Assisted-by: Claude Fable 5 - - - - - 17 changed files: - + changelog.d/march-native - changelog.d/print-enabled-cpu-features - + compiler/GHC/Driver/CpuFeatures.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - + compiler/cbits/cpu_features_x86.c - compiler/ghc.cabal.in - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/using.rst - rts/RtsSymbols.c - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.asm - + testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.hs - testsuite/tests/driver/all.T - + testsuite/tests/driver/march_native.stdout - + testsuite/tests/driver/march_native_additive.stdout - + testsuite/tests/driver/march_native_unsupported_arch.stderr Changes: ===================================== changelog.d/march-native ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Add -march=native flag +issues: #25450 +mrs: !16126 + +description: + GHC now supports ``-march=native`` on x86 and x86_64. It probes the CPU of the + machine running GHC and enables all of the corresponding ``-m...`` CPU-feature + options automatically (such as ``-msse4.2``, ``-mavx2``, ``-mbmi2`` and + ``-mfma``), for both the native code generator and the LLVM backend. The + detected features are enabled in addition to any explicitly requested feature + flags. The flag is rejected for non-x86 targets and when cross-compiling. ===================================== changelog.d/print-enabled-cpu-features ===================================== @@ -8,9 +8,11 @@ description: prints a JSON object describing the CPU features currently enabled for code generation, together with a set of ``-m...`` flags that reproduce the effective feature set for the current target. - Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected. :: + Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected, so the flag + can also be used to inspect which features :ghc-flag:`-march=native` detected + and enabled. :: - $ ghc -mavx2 --print-enabled-cpu-features + $ ghc -march=native --print-enabled-cpu-features {"tag":"enabled-cpu-features","version":1,"target":"x86_64-linux-gnu", - "features":["SSE","SSE2","SSE3","SSSE3","SSE4.1","SSE4.2","AVX","AVX2"], - "as_m_flags":["-mavx2"]} + "features":["SSE","SSE2","SSE3","SSSE3","SSE4.1","SSE4.2","AVX","AVX2","BMI1","BMI2","FMA"], + "as_m_flags":["-mavx2","-mbmi2","-mfma"]} ===================================== compiler/GHC/Driver/CpuFeatures.hs ===================================== @@ -0,0 +1,64 @@ +{-# LANGUAGE CPP #-} + +module GHC.Driver.CpuFeatures + ( X86CpuFeature(..) + , cachedX86CpuFeatures + ) where + +import GHC.Prelude + +import Data.Word (Word64) +import System.IO.Unsafe (unsafePerformIO) + +-- | x86 CPU features understood by GHC's native CPU feature probe. +data X86CpuFeature + = SSE2 + | SSE3 + | SSSE3 + | SSE4_1 + | SSE4_2 + | AVX + | AVX2 + | AVX512F + | AVX512BW + | AVX512CD + | AVX512DQ + | AVX512VL + | BMI1 + | BMI2 + | FMA + | GFNI + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | Decode the bitmask returned by 'ghc_detect_x86_cpu_features'. +-- +-- Bit positions are constructor order, which must match the enum in +-- @compiler/cbits/cpu_features_x86.c@. +decodeX86CpuFeatureMask :: Word64 -> [X86CpuFeature] +decodeX86CpuFeatureMask mask = + [ feat + | feat <- [minBound .. maxBound] + , testBit mask (fromEnum feat) + ] + +-- | Low-level FFI access to the C probe. +detectX86CpuFeatureMask :: IO Word64 +#if defined(javascript_HOST_ARCH) +detectX86CpuFeatureMask = pure 0 +#else +detectX86CpuFeatureMask = c_ghc_detect_x86_cpu_features +#endif + +-- | Probe host x86 CPU features and decode them into an ordered feature list. +detectX86CpuFeatures :: IO [X86CpuFeature] +detectX86CpuFeatures = decodeX86CpuFeatureMask <$> detectX86CpuFeatureMask + +-- | The host's x86 CPU features, probed once and memoized. +cachedX86CpuFeatures :: [X86CpuFeature] +cachedX86CpuFeatures = unsafePerformIO detectX86CpuFeatures +{-# NOINLINE cachedX86CpuFeatures #-} + +#if !defined(javascript_HOST_ARCH) +foreign import ccall unsafe "ghc_detect_x86_cpu_features" + c_ghc_detect_x86_cpu_features :: IO Word64 +#endif ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -473,6 +473,8 @@ data DynFlags = DynFlags { fma :: Bool, -- ^ Enable FMA instructions. gfni :: Bool, -- ^ Enable GFNI Instructions. la664 :: Bool, -- ^ Enable LA664 instructions + marchNative :: Bool, -- ^ @-march=native@ was requested; the host + -- CPU features are applied during flag parsing. -- Constants used to control the amount of optimization done. @@ -765,6 +767,7 @@ defaultDynFlags mySettings = gfni = False, -- For LoongArch, la464 is used by default. la664 = False, + marchNative = False, maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -245,6 +245,8 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile import GHC.Platform.ArchOS +import GHC.Platform.Host (hostPlatformArch) +import qualified GHC.Driver.CpuFeatures as Cpu import GHC.Unit.Types import GHC.Unit.Parser @@ -907,8 +909,10 @@ parseDynamicFlagsFull activeFlags cmdline logger dflags0 args = do unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $ map ((rdr . ppr . getLoc &&& unLoc) . errMsg) $ errs + dflags1' <- applyMarchNative dflags1 + -- check for disabled flags in safe haskell - let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1 + let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1' theWays = ways dflags2 unless (allowed_combination theWays) $ liftIO $ @@ -1743,6 +1747,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "mavx512vl" (noArg (\d -> d { avx512vl = True })) , make_ord_flag defGhcFlag "mfma" (noArg (\d -> d { fma = True })) , make_ord_flag defGhcFlag "mgfni" (noArg (\d -> d { gfni = True })) + , make_ord_flag defGhcFlag "march=native" (noArg (\d -> d { marchNative = True })) , make_ord_flag defGhcFlag "mla664" (noArg (\d -> d { la664 = True })) @@ -3826,6 +3831,53 @@ x86AsMFlags dflags = gfniFlags = [ "-mgfni" | gfni dflags ] +-- | Apply a requested @-march=native@ by probing the host CPU and enabling the +-- matching CPU-feature flags. +applyMarchNative :: MonadIO m => DynFlags -> m DynFlags +applyMarchNative dflags + | not (marchNative dflags) = return dflags + | otherwise = do + let arch = platformArch (targetPlatform dflags) + unless (arch == ArchX86 || arch == ArchX86_64) $ liftIO $ + throwGhcExceptionIO $ CmdLineError + "-march=native is only supported on x86 and x86_64 targets" + unless (arch == hostPlatformArch) $ liftIO $ + throwGhcExceptionIO $ CmdLineError + "-march=native is not supported when cross-compiling" + return (applyX86CpuFeatures Cpu.cachedX86CpuFeatures dflags) + +-- | Enable the 'DynFlags' CPU-feature fields corresponding to a probed set of +-- host x86 features. +applyX86CpuFeatures :: [Cpu.X86CpuFeature] -> DynFlags -> DynFlags +applyX86CpuFeatures feats dflags = dflags + { sseAvxVersion = foldr (max . Just) (sseAvxVersion dflags) sseLevels + , bmiVersion = foldr (max . Just) (bmiVersion dflags) bmiLevels + , avx512f = avx512f dflags || has Cpu.AVX512F + , avx512bw = avx512bw dflags || has Cpu.AVX512BW + , avx512cd = avx512cd dflags || has Cpu.AVX512CD + , avx512dq = avx512dq dflags || has Cpu.AVX512DQ + , avx512vl = avx512vl dflags || has Cpu.AVX512VL + , fma = fma dflags || has Cpu.FMA + , gfni = gfni dflags || has Cpu.GFNI + } + where + has feat = feat `elem` feats + sseLevels = [ lvl | feat <- feats, Just lvl <- [sseLevelOf feat] ] + bmiLevels = [ lvl | feat <- feats, Just lvl <- [bmiLevelOf feat] ] + sseLevelOf feat = case feat of + Cpu.SSE2 -> Just SSE2 + Cpu.SSE3 -> Just SSE3 + Cpu.SSSE3 -> Just SSSE3 + Cpu.SSE4_1 -> Just SSE4 + Cpu.SSE4_2 -> Just SSE42 + Cpu.AVX -> Just AVX1 + Cpu.AVX2 -> Just AVX2 + _ -> Nothing + bmiLevelOf feat = case feat of + Cpu.BMI1 -> Just BMI1 + Cpu.BMI2 -> Just BMI2 + _ -> Nothing + -- | Query if the target RTS has the given 'Ways'. It's computed from -- the @"RTS ways"@ field in the settings file. targetHasRTSWays :: DynFlags -> Ways -> Bool ===================================== compiler/cbits/cpu_features_x86.c ===================================== @@ -0,0 +1,97 @@ +#include <HsFFI.h> + +/* Runtime x86 CPU feature detection backing GHC.Driver.CpuFeatures + (-march=native). + + The bit positions in the returned mask are GHC's own; the enum below + must match the constructor order of X86CpuFeature in + GHC.Driver.CpuFeatures. + + The __builtin_cpu_* calls below compile to references to libgcc/compiler-rt + symbols (__cpu_model & co.), which GHCi's runtime linker can only resolve + because the RTS exports them: see RTS_X86_CPU_MODEL_SYMBOLS in + rts/RtsSymbols.c and keep its guards in sync with this file's. */ + +enum { + GHC_X86_FEAT_SSE2 = 0, + GHC_X86_FEAT_SSE3, + GHC_X86_FEAT_SSSE3, + GHC_X86_FEAT_SSE4_1, + GHC_X86_FEAT_SSE4_2, + GHC_X86_FEAT_AVX, + GHC_X86_FEAT_AVX2, + GHC_X86_FEAT_AVX512F, + GHC_X86_FEAT_AVX512BW, + GHC_X86_FEAT_AVX512CD, + GHC_X86_FEAT_AVX512DQ, + GHC_X86_FEAT_AVX512VL, + GHC_X86_FEAT_BMI1, + GHC_X86_FEAT_BMI2, + GHC_X86_FEAT_FMA, + GHC_X86_FEAT_GFNI +}; + +#if (defined(__i386__) || defined(__x86_64__)) \ + && (defined(__GNUC__) || defined(__clang__)) + +/* GFNI joined the __builtin_cpu_supports feature lists later than the + other features here (GCC 11; compiler-rt's cpu_model in LLVM 12). + Under an older bootstrap compiler we conservatively report no GFNI. */ +#if (defined(__clang_major__) && __clang_major__ >= 12) \ + || (!defined(__clang__) && defined(__GNUC__) && __GNUC__ >= 11) +#define GHC_HAS_CPU_SUPPORTS_GFNI 1 +#else +#define GHC_HAS_CPU_SUPPORTS_GFNI 0 +#endif + +HsWord64 ghc_detect_x86_cpu_features(void) +{ + __builtin_cpu_init(); + + HsWord64 feats = 0; + + /* __builtin_cpu_supports returns the feature's (nonzero) mask bit, + not 0/1, so it must be normalized before shifting. */ +#define GHC_CPU_FEATURE(name, bit) \ + if (__builtin_cpu_supports(name)) { feats |= ((HsWord64)1 << (bit)); } + + GHC_CPU_FEATURE("sse2", GHC_X86_FEAT_SSE2) + GHC_CPU_FEATURE("sse3", GHC_X86_FEAT_SSE3) + GHC_CPU_FEATURE("ssse3", GHC_X86_FEAT_SSSE3) + GHC_CPU_FEATURE("sse4.1", GHC_X86_FEAT_SSE4_1) + GHC_CPU_FEATURE("sse4.2", GHC_X86_FEAT_SSE4_2) + GHC_CPU_FEATURE("avx", GHC_X86_FEAT_AVX) + GHC_CPU_FEATURE("avx2", GHC_X86_FEAT_AVX2) + GHC_CPU_FEATURE("avx512f", GHC_X86_FEAT_AVX512F) + GHC_CPU_FEATURE("avx512bw", GHC_X86_FEAT_AVX512BW) + GHC_CPU_FEATURE("avx512cd", GHC_X86_FEAT_AVX512CD) + GHC_CPU_FEATURE("avx512dq", GHC_X86_FEAT_AVX512DQ) + GHC_CPU_FEATURE("avx512vl", GHC_X86_FEAT_AVX512VL) + GHC_CPU_FEATURE("bmi", GHC_X86_FEAT_BMI1) + GHC_CPU_FEATURE("bmi2", GHC_X86_FEAT_BMI2) + + /* FMA is usable only when the OS saves the AVX register state. However + compiler-rt's cpu_model/x86.c reports "fma" from the raw CPUID bit. */ + if (__builtin_cpu_supports("fma") && __builtin_cpu_supports("avx")) { + feats |= ((HsWord64)1 << GHC_X86_FEAT_FMA); + } + +#if GHC_HAS_CPU_SUPPORTS_GFNI + GHC_CPU_FEATURE("gfni", GHC_X86_FEAT_GFNI) +#endif + +#undef GHC_CPU_FEATURE + + return feats; +} + +#else + +/* Non-x86 host, or a compiler without __builtin_cpu_supports (e.g. MSVC): + report no features. */ +HsWord64 ghc_detect_x86_cpu_features(void) +{ + return 0; +} + +#endif ===================================== compiler/ghc.cabal.in ===================================== @@ -187,6 +187,7 @@ Library else c-sources: cbits/cutils.c + cbits/cpu_features_x86.c cbits/genSym.c cbits/keepCAFsForGHCi.c @@ -518,6 +519,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.CpuFeatures GHC.Driver.DynFlags GHC.Driver.IncludeSpecs GHC.Driver.Downsweep ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -74,6 +74,7 @@ -instantiated-with -keep-hi-file -keep-o-file +-march=native -n -no-keep-hi-file -no-keep-o-file ===================================== docs/users_guide/using.rst ===================================== @@ -539,7 +539,9 @@ The available mode flags are: Print a JSON object describing the CPU features currently enabled for code generation, together with a set of ``-m...`` flags that reproduce the effective feature set for the current target. - Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected. + Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected, so this flag + can also be used to inspect which features :ghc-flag:`-march=native` detected + and enabled. .. ghc-flag:: --print-debug-on :shortdesc: print whether GHC was built with ``-DDEBUG`` @@ -1897,6 +1899,34 @@ Some flags only make sense for particular target platforms. so this flag has no effect when used with the :ref:`native code generator <native-code-gen>` or the :ref:`LLVM backend <llvm-code-gen>`. +.. ghc-flag:: -march=native + :shortdesc: (x86 only) Enable all CPU features supported by the host + :type: dynamic + :category: platform-options + + (x86/x86_64 only) Probe the CPU of the machine running GHC and enable all of + the corresponding ``-m...`` CPU-feature options automatically (for example + ``-msse4.2``, ``-mavx2``, ``-mbmi2``, ``-mfma``). The detected features apply + to both the :ref:`native code generator <native-code-gen>` and the + :ref:`LLVM backend <llvm-code-gen>`. + + The detected features are enabled *in addition* to any CPU-feature flags you + pass explicitly, regardless of their order on the command line; ``-march=native`` + never disables a feature. + + The features that were detected and enabled can be inspected with + :ghc-flag:`--print-enabled-cpu-features`. + + .. warning:: + + Code compiled with ``-march=native`` may use instructions that are not + available on other CPUs, and is therefore not portable to a different + machine. + + Only x86 and x86_64 targets are supported so far; the flag is rejected on + other targets. It is also rejected when cross-compiling, since the host CPU + is then unrelated to the target. + Haddock ------- ===================================== rts/RtsSymbols.c ===================================== @@ -1039,6 +1039,41 @@ extern char **environ; #define RTS_ARM_OUTLINE_ATOMIC_SYMBOLS #endif +// libgcc/compiler-rt symbols behind __builtin_cpu_supports/__builtin_cpu_init, +// referenced by compiler/cbits/cpu_features_x86.c (-march=native). +// Without them the runtime linker cannot load the ghc library's object code +// (e.g. for plugins in a statically linked GHCi). Keep the guards in sync +// with cpu_features_x86.c. +#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) \ + && (defined(__GNUC__) || defined(__clang__)) +// __cpu_features2 holds the feature words beyond the first 32 (e.g. GFNI) +// and only exists in the runtimes of GCC >= 11 resp. LLVM >= 12. +#if (defined(__clang_major__) && __clang_major__ >= 12) \ + || (!defined(__clang__) && defined(__GNUC__) && __GNUC__ >= 11) +#define RTS_X86_CPU_FEATURES2_SYMBOLS \ + SymI_NeedsDataProto(__cpu_features2) +#else +#define RTS_X86_CPU_FEATURES2_SYMBOLS +#endif +// Alpine's and Gentoo's musl GCCs patch __builtin_cpu_init to call +// __cpu_indicator_init_local, an alias of __cpu_indicator_init. Weak +// because other musl toolchains lack the alias (and don't reference it). +#if defined(linux_HOST_OS) && !defined(__GLIBC__) +extern void __cpu_indicator_init_local(void) __attribute__((weak)); +#define RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS \ + SymI_NeedsProto(__cpu_indicator_init_local) +#else +#define RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS +#endif +#define RTS_X86_CPU_MODEL_SYMBOLS \ + SymI_NeedsProto(__cpu_indicator_init) \ + SymI_NeedsDataProto(__cpu_model) \ + RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS \ + RTS_X86_CPU_FEATURES2_SYMBOLS +#else +#define RTS_X86_CPU_MODEL_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, SYM_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1199,6 +1234,7 @@ RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_ARCH_LIBGCC_SYMBOLS +RTS_X86_CPU_MODEL_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS @@ -1254,6 +1290,7 @@ void initLinkerRtsSyms (StrHashTable *symhash) { RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_ARCH_LIBGCC_SYMBOLS + RTS_X86_CPU_MODEL_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -17,6 +17,11 @@ test('msse-option-order', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-msse4.2 -msse2']) test('mavx-should-enable-popcnt', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-mavx']) +# -march=native probes the host CPU, so gate on the host actually having SSE4.2 +# (have_cpu_feature reports nothing under cross, skipping the test there too). +test('march-native-enables-popcnt', + [unless((arch('x86_64') or arch('i386')) and have_cpu_feature('sse4_2'), skip), + when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-march=native']) test('avx512-int64-mul', [unless(arch('x86_64'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512dq -mavx512vl']) test('avx512-int64-minmax', [unless(arch('x86_64'), skip), ===================================== testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.asm ===================================== @@ -0,0 +1 @@ +popcnt(?![0-9]) \ No newline at end of file ===================================== testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.hs ===================================== @@ -0,0 +1,11 @@ +-- `-march=native` enables the host's CPU features. On a host with SSE4.2 +-- (gated in all.T via have_cpu_feature) this makes popCount compile to a +-- `popcnt` instruction rather than the SSE2-baseline software fallback. +import Data.Bits + +{-# NOINLINE foo #-} +foo :: Int -> Int +foo x = 1 + popCount x + +main :: IO () +main = print (foo 42) ===================================== testsuite/tests/driver/all.T ===================================== @@ -7,6 +7,12 @@ def normalise_unknown_flag(msg): m = re.search(r'unrecognised flag: \S+', msg) return m.group(0) + '\n' if m else msg +def normalise_march_native_error(msg): + # Keep only the stable '-march=native ...' diagnostic; the program-name + # prefix and any usage trailer vary across configurations. + m = re.search(r'-march=native is [^\n]+', msg) + return m.group(0) + '\n' if m else msg + test('driver011', [extra_files(['A011.hs'])], makefile_test, ['test011']) test('driver012', [extra_files(['A012.hs'])], makefile_test, ['test012']) @@ -265,6 +271,29 @@ test('print_enabled_cpu_features_unknown_flag', run_command, ['{compiler} -mavx22 --print-enabled-cpu-features']) +# -march=native enables at least the x86_64 baseline (SSE2). The full feature +# set is host-dependent, so we only assert the always-present baseline. +test('march_native', + [unless(arch('x86_64') or arch('i386'), skip)], + run_command, + ['{compiler} -march=native --print-enabled-cpu-features | grep -o SSE2']) + +# On non-x86 targets -march=native must be rejected. +test('march_native_unsupported_arch', + [when(arch('x86_64') or arch('i386'), skip), + normalise_errmsg_fun(normalise_march_native_error), exit_code(1)], + run_command, + ['{compiler} -march=native --print-enabled-cpu-features']) + +# -march=native is additive with explicit -m flags, regardless of order: an +# explicitly requested feature (here AVX2, forced on independent of the host) is +# still present whether the flag comes before or after -march=native. +test('march_native_additive', + [unless(arch('x86_64') or arch('i386'), skip)], + run_command, + ['{compiler} -mavx2 -march=native --print-enabled-cpu-features | grep -o AVX2 && ' + '{compiler} -march=native -mavx2 --print-enabled-cpu-features | grep -o AVX2']) + test('T10219', normal, run_command, # `-x hspp` in make mode should work. # Note: need to specify `-x hspp` before the filename. ===================================== testsuite/tests/driver/march_native.stdout ===================================== @@ -0,0 +1 @@ +SSE2 ===================================== testsuite/tests/driver/march_native_additive.stdout ===================================== @@ -0,0 +1,2 @@ +AVX2 +AVX2 ===================================== testsuite/tests/driver/march_native_unsupported_arch.stderr ===================================== @@ -0,0 +1 @@ +-march=native is only supported on x86 and x86_64 targets View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0e58e4b9a708d6a576b2d9d5bd235… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0e58e4b9a708d6a576b2d9d5bd235… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27731] 5 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/T27731 at Glasgow Haskell Compiler / GHC Commits: 192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00 rts: fix ctoi_tuple_spill_words getting out of sync Fix a few places that were not updating ctoi_tuple_spill_words correctly, leading to corruption/crashes when dealing with large unboxed tuples in bytecode: - captureContinuationAndAbort - findRetryFrameHelper/findAtomicallyFrameHelper - interpretBCO bci_BRK_FUN fixes #27633 - - - - - 604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00 Hadrian: don't capture the testsuite driver's output (#27780) a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the cmd' wrapper. cmd' always captures stdout and stderr, and since the caller asks for Exit, it returns without dumping what it captured. As a result the testsuite output no longer appears in CI job logs: failures, performance metrics and the summary were lost with the job. Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that commit do. Fixes #27780. Assisted-by: Claude Fable 5.1 - - - - - 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 6b7dcb25 by Simon Peyton Jones at 2026-09-09T10:14:38+01:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In GHC.Tc.Errors.reportWanteds we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. - - - - - 34 changed files: - + changelog.d/T27731 - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - hadrian/src/Builder.hs - rts/Continuation.c - rts/Interpreter.c - rts/Schedule.c - rts/sm/Evac.c - + testsuite/tests/bytecode/T27633/Obj.hs - + testsuite/tests/bytecode/T27633/T27633a.hs - + testsuite/tests/bytecode/T27633/T27633a.stdout - + testsuite/tests/bytecode/T27633/T27633b.hs - + testsuite/tests/bytecode/T27633/T27633b.stdout - + testsuite/tests/bytecode/T27633/all.T - + testsuite/tests/ghci.debugger/scripts/T27633c.hs - + testsuite/tests/ghci.debugger/scripts/T27633c.script - + testsuite/tests/ghci.debugger/scripts/T27633c.stdout - + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs - testsuite/tests/ghci.debugger/scripts/all.T - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/327f9854de01423b8c419798467097… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/327f9854de01423b8c419798467097… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T26543b] Improve the atvFolder stuff
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC Commits: e2f4f707 by Simon Peyton Jones at 2026-09-09T10:09:22+01:00 Improve the atvFolder stuff ...to use the same idiom that we already use in exprFreeVars. - - - - - 3 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Types/Var/FV.hs Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -223,11 +223,11 @@ addCoreBndrsFV bndrs fv = foldr addCoreBndrFV fv bndrs unitFV :: Var -> SelectiveDFV -- Deals with an occurrence -- Shallow: does not look at the kind -unitFV v = MkFV (\bvs -> EndoOS (do_it bvs)) +unitFV v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs, is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude the bound vars | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -443,11 +443,11 @@ selectiveTcvFolder , tcf_hole = do_hole , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv v = MkFV (\bvs -> EndoOS (do_it bvs)) + do_tcv v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs,is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude bound variables | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v @@ -847,43 +847,67 @@ invisibleVarsOfTypes = foldr (unionVarSet . invisibleVarsOfType) emptyVarSet * * ********************************************************************* -} -{-# INLINE afvFolder #-} -- so that specialization to (const True) works -afvFolder :: (TyCoVar -> Bool) -> TyCoFolder (FV TyCoVarSet DM.Any) +{- Note [Any-free-var folder] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The "any-free-var" folders take a `check_fv` predicate (TyCoVar -> Bool) and +check if any free variable of the type/coercion satisfies it. Our main folders +look like: + + afv_type :: Type -> FV (BoundVars, TyVar -> Bool) Any + +where we cleverly pair the predicate with the forall-bound variables of the type +in the "env" field of (FV env Any). This way we can build the /folder/ once and +for all (independent of the `check_fv` predicate), and the loop passes down +the pair. + +The same idiom is used in `exprFreeVarsDSet` and friends. + +However we are careful to inline `atvFolder` and `runAny` so that we get those +nice tight loops. +-} + +{-# INLINE afvFolder #-} -- See Note [Inlining any-fvs] +afvFolder :: TyCoFolder (FV (BoundVars, TyCoVar -> Bool) DM.Any) -- 'afvFolder' is short for "any-free-var folder", good for checking --- if any shallow free var of a type satisfies a predicate `check_fv` -afvFolder check_fv = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] - , tcf_tyvar = do_tcv, tcf_covar = do_tcv - , tcf_hole = do_hole - , tcf_tycobinder = addBndrFV } +-- if any shallow free var of a type satisfies a predicate `check_fv` +-- The "env" of the (FV env Any) is a pair (bvs,pred) of +-- the bound variables (which are definitely not free), and +-- an "interesting var" predicate which the client supplies +afvFolder = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] + , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_hole = do_hole + , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv tv = MkFV $ \ bvs -> + do_tcv tv = MkFV $ \ (bvs,check_fv) -> Any (not (tv `elemVarSet` bvs) && check_fv tv) do_hole hole = do_tcv (coHoleCoVar hole) +afv_type :: Type -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_types :: [Type] -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_co :: Coercion -> FV (BoundVars, TyVar -> Bool) DM.Any +(afv_type, afv_types, afv_co, _) = foldTyCo afvFolder + +runAny :: (TyVar -> Bool) -> FV (BoundVars, TyCoVar -> Bool) DM.Any -> Bool +{-# INLINE runAny #-} +runAny check_fv fvs = DM.getAny $ runFV fvs (emptyVarSet, check_fv) + anyFreeVarsOfType :: (TyCoVar -> Bool) -> Type -> Bool -anyFreeVarsOfType check_fv ty = DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfType check_fv ty = runAny check_fv (afv_type ty) anyFreeVarsOfTypes :: (TyCoVar -> Bool) -> [Type] -> Bool -anyFreeVarsOfTypes check_fv tys = DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfTypes check_fv tys = runAny check_fv (afv_types tys) anyFreeVarsOfCo :: (TyCoVar -> Bool) -> Coercion -> Bool -anyFreeVarsOfCo check_fv co = DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfCo check_fv co = runAny check_fv (afv_co co) noFreeVarsOfType :: Type -> Bool -noFreeVarsOfType ty = not $ DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfType ty = not $ runAny (const True) (afv_type ty) noFreeVarsOfTypes :: [Type] -> Bool -noFreeVarsOfTypes tys = not $ DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfTypes tys = not $ runAny (const True) (afv_types tys) noFreeVarsOfCo :: Coercion -> Bool -noFreeVarsOfCo co = not $ DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder (const True)) - +noFreeVarsOfCo co = not $ runAny (const True) (afv_co co) {- ************************************************************************ ===================================== compiler/GHC/Types/Var/FV.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.FV ( runFVSelective, runFVSelectiveList, runFVSelectiveSet, InterestingVarFun, - addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, + updEnvFV, addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, emptyFV, -- or `mempty` unionFV, -- or `mappend` mapUnionFV @@ -138,7 +138,7 @@ type BoundVars = TyCoVarSet type VarSetFV = FV BoundVars (EndoOS TyCoVarSet) type DVarSetFV = FV BoundVars (EndoOS DTyCoVarSet) -type SelectiveDFV = FV (InterestingVarFun, BoundVars) (EndoOS DVarSet) +type SelectiveDFV = FV (BoundVars, InterestingVarFun) (EndoOS DVarSet) -- VarSetFV: collects a VarSet -- DVarSetFV: collects a DVarSet (deterministic) -- SelectiveDFV: selectively collects a DVarSet @@ -174,28 +174,28 @@ emptyFV = MkFV (\_ -> mempty) unionFV :: Semigroup a => FV env a -> FV env a -> FV env a unionFV (MkFV' f1) (MkFV' f2) = MkFV (\env -> f1 env <> f2 env) -upd_bndrs_fv :: (env -> env) -> FV env a -> FV env a -{-# INLINE addBndrFV #-} -upd_bndrs_fv upd f = MkFV (\bvs -> runFV f $! upd bvs) +updEnvFV :: (env -> env) -> FV env a -> FV env a +updEnvFV upd f = MkFV (\bvs -> runFV f $! upd bvs) -- Strict application to avoid making a thunk addBndrFV :: TyCoVar -> FV BoundVars a -> FV BoundVars a -addBndrFV tcv = upd_bndrs_fv (\bvs -> extendVarSet bvs tcv) +{-# INLINE addBndrFV #-} +addBndrFV tcv = updEnvFV (\bvs -> extendVarSet bvs tcv) addBndrsFV :: [Var] -> FV BoundVars a -> FV BoundVars a -addBndrsFV tcvs = upd_bndrs_fv (\bvs -> extendVarSetList bvs tcvs) +addBndrsFV tcvs = updEnvFV (\bvs -> extendVarSetList bvs tcvs) -addBndrSelectiveFV :: TyCoVar -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrSelectiveFV :: TyCoVar -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrSelectiveFV tcv - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSet bvs tcv + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSet bvs tcv -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) -addBndrsSelectiveFV :: [Var] -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrsSelectiveFV :: [Var] -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrsSelectiveFV bs - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSetList bvs bs + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSetList bvs bs -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) mapUnionFV :: (Foldable t, Monoid acc) => (a -> FV env acc) -> t a -> FV env acc @@ -221,7 +221,7 @@ runTyCoVarsDSet f = runFVAcc f emptyDVarSet runFVSelective :: InterestingVarFun -> SelectiveDFV -> DVarSet runFVSelective interesting f - = runEndoOS (runFV f (interesting, emptyVarSet)) emptyDVarSet + = runEndoOS (runFV f (emptyVarSet, interesting)) emptyDVarSet runFVSelectiveList :: InterestingVarFun -> SelectiveDFV -> [Var] runFVSelectiveList interesting f = dVarSetElems (runFVSelective interesting f) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2f4f707b4ea34b99a04a7611618562… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2f4f707b4ea34b99a04a7611618562… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: EPA Fix HsCmdDo exact print with comments
by Marge Bot (＠marge-bot) 09 Sep '26

09 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - c358ef9d by Simon Jakobi at 2026-09-09T03:32:34-04:00 FastString: Drop mkFastStringWith's constructor callback All three callers passed the same callback, a partial application of mkNewFastStringShortByteString to the string being interned. That partial application is allocated as a closure before the table lookup, on the common hit path too, although the callback is needed only after a miss. Drop the parameter and call mkNewFastStringShortByteString directly after a miss. Since nothing is passed "with" anymore, rename the function to internSB. Suggested by Simon PJ in #27528: https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031 Assisted-by: Claude Fable 5 - - - - - 04fcdddb by Alan Zimmerman at 2026-09-09T03:32:35-04:00 EPA: Exact print ConDeclGADT without custom enterAnn !16321 brought in explicit capture of parens in a ConDeclGADT. The ExactPrint update introduced a modification of the fundamental function in exact printing, `enterAnn`, by splitting it into a version allowing injection of functionality normally handled by the ExactPrint class methods. This commit refactors that code, to restore the prior `enterAnn` version, by following the convention in ExactPrint of introducing a helper data structure with its own `ExactPrint` instance to achieve the same effect. - - - - - 4 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -320,7 +320,7 @@ data FastStringTable = FastStringTable -- ^ Number of computed z-encodings for all buckets. -- -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk - -- in 'mkFastStringWith' and needs to be boxed any way. + -- in 'internSB' and needs to be boxed any way. -- If this is unpacked, then we box this single 'FastMutInt' once for each -- allocated FastString. (Array# (IORef FastStringTableSegment)) -- ^ concurrent segments @@ -474,9 +474,10 @@ The procedure goes like this: * Otherwise, insert and return the string we created. -} -mkFastStringWith - :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString -mkFastStringWith mk_fs sbs = do +-- | Return the interned 'FastString' for the given bytes, creating and +-- inserting one on a table miss. +internSB :: ShortByteString -> IO FastString +internSB sbs = do FastStringTableSegment lock _ buckets# <- readIORef segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# @@ -487,7 +488,7 @@ mkFastStringWith mk_fs sbs = do -- only run partially and putMVar is not called after takeMVar. noDuplicate n <- get_uid - new_fs <- mk_fs n n_zencs + new_fs <- mkNewFastStringShortByteString sbs n n_zencs withMVar lock $ \_ -> insert new_fs where !(FastStringTable uid n_zencs segments#) = stringTable @@ -523,11 +524,11 @@ bucket_match fs sbs = go fs mkFastStringBytes :: Ptr Word8 -> Int -> FastString mkFastStringBytes !ptr !len = - -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is + -- NB: Might as well use unsafeDupablePerformIO, since internSB is -- idempotent. unsafeDupablePerformIO $ do sbs <- newSBSFromPtr ptr len - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString newSBSFromPtr (Ptr src#) (I# len#) = @@ -541,14 +542,13 @@ newSBSFromPtr (Ptr src#) (I# len#) = mkFastStringByteString :: ByteString -> FastString mkFastStringByteString bs = let sbs = SBS.toShort bs in - inlinePerformIO $ - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an existing 'ShortByteString' without -- copying. mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = - inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an 'HText' mkFastStringShortText :: ShortText -> FastString @@ -560,7 +560,7 @@ mkFastString :: String -> FastString mkFastString str = inlinePerformIO $ do let !sbs = utf8EncodeShortByteString str - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs -- The following rule is used to avoid polluting the non-reclaimable FastString -- table with transient strings when we only want their encoding. ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass) ===================================== compiler/GHC/Hs/Extension/Pass.hs ===================================== @@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a -- but pass-independent, source location type XRecGhc a = GenLocated (Anno a) a +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (HsDocString (GhcPass _)) = SrcSpan type instance Anno HsDocStringChunk = SrcSpan ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -370,10 +370,6 @@ cua CanUpdateAnchor f = f cua CanUpdateAnchorOnly _ = return [] cua NoCanUpdateAnchor _ = return [] -enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a -enterAnn = enterAnnWith exact setAnnotationAnchor - -{-# INLINE enterAnnWith #-} -- | "Enter" an annotation, by using the associated 'anchor' field as -- the new reference point for calculating all DeltaPos positions. -- This is the heart of the exact printing process. @@ -381,17 +377,14 @@ enterAnn = enterAnnWith exact setAnnotationAnchor -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. -enterAnnWith :: (Monad m, Monoid w, Typeable a, Typeable b) => - (a -> EP w m b) -> -- exact - (b -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> b) -> -- setAnnotationAnchor - Entry -> a -> EP w m b -enterAnnWith exactVia _ NoEntryVal a = do +enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a +enterAnn NoEntryVal a = do p <- getPosP debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a) - r <- exactVia a + r <- exact a debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a) return r -enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do +enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do acceptSpan <- getAcceptSpan setAcceptSpan False case anchor' of @@ -502,7 +495,7 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd advance edp debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor') - a' <- exactVia a + a' <- exact a debugM $ "enterAnn:exact a done:" ++ show (showAst anchor') -- Core recursive exactprint done, start end of Entry processing @@ -556,8 +549,8 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd EpaSpan s -> EpaDelta s edp [] _ -> EpaDelta noSrcSpan edp [] let r = case canUpdateAnchor of - CanUpdateAnchor -> setAnnAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) - CanUpdateAnchorOnly -> setAnnAnchor a' newAnchor [] emptyComments + CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) + CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments NoCanUpdateAnchor -> a' return r @@ -3404,13 +3397,13 @@ instance ExactPrint (HsCmd GhcPs) where e' <- markAnnotated e return (HsCmdLet (tkLet', tkIn') binds' e') - exact (HsCmdDo (an0,loc) (L l es)) = do + exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" (an1,es') <- markAnnList' an0 $ do - ee <- mapM markAnnotated es + ee <- markAnnotated es return ee - return (HsCmdDo (an1,loc') (L l es')) + return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- @@ -4264,26 +4257,13 @@ instance ExactPrint (ConDecl GhcPs) where epTokensToComments "(" ops epTokensToComments ")" cps - -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558 outer_bndrs' <- case outer_bndrs of L _ (HsOuterImplicit _) -> return outer_bndrs _ -> markAnnotated outer_bndrs - (inner_bndrs', (mcxt', args', res_ty')) <- markGadtArgs inner_bndrs $ do - mcxt' <- markAnnotated mcxt - args' <- - case args of - (PrefixConGADT x args0) -> do - args0' <- mapM markAnnotated args0 - return (PrefixConGADT x args0') - (RecConGADT (oc,cc,rarr) fields) -> do - oc' <- markEpToken oc - fields' <- markAnnotated fields - cc' <- markEpToken cc - rarr' <- markEpUniToken rarr - return (RecConGADT (oc',cc',rarr') fields') - res_ty' <- markAnnotated res_ty - return (mcxt', args', res_ty') + let ib = toInnerBindings inner_bndrs (mcxt, args, res_ty) + ib' <- markAnnotated ib + let (inner_bndrs', (mcxt', args', res_ty')) = fromInnerBindings ib' return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol' , con_names = cons' @@ -4293,43 +4273,54 @@ instance ExactPrint (ConDecl GhcPs) where , con_modifiers = mods' , con_res_ty = res_ty', con_doc = doc }) --- | Exact print the inner binders of a GADT signature. --- --- It's that complicated because we need to mark comments/trailing anns --- stored inside `L` and mark closing parenthesis _after_ we mark inner --- type: --- --- data T a b where --- MkT :: --- forall a. ( -- mark inside `markGadtArgs` --- forall b. some type -> T a b -- mark everything there --- ) -- mark inside `markGadtArgs` --- --- We don't have the same problem for `HsArgPar` because we ignore it --- during exact-print, "Does not appear in original source" -markGadtArgs :: (Monad m, Monoid w, Typeable a) - => [LHsGadtTelescope GhcPs] -> EP w m a - -> EP w m ([LHsGadtTelescope GhcPs], a) -markGadtArgs args inner_action = go args +-- --------------------------------------------------------------------- + +data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +toInnerBindings :: [LHsGadtTelescope GhcPs] + -> (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) -> InnerBindings +toInnerBindings [] inner = InnerDone inner +toInnerBindings (b:bs) inner = InnerMore b (toInnerBindings bs inner) + +fromInnerBindings :: InnerBindings -> ([LHsGadtTelescope GhcPs], (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs)) +fromInnerBindings = go [] where - go [] = do - r <- inner_action - return ([], r) - go (arg:xs) = enterAnnWith (exact_arg xs) setAnchor (entryFromLocatedA arg) arg + go acc (InnerMore b n) = go (b:acc) n + go acc (InnerDone x) = (acc,x) - exact_arg xs (L l (HsGadtForAll _ tele)) = do - tele' <- markAnnotated tele - (xs', r) <- go xs - return (L l (HsGadtForAll noExtField tele') : xs', r) - exact_arg xs (L l (HsGadtPar (lp, rp))) = do - lp' <- markEpToken lp - (xs', r) <- go xs - rp' <- markEpToken rp - return (L l (HsGadtPar (lp',rp')) : xs', r) +instance ExactPrint InnerBindings where + getAnnotationEntry (InnerMore (L li _) _) = fromAnn li + getAnnotationEntry (InnerDone _) = NoEntryVal - -- The binder just entered is the head of the returned list - setAnchor (arg':xs', r) anc ts cs = (setAnchorAn arg' anc ts cs : xs', r) - setAnchor ([], r) _ _ _ = ([], r) + setAnnotationAnchor (InnerMore li n) anc ts cs = InnerMore (setAnchorAn li anc ts cs) n + setAnnotationAnchor (InnerDone x) _ _ _ = InnerDone x + + exact (InnerMore (L li (HsGadtForAll x tele)) n) = do + tele' <- markAnnotated tele + n' <- markAnnotated n + return (InnerMore (L li (HsGadtForAll x tele')) n') + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + exact (InnerDone (mcxt, args, res_ty)) = do + mcxt' <- markAnnotated mcxt + args' <- + case args of + (PrefixConGADT x args0) -> do + args0' <- mapM markAnnotated args0 + return (PrefixConGADT x args0') + (RecConGADT (oc,cc,rarr) fields) -> do + oc' <- markEpToken oc + fields' <- markAnnotated fields + cc' <- markEpToken cc + rarr' <- markEpUniToken rarr + return (RecConGADT (oc',cc',rarr') fields') + res_ty' <- markAnnotated res_ty + return (InnerDone (mcxt', args', res_ty')) -- --------------------------------------------------------------------- @@ -4508,10 +4499,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" ls' <- markAnnotated ls - initStmts' <- markAnnotated initStmts + initStmts' <- mapM markAnnotated initStmts return (initStmts' ++ [ls']) _ -> do - stmts' <- markAnnotated stmts + stmts' <- mapM markAnnotated stmts return stmts' instance ExactPrint [Located HsDocStringChunk] where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ab270a20d1152aaf89c17c70cdf8c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ab270a20d1152aaf89c17c70cdf8c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] 11 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00 rts: fix ctoi_tuple_spill_words getting out of sync Fix a few places that were not updating ctoi_tuple_spill_words correctly, leading to corruption/crashes when dealing with large unboxed tuples in bytecode: - captureContinuationAndAbort - findRetryFrameHelper/findAtomicallyFrameHelper - interpretBCO bci_BRK_FUN fixes #27633 - - - - - 604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00 Hadrian: don't capture the testsuite driver's output (#27780) a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the cmd' wrapper. cmd' always captures stdout and stderr, and since the caller asks for Exit, it returns without dumping what it captured. As a result the testsuite output no longer appears in CI job logs: failures, performance metrics and the summary were lost with the job. Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that commit do. Fixes #27780. Assisted-by: Claude Fable 5.1 - - - - - 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 5c341aec by Simon Peyton Jones at 2026-09-09T08:16:21+01:00 Try using TyCoMapper for substitutions - - - - - 5fbacf20 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Implement substitution via TyCoMapper This is a significant bit of refactoring. The dependencies look like this, where each module depends on one above Defines Needs --------------------------------------------------- GHC.Core.TyCo.Rep Type, Coercion TyCoFolder GHC.Core.TyCo.FVs Free-var finders TyCoFolder GHC.Core.TyCo.Make Lots of mkX functions Free vars TyCoMapper GHC.Core.TyCo.Subst Substitution TyCoMapper, mkX functions GHC.Core.Type coreView, typeKind Substitution coercionKind GHC.Core.TyCo.Compare Comparison coreView Some `mkX` functions (such as `mkLRCo`, `mkInstCo`, `mkCastTy`) use substitution, and so are defined in GHC.Core.Type via a hs-boot import. - - - - - cd10776c by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Make substitution strict It's nice that it is so easy to do so - - - - - 4c4683e9 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 8d227953 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 02eb1b02 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibble imports - - - - - 6646c67a by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 58 changed files: - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + compiler/GHC/Utils/StrictIdentity.hs - compiler/ghc.cabal.in - hadrian/src/Builder.hs - rts/Continuation.c - rts/Interpreter.c - rts/Schedule.c - rts/sm/Evac.c - + testsuite/tests/bytecode/T27633/Obj.hs - + testsuite/tests/bytecode/T27633/T27633a.hs - + testsuite/tests/bytecode/T27633/T27633a.stdout - + testsuite/tests/bytecode/T27633/T27633b.hs - + testsuite/tests/bytecode/T27633/T27633b.stdout - + testsuite/tests/bytecode/T27633/all.T - + testsuite/tests/ghci.debugger/scripts/T27633c.hs - + testsuite/tests/ghci.debugger/scripts/T27633c.script - + testsuite/tests/ghci.debugger/scripts/T27633c.stdout - + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs - testsuite/tests/ghci.debugger/scripts/all.T - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cabfd30c53b023420eaa5aa8d696f5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cabfd30c53b023420eaa5aa8d696f5… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0