Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Cmm/Parser.y
    ... ... @@ -1321,6 +1321,7 @@ stmtMacros = listToUFM [
    1321 1321 
       ( fsLit "PROF_HEADER_CREATE",     \[e] -> profHeaderCreate e ),
    1322 1322
    1323 1323 
       ( fsLit "PUSH_UPD_FRAME",        \[sp,e] -> emitPushUpdateFrame sp e ),
    1324 
    +  ( fsLit "PUSH_BH_UPD_FRAME",     \[sp,e] -> emitPushBHUpdateFrame sp e ),
    1324 1325 
       ( fsLit "SET_HDR",               \[ptr,info,ccs] ->
    1325 1326 
                                             emitSetDynHdr ptr info ccs ),
    1326 1327 
       ( fsLit "TICK_ALLOC_PRIM",       \[hdr,goods,slop] ->
    ... ... @@ -1336,6 +1337,10 @@ emitPushUpdateFrame :: CmmExpr -> CmmExpr -> FCode ()
    1336 1337 
     emitPushUpdateFrame sp e = do
    1337 1338 
       emitUpdateFrame sp mkUpdInfoLabel e
    1338 1339
    1340 
    +emitPushBHUpdateFrame :: CmmExpr -> CmmExpr -> FCode ()
    1341 
    +emitPushBHUpdateFrame sp e = do
    1342 
    +  emitUpdateFrame sp mkBHUpdInfoLabel e
    1343 
    +
    1339 1344 
     pushStackFrame :: [CmmParse CmmExpr] -> CmmParse () -> CmmParse ()
    1340 1345 
     pushStackFrame fields body = do
    1341 1346 
       profile <- getProfile

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -102,7 +102,6 @@ module GHC.Driver.Main
    102 102 
         , dumpIfaceStats
    103 103 
         , ioMsgMaybe
    104 104 
         , showModuleIndex
    105 
    -    , hscAddSptEntries
    106 105 
         , writeInterfaceOnlyMode
    107 106 
         , loadByteCode
    108 107 
         , genModDetails
    ... ... @@ -2515,9 +2514,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
    2515 2514 
         let src_span = srcLocSpan interactiveSrcLoc
    2516 2515 
         _ <- liftIO $ loadDecls interp hsc_env src_span linkable
    2517 2516
    2518 
    -    {- Load static pointer table entries -}
    2519 
    -    liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg)
    2520 
    -
    2521 2517 
         let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)
    2522 2518 
             patsyns = mg_patsyns simpl_mg
    2523 2519
    ... ... @@ -2539,18 +2535,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
    2539 2535 
                                                     fam_insts defaults fix_env
    2540 2536 
         return (new_tythings, new_ictxt)
    2541 2537
    2542 
    --- | Load the given static-pointer table entries into the interpreter.
    2543 
    --- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".
    2544 
    -hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
    2545 
    -hscAddSptEntries hsc_env entries = do
    2546 
    -    let interp = hscInterp hsc_env
    2547 
    -    let add_spt_entry :: SptEntry -> IO ()
    2548 
    -        add_spt_entry (SptEntry n fpr) = do
    2549 
    -            -- These are only names from the current module
    2550 
    -            (val, _, _) <- loadName interp hsc_env n
    2551 
    -            addSptEntry interp fpr val
    2552 
    -    mapM_ add_spt_entry entries
    2553 
    -
    2554 2538 
     {-
    2555 2539 
       Note [Fixity declarations in GHCi]
    2556 2540 
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Driver/Make.hs
    ... ... @@ -56,8 +56,6 @@ import GHC.Tc.Utils.Monad ( initIfaceCheck, concatMapM )
    56 56
    57 57 
     import GHC.Runtime.Interpreter
    58 58 
     import qualified GHC.Linker.Loader as Linker
    59 
    -import GHC.Linker.Types
    60 
    -
    61 59
    62 60 
     import GHC.Driver.Config.Diagnostic
    63 61 
     import GHC.Driver.Pipeline
    ... ... @@ -72,8 +70,6 @@ import GHC.Driver.MakeSem
    72 70 
     import GHC.Driver.Downsweep
    73 71 
     import GHC.Driver.MakeAction
    74 72
    75 
    -import GHC.ByteCode.Types
    76 
    -
    77 73 
     import GHC.Iface.Load      ( cannotFindModule, readIface )
    78 74 
     import GHC.IfaceToCore     ( typecheckIface )
    79 75 
     import GHC.Iface.Recomp    ( RecompileRequired(..), CompileReason(..) )
    ... ... @@ -1232,31 +1228,9 @@ upsweep_mod :: HscEnv
    1232 1228 
     upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods =  do
    1233 1229 
       hmi <- compileOne' mHscMessage hsc_env summary
    1234 1230 
               mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi)
    1235 
    -
    1236 
    -  -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module
    1237 
    -  -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I
    1238 
    -  -- am unsure if this is sound (wrt running TH splices for example).
    1239 
    -  -- This function only does anything if the linkable produced is a BCO, which
    1240 
    -  -- used to only happen with the bytecode backend, but with
    1241 
    -  -- @-fprefer-byte-code@, @HomeModInfo@ has bytecode even when generating
    1242 
    -  -- object code, see #25230.
    1243 1231 
       hscInsertHPT hmi hsc_env
    1244 
    -  addSptEntries (hsc_env)
    1245 
    -                (homeModInfoByteCode hmi)
    1246 
    -
    1247 1232 
       return hmi
    1248 1233
    1249 
    --- | Add the entries from a BCO linkable to the SPT table, see
    1250 
    --- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
    1251 
    -addSptEntries :: HscEnv -> Maybe Linkable -> IO ()
    1252 
    -addSptEntries hsc_env mlinkable =
    1253 
    -  hscAddSptEntries hsc_env
    1254 
    -     [ spt
    1255 
    -     | linkable <- maybeToList mlinkable
    1256 
    -     , bco <- linkableBCOs linkable
    1257 
    -     , spt <- bc_spt_entries bco
    1258 
    -     ]
    1259 
    -
    1260 1234
    1261 1235 
     -- Note [When source is considered modified]
    1262 1236 
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Iface/Tidy/StaticPtrTable.hs
    ... ... @@ -124,7 +124,7 @@ Here is a running example:
    124 124 
     * If we are compiling for the byte-code interpreter, we instead explicitly add
    125 125 
       the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter
    126 126 
       process' SPT table using the addSptEntry interpreter message. This happens
    127 
    -  in upsweep after we have compiled the module (see GHC.Driver.Make.upsweep').
    127 
    +  when the bytecode object is linked in `dynLinkBCOs`.
    128 128 
     -}
    129 129
    130 130 
     import GHC.Prelude

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -718,6 +718,7 @@ loadDecls interp hsc_env span linkable = do
    718 718 
               let ce2  = extendClosureEnv (closure_env le2) nms_fhvs
    719 719 
                   !pls2 = pls { linker_env = le2 { closure_env = ce2 }
    720 720 
                               , linked_breaks = lb2 }
    721 
    +          mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
    721 722 
               return (pls2, (nms_fhvs, links_needed, units_needed))
    722 723 
       where
    723 724 
         cbcs = linkableBCOs linkable
    ... ... @@ -951,10 +952,28 @@ dynLinkBCOs interp pls bcos = do
    951 952 
             -- Wrap finalizers on the ones we want to keep
    952 953 
             new_binds <- makeForeignNamedHValueRefs interp to_add
    953 954
    955 
    +
    954 956 
             let ce2 = extendClosureEnv (closure_env le2) new_binds
    957 
    +
    958 
    +        -- Add SPT entries
    959 
    +        mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs)
    960 
    +
    955 961 
             return $! pls1 { linker_env = le2 { closure_env = ce2 }
    956 962 
                            , linked_breaks = lb2 }
    957 963
    964 
    +-- | Register SPT entries for this module in the interpreter
    965 
    +-- Assumes that the name from the SPT has already been loaded into the interpreter.
    966 
    +linkSptEntry :: Interp -> ClosureEnv -> SptEntry -> IO ()
    967 
    +linkSptEntry interp ce (SptEntry name fpr) = do
    968 
    +  case lookupNameEnv ce name of
    969 
    +    -- The SPT entries only point to locally defined names, which should have already been
    970 
    +    -- loaded into the interpreter before this function is called.
    971 
    +    Nothing -> pprPanic "linkSptEntry" (ppr name)
    972 
    +    Just (_, hval) -> addSptEntry interp fpr hval
    973 
    +
    974 
    +
    975 
    +
    976 
    +
    958 977 
     -- Link a bunch of BCOs and return references to their values
    959 978 
     linkSomeBCOs :: Interp
    960 979 
                  -> PkgsLoaded

  • rts/Apply.cmm
    ... ... @@ -699,7 +699,7 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
    699 699
    700 700 
       /* ensure there is at least AP_STACK_SPLIM words of headroom available
    701 701 
        * after unpacking the AP_STACK. See bug #1466 */
    702 
    -  PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
    702 
    +  PUSH_BH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
    703 703 
       Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
    704 704
    705 705 
       TICK_ENT_AP();

  • rts/Interpreter.c
    ... ... @@ -2599,11 +2599,11 @@ run_BCO:
    2599 2599 
     #define SIZED_BIN_OP_TY_INT(op,ty)                                      \
    2600 2600 
     {                                                                       \
    2601 2601 
         if(sizeof(ty) > sizeof(StgWord)) {                                  \
    2602 
    -        ty r = ((ty) ReadSpW64(0)) op ((ty) ReadSpW(2));                \
    2602 
    +        ty r = ((ty) ReadSpW64(0)) op ((StgInt) ReadSpW(2));                \
    2603 2603 
             Sp_addW(1);                                                     \
    2604 2604 
             SpW64(0) = (StgWord64) r;                                       \
    2605 2605 
         } else {                                                            \
    2606 
    -        ty r = ((ty) ReadSpW(0)) op ((ty) ReadSpW(1));                  \
    2606 
    +        ty r = ((ty) ReadSpW(0)) op ((StgInt) ReadSpW(1));                  \
    2607 2607 
             Sp_addW(1);                                                     \
    2608 2608 
             SpW(0) = (StgWord) r;                                           \
    2609 2609 
         };                                                                  \

  • rts/ThreadPaused.c
    ... ... @@ -15,6 +15,7 @@
    15 15 
     #include "RaiseAsync.h"
    16 16 
     #include "Trace.h"
    17 17 
     #include "Threads.h"
    18 
    +#include "Messages.h"
    18 19 
     #include "sm/NonMovingMark.h"
    19 20
    20 21 
     #include <string.h> // for memmove()
    ... ... @@ -314,52 +315,66 @@ threadPaused(Capability *cap, StgTSO *tso)
    314 315 
                     continue;
    315 316 
                 }
    316 317
    317 
    -            // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a
    318 
    -            // BLACKHOLE here.
    318 
    +            // If we have a frame that is already eagerly blackholed, we
    319 
    +            // shouldn't overwrite its payload: There may already be a blocking
    320 
    +            // queue (see #26324).
    321 
    +            if(frame_info == &stg_bh_upd_frame_info) {
    322 
    +                // eager black hole: we do nothing
    323 
    +
    324 
    +                // it should be a black hole that we own
    325 
    +                ASSERT(bh_info == &stg_BLACKHOLE_info ||
    326 
    +                       bh_info == &__stg_EAGER_BLACKHOLE_info ||
    327 
    +                       bh_info == &stg_CAF_BLACKHOLE_info);
    328 
    +                ASSERT(blackHoleOwner(bh) == tso || blackHoleOwner(bh) == NULL);
    329 
    +            } else {
    330 
    +                // lazy black hole
    331 
    +
    319 332 
     #if defined(THREADED_RTS)
    320 
    -            // first we turn it into a WHITEHOLE to claim it, and if
    321 
    -            // successful we write our TSO and then the BLACKHOLE info pointer.
    322 
    -            cur_bh_info = (const StgInfoTable *)
    323 
    -                cas((StgVolatilePtr)&bh->header.info,
    324 
    -                    (StgWord)bh_info,
    325 
    -                    (StgWord)&stg_WHITEHOLE_info);
    326 
    -
    327 
    -            if (cur_bh_info != bh_info) {
    328 
    -                bh_info = cur_bh_info;
    333 
    +                // first we turn it into a WHITEHOLE to claim it, and if
    334 
    +                // successful we write our TSO and then the BLACKHOLE info pointer.
    335 
    +                cur_bh_info = (const StgInfoTable *)
    336 
    +                    cas((StgVolatilePtr)&bh->header.info,
    337 
    +                        (StgWord)bh_info,
    338 
    +                        (StgWord)&stg_WHITEHOLE_info);
    339 
    +
    340 
    +                if (cur_bh_info != bh_info) {
    341 
    +                    bh_info = cur_bh_info;
    329 342 
     #if defined(PROF_SPIN)
    330 
    -                NONATOMIC_ADD(&whitehole_threadPaused_spin, 1);
    343 
    +                    NONATOMIC_ADD(&whitehole_threadPaused_spin, 1);
    331 344 
     #endif
    332 
    -                busy_wait_nop();
    333 
    -                goto retry;
    334 
    -            }
    345 
    +                    busy_wait_nop();
    346 
    +                    goto retry;
    347 
    +                }
    335 348 
     #endif
    336 
    -
    337 
    -            IF_NONMOVING_WRITE_BARRIER_ENABLED {
    338 
    -                if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) {
    339 
    -                    // We are about to replace a thunk with a blackhole.
    340 
    -                    // Add the free variables of the closure we are about to
    341 
    -                    // overwrite to the update remembered set.
    342 
    -                    // N.B. We caught the WHITEHOLE case above.
    343 
    -                    updateRemembSetPushThunkEager(cap,
    344 
    -                                                  THUNK_INFO_PTR_TO_STRUCT(bh_info),
    345 
    -                                                  (StgThunk *) bh);
    349 
    +                ASSERT(bh_info != &stg_WHITEHOLE_info);
    350 
    +
    351 
    +                IF_NONMOVING_WRITE_BARRIER_ENABLED {
    352 
    +                    if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) {
    353 
    +                        // We are about to replace a thunk with a blackhole.
    354 
    +                        // Add the free variables of the closure we are about to
    355 
    +                        // overwrite to the update remembered set.
    356 
    +                        // N.B. We caught the WHITEHOLE case above.
    357 
    +                        updateRemembSetPushThunkEager(cap,
    358 
    +                                                    THUNK_INFO_PTR_TO_STRUCT(bh_info),
    359 
    +                                                    (StgThunk *) bh);
    360 
    +                    }
    346 361 
                     }
    347 
    -            }
    348 362
    349 
    -            // zero out the slop so that the sanity checker can tell
    350 
    -            // where the next closure is. N.B. We mustn't do this until we have
    351 
    -            // pushed the free variables to the update remembered set above.
    352 
    -            OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info)));
    363 
    +                // zero out the slop so that the sanity checker can tell
    364 
    +                // where the next closure is. N.B. We mustn't do this until we have
    365 
    +                // pushed the free variables to the update remembered set above.
    366 
    +                OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info)));
    353 367
    354 
    -            // The payload of the BLACKHOLE points to the TSO
    355 
    -            RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso);
    356 
    -            SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info);
    368 
    +                // The payload of the BLACKHOLE points to the TSO
    369 
    +                RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso);
    370 
    +                SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info);
    357 371
    358 
    -            // .. and we need a write barrier, since we just mutated the closure:
    359 
    -            recordClosureMutated(cap,bh);
    372 
    +                // .. and we need a write barrier, since we just mutated the closure:
    373 
    +                recordClosureMutated(cap,bh);
    360 374
    361 
    -            // We pretend that bh has just been created.
    362 
    -            LDV_RECORD_CREATE(bh);
    375 
    +                // We pretend that bh has just been created.
    376 
    +                LDV_RECORD_CREATE(bh);
    377 
    +            }
    363 378
    364 379 
                 frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
    365 380 
                 if (prev_was_update_frame) {

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help