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/809294f14cf6939b249d93af92c0ae17... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/809294f14cf6939b249d93af92c0ae17... 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