diff options
| -rw-r--r-- | hadrian/src/Packages.hs | 12 | ||||
| -rw-r--r-- | hadrian/src/Rules/Libffi.hs | 121 | ||||
| -rw-r--r-- | hadrian/src/Rules/Library.hs | 9 | ||||
| -rw-r--r-- | hadrian/src/Rules/Program.hs | 20 | ||||
| -rw-r--r-- | hadrian/src/Rules/Test.hs | 6 | ||||
| -rwxr-xr-x | hadrian/src/Settings.hs | 11 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/Configure.hs | 6 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/Ghc.hs | 43 | ||||
| m--------- | libraries/Cabal | 0 |
9 files changed, 164 insertions, 64 deletions
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs index 8d2aef1c7b..75a74b2ae6 100644 --- a/hadrian/src/Packages.hs +++ b/hadrian/src/Packages.hs @@ -12,7 +12,7 @@ module Packages ( -- * Package information programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, - rtsContext, rtsBuildPath, libffiContext, libffiBuildPath, libffiLibraryName, + rtsContext, rtsBuildPath, libffiBuildPath, libffiLibraryName, generatedGhcDependencies, ensureConfigured ) where @@ -200,14 +200,12 @@ rtsContext stage = vanillaContext stage rts rtsBuildPath :: Stage -> Action FilePath rtsBuildPath stage = buildPath (rtsContext stage) --- | Build directory for @libffi@. This probably doesn't need to be stage --- dependent but it is for consistency for now. -libffiContext :: Stage -> Context -libffiContext stage = vanillaContext stage libffi - -- | Build directory for in-tree 'libffi' library. libffiBuildPath :: Stage -> Action FilePath -libffiBuildPath stage = buildPath (libffiContext stage) +libffiBuildPath stage = buildPath $ Context + stage + libffi + (error "libffiBuildPath: way not set.") -- | Name of the 'libffi' library. libffiLibraryName :: Action FilePath diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs index 1fe6174b1e..64f63039eb 100644 --- a/hadrian/src/Rules/Libffi.hs +++ b/hadrian/src/Rules/Libffi.hs @@ -1,4 +1,4 @@ -module Rules.Libffi (libffiRules, libffiDependencies) where +module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where import Hadrian.Utilities @@ -7,6 +7,50 @@ import Settings.Builders.Common import Target import Utilities +{- +Note [Hadrian: install libffi hack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are 2 important steps in handling libffi's .a and .so files: + + 1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir + to the rts build dir. This is because libffi is ultimately bundled with the + rts package. Relevant code is in the libffiRules function. + 2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs + copyPackage action. This uses the "cabal copy" command which (among other + things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the + rts build dir to the install dir. + +There is an issue in step 1. that the name of the shared library files is not +know untill after libffi is built. As a workaround, the rts package needs just +the libffiDependencies, and the corresponding rule (defined below in +libffiRules) does the extra work of installing the shared library files into the +rts build directory after building libffi. +-} + +-- | Context for @libffi@. +libffiContext :: Stage -> Action Context +libffiContext stage = do + ways <- interpretInContext + (Context stage libffi (error "libffiContext: way not set")) + getLibraryWays + return . Context stage libffi $ if any (wayUnit Dynamic) ways + then dynamic + else vanilla + +-- | The name of the (locally built) library +libffiName :: Expr String +libffiName = do + windows <- expr windowsHost + way <- getWay + return $ libffiName' windows (Dynamic `wayUnit` way) + +-- | The name of the (locally built) library +libffiName' :: Bool -> Bool -> String +libffiName' windows dynamic + = (if dynamic then "" else "C") + ++ (if windows then "ffi-6" else "ffi") + libffiDependencies :: [FilePath] libffiDependencies = ["ffi.h", "ffitarget.h"] @@ -29,10 +73,11 @@ fixLibffiMakefile top = -- TODO: check code duplication w.r.t. ConfCcArgs configureEnvironment :: Stage -> Action [CmdOption] configureEnvironment stage = do - cFlags <- interpretInContext (libffiContext stage) $ mconcat + context <- libffiContext stage + cFlags <- interpretInContext context $ mconcat [ cArgs , getStagedSettingList ConfCcArgs ] - ldFlags <- interpretInContext (libffiContext stage) ldArgs + ldFlags <- interpretInContext context ldArgs sequence [ builderEnvironment "CC" $ Cc CompileC stage , builderEnvironment "CXX" $ Cc CompileC stage , builderEnvironment "LD" (Ld stage) @@ -52,7 +97,10 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do -- We set a higher priority because this rule overlaps with the build rule -- for static libraries 'Rules.Library.libraryRules'. - priority 2.0 $ libffiOuts &%> \(out : _) -> do + -- See [Hadrian: install libffi hack], this rule installs libffi into the + -- rts build path. + priority 2.0 $ libffiOuts &%> \_ -> do + context <- libffiContext stage useSystemFfi <- flag UseSystemFfi rtsPath <- rtsBuildPath stage if useSystemFfi @@ -63,25 +111,65 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do copyFile (ffiIncludeDir -/- file) (rtsPath -/- file) putSuccess "| Successfully copied system FFI library header files" else do - build $ target (libffiContext stage) (Make libffiPath) [] [] + build $ target context (Make libffiPath) [] [] -- Here we produce 'libffiDependencies' - hs <- liftIO $ getDirectoryFilesIO "" [libffiPath -/- "inst/include/*"] - forM_ hs $ \header -> do + headers <- liftIO $ getDirectoryFilesIO "" [libffiPath -/- "inst/include/*"] + forM_ headers $ \header -> do let target = rtsPath -/- takeFileName header copyFileUntracked header target produces [target] - ways <- interpretInContext (libffiContext stage) + -- Find ways. + ways <- interpretInContext context (getLibraryWays <> getRtsWays) - forM_ (nubOrd ways) $ \way -> do + let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways + + -- Install static libraries. + forM_ staticWays $ \way -> do rtsLib <- rtsLibffiLibrary stage way - copyFileUntracked out rtsLib + copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib produces [rtsLib] - putSuccess "| Successfully built custom library 'libffi'" + -- Install dynamic libraries. + when (not $ null dynamicWays) $ do + -- Find dynamic libraries. + windows <- windowsHost + osx <- osxHost + let libffiName'' = libffiName' windows True + (dynLibsSrcDir, dynLibFiles) <- if windows + then do + let libffiDll = "lib" ++ libffiName'' ++ ".dll" + return (libffiPath -/- "inst/bin", [libffiDll]) + else do + let libffiLibPath = libffiPath -/- "inst/lib" + dynLibsRelative <- liftIO $ getDirectoryFilesIO + libffiLibPath + (if osx + then ["lib" ++ libffiName'' ++ ".dylib*"] + else ["lib" ++ libffiName'' ++ ".so*"]) + return (libffiLibPath, dynLibsRelative) + + -- Install dynamic libraries. + rtsPath <- rtsBuildPath stage + forM_ dynLibFiles $ \dynLibFile -> do + let target = rtsPath -/- dynLibFile + copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target + + -- On OSX the dylib's id must be updated to a relative path. + when osx $ cmd + [ "install_name_tool" + , "-id", "@rpath/" ++ dynLibFile + , target + ] + + produces [target] + + putSuccess "| Successfully bundled custom library 'libffi' with rts" fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do + -- Extract libffi tar file + context <- libffiContext stage removeDirectory libffiPath tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"] @@ -90,11 +178,11 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999' let libname = takeWhile (/= '+') $ takeFileName tarball + -- Move extracted directory to libffiPath. root <- buildRoot removeDirectory (root -/- libname) - -- TODO: Simplify. actionFinally (do - build $ target (libffiContext stage) (Tar Extract) [tarball] [path] + build $ target context (Tar Extract) [tarball] [path] moveDirectory (path -/- libname) libffiPath) $ -- And finally: removeFiles (path) [libname <//> "*"] @@ -106,12 +194,17 @@ libffiRules = forM_ [Stage1 ..] $ \stage -> do produces files fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do + context <- libffiContext stage + + -- This need rule extracts the libffi tar file to libffiPath. need [mk <.> "in"] + + -- Configure. forM_ ["config.guess", "config.sub"] $ \file -> do copyFile file (libffiPath -/- file) env <- configureEnvironment stage buildWithCmdOptions env $ - target (libffiContext stage) (Configure libffiPath) [mk <.> "in"] [mk] + target context (Configure libffiPath) [mk <.> "in"] [mk] dir <- setting BuildPlatform files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir <//> "*"] diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs index 8bd7067202..d19907bfa9 100644 --- a/hadrian/src/Rules/Library.hs +++ b/hadrian/src/Rules/Library.hs @@ -13,6 +13,7 @@ import Flavour import Oracles.ModuleFiles import Packages import Rules.Gmp +import Rules.Libffi (libffiDependencies) import Settings import Target import Utilities @@ -57,6 +58,14 @@ buildDynamicLibUnix root suffix dynlibpath = do let context = libDynContext dynlib deps <- contextDependencies context need =<< mapM pkgLibraryFile deps + + -- TODO should this be somewhere else? + -- Custom build step to generate libffi.so* in the rts build directory. + when (package context == rts) . interpretInContext context $ do + stage <- getStage + rtsPath <- expr (rtsBuildPath stage) + expr $ need ((rtsPath -/-) <$> libffiDependencies) + objs <- libraryObjects context build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath] diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs index d7bcb48712..51bc2e9959 100644 --- a/hadrian/src/Rules/Program.hs +++ b/hadrian/src/Rules/Program.hs @@ -13,7 +13,6 @@ import Settings import Settings.Default import Target import Utilities -import Flavour -- | TODO: Drop code duplication buildProgramRules :: [(Resource, Int)] -> Rules () @@ -45,18 +44,13 @@ getProgramContexts stage = do -- make sure that we cover these -- "prof-build-under-other-name" cases. -- iserv gets its names from Packages.hs:programName - -- - profiled <- ghcProfiled <$> flavour - let allCtxs = - if pkg == ghc && profiled && stage > Stage0 - then [ Context stage pkg profiling ] - else [ vanillaContext stage pkg - , Context stage pkg profiling - -- TODO Dynamic way has been reverted as the dynamic build is - -- broken. See #15837. - -- , Context stage pkg dynamic - ] - + ctx <- programContext stage pkg -- TODO: see todo on programContext. + let allCtxs = if pkg == iserv + then [ vanillaContext stage pkg + , Context stage pkg profiling + , Context stage pkg dynamic + ] + else [ ctx ] forM allCtxs $ \ctx -> do name <- programName ctx return (name <.> exe, ctx) diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index 461a95f93a..b72c1b964b 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -113,11 +113,7 @@ needIservBins = do rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays need =<< traverse programPath [ Context Stage1 iserv w - | w <- [vanilla, profiling - -- TODO dynamic way has been reverted as the dynamic build - -- is broken. See #15837. - -- , dynamic - ] + | w <- [vanilla, profiling, dynamic] , w `elem` rtsways ] diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs index fdbef1c359..bc0f8cecaa 100755 --- a/hadrian/src/Settings.hs +++ b/hadrian/src/Settings.hs @@ -50,12 +50,17 @@ flavour = do getIntegerPackage :: Expr Package getIntegerPackage = expr (integerLibrary =<< flavour) +-- TODO: there is duplication and inconsistency between this and +-- Rules.Program.getProgramContexts. There should only be one way to get a +-- context / contexts for a given stage and package. programContext :: Stage -> Package -> Action Context programContext stage pkg = do profiled <- ghcProfiled <$> flavour - return $ if pkg == ghc && profiled && stage > Stage0 - then Context stage pkg profiling - else vanillaContext stage pkg + dynGhcProgs <- dynamicGhcPrograms =<< flavour + return . Context stage pkg . wayFromUnits . concat $ + [ [ Profiling | pkg == ghc && profiled && stage > Stage0 ] + , [ Dynamic | dynGhcProgs && stage > Stage0 ] + ] -- TODO: switch to Set Package as the order of packages should not matter? -- Otherwise we have to keep remembering to sort packages from time to time. diff --git a/hadrian/src/Settings/Builders/Configure.hs b/hadrian/src/Settings/Builders/Configure.hs index 214aed6c27..427d5da6f6 100644 --- a/hadrian/src/Settings/Builders/Configure.hs +++ b/hadrian/src/Settings/Builders/Configure.hs @@ -19,8 +19,12 @@ configureBuilderArgs = do , builder (Configure libffiPath) ? do top <- expr topDirectory targetPlatform <- getSetting TargetPlatform + way <- getWay pure [ "--prefix=" ++ top -/- libffiPath -/- "inst" , "--libdir=" ++ top -/- libffiPath -/- "inst/lib" , "--enable-static=yes" - , "--enable-shared=no" -- TODO: add support for yes + , "--enable-shared=" + ++ (if wayUnit Dynamic way + then "yes" + else "no") , "--host=" ++ targetPlatform ] ] diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs index f18832c1ef..4bc10e5edd 100644 --- a/hadrian/src/Settings/Builders/Ghc.hs +++ b/hadrian/src/Settings/Builders/Ghc.hs @@ -8,6 +8,7 @@ import Packages import Settings.Builders.Common import Settings.Warnings import qualified Context as Context +import Rules.Libffi (libffiName) ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] @@ -46,20 +47,37 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do libs <- getContextData extraLibs libDirs <- getContextData extraLibDirs fmwks <- getContextData frameworks - dynamic <- requiresDynamic darwin <- expr osxHost + way <- getWay -- Relative path from the output (rpath $ORIGIN). originPath <- dropFileName <$> getOutput context <- getContext libPath' <- expr (libPath context) distDir <- expr Context.distDir + + useSystemFfi <- expr (flag UseSystemFfi) + buildPath <- getBuildPath + libffiName' <- libffiName + let + dynamic = Dynamic `wayUnit` way distPath = libPath' -/- distDir originToLibsDir = makeRelativeNoSysLink originPath distPath rpath | darwin = "@loader_path" -/- originToLibsDir | otherwise = "$ORIGIN" -/- originToLibsDir + -- TODO: an alternative would be to generalize by linking with extra + -- bundled libraries, but currently the rts is the only use case. It is + -- a special case when `useSystemFfi == True`: the ffi library files + -- are not actually bundled with the rts. Perhaps ffi should be part of + -- rts's extra libraries instead of extra bundled libraries in that + -- case. Care should be take as to not break the make build. + rtsFfiArg = package rts ? not useSystemFfi ? mconcat + [ arg ("-L" ++ buildPath) + , arg ("-l" ++ libffiName') + ] + mconcat [ dynamic ? mconcat [ arg "-dynamic" -- TODO what about windows? @@ -70,8 +88,9 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" , not (nonHsMainPackage pkg) ? arg "-rtsopts" - , pure [ "-l" ++ lib | lib <- libs ] + , pure [ "-l" ++ lib | lib <- libs ] , pure [ "-L" ++ libDir | libDir <- libDirs ] + , rtsFfiArg , darwin ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ]) ] @@ -117,8 +136,7 @@ commonGhcArgs = do wayGhcArgs :: Args wayGhcArgs = do way <- getWay - dynamic <- requiresDynamic - mconcat [ if dynamic + mconcat [ if Dynamic `wayUnit` way then pure ["-fPIC", "-dynamic"] else arg "-static" , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS" @@ -156,20 +174,3 @@ includeGhcArgs = do , arg $ "-I" ++ root -/- generatedDir , arg $ "-optc-I" ++ root -/- generatedDir , pure ["-optP-include", "-optP" ++ cabalMacros] ] - --- Check if building dynamically is required. GHC is a special case that needs --- to be built dynamically if any of the RTS ways is dynamic. -requiresDynamic :: Expr Bool -requiresDynamic = wayUnit Dynamic <$> getWay - -- TODO This logic has been reverted as the dynamic build is broken. - -- See #15837. - -- - -- pkg <- getPackage - -- way <- getWay - -- rtsWays <- getRtsWays - -- let - -- dynRts = any (Dynamic `wayUnit`) rtsWays - -- dynWay = Dynamic `wayUnit` way - -- return $ if pkg == ghc - -- then dynRts || dynWay - -- else dynWay diff --git a/libraries/Cabal b/libraries/Cabal -Subproject 97484d8e46f3c542523ef5daf5470540a4d66cb +Subproject fd51946bbb3850165de5f7b394fa987d1f4bd28 |