[Git][ghc/ghc][wip/jsem] 3 commits: hadrian fixes
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Thu Sep 29 17:29:15 UTC 2022
Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC
Commits:
48565020 by Matthew Pickering at 2022-09-29T18:18:35+01:00
hadrian fixes
- - - - -
bd2afc2f by Matthew Pickering at 2022-09-29T18:20:41+01:00
Fix par logging
- - - - -
adc4d2b7 by Matthew Pickering at 2022-09-29T18:20:52+01:00
remove hadrian trace
- - - - -
5 changed files:
- compiler/GHC/Driver/Make.hs
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Library.hs
Changes:
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -2837,18 +2837,18 @@ runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do
let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger }
- withParLog log_queue_queue_var (-1) $ \ modify_logger -> do
- let sem_logger = modify_logger $ hsc_logger thread_safe_hsc_env
- runWorkerLimit worker_limit sem_logger $ \abstract_sem -> do
- let env = MakeEnv { hsc_env = thread_safe_hsc_env
- , withLogger = withParLog log_queue_queue_var
- , compile_sem = abstract_sem
- , env_messager = mHscMessager
- }
- -- Reset the number of capabilities once the upsweep ends.
- runAllPipelines worker_limit env all_pipelines
- atomically $ writeTVar stopped_var True
- wait_log_thread
+
+-- let sem_logger = modify_logger $ hsc_logger thread_safe_hsc_env
+ runWorkerLimit worker_limit (hsc_logger thread_safe_hsc_env) $ \abstract_sem -> do
+ let env = MakeEnv { hsc_env = thread_safe_hsc_env
+ , withLogger = withParLog log_queue_queue_var
+ , compile_sem = abstract_sem
+ , env_messager = mHscMessager
+ }
+ -- Reset the number of capabilities once the upsweep ends.
+ runAllPipelines worker_limit env all_pipelines
+ atomically $ writeTVar stopped_var True
+ wait_log_thread
withLocalTmpFS :: RunMakeM a -> RunMakeM a
withLocalTmpFS act = do
=====================================
hadrian/hadrian.cabal
=====================================
@@ -165,6 +165,7 @@ executable hadrian
, unordered-containers >= 0.2.1 && < 0.3
, text >= 1.2 && < 3
, time
+ , unix
if os(windows)
build-depends: Win32
=====================================
hadrian/src/Context.hs
=====================================
@@ -9,7 +9,7 @@ module Context (
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
pkgLibraryFile, pkgGhciLibraryFile,
- pkgConfFile, pkgStampFile, objectPath, contextPath, getContextPath, libPath, distDir,
+ pkgConfFile, pkgStampFile, pkgStamp2File, objectPath, contextPath, getContextPath, libPath, distDir,
haddockStatsFilesDir
) where
@@ -148,6 +148,12 @@ pkgStampFile c at Context{..} = do
let extension = waySuffix way
pkgFile c "stamp-" extension
+pkgStamp2File :: Context -> Action FilePath
+pkgStamp2File c at Context{..} = do
+ let extension = waySuffix way
+ pkgFile c "stamp2-" extension
+
+
-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its object file. For example:
-- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -215,7 +215,7 @@ compileHsObjectAndHi rs objpath = do
where
compileWithMake ctx = do
-- Need the stamp file, which triggers a rebuild via make
- stamp <- pkgStampFile ctx
+ stamp <- pkgStamp2File ctx
let way = C.way ctx
lib_ways <- interpretInContext ctx getLibraryWays
-- In this situation -dynamic-too will produce both ways
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -30,6 +30,7 @@ libraryRules = do
root -/- "**/libHS*-*.dll" %> buildDynamicLib root "dll"
root -/- "**/*.a" %> buildStaticLib root
root -/- "**/stamp-*" %> buildPackage root
+ root -/- "**/stamp2-*" %> buildHsObjs root
priority 2 $ do
root -/- "stage*/lib/**/libHS*-*.dylib" %> registerDynamicLib root "dylib"
root -/- "stage*/lib/**/libHS*-*.so" %> registerDynamicLib root "so"
@@ -61,6 +62,25 @@ buildPackage root fp = do
lib_targets <- libraryTargets True ctx
+ need (srcs ++ gens ++ lib_targets)
+ time <- liftIO $ getCurrentTime
+ liftIO $ writeFile fp (show time)
+ ways <- interpretInContext ctx getLibraryWays
+ let hasVanilla = elem vanilla ways
+ hasDynamic = elem dynamic ways
+ support <- platformSupportsSharedLibs
+ when ((hasVanilla && hasDynamic) &&
+ support && way == vanilla) $ do
+ stamp <- (pkgStampFile (ctx { way = dynamic }))
+ liftIO $ writeFile stamp (show time)
+
+buildHsObjs :: FilePath -> FilePath -> Action ()
+buildHsObjs root fp = do
+ l@(BuildPath _ stage _ (PkgStamp _ _ way)) <- parsePath (parseStampPath2 root) "<.stamp parser>" fp
+ let ctx = stampContext l
+ srcs <- hsSources ctx
+ gens <- interpretInContext ctx generatedDependencies
+
-- Write the current time into the file so the file always changes if
-- we restamp it because a dependency changes.
@@ -71,13 +91,8 @@ buildPackage root fp = do
deps <- sequence [ pkgConfFile (ctx { package = pkg })
| pkg <- depPkgs, pkg `elem` stagePkgs ]
need deps
- let needs
- | isStage0 stage
- = srcs ++ gens ++ lib_targets
- | otherwise
- = srcs ++ gens
- need needs
- unless (null srcs || isStage0 stage) $ do
+ need (srcs ++ gens)
+ unless (null srcs) $ do
build $ target ctx (Ghc (CompileHs GhcMake) stage) srcs []
time <- liftIO $ getCurrentTime
liftIO $ writeFile fp (show time)
@@ -87,7 +102,7 @@ buildPackage root fp = do
support <- platformSupportsSharedLibs
when ((hasVanilla && hasDynamic) &&
support && way == vanilla) $ do
- stamp <- (pkgStampFile (ctx { way = dynamic }))
+ stamp <- (pkgStamp2File (ctx { way = dynamic }))
liftIO $ writeFile stamp (show time)
@@ -303,6 +318,9 @@ parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
parseStampPath :: FilePath -> Parsec.Parsec String () (BuildPath PkgStamp)
parseStampPath root = parseBuildPath root parseStamp
+parseStampPath2 :: FilePath -> Parsec.Parsec String () (BuildPath PkgStamp)
+parseStampPath2 root = parseBuildPath root parseStamp2
+
-- | Parse a path to a dynamic library to be built, making sure the path starts
-- with the given build root.
parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
@@ -351,3 +369,10 @@ parseStamp = do
(pkgname, pkgver) <- parsePkgId
way <- parseWaySuffix vanilla
return (PkgStamp pkgname pkgver way)
+
+parseStamp2 :: Parsec.Parsec String () PkgStamp
+parseStamp2 = do
+ _ <- Parsec.string "stamp2-"
+ (pkgname, pkgver) <- parsePkgId
+ way <- parseWaySuffix vanilla
+ return (PkgStamp pkgname pkgver way)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9644da47cd44eaeadb97ac0ba6ad8ae99e201983...adc4d2b702c370868a82141ad0d6e9367e66f0bb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9644da47cd44eaeadb97ac0ba6ad8ae99e201983...adc4d2b702c370868a82141ad0d6e9367e66f0bb
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220929/d36f092e/attachment-0001.html>
More information about the ghc-commits
mailing list