Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: 85e760cd by Rodrigo Mesquita at 2025-12-19T23:53:18+00:00 X LOOK - - - - - 8413b6e6 by Rodrigo Mesquita at 2025-12-19T23:53:37+00:00 Revert "X LOOK" This reverts commit 85e760cde55d7d28e17b2afd41be451584bf2b02. - - - - - bdb5798e by Rodrigo Mesquita at 2025-12-19T23:53:44+00:00 Revert "Kill traces" This reverts commit 0be5515a3a30cf47415187d54679b5cb434d19fb. - - - - - 54c9db31 by Rodrigo Mesquita at 2025-12-20T00:25:46+00:00 Reapply "Kill traces" This reverts commit bdb5798e8294a5938db5c0d399ea658bb8c9fc05. - - - - - 28ec9e05 by Rodrigo Mesquita at 2025-12-20T00:26:07+00:00 Reapply "X LOOK" This reverts commit 8413b6e6902bb19c1247be0befdbbef8b2a7bac4. - - - - - f0ce9444 by Rodrigo Mesquita at 2025-12-20T12:20:55+00:00 WIP.. - - - - - 4 changed files: - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Linker/Loader.hs - libraries/ghci/GHCi/CreateBCO.hs - rts/PrimOps.cmm Changes: ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -288,9 +288,9 @@ instance NFData BCOPtr where rnf x = x `seq` () instance Outputable BCOPtr where - ppr (BCOPtrName nm) = text "BCOPtrName" <+> ppr nm - ppr (BCOPtrPrimOp op) = text "BCOPtrPrimOp" <+> ppr op - ppr (BCOPtrBCO bco) = text "BCOPtrBCO" <+> ppr bco + ppr (BCOPtrName nm) = text "BCOPtrName" <+> ppr nm + ppr (BCOPtrPrimOp op) = text "BCOPtrPrimOp" <+> ppr op + ppr (BCOPtrBCO bco) = text "BCOPtrBCO" <+> ppr bco ppr (BCOPtrBreakArray mod) = text " ppr mod <> char '>' data BCONPtr @@ -311,13 +311,13 @@ data BCONPtr | BCONPtrCostCentre !InternalBreakpointId instance Outputable BCONPtr where - ppr (BCONPtrWord w) = integer (fromIntegral w) - ppr (BCONPtrLbl lbl) = text " ftext lbl <> char '>' - ppr (BCONPtrItbl nm) = text " ppr nm <> char '>' - ppr (BCONPtrAddr nm) = text " ppr nm <> char '>' - ppr (BCONPtrStr bs) = text " text (BS8.unpack bs) <> char '>' - ppr (BCONPtrFS fs) = text " ftext fs <> char '>' - ppr (BCONPtrFFIInfo ffi) = text "<FFIInfo>" + ppr (BCONPtrWord w) = integer (fromIntegral w) + ppr (BCONPtrLbl lbl) = text " ftext lbl <> char '>' + ppr (BCONPtrItbl nm) = text " ppr nm <> char '>' + ppr (BCONPtrAddr nm) = text " ppr nm <> char '>' + ppr (BCONPtrStr bs) = text " text (BS8.unpack bs) <> char '>' + ppr (BCONPtrFS fs) = text " ftext fs <> char '>' + ppr (BCONPtrFFIInfo _) = text "<FFIInfo>" ppr (BCONPtrCostCentre bid) = text " ppr bid <> char '>' instance NFData BCONPtr where ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -1049,7 +1049,7 @@ linkSomeBCOs interp pkgs_loaded bytecode_state mods = foldr fun do_link mods [] ) flat bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..]) resolved <- sequence [ linkBCO interp pkgs_loaded bytecode_state bco_ix bco | bco <- flat ] - hvrefs <- createBCOs interp resolved + hvrefs <- {- pprTrace "CreatingBCOS" (ppr (zip [bco | bco <- flat] [(0::Int)..])) $ -} createBCOs interp resolved return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -39,7 +39,16 @@ createBCOs bcos = do hvals <- fixIO $ \hvs -> do let arr = listArray (0, n_bcos-1) hvs mapM (createBCO arr) bcos - mapM mkRemoteRef hvals + -- Force all StaticConRefs! They must definitely not be thunks! + -- See Note ... + -- This doesn't work. We need to force the thunk which is written into the Ptrs array + zipWithM (\bco hval -> + case bco of + ResolvedBCO{} -> + mkRemoteRef hval + ResolvedStaticCon{} -> + hval `seq` mkRemoteRef hval + ) bcos hvals createBCO :: Array Int HValue -> ResolvedBCO -> IO HValue createBCO _ obj | resolvedBCOIsLE obj /= isLittleEndian @@ -116,7 +125,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,9 +142,7 @@ 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 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 + writePtrsArrayHValue i (arr ! n) marr fill (ResolvedBCOPtr r) i = do hv <- localRef r writePtrsArrayHValue i hv marr ===================================== rts/PrimOps.cmm ===================================== @@ -2185,6 +2185,8 @@ stg_newConAppObjzh ( P_ datacon_info, P_ literals, P_ ptrs , W_ arity ) { W_ con_obj, bytes; + // ccall debugBelch("New Con App Obj %p\n",arity); + bytes = SIZEOF_StgHeader + WDS(arity); ALLOC_PRIM (bytes); @@ -2214,6 +2216,8 @@ loop2: goto loop2; } + // ccall debugBelch("Exit New Con App Obj %p\n",arity); + return (con_obj); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be5515a3a30cf47415187d54679b5c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be5515a3a30cf47415187d54679b5c... You're receiving this email because of your account on gitlab.haskell.org.