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.
