[Git][ghc/ghc][wip/bytecode-serialize-clean] compiler: make FFIInfo serializable in BCO

[Cheng Shao (@TerrorJack)]

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


Commits:
e27e0163 by Cheng Shao at 2025-02-14T22:00:52+00:00
compiler: make FFIInfo serializable in BCO

- - - - -


5 changed files:

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


Changes:

=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -468,7 +468,7 @@ assembleI platform i = case i of
   ENTER                    -> emit bci_ENTER []
   RETURN rep               -> emit (return_non_tuple rep) []
   RETURN_TUPLE             -> emit bci_RETURN_T []
-  CCALL off m_addr i       -> do np <- addr m_addr
+  CCALL off ffi i          -> do np <- lit [BCONPtrFFIInfo ffi]
                                  emit bci_CCALL [wOp off, Op np, SmallOp i]
   PRIMCALL                 -> emit bci_PRIMCALL []
   BRK_FUN arr tick_mod tickx info_mod infox cc ->


=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -15,7 +15,6 @@ import GHC.Prelude
 
 import GHC.ByteCode.Types
 import GHCi.RemoteTypes
-import GHCi.FFI (C_ffi_cif)
 import GHC.StgToCmm.Layout     ( ArgRep(..) )
 import GHC.Utils.Outputable
 import GHC.Types.Name
@@ -201,7 +200,7 @@ data BCInstr
 
    -- For doing calls to C (via glue code generated by libffi)
    | CCALL            !WordOff  -- stack frame size
-                      (RemotePtr C_ffi_cif) -- addr of the glue code
+                      !FFIInfo  -- libffi ffi_cif function prototype
                       !Word16   -- flags.
                                 --
                                 -- 0x1: call is interruptible
@@ -382,9 +381,9 @@ instance Outputable BCInstr where
    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
    ppr CASEFAIL              = text "CASEFAIL"
    ppr (JMP lab)             = text "JMP"      <+> ppr lab
-   ppr (CCALL off marshal_addr flags) = text "CCALL   " <+> ppr off
+   ppr (CCALL off ffi flags) = text "CCALL   " <+> ppr off
                                                 <+> text "marshal code at"
-                                               <+> text (show marshal_addr)
+                                               <+> text (show ffi)
                                                <+> (case flags of
                                                       0x1 -> text "(interruptible)"
                                                       0x2 -> text "(unsafe)"


=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -3,6 +3,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE RecordWildCards       #-}
 {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 --
 --  (c) The University of Glasgow 2002-2006
@@ -86,6 +87,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of
   BCONPtrStr bs -> do
     RemotePtr p <- fmap head $ interpCmd interp $ MallocStrings [bs]
     pure $ fromIntegral p
+  BCONPtrFFIInfo (FFIInfo {..}) -> do
+    RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
+    pure $ fromIntegral p
 
 lookupStaticPtr :: Interp -> FastString -> IO (Ptr ())
 lookupStaticPtr interp addr_of_label_string = do


=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -74,8 +74,8 @@ data CompiledByteCode = CompiledByteCode
     -- "GHC.Iface.Tidy.StaticPtrTable".
   }
                 -- ToDo: we're not tracking strings that we malloc'd
-newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
-  deriving (Show, NFData)
+data FFIInfo = FFIInfo { ffiInfoArgs :: ![FFIType], ffiInfoRet :: !FFIType }
+  deriving (Show)
 
 instance Outputable CompiledByteCode where
   ppr CompiledByteCode{..} = ppr $ elemsFlatBag bc_bcos
@@ -198,6 +198,8 @@ data BCONPtr
   | BCONPtrAddr  !Name
   -- | A top-level string literal.
   | BCONPtrStr   !ByteString
+  -- | A libffi ffi_cif function prototype.
+  | BCONPtrFFIInfo !FFIInfo
 
 instance NFData BCONPtr where
   rnf x = x `seq` ()


=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -1682,12 +1682,10 @@ generateCCall d0 s p (CCallSpec target _ safety) result_ty args
 
      let ffires = primRepToFFIType platform r_rep
          ffiargs = map (primRepToFFIType platform) a_reps
-     interp <- hscInterp <$> getHscEnv
-     token <- ioToBc $ interpCmd interp (PrepFFI ffiargs ffires)
 
      let
          -- do the call
-         do_call      = unitOL (CCALL stk_offset token flags)
+         do_call      = unitOL (CCALL stk_offset (FFIInfo ffiargs ffires) flags)
            where flags = case safety of
                            PlaySafe          -> 0x0
                            PlayInterruptible -> 0x1



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e27e0163cd9caca68f82bf63ea07a1f7f23fe750
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/20250214/53d99dfc/attachment-0001.html>