September 2026 - ghc-commits

[Git][ghc/ghc][master] 2 commits: testsuite: Fix out-of-bounds access in T3586
by Marge Bot (＠marge-bot) 01 Sep '26

01 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4bfbf5c8 by ARATA Mizuki at 2026-09-01T18:55:08-04:00 testsuite: Fix out-of-bounds access in T3586 unsafeRead and unsafeWrite use 0-based index. Looking at #3586, the expected output seems to be 2.8e8. Addresses #27596 - - - - - 3f9db6d4 by ARATA Mizuki at 2026-09-01T18:55:08-04:00 testsuite: Fix out-of-bounds access in T21305 writeInt64Array# takes an index measured in units of Int64 elements. Fixes #27596 - - - - - 3 changed files: - testsuite/tests/ffi/should_run/T21305.hs - testsuite/tests/perf/should_run/T3586.hs - testsuite/tests/perf/should_run/T3586.stdout Changes: ===================================== testsuite/tests/ffi/should_run/T21305.hs ===================================== @@ -45,4 +45,4 @@ writeByteArray# :: MutableByteArray# RealWorld writeByteArray# _ _ [] s = s writeByteArray# mba off (I64# i:is) s = case writeInt64Array# mba off i s of - s' -> writeByteArray# mba (off +# 8#) is s' + s' -> writeByteArray# mba (off +# 1#) is s' ===================================== testsuite/tests/perf/should_run/T3586.hs ===================================== @@ -14,7 +14,8 @@ go :: STUArray s Int Double -> Int -> Double -> ST s Double go !a i !acc | i < 1 = return acc | otherwise = do - b <- unsafeRead a i - unsafeWrite a i (b+3.0) - c <- unsafeRead a i + -- unsafeRead/unsafeWrite use 0-based index + b <- unsafeRead a (i-1) + unsafeWrite a (i-1) (b+3.0) + c <- unsafeRead a (i-1) go a (i-1) (c+acc) ===================================== testsuite/tests/perf/should_run/T3586.stdout ===================================== @@ -1 +1 @@ -2.79999863e8 +2.8e8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4117e5ae711b9d7f6dd1f59362916a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4117e5ae711b9d7f6dd1f59362916a… 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/andrea/gbc-backport] testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests
by Andrea Vezzosi (＠trac-Saizan) 01 Sep '26

01 Sep '26

Andrea Vezzosi pushed to branch wip/andrea/gbc-backport at Glasgow Haskell Compiler / GHC Commits: d02068f2 by Matthew Pickering at 2026-09-01T22:41:28+02:00 testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests These tests reimplemented the logic from `valid_way` in order to determine what ways to run. It's easier to use this combination of `only_ways` and `extra_ways` to only run in GHCi ways and always run in GHCi ways. (cherry picked from commit 1275d3607299734228adbbc47bfb69bf8800279f) - - - - - 5 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T - testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T - testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -136,9 +136,12 @@ class TestConfig: # Do we have interpreter support? self.have_interp = False + # Do we have external interpreter support? + self.have_ext_interp = False + # Are we cross-compiling? self.cross = False - + # Does the RTS linker only support loading shared libraries? self.interp_force_dyn = False ===================================== testsuite/driver/testlib.py ===================================== @@ -549,10 +549,12 @@ only_ghci = only_ways([WayName('ghci'), WayName('ghci-opt')]) # ----- def valid_way( way: WayName ) -> bool: - if way in {'ghci', 'ghci-opt', 'ghci-ext'}: + if way in {'ghci', 'ghci-opt'}: return config.have_RTS_linker - if way == 'ghci-ext-prof': - return config.have_RTS_linker and config.have_profiling + if way in {'ghci-ext'}: + return config.have_ext_interp + if way in {'ghci-ext-prof'}: + return config.have_ext_interp and config.have_profiling return True def extra_ways( ways: List[WayName] ): ===================================== testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T ===================================== @@ -2,9 +2,8 @@ test('PackedDataCon', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + extra_ways(ghci_ways), + only_ways(ghci_ways), ], compile_and_run, [''] ===================================== testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T ===================================== @@ -2,9 +2,8 @@ test('UnboxedTuples', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + only_ways(ghci_ways), + extra_ways(ghci_ways), ], compile_and_run, [''] ===================================== testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T ===================================== @@ -2,9 +2,8 @@ test('UnliftedDataTypeInterp', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + only_ways(ghci_ways), + extra_ways(ghci_ways), ], compile_and_run, [''] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d02068f2c095634566cd258881aec95… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d02068f2c095634566cd258881aec95… 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/az/epa-tidy-locatedxxx-22] 7 commits: Never make an absent filler for a constraint type
by Alan Zimmerman (＠alanz) 01 Sep '26

01 Sep '26

Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-22 at Glasgow Haskell Compiler / GHC Commits: 7bf546fc by Simon Peyton Jones at 2026-08-31T23:48:53-04:00 Never make an absent filler for a constraint type mkAbsentFiller used isTerminatingType to decide, but that is not enough. Consider class Eq a => UC a where {} let u :: UC Int -- UC Int is a "non-terminating type" u = error "Absent" let e :: Eq Int -- Eq Int is a "terminating type" e = $p1UC u We clearly must not make a filler for `e`, because we speculatively evaluate it. But speculatively evaluating `e` forces `u`, so we must not make one for `u` either. Asking isDictTy instead is not enough either, because it does not catch a constraint hidden behind an unreduced type family application: type family F a :: Constraint type instance F W = TC W a :: F W => Int -> Int -- (F W) argument is absent Oops! Entered absent arg Arg: irred Type: F W So play safe and use isPredTy: never make an absent filler for any constraint-kinded type. Fixes #27627 - - - - - 5f474953 by Zubin Duggal at 2026-08-31T23:48:53-04:00 Add tests for absent fillers at dictionary types T27627 a unary class whose superclass is a non-unary class T27627a ...whose superclass is a Constraint-kinded type family T27627b ...whose superclass is a quantified constraint T27627c a unary class applied to itself, (UC (UC (TC a))) T27627e a (forall b. P b) dictionary that loops - - - - - cd5c6bcc by Zubin Duggal at 2026-08-31T23:48:53-04:00 An abstract TyCon may hide a unary class A class declared in an hs-boot file is an AbstractTyCon inside the module loop, and compiling the real declaration may reveal it to be a UnaryClassTyCon. - isTerminatingType returned True for such AbstractTyCons - IfaceToCore set the unary flag to False in the DFunId So we could end up speculating bottom dictionaries because inside a module loop we see an UnaryClassTyCon as an AbstractTyCon Use isTerminatingTyCon, which returns False for an abstract TyCon. The Bool in DFunId is now a cache for isTerminatingTyCon, set in mkDFunIdDetails. Fixes #27704 - - - - - abfc224a by Zubin Duggal at 2026-08-31T23:48:53-04:00 Specialise: don't replace dead args with absent fillers specHeader decides an argument is dead by calling isDeadBinder on a binder of the /optimised RHS/, then applies the filler to the /stable unfolding/ template instead. The two may differ, so the argument can be dead in the RHS and not in the template. The specialised function's unfolding then has an absent filler, and any call site that inlines it evaluates the error thunk. Dropping dead args in the specialiser is rarely worth it, to quote Simon, "The later worker/wrapper pass will pick up the dead arg later if it is really dead. Keeps the specialiser simpler." So instead of trying to check if the arg really is dead in the stable unfolding, just drop the logic for dropping dead args in the specialiser altogeher. Fixes #27703 - - - - - 1557fd1c by Zubin Duggal at 2026-08-31T23:48:53-04:00 CorePrep: don't speculate a call across an hs-boot edge We take care not to evaluate things that might be bottom, like a looping dictionary group, but our analysis is defeated by boot files. We only track recursion within a module, so two dictionaries that depend on each other across a module loop each look non-recursive, and we might speculate them. Any recursion we cannot see must cross an hs-boot edge, so refuse to speculate calls that cross one. Fixes #27717 - - - - - 4117e5ae by Wolfgang Jeltsch at 2026-08-31T23:49:35-04:00 Incorporate the `rethrowSTM` reexport into the `stm` submodule - - - - - d2edb197 by Alan Zimmerman at 2026-09-01T18:18:02+01:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 76 changed files: - + changelog.d/27627 - + changelog.d/27703 - + changelog.d/27704 - + changelog.d/27717 - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Literal.hs - libraries/stm - + testsuite/tests/core-to-stg/T27627/Callee.hs - + testsuite/tests/core-to-stg/T27627/Caller.hs - + testsuite/tests/core-to-stg/T27627/Main.hs - + testsuite/tests/core-to-stg/T27627/T27627.stdout - + testsuite/tests/core-to-stg/T27627/all.T - + testsuite/tests/core-to-stg/T27627a/Callee.hs - + testsuite/tests/core-to-stg/T27627a/Caller.hs - + testsuite/tests/core-to-stg/T27627a/Main.hs - + testsuite/tests/core-to-stg/T27627a/T27627a.stdout - + testsuite/tests/core-to-stg/T27627a/all.T - + testsuite/tests/core-to-stg/T27627b/Callee.hs - + testsuite/tests/core-to-stg/T27627b/Caller.hs - + testsuite/tests/core-to-stg/T27627b/Main.hs - + testsuite/tests/core-to-stg/T27627b/T27627b.stdout - + testsuite/tests/core-to-stg/T27627b/all.T - + testsuite/tests/core-to-stg/T27627c/Callee.hs - + testsuite/tests/core-to-stg/T27627c/Caller.hs - + testsuite/tests/core-to-stg/T27627c/Main.hs - + testsuite/tests/core-to-stg/T27627c/T27627c.stdout - + testsuite/tests/core-to-stg/T27627c/all.T - + testsuite/tests/core-to-stg/T27627e.hs - + testsuite/tests/core-to-stg/T27627e.stdout - + testsuite/tests/core-to-stg/T27627f/Callee.hs - + testsuite/tests/core-to-stg/T27627f/Caller.hs - + testsuite/tests/core-to-stg/T27627f/Inst.hs - + testsuite/tests/core-to-stg/T27627f/Main.hs - + testsuite/tests/core-to-stg/T27627f/T27627f.stdout - + testsuite/tests/core-to-stg/T27627f/all.T - + testsuite/tests/core-to-stg/T27704/Callee.hs - + testsuite/tests/core-to-stg/T27704/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704/Main.hs - + testsuite/tests/core-to-stg/T27704/Mid.hs - + testsuite/tests/core-to-stg/T27704/T27704.stdout - + testsuite/tests/core-to-stg/T27704/all.T - + testsuite/tests/core-to-stg/T27704a/Callee.hs - + testsuite/tests/core-to-stg/T27704a/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704a/Main.hs - + testsuite/tests/core-to-stg/T27704a/Mid.hs - + testsuite/tests/core-to-stg/T27704a/T27704a.stdout - + testsuite/tests/core-to-stg/T27704a/all.T - + testsuite/tests/core-to-stg/T27717/Callee.hs - + testsuite/tests/core-to-stg/T27717/Callee.hs-boot - + testsuite/tests/core-to-stg/T27717/Main.hs - + testsuite/tests/core-to-stg/T27717/Mid.hs - + testsuite/tests/core-to-stg/T27717/T27717.stdout - + testsuite/tests/core-to-stg/T27717/Ty.hs - + testsuite/tests/core-to-stg/T27717/all.T - testsuite/tests/core-to-stg/all.T - testsuite/tests/simplCore/should_compile/T17966.stderr - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/simplCore/should_compile/spec004.hs - testsuite/tests/simplCore/should_compile/spec004.stderr - + testsuite/tests/simplCore/should_run/T27703/Lib.hs - + testsuite/tests/simplCore/should_run/T27703/Main.hs - + testsuite/tests/simplCore/should_run/T27703/T27703.stdout - + testsuite/tests/simplCore/should_run/T27703/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee1c879eaf97bd0e168234f9623732… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee1c879eaf97bd0e168234f9623732… 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/romes/multi-threaded-debugger] 2 commits: have to fix these toggle untoggle things
by Rodrigo Mesquita (＠alt-romes) 01 Sep '26

01 Sep '26

Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC Commits: 5abaed82 by Rodrigo Mesquita at 2026-09-01T18:12:20+01:00 have to fix these toggle untoggle things - - - - - 32737daa by Rodrigo Mesquita at 2026-09-01T18:37:21+01:00 very satisfying solution with mutable state Matthew-certified big brain - - - - - 1 changed file: - libraries/ghci/GHCi/Run.hs Changes: ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -210,8 +210,8 @@ resumeSeq hvref = clearEvalStatus <$> do ResumeContext{..} <- getThreadResumeContext resumeThreadId mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... - redirectInterrupts resumeThreadId $ do - takeMVar globalDbgStatusMVar + redirectInterrupts resumeThreadId $ + readThreadEvalStatus resumeThreadId evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts @@ -242,11 +242,10 @@ sandboxIO opts io = do tid <- forkIO $ do tid <- myThreadId labelThread tid "GHCi sandbox" - unsafeUnmask runIt >>= putMVar globalDbgStatusMVar -- TODO: see IDEA in 'globalDbgStatusMVar' - -- empty: can't block + unsafeUnmask runIt >>= writeThreadEvalStatus tid + redirectInterrupts tid $ unsafeUnmask $ - takeMVar globalDbgStatusMVar -- TODO: following IDEA, here we should block - -- on either the globalDbgStatusVar or on the per-call EvalSuccess mvar (written above, needs diff var). + readThreadEvalStatus tid else -- GLUT on OS X needs to run on the main thread. If you -- try to use it from another thread then you just get a @@ -339,16 +338,17 @@ withBreakAction opts mtid act = bracket setBreakAction resetBreakAction (\_ -> act) where setBreakAction = do - poke breakPointIOAction globalBreakStablePtr -- TODO: This is thread unsafe, as one thread might be accessing this global variable while this thread tries to overwrite it. + poke breakPointIOAction globalBreakStablePtr -- TODO: This is thread unsafe, as one thread might be accessing this global variable while this thread tries to overwrite it. We should rather do it when the interpreter process/internal is initialized somehow. when (breakOnException opts) $ poke exceptionFlag 1 when (singleStep opts) $ do + rts_enableStopNextBreakpointAll case mtid of - Nothing -> rts_enableStopNextBreakpointAll + Nothing -> pure () Just (ThreadId tid) -> do rts_enableStopNextBreakpoint tid when (stepOut opts) $ do case mtid of - Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped + Nothing -> pure () Just (ThreadId tid) -> do rts_enableStopAfterReturn tid return () @@ -360,10 +360,13 @@ withBreakAction opts mtid act -- poke breakPointIOAction noBreakStablePtr -- Never unset it. -- TODO: What about evaluating a thunk with breakpoints? when did we get "ignoring breakpoint..." before? poke exceptionFlag 0 - rts_disableStopNextBreakpointAll case mtid of Just (ThreadId tid) -> rts_disableStopAfterReturn tid _ -> pure () + case mtid of + Nothing -> rts_disableStopNextBreakpointAll + Just (ThreadId tid) -> do + rts_disableStopNextBreakpoint tid -- freeStablePtr stablePtr resumeStmt @@ -376,7 +379,7 @@ resumeStmt opts rtid = do mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... redirectInterrupts resumeThreadId $ - takeMVar globalDbgStatusMVar -- TODO: See IDEA. This here is wrongish + readThreadEvalStatus resumeThreadId -- when abandoning a computation we have to -- (a) kill the thread with an async exception, so that the @@ -396,37 +399,9 @@ abandonStmt hvref = do ResumeContext{..} <- getThreadResumeContext tid killThread tid putMVar resumeBreakMVar () - _ <- takeMVar globalDbgStatusMVar -- TODO: See IDEA: this here is wrongish + _ <- readThreadEvalStatus tid return () -globalBreakStablePtr :: StablePtr BreakpointCallback -globalBreakStablePtr = unsafePerformIO $ newStablePtr globalBreakAction - -globalBreakAction :: BreakpointCallback -globalBreakAction info_mod# info_mod_uid# infox# is_exception apStack = do - tid <- myThreadId - ResumeContext{..} <- getThreadResumeContext tid - resume_r <- mkRemoteRef tid - apStack_r <- mkRemoteRef apStack - ccs <- toRemotePtr <$> getCCSOf apStack - breakpoint <- - if is_exception - then pure Nothing - else do - info_mod <- BS.packCString (Ptr info_mod#) - info_mod_uid <- BS.packCString (Ptr info_mod_uid#) - pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) - putMVar globalDbgStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs - - -- Block until this thread is resumed (by the thread which took the - -- `ResumeContext` from the `statusMVar`). - -- - -- The `onBreak` function must have been called from `rts/Interpreter.c` - -- when interpreting a `BRK_FUN`. After taking from the MVar, the function - -- returns to the continuation on the stack which is where the interpreter - -- was stopped. - takeMVar resumeBreakMVar - -- Malloc and copy the bytes. We don't have any way to monitor the -- lifetime of this memory, so it just leaks. mkString :: ByteString -> IO (RemotePtr ()) @@ -475,7 +450,38 @@ clearEvalStatus = \case -------------------------------------------------------------------------------- -- Global Debugger Per-Thread Context --- TODO: when to clean? +-- TODO: when to clean MVar? how to figure out when Threads are dead and we'll never need their mvars again? perhaps a finalizer on the thread id? +-- TODO: Move to independent module, and don't expose the global variables at all. move also the global break action maybe. +-- Maybe there could even be something in that module for setting the global +-- break action on start. maybe just an init function + +globalBreakStablePtr :: StablePtr BreakpointCallback +globalBreakStablePtr = unsafePerformIO $ newStablePtr globalBreakAction + +globalBreakAction :: BreakpointCallback +globalBreakAction info_mod# info_mod_uid# infox# is_exception apStack = do + tid <- myThreadId + ResumeContext{..} <- getThreadResumeContext tid + resume_r <- mkRemoteRef tid + apStack_r <- mkRemoteRef apStack + ccs <- toRemotePtr <$> getCCSOf apStack + breakpoint <- + if is_exception + then pure Nothing + else do + info_mod <- BS.packCString (Ptr info_mod#) + info_mod_uid <- BS.packCString (Ptr info_mod_uid#) + pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) + writeThreadEvalStatus tid $ EvalBreak apStack_r breakpoint resume_r ccs + + -- Block until this thread is resumed (by the thread which took the + -- `ResumeContext` from the `statusMVar`). + -- + -- The `onBreak` function must have been called from `rts/Interpreter.c` + -- when interpreting a `BRK_FUN`. After taking from the MVar, the function + -- returns to the continuation on the stack which is where the interpreter + -- was stopped. + takeMVar resumeBreakMVar getThreadResumeContext :: ThreadId -> IO ResumeContext getThreadResumeContext tid = modifyMVar globalBreakActionMap $ \gbm0 -> do @@ -499,6 +505,27 @@ newtype ResumeContext = ResumeContext -- The debugger can unblock that thread by signaling its MVar. } +-- brilliant STM +-- * only retries when the map is written again +-- * essentially blocks until the result for this thread is there +readThreadEvalStatus :: ThreadId -> IO (EvalStatus [HValueRef]) +readThreadEvalStatus tid = do + atomically $ do + dbgmap <- readTVar globalDbgStatusVar + case Map.lookup tid dbgmap of + Just r -> do + writeTVar globalDbgStatusVar $! + Map.delete tid dbgmap -- clear it + pure r + Nothing -> retry -- until someone writes the result for this thread + +writeThreadEvalStatus :: ThreadId -> EvalStatus [HValueRef] -> IO () +writeThreadEvalStatus tid new = do + atomically $ do + dbgmap <- readTVar globalDbgStatusVar + writeTVar globalDbgStatusVar $! + Map.insertWith (\_ _ -> error "writeThreadEvalStatus: should be impossible") tid new dbgmap + -- | A global synchronization variable which a thread writes an 'EvalBreak' to -- when it hits a breakpoint. This variable is shared across all threads, and -- the debugger can read the threads which hit breakpoints by reading from this @@ -511,6 +538,9 @@ newtype ResumeContext = ResumeContext -- IDEA: maybe `sandboxIO` and friends receive as an argument the var on which -- to expect the result specifically? And distinguish that from the global break var? -- Then we split the EvalSuccess and EvalBreak into two datatypes. -globalDbgStatusMVar :: MVar (EvalStatus [HValueRef]) -globalDbgStatusMVar = unsafePerformIO $ newEmptyMVar -{-# NOINLINE globalDbgStatusMVar #-} +-- +-- Instead, let's just assume we may wait for a single thread's result and this +-- kind of falls out nicely. See my impl. notes. +globalDbgStatusVar :: TVar (Map.Map ThreadId (EvalStatus [HValueRef])) +globalDbgStatusVar = unsafePerformIO $ newTVarIO Map.empty +{-# NOINLINE globalDbgStatusVar #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/656602a8b82cd54413cae6b9e8c492… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/656602a8b82cd54413cae6b9e8c492… 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/andrea/gbc-backport
by Andrea Vezzosi (＠trac-Saizan) 01 Sep '26

01 Sep '26

Andrea Vezzosi pushed new branch wip/andrea/gbc-backport at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andrea/gbc-backport 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/romes/multi-threaded-debugger] the status Var must actually be global across all threads, otherwise all of...
by Rodrigo Mesquita (＠alt-romes) 01 Sep '26

01 Sep '26

Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC Commits: 656602a8 by Rodrigo Mesquita at 2026-09-01T16:59:51+01:00 the status Var must actually be global across all threads, otherwise all of them will block trying to write some Status Var no one is looking at at all - - - - - 1 changed file: - libraries/ghci/GHCi/Run.hs Changes: ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -211,7 +211,7 @@ resumeSeq hvref = clearEvalStatus <$> do mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... redirectInterrupts resumeThreadId $ do - takeMVar resumeStatusMVar + takeMVar globalDbgStatusMVar evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts @@ -241,12 +241,12 @@ sandboxIO opts io = do then do tid <- forkIO $ do tid <- myThreadId - ResumeContext{..} <- getThreadResumeContext tid labelThread tid "GHCi sandbox" - unsafeUnmask runIt >>= putMVar resumeStatusMVar + unsafeUnmask runIt >>= putMVar globalDbgStatusMVar -- TODO: see IDEA in 'globalDbgStatusMVar' -- empty: can't block - ResumeContext{..} <- getThreadResumeContext tid - redirectInterrupts tid $ unsafeUnmask $ takeMVar resumeStatusMVar + redirectInterrupts tid $ unsafeUnmask $ + takeMVar globalDbgStatusMVar -- TODO: following IDEA, here we should block + -- on either the globalDbgStatusVar or on the per-call EvalSuccess mvar (written above, needs diff var). else -- GLUT on OS X needs to run on the main thread. If you -- try to use it from another thread then you just get a @@ -375,7 +375,8 @@ resumeStmt opts rtid = do withBreakAction opts (Just resumeThreadId) $ mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... - redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar + redirectInterrupts resumeThreadId $ + takeMVar globalDbgStatusMVar -- TODO: See IDEA. This here is wrongish -- when abandoning a computation we have to -- (a) kill the thread with an async exception, so that the @@ -395,7 +396,7 @@ abandonStmt hvref = do ResumeContext{..} <- getThreadResumeContext tid killThread tid putMVar resumeBreakMVar () - _ <- takeMVar resumeStatusMVar + _ <- takeMVar globalDbgStatusMVar -- TODO: See IDEA: this here is wrongish return () globalBreakStablePtr :: StablePtr BreakpointCallback @@ -415,7 +416,7 @@ globalBreakAction info_mod# info_mod_uid# infox# is_exception apStack = do info_mod <- BS.packCString (Ptr info_mod#) info_mod_uid <- BS.packCString (Ptr info_mod_uid#) pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) - putMVar resumeStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs + putMVar globalDbgStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs -- Block until this thread is resumed (by the thread which took the -- `ResumeContext` from the `statusMVar`). @@ -476,21 +477,40 @@ clearEvalStatus = \case -- Global Debugger Per-Thread Context -- TODO: when to clean? -getThreadResumeContext :: ThreadId -> IO (ResumeContext [HValueRef]) +getThreadResumeContext :: ThreadId -> IO ResumeContext getThreadResumeContext tid = modifyMVar globalBreakActionMap $ \gbm0 -> do case Map.lookup tid gbm0 of Nothing -> do - r <- ResumeContext <$> newEmptyMVar <*> newEmptyMVar + r <- ResumeContext <$> newEmptyMVar let !gbm1 = Map.insert tid r gbm0 pure (gbm1, r) Just ctx -> do pure (gbm0, ctx) -globalBreakActionMap :: MVar (Map.Map ThreadId (ResumeContext [HValueRef])) +-- | A global mapping from thread ids to the MVars on which they block when stopped. +globalBreakActionMap :: MVar (Map.Map ThreadId ResumeContext) globalBreakActionMap = unsafePerformIO $ newMVar Map.empty {-# NOINLINE globalBreakActionMap #-} -data ResumeContext a = ResumeContext +newtype ResumeContext = ResumeContext { resumeBreakMVar :: MVar () - , resumeStatusMVar :: MVar (EvalStatus a) + -- ^ A thread that hits a breakpoint blocks reading its corresponding MVar + -- (gotten from the 'globalBreakActionMap'). + -- The debugger can unblock that thread by signaling its MVar. } + +-- | A global synchronization variable which a thread writes an 'EvalBreak' to +-- when it hits a breakpoint. This variable is shared across all threads, and +-- the debugger can read the threads which hit breakpoints by reading from this +-- variable. It will also be written with 'EvalSuccess' when a `sandboxIO` +-- action finishes (TODO: wait what? that is a bit weird. so what if we run two +-- evalStmt? they will both race to write a result? but then how do we tell +-- which result we got from where? this won't do in general, but let's see if +-- it can solve some problems first) +-- +-- IDEA: maybe `sandboxIO` and friends receive as an argument the var on which +-- to expect the result specifically? And distinguish that from the global break var? +-- Then we split the EvalSuccess and EvalBreak into two datatypes. +globalDbgStatusMVar :: MVar (EvalStatus [HValueRef]) +globalDbgStatusMVar = unsafePerformIO $ newEmptyMVar +{-# NOINLINE globalDbgStatusMVar #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/656602a8b82cd54413cae6b9e8c4926… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/656602a8b82cd54413cae6b9e8c4926… 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] 9 commits: Never make an absent filler for a constraint type
by Marge Bot (＠marge-bot) 01 Sep '26

01 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7bf546fc by Simon Peyton Jones at 2026-08-31T23:48:53-04:00 Never make an absent filler for a constraint type mkAbsentFiller used isTerminatingType to decide, but that is not enough. Consider class Eq a => UC a where {} let u :: UC Int -- UC Int is a "non-terminating type" u = error "Absent" let e :: Eq Int -- Eq Int is a "terminating type" e = $p1UC u We clearly must not make a filler for `e`, because we speculatively evaluate it. But speculatively evaluating `e` forces `u`, so we must not make one for `u` either. Asking isDictTy instead is not enough either, because it does not catch a constraint hidden behind an unreduced type family application: type family F a :: Constraint type instance F W = TC W a :: F W => Int -> Int -- (F W) argument is absent Oops! Entered absent arg Arg: irred Type: F W So play safe and use isPredTy: never make an absent filler for any constraint-kinded type. Fixes #27627 - - - - - 5f474953 by Zubin Duggal at 2026-08-31T23:48:53-04:00 Add tests for absent fillers at dictionary types T27627 a unary class whose superclass is a non-unary class T27627a ...whose superclass is a Constraint-kinded type family T27627b ...whose superclass is a quantified constraint T27627c a unary class applied to itself, (UC (UC (TC a))) T27627e a (forall b. P b) dictionary that loops - - - - - cd5c6bcc by Zubin Duggal at 2026-08-31T23:48:53-04:00 An abstract TyCon may hide a unary class A class declared in an hs-boot file is an AbstractTyCon inside the module loop, and compiling the real declaration may reveal it to be a UnaryClassTyCon. - isTerminatingType returned True for such AbstractTyCons - IfaceToCore set the unary flag to False in the DFunId So we could end up speculating bottom dictionaries because inside a module loop we see an UnaryClassTyCon as an AbstractTyCon Use isTerminatingTyCon, which returns False for an abstract TyCon. The Bool in DFunId is now a cache for isTerminatingTyCon, set in mkDFunIdDetails. Fixes #27704 - - - - - abfc224a by Zubin Duggal at 2026-08-31T23:48:53-04:00 Specialise: don't replace dead args with absent fillers specHeader decides an argument is dead by calling isDeadBinder on a binder of the /optimised RHS/, then applies the filler to the /stable unfolding/ template instead. The two may differ, so the argument can be dead in the RHS and not in the template. The specialised function's unfolding then has an absent filler, and any call site that inlines it evaluates the error thunk. Dropping dead args in the specialiser is rarely worth it, to quote Simon, "The later worker/wrapper pass will pick up the dead arg later if it is really dead. Keeps the specialiser simpler." So instead of trying to check if the arg really is dead in the stable unfolding, just drop the logic for dropping dead args in the specialiser altogeher. Fixes #27703 - - - - - 1557fd1c by Zubin Duggal at 2026-08-31T23:48:53-04:00 CorePrep: don't speculate a call across an hs-boot edge We take care not to evaluate things that might be bottom, like a looping dictionary group, but our analysis is defeated by boot files. We only track recursion within a module, so two dictionaries that depend on each other across a module loop each look non-recursive, and we might speculate them. Any recursion we cannot see must cross an hs-boot edge, so refuse to speculate calls that cross one. Fixes #27717 - - - - - 4117e5ae by Wolfgang Jeltsch at 2026-08-31T23:49:35-04:00 Incorporate the `rethrowSTM` reexport into the `stm` submodule - - - - - 04c08a38 by ARATA Mizuki at 2026-09-01T11:34:24-04:00 testsuite: Fix out-of-bounds access in T3586 unsafeRead and unsafeWrite use 0-based index. Looking at #3586, the expected output seems to be 2.8e8. Addresses #27596 - - - - - 570f7127 by ARATA Mizuki at 2026-09-01T11:34:24-04:00 testsuite: Fix out-of-bounds access in T21305 writeInt64Array# takes an index measured in units of Int64 elements. Fixes #27596 - - - - - 37eb9acc by Simon Peyton Jones at 2026-09-01T11:34:24-04:00 Fix buglet in INLINE-arity calculation for pattern synonyms This fixes #27744. The buglet was accidentally introduced by commit 3a0f9a51c1dacc474c7fd128082edd8bf4081256 Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Sat Aug 1 00:13:02 2026 +0100 Fix three bugs related to required type args and INLINE pragmas I failed to find all the calls to `addInlinePragArity`! - - - - - 80 changed files: - + changelog.d/27627 - + changelog.d/27703 - + changelog.d/27704 - + changelog.d/27717 - + changelog.d/T27744 - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Literal.hs - libraries/stm - + testsuite/tests/core-to-stg/T27627/Callee.hs - + testsuite/tests/core-to-stg/T27627/Caller.hs - + testsuite/tests/core-to-stg/T27627/Main.hs - + testsuite/tests/core-to-stg/T27627/T27627.stdout - + testsuite/tests/core-to-stg/T27627/all.T - + testsuite/tests/core-to-stg/T27627a/Callee.hs - + testsuite/tests/core-to-stg/T27627a/Caller.hs - + testsuite/tests/core-to-stg/T27627a/Main.hs - + testsuite/tests/core-to-stg/T27627a/T27627a.stdout - + testsuite/tests/core-to-stg/T27627a/all.T - + testsuite/tests/core-to-stg/T27627b/Callee.hs - + testsuite/tests/core-to-stg/T27627b/Caller.hs - + testsuite/tests/core-to-stg/T27627b/Main.hs - + testsuite/tests/core-to-stg/T27627b/T27627b.stdout - + testsuite/tests/core-to-stg/T27627b/all.T - + testsuite/tests/core-to-stg/T27627c/Callee.hs - + testsuite/tests/core-to-stg/T27627c/Caller.hs - + testsuite/tests/core-to-stg/T27627c/Main.hs - + testsuite/tests/core-to-stg/T27627c/T27627c.stdout - + testsuite/tests/core-to-stg/T27627c/all.T - + testsuite/tests/core-to-stg/T27627e.hs - + testsuite/tests/core-to-stg/T27627e.stdout - + testsuite/tests/core-to-stg/T27627f/Callee.hs - + testsuite/tests/core-to-stg/T27627f/Caller.hs - + testsuite/tests/core-to-stg/T27627f/Inst.hs - + testsuite/tests/core-to-stg/T27627f/Main.hs - + testsuite/tests/core-to-stg/T27627f/T27627f.stdout - + testsuite/tests/core-to-stg/T27627f/all.T - + testsuite/tests/core-to-stg/T27704/Callee.hs - + testsuite/tests/core-to-stg/T27704/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704/Main.hs - + testsuite/tests/core-to-stg/T27704/Mid.hs - + testsuite/tests/core-to-stg/T27704/T27704.stdout - + testsuite/tests/core-to-stg/T27704/all.T - + testsuite/tests/core-to-stg/T27704a/Callee.hs - + testsuite/tests/core-to-stg/T27704a/Callee.hs-boot - + testsuite/tests/core-to-stg/T27704a/Main.hs - + testsuite/tests/core-to-stg/T27704a/Mid.hs - + testsuite/tests/core-to-stg/T27704a/T27704a.stdout - + testsuite/tests/core-to-stg/T27704a/all.T - + testsuite/tests/core-to-stg/T27717/Callee.hs - + testsuite/tests/core-to-stg/T27717/Callee.hs-boot - + testsuite/tests/core-to-stg/T27717/Main.hs - + testsuite/tests/core-to-stg/T27717/Mid.hs - + testsuite/tests/core-to-stg/T27717/T27717.stdout - + testsuite/tests/core-to-stg/T27717/Ty.hs - + testsuite/tests/core-to-stg/T27717/all.T - testsuite/tests/core-to-stg/all.T - testsuite/tests/ffi/should_run/T21305.hs - + testsuite/tests/patsyn/should_compile/T27744.hs - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T3586.hs - testsuite/tests/perf/should_run/T3586.stdout - testsuite/tests/simplCore/should_compile/T17966.stderr - testsuite/tests/simplCore/should_compile/T7785.stderr - testsuite/tests/simplCore/should_compile/spec004.hs - testsuite/tests/simplCore/should_compile/spec004.stderr - + testsuite/tests/simplCore/should_run/T27703/Lib.hs - + testsuite/tests/simplCore/should_run/T27703/Main.hs - + testsuite/tests/simplCore/should_run/T27703/T27703.stdout - + testsuite/tests/simplCore/should_run/T27703/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e92657b304e68628136db55b2b225a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e92657b304e68628136db55b2b225a… 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] Deleted branch wip/jeltsch/rethrow-stm-reexport
by Wolfgang Jeltsch (＠jeltsch) 01 Sep '26

01 Sep '26

Wolfgang Jeltsch deleted branch wip/jeltsch/rethrow-stm-reexport at Glasgow Haskell Compiler / GHC -- 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/romes/multi-threaded-debugger] wip: global break action for multi thread support
by Rodrigo Mesquita (＠alt-romes) 01 Sep '26

01 Sep '26

Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC Commits: 21fe1866 by Rodrigo Mesquita at 2026-09-01T15:58:20+01:00 wip: global break action for multi thread support - - - - - 4 changed files: - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Interpreter.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs Changes: ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Runtime.Eval.Types ( import GHC.Prelude import GHCi.RemoteTypes -import GHCi.Message (EvalExpr, ResumeContext) +import GHCi.Message (EvalExpr) import GHC.ByteCode.Types (InternalBreakpointId(..)) import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id @@ -28,6 +28,7 @@ import GHC.Utils.Exception import Data.Word import GHC.Stack.CCS +import Control.Concurrent (ThreadId) data ExecOptions = ExecOptions @@ -170,7 +171,7 @@ data IcGlobalRdrEnv = IcGlobalRdrEnv data Resume = Resume { resumeStmt :: String -- the original statement - , resumeContext :: ForeignRef (ResumeContext [HValueRef]) + , resumeContext :: ForeignRef ThreadId , resumeBindings :: ResumeBindings , resumeFinalIds :: [Id] -- [Id] to bind on completion , resumeApStack :: ForeignHValue -- The object from which we can get ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -303,16 +303,16 @@ evalStmt interp opts foreign_expr = do resumeStmt :: Interp -> EvalOpts - -> ForeignRef (ResumeContext [HValueRef]) + -> ForeignRef ThreadId -> IO (EvalStatus_ [ForeignHValue] [HValueRef]) -resumeStmt interp opts resume_ctxt = do - status <- withForeignRef resume_ctxt $ \rhv -> +resumeStmt interp opts resume_tid = do + status <- withForeignRef resume_tid $ \rhv -> interpCmd interp (ResumeStmt opts rhv) handleEvalStatus interp status -abandonStmt :: Interp -> ForeignRef (ResumeContext [HValueRef]) -> IO () -abandonStmt interp resume_ctxt = - withForeignRef resume_ctxt $ \rhv -> +abandonStmt :: Interp -> ForeignRef ThreadId -> IO () +abandonStmt interp resume_tid = + withForeignRef resume_tid $ \rhv -> interpCmd interp (AbandonStmt rhv) handleEvalStatus ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -19,7 +19,6 @@ module GHCi.Message , SerializableException(..) , toSerializableException, fromSerializableException , THResult(..), THResultType(..) - , ResumeContext(..) , QState(..) , getMessage, putMessage, getTHMessage, putTHMessage , Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe @@ -138,12 +137,12 @@ data Message a where -- | Resume evaluation of a statement after a breakpoint ResumeStmt :: EvalOpts - -> RemoteRef (ResumeContext [HValueRef]) + -> RemoteRef ThreadId -> Message (EvalStatus [HValueRef]) -- | Abandon evaluation of a statement after a breakpoint AbandonStmt - :: RemoteRef (ResumeContext [HValueRef]) + :: RemoteRef ThreadId -> Message () -- | Evaluate something of type @IO String@ @@ -245,7 +244,7 @@ data Message a where -- | Resume forcing a free variable in a breakpoint (#2950) ResumeSeq - :: RemoteRef (ResumeContext ()) + :: RemoteRef ThreadId -> Message (EvalStatus ()) -- | User-defined request encoded as a tag/payload pair. This is left @@ -400,12 +399,6 @@ data EvalOpts = EvalOpts instance Binary EvalOpts -data ResumeContext a = ResumeContext - { resumeBreakMVar :: MVar () - , resumeStatusMVar :: MVar (EvalStatus a) - , resumeThreadId :: ThreadId - } - -- | We can pass simple expressions to EvalStmt, consisting of values -- and application. This allows us to wrap the statement to be -- executed in another function, which is used by GHCi to implement @@ -425,7 +418,7 @@ data EvalStatus_ a b | EvalBreak HValueRef{- AP_STACK -} (Maybe EvalBreakpoint) - (RemoteRef (ResumeContext b)) + (RemoteRef ThreadId) (RemotePtr CostCentreStack) -- Cost centre stack deriving (Generic, Show) ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, UnboxedTuples, LambdaCase, UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# LANGUAGE BangPatterns #-} -- | -- Execute GHCi messages. @@ -30,6 +31,7 @@ import GHCi.TH import GHCi.BreakArray import GHCi.StaticPtrTable +import qualified Data.Map as Map import Control.Concurrent import Control.DeepSeq import Control.Exception @@ -194,20 +196,22 @@ evalStringToString r str = do -- information about the breakpoint than the current iserv -- process. doSeq :: RemoteRef a -> IO (EvalStatus ()) -doSeq ref = do +doSeq ref = clearEvalStatus <$> do sandboxIO evalOptsSeq $ do _ <- (void $ evaluate =<< localRef ref) - return () + return [] -- | Process a ResumeSeq message. Continue the :force processing #2950 -- after a breakpoint. -resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ()) -resumeSeq hvref = do - ResumeContext{..} <- localRef hvref - withBreakAction evalOptsSeq resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $ +resumeSeq :: RemoteRef ThreadId -> IO (EvalStatus ()) +resumeSeq hvref = clearEvalStatus <$> do + resumeThreadId <- localRef hvref + withBreakAction evalOptsSeq (Just resumeThreadId) $ do + ResumeContext{..} <- getThreadResumeContext resumeThreadId mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... - redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar + redirectInterrupts resumeThreadId $ do + takeMVar resumeStatusMVar evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts @@ -228,21 +232,21 @@ evalOptsSeq = EvalOpts -- only while we execute the user's code. We can't afford to lose the final -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946) -sandboxIO :: EvalOpts -> IO a -> IO (EvalStatus a) +sandboxIO :: EvalOpts -> IO [HValueRef] -> IO (EvalStatus [HValueRef]) sandboxIO opts io = do -- We are running in uninterruptibleMask - breakMVar <- newEmptyMVar - statusMVar <- newEmptyMVar - withBreakAction opts breakMVar statusMVar Nothing $ do + withBreakAction opts Nothing $ do let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io if useSandboxThread opts then do tid <- forkIO $ do tid <- myThreadId + ResumeContext{..} <- getThreadResumeContext tid labelThread tid "GHCi sandbox" - unsafeUnmask runIt >>= putMVar statusMVar + unsafeUnmask runIt >>= putMVar resumeStatusMVar -- empty: can't block - redirectInterrupts tid $ unsafeUnmask $ takeMVar statusMVar + ResumeContext{..} <- getThreadResumeContext tid + redirectInterrupts tid $ unsafeUnmask $ takeMVar resumeStatusMVar else -- GLUT on OS X needs to run on the main thread. If you -- try to use it from another thread then you just get a @@ -328,71 +332,47 @@ tryEval io = do -- resets everything when the computation has stopped running. This -- is a not-very-good way to ensure that only the interactive -- evaluation should generate breakpoints. -withBreakAction :: EvalOpts -> MVar () - -> MVar (EvalStatus b) +withBreakAction :: EvalOpts -> Maybe ThreadId -- ^ If resuming, the current threadId -> IO a -> IO a -withBreakAction opts breakMVar statusMVar mtid act +withBreakAction opts mtid act = bracket setBreakAction resetBreakAction (\_ -> act) where setBreakAction = do - stablePtr <- newStablePtr onBreak - poke breakPointIOAction stablePtr + poke breakPointIOAction globalBreakStablePtr -- TODO: This is thread unsafe, as one thread might be accessing this global variable while this thread tries to overwrite it. when (breakOnException opts) $ poke exceptionFlag 1 - when (singleStep opts) rts_enableStopNextBreakpointAll + when (singleStep opts) $ do + case mtid of + Nothing -> rts_enableStopNextBreakpointAll + Just (ThreadId tid) -> do + rts_enableStopNextBreakpoint tid when (stepOut opts) $ do case mtid of Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped Just (ThreadId tid) -> do rts_enableStopAfterReturn tid - return stablePtr + return () -- Breaking on exceptions is not enabled by default, since it -- might be a bit surprising. The exception flag is turned off -- as soon as it is hit, or in resetBreakAction below. - onBreak :: BreakpointCallback - onBreak info_mod# info_mod_uid# infox# is_exception apStack = do - tid <- myThreadId - let resume = ResumeContext - { resumeBreakMVar = breakMVar - , resumeStatusMVar = statusMVar - , resumeThreadId = tid } - resume_r <- mkRemoteRef resume - apStack_r <- mkRemoteRef apStack - ccs <- toRemotePtr <$> getCCSOf apStack - breakpoint <- - if is_exception - then pure Nothing - else do - info_mod <- BS.packCString (Ptr info_mod#) - info_mod_uid <- BS.packCString (Ptr info_mod_uid#) - pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) - putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs - - -- Block until this thread is resumed (by the thread which took the - -- `ResumeContext` from the `statusMVar`). - -- - -- The `onBreak` function must have been called from `rts/Interpreter.c` - -- when interpreting a `BRK_FUN`. After taking from the MVar, the function - -- returns to the continuation on the stack which is where the interpreter - -- was stopped. - takeMVar breakMVar - - resetBreakAction stablePtr = do - poke breakPointIOAction noBreakStablePtr + resetBreakAction {-stablePtr-}() = do + -- poke breakPointIOAction noBreakStablePtr -- Never unset it. + -- TODO: What about evaluating a thunk with breakpoints? when did we get "ignoring breakpoint..." before? poke exceptionFlag 0 rts_disableStopNextBreakpointAll case mtid of Just (ThreadId tid) -> rts_disableStopAfterReturn tid _ -> pure () - freeStablePtr stablePtr + -- freeStablePtr stablePtr resumeStmt - :: EvalOpts -> RemoteRef (ResumeContext [HValueRef]) + :: EvalOpts -> RemoteRef ThreadId -> IO (EvalStatus [HValueRef]) -resumeStmt opts hvref = do - ResumeContext{..} <- localRef hvref - withBreakAction opts resumeBreakMVar resumeStatusMVar (Just resumeThreadId) $ +resumeStmt opts rtid = do + resumeThreadId <- localRef rtid + ResumeContext{..} <- getThreadResumeContext resumeThreadId + withBreakAction opts (Just resumeThreadId) $ mask_ $ do putMVar resumeBreakMVar () -- this awakens the stopped thread... redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar @@ -409,20 +389,42 @@ resumeStmt opts hvref = do -- step is necessary to prevent race conditions with -- -fbreak-on-exception (see #5975). -- See test break010. -abandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO () +abandonStmt :: RemoteRef ThreadId -> IO () abandonStmt hvref = do - ResumeContext{..} <- localRef hvref - killThread resumeThreadId + tid <- localRef hvref + ResumeContext{..} <- getThreadResumeContext tid + killThread tid putMVar resumeBreakMVar () _ <- takeMVar resumeStatusMVar return () -noBreakStablePtr :: StablePtr BreakpointCallback -noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction - -noBreakAction :: BreakpointCallback -noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint" -noBreakAction _ _ _ True _ = return () -- exception: just continue +globalBreakStablePtr :: StablePtr BreakpointCallback +globalBreakStablePtr = unsafePerformIO $ newStablePtr globalBreakAction + +globalBreakAction :: BreakpointCallback +globalBreakAction info_mod# info_mod_uid# infox# is_exception apStack = do + tid <- myThreadId + ResumeContext{..} <- getThreadResumeContext tid + resume_r <- mkRemoteRef tid + apStack_r <- mkRemoteRef apStack + ccs <- toRemotePtr <$> getCCSOf apStack + breakpoint <- + if is_exception + then pure Nothing + else do + info_mod <- BS.packCString (Ptr info_mod#) + info_mod_uid <- BS.packCString (Ptr info_mod_uid#) + pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#))) + putMVar resumeStatusMVar $ EvalBreak apStack_r breakpoint resume_r ccs + + -- Block until this thread is resumed (by the thread which took the + -- `ResumeContext` from the `statusMVar`). + -- + -- The `onBreak` function must have been called from `rts/Interpreter.c` + -- when interpreting a `BRK_FUN`. After taking from the MVar, the function + -- returns to the continuation on the stack which is where the interpreter + -- was stopped. + takeMVar resumeBreakMVar -- Malloc and copy the bytes. We don't have any way to monitor the -- lifetime of this memory, so it just leaks. @@ -463,3 +465,32 @@ getIdValFromApStack apStack (I# stackDepth) = do case ok of 0# -> return Nothing -- AP_STACK not found _ -> return (Just (unsafeCoerce# result)) + +clearEvalStatus :: EvalStatus a -> EvalStatus () +clearEvalStatus = \case + EvalComplete w (EvalException se) -> EvalComplete w (EvalException se) + EvalComplete w (EvalSuccess _) -> EvalComplete w (EvalSuccess ()) + EvalBreak ap mb rt rccs -> EvalBreak ap mb rt rccs + +-------------------------------------------------------------------------------- +-- Global Debugger Per-Thread Context +-- TODO: when to clean? + +getThreadResumeContext :: ThreadId -> IO (ResumeContext [HValueRef]) +getThreadResumeContext tid = modifyMVar globalBreakActionMap $ \gbm0 -> do + case Map.lookup tid gbm0 of + Nothing -> do + r <- ResumeContext <$> newEmptyMVar <*> newEmptyMVar + let !gbm1 = Map.insert tid r gbm0 + pure (gbm1, r) + Just ctx -> do + pure (gbm0, ctx) + +globalBreakActionMap :: MVar (Map.Map ThreadId (ResumeContext [HValueRef])) +globalBreakActionMap = unsafePerformIO $ newMVar Map.empty +{-# NOINLINE globalBreakActionMap #-} + +data ResumeContext a = ResumeContext + { resumeBreakMVar :: MVar () + , resumeStatusMVar :: MVar (EvalStatus a) + } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21fe18666c1fa8494695331b1bce656… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21fe18666c1fa8494695331b1bce656… 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/romes/multi-threaded-debugger
by Rodrigo Mesquita (＠alt-romes) 01 Sep '26

01 Sep '26

Rodrigo Mesquita pushed new branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/multi-threaded-debugger 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