[Git][ghc/ghc][wip/bytecode-serialize-clean] compiler: make bc_itbls serializable
Cheng Shao (@TerrorJack)
gitlab at gitlab.haskell.org
Fri Feb 14 01:33:56 UTC 2025
Cheng Shao pushed to branch wip/bytecode-serialize-clean at Glasgow Haskell Compiler / GHC
Commits:
ddb8b2b7 by Cheng Shao at 2025-02-14T01:33:34+00:00
compiler: make bc_itbls serializable
- - - - -
5 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/StgToByteCode.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -21,7 +21,6 @@ import GHC.ByteCode.Instr
import GHC.ByteCode.InfoTable
import GHC.ByteCode.Types
import GHCi.RemoteTypes
-import GHC.Runtime.Interpreter
import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord )
import GHC.Types.Name
@@ -89,22 +88,21 @@ bcoFreeNames bco
-- Top level assembler fn.
assembleBCOs
- :: Interp
- -> Profile
+ :: Profile
-> FlatBag (ProtoBCO Name)
-> [TyCon]
-> [(Name, ByteString)]
-> Maybe ModBreaks
-> [SptEntry]
-> IO CompiledByteCode
-assembleBCOs interp profile proto_bcos tycons top_strs modbreaks spt_entries = do
+assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
- itblenv <- mkITbls interp profile tycons
+ let itbls = mkITbls profile tycons
bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos
return CompiledByteCode
{ bc_bcos = bcos
- , bc_itbls = itblenv
+ , bc_itbls = itbls
, bc_ffis = concatMap protoBCOFFIs proto_bcos
, bc_strs = top_strs
, bc_breaks = modbreaks
=====================================
compiler/GHC/ByteCode/InfoTable.hs
=====================================
@@ -13,11 +13,11 @@ import GHC.Prelude
import GHC.Platform
import GHC.Platform.Profile
-import GHC.ByteCode.Types
import GHC.Runtime.Interpreter
+import GHCi.RemoteTypes
+import qualified GHC.Exts.Heap as Heap
import GHC.Types.Name ( Name, getName )
-import GHC.Types.Name.Env
import GHC.Types.RepType
import GHC.Core.DataCon ( DataCon, dataConRepArgTys, dataConIdentity )
@@ -35,33 +35,38 @@ import GHC.Utils.Panic
-}
-- Make info tables for the data decls in this module
-mkITbls :: Interp -> Profile -> [TyCon] -> IO ItblEnv
-mkITbls interp profile tcs =
- foldr plusNameEnv emptyNameEnv <$>
- mapM mkITbl (filter isDataTyCon tcs)
+mkITbls :: Profile -> [TyCon] -> [(Name, Message (RemotePtr Heap.StgInfoTable))]
+mkITbls profile tcs = concatMap mkITbl (filter isDataTyCon tcs)
where
- mkITbl :: TyCon -> IO ItblEnv
+ mkITbl :: TyCon -> [(Name, Message (RemotePtr Heap.StgInfoTable))]
mkITbl tc
| dcs `lengthIs` n -- paranoia; this is an assertion.
- = make_constr_itbls interp profile dcs
+ = make_constr_itbls profile dcs
where
dcs = tyConDataCons tc
n = tyConFamilySize tc
mkITbl _ = panic "mkITbl"
-mkItblEnv :: [(Name,ItblPtr)] -> ItblEnv
-mkItblEnv pairs = mkNameEnv [(n, (n,p)) | (n,p) <- pairs]
-
-- Assumes constructors are numbered from zero, not one
-make_constr_itbls :: Interp -> Profile -> [DataCon] -> IO ItblEnv
-make_constr_itbls interp profile cons =
+make_constr_itbls :: Profile -> [DataCon] -> [(Name, Message (RemotePtr Heap.StgInfoTable))]
+make_constr_itbls profile cons =
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
- mkItblEnv <$> mapM (uncurry mk_itbl) (zip cons [0..])
- where
- mk_itbl :: DataCon -> Int -> IO (Name,ItblPtr)
- mk_itbl dcon conNo = do
- let rep_args = [ prim_rep
+ map (uncurry mk_itbl) (zip cons [0..])
+ where
+ mk_itbl :: DataCon -> Int -> (Name, Message (RemotePtr Heap.StgInfoTable))
+ mk_itbl dcon conNo =
+ ( getName dcon,
+ MkConInfoTable
+ tables_next_to_code
+ ptrs'
+ nptrs_really
+ conNo
+ (tagForCon platform dcon)
+ descr
+ )
+ where
+ rep_args = [ prim_rep
| arg <- dataConRepArgTys dcon
, prim_rep <- typePrimRep (scaledThing arg) ]
@@ -79,7 +84,3 @@ make_constr_itbls interp profile cons =
platform = profilePlatform profile
constants = platformConstants platform
tables_next_to_code = platformTablesNextToCode platform
-
- r <- interpCmd interp (MkConInfoTable tables_next_to_code ptrs' nptrs_really
- conNo (tagForCon platform dcon) descr)
- return (getName dcon, ItblPtr r)
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Builtin.PrimOps
import GHC.Types.SptEntry
import GHC.Types.SrcLoc
import GHCi.BreakArray
+import GHCi.Message
import GHCi.RemoteTypes
import GHCi.FFI
import Control.DeepSeq
@@ -58,7 +59,7 @@ data CompiledByteCode = CompiledByteCode
{ bc_bcos :: FlatBag UnlinkedBCO
-- ^ Bunch of interpretable bindings
- , bc_itbls :: ItblEnv
+ , bc_itbls :: ![(Name, Message (RemotePtr Heap.StgInfoTable))]
-- ^ Mapping from DataCons to their info tables
, bc_ffis :: [FFIInfo]
@@ -87,7 +88,7 @@ instance Outputable CompiledByteCode where
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{..} =
rnf bc_bcos `seq`
- seqEltsNameEnv rnf bc_itbls `seq`
+ seq bc_itbls `seq`
rnf bc_ffis `seq`
rnf bc_strs `seq`
rnf (fmap seqModBreaks bc_breaks)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -55,6 +55,7 @@ import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHC.Iface.Load
import GHCi.Message (LoadedDLL)
+import qualified GHC.Exts.Heap as Heap
import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
@@ -724,8 +725,9 @@ loadDecls interp hsc_env span linkable = do
else do
-- Link the expression itself
let le = linker_env pls
+ le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs)
le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs
- let le2 = le { itbl_env = foldl' (\acc cbc -> plusNameEnv acc (bc_itbls cbc)) (itbl_env le) cbcs
+ let le2 = le { itbl_env = le2_itbl_env
, addr_env = le2_addr_env }
-- Link the necessary packages and linkables
@@ -948,7 +950,7 @@ dynLinkBCOs interp pls bcos = do
le1 = linker_env pls
- ie2 = foldr plusNameEnv (itbl_env le1) (map bc_itbls cbcs)
+ ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
let le2 = le1 { itbl_env = ie2, addr_env = ae2 }
@@ -995,6 +997,11 @@ makeForeignNamedHValueRefs
makeForeignNamedHValueRefs interp bindings =
mapM (\(n, hvref) -> (n,) <$> mkFinalizedHValue interp hvref) bindings
+linkITbls :: Interp -> ItblEnv -> [(Name, Message (RemotePtr Heap.StgInfoTable))] -> IO ItblEnv
+linkITbls interp = foldlM $ \env (nm, msg) -> do
+ r <- interpCmd interp msg
+ evaluate $ extendNameEnv env nm (nm, ItblPtr r)
+
{- **********************************************************************
Unload some object modules
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -134,7 +134,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
let mod_breaks = case modBreaks of
Nothing -> Nothing
Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }
- cbc <- assembleBCOs interp profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -148,7 +148,6 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
where dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
- interp = hscInterp hsc_env
profile = targetProfile dflags
{- Note [Generating code for top-level string literal bindings]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddb8b2b7d8f70b153e13181416e10913dd8c5497
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddb8b2b7d8f70b153e13181416e10913dd8c5497
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250213/f757c548/attachment-0001.html>
More information about the ghc-commits
mailing list