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
-
0be5515a
by Rodrigo Mesquita at 2025-12-19T22:31:57+00:00
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:
| ... | ... | @@ -298,8 +298,9 @@ data BCInstr |
| 298 | 298 | |
| 299 | 299 | instance Outputable ProtoBCO where
|
| 300 | 300 | ppr (ProtoStaticCon nm con args origin)
|
| 301 | - = text "ProtoStaticCon" <+> ppr nm <+> text "for constructor" <+> ppr con <> colon
|
|
| 301 | + = text "ProtoStaticCon" <+> ppr nm <> colon
|
|
| 302 | 302 | $$ nest 3 (pprStgRhsShort shortStgPprOpts origin)
|
| 303 | + $$ nest 3 (text "constructor: " <+> ppr con)
|
|
| 303 | 304 | $$ nest 3 (text "sorted args: " <+> ppr args)
|
| 304 | 305 | ppr (ProtoBCO { protoBCOName = name
|
| 305 | 306 | , protoBCOInstrs = instrs
|
| ... | ... | @@ -79,14 +79,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do |
| 79 | 79 | UnlinkedStaticCon
|
| 80 | 80 | { unlinkedStaticConLits = lits0
|
| 81 | 81 | , unlinkedStaticConPtrs = ptrs0
|
| 82 | + , unlinkedStaticConDataConName
|
|
| 82 | 83 | } -> do
|
| 83 | - pprTraceM "linkBCO: linking static constructor" (ppr unl_bco)
|
|
| 84 | - Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state (unlinkedStaticConDataConName unl_bco)
|
|
| 85 | - pprTraceM "linkBCO: itbl_ptr#" (ppr (unlinkedStaticConDataConName unl_bco) <+> text (show (Ptr itbl_ptr#)))
|
|
| 84 | + Ptr itbl_ptr# <- lookupIE interp pkgs_loaded bytecode_state unlinkedStaticConDataConName
|
|
| 86 | 85 | lits <- doLits lits0
|
| 87 | - pprTraceM "linkBCO: lits done" (empty)
|
|
| 88 | 86 | ptrs <- doPtrs ptrs0
|
| 89 | - pprTraceM "linkBCO: ptrs done" (empty)
|
|
| 90 | 87 | return ResolvedStaticCon
|
| 91 | 88 | { resolvedBCOIsLE = isLittleEndian
|
| 92 | 89 | , resolvedStaticConInfoPtr = W# (int2Word# (addr2Int# itbl_ptr#))
|
| ... | ... | @@ -99,11 +96,11 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix unl_bco = do |
| 99 | 96 | (lits :: [Word]) <- mapM (lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0)
|
| 100 | 97 | let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits
|
| 101 | 98 | return $ mkBCOByteArray lits'
|
| 102 | - doPtrs ptrs0 = addListToSS emptySS <$>
|
|
| 99 | + doPtrs ptrs0 = addListToSS emptySS <$> do
|
|
| 103 | 100 | mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0)
|
| 104 | 101 | |
| 105 | 102 | lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word
|
| 106 | -lookupLiteral interp pkgs_loaded bytecode_state ptr = pprTrace "lookupLiteral" (ppr ptr) $ case ptr of
|
|
| 103 | +lookupLiteral interp pkgs_loaded bytecode_state ptr = case ptr of
|
|
| 107 | 104 | BCONPtrWord lit -> return lit
|
| 108 | 105 | BCONPtrLbl sym -> do
|
| 109 | 106 | Ptr a# <- lookupStaticPtr interp sym
|
| ... | ... | @@ -187,24 +184,20 @@ resolvePtr |
| 187 | 184 | -> NameEnv (Int, Bool)
|
| 188 | 185 | -> BCOPtr
|
| 189 | 186 | -> IO ResolvedBCOPtr
|
| 190 | -resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = pprTrace "resolvePtr" (ppr ptr) $ case ptr of
|
|
| 187 | +resolvePtr interp pkgs_loaded bco_loader_state bco_ix ptr = case ptr of
|
|
| 191 | 188 | BCOPtrName nm
|
| 192 | 189 | | Just (ix, b) <- lookupNameEnv bco_ix nm
|
| 193 | - -> if b then do
|
|
| 194 | - pprTraceM "resolvePtr: ResolvedBCORef" (ppr nm <+> ppr ix)
|
|
| 190 | + -> if b then
|
|
| 195 | 191 | return (ResolvedBCORef ix) -- ref to another BCO in this group
|
| 196 | - else do
|
|
| 197 | - pprTraceM "resolvePtr: StaticConRef" (ppr nm <+> ppr ix)
|
|
| 192 | + else
|
|
| 198 | 193 | return (ResolvedStaticConRef ix) -- ref to another StaticCon in this group
|
| 199 | 194 | |
| 200 | 195 | | Just (_, rhv) <- lookupNameBytecodeState bco_loader_state nm
|
| 201 | - -> do
|
|
| 202 | - pprTraceM "resolvePtr: BCOPtr" (ppr nm)
|
|
| 203 | - return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv))
|
|
| 196 | + -> return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv))
|
|
| 204 | 197 | |
| 205 | 198 | | otherwise
|
| 206 | 199 | -> assertPpr (isExternalName nm) (ppr nm) $
|
| 207 | - pprTrace "resolvePtr: OTHERWISE? ASSERTION FIALURE?" (ppr nm) $ do
|
|
| 200 | + do
|
|
| 208 | 201 | let sym_to_find = IClosureSymbol nm
|
| 209 | 202 | m <- lookupHsSymbol interp pkgs_loaded sym_to_find
|
| 210 | 203 | case m of
|
| ... | ... | @@ -1048,13 +1048,6 @@ linkSomeBCOs interp pkgs_loaded bytecode_state mods = foldr fun do_link mods [] |
| 1048 | 1048 | UnlinkedStaticCon{unlinkedStaticConName} -> (unlinkedStaticConName, False)
|
| 1049 | 1049 | ) flat
|
| 1050 | 1050 | bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..])
|
| 1051 | - pprTraceM "linkSomeBCOs what" $ (ppr mods <+> ppr flat)
|
|
| 1052 | - pprTraceM "linkSomeBCOs" $
|
|
| 1053 | - vcat [ text "Linking BCOs:"
|
|
| 1054 | - , nest 2 (vcat (map (ppr . fst) names))
|
|
| 1055 | - , text "BCO index:"
|
|
| 1056 | - , nest 2 (ppr bco_ix)
|
|
| 1057 | - ]
|
|
| 1058 | 1051 | resolved <- sequence [ linkBCO interp pkgs_loaded bytecode_state bco_ix bco | bco <- flat ]
|
| 1059 | 1052 | hvrefs <- createBCOs interp resolved
|
| 1060 | 1053 | return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs)
|
| ... | ... | @@ -307,7 +307,6 @@ argBits platform (rep : args) |
| 307 | 307 | schemeTopBind :: (Id, CgStgRhs) -> BcM ProtoBCO
|
| 308 | 308 | schemeTopBind (id, rhs@(StgRhsCon _ dc _ _ args _))
|
| 309 | 309 | = do
|
| 310 | - pprTraceM "schemeTopBind: static con" (ppr id <+> ppr dc <+> ppr args)
|
|
| 311 | 310 | profile <- getProfile
|
| 312 | 311 | let non_voids = addArgReps (assertNonVoidStgArgs args)
|
| 313 | 312 | (_, _, args_offsets)
|
| ... | ... | @@ -116,7 +116,7 @@ linkBCO' arr resolved_obj = |
| 116 | 116 | IO $ \s ->
|
| 117 | 117 | case unsafeFreezeArray# marr s of { (# s, arr #) ->
|
| 118 | 118 | case newConAppObj# itbl_ptr# literals_barr arr data_size# s of
|
| 119 | - (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #)
|
|
| 119 | + (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #)
|
|
| 120 | 120 | }
|
| 121 | 121 | where
|
| 122 | 122 | !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array]
|
| ... | ... | @@ -133,8 +133,9 @@ mkPtrsArray arr n_ptrs ptrs = do |
| 133 | 133 | -- this MUST be /strict/!
|
| 134 | 134 | -- the static con reference must be an evaluated pointer to the data con
|
| 135 | 135 | -- info table, but (arr ! n) would construct a thunk instead if unforced.
|
| 136 | - let !hv = arr ! n
|
|
| 137 | - writePtrsArrayHValue i hv marr
|
|
| 136 | + let HValue !hv = arr ! n
|
|
| 137 | + -- let !hv = arr ! n -- this loops, but the above doesn't? something I didn't understand.
|
|
| 138 | + writePtrsArrayHValue i (HValue hv) marr
|
|
| 138 | 139 | fill (ResolvedBCOPtr r) i = do
|
| 139 | 140 | hv <- localRef r
|
| 140 | 141 | writePtrsArrayHValue i hv marr
|