Matthew Pickering pushed to branch wip/bytecode-library at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Driver/Errors/Ppr.hs
    ... ... @@ -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

  • compiler/GHC/Driver/Errors/Types.hs
    ... ... @@ -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 =
    

  • compiler/GHC/Driver/Make.hs
    ... ... @@ -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 ()
    

  • compiler/GHC/Driver/Pipeline.hs
    ... ... @@ -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
    

  • compiler/GHC/Linker/ByteCode.hs
    ... ... @@ -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 $
    

  • compiler/GHC/Types/Error/Codes.hs
    ... ... @@ -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
    

  • docs/users_guide/phases.rst
    ... ... @@ -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
    

  • testsuite/tests/driver/bytecode-object/Makefile
    ... ... @@ -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: