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
-
b56d46c6
by Matthew Pickering at 2025-10-06T16:19:27+01:00
-
4663c4e1
by Matthew Pickering at 2025-10-07T09:39:50+01:00
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:
| ... | ... | @@ -282,6 +282,10 @@ instance Diagnostic DriverMessage where |
| 282 | 282 | ++ " and "
|
| 283 | 283 | ++ llvmVersionStr supportedLlvmVersionUpperBound
|
| 284 | 284 | ++ ") and reinstall GHC to ensure -fllvm works")
|
| 285 | + DriverMissingLinkableForModule mods
|
|
| 286 | + -> mkSimpleDecorated $
|
|
| 287 | + vcat [ text "The following modules are missing a linkable which is needed for creating a library:"
|
|
| 288 | + , nest 2 $ hcat (map ppr mods) ]
|
|
| 285 | 289 | |
| 286 | 290 | diagnosticReason = \case
|
| 287 | 291 | DriverUnknownMessage m
|
| ... | ... | @@ -353,6 +357,8 @@ instance Diagnostic DriverMessage where |
| 353 | 357 | -> ErrorWithoutFlag
|
| 354 | 358 | DriverNoConfiguredLLVMToolchain
|
| 355 | 359 | -> WarningWithoutFlag
|
| 360 | + DriverMissingLinkableForModule {}
|
|
| 361 | + -> ErrorWithoutFlag
|
|
| 356 | 362 | |
| 357 | 363 | diagnosticHints = \case
|
| 358 | 364 | DriverUnknownMessage m
|
| ... | ... | @@ -426,5 +432,7 @@ instance Diagnostic DriverMessage where |
| 426 | 432 | -> noHints
|
| 427 | 433 | DriverNoConfiguredLLVMToolchain
|
| 428 | 434 | -> noHints
|
| 435 | + DriverMissingLinkableForModule {}
|
|
| 436 | + -> noHints
|
|
| 429 | 437 | |
| 430 | 438 | diagnosticCode = constructorCode @GHC |
| ... | ... | @@ -412,6 +412,17 @@ data DriverMessage where |
| 412 | 412 | -}
|
| 413 | 413 | DriverNoConfiguredLLVMToolchain :: DriverMessage
|
| 414 | 414 | |
| 415 | + {- |
|
|
| 416 | + DriverMissingLinkableForModule is an error that occurs if a module is missing a linkable
|
|
| 417 | + which is needed for creating a library.
|
|
| 418 | + |
|
| 419 | + |
|
| 420 | + Test cases: bytecode-object22
|
|
| 421 | + |
|
| 422 | + -}
|
|
| 423 | + |
|
| 424 | + DriverMissingLinkableForModule :: ![Module] -> DriverMessage
|
|
| 425 | + |
|
| 415 | 426 | deriving instance Generic DriverMessage
|
| 416 | 427 | |
| 417 | 428 | data DriverMessageOpts =
|
| ... | ... | @@ -1840,19 +1840,20 @@ Also closely related are |
| 1840 | 1840 | -}
|
| 1841 | 1841 | |
| 1842 | 1842 | executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM ()
|
| 1843 | -executeLinkNode hug kn uid deps = do
|
|
| 1843 | +executeLinkNode hug kn@(k, _) uid deps = do
|
|
| 1844 | 1844 | withCurrentUnit uid $ do
|
| 1845 | - MakeEnv{..} <- ask
|
|
| 1845 | + make_env@MakeEnv{..} <- ask
|
|
| 1846 | 1846 | let dflags = hsc_dflags hsc_env
|
| 1847 | - let hsc_env' = setHUG hug hsc_env
|
|
| 1848 | 1847 | msg' = (\messager -> \recomp -> messager hsc_env kn recomp (LinkNode deps uid)) <$> env_messager
|
| 1849 | 1848 | |
| 1850 | - linkresult <- liftIO $ withAbstractSem compile_sem $ do
|
|
| 1851 | - link (ghcLink dflags)
|
|
| 1852 | - hsc_env'
|
|
| 1853 | - True -- We already decided to link
|
|
| 1854 | - msg'
|
|
| 1855 | - (hsc_HPT hsc_env')
|
|
| 1849 | + linkresult <- lift $ MaybeT $ withAbstractSem compile_sem $ withLoggerHsc k make_env $ \lcl_hsc_env -> do
|
|
| 1850 | + let hsc_env' = setHUG hug lcl_hsc_env
|
|
| 1851 | + wrapAction diag_wrapper hsc_env' $ do
|
|
| 1852 | + link (ghcLink dflags)
|
|
| 1853 | + hsc_env'
|
|
| 1854 | + True -- We already decided to link
|
|
| 1855 | + msg'
|
|
| 1856 | + (hsc_HPT hsc_env')
|
|
| 1856 | 1857 | case linkresult of
|
| 1857 | 1858 | Failed -> fail "Link Failed"
|
| 1858 | 1859 | Succeeded -> return ()
|
| ... | ... | @@ -22,7 +22,7 @@ module GHC.Driver.Pipeline ( |
| 22 | 22 | compileForeign, compileEmptyStub,
|
| 23 | 23 | |
| 24 | 24 | -- * Linking
|
| 25 | - link, linkingNeeded, checkLinkInfo,
|
|
| 25 | + link, checkLinkInfo,
|
|
| 26 | 26 | |
| 27 | 27 | -- * PipeEnv
|
| 28 | 28 | PipeEnv(..), mkPipeEnv, phaseOutputFilenameNew,
|
| ... | ... | @@ -424,22 +424,13 @@ link' hsc_env batch_attempt_linking mHscMessager hpt |
| 424 | 424 | return Succeeded
|
| 425 | 425 | else do
|
| 426 | 426 | |
| 427 | - -- TODO: This is very awkward.
|
|
| 428 | - |
|
| 429 | - -- 1. Ban using --make mode to create -bytecodelib, since then you would not need in-memory linkables
|
|
| 430 | - -- 2. Make Linkable and ByteCodeObject more similar, so that you can translate between them.
|
|
| 431 | - -- * Either store .o files in ByteCodeObject <-- MP thinks this way
|
|
| 432 | - -- * or Store ForeignStubs/ForeignSrcs in Linkable
|
|
| 433 | - -- 3. Store ByteCodeObject in Linkable directly
|
|
| 434 | - let hackyMPtodo l = [ cbc | cbc <- linkableByteCodeObjects l ]
|
|
| 435 | - |
|
| 436 | 427 | let linkObjectLinkable action =
|
| 437 | - checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink homeMod_object $ \linkables ->
|
|
| 428 | + checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink (checkNativeLibraryLinkingNeeded staticLink) homeMod_object $ \linkables ->
|
|
| 438 | 429 | let obj_files = concatMap linkableObjs linkables
|
| 439 | 430 | in action obj_files
|
| 440 | 431 | linkBytecodeLinkable action =
|
| 441 | - checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink homeMod_bytecode $ \linkables ->
|
|
| 442 | - let bytecode = concatMap hackyMPtodo linkables
|
|
| 432 | + checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeMod_bytecode $ \linkables ->
|
|
| 433 | + let bytecode = concatMap linkableByteCodeObjects linkables
|
|
| 443 | 434 | in action bytecode
|
| 444 | 435 | |
| 445 | 436 | -- Don't showPass in Batch mode; doLink will do that for us.
|
| ... | ... | @@ -465,38 +456,31 @@ link' hsc_env batch_attempt_linking mHscMessager hpt |
| 465 | 456 | |
| 466 | 457 | -- | Check that the relevant linkables are up-to-date and then apply the given action
|
| 467 | 458 | -- to them.
|
| 468 | -checkLinkablesUpToDate :: Foldable t => HscEnv
|
|
| 469 | - -> t (RecompileRequired -> IO b)
|
|
| 459 | +checkLinkablesUpToDate :: HscEnv
|
|
| 460 | + -> Maybe (RecompileRequired -> IO b)
|
|
| 470 | 461 | -> [HomeModInfo]
|
| 471 | 462 | -> [UnitId]
|
| 472 | 463 | -> Bool
|
| 464 | + -> (Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired)
|
|
| 473 | 465 | -> (HomeModLinkable -> Maybe Linkable)
|
| 474 | 466 | -> ([Linkable] -> IO ()) -> IO ()
|
| 475 | -checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink linkable_selector action = do
|
|
| 467 | +checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink linkingNeeded linkable_selector action = do
|
|
| 476 | 468 | |
| 477 | 469 | let dflags = hsc_dflags hsc_env
|
| 478 | 470 | logger = hsc_logger hsc_env
|
| 479 | 471 | unit_env = hsc_unit_env hsc_env
|
| 480 | - let -- The .o files for the home modules
|
|
| 481 | - -- obj_files = concat (mapMaybe (fmap linkableObjs . homeMod_object) linkables)
|
|
| 482 | - |
|
| 483 | - -- The .gbc files for the home modules
|
|
| 484 | - -- bytecode = concat (mapMaybe (fmap hackyMPtodo . homeMod_bytecode) linkables)
|
|
| 485 | - |
|
| 486 | - |
|
| 487 | - |
|
| 488 | - platform = targetPlatform dflags
|
|
| 472 | + let platform = targetPlatform dflags
|
|
| 489 | 473 | arch_os = platformArchOS platform
|
| 490 | 474 | exe_file = exeFileName arch_os staticLink (outputFile_ dflags)
|
| 491 | 475 | |
| 492 | 476 | -- 1. Check that all modules have a linkable
|
| 493 | 477 | let linkables = checkAllModulesHaveLinkable linkable_selector home_mods
|
| 494 | 478 | case linkables of
|
| 495 | - -- MP: Use a proper error when not all modules have a linkable
|
|
| 496 | - Left missing -> pprPanic "checkLinkablesUpToDate: todo, need proper error" (ppr missing)
|
|
| 479 | + Left missing -> throwOneError $ fmap GhcDriverMessage $
|
|
| 480 | + mkPlainErrorMsgEnvelope noSrcSpan $ DriverMissingLinkableForModule missing
|
|
| 497 | 481 | Right linkables -> do
|
| 498 | 482 | -- 2. Check that the linkables are up to date
|
| 499 | - linking_needed <- linkingNeeded logger dflags unit_env staticLink linkables pkg_deps
|
|
| 483 | + linking_needed <- linkingNeeded logger dflags unit_env linkables pkg_deps
|
|
| 500 | 484 | forM_ mHscMessager $ \hscMessage -> hscMessage linking_needed
|
| 501 | 485 | if not (gopt Opt_ForceRecomp dflags) && (linking_needed == UpToDate)
|
| 502 | 486 | 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 |
| 535 | 519 | let cfg = initStgToJSConfig dflags
|
| 536 | 520 | jsLinkBinary fc lc_cfg cfg logger tmpfs dflags unit_env obj_files pkg_deps
|
| 537 | 521 | |
| 538 | -linkingNeeded :: Logger -> DynFlags -> UnitEnv -> Bool -> [Linkable] -> [UnitId] -> IO RecompileRequired
|
|
| 539 | -linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
|
|
| 522 | +-- | Bytecode libraries are simpler to check for linking needed since they do not
|
|
| 523 | +-- depend on any other libraries.
|
|
| 524 | +checkBytecodeLibraryLinkingNeeded :: Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired
|
|
| 525 | +checkBytecodeLibraryLinkingNeeded _logger dflags unit_env linkables _pkg_deps = do
|
|
| 526 | + let platform = ue_platform unit_env
|
|
| 527 | + arch_os = platformArchOS platform
|
|
| 528 | + exe_file = exeFileName arch_os False (outputFile_ dflags)
|
|
| 529 | + |
|
| 530 | + e_bytecode_lib_time <- modificationTimeIfExists exe_file
|
|
| 531 | + case e_bytecode_lib_time of
|
|
| 532 | + Nothing -> return $ NeedsRecompile MustCompile
|
|
| 533 | + Just t -> do
|
|
| 534 | + let bytecode_times = map linkableTime linkables
|
|
| 535 | + if any (t <) bytecode_times
|
|
| 536 | + then return $ needsRecompileBecause ObjectsChanged
|
|
| 537 | + else return UpToDate
|
|
| 538 | + |
|
| 539 | +checkNativeLibraryLinkingNeeded :: Bool -> Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired
|
|
| 540 | +checkNativeLibraryLinkingNeeded staticLink logger dflags unit_env linkables pkg_deps = do
|
|
| 540 | 541 | -- if the modification time on the executable is later than the
|
| 541 | 542 | -- modification times on all of the objects and libraries, then omit
|
| 542 | 543 | -- linking (unless the -fforce-recomp flag was given).
|
| ... | ... | @@ -544,10 +545,10 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do |
| 544 | 545 | unit_state = ue_homeUnitState unit_env
|
| 545 | 546 | arch_os = platformArchOS platform
|
| 546 | 547 | exe_file = exeFileName arch_os staticLink (outputFile_ dflags)
|
| 547 | - e_exe_time <- tryIO $ getModificationUTCTime exe_file
|
|
| 548 | + e_exe_time <- modificationTimeIfExists exe_file
|
|
| 548 | 549 | case e_exe_time of
|
| 549 | - Left _ -> return $ NeedsRecompile MustCompile
|
|
| 550 | - Right t -> do
|
|
| 550 | + Nothing -> return $ NeedsRecompile MustCompile
|
|
| 551 | + Just t -> do
|
|
| 551 | 552 | -- first check object files and extra_ld_inputs
|
| 552 | 553 | let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
|
| 553 | 554 | (errs,extra_times) <- partitionWithM (tryIO . getModificationUTCTime) extra_ld_inputs
|
| ... | ... | @@ -15,7 +15,6 @@ linkBytecodeLib hsc_env gbcs = do |
| 15 | 15 | -- The .gbc files from the command line
|
| 16 | 16 | let bytecodeObjects = [f | FileOption _ f <- ldInputs dflags]
|
| 17 | 17 | |
| 18 | - -- INSERT_YOUR_CODE
|
|
| 19 | 18 | let logger = hsc_logger hsc_env
|
| 20 | 19 | let allFiles = (map text bytecodeObjects) ++ [ angleBrackets (text "in-memory" <+> ppr (bco_module bco)) | bco <- gbcs ]
|
| 21 | 20 | debugTraceMsg logger 2 $
|
| ... | ... | @@ -405,6 +405,7 @@ type family GhcDiagnosticCode c = n | n -> c where |
| 405 | 405 | GhcDiagnosticCode "DriverModuleGraphCycle" = 92213
|
| 406 | 406 | GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
|
| 407 | 407 | GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599
|
| 408 | + GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338
|
|
| 408 | 409 | |
| 409 | 410 | -- Constraint solver diagnostic codes
|
| 410 | 411 | GhcDiagnosticCode "BadTelescope" = 97739
|
| ... | ... | @@ -1048,6 +1048,20 @@ for example). |
| 1048 | 1048 | when linking against this package.
|
| 1049 | 1049 | See :ref:`shared object name mangling <building-packages>` for details.
|
| 1050 | 1050 | |
| 1051 | +.. ghc-flag:: -bytecodelib
|
|
| 1052 | + :shortdesc: Generate a bytecode library
|
|
| 1053 | + :type: dynamic
|
|
| 1054 | + :category: linking
|
|
| 1055 | + |
|
| 1056 | + Generate a bytecode library. A bytecode library is a collection of bytecode
|
|
| 1057 | + artifacts.
|
|
| 1058 | + |
|
| 1059 | + This unit can be used to package bytecode together for a library.
|
|
| 1060 | + |
|
| 1061 | + |
|
| 1062 | + |
|
| 1063 | + |
|
| 1064 | + |
|
| 1051 | 1065 | .. ghc-flag:: -dynload
|
| 1052 | 1066 | :shortdesc: Selects one of a number of modes for finding shared libraries at runtime.
|
| 1053 | 1067 | :type: dynamic
|
| ... | ... | @@ -134,7 +134,7 @@ bytecode_object20: |
| 134 | 134 | |
| 135 | 135 | # Test that -bytecodelib without -fbyte-code results in an error
|
| 136 | 136 | bytecode_object21:
|
| 137 | - "$(TEST_HC)" $(TEST_HC_OPTS) --make -bytecodelib -o pkg.bytecode BytecodeTest.hs
|
|
| 137 | + ! "$(TEST_HC)" $(TEST_HC_OPTS) --make -bytecodelib -o pkg.bytecode BytecodeTest.hs
|
|
| 138 | 138 | |
| 139 | 139 | # Test that you can link together .gbc files with -c and -bytecodelib
|
| 140 | 140 | bytecode_object22:
|