Fix haddock.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 29 Feb 2016 02:02:53 +0000 (02:02 +0000)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 29 Feb 2016 02:02:53 +0000 (02:02 +0000)
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Rules/Generate.hs
src/Rules/Library.hs
src/Settings/Packages/Rts.hs

index 95727e9..fee310f 100644 (file)
@@ -114,20 +114,20 @@ buildPackageData context@Context {..} = do
                     dirs   = [ ".", "hooks", "sm", "eventlog" ]
                           ++ [ "posix" | not windows ]
                           ++ [ "win32" |     windows ]
-                -- TODO: rts/dist/build/sm/Evac_thr.c, rts/dist/build/sm/Scav_thr.c
                 -- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
-                cSrcs    <- getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
-                cmmSrcs  <- getDirectoryFiles (pkgPath package) ["*.cmm"]
+                cSrcs   <- getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
+                cmmSrcs <- getDirectoryFiles (pkgPath package) ["*.cmm"]
                 buildAdjustor   <- anyTargetArch ["i386", "powerpc", "powerpc64"]
                 buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
-                let sSrcs = [ "AdjustorAsm.S" | buildAdjustor   ]
-                         ++ [ "StgCRunAsm.S"  | buildStgCRunAsm ]
-                    extraSrcs = [ rtsBuildPath -/- "AutoApply.cmm" ]
+                let extraSrcs = [ "AdjustorAsm.S" | buildAdjustor   ]
+                             ++ [ "StgCRunAsm.S"  | buildStgCRunAsm ]
+                             ++ [ rtsBuildPath -/- "AutoApply.cmm"  ]
+                             ++ [ rtsBuildPath -/- "sm/Evac_thr.c"  ]
+                             ++ [ rtsBuildPath -/- "sm/Scav_thr.c"  ]
                 includes <- interpretInContext context $ fromDiffExpr includesArgs
                 let contents = unlines $ map (prefix++)
-                        [ "C_SRCS = "
-                          ++ unwords (cSrcs ++ cmmSrcs ++ sSrcs ++ extraSrcs)
-                        , "CC_OPTS = "  ++ unwords includes
+                        [ "C_SRCS = "  ++ unwords (cSrcs ++ cmmSrcs ++ extraSrcs)
+                        , "CC_OPTS = " ++ unwords includes
                         , "COMPONENT_ID = rts" ]
                 writeFileChanged mk contents
                 putSuccess $ "| Successfully generated '" ++ mk ++ "'."
index 99312f5..87df53b 100644 (file)
@@ -11,20 +11,16 @@ import Rules.Actions
 import Settings
 import Target
 
--- TODO: simplify handling of AutoApply.cmm
 buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
 buildPackageDependencies rs context@Context {..} =
     let path     = buildPath context
-        dropPath = (pkgPath package ++) . drop (length path)
         hDepFile = path -/- ".hs-dependencies"
     in do
         fmap (path ++)
             [ "//*.c.deps", "//*.cmm.deps", "//*.S.deps" ] |%> \out -> do
-                let srcFile = if "//AutoApply.*" ?== out
-                              then dropExtension out
-                              else dropPath . dropExtension $ out
-                need [srcFile]
-                build $ Target context (GccM stage) [srcFile] [out]
+                let src = dep2src context out
+                need [src]
+                build $ Target context (GccM stage) [src] [out]
 
         hDepFile %> \out -> do
             srcs <- haskellSources context
@@ -37,10 +33,7 @@ buildPackageDependencies rs context@Context {..} =
         -- TODO: don't accumulate *.deps into .dependencies
         path -/- ".dependencies" %> \out -> do
             cSrcs <- pkgDataList $ CSrcs path
-            let cDepFiles = [ path -/- src <.> "deps" | src <- cSrcs
-                            , not ("//AutoApply.cmm" ?== src) ]
-                         ++ [ src <.> "deps" | src <- cSrcs, "//AutoApply.cmm" ?== src ]
-
+            let cDepFiles = map (src2dep context) cSrcs
             need $ hDepFile : cDepFiles -- need all for more parallelism
             cDeps <- fmap concat $ traverse readFile' cDepFiles
             hDeps <- readFile' hDepFile
@@ -52,3 +45,23 @@ buildPackageDependencies rs context@Context {..} =
                        . sortBy (compare `on` fst)
                        . parseMakefile $ cDeps ++ hDeps
             writeFileChanged out result
+
+-- Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
+-- to its dependencies. For example, in vanillaContext Stage1 rts:
+-- * "Task.c"                          -> ".build/stage1/rts/Task.c.deps"
+-- * ".build/stage1/rts/AutoApply.cmm" -> ".build/stage1/rts/AutoApply.cmm.deps"
+src2dep :: Context -> FilePath -> FilePath
+src2dep context src
+    | buildRootPath `isPrefixOf` src = src <.> "deps"
+    | otherwise                      = buildPath context -/- src <.> "deps"
+
+-- Given a 'Context' and a 'FilePath' to a file with dependencies, compute the
+-- 'FilePath' to the source file. For example, in vanillaContext Stage1 rts:
+-- * ".build/stage1/rts/Task.c.deps"        -> "Task.c"
+-- * ".build/stage1/rts/AutoApply.cmm.deps" -> ".build/stage1/rts/AutoApply.cmm"
+dep2src :: Context -> FilePath -> FilePath
+dep2src context@Context {..} dep
+    | takeBaseName dep `elem` [ "AutoApply.cmm", "Evac_thr.c", "Scav_thr.c" ] = src
+    | otherwise = pkgPath package ++ drop (length $ buildPath context) src
+  where
+    src = dropExtension dep
index 14a9255..8d04e8d 100644 (file)
@@ -142,7 +142,7 @@ generatePackageCode context@(Context stage pkg _) =
 
         priority 2.0 $ do
             -- TODO: this is temporary hack, get rid of this (#113)
-            let oldPath = pkgPath pkg -/- contextDirectory context
+            let oldPath = pkgPath pkg -/- contextDirectory context -/- "build"
                 olden f = oldPath ++ (drop (length (buildPath context)) f)
 
             when (pkg == compiler) $ path -/- "Config.hs" %> \file -> do
@@ -162,13 +162,15 @@ generatePackageCode context@(Context stage pkg _) =
 
 copyRules :: Rules ()
 copyRules = do
-    "inplace/lib/ghc-usage.txt"     <~ "driver"
-    "inplace/lib/ghci-usage.txt"    <~ "driver"
-    "inplace/lib/platformConstants" <~ derivedConstantsPath
-    "inplace/lib/settings"          <~ "."
-    "inplace/lib/template-hsc.h"    <~ pkgPath hsc2hs
+    "inplace/lib/ghc-usage.txt"      <~ "driver"
+    "inplace/lib/ghci-usage.txt"     <~ "driver"
+    "inplace/lib/platformConstants"  <~ derivedConstantsPath
+    "inplace/lib/settings"           <~ "."
+    "inplace/lib/template-hsc.h"     <~ pkgPath hsc2hs
+    rtsBuildPath -/- "sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
+    rtsBuildPath -/- "sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
   where
-    file <~ dir = file %> \_ -> copyFile (dir -/- takeFileName file) file
+    file <~ dir = file %> copyFile (dir -/- takeFileName file)
 
 generateRules :: Rules ()
 generateRules = do
index 3ac47bb..b74baf8 100644 (file)
@@ -26,11 +26,10 @@ buildPackageLibrary context@Context {..} = do
         cSrcs <- cSources context
         hSrcs <- hSources context
 
-        -- TODO: simplify handling of AutoApply.cmm, eliminate differences below
-        let cObjs = [ path -/- src -<.> osuf way | src <- cSrcs
-                    , not ("//AutoApply.cmm" ?== src) ]
-                 ++ [ src -<.> osuf way | src <- cSrcs, "//AutoApply.cmm" ?== src ]
-            hObjs = [ path -/- src  <.> osuf way | src <- hSrcs ]
+        let cObjs = [ objFile context src | src <- cSrcs
+                    , takeFileName src `notElem` ["Evac_thr.c", "Scav_thr.c"]
+                      || way == threaded ]
+            hObjs = [ path -/- src <.> osuf way | src <- hSrcs ]
 
         -- This will create split objects if required (we don't track them
         -- explicitly as this would needlessly bloat the Shake database).
@@ -50,7 +49,7 @@ buildPackageLibrary context@Context {..} = do
         asuf <- libsuf way
         let isLib0 = ("//*-0" ++ asuf) ?== a
         if isLib0
-        then build $ Target context Ar [] [a] -- TODO: scan for dlls
+        then build $ Target context Ar []   [a] -- TODO: scan for dlls
         else build $ Target context Ar objs [a]
 
         synopsis <- interpretInContext context $ getPkgData Synopsis
@@ -68,12 +67,22 @@ buildPackageGhciLibrary context@Context {..} = priority 2 $ do
     matchVersionedFilePath libPrefix (waySuffix way <.> "o") ?> \obj -> do
             cSrcs <- cSources context
             hSrcs <- hSources context
-            let cObjs = [ path -/- src -<.> "o" | src <- cSrcs
-                        , not ("//AutoApply.cmm" ?== src) ]
-                     ++ [ src -<.> "o" | src <- cSrcs, "//AutoApply.cmm" ?== src ]
-                hObjs = [ path -/- src  <.> "o" | src <- hSrcs ]
-            need $ cObjs ++ hObjs
-            build $ Target context Ld (cObjs ++ hObjs) [obj]
+
+            let cObjs = map (objFile context) cSrcs
+                hObjs = [ path -/- src <.> osuf way | src <- hSrcs ]
+                objs  = cObjs ++ hObjs
+            need objs
+            build $ Target context Ld objs [obj]
+
+-- TODO: Get rid of code duplication and simplify. See also src2dep.
+-- Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
+-- to its object file. For example, in Context Stage1 rts threaded:
+-- * "Task.c"                          -> ".build/stage1/rts/Task.thr_o"
+-- * ".build/stage1/rts/sm/Evac_thr.c" -> ".build/stage1/rts/sm/Evac_thr.thr_o"
+objFile :: Context -> FilePath -> FilePath
+objFile context@Context {..} src
+    | buildRootPath `isPrefixOf` src = src -<.> osuf way
+    | otherwise                      = buildPath context -/- src -<.> osuf way
 
 cSources :: Context -> Action [FilePath]
 cSources context = interpretInContext context $ getPkgDataList CSrcs
index ba79289..c841526 100644 (file)
@@ -56,12 +56,12 @@ rtsPackageArgs = package rts ? do
           [ arg "-Irts"
           , arg $ "-I" ++ path
           , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
-          -- rts **must** be compiled with optimizations. The INLINE_HEADER macro,
-          -- requires that functions are inlined to work as expected.  Inlining
-          -- only happens for optimized builds. Otherwise we can assume that
+          -- rts *must* be compiled with optimisations. The INLINE_HEADER macro
+          -- requires that functions are inlined to work as expected. Inlining
+          -- only happens for optimised builds. Otherwise we can assume that
           -- there is a non-inlined variant to use instead. But rts does not
           -- provide non-inlined alternatives and hence needs the function to
-          -- be inlined. See also Issue #90
+          -- be inlined. See also #90.
           , arg "-O2"
 
           , way == threaded ? arg "-DTHREADED_RTS"
@@ -86,8 +86,11 @@ rtsPackageArgs = package rts ? do
             , "-DGhcUnregisterised="         ++ quote ghcUnreg
             , "-DGhcEnableTablesNextToCode=" ++ quote ghcEnableTNC ]
 
-            , (file "//Evac_thr.*" ||^ file "//Scav_thr.*") ?
-              append [ "-DPARALLEL_GC", "-Irts/sm" ] ]
+            , file "//Evac.*"     ? arg "-funroll-loops"
+            , file "//Evac_thr.*" ? arg "-funroll-loops"
+
+            , file "//Evac_thr.*" ? append [ "-DPARALLEL_GC", "-Irts/sm" ]
+            , file "//Scav_thr.*" ? append [ "-DPARALLEL_GC", "-Irts/sm" ] ]
 
         , builderGhc ? (arg "-Irts" <> includesArgs)
 
@@ -234,7 +237,3 @@ rtsPackageArgs = package rts ? do
 -- ifneq "$(CC_CLANG_BACKEND)" "1"
 -- rts/sm/Compact_CC_OPTS += -finline-limit=2500
 -- endif
-
--- # -O3 helps unroll some loops (especially in copy() with a constant argument).
--- rts/sm/Evac_CC_OPTS += -funroll-loops
--- rts/dist/build/sm/Evac_thr_HC_OPTS += -optc-funroll-loops