Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2d52b3b by Wolfgang Jeltsch at 2025-12-23T04:47:33-05:00 Add an operation `System.IO.hGetNewlineMode` This commit also contains some small code and documentation changes for related operations, for the sake of consistency. - - - - - b26d134a by Cheng Shao at 2025-12-23T04:48:15-05:00 rts: opportunistically reclaim slop space in shrinkMutableByteArray# Previously, `shrinkMutableByteArray#` shrinks a `MutableByteArray#` in-place by assigning the new size to it, and zeroing the extra slop space. That slop space is not reclaimed and wasted. But it's often the case that we allocate a `MutableByteArray#` upfront, then shrink it shortly after, so the `MutableByteArray#` closure sits right at the end of a nursery block; this patch identifies such chances, and also shrink `bd->free` if possible, reducing heap space fragmentation. Co-authored-by: Codex ------------------------- Metric Decrease: T10678 ------------------------- - - - - - fa7e3ff0 by Cheng Shao at 2025-12-23T11:13:02-05:00 hadrian: fix bootstrapping with ghc-9.14 This patch fixes bootstrapping GHC with ghc-9.14, tested locally with ghc-9.14.1 release as bootstrapping GHC. - - - - - a648f491 by Cheng Shao at 2025-12-23T11:13:03-05:00 hadrian: pass -keep-tmp-files to test ghc when --keep-test-files is enabled This patch makes hadrian pass `-keep-tmp-files` to test ghc when `--keep-test-files` is enabled, so you can check the ghc intermediate files when debugging certain test failures. Closes #26688. - - - - - 13 changed files: - .gitlab/ci.sh - hadrian/cabal.project - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/changelog.md - libraries/base/src/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - rts/PrimOps.cmm - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,7 +8,7 @@ set -Eeuo pipefail # Configuration: # N.B. You may want to also update the index-state in hadrian/cabal.project. -HACKAGE_INDEX_STATE="2025-01-27T17:45:32Z" +HACKAGE_INDEX_STATE="2025-12-19T19:24:24Z" MIN_HAPPY_VERSION="1.20" MIN_ALEX_VERSION="3.2.6" ===================================== hadrian/cabal.project ===================================== @@ -4,11 +4,11 @@ packages: ./ -- This essentially freezes the build plan for hadrian -- It would be wise to keep this up to date with the state set in .gitlab/ci.sh. -index-state: 2025-01-27T17:45:32Z +index-state: 2025-12-19T19:24:24Z --- unordered-containers-0.2.20-r1 requires template-haskell < 2.22 --- ghc-9.10 has template-haskell-2.22.0.0 -allow-newer: unordered-containers:template-haskell +-- Fixes bootstrapping with ghc-9.14 +allow-newer: all:base, all:ghc-bignum, all:template-haskell +constraints: hashable >= 1.5.0.0 -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -47,12 +47,20 @@ runTestGhcFlags = do then "-optc-fno-builtin" else "" + -- Also pass -keep-tmp-files to GHC when --keep-test-files is + -- passed to hadrian for debugging purpose (#26688) + keepFiles <- testKeepFiles <$> userSetting defaultTestArgs + let keepTmpFilesFlag + | keepFiles = "-keep-tmp-files" + | otherwise = "" + -- Take flags to send to the Haskell compiler from test.mk. -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37 unwords <$> sequence [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways -fprint-error-index-links=never -rtsopts" , pure ghcOpts , pure ghcExtraFlags + , pure keepTmpFilesFlag , ifMinGhcVer "711" "-fno-warn-missed-specialisations" , ifMinGhcVer "711" "-fshow-warning-groups" , ifMinGhcVer "801" "-fdiagnostics-color=never" ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,7 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.23.0.0 *TBA* + * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{init,last}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/292)) ===================================== libraries/base/src/System/IO.hs ===================================== @@ -175,6 +175,7 @@ module System.IO -- Binary-mode 'Handle's do no newline translation at all. hSetNewlineMode, + hGetNewlineMode, Newline(..), nativeNewline, NewlineMode(..), ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Internal.IO.Handle ( hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable, hSetEcho, hGetEcho, hIsTerminalDevice, - hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, + hSetNewlineMode, hGetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, noNewlineTranslation, universalNewlineMode, nativeNewlineMode, hShow, @@ -238,7 +238,7 @@ hSetBuffering handle mode = return Handle__{ haBufferMode = mode,.. } -- ----------------------------------------------------------------------------- --- hSetEncoding +-- Setting and getting the text encoding -- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding -- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is @@ -624,16 +624,24 @@ hSetBinaryMode handle bin = haOutputNL = outputNL nl, .. } -- ----------------------------------------------------------------------------- --- hSetNewlineMode +-- Setting and getting the newline mode --- | Set the 'NewlineMode' on the specified 'Handle'. All buffered +-- | Set the 'NewlineMode' for the specified 'Handle'. All buffered -- data is flushed first. hSetNewlineMode :: Handle -> NewlineMode -> IO () -hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } = +hSetNewlineMode handle NewlineMode{..} = withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{} -> do flushBuffer h_ - return h_{ haInputNL=i, haOutputNL=o } + return h_{ haInputNL = inputNL, haOutputNL = outputNL } + +-- | Return the current 'NewlineMode' for the specified 'Handle'. +-- +-- @since 4.23.0.0 +hGetNewlineMode :: Handle -> IO NewlineMode +hGetNewlineMode hdl = + withHandle_ "hGetNewlineMode" hdl $ \h_@Handle__{..} -> + return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL } -- ----------------------------------------------------------------------------- -- Duplicating a Handle ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -214,6 +214,7 @@ module GHC.Internal.System.IO ( -- Binary-mode 'Handle's do no newline translation at all. -- hSetNewlineMode, + hGetNewlineMode, Newline(..), nativeNewline, NewlineMode(..), noNewlineTranslation, universalNewlineMode, nativeNewlineMode, ===================================== rts/PrimOps.cmm ===================================== @@ -204,12 +204,47 @@ stg_isMutableByteArrayWeaklyPinnedzh ( gcptr mba ) stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> State# s { - ASSERT(new_size <= StgArrBytes_bytes(mba)); + W_ old_size, old_wds, new_wds; + W_ bd; + + old_size = StgArrBytes_bytes(mba); + ASSERT(new_size <= old_size); + old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size); + new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size); + + // Try to shrink bd->free as well, to reclaim slop space at the end + // of current block and avoid unnecessary fragmentation. But we + // must guarantee that: + // + // 1. mba is already at the end of current block (check bd->free). + // Otherwise we can't move closures that come after it anyway. + // 2. It's a nursery block that belongs to the current Capability, + // so check rCurrentAlloc (used by allocateMightFail) or + // pinned_object_block (used by allocatePinned). There's also no + // point if it's an older generation block, the mutator won't + // allocate into those blocks anyway. + // + // If check fails, fall back to the conservative code path: just + // zero the slop and return. + bd = Bdescr(mba); + if (bdescr_free(bd) != mba + WDS(old_wds) || + (bd != StgRegTable_rCurrentAlloc(BaseReg) && bd != Capability_pinned_object_block(MyCapability()))) { + OVERWRITING_CLOSURE_MUTABLE(mba, new_wds); + StgArrBytes_bytes(mba) = new_size; + // No need to call PROF_HEADER_CREATE. See Note [LDV profiling and resizing arrays] + return (); + } - OVERWRITING_CLOSURE_MUTABLE(mba, (BYTES_TO_WDS(SIZEOF_StgArrBytes) + - ROUNDUP_BYTES_TO_WDS(new_size))); + // Check passes, we can shrink bd->free! Also uninitialize the slop + // if zero_on_gc is enabled, to conform with debug RTS convention. StgArrBytes_bytes(mba) = new_size; - // No need to call PROF_HEADER_CREATE. See Note [LDV profiling and resizing arrays] + IF_DEBUG(zero_on_gc, + prim %memset(mba + WDS(new_wds), + 0xaa, + WDS(old_wds - new_wds), + 1); + ); + bdescr_free(bd) = mba + WDS(new_wds); return (); } @@ -223,18 +258,10 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) { - W_ new_size_wds; - - ASSERT(new_size >= 0); - - new_size_wds = ROUNDUP_BYTES_TO_WDS(new_size); - - if (new_size_wds <= BYTE_ARR_WDS(mba)) { - OVERWRITING_CLOSURE_MUTABLE(mba, (BYTES_TO_WDS(SIZEOF_StgArrBytes) + - new_size_wds)); - StgArrBytes_bytes(mba) = new_size; - // No need to call PROF_HEADER_CREATE. See Note [LDV profiling and resizing arrays] + ASSERT(new_size `ge` 0); + if (new_size <= StgArrBytes_bytes(mba)) { + call stg_shrinkMutableByteArrayzh(mba, new_size); return (mba); } else { (P_ new_mba) = call stg_newByteArrayzh(new_size); ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -10263,6 +10263,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -13309,6 +13309,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -10543,6 +10543,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -10263,6 +10263,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== utils/deriveConstants/Main.hs ===================================== @@ -395,6 +395,7 @@ wanteds os = concat ,fieldOffset Both "StgRegTable" "rCurrentTSO" ,fieldOffset Both "StgRegTable" "rCurrentNursery" ,fieldOffset Both "StgRegTable" "rHpAlloc" + ,structField C "StgRegTable" "rCurrentAlloc" ,structField C "StgRegTable" "rRet" ,structField C "StgRegTable" "rNursery" @@ -414,6 +415,7 @@ wanteds os = concat ,structField C "Capability" "weak_ptr_list_hd" ,structField C "Capability" "weak_ptr_list_tl" ,structField C "Capability" "n_run_queue" + ,structField C "Capability" "pinned_object_block" ,structField Both "bdescr" "start" ,structField Both "bdescr" "free" @@ -629,6 +631,8 @@ wanteds os = concat "RTS_FLAGS" "DebugFlags.sanity" ,structField_ C "RtsFlags_DebugFlags_weak" "RTS_FLAGS" "DebugFlags.weak" + ,structField_ C "RtsFlags_DebugFlags_zero_on_gc" + "RTS_FLAGS" "DebugFlags.zero_on_gc" ,structField_ C "RtsFlags_GcFlags_initialStkSize" "RTS_FLAGS" "GcFlags.initialStkSize" ,structField_ C "RtsFlags_MiscFlags_tickInterval" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/988619c7a08ff8daf53ce835c34ca31... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/988619c7a08ff8daf53ce835c34ca31... You're receiving this email because of your account on gitlab.haskell.org.