Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9c304ec0 by Sean D. Gillespie at 2025-09-29T19:57:07-04:00 Fix SIZED_BIN_OP_TY_INT casts in RTS interpreter Correct `SIZED_BIN_OP_TY_INT` cast to integer. Previously, it cast its second operand as its parameter `ty`. This does not currently cause any issues, since we are only using it for bit shifts. Fixes #26287 - - - - - d9124883 by Luite Stegeman at 2025-09-30T07:11:54-04:00 rts: Fix lost wakeups in threadPaused for threads blocked on black holes The lazy blackholing code in threadPaused could overwrite closures that were already eagerly blackholed, and as such wouldn't have a marked update frame. If the black hole was overwritten by its original owner, this would lead to an undetected collision, and the contents of any existing blocking queue being lost. This adds a check for eagerly blackholed closures and avoids overwriting their contents. Fixes #26324 - - - - - baa21c3d by Luite Stegeman at 2025-09-30T07:11:54-04:00 rts: push the correct update frame in stg_AP_STACK The frame contains an eager black hole (__stg_EAGER_BLACKHOLE_info) so we should push an stg_bh_upd_frame_info instead of an stg_upd_frame_info. - - - - - 81b7bea2 by Matthew Pickering at 2025-09-30T07:11:55-04:00 driver: Load bytecode static pointer entries during linking Previously the entries were loaded too eagerly, during upsweep, but we should delay loading them until we know that the relevant bytecode object is demanded. Towards #25230 - - - - - 8 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Linker/Loader.hs - rts/Apply.cmm - rts/Interpreter.c - rts/ThreadPaused.c Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1321,6 +1321,7 @@ stmtMacros = listToUFM [ ( fsLit "PROF_HEADER_CREATE", \[e] -> profHeaderCreate e ), ( fsLit "PUSH_UPD_FRAME", \[sp,e] -> emitPushUpdateFrame sp e ), + ( fsLit "PUSH_BH_UPD_FRAME", \[sp,e] -> emitPushBHUpdateFrame sp e ), ( fsLit "SET_HDR", \[ptr,info,ccs] -> emitSetDynHdr ptr info ccs ), ( fsLit "TICK_ALLOC_PRIM", \[hdr,goods,slop] -> @@ -1336,6 +1337,10 @@ emitPushUpdateFrame :: CmmExpr -> CmmExpr -> FCode () emitPushUpdateFrame sp e = do emitUpdateFrame sp mkUpdInfoLabel e +emitPushBHUpdateFrame :: CmmExpr -> CmmExpr -> FCode () +emitPushBHUpdateFrame sp e = do + emitUpdateFrame sp mkBHUpdInfoLabel e + pushStackFrame :: [CmmParse CmmExpr] -> CmmParse () -> CmmParse () pushStackFrame fields body = do profile <- getProfile ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Main , dumpIfaceStats , ioMsgMaybe , showModuleIndex - , hscAddSptEntries , writeInterfaceOnlyMode , loadByteCode , genModDetails @@ -2515,9 +2514,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do let src_span = srcLocSpan interactiveSrcLoc _ <- liftIO $ loadDecls interp hsc_env src_span linkable - {- Load static pointer table entries -} - liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg) - let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg) patsyns = mg_patsyns simpl_mg @@ -2539,18 +2535,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do fam_insts defaults fix_env return (new_tythings, new_ictxt) --- | Load the given static-pointer table entries into the interpreter. --- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable". -hscAddSptEntries :: HscEnv -> [SptEntry] -> IO () -hscAddSptEntries hsc_env entries = do - let interp = hscInterp hsc_env - let add_spt_entry :: SptEntry -> IO () - add_spt_entry (SptEntry n fpr) = do - -- These are only names from the current module - (val, _, _) <- loadName interp hsc_env n - addSptEntry interp fpr val - mapM_ add_spt_entry entries - {- Note [Fixity declarations in GHCi] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -56,8 +56,6 @@ import GHC.Tc.Utils.Monad ( initIfaceCheck, concatMapM ) import GHC.Runtime.Interpreter import qualified GHC.Linker.Loader as Linker -import GHC.Linker.Types - import GHC.Driver.Config.Diagnostic import GHC.Driver.Pipeline @@ -72,8 +70,6 @@ import GHC.Driver.MakeSem import GHC.Driver.Downsweep import GHC.Driver.MakeAction -import GHC.ByteCode.Types - import GHC.Iface.Load ( cannotFindModule, readIface ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) @@ -1232,31 +1228,9 @@ upsweep_mod :: HscEnv upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods = do hmi <- compileOne' mHscMessage hsc_env summary mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi) - - -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module - -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I - -- am unsure if this is sound (wrt running TH splices for example). - -- This function only does anything if the linkable produced is a BCO, which - -- used to only happen with the bytecode backend, but with - -- @-fprefer-byte-code@, @HomeModInfo@ has bytecode even when generating - -- object code, see #25230. hscInsertHPT hmi hsc_env - addSptEntries (hsc_env) - (homeModInfoByteCode hmi) - return hmi --- | Add the entries from a BCO linkable to the SPT table, see --- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. -addSptEntries :: HscEnv -> Maybe Linkable -> IO () -addSptEntries hsc_env mlinkable = - hscAddSptEntries hsc_env - [ spt - | linkable <- maybeToList mlinkable - , bco <- linkableBCOs linkable - , spt <- bc_spt_entries bco - ] - -- Note [When source is considered modified] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -124,7 +124,7 @@ Here is a running example: * If we are compiling for the byte-code interpreter, we instead explicitly add the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter process' SPT table using the addSptEntry interpreter message. This happens - in upsweep after we have compiled the module (see GHC.Driver.Make.upsweep'). + when the bytecode object is linked in `dynLinkBCOs`. -} import GHC.Prelude ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -718,6 +718,7 @@ loadDecls interp hsc_env span linkable = do let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } , linked_breaks = lb2 } + mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs) return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -951,10 +952,28 @@ dynLinkBCOs interp pls bcos = do -- Wrap finalizers on the ones we want to keep new_binds <- makeForeignNamedHValueRefs interp to_add + let ce2 = extendClosureEnv (closure_env le2) new_binds + + -- Add SPT entries + mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs) + return $! pls1 { linker_env = le2 { closure_env = ce2 } , linked_breaks = lb2 } +-- | Register SPT entries for this module in the interpreter +-- Assumes that the name from the SPT has already been loaded into the interpreter. +linkSptEntry :: Interp -> ClosureEnv -> SptEntry -> IO () +linkSptEntry interp ce (SptEntry name fpr) = do + case lookupNameEnv ce name of + -- The SPT entries only point to locally defined names, which should have already been + -- loaded into the interpreter before this function is called. + Nothing -> pprPanic "linkSptEntry" (ppr name) + Just (_, hval) -> addSptEntry interp fpr hval + + + + -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp -> PkgsLoaded ===================================== rts/Apply.cmm ===================================== @@ -699,7 +699,7 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK") /* ensure there is at least AP_STACK_SPLIM words of headroom available * after unpacking the AP_STACK. See bug #1466 */ - PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); + PUSH_BH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words); TICK_ENT_AP(); ===================================== rts/Interpreter.c ===================================== @@ -2599,11 +2599,11 @@ run_BCO: #define SIZED_BIN_OP_TY_INT(op,ty) \ { \ if(sizeof(ty) > sizeof(StgWord)) { \ - ty r = ((ty) ReadSpW64(0)) op ((ty) ReadSpW(2)); \ + ty r = ((ty) ReadSpW64(0)) op ((StgInt) ReadSpW(2)); \ Sp_addW(1); \ SpW64(0) = (StgWord64) r; \ } else { \ - ty r = ((ty) ReadSpW(0)) op ((ty) ReadSpW(1)); \ + ty r = ((ty) ReadSpW(0)) op ((StgInt) ReadSpW(1)); \ Sp_addW(1); \ SpW(0) = (StgWord) r; \ }; \ ===================================== rts/ThreadPaused.c ===================================== @@ -15,6 +15,7 @@ #include "RaiseAsync.h" #include "Trace.h" #include "Threads.h" +#include "Messages.h" #include "sm/NonMovingMark.h" #include <string.h> // for memmove() @@ -314,52 +315,66 @@ threadPaused(Capability *cap, StgTSO *tso) continue; } - // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a - // BLACKHOLE here. + // If we have a frame that is already eagerly blackholed, we + // shouldn't overwrite its payload: There may already be a blocking + // queue (see #26324). + if(frame_info == &stg_bh_upd_frame_info) { + // eager black hole: we do nothing + + // it should be a black hole that we own + ASSERT(bh_info == &stg_BLACKHOLE_info || + bh_info == &__stg_EAGER_BLACKHOLE_info || + bh_info == &stg_CAF_BLACKHOLE_info); + ASSERT(blackHoleOwner(bh) == tso || blackHoleOwner(bh) == NULL); + } else { + // lazy black hole + #if defined(THREADED_RTS) - // first we turn it into a WHITEHOLE to claim it, and if - // successful we write our TSO and then the BLACKHOLE info pointer. - cur_bh_info = (const StgInfoTable *) - cas((StgVolatilePtr)&bh->header.info, - (StgWord)bh_info, - (StgWord)&stg_WHITEHOLE_info); - - if (cur_bh_info != bh_info) { - bh_info = cur_bh_info; + // first we turn it into a WHITEHOLE to claim it, and if + // successful we write our TSO and then the BLACKHOLE info pointer. + cur_bh_info = (const StgInfoTable *) + cas((StgVolatilePtr)&bh->header.info, + (StgWord)bh_info, + (StgWord)&stg_WHITEHOLE_info); + + if (cur_bh_info != bh_info) { + bh_info = cur_bh_info; #if defined(PROF_SPIN) - NONATOMIC_ADD(&whitehole_threadPaused_spin, 1); + NONATOMIC_ADD(&whitehole_threadPaused_spin, 1); #endif - busy_wait_nop(); - goto retry; - } + busy_wait_nop(); + goto retry; + } #endif - - IF_NONMOVING_WRITE_BARRIER_ENABLED { - if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) { - // We are about to replace a thunk with a blackhole. - // Add the free variables of the closure we are about to - // overwrite to the update remembered set. - // N.B. We caught the WHITEHOLE case above. - updateRemembSetPushThunkEager(cap, - THUNK_INFO_PTR_TO_STRUCT(bh_info), - (StgThunk *) bh); + ASSERT(bh_info != &stg_WHITEHOLE_info); + + IF_NONMOVING_WRITE_BARRIER_ENABLED { + if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) { + // We are about to replace a thunk with a blackhole. + // Add the free variables of the closure we are about to + // overwrite to the update remembered set. + // N.B. We caught the WHITEHOLE case above. + updateRemembSetPushThunkEager(cap, + THUNK_INFO_PTR_TO_STRUCT(bh_info), + (StgThunk *) bh); + } } - } - // zero out the slop so that the sanity checker can tell - // where the next closure is. N.B. We mustn't do this until we have - // pushed the free variables to the update remembered set above. - OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info))); + // zero out the slop so that the sanity checker can tell + // where the next closure is. N.B. We mustn't do this until we have + // pushed the free variables to the update remembered set above. + OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info))); - // The payload of the BLACKHOLE points to the TSO - RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso); - SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info); + // The payload of the BLACKHOLE points to the TSO + RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso); + SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info); - // .. and we need a write barrier, since we just mutated the closure: - recordClosureMutated(cap,bh); + // .. and we need a write barrier, since we just mutated the closure: + recordClosureMutated(cap,bh); - // We pretend that bh has just been created. - LDV_RECORD_CREATE(bh); + // We pretend that bh has just been created. + LDV_RECORD_CREATE(bh); + } frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); if (prev_was_update_frame) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf800f34731795aa247ea2553bd1b3... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf800f34731795aa247ea2553bd1b3... You're receiving this email because of your account on gitlab.haskell.org.