September 2026 - ghc-commits

[Git][ghc/ghc][master] rts: make stg_threadLabelzh return a valid pointer for unlabeled threads.
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 809294f1 by Luite Stegeman at 2026-09-15T20:13:08-04:00 rts: make stg_threadLabelzh return a valid pointer for unlabeled threads. This fixes a segfault in the GC caused by stg_threadLabelzh returning a 0 pointer in a GC pointer field. stg_threadLabelzh returns a tuple of type (# Int#, ByteArray# #). If a thread has no label, the second field is unused. We must still return a valid heap object pointer. Instead of returning 0, we now return stg_DEAD_SLOT_closure. fixes #27618 - - - - - 7 changed files: - + changelog.d/fix-threadlabel-segfault-27618 - rts/PrimOps.cmm - rts/StgMiscClosures.cmm - rts/include/stg/MiscClosures.h - + testsuite/tests/rts/T27618.hs - + testsuite/tests/rts/T27618.stdout - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/fix-threadlabel-segfault-27618 ===================================== @@ -0,0 +1,10 @@ +section: rts +synopsis: Fix a segfault that could occur when querying the label of an + unlabeled thread. +issues: #27618 +mrs: !16468 +description: { + The ``threadLabel#`` primop returned a null pointer in the ``ByteArray#`` + field of its result for threads that have no label. This could lead to a + crash during garbage collection. +} ===================================== rts/PrimOps.cmm ===================================== @@ -51,6 +51,7 @@ import CLOSURE stg_AP_info; import CLOSURE stg_ARR_WORDS_info; import CLOSURE stg_BCO_info; import CLOSURE stg_C_FINALIZER_LIST_info; +import CLOSURE stg_DEAD_SLOT_closure; import CLOSURE stg_DEAD_WEAK_info; import CLOSURE stg_END_STM_WATCH_QUEUE_closure; import CLOSURE stg_END_TSO_QUEUE_closure; @@ -1160,7 +1161,7 @@ stg_threadLabelzh ( gcptr tso ) W_ r; r = StgTSO_label(tso); if (r == 0) { - return (0, 0); + return (0, stg_DEAD_SLOT_closure); } else { return (1, r); } ===================================== rts/StgMiscClosures.cmm ===================================== @@ -726,6 +726,18 @@ INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF,"NO_FINALIZER","NO_FINALIZ CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER); +/* ---------------------------------------------------------------------------- + DEAD_SLOT + + A static nullary constructor for dead pointer-typed result slots + that must still hold a valid closure for the GC (see #27618). + ------------------------------------------------------------------------- */ + +INFO_TABLE_CONSTR(stg_DEAD_SLOT,0,0,0,CONSTR_NOCAF,"DEAD_SLOT","DEAD_SLOT") +{ ccall pbarf("DEAD_SLOT object (%p) entered!", R1 "ptr") never returns; } + +CLOSURE(stg_DEAD_SLOT_closure,stg_DEAD_SLOT); + /* ---------------------------------------------------------------------------- Stable Names are unlifted too. ------------------------------------------------------------------------- */ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -200,6 +200,7 @@ RTS_ENTRY(stg_SRT_16); RTS_CLOSURE(stg_END_TSO_QUEUE_closure); RTS_CLOSURE(stg_NO_FINALIZER_closure); +RTS_CLOSURE(stg_DEAD_SLOT_closure); RTS_CLOSURE(stg_dummy_ret_closure); RTS_CLOSURE(stg_forceIO_closure); RTS_CLOSURE(stg_CLOSURE_TABLE_NULL_closure); @@ -211,6 +212,7 @@ RTS_CLOSURE(stg_END_STM_CHUNK_LIST_closure); RTS_CLOSURE(stg_NO_TREC_closure); RTS_ENTRY(stg_NO_FINALIZER); +RTS_ENTRY(stg_DEAD_SLOT); #if IN_STG_CODE extern StgWordArray stg_CHARLIKE_closure; ===================================== testsuite/tests/rts/T27618.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for a major GC segfault triggered by threadLabel# returning NULL in +-- a GC pointer field on unlabeled threads. Run with -N4 -A32k. + +module Main (main) where + +import Control.Concurrent +import Control.Monad +import Data.IORef +import GHC.Conc.Sync (threadLabel) +import System.Mem (performMajorGC) + +{-# NOINLINE queryLabel #-} +queryLabel :: ThreadId -> IO (Maybe String) +queryLabel = threadLabel + +main :: IO () +main = do + stop <- newIORef False + _ <- forkIO $ forever performMajorGC + targets <- replicateM 8 $ forkIO $ forever (threadDelay 1_000_000) + dones <- forM [1 :: Int .. 8] $ \_ -> do + done <- newEmptyMVar + _ <- forkIO $ do + let loop = do + s <- readIORef stop + unless s $ do + forM_ targets $ \t -> do + r <- queryLabel t + r `seq` pure () + loop + loop + putMVar done () + pure done + threadDelay 2_000_000 + writeIORef stop True + mapM_ takeMVar dones + putStrLn "done" ===================================== testsuite/tests/rts/T27618.stdout ===================================== @@ -0,0 +1 @@ +done ===================================== testsuite/tests/rts/all.T ===================================== @@ -741,3 +741,7 @@ test('T27477', ], compile_and_run, ['-O2']) +test('T27618', + [req_target_smp, omit_ghci], + compile_and_run, ['-O2 -threaded -with-rtsopts "-N4 -A32k"']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/809294f14cf6939b249d93af92c0ae1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/809294f14cf6939b249d93af92c0ae1… 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][master] Revert "wasm: workaround WebKit bug in dyld"
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0f48735b by Cheng Shao at 2026-09-15T20:12:23-04:00 Revert "wasm: workaround WebKit bug in dyld" This reverts commit c9b8465c2c338176fcab9d197e9d31f4aee11f68. The underlying webkit bug has been fixed in https://commits.webkit.org/314219@main. Closes #27564. - - - - - 1 changed file: - utils/jsffi/dyld.mjs Changes: ===================================== utils/jsffi/dyld.mjs ===================================== @@ -783,25 +783,7 @@ class DyLD { // Wasm memory & table #memory = new WebAssembly.Memory({ initial: 1 }); - #table = new WebAssembly.Table({ element: "anyfunc", initial: 1 }); - // First free slot, might be invalid when it advances to #table.length - #tableFree = 1; - // See Note [The evil wasm table grower] - #tableGrowInstance = new WebAssembly.Instance( - new WebAssembly.Module( - new Uint8Array([ - 0, 97, 115, 109, 1, 0, 0, 0, 1, 6, 1, 96, 1, 127, 1, 127, 2, 35, 1, 3, - 101, 110, 118, 25, 95, 95, 105, 110, 100, 105, 114, 101, 99, 116, 95, - 102, 117, 110, 99, 116, 105, 111, 110, 95, 116, 97, 98, 108, 101, 1, - 112, 0, 0, 3, 2, 1, 0, 7, 31, 1, 27, 95, 95, 103, 104, 99, 95, 119, 97, - 115, 109, 95, 106, 115, 102, 102, 105, 95, 116, 97, 98, 108, 101, 95, - 103, 114, 111, 119, 0, 0, 10, 11, 1, 9, 0, 208, 112, 32, 0, 252, 15, 0, - 11, - ]) - ), - { env: { __indirect_function_table: this.#table } } - ); // __stack_pointer #sp = new WebAssembly.Global( @@ -846,82 +828,6 @@ class DyLD { // Global STG registers #regs = {}; - // Note [The evil wasm table grower] - // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - // We need to grow the wasm table as we load shared libraries in - // wasm dyld. We used to directly call the table.grow() JS API, - // which works as expected in Firefox/Chrome, but unfortunately, - // WebKit's implementation of the table.grow() JS API is broken: - // https://bugs.webkit.org/show_bug.cgi?id=290681, which means that - // the wasm dyld simply does not work in WebKit-based browsers like - // Safari. - // - // Now, one simple workaround would be to avoid growing the table at - // all: just allocate a huge table upfront (current limitation - // agreed by all vendors is 10000000). To avoid unnecessary space - // waste on non-WebKit platforms, we could additionally check - // navigator.userAgent against some regexes and only allocate - // fixed-length table when there's no blink/gecko mention. But this - // is fragile and gross, and it's better to stick to a uniform code - // path for all browsers. - // - // Fortunately, it turns out the table.grow wasm instruction work as - // expected in WebKit! So we can invoke a wasm function that grows - // the table for us. But don't open a champagne yet, where would - // that wasm function come from? It can't be put into RTS, or even - // libc.so, because loading those libraries would require growing - // the table in the first place! Or perhaps, reserve a table upfront - // that's just large enough to load RTS and then we can access that - // function for subsequent table grows? But then we need to - // experiment for a reasonable initial size, and add a magic number - // here, which is also fragile and gross and not future-proof! - // - // So this special wasm function needs to live in a single wasm - // module, which is loaded before we load anything else. The full - // source code for this module is: - // - // (module - // (type (func (param i32) (result i32))) - // (import "env" "__indirect_function_table" (table 0 funcref)) - // (export "__ghc_wasm_jsffi_table_grow" (func 0)) - // (func (type 0) (param i32) (result i32) - // ref.null func - // local.get 0 - // table.grow 0 - // ) - // ) - // - // This module is 103 bytes so that we can inline its blob in dyld, - // and use the usually discouraged synchronous - // WebAssembly.Instance/WebAssembly.Module constructors to load it. - // On non-WebKit platforms, growing tables this way would introduce - // a bit of extra JS/Wasm interop overhead, which can be amplified - // as we used to call table.grow(1, foo) for every GOT.func item. - // Therefore, unless we're about to exceed the hard limit of table - // size, we now grow the table exponentially, and use bump - // allocation to calculate the table index to be returned. - // Exponential growth is only implemented to minimize the JS/Wasm - // interop overhead when calling __ghc_wasm_jsffi_table_grow; - // V8/SpiderMonkey/WebKit already do their own exponential growth of - // the table's backing buffer in their table growth logic. - // - // Invariants: n >= 0; when v is non-null, n === 1 - #tableGrow(n, v) { - const prev_free = this.#tableFree; - if (prev_free + n > this.#table.length) { - const min_delta = prev_free + n - this.#table.length; - const delta = Math.max(min_delta, this.#table.length); - this.#tableGrowInstance.exports.__ghc_wasm_jsffi_table_grow( - this.#table.length + delta <= 10000000 ? delta : min_delta - ); - } - if (v) { - this.#table.set(prev_free, v); - } - this.#tableFree += n; - return prev_free; - } - constructor({ args, rpc }) { this.#rpc = rpc; @@ -1116,7 +1022,7 @@ class DyLD { // __memory_base & __table_base, different for each .so let memory_base; - let table_base = this.#tableGrow(tableSize); + let table_base = this.#table.grow(tableSize); console.assert(tableP2Align === 0); // libc.so is always the first one to be ever loaded and has VIP @@ -1220,7 +1126,7 @@ class DyLD { if (this.exportFuncs[name]) { this.#gotFunc[name] = new WebAssembly.Global( { value: "i32", mutable: true }, - this.#tableGrow(1, this.exportFuncs[name]) + this.#table.grow(1, this.exportFuncs[name]) ); continue; } @@ -1271,7 +1177,7 @@ class DyLD { if (this.#gotFunc[k]) { const got = this.#gotFunc[k]; if (got.value === DyLD.#poison) { - const idx = this.#tableGrow(1, v); + const idx = this.#table.grow(1, v); got.value = idx; } else { this.#table.set(got.value, v); @@ -1325,7 +1231,7 @@ class DyLD { // Not in GOT.func yet, create the entry on demand if (this.exportFuncs[sym]) { console.assert(!this.#gotFunc[sym]); - const addr = this.#tableGrow(1, this.exportFuncs[sym]); + const addr = this.#table.grow(1, this.exportFuncs[sym]); this.#gotFunc[sym] = new WebAssembly.Global( { value: "i32", mutable: true }, addr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f48735bf5dbddd3ae43932d8abfbb0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f48735bf5dbddd3ae43932d8abfbb0… 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][master] 6 commits: Refactor (and rename) removeFromQueues, to simplify I/O managers
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8e09a46f by Duncan Coutts at 2026-09-15T20:11:35-04:00 Refactor (and rename) removeFromQueues, to simplify I/O managers Rename it to unblockAndAppendToRunQueue which better reflects what it is intended to do. The post-condition for unblockAndAppendToRunQueue is that the TSO is on the run queue or it is in the process of migrating to another cap. Previously it achieved that by always directly adding the TSO to the run queue itself. But this actually made things more complicated for the I/O managers, because it meant they needed a separate code path for notifying for cancellation compared to notifying for completion. The general notification code would always add the TSO to the run queue itself. So the improvement is to allow different cases in unblockAndAppendToRunQueue to achieve the same outcome in different ways: either directly adding to the run queue or calling helper functions that do so themselves. This then allows the new I/O managers to share code between the sync and async cancellation, and to reuse their notifyIOCompletion helpers for cancellation. This avoids a source of bugs where the completion path may be updated but the cancellation path may be forgotten, or similarly in future for sync/async operations. Update all the existing in-RTS I/O managers, and the posix timeout code. - - - - - d668782c by Duncan Coutts at 2026-09-15T20:11:35-04:00 Document that awaitCompletedTimeoutsOrIO expects an empty run queue This was true before but implicit and not relied on much. It's better to be explicit, and allow things to depend on it. - - - - - 11d938bb by Duncan Coutts at 2026-09-15T20:11:35-04:00 Store the I/O opcode and fd in the StgAsyncIOOp This will be useful in several I/O managers and it is handy for logging and debugging. It also doesn't increase the size of the StgAsyncIOOp structure. There was enough spare padding space already. Update the poll I/O manager to set the new fields. Add a helper function to convert the enum IOReadOrWrite into the enum IOOpCode. Also change IOReadOrWrite to be an enum without a typedef, for consistency with other enumerations in IOManager.h - - - - - bfa87882 by Duncan Coutts at 2026-09-15T20:11:36-04:00 Add a new I/O manager based on select() Yes, this is the second such I/O manager, but it is a modern re-implementation based on the new in-RTS I/O manager infrastructure. So it is cleaner and faster than the old select I/O manager. Why do we need another I/O manager based on select? Why isn't the poll() one good enough as a baseline portable unix I/O manager? Because macOS. Apple Inc. is why we cannot have nice things. The man page for poll on macOS documents the fact that it does not work. At least, it does not work for all files. Specifically, it does not work for device files. Whereas macOS select() does work for device files. Aaaaarg! We _do_ want to deprecate and remove the old select I/O manager, but due to macOS we cannot do that until we have a replacement. This is that replacement. Until of course a nice new k-queue I/O manager arrives, which could become the new default for macOS and FreeBSD. Interestingly, this select I/O manager is actually faster than the poll one, on Linix, in some circumstances: specifically when many Haskell threads are waiting on the same fd. The poll I/O manager does O(n) work for n threads waiting on I/O, whereas the select one does O(fds) work for the number of fds that threads are waiting on. Usually this is 1:1, so it's not noticable, but one can concoct extreme benchmarks to show the difference. - - - - - 8e9de15a by Duncan Coutts at 2026-09-15T20:11:36-04:00 Minor updates in the poll I/O manager to keep in sync with select This keeps it in sync with select one. The changes are based on code review while implementing the new select I/O manager. The two I/O managers are so similar in structure that it makes sense to try to minimise the diff between them. This should aid understanding, and fixes to both in future. - - - - - 222668bb by Duncan Coutts at 2026-09-15T20:11:36-04:00 Document the new select I/O manager in the user guide in the RTS section about I/O managers. And add a changelog entry. - - - - - 20 changed files: - + changelog.d/select-io-manager - docs/users_guide/runtime_control.rst - libraries/base/src/GHC/RTS/Flags.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/RaiseAsync.c - rts/configure.ac - rts/include/rts/Flags.h - rts/include/rts/storage/Closures.h - rts/posix/Poll.c - rts/posix/Poll.h - + rts/posix/SelectBis.c - + rts/posix/SelectBis.h - rts/posix/Timeout.c - rts/posix/Timeout.h - rts/rts.cabal - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 Changes: ===================================== changelog.d/select-io-manager ===================================== @@ -0,0 +1,19 @@ +section: rts +issues: #27519 +mrs: !16359 +synopsis: + New I/O manager based on select() +description: + There is a new I/O manager on Posix systems based on select(). This exists + primarily to support macOS, where the poll() API does not work correctly + (specifically it is documented not to work for device files). It is the new + default I/O manager for the non-threaded RTS for the macOS platform. + + This is intended to allow the legacy select I/O manager to be retired. It is + also a stop-gap measure until a kqueue I/O manager is added. + + The new implementation is marginally faster in some cases. It scales better + for timers, O(log n) rather than O(m). For threads waiting on I/O it is + necessarily still O(n). If used to wait on fds > 1024 it will throw an IO + exception rather than terminating the RTS, as was the behaviour of the old + select I/O manager. ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1441,15 +1441,30 @@ limited. Currently the available I/O managers are: ================ ========= ============ - Name Platforms RTS way +I/O manager name Platforms RTS way ================ ========= ============ ``select`` Posix Non-threaded -``poll`` Posix Non-threaded +``selectbis`` Posix Non-threaded +``poll`` Posix(*) Non-threaded ``mio`` All Threaded ``win32-legacy`` Windows Non-threaded ``winio`` Windows Both ================ ========= ============ +(*) The ``poll`` I/O manager is not available on macOS due to platform +limitations. + +Currently the default I/O manager on each platform is: + +========= ============ =================== +Platform RTS way default I/O manager +========= ============ =================== +macOS Non-threaded ``selectbis`` +Posix Non-threaded ``poll`` +Windows Non-threaded ``win32-legacy`` +all Threaded ``mio`` +========= ============ =================== + .. rts-flag:: --io-manager=(name) Select the I/O manager to use. On some combinations of platform and @@ -1474,7 +1489,8 @@ This is because it uses a linked list for timers. This I/O manager is highly portable and its code is very mature: it is the I/O manager that has been used by GHC in the single-threaded RTS on Posix platforms -since time immemorial. +since time immemorial. It is likely to be retired, once the ``poll`` and +``selectbis`` I/O managers are mature enough to cover all use cases. Timer resolution: on 64bit platforms it supports microsecond precision timers while on 32bit platforms it only supports millisecond precision. Timer accuracy @@ -1485,6 +1501,29 @@ support 1024 open files. More specifically it supports file descriptors with numerical value up to 1024 but no higher. It will terminate the RTS (and thus typically the process) if this limit is exceeded. +The ``selectbis`` I/O manager +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This I/O manager based on the classic Posix ``select()`` API. It supports +waiting on I/O readiness on non-blocking file descriptors (i.e. not disk files). +It is implemented within the RTS and is currently available only in the +non-threaded RTS. + +It scales poorly for I/O readiness notification: costing O(n) in the number of +threads that are waiting on I/O simultaneously. It scales well for timers: +most timer operations cost O(log n) in the number of simultaneous timers. This +is because it uses a heap data structure for timers. + +Timer resolution: this I/O manager supports microsecond precision timers. + +Limitation: on most platforms where it is available this I/O manager can only +support 1024 open files. More specifically it supports file descriptors with +numerical value up to 1024 but no higher. It will throw an IO exception if this +limit is exceeded. + +This I/O manager exists primarily to support macOS, due to ``poll()`` not +working properly on macOS, while ``select()`` does work. It's name reflects +the fact that it is the second I/O manager to be based on ``select()``. + The ``poll`` I/O manager ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1512,6 +1551,10 @@ limit can be adjusted using OS facilities (e.g. the ``ulimit`` command). Exceeding this limit will cause the RTS (and thus typically the process) to terminate. +This I/O manager is not available on macOS due to the ``poll()`` API not +working for all file types on macOS. Specifically the macOS man page for +``poll`` documents that it does not work for device files. + The ``mio`` I/O manager ~~~~~~~~~~~~~~~~~~~~~~~ This I/O manager is based on several platform-specific APIs. It supports ===================================== libraries/base/src/GHC/RTS/Flags.hs ===================================== @@ -393,10 +393,11 @@ internal_to_base_MiscFlags i@Internal.MiscFlags{..} = internal_to_base_ioManager Internal.IoManagerFlagAuto = IoManagerFlagAuto internal_to_base_ioManager Internal.IoManagerFlagSelect = IoManagerFlagSelect #if __GLASGOW_HASKELL__ >= 1000 + internal_to_base_ioManager Internal.IoManagerFlagSelectBis = IoManagerFlagAuto internal_to_base_ioManager Internal.IoManagerFlagPoll = IoManagerFlagAuto - -- This is a lie, we cannot translate poll. We cannot translate - -- accurately because want to freeze the API of the the compat RTS flags - -- here. Using "auto" is the least bad translation. + -- This is a lie, we cannot translate these new I/O managers. We cannot + -- translate accurately because want to freeze the API of the the compat + -- RTS flags here. Using "auto" is the least bad translation. -- https://github.com/haskell/core-libraries-committee/issues/362 #endif internal_to_base_ioManager Internal.IoManagerFlagMIO = IoManagerFlagMIO ===================================== libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc ===================================== @@ -182,6 +182,7 @@ data MiscFlags = MiscFlags data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect -- ^ Unix only, non-threaded RTS only + | IoManagerFlagSelectBis -- ^ Unix only, non-threaded RTS only | IoManagerFlagPoll -- ^ Unix only, non-threaded RTS only | IoManagerFlagMIO -- ^ cross-platform, threaded RTS only | IoManagerFlagWinIO -- ^ Windows only ===================================== rts/IOManager.c ===================================== @@ -33,6 +33,11 @@ #include "posix/Signals.h" #endif +#if defined(IOMGR_ENABLED_SELECTBIS) +#include "posix/SelectBis.h" +#include "posix/Timeout.h" +#endif + #if defined(IOMGR_ENABLED_POLL) #include "posix/Poll.h" #include "posix/Timeout.h" @@ -117,6 +122,14 @@ parseIOManagerFlag(const char *iomgrstr, IO_MANAGER_FLAG *flag) return IOManagerAvailable; #else return IOManagerUnavailable; +#endif + } + else if (strcmp("selectbis", iomgrstr) == 0) { +#if defined(IOMGR_ENABLED_SELECTBIS) + *flag = IO_MNGR_FLAG_SELECTBIS; + return IOManagerAvailable; +#else + return IOManagerUnavailable; #endif } else if (strcmp("poll", iomgrstr) == 0) { @@ -226,6 +239,8 @@ void selectIOManager(void) #else // !defined(THREADED_RTS) #if defined(IOMGR_DEFAULT_NON_THREADED_SELECT) iomgr_type = IO_MANAGER_SELECT; +#elif defined(IOMGR_DEFAULT_NON_THREADED_SELECTBIS) + iomgr_type = IO_MANAGER_SELECTBIS; #elif defined(IOMGR_DEFAULT_NON_THREADED_POLL) iomgr_type = IO_MANAGER_POLL; #elif defined(IOMGR_DEFAULT_NON_THREADED_WINIO) @@ -244,6 +259,12 @@ void selectIOManager(void) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MNGR_FLAG_SELECTBIS: + iomgr_type = IO_MANAGER_SELECTBIS; + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MNGR_FLAG_POLL: iomgr_type = IO_MANAGER_POLL; @@ -291,6 +312,10 @@ char * showIOManager(void) case IO_MANAGER_SELECT: return "select"; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + return "selectbis"; +#endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: return "poll"; @@ -347,6 +372,12 @@ void initCapabilityIOManager(CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + initCapabilityIOManagerSelectBis(iomgr); + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: initCapabilityIOManagerPoll(iomgr); @@ -380,6 +411,12 @@ void freeCapabilityIOManager(CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + freeCapabilityIOManagerSelectBis(iomgr); + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: freeCapabilityIOManagerPoll(iomgr); @@ -464,6 +501,7 @@ restartIOManager(CapIOManager *iomgr, Capability **pcap) break; #endif /* The IO_MANAGER_SELECT needs no initialisation */ + /* The IO_MANAGER_SELECTBIS needs no initialisation */ /* The IO_MANAGER_POLL needs no initialisation */ /* No impl for any of the Windows I/O managers, since no forking. */ @@ -555,8 +593,14 @@ void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: +#endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: +#endif markClosureTable(evac, user, &iomgr->aiop_table); evac(user, (StgClosure **)(void *)&iomgr->timeout_queue); break; @@ -600,6 +644,11 @@ bool anyPendingTimeoutsOrIO(CapIOManager *iomgr) || (iomgr->sleeping_queue != END_TSO_QUEUE); #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + return anyPendingTimeoutsOrIOSelectBis(iomgr); +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: return anyPendingTimeoutsOrIOPoll(iomgr); @@ -659,6 +708,12 @@ void pollCompletedTimeoutsOrIO(CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + pollCompletedTimeoutsOrIOSelectBis(iomgr); + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: pollCompletedTimeoutsOrIOPoll(iomgr); @@ -685,6 +740,7 @@ void pollCompletedTimeoutsOrIO(CapIOManager *iomgr) bool awaitCompletedTimeoutsOrIO(CapIOManager *iomgr) { debugTrace(DEBUG_iomanager, "waiting for completed IO or timeouts"); + ASSERT(emptyRunQueue(iomgr->cap)); bool completed = true; // wait completed or interrupted? switch (iomgr_type) { #if defined(IOMGR_ENABLED_SELECT) @@ -693,6 +749,12 @@ bool awaitCompletedTimeoutsOrIO(CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + completed = awaitCompletedTimeoutsOrIOSelectBis(iomgr); + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: completed = awaitCompletedTimeoutsOrIOPoll(iomgr); @@ -734,6 +796,12 @@ void interruptIOManager(CapIOManager *iomgr) break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + interruptIOManagerSelectBis(iomgr); + break; +#endif + #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: interruptIOManagerPoll(iomgr); @@ -761,10 +829,10 @@ void interruptIOManager(CapIOManager *iomgr) /* CMM primop. Result is true on success, or false on allocation failure. */ -IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, - StgTSO *tso, - IOReadOrWrite rw, - HsInt fd) +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, + StgTSO *tso, + enum IOReadOrWrite rw, + HsInt fd) { debugTrace(DEBUG_iomanager, "thread %ld waiting for %s I/O readiness on fd %d", @@ -783,6 +851,10 @@ IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, return IOSubmitResultAsyncContinue; } #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + return syncIOWaitReadySelectBis(iomgr, tso, rw, fd); +#endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: return syncIOWaitReadyPoll(iomgr, tso, rw, fd); @@ -803,6 +875,13 @@ void syncIOCancel(CapIOManager *iomgr, StgTSO *tso) &iomgr->blocked_queue_hd, &iomgr->blocked_queue_tl, tso); + appendToRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); + break; +#endif +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: + syncIOCancelSelectBis(iomgr, tso); break; #endif #if defined(IOMGR_ENABLED_POLL) @@ -817,11 +896,14 @@ void syncIOCancel(CapIOManager *iomgr, StgTSO *tso) &iomgr->blocked_queue_tl, tso); abandonWorkRequest(tso->block_info.async_reqID); + appendToRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; #endif default: barf("syncIOCancel not supported for I/O manager %d", iomgr_type); } + ASSERT(tso->why_blocked == NotBlocked); } @@ -848,8 +930,14 @@ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) return true; } #endif +#if defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: +#endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: +#endif return syncDelayTimeout(iomgr, tso, us_delay); #endif #if defined(IOMGR_ENABLED_WIN32_LEGACY) @@ -883,10 +971,18 @@ void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso) case IO_MANAGER_SELECT: ASSERT(tso->why_blocked == (BlockedOnDelay | BlockInfoForceNonClosure)); removeThreadFromQueue(iomgr->cap, &iomgr->sleeping_queue, tso); + appendToRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); break; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_SELECTBIS) + case IO_MANAGER_SELECTBIS: +#endif #if defined(IOMGR_ENABLED_POLL) case IO_MANAGER_POLL: +#endif syncDelayCancelTimeout(iomgr, tso); break; #endif @@ -900,6 +996,7 @@ void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso) default: barf("syncDelayCancel not supported for I/O manager %d", iomgr_type); } + ASSERT(tso->why_blocked == NotBlocked); } ===================================== rts/IOManager.h ===================================== @@ -53,6 +53,9 @@ extern bool rts_IOManagerIsWin32Native; #if defined(IOMGR_BUILD_SELECT) && !defined(THREADED_RTS) #define IOMGR_ENABLED_SELECT #endif +#if defined(IOMGR_BUILD_SELECTBIS) && !defined(THREADED_RTS) + #define IOMGR_ENABLED_SELECTBIS +#endif #if defined(IOMGR_BUILD_POLL) && !defined(THREADED_RTS) #define IOMGR_ENABLED_POLL #endif @@ -95,6 +98,8 @@ extern bool rts_IOManagerIsWin32Native; #else // !defined(THREADED_RTS) #if defined(IOMGR_DEFAULT_NON_THREADED_SELECT) #define IOMGR_DEFAULT_STR "select" +#elif defined(IOMGR_DEFAULT_NON_THREADED_SELECTBIS) + #define IOMGR_DEFAULT_STR "selectbis" #elif defined(IOMGR_DEFAULT_NON_THREADED_POLL) #define IOMGR_DEFAULT_STR "poll" #elif defined(IOMGR_DEFAULT_NON_THREADED_WINIO) @@ -115,6 +120,11 @@ extern bool rts_IOManagerIsWin32Native; #else #define IOMGR_ENABLED_STR_SELECT "" #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + #define IOMGR_ENABLED_STR_SELECTBIS " selectbis" +#else + #define IOMGR_ENABLED_STR_SELECTBIS "" +#endif #if defined(IOMGR_ENABLED_POLL) #define IOMGR_ENABLED_STR_POLL " poll" #else @@ -137,6 +147,7 @@ extern bool rts_IOManagerIsWin32Native; #endif #define IOMGRS_ENABLED_STR \ IOMGR_ENABLED_STR_SELECT \ + IOMGR_ENABLED_STR_SELECTBIS \ IOMGR_ENABLED_STR_POLL \ IOMGR_ENABLED_STR_MIO \ IOMGR_ENABLED_STR_WINIO \ @@ -150,6 +161,9 @@ typedef enum { #if defined(IOMGR_ENABLED_SELECT) IO_MANAGER_SELECT, #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + IO_MANAGER_SELECTBIS, +#endif #if defined(IOMGR_ENABLED_POLL) IO_MANAGER_POLL, #endif @@ -212,7 +226,19 @@ char * showIOManager(void); */ bool is_io_mng_native_p (void); +/* Values for StgAsyncIOOp.operation. + * + * Note: this is encoded in 6 bits in StgAsyncIOOp. + */ +enum IOOpCode { + IOOpCodeWaitRead = 0, + IOOpCodeWaitWrite = 1 + /* This will be extended, e.g. for Read/Write */ +}; + /* Values for StgAsyncIOOp.outcome. + * + * Note: this is encoded in 2 bits in StgAsyncIOOp. */ enum IOOpOutcome { IOOpOutcomeInFlight = 0, @@ -314,7 +340,17 @@ void markCapabilityIOManager(evac_fn evac, void *user, CapIOManager *iomgr); /* Several code paths are almost identical between read and write paths. In * such cases we use a shared code path with an enum to say which we're doing. */ -typedef enum { IORead = 0, IOWrite = 1 } IOReadOrWrite; +enum IOReadOrWrite { IORead = 0, IOWrite = 1 }; + +INLINE_HEADER enum IOOpCode convIOReadOrWriteToIOOpCode (enum IOReadOrWrite rw) +{ + // The codes are compatible: + ASSERT((int) IOOpCodeWaitRead == (int) IORead && + (int) IOOpCodeWaitWrite == (int) IOWrite); + + return (enum IOOpCode) rw; +} + /* Synchronous operations: I/O and delays. As synchronous operations they * necessarily operate on threads. The thread is suspended until the operation @@ -351,13 +387,16 @@ enum IOSubmitResultCodes { }; /* Called from CMM primop */ -IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, IOReadOrWrite rw, HsInt fd); +IOSubmitResult syncIOWaitReady(CapIOManager *iomgr, StgTSO *tso, + enum IOReadOrWrite rw, HsInt fd); +/* Cancel the I/O the TSO is blocked on and add the TSO to the run queue */ void syncIOCancel(CapIOManager *iomgr, StgTSO *tso); /* Called from CMM primop */ bool syncDelay(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay); +/* Cancel the timeout the TSO is blocked on and add the TSO to the run queue */ void syncDelayCancel(CapIOManager *iomgr, StgTSO *tso); #if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_WIN32_LEGACY) @@ -390,6 +429,11 @@ void pollCompletedTimeoutsOrIO(CapIOManager *iomgr); * does complete (or we get a signal with a handler) and process the * completions as appropriate. * + * This should _only_ be called when there are no runnable threads and it is + * thus accepable to block and wait for I/O or timeouts. Notably this means it + * must _not_ be used in the threaded RTS (where it is unacceptable to block + * a capability). + * * Upon returning true this guarantees that the scheduler run queue is * non-empty or that the scheduler is no longer in the running state. * Succinctly, the post-condition in the return true case is ===================================== rts/IOManagerInternals.h ===================================== @@ -14,12 +14,20 @@ #include "IOManager.h" -#if defined(IOMGR_ENABLED_POLL) -#include <poll.h> /* for struct pollfd */ +#if defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) #include "ClosureTable.h" #include "TimeoutQueue.h" #endif +#if defined(IOMGR_ENABLED_SELECTBIS) +#include <sys/select.h> /* for fd_set */ +#endif + +#if defined(IOMGR_ENABLED_POLL) +#include <poll.h> /* for struct pollfd */ +#endif + #include "BeginPrivate.h" /* The per-capability data structures belonging to the I/O manager. @@ -46,19 +54,26 @@ struct _CapIOManager { StgTSO *sleeping_queue; #endif -#if defined(IOMGR_ENABLED_SELECT) || defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_SELECT) \ + || defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) #if defined(HAVE_PREEMPTION) /* FDs for waking up the I/O manager when it is blocked waiting */ int interrupt_fd_r, interrupt_fd_w; #endif #endif -#if defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_POLL) \ + || defined(IOMGR_ENABLED_SELECTBIS) /* AIOP and timeout collections shared by several I/O manager impls */ ClosureTable aiop_table; StgTimeoutQueue *timeout_queue; #endif +#if defined(IOMGR_ENABLED_SELECTBIS) + fd_set *rfds, *wfds; +#endif + #if defined(IOMGR_ENABLED_POLL) /* Auxiliary table with size and indexes matching the aiop_table. This is * aliased to the tail of the full poll table, which has a head entry for ===================================== rts/RaiseAsync.c ===================================== @@ -28,7 +28,7 @@ static void blockedThrowTo (Capability *cap, StgTSO *target, MessageThrowTo *msg); -static void removeFromQueues(Capability *cap, StgTSO *tso); +static void unblockAndAppendToRunQueue(Capability *cap, StgTSO *tso); static void removeFromMVarBlockedQueue (StgTSO *tso); @@ -62,8 +62,10 @@ throwToSingleThreaded__ (Capability *cap, StgTSO *tso, StgClosure *exception, return; } - // Remove it from any blocking queues - removeFromQueues(cap,tso); + // Remove it from any blocking queues and add it to the run queue + unblockAndAppendToRunQueue(cap,tso); + ASSERT(tso->why_blocked == NotBlocked || + tso->why_blocked == ThreadMigrating); raiseAsync(cap, tso, exception, stop_at_atomically, stop_here); } @@ -471,7 +473,7 @@ check_target: blockedThrowTo(cap,target,msg); return THROWTO_BLOCKED; } else { - removeFromQueues(cap,target); + unblockAndAppendToRunQueue(cap,target); raiseAsync(cap, target, msg->exception, false, NULL); return THROWTO_SUCCESS; } @@ -612,16 +614,7 @@ awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso) tso->blocked_exceptions = END_BLOCKED_EXCEPTIONS_QUEUE; } -/* ----------------------------------------------------------------------------- - Remove a thread from blocking queues. - - This is for use when we raise an exception in another thread, which - may be blocked. - - Precondition: we have exclusive access to the TSO, via the same set - of conditions as throwToSingleThreaded() (c.f.). - -------------------------------------------------------------------------- */ - +// Helper for unblockAndAppendToRunQueue static void removeFromMVarBlockedQueue (StgTSO *tso) { @@ -664,13 +657,24 @@ removeFromMVarBlockedQueue (StgTSO *tso) tso->_link = END_TSO_QUEUE; } +/* ----------------------------------------------------------------------------- + Remove a thread from blocking queues (if any) and add it to the run queue + (if it wasn't on the run queue already). + + This is for use when we raise an exception in another thread, which + may be blocked. + + Precondition: we have exclusive access to the TSO, via the same set + of conditions as throwToSingleThreaded() (c.f.). + -------------------------------------------------------------------------- */ + static void -removeFromQueues(Capability *cap, StgTSO *tso) +unblockAndAppendToRunQueue(Capability *cap, StgTSO *tso) { switch (UntagWhyBlocked(ACQUIRE_LOAD(&tso->why_blocked))) { - case NotBlocked: - case ThreadMigrating: + case NotBlocked: // Already on the run queue + case ThreadMigrating: // Not added to the run queue return; case BlockedOnSTM: @@ -680,16 +684,16 @@ removeFromQueues(Capability *cap, StgTSO *tso) // perhaps have a debugging test to make sure that this really // happens and that the 'zombie' transaction does not get // committed. - goto done; + break; case BlockedOnMVar: case BlockedOnMVarRead: removeFromMVarBlockedQueue(tso); - goto done; + break; case BlockedOnBlackHole: // nothing to do - goto done; + break; case BlockedOnMsgThrowTo: { @@ -709,18 +713,19 @@ removeFromQueues(Capability *cap, StgTSO *tso) case BlockedOnDoProc: // These blocking reasons are only used by some I/O managers syncIOCancel(cap->iomgr, tso); - goto done; + return; case BlockedOnDelay: // This blocking reasons is only used by some I/O managers syncDelayCancel(cap->iomgr, tso); - goto done; + return; default: - barf("removeFromQueues: %d", tso->why_blocked); + barf("unblockAndAppendToRunQueue: %d", tso->why_blocked); } - done: + // The cases above that use return add the TSO to the run queue themselves + // (or don't need to). For the rest (that use break) we do it here. appendToRunQueue(cap, tso); RELEASE_STORE(&tso->why_blocked, NotBlocked); } ===================================== rts/configure.ac ===================================== @@ -368,6 +368,15 @@ GHC_IOMANAGER_ENABLE([select], [EnableIOManagerSelect], [IOMGR_BUILD_SELECT], [AC_MSG_ERROR([sys/select.h required by select I/O manager])],[]) fi]) +GHC_IOMANAGER_ENABLE([selectbis], [EnableIOManagerSelectBis], [IOMGR_BUILD_SELECTBIS], + [if test "$HostOS" = "mingw32"; then + EnableIOManagerSelectBis=NO + else + AC_CHECK_HEADER([sys/select.h], + [EnableIOManagerSelectBis=YES], + [AC_MSG_ERROR([sys/select.h required by selectbis I/O manager])],[]) + fi]) + GHC_IOMANAGER_ENABLE([poll], [EnableIOManagerPoll], [IOMGR_BUILD_POLL], [if test "$HostOS" = "mingw32"; then EnableIOManagerPoll=NO @@ -406,6 +415,7 @@ if test "$HostOS" = "mingw32"; then GHC_IOMANAGER_DEFAULT_SELECT([IOManagerThreadedDefault], [mio], [EnableIOManagerMIO]) else GHC_IOMANAGER_DEFAULT_SELECT([IOManagerNonThreadedDefault], [select], [EnableIOManagerSelect]) + GHC_IOMANAGER_DEFAULT_SELECT([IOManagerNonThreadedDefault], [selectbis], [EnableIOManagerSelectBis]) GHC_IOMANAGER_DEFAULT_SELECT([IOManagerNonThreadedDefault], [poll], [EnableIOManagerPoll]) GHC_IOMANAGER_DEFAULT_SELECT([IOManagerThreadedDefault], [mio], [EnableIOManagerMIO]) fi @@ -419,6 +429,9 @@ dnl Now define CPP vars for the default ones (threaded and non-threaded) GHC_IOMANAGER_DEFAULT_AC_DEFINE([IOManagerNonThreadedDefault], [non-threaded], [select], [IOMGR_DEFAULT_NON_THREADED_SELECT]) +GHC_IOMANAGER_DEFAULT_AC_DEFINE([IOManagerNonThreadedDefault], [non-threaded], + [selectbis], [IOMGR_DEFAULT_NON_THREADED_SELECTBIS]) + GHC_IOMANAGER_DEFAULT_AC_DEFINE([IOManagerNonThreadedDefault], [non-threaded], [poll], [IOMGR_DEFAULT_NON_THREADED_POLL]) ===================================== rts/include/rts/Flags.h ===================================== @@ -258,6 +258,7 @@ typedef enum _IO_MANAGER_FLAG { /* All other choices pick only the requested one, with no fallback. */ IO_MNGR_FLAG_SELECT, /* Unix only, non-threaded RTS only */ + IO_MNGR_FLAG_SELECTBIS, /* Unix only, non-threaded RTS only */ IO_MNGR_FLAG_POLL, /* Unix only, non-threaded RTS only */ IO_MNGR_FLAG_MIO, /* cross-platform, threaded RTS only */ IO_MNGR_FLAG_WINIO, /* Windows only */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -823,6 +823,8 @@ typedef struct { // In the threaded way there is one I/O manager per capability. We have // to handle cross-capability I/O op cancellation specially, so we need // to know which capability an aiop is being managed on. + // + // We could probably afford to steal some bits here if needed. uint16_t capno; // This tells us which thing the notify union above contains. It is a @@ -837,7 +839,30 @@ typedef struct { // 3: IOOpOutcomeCancelled: cancelled, no further detail. uint16_t outcome: 2; - // 12 bits going spare! + // The I/O operation we are performing. It is a value from enum IOOpCode, + // but we don't use the enum type here due to portability concerns for + // this C bitfield. + // + // The size of this field, allows us up to 64 opcodes. + uint16_t operation: 6; + + // 6 bits going spare! + uint16_t padding: 6; + + // The file descriptor the operation is on. This is used in several I/O + // managers to group StgAsyncIOOps by fd. In particular this is needed + // for cancelling all wait-notification ops when closing an fd. It is + // also handy for logging and debugging. + // + // Note that it is technically possible to stuff Win32 HANDLEs into here, + // but no Win32 I/O manager does this _yet_. See: + // https://learn.microsoft.com/en-us/windows/win32/winprog64/interprocess-comm… + // > 64-bit versions of Windows use 32-bit handles for interoperability. + // > When sharing a handle between 32-bit and 64-bit applications, only + // > the lower 32 bits are significant, so it is safe to truncate the + // > handle (when passing it from 64-bit to 32-bit) or sign-extend the + // > handle (when passing it from 32-bit to 64-bit). + uint32_t fd; union { // For successful outcomes, this is the result code of the operation. @@ -850,10 +875,6 @@ typedef struct { uint32_t error; }; - // Round it up to 2 words on 64bit platforms. - // This is also space for future extension, without increasing the size. - uint32_t padding; - // Note that because we use fixed size Ctypes here then the size in words // of this heap object is different on 32bit and 64bit platforms. // We handle this in the INFO_TABLE_CONSTR decl for stg_ASYNCIOOP using ===================================== rts/posix/Poll.c ===================================== @@ -132,7 +132,7 @@ the aiop_table, but still allows the full_poll_table to have an extra entry. /* Forward declarations */ static bool enlargeTables(CapIOManager *iomgr); static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop); -static void ioCancel(CapIOManager *iomgr, StgAsyncIOOp *aiop); +static void removeFromTables(CapIOManager *iomgr, int i); static void reportPollError(int res, nfds_t nfds) STG_NORETURN; @@ -172,7 +172,7 @@ void freeCapabilityIOManagerPoll(CapIOManager *iomgr) /* Used to implement syncIOWaitReady. */ IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd) + enum IOReadOrWrite rw, HsInt fd) { StgAsyncIOOp *aiop; aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp)); @@ -188,7 +188,7 @@ IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, } IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd) + enum IOReadOrWrite rw, int fd) { if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) { bool ok = enlargeTables(iomgr); @@ -203,9 +203,11 @@ IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, /* The syncIO wrapper or CMM primop filled in the notify and live fields, * we fill the rest. */ - aiop->capno = iomgr->cap->no; - aiop->index = ix; - aiop->outcome = IOOpOutcomeInFlight; + aiop->capno = iomgr->cap->no; + aiop->index = ix; + aiop->outcome = IOOpOutcomeInFlight; + aiop->operation = convIOReadOrWriteToIOOpCode(rw); + aiop->fd = fd; /* Fill in the corresponding entry in the aiop_poll_table */ iomgr->aiop_poll_table[ix] = (struct pollfd) { @@ -222,20 +224,7 @@ void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso) StgAsyncIOOp *aiop = tso->block_info.aiop; 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 - * status, as that is done by removeFromQueues (in the throwTo* functions). - */ - - /* We are in the TSO case, where the aiop was only reachable from the TSO - * itself, and thus it is now no longer be reachable at all. - */ - IF_NONMOVING_WRITE_BARRIER_ENABLED { - updateRemembSetPushClosure(iomgr->cap, (StgClosure *)aiop); - } + asyncIOCancelPoll(iomgr, aiop); } @@ -246,29 +235,14 @@ void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop) * because each aiop is GC heap allocated, so cannot be recycled until it * is no longer retained by the application. */ - ASSERT(aiop->notify_type != NotifyTSO); if (indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop) { - ioCancel(iomgr, aiop); + removeFromTables(iomgr, aiop->index); + aiop->outcome = IOOpOutcomeCancelled; notifyIOCompletion(iomgr, aiop); } } -static void ioCancel(CapIOManager *iomgr, StgAsyncIOOp *aiop) -{ - int ix = aiop->index; - int ix_from; int ix_to; - removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, ix, - &ix_from, &ix_to); - if (ix_to != ix_from) { - StgAsyncIOOp *aiop_to = indexClosureTable(&iomgr->aiop_table, ix_to); - aiop_to->index = ix_to; - iomgr->aiop_poll_table[ix_to] = iomgr->aiop_poll_table[ix_from]; - } - aiop->outcome = IOOpOutcomeCancelled; -} - - bool anyPendingTimeoutsOrIOPoll(CapIOManager *iomgr) { return !isEmptyTimeoutQueue(iomgr->timeout_queue) @@ -313,6 +287,15 @@ static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) } +/* Called from poll/awaitCompletedTimeoutsOrIOPoll after a successful poll() + * call to process all the I/O completions. + * + * We match up the I/O completion notifications from the system call against + * the pending I/O operations from the aiop_table, and use notifyIOCompletion + * on each completed aiop. + * + * Returns true if the poll() was interupted via iomgr->interrupt_fd_r. + */ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) { /* The scheme we use with poll is that we have a dense poll table, and a @@ -323,6 +306,7 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) */ debugTrace(DEBUG_iomanager, "processIOCompletions(ncompletions = %d)", ncompletions); + ASSERT(ncompletions > 0); bool interrupt = false; #if defined(HAVE_PREEMPTION) @@ -337,9 +321,8 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) #endif struct pollfd *aiop_poll_table = iomgr->aiop_poll_table; - int n = ncompletions; int i = 0; - while (n > 0) { + while (ncompletions > 0) { ASSERT(i < sizeClosureTable(&iomgr->aiop_table)); /* Since each aiop_table entry is for a single (fd, rw) pair, we @@ -349,6 +332,8 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) if (aiop_poll_table[i].revents) { StgAsyncIOOp *aiop = indexClosureTable(&iomgr->aiop_table, i); + ASSERT(aiop->outcome == IOOpOutcomeInFlight); + /* We do need to handle POLLNVAL, but we do not need to do anything * special for POLLERR or POLLHUP. (See man poll for details). * The calling thread will typically try to do I/O after waiting @@ -364,26 +349,14 @@ static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) aiop->result = 0; } - /* Remove from the completion table, preserving compactness, and - * apply the same compacting to the aiop_poll_table. - */ - int ix_from; int ix_to; - removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, i, - &ix_from, &ix_to); - if (ix_to != ix_from) { - StgAsyncIOOp *aiop_to; - aiop_to = indexClosureTable(&iomgr->aiop_table, ix_to); - aiop_to->index = ix_to; - aiop_poll_table[ix_to] = aiop_poll_table[ix_from]; - } - + removeFromTables(iomgr, i); notifyIOCompletion(iomgr, aiop); - n--; + ncompletions--; } else { - /* You'd expect incrementing the poll table index to be - * unconditional, but we don't increment the index if we did - * process the entry, because using removeCompactClosureTable - * means we'll move an entry from the end into the same index. + /* You'd expect incrementing the table index to be unconditional, + * but we don't increment the index if we did process the entry, + * because using removeFromTables means we'll move an entry from + * the end of the table into the index i. */ i++; } @@ -532,9 +505,12 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr) int ncompletions = res; ASSERT(ncompletions <= (int)nfds); interrupt = processIOCompletions(iomgr, ncompletions); - // FIXME: do we also need to check for timeout completions now? - // we have a non-empty queue, but if !wait then we have also moved - // on and so we sould check for timeouts. + /* We do _not_ need to check for timeouts again here. We know that + * poll() returned due to I/O being ready before the timeout. If we + * were woken late by the OS then we may be past the first timer + * wake time, but we do _not_ eagerly process the timer. This is + * probably the desired behaviour for "timeout $ do someio". + */ } else if (errno == EINTR) { /* We got interrupted by a signal. In the non-threaded RTS, if the @@ -564,6 +540,7 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr) return !interrupt; } + static void reportPollError(int res, nfds_t nfds) { if (errno == EINVAL) { @@ -619,4 +596,20 @@ static bool enlargeTables(CapIOManager *iomgr) return true; } + +/* Remove from the completion table, preserving compactness, and apply the same + * compacting to the aiop_poll_table. + */ +static void removeFromTables(CapIOManager *iomgr, int ix) +{ + int ix_from; int ix_to; + removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, ix, + &ix_from, &ix_to); + if (ix_to != ix_from) { + StgAsyncIOOp *aiop_to = indexClosureTable(&iomgr->aiop_table, ix_to); + aiop_to->index = ix_to; + iomgr->aiop_poll_table[ix_to] = iomgr->aiop_poll_table[ix_from]; + } +} + #endif /* IOMGR_ENABLED_POLL */ ===================================== rts/posix/Poll.h ===================================== @@ -21,12 +21,12 @@ void freeCapabilityIOManagerPoll(CapIOManager *iomgr); /* Synchronous I/O and timer operations */ IOSubmitResult syncIOWaitReadyPoll(CapIOManager *iomgr, StgTSO *tso, - IOReadOrWrite rw, HsInt fd); + enum IOReadOrWrite rw, HsInt fd); void syncIOCancelPoll(CapIOManager *iomgr, StgTSO *tso); /* Asynchronous operations */ IOSubmitResult asyncIOWaitReadyPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop, - IOReadOrWrite rw, int fd); + enum IOReadOrWrite rw, int fd); void asyncIOCancelPoll(CapIOManager *iomgr, StgAsyncIOOp *aiop); /* Scheduler operations */ ===================================== rts/posix/SelectBis.c ===================================== @@ -0,0 +1,657 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020-2026 + * + * A second I/O manager based on the classic Unix select() system call. + * + * See SelectBis.h for the sad story of why this exists. + * + * ---------------------------------------------------------------------------*/ + +#include "rts/PosixSource.h" +#include "Rts.h" +#include "RtsFlags.h" // needed by SET_HDR macro + +#include "IOManager.h" // defines IOMGR_ENABLED_SELECTBIS + +#if defined(IOMGR_ENABLED_SELECTBIS) + +#include "Capability.h" +#include "Threads.h" +#include "Schedule.h" +#include "Prelude.h" +#include "RtsUtils.h" +#include "rts/Time.h" +#include "Trace.h" + +#include "SelectBis.h" +#include "RtsSignals.h" + +#include <errno.h> +#include <sys/select.h> + +#include "IOManagerInternals.h" +#include "Timeout.h" +#include "FdWakeup.h" + +/****************************************************************************** + +This I/O manager is based on the classic Unix select() system call. + + int select(int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timeval *timeout); + +The select() call has various limits, quirks and slight differences between +historical Unix variants. + +The basic idea is to collect a set of fds (represented as a bitset) that we are +interested in: one for reads, one for writes. The call then queries for I/O +readiness on all the fds in the read and write sets. The result is a set of fds +that are ready to read from, and a set that are ready to write to. The same +bitset representation is used for the output. Indeed a "fun" quirk of select() +is that it mutates the fd sets it is passed, which means they either need to be +built up each time, or copied. There is also an optional timeout if no fds are +ready immediately. There is also an fd bitset for "exceptional conditions" +which we do not use. + +There is of course no incremental behaviour here; this is a bulk one-off call +with no persistent state. This has obvious scaling problems. The cost each time +is O(n) in the maximum of the integer value of the fds of interest. There is +also a maximum bitset size. On Linux this is 1024. This means select() cannot +be used if the process uses more than that many open files, even if we're only +interested in a few. On OSX the default limit is also 1024 but this can be +raised or even managed dynamically, at the cost of more memory (and some +non-standard code). + +That particular problem is solved by the later Unix poll() system call, which +uses an array of the fds we are interested in, which means it is not limited by +the absolute value of the fds numbers (but it is still O(n) in how many fds we +are interested in). + +We have some choice in how we process results. We want to find the intersection +between the requests for notification of I/O readiness (coming from the Haskell +threads) and the read and write bit sets. There's not much clever we can do to +compute this intersection efficiently: we can either iterate over the bit sets +or over the readiness requests. There is no obvious answer here. Typically +there will be few results compared to the number of requests and a bitset scan +could be fast. In practice we cannot portably scan the bitset efficiently (e.g. +word at a time). Portably, we can only probe each bit at a time using FD_ISSET. +Portability is the main reason to use select() rather than a more modern +interface, so we have to take it seriously here. Furthermore, if we iterated +over the bit sets we would have to maintain a mapping from fd to requests. + +In principle we also have the choice to maintain the read and write fd bit sets +incrementally, or create them afresh each time we call select(). There is no +asymptotic bonus to maintaining them incrementally since the whole thing is +O(n) anyway. There could plausibly be some constant factor benefit. To maintain +the fd bit sets incrementally we would need to maintain a mapping between +requests and fds. This would also be an extra cost that would have to be +outweighed by any saving. + +In the end we take the simple approach to constructing the bitset inputs and to +results processing. We create the bit sets afresh each time from the collection +of requests. For processing results we iterate over the requests and look up +each one to see if it is in the appropriate result bitset. Along with each +operation, we store the fd and whether we were interested in reading or writing. +We iterate over the operations and use the fd and r/w information to construct +the read and write bit sets. + +A particularly frustrating feature of select() is that if any single fd in any +fd bitset is invalid (e.g. because the file was already closed) then select() +fails and tells us there is a bad fd somewhere, but it has no way to indicate +which fd was bad. This is really quite annoying as we then have to do a search +through the fds to find which one was bad. + +The primary data structure for this I/O manager is a aiop_table which is a +ClosureTable of AsyncIOOps. This table tracks the active I/O operations, with +one entry per operation (corresponding to threads calling waitRead#/waitWrite#). +We also track the fd for each operation and whether the operation is waiting on +read or write readiness. This additional information is stored in the fd_table. +The fd_table is maintained as an auxiliary table to the aiop_table, with table +indexes matching the ClosureTable. So there is an entry in the aiop_table for +each operation, and a corresponding entry in the fd_table at the same table +index. The aiop_table and the fd_table are maintained incrementally, and with +dense indexes. + +We also use a StgTimeoutQueue to track timeouts, and use the delay to the next +timeout (if any) as the poll() timeout parameter. + +The CapIOManager structure for this I/O manager contains: + + ClosureTable aiop_table; + StgTimeoutQueue *timeout_queue; + int interrupt_fd_r, interrupt_fd_w; + +******************************************************************************/ + +/* Forward declarations */ +static bool enlargeTables(CapIOManager *iomgr); +static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop); +static void removeFromTables(CapIOManager *iomgr, int i); +static bool fdInSelectRange(int fd); +static int collectFdSets(CapIOManager *iomgr); +static void processBadFds(CapIOManager *iomgr); +static void reportSelectError(void) STG_NORETURN; + + +void initCapabilityIOManagerSelectBis(CapIOManager *iomgr) +{ + initClosureTable(&iomgr->aiop_table, ClosureTableCompact); + iomgr->timeout_queue = emptyTimeoutQueue(); + +#if defined(HAVE_PREEMPTION) + newFdWakeup(&iomgr->interrupt_fd_r, &iomgr->interrupt_fd_w); + + /* Would never happen in a standalone process, but could plausibly happen + * if the RTS is used within another process that already has many open fds. + */ + if (iomgr->interrupt_fd_r < 0 || iomgr->interrupt_fd_r >= (int)FD_SETSIZE || + iomgr->interrupt_fd_w < 0 || iomgr->interrupt_fd_w >= (int)FD_SETSIZE) { + barf("initCapabilityIOManagerSelectBis: fds out of select range"); + } +#endif + + iomgr->rfds = stgMallocBytes(sizeof (fd_set), "IOManagerSelectBis"); + iomgr->wfds = stgMallocBytes(sizeof (fd_set), "IOManagerSelectBis"); +} + + +void freeCapabilityIOManagerSelectBis(CapIOManager *iomgr) +{ + stgFree(iomgr->rfds); + stgFree(iomgr->wfds); +#if defined(HAVE_PREEMPTION) + closeFdWakeup(iomgr->interrupt_fd_r, iomgr->interrupt_fd_w); +#endif +} + + +/* Used to implement syncIOWaitReady. */ +IOSubmitResult syncIOWaitReadySelectBis(CapIOManager *iomgr, StgTSO *tso, + enum IOReadOrWrite rw, HsInt fd) +{ + StgAsyncIOOp *aiop; + aiop = (StgAsyncIOOp *)allocateMightFail(iomgr->cap, sizeofW(StgAsyncIOOp)); + 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; + aiop->live = &stg_ASYNCIO_LIVE0_closure; + tso->block_info.aiop = aiop; + RELEASE_STORE(&tso->why_blocked, rw == IORead ? BlockedOnRead + : BlockedOnWrite); + return asyncIOWaitReadySelectBis(iomgr, aiop, rw, fd); +} + +IOSubmitResult asyncIOWaitReadySelectBis(CapIOManager *iomgr, + StgAsyncIOOp *aiop, + enum IOReadOrWrite rw, int fd) +{ + if (RTS_UNLIKELY(isFullClosureTable(&iomgr->aiop_table))) { + bool ok = enlargeTables(iomgr); + if (RTS_UNLIKELY(!ok)) return IOSubmitResultHeapOverflow; + } + + if (RTS_UNLIKELY(!fdInSelectRange(fd))) { + /* Synchronous error */ + aiop->outcome = IOOpOutcomeFailed; + aiop->error = EBADF; + return -EBADF; + }; + + int ix = insertClosureTable(iomgr->cap, &iomgr->aiop_table, aiop); + + /* We use the aiop_table densely. */ + ASSERT(ix == sizeClosureTable(&iomgr->aiop_table) - 1); + + /* The syncIO wrapper or CMM primop filled in the notify and live fields, + * we fill the rest. + */ + aiop->capno = iomgr->cap->no; + aiop->index = ix; + aiop->outcome = IOOpOutcomeInFlight; + aiop->operation = convIOReadOrWriteToIOOpCode(rw); + aiop->fd = fd; + + return IOSubmitResultAsyncContinue; +} + + +void syncIOCancelSelectBis(CapIOManager *iomgr, StgTSO *tso) +{ + StgAsyncIOOp *aiop = tso->block_info.aiop; + ASSERT(aiop->notify_type == NotifyTSO); + ASSERT(indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop); + asyncIOCancelSelectBis(iomgr, aiop); +} + + +void asyncIOCancelSelectBis(CapIOManager *iomgr, StgAsyncIOOp *aiop) +{ + /* We can reliably determine if the aiop is still in progress by checking + * if the aiop_table still points to this aiop object. This is reliable + * because each aiop is GC heap allocated, so cannot be recycled until it + * is no longer retained by the application. + */ + if (indexClosureTable(&iomgr->aiop_table, aiop->index) == aiop) { + removeFromTables(iomgr, aiop->index); + aiop->outcome = IOOpOutcomeCancelled; + notifyIOCompletion(iomgr, aiop); + } +} + + +bool anyPendingTimeoutsOrIOSelectBis(CapIOManager *iomgr) +{ + return !isEmptyTimeoutQueue(iomgr->timeout_queue) + || !isEmptyClosureTable(&iomgr->aiop_table); +} + + +static void notifyIOCompletion(CapIOManager *iomgr, StgAsyncIOOp *aiop) +{ + ASSERT(aiop->outcome != IOOpOutcomeInFlight); + switch (aiop->notify_type) { + case NotifyTSO: + { + /* 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. + */ + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(iomgr->cap, (StgClosure *)aiop); + } + break; + } + case NotifyMVar: + barf("selectbis iomgr: MVar notification not yet supported"); + break; + + case NotifyTVar: + barf("selectbis iomgr: TVar notification not yet supported"); + break; + } +} + + +/* Called from poll/awaitCompletedTimeoutsOrIOSelectBis after a successful + * select() call to process all the I/O completions. + * + * We match up the I/O completion notifications from the system call against + * the pending I/O operations from the aiop_table, and use notifyIOCompletion + * on each completed aiop. + * + * Returns true if the select() was interupted via iomgr->interrupt_fd_r. + */ +static bool processIOCompletions(CapIOManager *iomgr, int ncompletions) +{ + /* We want to find the intersection between the sets of ready fds returned + * by select() and the aiop_table. Given how select() represents + * things there's no particularly efficient way to do it. + * + * We just go through the whole aiop_table and look up each one in + * the read or write fd_set to see if they completed. Note that here is + * where we rely on the aiop_table being dense so we can iterate + * over the entries. We can short-cut if we hit the ncompletions before + * getting to the end of the table. + */ + debugTrace(DEBUG_iomanager, "processIOCompletions(ncompletions = %d)", + ncompletions); + ASSERT(ncompletions > 0); + + bool interrupt = false; +#if defined(HAVE_PREEMPTION) + /* If the interrupt_fd_r is ready, collect it */ + if (FD_ISSET(iomgr->interrupt_fd_r, iomgr->rfds)) { + collectFdWakeup(iomgr->interrupt_fd_r); + ncompletions--; + interrupt = true; + debugTrace(DEBUG_iomanager, "Received interrupt in poll I/O manager"); + } +#endif + + int i = 0; + while (ncompletions > 0) { + ASSERT(i < sizeClosureTable(&iomgr->aiop_table)); + + StgAsyncIOOp *aiop = indexClosureTable(&iomgr->aiop_table, i); + int fd = aiop->fd; + enum IOOpCode op = aiop->operation; + + ASSERT(op == IOOpCodeWaitRead || op == IOOpCodeWaitWrite); + ASSERT(aiop->outcome == IOOpOutcomeInFlight); + + if (op == IOOpCodeWaitRead ? FD_ISSET(fd, iomgr->rfds) + : FD_ISSET(fd, iomgr->wfds)) { + aiop->outcome = IOOpOutcomeSuccess; + aiop->result = 0; + removeFromTables(iomgr, i); + notifyIOCompletion(iomgr, aiop); + ncompletions--; + } else { + /* You'd expect incrementing the table index to be unconditional, + * but we don't increment the index if we did process the entry, + * because using removeFromTables means we'll move an entry from + * the end of the table into the index i. + */ + i++; + } + } + return interrupt; +} + + +void pollCompletedTimeoutsOrIOSelectBis(CapIOManager *iomgr) +{ + if (!isEmptyTimeoutQueue(iomgr->timeout_queue)) { + Time now = getProcessElapsedTime(); + processTimeoutCompletions(iomgr, now); + } + + if (!isEmptyClosureTable(&iomgr->aiop_table)) { + /* Prepare to poll for I/O readiness: collect all of the fd's that + * we're interested in. + */ + int maxfd = collectFdSets(iomgr); + + /* Poll for I/O readiness, without waiting. */ + struct timeval tv = (struct timeval) { .tv_sec = 0, .tv_usec = 0 }; + int res = select(maxfd+1, iomgr->rfds, iomgr->wfds, NULL, &tv); + if (res == 0) { + /* There is no I/O ready. We'll return to the scheduler. */ + + } else if (res > 0) { + int ncompletions = res; + ASSERT(ncompletions <= sizeClosureTable(&iomgr->aiop_table)+1); + processIOCompletions(iomgr, ncompletions); + + } else if (errno == EBADF) { + processBadFds(iomgr); + + } else if (errno == EINTR) { + /* We got interrupted by a signal. This is unlikely since we asked + * select() not to wait, but if so we'll return to the scheduler. + */ + + } else { + reportSelectError(); + } + } +} + + +bool awaitCompletedTimeoutsOrIOSelectBis(CapIOManager *iomgr) +{ + bool interrupt = false; /* got woken up via interruptIOManager */ + + /* Loop until we've woken up some threads. This loop is needed because the + * select() timing isn't accurate, we sometimes sleep for a while but not + * long enough to wake up a thread in a threadDelay. Or we may need to + * sleep multiple times if we need to sleep longer than the maximum timeout + * that select() supports. + */ + do { + /* There is either pending I/O or pending timers. */ + ASSERT(!isEmptyTimeoutQueue(iomgr->timeout_queue) || + !isEmptyClosureTable(&iomgr->aiop_table)); + + Time now = getProcessElapsedTime(); + processTimeoutCompletions(iomgr, now); + + /* If we didn't wake any threads due to expiring timeouts, then we need + * to wait on I/O. Or to put it another way, even if we did wake some + * threads, we'll still poll (but not wait) for I/O. This is to ensure + * we avoid starving threads blocked on I/O. + */ + bool wait = emptyRunQueue(iomgr->cap); + + /* Prepare to poll for I/O readiness: collect all of the fd's that + * we're interested in. + */ + int maxfd = collectFdSets(iomgr); + + /* Decide if we are going to wait if no I/O is ready, either: + * poll only, wait indefinitely, or wait until a timeout. + */ + struct timeval tv, *timeout_us; + timeout_us = timeoutInMicroseconds(iomgr, wait, now, &tv); + + /* Check for I/O readiness, possibly waiting. */ + int res = select(maxfd+1, iomgr->rfds, iomgr->wfds, NULL, timeout_us); + + if (res == 0) { + /* Success but there is no I/O ready. This can happen either if we + * were not blocking or were in a timed wait and the timeout + * occurred before any I/O became ready. Either way, the do-while + * loop condition will handle it. + */ + ASSERT(timeout_us != NULL); + + } else if (res > 0) { + int ncompletions = res; + ASSERT(ncompletions <= sizeClosureTable(&iomgr->aiop_table)+1); + interrupt = processIOCompletions(iomgr, ncompletions); + /* We do _not_ need to check for timeouts again here. We know that + * select() returned due to I/O being ready before the timeout. If + * we were woken late by the OS then we may be past the first timer + * wake time, but we do _not_ eagerly process the timer. This is + * probably the desired behaviour for "timeout $ do someio". + */ + + } else if (errno == EINTR) { + /* We got interrupted by a signal. In the non-threaded RTS, if the + * signal is one of ours we need to return to the scheduler to let + * it handle it. Otherwise we would loop and keep waiting for I/O + * or timeouts, meaning we would block for a long time before the + * signal is serviced. + */ +#if defined(RTS_USER_SIGNALS) + if (startPendingSignalHandlers(iomgr->cap)) break; +#endif + + /* We can also be interrupted by the shutdown signal handler, which + * will set sched_state and so cause us to drop out of the loop. + * + * For any other interruption (e.g. timer) we will go round the + * do-while loop again. + */ + + } else if (errno == EBADF) { + processBadFds(iomgr); + + } else { + reportSelectError(); + } + + } while (emptyRunQueue(iomgr->cap) + && !interrupt + && (getSchedState() == SCHED_RUNNING)); + return !interrupt; +} + + +static void reportSelectError(void) +{ + sysErrorBelch("select() failed"); + stg_exit(EXIT_FAILURE); +} + + +static void processBadFds(CapIOManager *iomgr) +{ + /* This is extremely tiresome. The select() call fails with EBADF if any + * fd is invalid (usually closed), but it does not tell us which one. + * So we have to loop through them to find the offending fd. + * + * This will only find the first bad fd, so the caller must cope with + * there still being bad fds after this. + */ + + fd_set rfds, wfds; + FD_ZERO(&rfds); + FD_ZERO(&wfds); + + int nentries = sizeClosureTable(&iomgr->aiop_table); + for (int ix = 0; ix < nentries; ix++) { + StgAsyncIOOp *aiop = indexClosureTable(&iomgr->aiop_table, ix); + int fd = aiop->fd; + enum IOOpCode op = aiop->operation; + + ASSERT(op == IOOpCodeWaitRead || op == IOOpCodeWaitWrite); + + struct timeval tv = { .tv_sec = 0, .tv_usec = 0 }; + int res; + if (op == IOOpCodeWaitRead) { + FD_SET(fd, &rfds); + res = select(fd+1, &rfds, NULL, NULL, &tv); + FD_CLR(fd, &rfds); + } else { + FD_SET(fd, &wfds); + res = select(fd+1, NULL, &wfds, NULL, &tv); + FD_CLR(fd, &wfds); + } + if (res == 0) { + continue; + + } else if (errno == EBADF) { + aiop->outcome = IOOpOutcomeFailed; + aiop->error = EBADF; + removeFromTables(iomgr, ix); + notifyIOCompletion(iomgr, aiop); + /* There is /probably/ only one bad fd at once, so we abort the + * search here. If we are unlucky and there are several bad fds + * then the caller will just loop round again. + */ + + return; + + } else if (errno == EINTR) { + /* Unlikely, since we did a non-blocking select(). + * Try again with the same ix. */ + ix--; + continue; + + } else { + reportSelectError(); + } + } +} + + +void interruptIOManagerSelectBis(CapIOManager *iomgr) +{ +#if defined(HAVE_PREEMPTION) + sendFdWakeup(iomgr->interrupt_fd_w); +#endif +} + + +/* Helper function to double the size of the aiop_table. + */ +static bool enlargeTables(CapIOManager *iomgr) +{ + int oldcapacity = capacityClosureTable(&iomgr->aiop_table); + int newcapacity = (oldcapacity == 0) ? 1 : (oldcapacity * 2); + + bool ok = enlargeClosureTable(iomgr->cap, &iomgr->aiop_table, newcapacity); + if (RTS_UNLIKELY(!ok)) return false; + + return true; +} + + +/* Remove from the completion table, preserving compactness. + */ +static void removeFromTables(CapIOManager *iomgr, int ix) +{ + int ix_from; int ix_to; + removeCompactClosureTable(iomgr->cap, &iomgr->aiop_table, ix, + &ix_from, &ix_to); + if (ix_to != ix_from) { + StgAsyncIOOp *aiop_to = indexClosureTable(&iomgr->aiop_table, ix_to); + aiop_to->index = ix_to; + } +} + +/* In preparation for calling select(), set the iomgr->rfds and iomgr->wfds + * sets based on the pending I/O ops iomgr->aiop_table. + * + * Returns the maximum fd in the two sets (since select() needs this). + */ +static int collectFdSets(CapIOManager *iomgr) +{ + int maxfd = -1; + int nentries = sizeClosureTable(&iomgr->aiop_table); + + /* In principle we could optimise this slightly by not resetting the + * whole of each fdset, by assuming that select() does not modify + * entries above maxfd. This is probably not worth doing however, since + * this I/O manager is supposed to be portable and is expected to be slow. + */ + FD_ZERO(iomgr->rfds); + FD_ZERO(iomgr->wfds); + +#if defined(HAVE_PREEMPTION) + /* We're always interested in our interrupt fd */ + { + int fd = iomgr->interrupt_fd_r; + maxfd = (fd > maxfd) ? fd : maxfd; + FD_SET(fd, iomgr->rfds); + } +#endif + + for (int ix = 0; ix < nentries; ix++) { + StgAsyncIOOp *aiop = indexClosureTable(&iomgr->aiop_table, ix); + int fd = aiop->fd; + enum IOOpCode op = aiop->operation; + + ASSERT(op == IOOpCodeWaitRead || op == IOOpCodeWaitWrite); + ASSERT(fdInSelectRange(fd)); // Checked in asyncIOWaitReadySelectBis + + if (op == IOOpCodeWaitRead) { + FD_SET(fd, iomgr->rfds); + } else { + FD_SET(fd, iomgr->wfds); + } + maxfd = (fd > maxfd) ? fd : maxfd; + } + return maxfd; +} + + +/* Helper function to check if the fd is within range for select(). + */ +static bool fdInSelectRange(int fd) +{ + /* On older FreeBSDs, FD_SETSIZE is unsigned. Cast it to signed int + * in order to switch off the 'comparison between signed and + * unsigned error message + * Newer versions of FreeBSD have switched to unsigned int: + * https://github.com/freebsd/freebsd/commit/12ae7f74a071f0439763986026525094a… + * http://fa.freebsd.cvs-all.narkive.com/bCWNHbaC/svn-commit-r265051-head-sys-… + * So the (int) cast should be removed across the code base once + * GHC requires a version of FreeBSD that has that change in it. + */ + return ((fd >= 0) && (fd < (int)FD_SETSIZE)); + /* TODO: on several platforms, it is possible to use a larger fd set size. + For example on OSX: + https://code.saghul.net/2016/05/libuv-internals-the-osx-select2-trick/ + And probably similar on other platforms. It basically amounts to looking + through the representation abstraction of fd_set and to know that it is + indeed a bit set, and then we can simply allocate it and manipulte it + ourselves. We could do this, dynamically (re-)allocate the size. + */ +} + +#endif /* IOMGR_ENABLED_SELECTBIS */ ===================================== rts/posix/SelectBis.h ===================================== @@ -0,0 +1,62 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020-2026 + * + * A second I/O manager based on the classic Unix select() system call. + * + * This I/O manager is called "selectbis", because it is the second such I/O + * manager based on select(). The historic implementation is named "select" + * and lives in Select.{c,h}. This I/O manager exists for the benefit of users + * of Apple products. + * + * The poll I/O manger _should_ be the portable baseline posix I/O manager. + * Unfortunately Mac OSX has a buggy implementation of poll(). The OSX man + * page documents this as: + * + * > BUGS The poll() system call currently does not support devices. + * + * This is quite incredible, given that poll and select should be relatively + * thin interfaces to the the same underlying kernel infrastructure. + * Furthermore, OSX is supposedly certified as POSIX compliant! Due to this + * (incompetence) we need a new I/O manager implementation based on the + * antique select() API, with all of its known limitations. + * + * Please direct all complaints to: + * Apple Inc., One Apple Park Way, Cupertino, CA 95014, USA. + * + * Prototypes for functions in SelectBis.c + * + * -------------------------------------------------------------------------*/ + +#pragma once + +#include "IOManager.h" + +#include "BeginPrivate.h" + +#if defined(IOMGR_ENABLED_SELECTBIS) + +void initCapabilityIOManagerSelectBis(CapIOManager *iomgr); +void freeCapabilityIOManagerSelectBis(CapIOManager *iomgr); + +/* Synchronous I/O and timer operations */ +IOSubmitResult syncIOWaitReadySelectBis(CapIOManager *iomgr, StgTSO *tso, + enum IOReadOrWrite rw, HsInt fd); +void syncIOCancelSelectBis(CapIOManager *iomgr, StgTSO *tso); + +/* Asynchronous operations */ +IOSubmitResult asyncIOWaitReadySelectBis(CapIOManager *iomgr, + StgAsyncIOOp *aiop, + enum IOReadOrWrite rw, int fd); +void asyncIOCancelSelectBis(CapIOManager *iomgr, StgAsyncIOOp *aiop); + +/* Scheduler operations */ +bool anyPendingTimeoutsOrIOSelectBis(CapIOManager *iomgr); +void pollCompletedTimeoutsOrIOSelectBis(CapIOManager *iomgr); +bool awaitCompletedTimeoutsOrIOSelectBis(CapIOManager *iomgr); +void interruptIOManagerSelectBis(CapIOManager *iomgr); + +#endif /* IOMGR_ENABLED_SELECTBIS */ + +#include "EndPrivate.h" + ===================================== rts/posix/Timeout.c ===================================== @@ -14,8 +14,9 @@ #include "Schedule.h" #include "Prelude.h" -#include "Timeout.h" +#include "IOManager.h" #include "IOManagerInternals.h" +#include "Timeout.h" #include "TimeoutQueue.h" #include <limits.h> @@ -24,7 +25,8 @@ /* Currently only used by the poll I/O manager, but in future may be used by several in-RTS I/O managers. */ -#if defined(IOMGR_ENABLED_POLL) +#if defined(IOMGR_ENABLED_SELECTBIS) \ + || defined(IOMGR_ENABLED_POLL) bool syncDelayTimeout(CapIOManager *iomgr, StgTSO *tso, HsInt us_delay) { @@ -68,14 +70,13 @@ void syncDelayCancelTimeout(CapIOManager *iomgr, StgTSO *tso) deleteTimeoutQueue(&iomgr->timeout_queue, timeout); + appendToRunQueue(iomgr->cap, tso); + RELEASE_STORE(&tso->why_blocked, NotBlocked); + /* the timeout is no longer accessible from anywhere (except here) */ IF_NONMOVING_WRITE_BARRIER_ENABLED { updateRemembSetPushClosure(iomgr->cap, (StgClosure *)timeout); } - - /* We don't put the TSO back on the run queue or change the why_blocked - status, as that is done by removeFromQueues (in the throwTo* functions). - */ } static void notifyTimeoutCompletion(CapIOManager *iomgr, StgTimeout *timeout); @@ -222,5 +223,58 @@ struct timespec *timeoutInNanoseconds(CapIOManager *iomgr, bool wait, } #endif -#endif // defined(IOMGR_ENABLED_POLL) +/* select() expect a timeout in microseconds, using struct timeval * with + * special values of NULL for indefinite wait, and 0 for no waiting. + */ +#if defined(IOMGR_ENABLED_SELECTBIS) +struct timeval *timeoutInMicroseconds(CapIOManager *iomgr, bool wait, + Time now, struct timeval *tv) +{ + if (!wait) { + /* Don't wait, just poll. */ + *tv = (struct timeval) { .tv_sec = 0, .tv_usec = 0 }; + return tv; + + } else if (!isEmptyTimeoutQueue(iomgr->timeout_queue)) { + /* SUSv2 allows implementations to have an implementation defined + * maximum timeout for select(2). The standard requires + * implementations to silently truncate values exceeding this maximum + * to the maximum. Unfortunately, OSX and the BSD don't comply with + * SUSv2, instead opting to return EINVAL for values exceeding a + * timeout of 1e8. + * + * Select returning an error crashes the runtime in a bad way. To + * play it safe we truncate any timeout to 31 days, as SUSv2 requires + * any implementations maximum timeout to be larger than this. + * + * Truncating the timeout is not an issue, because if nothing + * interesting happens when the timeout expires, we'll see that the + * thread still wants to be blocked longer and simply block on a new + * iteration of select(2). + */ + const time_t max_seconds = 2678400; // 31 * 24 * 60 * 60 + + Time waketime = findMinWaketimeTimeoutQueue(iomgr->timeout_queue); + Time waittime = waketime - now; + + /* Any expired timeouts should have been cleared, so we must be waiting + * for a timeout in the future. */ + ASSERT(waittime > 0); + + tv->tv_sec = TimeToSeconds(waittime); + if (tv->tv_sec < max_seconds) { + tv->tv_usec = TimeToUS(waittime) % 1000000; + } else { + tv->tv_sec = max_seconds; + tv->tv_usec = 0; + } + return tv; + + } else { + return NULL; + } +} +#endif + +#endif // defined(IOMGR_ENABLED_POLL) || ... etc ===================================== rts/posix/Timeout.h ===================================== @@ -46,5 +46,15 @@ struct timespec *timeoutInNanoseconds(CapIOManager *iomgr, bool wait, Time now, struct timespec *tv); #endif +/* As above, but a timeout in microseconds. This is intended to be used with + * select() which expect struct timespec *, with special values of NULL for + * indefinite wait, and 0 for no waiting. + */ +#if defined(IOMGR_ENABLED_SELECTBIS) +struct timeval *timeoutInMicroseconds(CapIOManager *iomgr, bool wait, + Time now, struct timeval *tv); + +#endif + #include "EndPrivate.h" ===================================== rts/rts.cabal ===================================== @@ -568,6 +568,7 @@ library wasm/JSFFI.c wasm/JSFFIGlobals.c posix/Select.c + posix/SelectBis.c posix/Poll.c posix/Timeout.c cmm-sources: wasm/jsval.cmm @@ -583,6 +584,7 @@ library posix/MIO.c posix/Poll.c posix/Select.c + posix/SelectBis.c posix/Signals.c posix/Timeout.c posix/TTY.c ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -7861,7 +7861,7 @@ module GHC.RTS.Flags.Experimental where type HpcFlags :: * data HpcFlags = HpcFlags {readTixFile :: GHC.Internal.Types.Bool, writeTixFile :: GHC.Internal.Types.Bool} type IoManagerFlag :: * - data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagPoll | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy + data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagSelectBis | IoManagerFlagPoll | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy type IoSubSystem :: * data IoSubSystem = IoPOSIX | IoNative type MiscFlags :: * ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -7864,7 +7864,7 @@ module GHC.RTS.Flags.Experimental where type HpcFlags :: * data HpcFlags = HpcFlags {readTixFile :: GHC.Internal.Types.Bool, writeTixFile :: GHC.Internal.Types.Bool} type IoManagerFlag :: * - data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagPoll | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy + data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagSelectBis | IoManagerFlagPoll | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy type IoSubSystem :: * data IoSubSystem = IoPOSIX | IoNative type MiscFlags :: * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2486cc92cea451fd6528292252a8f3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2486cc92cea451fd6528292252a8f3… 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/jeltsch/improve-closure-property-check] Switch to more performant representation of processed units
by Wolfgang Jeltsch (＠jeltsch) 16 Sep '26

16 Sep '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC Commits: f292ca1c by Wolfgang Jeltsch at 2026-09-15T23:27:17+03:00 Switch to more performant representation of processed units - - - - - 1 changed file: - compiler/GHC/Driver/Downsweep.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -57,6 +57,7 @@ import Language.Haskell.Syntax.ImpExp import GHC.Types.UnresolvedImport import GHC.Data.FastString +import GHC.Data.ShortText ( ShortText ) import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.Maybe as M import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf ) @@ -95,7 +96,6 @@ import GHC.Unit.Module.Graph import GHC.Unit.Module.Deps import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Module.Stage -import GHC.Unit.External.Index (GlobalUnitKey, mkGlobalUnitKey) import Data.Either ( partitionEithers, lefts ) import Data.Map (Map) @@ -972,18 +972,19 @@ checkHomeUnitsClosed unit_env offenders :: [(UnitId, UnitId)] offenders = evalState (collect (map (homeUnitEnv_units . snd) home_unit_data)) - Set.empty + emptyUniqMap where -- | Collects offending dependencies. collect :: [UnitState] -- ^ The 'UnitState's of the home units from which to traverse -- the dependency graph. - -> State (Set GlobalUnitKey) [(UnitId, UnitId)] + -> State (UniqMap UnitId (Set ShortText)) [(UnitId, UnitId)] -- ^ A stateful computation that collects offending dependencies - -- that have not yet been found, using its state to keep track - -- of which units have already been considered as sources of - -- offending dependencies. + -- that have not yet been found. It uses its state, which is an + -- efficent representation of a set of 'GlobalUnitKey's, to + -- keep track of which units have already been considered as + -- sources of offending dependencies. collect = concatMapM $ \ unit_state -> collect_for_home_unit (unitInfoMap unit_state) @@ -998,10 +999,11 @@ checkHomeUnitsClosed unit_env -> [UnitId] -- ^ The 'UnitId's of the units from which to traverse the dependency -- graph. - -> State (Set GlobalUnitKey) [(UnitId, UnitId)] + -> State (UniqMap UnitId (Set ShortText)) [(UnitId, UnitId)] -- ^ A stateful computation that collects offending dependencies that - -- have not yet been found, using its state to keep track of which - -- units have already been considered as sources of offending + -- have not yet been found. It uses its state, which is an efficent + -- representation of a set of 'GlobalUnitKey's, to keep track of + -- which units have already been considered as sources of offending -- dependencies. collect_for_home_unit _ [] = return [] @@ -1019,15 +1021,19 @@ checkHomeUnitsClosed unit_env unit_not_found_msg :: String unit_not_found_msg = "Unit not found during closure property check" - -- | A 'GlobalUnitKey' that identifies the current unit. - global_unit_key :: GlobalUnitKey - global_unit_key = mkGlobalUnitKey current_unit (unitAbiHash unit_info) + -- | The ABI hash of the current unit. + unit_abi_hash :: ShortText + unit_abi_hash = unitAbiHash unit_info - has_been_processed <- gets (Set.member global_unit_key) + has_been_processed <- gets $ maybe False (Set.member unit_abi_hash) . + (`lookupUniqMap` current_unit) if has_been_processed then collect_for_home_unit unit_info_map remaining_units else do - modify (Set.insert global_unit_key) + modify $ \ processed -> addToUniqMap_C Set.union + processed + current_unit + (Set.singleton unit_abi_hash) let -- | The 'UnitId's of the units that the current unit depends on. @@ -1077,11 +1083,10 @@ units it directly depends on, and, starting from them, follows unit dependencies to search for offending dependencies. It does not follow dependencies that have been followed before, possibly when processing another home unit. To achieve this, the algorithm tracks, across home units, from which units it has already -followed dependencies. For this tracking, it identifies each unit by a -'GlobalUnitKey', which is a pair of a 'UnitId' and an ABI hash. Using only a -'UnitId' would not work, because 'UnitId's are not always globally unique. Also -using only an ABI hash is not an option, because an ABI hash is not necessarily -an ABI hash: it can also be the string @"inline"@. +followed dependencies. For this tracking, it identifies each unit by a 'UnitId' +and an ABI hash. Using only a 'UnitId' would not work, because 'UnitId's are not +always globally unique. Also using only an ABI hash is not an option, because an +ABI hash is not necessarily an ABI hash: it can also be the string @"inline"@. The correctness of this algorithm rests on the, likely correct, assumption that, among the units mentioned in the 'UnitState' of a particular home unit, any unit View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f292ca1cc63382b0b8378b0eb3171e5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f292ca1cc63382b0b8378b0eb3171e5… 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] Pushed new branch wip/apk/linear-reg-hints
by Andreas Klebinger (＠AndreasK) 16 Sep '26

16 Sep '26

Andreas Klebinger pushed new branch wip/apk/linear-reg-hints at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/apk/linear-reg-hints 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] 13 commits: rts: handle large CONSTR closures in compacting GC
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 749d2448 by Luite Stegeman at 2026-09-15T14:07:01-04:00 rts: handle large CONSTR closures in compacting GC The function update_fwd_large in the compacting GC could run into an unexpected object with the following error: internal error: update_fwd_large: unknown/strange object 1 Closure type 1 is CONSTR. This patch adds cases for CONSTR and CONSTR_NOCAF. This is the same problem as #27434 (large AP closures, fixed by cca0d58963), which missed this case. Fixes #27649 - - - - - 177d6155 by Luite Stegeman at 2026-09-15T14:07:02-04:00 testsuite: fix T27434 test with compacting GC Ensure that the interpreter is actually run with the compacting GC - - - - - 5796aa63 by Luite Stegeman at 2026-09-15T14:07:49-04:00 rts: initialise the stack frame header for mask_frame and apply_mask_frame We must leave the stack in consistent state before jumping to mask_frame or apply_mask_frame because they may result. Failing to do so could lead to a crash if there were waiting exceptions. Fixes #27651 - - - - - 2486cc92 by Simon Peyton Jones at 2026-09-15T14:08:36-04:00 Re-introduce the "weird SpecDict" case In this commit commit f80375dd4945350a1d784e436975b48b9c736eaf Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Sun Jun 29 15:26:58 2025 +0100 Refactor of Specialise.hs I removed a test for a dictionary with unbound type variables. This turned out to be wrong; see #27629. So this MR re-introduces it. - - - - - d4e35ce6 by Duncan Coutts at 2026-09-15T14:40:54-04:00 Refactor (and rename) removeFromQueues, to simplify I/O managers Rename it to unblockAndAppendToRunQueue which better reflects what it is intended to do. The post-condition for unblockAndAppendToRunQueue is that the TSO is on the run queue or it is in the process of migrating to another cap. Previously it achieved that by always directly adding the TSO to the run queue itself. But this actually made things more complicated for the I/O managers, because it meant they needed a separate code path for notifying for cancellation compared to notifying for completion. The general notification code would always add the TSO to the run queue itself. So the improvement is to allow different cases in unblockAndAppendToRunQueue to achieve the same outcome in different ways: either directly adding to the run queue or calling helper functions that do so themselves. This then allows the new I/O managers to share code between the sync and async cancellation, and to reuse their notifyIOCompletion helpers for cancellation. This avoids a source of bugs where the completion path may be updated but the cancellation path may be forgotten, or similarly in future for sync/async operations. Update all the existing in-RTS I/O managers, and the posix timeout code. - - - - - eddd3073 by Duncan Coutts at 2026-09-15T14:40:54-04:00 Document that awaitCompletedTimeoutsOrIO expects an empty run queue This was true before but implicit and not relied on much. It's better to be explicit, and allow things to depend on it. - - - - - d6212096 by Duncan Coutts at 2026-09-15T14:40:54-04:00 Store the I/O opcode and fd in the StgAsyncIOOp This will be useful in several I/O managers and it is handy for logging and debugging. It also doesn't increase the size of the StgAsyncIOOp structure. There was enough spare padding space already. Update the poll I/O manager to set the new fields. Add a helper function to convert the enum IOReadOrWrite into the enum IOOpCode. Also change IOReadOrWrite to be an enum without a typedef, for consistency with other enumerations in IOManager.h - - - - - fcdb7c47 by Duncan Coutts at 2026-09-15T14:40:55-04:00 Add a new I/O manager based on select() Yes, this is the second such I/O manager, but it is a modern re-implementation based on the new in-RTS I/O manager infrastructure. So it is cleaner and faster than the old select I/O manager. Why do we need another I/O manager based on select? Why isn't the poll() one good enough as a baseline portable unix I/O manager? Because macOS. Apple Inc. is why we cannot have nice things. The man page for poll on macOS documents the fact that it does not work. At least, it does not work for all files. Specifically, it does not work for device files. Whereas macOS select() does work for device files. Aaaaarg! We _do_ want to deprecate and remove the old select I/O manager, but due to macOS we cannot do that until we have a replacement. This is that replacement. Until of course a nice new k-queue I/O manager arrives, which could become the new default for macOS and FreeBSD. Interestingly, this select I/O manager is actually faster than the poll one, on Linix, in some circumstances: specifically when many Haskell threads are waiting on the same fd. The poll I/O manager does O(n) work for n threads waiting on I/O, whereas the select one does O(fds) work for the number of fds that threads are waiting on. Usually this is 1:1, so it's not noticable, but one can concoct extreme benchmarks to show the difference. - - - - - 0c44a59f by Duncan Coutts at 2026-09-15T14:40:55-04:00 Minor updates in the poll I/O manager to keep in sync with select This keeps it in sync with select one. The changes are based on code review while implementing the new select I/O manager. The two I/O managers are so similar in structure that it makes sense to try to minimise the diff between them. This should aid understanding, and fixes to both in future. - - - - - 78732559 by Duncan Coutts at 2026-09-15T14:40:55-04:00 Document the new select I/O manager in the user guide in the RTS section about I/O managers. And add a changelog entry. - - - - - 1e9beea1 by Cheng Shao at 2026-09-15T14:40:57-04:00 Revert "wasm: workaround WebKit bug in dyld" This reverts commit c9b8465c2c338176fcab9d197e9d31f4aee11f68. The underlying webkit bug has been fixed in https://commits.webkit.org/314219@main. Closes #27564. - - - - - 8b9880c7 by Luite Stegeman at 2026-09-15T14:41:00-04:00 rts: make stg_threadLabelzh return a valid pointer for unlabeled threads. This fixes a segfault in the GC caused by stg_threadLabelzh returning a 0 pointer in a GC pointer field. stg_threadLabelzh returns a tuple of type (# Int#, ByteArray# #). If a thread has no label, the second field is unused. We must still return a valid heap object pointer. Instead of returning 0, we now return stg_DEAD_SLOT_closure. fixes #27618 - - - - - a8c030a4 by Luite Stegeman at 2026-09-15T14:41:03-04:00 JS: fix selector thunk handling fix a bug where entering a selector thunk could lead to a crash if the selected field was still a thunk. fixes #27788 - - - - - 50 changed files: - + changelog.d/T27629 - + changelog.d/T27788-js-selector - + changelog.d/fix-compacting-gc-constr-27649 - + changelog.d/fix-control0-mask-trampoline - + changelog.d/fix-threadlabel-segfault-27618 - + changelog.d/select-io-manager - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Symbols.hs - docs/users_guide/runtime_control.rst - libraries/base/src/GHC/RTS/Flags.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - rts/ContinuationOps.cmm - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/StgMiscClosures.cmm - rts/configure.ac - rts/include/rts/Flags.h - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - rts/posix/Poll.c - rts/posix/Poll.h - + rts/posix/SelectBis.c - + rts/posix/SelectBis.h - rts/posix/Timeout.c - rts/posix/Timeout.h - rts/rts.cabal - rts/sm/Compact.c - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - + testsuite/tests/javascript/T27788.hs - + testsuite/tests/javascript/T27788.stdout - testsuite/tests/javascript/all.T - + testsuite/tests/rts/T27618.hs - + testsuite/tests/rts/T27618.stdout - + testsuite/tests/rts/T27649.hs - + testsuite/tests/rts/T27649.stdout - testsuite/tests/rts/all.T - + testsuite/tests/rts/continuations/T27651.hs - + testsuite/tests/rts/continuations/T27651.stdout - testsuite/tests/rts/continuations/all.T - testsuite/tests/simplCore/should_compile/Makefile - + testsuite/tests/simplCore/should_compile/T27629.hs - + testsuite/tests/simplCore/should_compile/T27629.stderr - + testsuite/tests/simplCore/should_compile/T27629Plugin.hs - testsuite/tests/simplCore/should_compile/all.T - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1e7f826ac764ac9d61da1442c5b0e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1e7f826ac764ac9d61da1442c5b0e… 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][master] Re-introduce the "weird SpecDict" case
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2486cc92 by Simon Peyton Jones at 2026-09-15T14:08:36-04:00 Re-introduce the "weird SpecDict" case In this commit commit f80375dd4945350a1d784e436975b48b9c736eaf Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Sun Jun 29 15:26:58 2025 +0100 Refactor of Specialise.hs I removed a test for a dictionary with unbound type variables. This turned out to be wrong; see #27629. So this MR re-introduces it. - - - - - 7 changed files: - + changelog.d/T27629 - compiler/GHC/Core/Opt/Specialise.hs - testsuite/tests/simplCore/should_compile/Makefile - + testsuite/tests/simplCore/should_compile/T27629.hs - + testsuite/tests/simplCore/should_compile/T27629.stderr - + testsuite/tests/simplCore/should_compile/T27629Plugin.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== changelog.d/T27629 ===================================== @@ -0,0 +1,6 @@ +section: compiler +synopsis: Fix a scoping bug in the type-class specialiser +description: We don't know of any user programs that can trigger this bug + (the repro involves a plugin), so there is no user-visible effect. +mrs: !16603 +issues: #27629 ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1713,9 +1713,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs' (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $ dx_binds `consDictBinds` rhs_uds - -- dx_binds comes from the arguments to the call, - -- and so can mention poly_qvars but no other local binders - spec_rhs = mkLams spec_rhs_bndrs $ + spec_rhs = mkLams spec_rhs_bndrs $ wrapDictBindsE inner_dumped_dbs rhs_body' rule_rhs_args = spec_bndrs @@ -1784,8 +1782,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , text "rule_act" <+> ppr rule_act ] --- ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars --- text "rule_bndrs" <+> ppr rule_bndrs +-- ; pprTrace "spec_call: rule" (vcat [ text "rule_bndrs" <+> ppr rule_bndrs -- , text "rule_lhs_args" <+> ppr rule_lhs_args -- , text "all_call_args" <+> ppr all_call_args -- , ppr spec_rule ]) $ @@ -2611,6 +2608,17 @@ specHeader subst (bndr:bndrs) (UnspecType : args) -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for -- the nitty-gritty), as a LHS rule and unfolding details. specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) + | let in_scope = getInScopeVars (substInScopeSet subst) + bad_dict_fv v = isLocalVar v && not (v `elemVarSet` in_scope) + , not $ isEmptyVarSet $ exprSomeFreeVars bad_dict_fv dict_arg + = -- Do not specialise if `dict_arg` has any free vars that are /not/ in scope + -- See Note [Weird special case for SpecDict] + -- We add a warnPprTrace because this should be super-rare, + -- so if it starts happening we'd like to know. + warnPprTrace True "Specialise: weird dictionary with free type variable" (ppr dict_arg) $ + specHeader subst (bndr:bndrs) (UnspecArg : args) + + | otherwise = do { -- Make up a fresh binder to use in the RULE -- It might turn into a dict binding (via bindAuxiliaryDict) which we -- then float, so we use cloneIdBndr to get a completely fresh binder @@ -2886,13 +2894,15 @@ We could zap `k` to (Any @Type) and `a` to (Any @(Any @Type)), but that is a lot of hard work for a very strange case. So we simply refrain from specialising in this case; hence the guard - allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d) -in the SpecDict cased of specHeader. - -How did this strange polymorphic mkD arise in the first place? -From GHC.Core.Opt.Utils.abstractFloats, which was abstracting -over too many type variables. But that too is now fixed; -see Note [Which type variables to abstract over] in that module. + not $ isEmptyVarSet $ exprSomeFreeVars bad_dict_fv dict_arg +in the SpecDict case of `specHeader`. + +How did this strange polymorphic mkD arise in the first place? From +GHC.Core.Opt.Simplify.Utils.abstractFloats, which was abstracting over too many type +variables. But that too is now fixed; see Note [Which type variables to abstract +over] in that module. So we don't actually have a Haskell source program that +triggers it (see #27629) -- only test T27629 that uses a plugin to inject a strange +definition. -} instance Outputable DictBind where ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -3,6 +3,12 @@ include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +# T27629 runs a plugin that injects a Core binding +# that made the specialiser crash +T27629: + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -package ghc -c T27629Plugin.hs -v0 + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcPluginWayFlags) -c -O -fpolymorphic-specialisation -dcore-lint T27629.hs + # T18815 should not have a non-recursive join-point for 'go' # Previously we ended up with # join {go_sPI w_sQ3 = case w_sQ3 of { GHC.Types.I# ww1_sQ6 -> ===================================== testsuite/tests/simplCore/should_compile/T27629.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# OPTIONS_GHC -fplugin=T27629Plugin #-} + +-- The plugin rewrites 'poly' to the example of +-- Note [Weird special case for SpecDict]: +-- +-- poly = /\x. \t. split @T (mkD @x MkT) [t] +-- +-- where mkD :: forall a. T -> C T is a new top-level binding +-- (mkD = /\a. \_. $fCT), so the tyvar x is free in the dictionary +-- *expression* but not in its *type* (C T). +module T27629 (poly, split, T (..), C (..)) where + +import Data.Kind (Type) + +data T = MkT + +class C b where + meth :: b -> b + +instance C T where + meth x = x + +split :: C b => [b] -> [b] +split [] = [] +split (x : xs) = meth x : split xs + +poly :: forall (x :: Type). T -> [T] +poly t = [t] ===================================== testsuite/tests/simplCore/should_compile/T27629.stderr ===================================== @@ -0,0 +1 @@ +ReproPlugin: injected weird SpecDict call into poly ===================================== testsuite/tests/simplCore/should_compile/T27629Plugin.hs ===================================== @@ -0,0 +1,89 @@ +-- Injects the example of Note [Weird special case for SpecDict] in +-- GHC.Core.Opt.Specialise, which cannot be written in source Haskell: +-- a call whose dictionary argument mentions a type variable that is +-- free in the dictionary expression but not in its type. +-- +-- Runs before the main Core pipeline (in particular before the +-- Specialiser). It adds +-- +-- mkD :: forall a. T -> C T {-# NOINLINE mkD #-} +-- mkD = /\a. \_. $fCT +-- +-- and rewrites poly = /\x. \t. [t] +-- to poly = /\x. \t. split @T (mkD @x MkT) [t] +module T27629Plugin (plugin) where + +import GHC.Core.Make (mkCoreApps, mkListExpr) +import GHC.Core.Predicate (getClassPredTys_maybe) +import GHC.Plugins +import GHC.Types.InlinePragma (neverInlinePragma) + +plugin :: Plugin +plugin = + defaultPlugin + { installCoreToDos = \_ todos -> + return (CoreDoPluginPass "inject-weird-specdict" pass : todos) + , pluginRecompile = purePlugin + } + +pass :: ModGuts -> CoreM ModGuts +pass guts = do + let binds = mg_binds guts + + dfun = case [b | b <- bindersOfBinds binds, isDFunId b] of + (b : _) -> b + [] -> panic "ReproPlugin: no dfun binding in module" + + dictTy = idType dfun -- C T + tyT = case getClassPredTys_maybe dictTy of + Just (_cls, [t]) -> t + _ -> panic "ReproPlugin: dfun type is not C T" + + mkTCon = case tyConDataCons (tyConAppTyCon tyT) of + (dc : _) -> dataConWorkId dc + [] -> panic "ReproPlugin: T has no data constructors" + + findTopId nm = + case [b | b <- bindersOfBinds binds, occNameString (getOccName b) == nm] of + (b : _) -> b + [] -> panic ("ReproPlugin: no top-level binding " ++ nm) + + splitId = findTopId "split" + polyId = findTopId "poly" + + uMkD <- getUniqueM + uTv <- getUniqueM + uWild <- getUniqueM + + let aTv = mkTyVar (mkSystemName uTv (mkTyVarOcc "a")) liftedTypeKind + mkDTy = mkSpecForAllTys [aTv] (mkFunctionType ManyTy tyT dictTy) + mkDId = + setInlinePragma + (mkExportedVanillaId (mkSystemName uMkD (mkVarOcc "mkD")) mkDTy) + neverInlinePragma + wild = mkSysLocal (fsLit "eta") uWild ManyTy tyT + mkDBind = NonRec mkDId (mkLams [aTv, wild] (Var dfun)) + + rewritePoly rhs + | (bndrs, _body) <- collectBinders rhs + , (x : _) <- reverse (filter isTyVar bndrs) + , (t : _) <- filter isId bndrs + = mkLams bndrs $ + mkCoreApps + (Var splitId) + [ Type tyT + , mkCoreApps (Var mkDId) [Type (mkTyVarTy x), Var mkTCon] + , mkListExpr tyT [Var t] + ] + | otherwise = + pprPanic "ReproPlugin: unexpected shape of poly" (ppr rhs) + + go (b, rhs) + | b == polyId = (b, rewritePoly rhs) + | otherwise = (b, rhs) + + -- One top-level Rec, so bind order is irrelevant. + binds' = [Rec (map go (flattenBinds binds) ++ flattenBinds [mkDBind])] + + putMsgS "ReproPlugin: injected weird SpecDict call into poly" + return guts {mg_binds = binds'} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -618,3 +618,5 @@ test('T27556', [only_ways('ghci'), extra_hc_opts('-O -fno-unoptimized-core-for-i test('T27749', multiline_grep_errmsg(r'ordering\n.*\n(\s+src<[^>]*>\n)+'), compile, ['-O -g3 -ddump-simpl -dsuppress-uniques']) + +test('T27629', only_ways(['optasm']), makefile_test, ['T27629']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2486cc92cea451fd6528292252a8f38… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2486cc92cea451fd6528292252a8f38… 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][master] rts: initialise the stack frame header for mask_frame and apply_mask_frame
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5796aa63 by Luite Stegeman at 2026-09-15T14:07:49-04:00 rts: initialise the stack frame header for mask_frame and apply_mask_frame We must leave the stack in consistent state before jumping to mask_frame or apply_mask_frame because they may result. Failing to do so could lead to a crash if there were waiting exceptions. Fixes #27651 - - - - - 5 changed files: - + changelog.d/fix-control0-mask-trampoline - rts/ContinuationOps.cmm - + testsuite/tests/rts/continuations/T27651.hs - + testsuite/tests/rts/continuations/T27651.stdout - testsuite/tests/rts/continuations/all.T Changes: ===================================== changelog.d/fix-control0-mask-trampoline ===================================== @@ -0,0 +1,13 @@ +section: rts +synopsis: Fix a crash when capturing or resuming a delimited continuation that adjusts the async exception masking state +issues: #27651 +mrs: !16484 + +description: { +Capturing a continuation with ``control0#`` from inside ``mask`` or +``uninterruptibleMask`` left an uninitialised word on the stack while +restoring the masking state. When the thread had a pending asynchronous +exception (e.g. from ``throwTo``), raising it walked over that word and +crashed with a segmentation fault. Resuming such a continuation had the +same defect. +} ===================================== rts/ContinuationOps.cmm ===================================== @@ -148,6 +148,7 @@ stg_control0zh_ll // explicit stack // and jump to the frame’s entry code. Sp_adj(-3); // Note -3, not -2, because `mask_frame` will // try to pop itself off the stack when it returns! + Sp(0) = mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_pv_info; Sp(2) = cont; R1 = f; @@ -230,6 +231,7 @@ stg_CONTINUATION_apply // explicit stack // Now we just set up the stack so that `apply_mask_frame` will apply `io` // when it returns and jump to it. Sp_adj(-2); + Sp(0) = apply_mask_frame; // Can't be omitted, see #27651 Sp(1) = stg_ap_v_info; R1 = io; jump %ENTRY_CODE(apply_mask_frame) [R1]; ===================================== testsuite/tests/rts/continuations/T27651.hs ===================================== @@ -0,0 +1,91 @@ +-- When capturing or resuming a continuation adjusts the async exception +-- masking state, the RTS trampolines through a mask/unmask frame, and the +-- stack must be well-formed at that point: with a blocked exception +-- pending, the eager raise in stg_unmaskAsyncExceptionszh_ret walks the +-- whole stack. +-- +-- Phase 1 exercises the capture side (stg_control0zh_ll): control0# runs +-- inside uninterruptibleMask_ while another thread has queued an +-- exception via throwTo, so the capture unmasks with the exception +-- pending. The frame evaluated between the unmask frame and the prompt +-- keeps raw Int# payload live so that a stale word on the stack cannot +-- masquerade as a valid frame by accident. +-- +-- Phase 2 exercises the resume side (stg_CONTINUATION_apply): the +-- continuation is captured while unmasked (inside mask/restore), so +-- resuming it unmasks, and it is applied from a thread that is masked +-- with an exception pending. +import Control.Concurrent +import Control.Exception +import Control.Monad + +import ContIO + +data Boom = Boom deriving Show +instance Exception Boom + +{-# NOINLINE useInts #-} +useInts :: Int -> Int -> Int -> Int -> Int -> Int +useInts a b c d e = a + b * c + d * e + +rounds :: Int +rounds = 150 + +phase1 :: Int -> IO () +phase1 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + let !p = i * 7919 + 3 -- raw ints to live in the continuation frame + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + tag <- newPromptTag + r <- prompt tag $ do + x <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + control0 tag (\_k -> pure (42 :: Int)) + -- continuation frame between the unmask frame and the + -- prompt frame, carrying raw Int# payload: + pure (useInts x p q u v) + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +phase2 :: Int -> IO () +phase2 i = do + mv <- newEmptyMVar + done <- newEmptyMVar + kvar <- newEmptyMVar + let !p = i * 7919 + 3 + !q = i * 104729 + 7 + !u = i * 1299709 + 11 + !v = i * 15485863 + 13 + -- Capture a continuation whose resumption unmasks: the capture happens + -- inside restore, so its apply_mask_frame is the unmask frame. + _ <- forkIO $ do + tag <- newPromptTag + _ <- prompt tag $ mask $ \restore -> do + x <- restore (control0 tag (\k -> putMVar kvar k >> pure 0)) + pure (useInts x p q u v) + pure () + k <- takeMVar kvar + a <- forkIO $ + handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do + r <- uninterruptibleMask_ $ do + putMVar mv () + threadDelay 2000 -- let the thrower queue its exception + k (pure 42) -- resuming unmasks with the exception pending + void (tryPutMVar done (Right r)) + takeMVar mv + _ <- forkIO $ throwTo a Boom + void (takeMVar done) + +main :: IO () +main = do + forM_ [1 .. rounds] phase1 + forM_ [1 .. rounds] phase2 + putStrLn "ok" ===================================== testsuite/tests/rts/continuations/T27651.stdout ===================================== @@ -0,0 +1 @@ +ok ===================================== testsuite/tests/rts/continuations/all.T ===================================== @@ -9,3 +9,4 @@ test('cont_nondet_handler', [extra_files(['ContIO.hs'])], multimod_compile_and_r test('cont_stack_overflow', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['cont_stack_overflow', '-with-rtsopts "-ki1k -kc2k -kb256"']) test('T23513', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T23513', '']) +test('T27651', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T27651', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5796aa637cca079854fc7e84e7e0fa4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5796aa637cca079854fc7e84e7e0fa4… 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][master] 2 commits: rts: handle large CONSTR closures in compacting GC
by Marge Bot (＠marge-bot) 16 Sep '26

16 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 749d2448 by Luite Stegeman at 2026-09-15T14:07:01-04:00 rts: handle large CONSTR closures in compacting GC The function update_fwd_large in the compacting GC could run into an unexpected object with the following error: internal error: update_fwd_large: unknown/strange object 1 Closure type 1 is CONSTR. This patch adds cases for CONSTR and CONSTR_NOCAF. This is the same problem as #27434 (large AP closures, fixed by cca0d58963), which missed this case. Fixes #27649 - - - - - 177d6155 by Luite Stegeman at 2026-09-15T14:07:02-04:00 testsuite: fix T27434 test with compacting GC Ensure that the interpreter is actually run with the compacting GC - - - - - 5 changed files: - + changelog.d/fix-compacting-gc-constr-27649 - rts/sm/Compact.c - + testsuite/tests/rts/T27649.hs - + testsuite/tests/rts/T27649.stdout - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/fix-compacting-gc-constr-27649 ===================================== @@ -0,0 +1,14 @@ +section: rts +synopsis: Fix "unknown/strange object 1" crash in compacting GC +issues: #27649 +mrs: !16482 + +description { +Fix a crash in the compacting garbage collector when collecting large +data constructor closures, as allocated by the bytecode interpreter for +constructors with several hundred fields. Affected programs (run in GHCi, +or via ``ghc -e`` or ``runghc``) crashed with an internal error of the +form "update_fwd_large: unknown/strange object 1" when run with the +compacting GC (``+RTS -c``, or compaction enabled automatically by a +``-M`` heap limit). +} ===================================== rts/sm/Compact.c ===================================== @@ -573,6 +573,13 @@ update_fwd_large( bdescr *bd ) continue; } + case CONSTR: + case CONSTR_NOCAF: + { + thread_obj(info, p); + continue; + } + case MUT_ARR_PTRS_CLEAN: case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN_CLEAN: ===================================== testsuite/tests/rts/T27649.hs ===================================== @@ -0,0 +1,27 @@ +-- Test that the compacting GC can handle large CONSTR closures. +-- +-- The bytecode interpreter allocates data constructors with allocate(), +-- so a constructor with enough fields becomes a large object (BF_LARGE). +-- update_fwd_large in rts/sm/Compact.c must therefore handle CONSTR. +-- This test only exercises the interpreter (ghci way): compiled code +-- bump-allocates constructors in the nursery and never hits this path. +module Main where + +import System.Mem (performMajorGC) +import Control.Monad (forM, forM_) + +data Big = Big Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int Int + +{-# NOINLINE mkBig #-} +mkBig :: Int -> Big +mkBig seed = Big (seed + 0) (seed + 1) (seed + 2) (seed + 3) (seed + 4) (seed + 5) (seed + 6) (seed + 7) (seed + 8) (seed + 9) (seed + 10) (seed + 11) (seed + 12) (seed + 13) (seed + 14) (seed + 15) (seed + 16) (seed + 17) (seed + 18) (seed + 19) (seed + 20) (seed + 21) (seed + 22) (seed + 23) (seed + 24) (seed + 25) (seed + 26) (seed + 27) (seed + 28) (seed + 29) (seed + 30) (seed + 31) (seed + 32) (seed + 33) (seed + 34) (seed + 35) (seed + 36) (seed + 37) (seed + 38) (seed + 39) (seed + 40) (seed + 41) (seed + 42) (seed + 43) (seed + 44) (seed + 45) (seed + 46) (seed + 47) (seed + 48) (seed + 49) (seed + 50) (seed + 51) (seed + 52) (seed + 53) (seed + 54) (seed + 55) (seed + 56) (seed + 57) (seed + 58) (seed + 59) (seed + 60) (seed + 61) (seed + 62) (seed + 63) (seed + 64) (seed + 65) (seed + 66) (seed + 67) (seed + 68) (seed + 69) (seed + 70) (seed + 71) (seed + 72) (seed + 73) (seed + 74) (seed + 75) (seed + 76) (seed + 77) (seed + 78) (seed + 79) (seed + 80) (seed + 81) (seed + 82) (seed + 83) (seed + 84) (seed + 85) (seed + 86) (seed + 87) (seed + 88) (seed + 89) (seed + 90) (seed + 91) (seed + 92) (seed + 93) (seed + 94) (seed + 95) (seed + 96) (seed + 97) (seed + 98) (seed + 99) (seed + 100) (seed + 101) (seed + 102) (seed + 103) (seed + 104) (seed + 105) (seed + 106) (seed + 107) (seed + 108) (seed + 109) (seed + 110) (seed + 111) (seed + 112) (seed + 113) (seed + 114) (seed + 115) (seed + 116) (seed + 117) (seed + 118) (seed + 119) (seed + 120) (seed + 121) (seed + 122) (seed + 123) (seed + 124) (seed + 125) (seed + 126) (seed + 127) (seed + 128) (seed + 129) (seed + 130) (seed + 131) (seed + 132) (seed + 133) (seed + 134) (seed + 135) (seed + 136) (seed + 137) (seed + 138) (seed + 139) (seed + 140) (seed + 141) (seed + 142) (seed + 143) (seed + 144) (seed + 145) (seed + 146) (seed + 147) (seed + 148) (seed + 149) (seed + 150) (seed + 151) (seed + 152) (seed + 153) (seed + 154) (seed + 155) (seed + 156) (seed + 157) (seed + 158) (seed + 159) (seed + 160) (seed + 161) (seed + 162) (seed + 163) (seed + 164) (seed + 165) (seed + 166) (seed + 167) (seed + 168) (seed + 169) (seed + 170) (seed + 171) (seed + 172) (seed + 173) (seed + 174) (seed + 175) (seed + 176) (seed + 177) (seed + 178) (seed + 179) (seed + 180) (seed + 181) (seed + 182) (seed + 183) (seed + 184) (seed + 185) (seed + 186) (seed + 187) (seed + 188) (seed + 189) (seed + 190) (seed + 191) (seed + 192) (seed + 193) (seed + 194) (seed + 195) (seed + 196) (seed + 197) (seed + 198) (seed + 199) (seed + 200) (seed + 201) (seed + 202) (seed + 203) (seed + 204) (seed + 205) (seed + 206) (seed + 207) (seed + 208) (seed + 209) (seed + 210) (seed + 211) (seed + 212) (seed + 213) (seed + 214) (seed + 215) (seed + 216) (seed + 217) (seed + 218) (seed + 219) (seed + 220) (seed + 221) (seed + 222) (seed + 223) (seed + 224) (seed + 225) (seed + 226) (seed + 227) (seed + 228) (seed + 229) (seed + 230) (seed + 231) (seed + 232) (seed + 233) (seed + 234) (seed + 235) (seed + 236) (seed + 237) (seed + 238) (seed + 239) (seed + 240) (seed + 241) (seed + 242) (seed + 243) (seed + 244) (seed + 245) (seed + 246) (seed + 247) (seed + 248) (seed + 249) (seed + 250) (seed + 251) (seed + 252) (seed + 253) (seed + 254) (seed + 255) (seed + 256) (seed + 257) (seed + 258) (seed + 259) (seed + 260) (seed + 261) (seed + 262) (seed + 263) (seed + 264) (seed + 265) (seed + 266) (seed + 267) (seed + 268) (seed + 269) (seed + 270) (seed + 271) (seed + 272) (seed + 273) (seed + 274) (seed + 275) (seed + 276) (seed + 277) (seed + 278) (seed + 279) (seed + 280) (seed + 281) (seed + 282) (seed + 283) (seed + 284) (seed + 285) (seed + 286) (seed + 287) (seed + 288) (seed + 289) (seed + 290) (seed + 291) (seed + 292) (seed + 293) (seed + 294) (seed + 295) (seed + 296) (seed + 297) (seed + 298) (seed + 299) (seed + 300) (seed + 301) (seed + 302) (seed + 303) (seed + 304) (seed + 305) (seed + 306) (seed + 307) (seed + 308) (seed + 309) (seed + 310) (seed + 311) (seed + 312) (seed + 313) (seed + 314) (seed + 315) (seed + 316) (seed + 317) (seed + 318) (seed + 319) (seed + 320) (seed + 321) (seed + 322) (seed + 323) (seed + 324) (seed + 325) (seed + 326) (seed + 327) (seed + 328) (seed + 329) (seed + 330) (seed + 331) (seed + 332) (seed + 333) (seed + 334) (seed + 335) (seed + 336) (seed + 337) (seed + 338) (seed + 339) (seed + 340) (seed + 341) (seed + 342) (seed + 343) (seed + 344) (seed + 345) (seed + 346) (seed + 347) (seed + 348) (seed + 349) (seed + 350) (seed + 351) (seed + 352) (seed + 353) (seed + 354) (seed + 355) (seed + 356) (seed + 357) (seed + 358) (seed + 359) (seed + 360) (seed + 361) (seed + 362) (seed + 363) (seed + 364) (seed + 365) (seed + 366) (seed + 367) (seed + 368) (seed + 369) (seed + 370) (seed + 371) (seed + 372) (seed + 373) (seed + 374) (seed + 375) (seed + 376) (seed + 377) (seed + 378) (seed + 379) (seed + 380) (seed + 381) (seed + 382) (seed + 383) (seed + 384) (seed + 385) (seed + 386) (seed + 387) (seed + 388) (seed + 389) (seed + 390) (seed + 391) (seed + 392) (seed + 393) (seed + 394) (seed + 395) (seed + 396) (seed + 397) (seed + 398) (seed + 399) (seed + 400) (seed + 401) (seed + 402) (seed + 403) (seed + 404) (seed + 405) (seed + 406) (seed + 407) (seed + 408) (seed + 409) (seed + 410) (seed + 411) (seed + 412) (seed + 413) (seed + 414) (seed + 415) (seed + 416) (seed + 417) (seed + 418) (seed + 419) (seed + 420) (seed + 421) (seed + 422) (seed + 423) (seed + 424) (seed + 425) (seed + 426) (seed + 427) (seed + 428) (seed + 429) (seed + 430) (seed + 431) (seed + 432) (seed + 433) (seed + 434) (seed + 435) (seed + 436) (seed + 437) (seed + 438) (seed + 439) (seed + 440) (seed + 441) (seed + 442) (seed + 443) (seed + 444) (seed + 445) (seed + 446) (seed + 447) (seed + 448) (seed + 449) (seed + 450) (seed + 451) (seed + 452) (seed + 453) (seed + 454) (seed + 455) (seed + 456) (seed + 457) (seed + 458) (seed + 459) (seed + 460) (seed + 461) (seed + 462) (seed + 463) (seed + 464) (seed + 465) (seed + 466) (seed + 467) (seed + 468) (seed + 469) (seed + 470) (seed + 471) (seed + 472) (seed + 473) (seed + 474) (seed + 475) (seed + 476) (seed + 477) (seed + 478) (seed + 479) (seed + 480) (seed + 481) (seed + 482) (seed + 483) (seed + 484) (seed + 485) (seed + 486) (seed + 487) (seed + 488) (seed + 489) (seed + 490) (seed + 491) (seed + 492) (seed + 493) (seed + 494) (seed + 495) (seed + 496) (seed + 497) (seed + 498) (seed + 499) + +sumBig :: Big -> Int +sumBig (Big a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 a66 a67 a68 a69 a70 a71 a72 a73 a74 a75 a76 a77 a78 a79 a80 a81 a82 a83 a84 a85 a86 a87 a88 a89 a90 a91 a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107 a108 a109 a110 a111 a112 a113 a114 a115 a116 a117 a118 a119 a120 a121 a122 a123 a124 a125 a126 a127 a128 a129 a130 a131 a132 a133 a134 a135 a136 a137 a138 a139 a140 a141 a142 a143 a144 a145 a146 a147 a148 a149 a150 a151 a152 a153 a154 a155 a156 a157 a158 a159 a160 a161 a162 a163 a164 a165 a166 a167 a168 a169 a170 a171 a172 a173 a174 a175 a176 a177 a178 a179 a180 a181 a182 a183 a184 a185 a186 a187 a188 a189 a190 a191 a192 a193 a194 a195 a196 a197 a198 a199 a200 a201 a202 a203 a204 a205 a206 a207 a208 a209 a210 a211 a212 a213 a214 a215 a216 a217 a218 a219 a220 a221 a222 a223 a224 a225 a226 a227 a228 a229 a230 a231 a232 a233 a234 a235 a236 a237 a238 a239 a240 a241 a242 a243 a244 a245 a246 a247 a248 a249 a250 a251 a252 a253 a254 a255 a256 a257 a258 a259 a260 a261 a262 a263 a264 a265 a266 a267 a268 a269 a270 a271 a272 a273 a274 a275 a276 a277 a278 a279 a280 a281 a282 a283 a284 a285 a286 a287 a288 a289 a290 a291 a292 a293 a294 a295 a296 a297 a298 a299 a300 a301 a302 a303 a304 a305 a306 a307 a308 a309 a310 a311 a312 a313 a314 a315 a316 a317 a318 a319 a320 a321 a322 a323 a324 a325 a326 a327 a328 a329 a330 a331 a332 a333 a334 a335 a336 a337 a338 a339 a340 a341 a342 a343 a344 a345 a346 a347 a348 a349 a350 a351 a352 a353 a354 a355 a356 a357 a358 a359 a360 a361 a362 a363 a364 a365 a366 a367 a368 a369 a370 a371 a372 a373 a374 a375 a376 a377 a378 a379 a380 a381 a382 a383 a384 a385 a386 a387 a388 a389 a390 a391 a392 a393 a394 a395 a396 a397 a398 a399 a400 a401 a402 a403 a404 a405 a406 a407 a408 a409 a410 a411 a412 a413 a414 a415 a416 a417 a418 a419 a420 a421 a422 a423 a424 a425 a426 a427 a428 a429 a430 a431 a432 a433 a434 a435 a436 a437 a438 a439 a440 a441 a442 a443 a444 a445 a446 a447 a448 a449 a450 a451 a452 a453 a454 a455 a456 a457 a458 a459 a460 a461 a462 a463 a464 a465 a466 a467 a468 a469 a470 a471 a472 a473 a474 a475 a476 a477 a478 a479 a480 a481 a482 a483 a484 a485 a486 a487 a488 a489 a490 a491 a492 a493 a494 a495 a496 a497 a498 a499) = a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + a64 + a65 + a66 + a67 + a68 + a69 + a70 + a71 + a72 + a73 + a74 + a75 + a76 + a77 + a78 + a79 + a80 + a81 + a82 + a83 + a84 + a85 + a86 + a87 + a88 + a89 + a90 + a91 + a92 + a93 + a94 + a95 + a96 + a97 + a98 + a99 + a100 + a101 + a102 + a103 + a104 + a105 + a106 + a107 + a108 + a109 + a110 + a111 + a112 + a113 + a114 + a115 + a116 + a117 + a118 + a119 + a120 + a121 + a122 + a123 + a124 + a125 + a126 + a127 + a128 + a129 + a130 + a131 + a132 + a133 + a134 + a135 + a136 + a137 + a138 + a139 + a140 + a141 + a142 + a143 + a144 + a145 + a146 + a147 + a148 + a149 + a150 + a151 + a152 + a153 + a154 + a155 + a156 + a157 + a158 + a159 + a160 + a161 + a162 + a163 + a164 + a165 + a166 + a167 + a168 + a169 + a170 + a171 + a172 + a173 + a174 + a175 + a176 + a177 + a178 + a179 + a180 + a181 + a182 + a183 + a184 + a185 + a186 + a187 + a188 + a189 + a190 + a191 + a192 + a193 + a194 + a195 + a196 + a197 + a198 + a199 + a200 + a201 + a202 + a203 + a204 + a205 + a206 + a207 + a208 + a209 + a210 + a211 + a212 + a213 + a214 + a215 + a216 + a217 + a218 + a219 + a220 + a221 + a222 + a223 + a224 + a225 + a226 + a227 + a228 + a229 + a230 + a231 + a232 + a233 + a234 + a235 + a236 + a237 + a238 + a239 + a240 + a241 + a242 + a243 + a244 + a245 + a246 + a247 + a248 + a249 + a250 + a251 + a252 + a253 + a254 + a255 + a256 + a257 + a258 + a259 + a260 + a261 + a262 + a263 + a264 + a265 + a266 + a267 + a268 + a269 + a270 + a271 + a272 + a273 + a274 + a275 + a276 + a277 + a278 + a279 + a280 + a281 + a282 + a283 + a284 + a285 + a286 + a287 + a288 + a289 + a290 + a291 + a292 + a293 + a294 + a295 + a296 + a297 + a298 + a299 + a300 + a301 + a302 + a303 + a304 + a305 + a306 + a307 + a308 + a309 + a310 + a311 + a312 + a313 + a314 + a315 + a316 + a317 + a318 + a319 + a320 + a321 + a322 + a323 + a324 + a325 + a326 + a327 + a328 + a329 + a330 + a331 + a332 + a333 + a334 + a335 + a336 + a337 + a338 + a339 + a340 + a341 + a342 + a343 + a344 + a345 + a346 + a347 + a348 + a349 + a350 + a351 + a352 + a353 + a354 + a355 + a356 + a357 + a358 + a359 + a360 + a361 + a362 + a363 + a364 + a365 + a366 + a367 + a368 + a369 + a370 + a371 + a372 + a373 + a374 + a375 + a376 + a377 + a378 + a379 + a380 + a381 + a382 + a383 + a384 + a385 + a386 + a387 + a388 + a389 + a390 + a391 + a392 + a393 + a394 + a395 + a396 + a397 + a398 + a399 + a400 + a401 + a402 + a403 + a404 + a405 + a406 + a407 + a408 + a409 + a410 + a411 + a412 + a413 + a414 + a415 + a416 + a417 + a418 + a419 + a420 + a421 + a422 + a423 + a424 + a425 + a426 + a427 + a428 + a429 + a430 + a431 + a432 + a433 + a434 + a435 + a436 + a437 + a438 + a439 + a440 + a441 + a442 + a443 + a444 + a445 + a446 + a447 + a448 + a449 + a450 + a451 + a452 + a453 + a454 + a455 + a456 + a457 + a458 + a459 + a460 + a461 + a462 + a463 + a464 + a465 + a466 + a467 + a468 + a469 + a470 + a471 + a472 + a473 + a474 + a475 + a476 + a477 + a478 + a479 + a480 + a481 + a482 + a483 + a484 + a485 + a486 + a487 + a488 + a489 + a490 + a491 + a492 + a493 + a494 + a495 + a496 + a497 + a498 + a499 + +main :: IO () +main = do + bigs <- forM [1..100] (return . mkBig) + performMajorGC + forM_ [1..3] (const performMajorGC) + print (sum (map sumBig bigs)) ===================================== testsuite/tests/rts/T27649.stdout ===================================== @@ -0,0 +1 @@ +15000000 ===================================== testsuite/tests/rts/all.T ===================================== @@ -699,8 +699,20 @@ test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']) test('T27123', [when(have_profiling(), extra_ways(['prof']))], compile_and_run, ['-O']) +# T27434 and T27649 test the compacting GC on large closures (AP and +# CONSTR respectively) that only the bytecode interpreter allocates, so +# they must run in the ghci way. In the ghci way extra_run_opts only +# sets the interpreted program's argv (via :set args), so enable +# compaction with GHCRTS to make it reach the RTS of the GHCi process +# itself (#27615). test('T27434', - extra_ways(['compacting_gc']), + [only_ways(['ghci']), + cmd_prefix('GHCRTS=-c ')], + compile_and_run, ['']) + +test('T27649', + [only_ways(['ghci']), + cmd_prefix('GHCRTS=-c ')], compile_and_run, ['']) test('T19048', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82c73b223a985bc0bcc00cb6252b2b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82c73b223a985bc0bcc00cb6252b2b… 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/jeltsch/improve-closure-property-check] Improve the definition of the closure property
by Wolfgang Jeltsch (＠jeltsch) 16 Sep '26

16 Sep '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC Commits: bbeff40d by Wolfgang Jeltsch at 2026-09-15T20:44:07+03:00 Improve the definition of the closure property - - - - - 1 changed file: - compiler/GHC/Unit/Env.hs Changes: ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -443,11 +443,10 @@ The flow: Closure Property ---------------- -A unit environment must have the closure property, which means that, whenever -some units /h/₁ and /h/₂ have been loaded as home units, /h/₁ does not directly -or indirectly depend on an external unit that directly or indirectly depends -on /h/₂. 'GHC.Driver.Downsweep.checkHomeUnitsClosed' checks whether a given unit -environment indeed has this property. +A unit environment must have the closure property, which means that a home unit +must not directly or indirectly depend on an external unit that directly or +indirectly depends on a home unit. 'GHC.Driver.Downsweep.checkHomeUnitsClosed' +checks whether a given unit environment indeed has this property. Offsetting Paths ---------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbeff40da6d01f69a2741e9997e236e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbeff40da6d01f69a2741e9997e236e… 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