Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: cb1974a8 by Rodrigo Mesquita at 2025-12-19T22:28:03+00:00 Decked out in tracs - - - - - 0be5515a by Rodrigo Mesquita at 2025-12-19T22:31:57+00:00 Kill traces - - - - - 5 changed files: - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/StgToByteCode.hs - libraries/ghci/GHCi/CreateBCO.hs Changes: ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -298,8 +298,9 @@ data BCInstr instance Outputable ProtoBCO where ppr (ProtoStaticCon nm con args origin) - = text "ProtoStaticCon" <+> ppr nm <+> text "for constructor" <+> ppr con <> colon + = text "ProtoStaticCon" <+> ppr nm <> colon $$ nest 3 (pprStgRhsShort shortStgPprOpts origin) + $$ nest 3 (text "constructor: " <+> ppr con) $$ nest 3 (text "sorted args: " <+> ppr args) ppr (ProtoBCO { protoBCOName = name , protoBCOInstrs = instrs ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -79,14 +79,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do UnlinkedStaticCon { unlinkedStaticConLits = lits0 , unlinkedStaticConPtrs = ptrs0 + , unlinkedStaticConDataConName } -> do - pprTraceM "linkBCO: linking static constructor" (ppr unl_bco) - Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state (unlinkedStaticConDataConName unl_bco) - pprTraceM "linkBCO: itbl_ptr#" (ppr (unlinkedStaticConDataConName unl_bco) <+> text (show (Ptr itbl_ptr#))) + Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state unlinkedStaticConDataConName lits <- doLits lits0 - pprTraceM "linkBCO: lits done" (empty) ptrs <- doPtrs ptrs0 - pprTraceM "linkBCO: ptrs done" (empty) return ResolvedStaticCon { resolvedBCOIsLE = isLittleEndian , resolvedStaticConInfoPtr = W# (int2Word# (addr2Int# itbl_ptr#)) @@ -99,11 +96,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do (lits :: [Word]) <- mapM (lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ mkBCOByteArray lits' - doPtrs ptrs0 = addListToSS emptySS <$> + doPtrs ptrs0 = addListToSS emptySS <$> do mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded bytecode_state ptr = pprTrace "lookupLiteral" (ppr ptr) $ case ptr of +lookupLiteral interp pkgs_loaded bytecode_state ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -187,24 +184,20 @@ resolvePtr -> NameEnv (Int, Bool) -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = pprTrace "resolvePtr" (ppr ptr) $ case ptr of +resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = case ptr of BCOPtrName nm | Just (ix, b) <- lookupNameEnv bco_ix nm - -> if b then do - pprTraceM "resolvePtr: ResolvedBCORef" (ppr nm <+> ppr ix) + -> if b then return (ResolvedBCORef ix) -- ref to another BCO in this group - else do - pprTraceM "resolvePtr: StaticConRef" (ppr nm <+> ppr ix) + else return (ResolvedStaticConRef ix) -- ref to another StaticCon in this group | Just (_, rhv) <- lookupNameBytecodeState bco_loader_state nm - -> do - pprTraceM "resolvePtr: BCOPtr" (ppr nm) - return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) + -> return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv)) | otherwise -> assertPpr (isExternalName nm) (ppr nm) $ - pprTrace "resolvePtr: OTHERWISE? ASSERTION FIALURE?" (ppr nm) $ do + do let sym_to_find = IClosureSymbol nm m <- lookupHsSymbol interp pkgs_loaded sym_to_find case m of ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1048,13 +1048,6 @@ linkSomeBCOs interp pkgs_loaded bytecode_state mods = foldr fun do_link mods [] UnlinkedStaticCon{unlinkedStaticConName} -> (unlinkedStaticConName, False) ) flat bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..]) - pprTraceM "linkSomeBCOs what" $ (ppr mods <+> ppr flat) - pprTraceM "linkSomeBCOs" $ - vcat [ text "Linking BCOs:" - , nest 2 (vcat (map (ppr . fst) names)) - , text "BCO index:" - , nest 2 (ppr bco_ix) - ] resolved <- sequence [ linkBCO interp pkgs_loaded bytecode_state bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -307,7 +307,6 @@ argBits platform (rep : args) schemeTopBind :: (Id, CgStgRhs) -> BcM ProtoBCO schemeTopBind (id, rhs@(StgRhsCon _ dc _ _ args _)) = do - pprTraceM "schemeTopBind: static con" (ppr id <+> ppr dc <+> ppr args) profile <- getProfile let non_voids = addArgReps (assertNonVoidStgArgs args) (_, _, args_offsets) ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -116,7 +116,7 @@ linkBCO' arr resolved_obj = IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newConAppObj# itbl_ptr# literals_barr arr data_size# s of - (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #) + (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #) } where !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -133,8 +133,9 @@ mkPtrsArray arr n_ptrs ptrs = do -- this MUST be /strict/! -- the static con reference must be an evaluated pointer to the data con -- info table, but (arr ! n) would construct a thunk instead if unforced. - let !hv = arr ! n - writePtrsArrayHValue i hv marr + let HValue !hv = arr ! n + -- let !hv = arr ! n -- this loops, but the above doesn't? something I didn't understand. + writePtrsArrayHValue i (HValue hv) marr fill (ResolvedBCOPtr r) i = do hv <- localRef r writePtrsArrayHValue i hv marr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c20b043b6a006361c1744c6886ad0c9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c20b043b6a006361c1744c6886ad0c9... You're receiving this email because of your account on gitlab.haskell.org.