[Git][ghc/ghc][wip/bytecode-serialize-clean] compiler: do not allocate strings in bytecode assembler

[Cheng Shao (@TerrorJack)]

Cheng Shao pushed to branch wip/bytecode-serialize-clean at Glasgow Haskell Compiler / GHC


Commits:
ff0df904 by Cheng Shao at 2025-02-14T00:16:32+00:00
compiler: do not allocate strings in bytecode assembler

- - - - -


3 changed files:

- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs


Changes:

=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -101,9 +101,8 @@ assembleBCOs interp profile proto_bcos tycons top_strs modbreaks spt_entries = d
   -- fixed for an interpreter
   itblenv <- mkITbls interp profile tycons
   bcos    <- mapM (assembleBCO (profilePlatform profile)) proto_bcos
-  bcos'   <- mallocStrings interp bcos
   return CompiledByteCode
-    { bc_bcos = bcos'
+    { bc_bcos = bcos
     , bc_itbls = itblenv
     , bc_ffis = concatMap protoBCOFFIs proto_bcos
     , bc_strs = top_strs
@@ -131,40 +130,6 @@ assembleBCOs interp profile proto_bcos tycons top_strs modbreaks spt_entries = d
 -- top-level string literal bindings] in GHC.StgToByteCode for some discussion
 -- about why.
 --
-mallocStrings ::  Interp -> FlatBag UnlinkedBCO -> IO (FlatBag UnlinkedBCO)
-mallocStrings interp ulbcos = do
-  let bytestrings = reverse (execState (mapM_ collect ulbcos) [])
-  ptrs <- interpCmd interp (MallocStrings bytestrings)
-  return (evalState (mapM splice ulbcos) ptrs)
- where
-  splice bco at UnlinkedBCO{..} = do
-    lits <- mapM spliceLit unlinkedBCOLits
-    ptrs <- mapM splicePtr unlinkedBCOPtrs
-    return bco { unlinkedBCOLits = lits, unlinkedBCOPtrs = ptrs }
-
-  spliceLit (BCONPtrStr _) = do
-    rptrs <- get
-    case rptrs of
-      (RemotePtr p : rest) -> do
-        put rest
-        return (BCONPtrWord (fromIntegral p))
-      _ -> panic "mallocStrings:spliceLit"
-  spliceLit other = return other
-
-  splicePtr (BCOPtrBCO bco) = BCOPtrBCO <$> splice bco
-  splicePtr other = return other
-
-  collect UnlinkedBCO{..} = do
-    mapM_ collectLit unlinkedBCOLits
-    mapM_ collectPtr unlinkedBCOPtrs
-
-  collectLit (BCONPtrStr bs) = do
-    strs <- get
-    put (bs:strs)
-  collectLit _ = return ()
-
-  collectPtr (BCOPtrBCO bco) = collect bco
-  collectPtr _ = return ()
 
 assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
 assembleBCO platform


=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -83,9 +83,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of
   BCONPtrAddr nm -> do
     Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm
     return (W# (int2Word# (addr2Int# a#)))
-  BCONPtrStr _ ->
-    -- should be eliminated during assembleBCOs
-    panic "lookupLiteral: BCONPtrStr"
+  BCONPtrStr bs -> do
+    RemotePtr p <- fmap head $ interpCmd interp $ MallocStrings [bs]
+    pure $ fromIntegral p
 
 lookupStaticPtr :: Interp -> FastString -> IO (Ptr ())
 lookupStaticPtr interp addr_of_label_string = do


=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -199,9 +199,7 @@ data BCONPtr
   -- | A reference to a top-level string literal; see
   -- Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode.
   | BCONPtrAddr  !Name
-  -- | Only used internally in the assembler in an intermediate representation;
-  -- should never appear in a fully-assembled UnlinkedBCO.
-  -- Also see Note [Allocating string literals] in GHC.ByteCode.Asm.
+  -- | A top-level string literal.
   | BCONPtrStr   !ByteString
 
 instance NFData BCONPtr where



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff0df9046ab1db4b31646dda87502f8b2fe4a9ac

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff0df9046ab1db4b31646dda87502f8b2fe4a9ac
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/3eabd081/attachment-0001.html>