Matthew Pickering pushed to branch wip/bytecode-library at Glasgow Haskell Compiler / GHC Commits: 3ea99c4b by Matthew Pickering at 2025-10-06T15:37:25+01:00 Fix recompilation checking - - - - - b56d46c6 by Matthew Pickering at 2025-10-06T16:19:27+01:00 proper error message - - - - - 4663c4e1 by Matthew Pickering at 2025-10-07T09:39:50+01:00 Add bytecodelib docs - - - - - 8 changed files: - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Linker/ByteCode.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/phases.rst - testsuite/tests/driver/bytecode-object/Makefile Changes: ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -282,6 +282,10 @@ instance Diagnostic DriverMessage where ++ " and " ++ llvmVersionStr supportedLlvmVersionUpperBound ++ ") and reinstall GHC to ensure -fllvm works") + DriverMissingLinkableForModule mods + -> mkSimpleDecorated $ + vcat [ text "The following modules are missing a linkable which is needed for creating a library:" + , nest 2 $ hcat (map ppr mods) ] diagnosticReason = \case DriverUnknownMessage m @@ -353,6 +357,8 @@ instance Diagnostic DriverMessage where -> ErrorWithoutFlag DriverNoConfiguredLLVMToolchain -> WarningWithoutFlag + DriverMissingLinkableForModule {} + -> ErrorWithoutFlag diagnosticHints = \case DriverUnknownMessage m @@ -426,5 +432,7 @@ instance Diagnostic DriverMessage where -> noHints DriverNoConfiguredLLVMToolchain -> noHints + DriverMissingLinkableForModule {} + -> noHints diagnosticCode = constructorCode @GHC ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -412,6 +412,17 @@ data DriverMessage where -} DriverNoConfiguredLLVMToolchain :: DriverMessage + {- | + DriverMissingLinkableForModule is an error that occurs if a module is missing a linkable + which is needed for creating a library. + + + Test cases: bytecode-object22 + + -} + + DriverMissingLinkableForModule :: ![Module] -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1840,19 +1840,20 @@ Also closely related are -} executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM () -executeLinkNode hug kn uid deps = do +executeLinkNode hug kn@(k, _) uid deps = do withCurrentUnit uid $ do - MakeEnv{..} <- ask + make_env@MakeEnv{..} <- ask let dflags = hsc_dflags hsc_env - let hsc_env' = setHUG hug hsc_env msg' = (\messager -> \recomp -> messager hsc_env kn recomp (LinkNode deps uid)) <$> env_messager - linkresult <- liftIO $ withAbstractSem compile_sem $ do - link (ghcLink dflags) - hsc_env' - True -- We already decided to link - msg' - (hsc_HPT hsc_env') + linkresult <- lift $ MaybeT $ withAbstractSem compile_sem $ withLoggerHsc k make_env $ \lcl_hsc_env -> do + let hsc_env' = setHUG hug lcl_hsc_env + wrapAction diag_wrapper hsc_env' $ do + link (ghcLink dflags) + hsc_env' + True -- We already decided to link + msg' + (hsc_HPT hsc_env') case linkresult of Failed -> fail "Link Failed" Succeeded -> return () ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Driver.Pipeline ( compileForeign, compileEmptyStub, -- * Linking - link, linkingNeeded, checkLinkInfo, + link, checkLinkInfo, -- * PipeEnv PipeEnv(..), mkPipeEnv, phaseOutputFilenameNew, @@ -424,22 +424,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 = [ cbc | cbc <- linkableByteCodeObjects l ] - let linkObjectLinkable action = - checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink homeMod_object $ \linkables -> + checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink (checkNativeLibraryLinkingNeeded staticLink) homeMod_object $ \linkables -> let obj_files = concatMap linkableObjs linkables in action obj_files linkBytecodeLinkable action = - checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink homeMod_bytecode $ \linkables -> - let bytecode = concatMap hackyMPtodo linkables + checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeMod_bytecode $ \linkables -> + let bytecode = concatMap linkableByteCodeObjects linkables in action bytecode -- Don't showPass in Batch mode; doLink will do that for us. @@ -465,38 +456,31 @@ link' hsc_env batch_attempt_linking mHscMessager hpt -- | Check that the relevant linkables are up-to-date and then apply the given action -- to them. -checkLinkablesUpToDate :: Foldable t => HscEnv - -> t (RecompileRequired -> IO b) +checkLinkablesUpToDate :: HscEnv + -> Maybe (RecompileRequired -> IO b) -> [HomeModInfo] -> [UnitId] -> Bool + -> (Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired) -> (HomeModLinkable -> Maybe Linkable) -> ([Linkable] -> IO ()) -> IO () -checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink linkable_selector action = do +checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink linkingNeeded linkable_selector action = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env unit_env = hsc_unit_env hsc_env - let -- The .o files for the home modules - -- obj_files = concat (mapMaybe (fmap linkableObjs . homeMod_object) linkables) - - -- The .gbc files for the home modules - -- bytecode = concat (mapMaybe (fmap hackyMPtodo . homeMod_bytecode) linkables) - - - - platform = targetPlatform dflags + let platform = targetPlatform dflags arch_os = platformArchOS platform exe_file = exeFileName arch_os staticLink (outputFile_ dflags) -- 1. Check that all modules have a linkable let linkables = checkAllModulesHaveLinkable linkable_selector home_mods case linkables of - -- MP: Use a proper error when not all modules have a linkable - Left missing -> pprPanic "checkLinkablesUpToDate: todo, need proper error" (ppr missing) + Left missing -> throwOneError $ fmap GhcDriverMessage $ + mkPlainErrorMsgEnvelope noSrcSpan $ DriverMissingLinkableForModule missing Right linkables -> do -- 2. Check that the linkables are up to date - linking_needed <- linkingNeeded logger dflags unit_env staticLink linkables pkg_deps + linking_needed <- linkingNeeded logger dflags unit_env linkables pkg_deps forM_ mHscMessager $ \hscMessage -> hscMessage linking_needed if not (gopt Opt_ForceRecomp dflags) && (linking_needed == UpToDate) then debugTraceMsg logger 2 (text exe_file <+> text "is up to date, linking not required.") @@ -535,8 +519,25 @@ linkJSBinary logger tmpfs fc dflags unit_env obj_files pkg_deps = do let cfg = initStgToJSConfig dflags jsLinkBinary fc lc_cfg cfg logger tmpfs dflags unit_env obj_files pkg_deps -linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO RecompileRequired -linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do +-- | Bytecode libraries are simpler to check for linking needed since they do not +-- depend on any other libraries. +checkBytecodeLibraryLinkingNeeded :: Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired +checkBytecodeLibraryLinkingNeeded _logger dflags unit_env linkables _pkg_deps = do + let platform = ue_platform unit_env + arch_os = platformArchOS platform + exe_file = exeFileName arch_os False (outputFile_ dflags) + + e_bytecode_lib_time <- modificationTimeIfExists exe_file + case e_bytecode_lib_time of + Nothing -> return $ NeedsRecompile MustCompile + Just t -> do + let bytecode_times = map linkableTime linkables + if any (t <) bytecode_times + then return $ needsRecompileBecause ObjectsChanged + else return UpToDate + +checkNativeLibraryLinkingNeeded :: Bool -> Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired +checkNativeLibraryLinkingNeeded staticLink logger dflags unit_env linkables pkg_deps = do -- if the modification time on the executable is later than the -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). @@ -544,10 +545,10 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do unit_state = ue_homeUnitState unit_env arch_os = platformArchOS platform exe_file = exeFileName arch_os staticLink (outputFile_ dflags) - e_exe_time <- tryIO $ getModificationUTCTime exe_file + e_exe_time <- modificationTimeIfExists exe_file case e_exe_time of - Left _ -> return $ NeedsRecompile MustCompile - Right t -> do + Nothing -> return $ NeedsRecompile MustCompile + Just t -> do -- first check object files and extra_ld_inputs let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ] (errs,extra_times) <- partitionWithM (tryIO . getModificationUTCTime) extra_ld_inputs ===================================== compiler/GHC/Linker/ByteCode.hs ===================================== @@ -15,7 +15,6 @@ linkBytecodeLib hsc_env gbcs = do -- The .gbc files from the command line let bytecodeObjects = [f | FileOption _ f <- ldInputs dflags] - -- INSERT_YOUR_CODE let logger = hsc_logger hsc_env let allFiles = (map text bytecodeObjects) ++ [ angleBrackets (text "in-memory" <+> ppr (bco_module bco)) | bco <- gbcs ] debugTraceMsg logger 2 $ ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -405,6 +405,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DriverModuleGraphCycle" = 92213 GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284 GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599 + GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338 -- Constraint solver diagnostic codes GhcDiagnosticCode "BadTelescope" = 97739 ===================================== docs/users_guide/phases.rst ===================================== @@ -1048,6 +1048,20 @@ for example). when linking against this package. See :ref:`shared object name mangling <building-packages>` for details. +.. ghc-flag:: -bytecodelib + :shortdesc: Generate a bytecode library + :type: dynamic + :category: linking + + Generate a bytecode library. A bytecode library is a collection of bytecode + artifacts. + + This unit can be used to package bytecode together for a library. + + + + + .. ghc-flag:: -dynload :shortdesc: Selects one of a number of modes for finding shared libraries at runtime. :type: dynamic ===================================== testsuite/tests/driver/bytecode-object/Makefile ===================================== @@ -134,7 +134,7 @@ bytecode_object20: # Test that -bytecodelib without -fbyte-code results in an error bytecode_object21: - "$(TEST_HC)" $(TEST_HC_OPTS) --make -bytecodelib -o pkg.bytecode BytecodeTest.hs + ! "$(TEST_HC)" $(TEST_HC_OPTS) --make -bytecodelib -o pkg.bytecode BytecodeTest.hs # Test that you can link together .gbc files with -c and -bytecodelib bytecode_object22: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d26339f51f016174c834e9bb3a3feb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d26339f51f016174c834e9bb3a3feb... You're receiving this email because of your account on gitlab.haskell.org.