Matthew Pickering pushed to branch wip/bytecode-library at Glasgow Haskell Compiler / GHC Commits: 99b973a9 by Matthew Pickering at 2025-08-28T17:23:50+01:00 Load bytecode objects into the linker when they are loaded. - - - - - 17 changed files: - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Driver/ByteCode.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Unit/Finder.hs - libraries/ghci/GHCi/Message.hs - testsuite/tests/cabal/Bytecode.hs - testsuite/tests/cabal/Makefile - testsuite/tests/cabal/all.T - testsuite/tests/cabal/bytecode.pkg - + testsuite/tests/cabal/bytecode.script - testsuite/tests/cabal/pkg_bytecode.stderr - testsuite/tests/cabal/pkg_bytecode.stdout Changes: ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -9,6 +9,7 @@ module GHC.ByteCode.Serialize , writeBytecodeLib , readBytecodeLib , mkBytecodeLib + , decodeOnDiskByteCodeObject ) where ===================================== compiler/GHC/Driver/ByteCode.hs ===================================== @@ -6,7 +6,8 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Driver.CodeOutput import GHC.Driver.Env -import GHC.Runtime.Interpreter +import GHC.Runtime.Interpreter.Types + ( interpreterDynamic, interpreterProfiled ) import GHC.ByteCode.Types import GHC.Linker.Types @@ -23,9 +24,11 @@ import Data.Time import GHC.Platform.Ways import GHC.ByteCode.Serialize +import System.OsPath -- | Write foreign sources and foreign stubs to temporary files and compile them. -outputAndCompileForeign :: HscEnv -> Module -> ModLocation -> [(ForeignSrcLang, FilePath)] -> ForeignStubs -> IO [FilePath] +outputAndCompileForeign :: HscEnv -> Module -> Maybe OsPath -- ^ Source file location + -> [(ForeignSrcLang, FilePath)] -> ForeignStubs -> IO [FilePath] outputAndCompileForeign hsc_env mod_name location foreign_files foreign_stubs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -58,13 +61,13 @@ compile_for_interpreter hsc_env use = adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay -- | Write the foreign sources and foreign stubs of a bytecode object to temporary files and compile them. -loadByteCodeObject :: HscEnv -> ModLocation -> ByteCodeObject +loadByteCodeObject :: HscEnv -> Maybe OsPath -> ByteCodeObject -> IO (CompiledByteCode, [FilePath]) loadByteCodeObject hsc_env location (ByteCodeObject mod cbc foreign_srcs foreign_stubs) = do fos <- outputAndCompileForeign hsc_env mod location foreign_srcs foreign_stubs return (cbc, fos) -loadByteCodeObjectLinkable :: HscEnv -> UTCTime -> ModLocation -> ByteCodeObject -> IO Linkable +loadByteCodeObjectLinkable :: HscEnv -> UTCTime -> Maybe OsPath -> ByteCodeObject -> IO Linkable loadByteCodeObjectLinkable hsc_env linkable_time location bco = do ~(cbc, fos) <- loadByteCodeObject hsc_env location bco return $! Linkable linkable_time (bco_module bco) (BCOs cbc :| [DotO fo ForeignObject | fo <- fos]) \ No newline at end of file ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -133,7 +133,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream - ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs + ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod (ml_hs_file_ospath $ location) stubs ; return (filenm, stubs_exist, foreign_fps, a) } @@ -269,7 +269,7 @@ outputForeignStubs -> DynFlags -> UnitState -> Module - -> ModLocation + -> Maybe OsPath -- ^ Source file location -> ForeignStubs -> IO (Bool, -- Header file created Maybe FilePath) -- C file created ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1015,7 +1015,7 @@ checkByteCodeFromObject hsc_env mod_sum = do -- that the one we have on disk would be suitable as well. linkable <- unsafeInterleaveIO $ do bco <- readBinByteCode hsc_env obj_fn - loadByteCodeObjectLinkable hsc_env obj_date (ms_location mod_sum) bco + loadByteCodeObjectLinkable hsc_env obj_date (ml_hs_file_ospath $ ms_location mod_sum) bco return $ UpToDateItem linkable _ -> return $ outOfDateItemBecause MissingBytecode Nothing @@ -2163,7 +2163,7 @@ hscInteractive hsc_env cgguts location = do let tmpfs = hsc_tmpfs hsc_env ------------------ Create f-x-dynamic C-side stuff ----- (_istub_h_exists, istub_c_exists) - <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) (cgi_module cgguts) location (cgi_foreign cgguts) + <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) (cgi_module cgguts) (ml_hs_file_ospath $ location) (cgi_foreign cgguts) return (istub_c_exists, comp_bc) @@ -2214,7 +2214,7 @@ generateByteCode :: HscEnv -> IO (CompiledByteCode, [FilePath]) generateByteCode hsc_env cgguts mod_location = do comp_bc' <- hscGenerateByteCode hsc_env cgguts mod_location - fos <- outputAndCompileForeign hsc_env (cgi_module cgguts) mod_location (cgi_foreign_files cgguts) (cgi_foreign cgguts) + fos <- outputAndCompileForeign hsc_env (cgi_module cgguts) (ml_hs_file_ospath $ mod_location) (cgi_foreign_files cgguts) (cgi_foreign cgguts) pure (comp_bc', fos) -- | Generate a byte code object linkable and write it to a file if `-fwrite-bytecode` is enabled. @@ -2234,7 +2234,7 @@ generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do -- It's important the time of the linkable matches the time of the .gbc file for recompilation -- checking. bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file mod_location) - loadByteCodeObjectLinkable hsc_env bco_time mod_location bco_object + loadByteCodeObjectLinkable hsc_env bco_time (ml_hs_file_ospath $ mod_location) bco_object mkByteCodeObject :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ByteCodeObject mkByteCodeObject hsc_env mod mod_location cgguts = do @@ -2249,7 +2249,7 @@ generateFreshByteCodeLinkable :: HscEnv generateFreshByteCodeLinkable hsc_env mod_name cgguts mod_location = do bco_time <- getCurrentTime bco_object <- mkByteCodeObject hsc_env (mkHomeModule (hsc_home_unit hsc_env) mod_name) mod_location cgguts - loadByteCodeObjectLinkable hsc_env bco_time mod_location bco_object + loadByteCodeObjectLinkable hsc_env bco_time (ml_hs_file_ospath $ mod_location) bco_object ------------------------------ hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> FilePath -> IO (Maybe FilePath) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -423,6 +423,13 @@ link' hsc_env batch_attempt_linking mHscMessager hpt return Succeeded else do + -- TODO: This is very awkward. + + -- 1. Ban using --make mode to create -bytecodelib, since then you would not need in-memory linkables + -- 2. Make Linkable and ByteCodeObject more similar, so that you can translate between them. + -- * Either store .o files in ByteCodeObject <-- MP thinks this way + -- * or Store ForeignStubs/ForeignSrcs in Linkable + -- 3. Store ByteCodeObject in Linkable directly let hackyMPtodo l = [ ByteCodeObject (linkableModule l) cbc [] NoStubs | cbc <- linkableBCOs l ] let linkObjectLinkable action = ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -132,6 +132,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import Foreign.Ptr (nullPtr) import GHC.ByteCode.Serialize +import GHC.Data.Maybe (expectJust) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -659,7 +660,7 @@ findBytecodeLinkableMaybe hsc_env mod locn = do loadInterface (text "get_reachable_nodes" <+> parens (ppr mod)) mod ImportBySystem bco <- readBinByteCode hsc_env bytecode_fn - Just <$> loadByteCodeObjectLinkable hsc_env bytecode_time locn bco + Just <$> loadByteCodeObjectLinkable hsc_env bytecode_time (ml_hs_file_ospath $ locn) bco get_reachable_nodes :: HscEnv -> [Module] -> IO ([Module], UniqDSet UnitId) get_reachable_nodes hsc_env mods @@ -1155,16 +1156,16 @@ loadPackages interp hsc_env new_pkgs = do loadPackages' :: Interp -> HscEnv -> [UnitId] -> LoaderState -> IO LoaderState loadPackages' interp hsc_env new_pks pls = do - pkgs' <- link (pkgs_loaded pls) new_pks - return $! pls { pkgs_loaded = pkgs' - } + pls' <- link pls new_pks + return $! pls' where - link :: PkgsLoaded -> [UnitId] -> IO PkgsLoaded + link :: LoaderState -> [UnitId] -> IO LoaderState link pkgs new_pkgs = foldM link_one pkgs new_pkgs + link_one :: LoaderState -> UnitId -> IO LoaderState link_one pkgs new_pkg - | new_pkg `elemUDFM` pkgs -- Already linked + | new_pkg `elemUDFM` (pkgs_loaded pkgs) -- Already linked = return pkgs | Just pkg_cfg <- lookupUnitId (hsc_units hsc_env) new_pkg @@ -1172,19 +1173,15 @@ loadPackages' interp hsc_env new_pks pls = do -- Link dependents first ; pkgs' <- link pkgs deps -- Now link the package itself - ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg - ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg - | dep_pkg <- deps - , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) - ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } + ; loadPackage interp hsc_env pkg_cfg pkgs' + } | otherwise = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) -loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) -loadPackage interp hsc_env pkg +loadPackage :: Interp -> HscEnv -> UnitInfo -> LoaderState -> IO LoaderState +loadPackage interp hsc_env pkg pls = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env @@ -1268,7 +1265,7 @@ loadPackage interp hsc_env pkg -- step to resolve everything. mapM_ (loadObj interp) objs mapM_ (loadArchive interp) archs - mapM_ (loadBytecodeLibrary interp) bytecodes + pls' <- foldM (loadBytecodeLibrary hsc_env interp) pls bytecodes maybePutStr logger "linking ... " ok <- resolveObjs interp @@ -1282,11 +1279,35 @@ loadPackage interp hsc_env pkg if succeeded ok then do maybePutStrLn logger "done." - return (hs_classifieds, extra_classifieds, loaded_dlls) + let deps = unitDepends pkg + let new_pkg = unitId pkg + let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg + | dep_pkg <- deps + , Just loaded_pkg_info <- pure (lookupUDFM (pkgs_loaded pls') dep_pkg) + ] + let new_pkg_info = LoadedPkgInfo new_pkg hs_classifieds extra_classifieds loaded_dlls trans_deps + return pls' { pkgs_loaded = addToUDFM (pkgs_loaded pls') new_pkg new_pkg_info } + --return (addToUDFM pkgs' new_pkg new_pkg_info) + -- return (hs_classifieds, extra_classifieds, loaded_dlls) else let errmsg = text "unable to load unit `" <> pprUnitInfoForUser pkg <> text "'" in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg)) + +loadBytecodeLibrary :: HscEnv -> Interp -> LoaderState -> FilePath -> IO LoaderState +loadBytecodeLibrary hsc_env interp pls path = do + path' <- canonicalizePath path -- Note [loadObj and relative paths] + -- TODO: see loadModuleLinkables in GHC/Linker/Loader.hs + -- 0. Get the modification time of the module + mod_time <- expectJust <$> modificationTimeIfExists path' + -- 1. Read the bytecode library + (BytecodeLib bcos) <- readBytecodeLib hsc_env path' + bcos' <- mapM (decodeOnDiskByteCodeObject hsc_env) bcos + linkables <- mapM (loadByteCodeObjectLinkable hsc_env mod_time Nothing) bcos' + (pls', _) <- loadModuleLinkables interp hsc_env pls linkables + return pls' + + {- Note [Crash early load_dyn and locateLib] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -155,7 +155,7 @@ data LoaderState = LoaderState -- ^ And the currently-loaded compiled modules (home package) , pkgs_loaded :: !PkgsLoaded - -- ^ The currently-loaded packages; always object code + -- ^ The currently-loaded packages; -- haskell libraries, system libraries, transitive dependencies , temp_sos :: ![(FilePath, String)] ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -41,7 +41,6 @@ module GHC.Runtime.Interpreter , loadDLL , loadArchive , loadObj - , loadBytecodeLibrary , unloadObj , addLibrarySearchPath , removeLibrarySearchPath @@ -78,6 +77,9 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) import GHC.ByteCode.Breakpoints +import GHC.ByteCode.Serialize +import GHC.Driver.Env +import GHC.Driver.ByteCode import GHC.ByteCode.Types import GHC.Linker.Types @@ -117,6 +119,7 @@ import qualified GHC.InfoProv as InfoProv import GHC.Builtin.Names import GHC.Types.Name import qualified GHC.Unit.Home.Graph as HUG +import GHC.Utils.Misc -- Standard libraries import GHC.Exts @@ -573,10 +576,6 @@ loadArchive interp path = do path' <- canonicalizePath path -- Note [loadObj and relative paths] interpCmd interp (LoadArchive path') -loadBytecodeLibrary :: Interp -> String -> IO () -loadBytecodeLibrary interp path = do - path' <- canonicalizePath path -- Note [loadObj and relative paths] - putStrLn $ "I would load bytecode library but I'm not implemented yet" ++ path' loadObj :: Interp -> String -> IO () loadObj interp path = do ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -781,16 +781,16 @@ mkBytecodePath fopts basename mod_basename = bytecode_basename <.> bytecodesuf mkStubPaths :: FinderOpts -> ModuleName - -> ModLocation -> Maybe OsPath -mkStubPaths fopts mod location = do + -> Maybe OsPath +mkStubPaths fopts mod hs_file_location = do stub_basename <- in_stub_dir <|> src_basename pure (stub_basename `mappend` os "_stub" <.> os "h") where in_stub_dir = ( mod_basename) <$> (finder_stubDir fopts) mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod - src_basename = OsPath.dropExtension <$> ml_hs_file_ospath location + src_basename = OsPath.dropExtension <$> hs_file_location -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -86,6 +86,7 @@ data Message a where LookupClosure :: String -> Message (Maybe HValueRef) LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL)) LoadArchive :: String -> Message () -- error? + LoadBytecode :: String -> Message () LoadObj :: String -> Message () -- error? UnloadObj :: String -> Message () -- error? AddLibrarySearchPath :: String -> Message (RemotePtr ()) @@ -593,6 +594,7 @@ getMessage = do 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) 40 -> Msg <$> (WhereFrom <$> get) + 41 -> Msg <$> (LoadBytecode <$> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put ===================================== testsuite/tests/cabal/Bytecode.hs ===================================== @@ -1,3 +1,3 @@ module Bytecode where -bytecode = "bytecode" +bytecode = "bytecode from a package" ===================================== testsuite/tests/cabal/Makefile ===================================== @@ -300,9 +300,8 @@ PKGCONF08=bytecode.package.conf LOCAL_GHC_PKG08 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF08) pkg_bytecode : $(LOCAL_GHC_PKG08) init $(PKGCONF08) - @echo "bytecode-library-dirs: \$${pkgroot}" >> bytecode.pkg - @echo "import-dirs: \$${pkgroot}" >> bytecode.pkg - @echo "library-dirs: \$${pkgroot}" >> bytecode.pkg + mkdir outdir + mv Bytecode.hs outdir/ + cd outdir && $(TEST_HC) -bytecodelib -hisuf=dyn_hi -dynamic -o testpkg-1.2.3.4-XXX.bytecode Bytecode.hs -fbyte-code -fwrite-interface -fwrite-byte-code -this-unit-id=testpkg-1.2.3.4-XXX $(LOCAL_GHC_PKG08) register --force bytecode.pkg - $(TEST_HC) -bytecodelib -o testpkg-1.2.3.4-XXX.bytecode Bytecode.hs -fbyte-code -fwrite-interface -fwrite-byte-code - $(TEST_HC) --interactive -package testpkg -package-db $(PKGCONF08) + cat bytecode.script | $(TEST_HC) --interactive -package testpkg -package-db $(PKGCONF08) ===================================== testsuite/tests/cabal/all.T ===================================== @@ -35,7 +35,7 @@ test('ghcpkg06', [extra_files(['test.pkg', 'testdup.pkg'])], makefile_test, []) test('ghcpkg07', [extra_files(['test.pkg', 'test7a.pkg', 'test7b.pkg'])], makefile_test, []) -test('pkg_bytecode', [extra_files(['bytecode.pkg', 'Bytecode.hs']), copy_files], makefile_test, []) +test('pkg_bytecode', [extra_files(['bytecode.pkg', 'Bytecode.hs', "bytecode.script"]), copy_files], makefile_test, []) # Test that we *can* compile a module that also belongs to a package # (this was disallowed in GHC 6.4 and earlier) ===================================== testsuite/tests/cabal/bytecode.pkg ===================================== @@ -13,7 +13,8 @@ category: none author: simonmar@microsoft.com exposed: True exposed-modules: Bytecode -import-dirs: -library-dirs: +import-dirs: ${pkgroot}/outdir +library-dirs: ${pkgroot}/outdir include-dirs: +bytecode-library-dirs: ${pkgroot}/outdir hs-libraries: testpkg-1.2.3.4-XXX ===================================== testsuite/tests/cabal/bytecode.script ===================================== @@ -0,0 +1,2 @@ +import Bytecode +bytecode ===================================== testsuite/tests/cabal/pkg_bytecode.stderr ===================================== @@ -1,6 +1,6 @@ -testpkg-1.2.3.4: cannot find any of ["Bytecode.hi","Bytecode.p_hi","Bytecode.dyn_hi","Bytecode.p_dyn_hi"] (ignoring) testpkg-1.2.3.4: cannot find any of ["libtestpkg-1.2.3.4-XXX.a","libtestpkg-1.2.3.4-XXX_p.a","libtestpkg-1.2.3.4-XXX-ghc9.15.20250811.so","libtestpkg-1.2.3.4-XXX_p-ghc9.15.20250811.so","libtestpkg-1.2.3.4-XXX-ghc9.15.20250811.dylib","libtestpkg-1.2.3.4-XXX_p-ghc9.15.20250811.dylib","testpkg-1.2.3.4-XXX-ghc9.15.20250811.dll","testpkg-1.2.3.4-XXX_p-ghc9.15.20250811.dll"] on library path (ignoring) -hs_classifieds [BytecodeLibrary ./testpkg-1.2.3.4-XXX.bytecode] +hs_classifieds + [BytecodeLibrary ./outdir/testpkg-1.2.3.4-XXX.bytecode] hs_classifieds [DLLPath /home/matt/ghc-bytecode/_new/stage1/lib/../lib/x86_64-linux-ghc-9.15.20250811/libHSghc-internal-9.1500.0-inplace-ghc9.15.20250811.so] hs_classifieds ===================================== testsuite/tests/cabal/pkg_bytecode.stdout ===================================== @@ -1,6 +1,6 @@ -Reading package info from "bytecode.pkg" ... done. [1 of 2] Compiling Bytecode ( Bytecode.hs, interpreted ) [2 of 2] Linking testpkg-1.2.3.4-XXX.bytecode +Reading package info from "bytecode.pkg" ... done. GHCi, version 9.15.20250811: https://www.haskell.org/ghc/ :? for help -I would load bytecode library but I'm not implemented yet/tmp/nix-shell-4063774-0/ghctest-8522p1jo/test spaces/testsuite/tests/cabal/pkg_bytecode.run/testpkg-1.2.3.4-XXX.bytecode +ghci> ghci> "bytecode from a package" ghci> Leaving GHCi. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b973a9ada4b427b688fde4d2a4f1e7... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b973a9ada4b427b688fde4d2a4f1e7... You're receiving this email because of your account on gitlab.haskell.org.