├── .travis.yml ├── Analysis.hs ├── Live.1600.ExtraIterations.B.Copying+Incremental-1+Incremental-2+Incremental-4.svg ├── Live.1600.ExtraIterations.D.Copying+Incremental.svg ├── Live.1600.ExtraIterations.D.Incremental-1+Incremental-2+Incremental-4.svg ├── Live.600.ExtraIterations.S.Copying+Incremental-1+Incremental-2+Incremental-4.svg ├── Live.600.ExtraIterations.S.Copying+IncrementalWithPauses.svg ├── Live.600.ExtraIterations.S.IncrementalWithPauses.svg ├── MaxResidency.B.Normal.Copying+Incremental.svg ├── MaxResidency.D.Incremental.svg ├── MaxResidency.D.Normal.Copying+Incremental.svg ├── Pauses.B.Normal.Copying+Incremental.svg ├── Pauses.D.Normal.Copying+Incremental.svg ├── Pauses.D.Normal.Incremental.svg ├── Pauses.S.Normal.Copying+Incremental.svg ├── README.md ├── Runtimes.B.Normal.Copying+Incremental.svg ├── Runtimes.D.Normal.Copying+Incremental.svg ├── Shake.hs ├── default.nix └── nix ├── 0001-Stats-Add-sync-pauses-to-RTS-S-output.patch ├── 0001-Unconditionally-flush-update-remembered-set-during-m.patch ├── 8.9.1.nonMoving.nix ├── ghc-8.8.0.20190730-src.tar.xz └── overlay.nix /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | 3 | # https://nixos.wiki/wiki/Nix_on_Travis 4 | 5 | cache: 6 | directories: 7 | - $HOME/nix.store 8 | 9 | before_install: 10 | - sudo mkdir -p /etc/nix 11 | - echo "substituters = https://cache.nixos.org/ file://$HOME/nix.store" | sudo tee -a /etc/nix/nix.conf > /dev/null 12 | - echo 'require-sigs = false' | sudo tee -a /etc/nix/nix.conf > /dev/null 13 | 14 | before_cache: 15 | - mkdir -p $HOME/nix.store 16 | - nix copy --to file://$HOME/nix.store -f default.nix buildInputs 17 | -------------------------------------------------------------------------------- /Analysis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveTraversable #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE AllowAmbiguousTypes #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE DerivingStrategies #-} 7 | {-# LANGUAGE DerivingVia #-} 8 | {-# LANGUAGE DuplicateRecordFields #-} 9 | {-# LANGUAGE FlexibleInstances #-} 10 | {-# LANGUAGE NamedFieldPuns #-} 11 | {-# LANGUAGE PatternSynonyms #-} 12 | {-# LANGUAGE RecordWildCards #-} 13 | {-# LANGUAGE ScopedTypeVariables #-} 14 | {-# LANGUAGE StandaloneDeriving #-} 15 | {-# LANGUAGE TypeApplications #-} 16 | {-# LANGUAGE TypeFamilies #-} 17 | {-# LANGUAGE TypeSynonymInstances #-} 18 | {-# LANGUAGE ViewPatterns #-} 19 | {-# OPTIONS -Wno-name-shadowing #-} 20 | 21 | module Analysis 22 | ( RunLog, RunLog_ (..) 23 | , DataSet, DataSet_ (..) 24 | , Trace 25 | , Analysis 26 | , GC, GC_(..) 27 | , Mode(..) 28 | , MsgTypeSing(..) 29 | , enumerate 30 | , parserFor 31 | , plotTrace 32 | , plotAnalysis 33 | ) where 34 | 35 | import Control.Applicative 36 | import Control.Monad 37 | import Development.Shake hiding (Normal, (*>)) 38 | import Data.Char 39 | import Data.Functor.Identity 40 | import Data.List 41 | import Data.Maybe 42 | import Generics.Deriving 43 | import qualified Graphics.Rendering.Chart.Easy as E 44 | import Graphics.Rendering.Chart.Easy ((.=)) 45 | import qualified Graphics.Rendering.Chart.Backend.Diagrams as E 46 | import Numeric.Natural 47 | import Pusher (MsgTypeSing(..)) 48 | import System.FilePath 49 | import Text.Read 50 | import qualified Text.ParserCombinators.ReadP as P 51 | 52 | -- | Various metrics of interest 53 | data Metric = Runtimes | Pauses | MaxResidency 54 | deriving (Bounded, Generic, Read, Show) 55 | deriving (GEq, GEnum) via Default Metric 56 | 57 | parserFor :: Metric -> String -> [Char] 58 | parserFor Pauses = parsePause 59 | parserFor Runtimes = parseRuntime 60 | parserFor MaxResidency = parseMaxResidency 61 | 62 | -- | Run mode - normal or twice as many iterations 63 | data Mode = Normal | ExtraIterations 64 | deriving (Generic, Bounded, Read, Show) 65 | deriving (GEq, GEnum) via Default Mode 66 | 67 | newtype Capabilities = Capabilities Natural 68 | deriving Generic 69 | deriving newtype (Eq, Num, Read, Show) 70 | deriving anyclass GEq 71 | 72 | instance GEnum Capabilities where genum = [1,2,4] 73 | 74 | newtype PauseMs = PauseMs Natural 75 | deriving Generic 76 | deriving newtype (Eq, Num, Read, Show) 77 | deriving anyclass GEq 78 | 79 | instance GEnum PauseMs where genum = [1,10] 80 | 81 | newtype IterBetweenPauses = IterBetweenPauses Natural 82 | deriving Generic 83 | deriving newtype (Eq, Num, Read, Show) 84 | deriving anyclass GEq 85 | 86 | instance GEnum IterBetweenPauses where genum = [100,10000] 87 | 88 | -- | Garbage collector to use 89 | data GC_ f 90 | = Copying 91 | | Incremental (HKD f Capabilities) 92 | | IncrementalWithPauses (HKD f Capabilities) (HKD f PauseMs) (HKD f IterBetweenPauses) 93 | deriving (Generic) 94 | 95 | type GC = GC_ Identity 96 | type GCs = GC_ Over 97 | 98 | deriving anyclass instance GEq GC 99 | deriving anyclass instance GEnum GC 100 | deriving anyclass instance GEq GCs 101 | deriving anyclass instance GEnum GCs 102 | 103 | flattenGCs :: GCs -> [GC] 104 | flattenGCs Copying = pure Copying 105 | flattenGCs (Incremental cap) = Incremental <$> over cap 106 | flattenGCs (IncrementalWithPauses cap len iter) = 107 | IncrementalWithPauses <$> over cap <*> over len <*> over iter 108 | 109 | instance Show GC where 110 | show Copying = "Copying" 111 | show (Incremental 1) = "Incremental" 112 | show (Incremental n) = "Incremental-" <> show n 113 | show (IncrementalWithPauses c ms n) = "IncrementalWithPauses-" <> show c <> "-" <> show ms <> "-" <> show n 114 | 115 | instance Show (GCs) where 116 | show Copying = "Copying" 117 | show (Incremental (Over [1])) = "Incremental" 118 | show (Incremental n) = "Incremental-" <> show n 119 | show (IncrementalWithPauses c ms n) = "IncrementalWithPauses-" <> show c <> "-" <> show ms <> "-" <> show n 120 | 121 | instance Read GC where 122 | readPrec = choice 123 | [ Copying <$ string "Copying" 124 | , Incremental 1 <$ string "Incremental" 125 | , Incremental <$> (string "Incremental-" *> readPrec) 126 | , do 127 | string "IncrementalWithPauses-" 128 | c <- readPrec 129 | char '-' 130 | ms <- readPrec 131 | char '-' 132 | n <- readPrec 133 | return (IncrementalWithPauses c ms n) 134 | ] 135 | 136 | instance Read GCs where 137 | readPrec = choice 138 | [ Copying <$ string "Copying" 139 | , Incremental (Over [1]) <$ string "Incremental" 140 | , Incremental <$> (string "Incremental-" *> readPrec) 141 | , do -- TODO review 142 | string "IncrementalWithPauses" 143 | c <- (char '-' *> readPrec) <|> pure OverAll 144 | ms <- (char '-' *> readPrec) <|> pure OverAll 145 | n <- (char '-' *> readPrec) <|> pure OverAll 146 | return (IncrementalWithPauses c ms n) 147 | ] 148 | 149 | -- | A file path containing the output of -S for a given run 150 | data RunLog_ f = RunLog 151 | { gc :: HKD f (GC_ f) 152 | , mode :: HKD f Mode 153 | , msgType :: HKD f MsgTypeSing 154 | , size :: HKD f Int 155 | } 156 | 157 | type RunLog = RunLog_ Identity 158 | 159 | instance Show RunLog where show RunLog{..} = show size <.> show mode <.> show msgType <.> show gc <.> "log" 160 | instance Read RunLog where 161 | readPrec = do 162 | size <- readPrec <* dot 163 | mode <- readPrec <* dot 164 | msgType <- readPrec <* dot 165 | gc <- readPrec <* dot 166 | "log" <- many get 167 | return RunLog { .. } 168 | 169 | data TraceMetric = Allocated | Copied | Live | User | Elapsed 170 | deriving (Generic, Read, Show) 171 | deriving (GEq, GEnum) via Default TraceMetric 172 | 173 | data Trace = Trace 174 | { traceMetric :: TraceMetric 175 | , runLog :: RunLog_ Over 176 | } 177 | deriving (Generic) 178 | 179 | instance Show Trace where 180 | show Trace{traceMetric, runLog = RunLog{..}} = 181 | show traceMetric <.> show size <.> show mode <.> show msgType <.> show gc <.> "svg" 182 | 183 | instance Read Trace where 184 | readPrec = do 185 | traceMetric <- readPrec <* dot 186 | size <- (readPrec <* dot) <|> pure OverAll 187 | mode <- (readPrec <* dot) <|> pure OverAll 188 | msgType <- (readPrec <* dot) <|> pure OverAll 189 | gc <- (readPrec <* dot) <|> pure OverAll 190 | "svg" <- many get 191 | let runLog = RunLog{..} 192 | return Trace{..} 193 | 194 | toRunLogs :: Trace -> [RunLog] 195 | toRunLogs Trace { runLog = RunLog {..} } = 196 | [ RunLog { .. } 197 | | gcs <- over gc 198 | , gc <- flattenGCs gcs 199 | , mode <- over mode 200 | , size <- over size 201 | , msgType <- over msgType 202 | ] 203 | 204 | -- | A line in the output of -S 205 | data Frame = Frame 206 | { allocated, copied, live :: Int 207 | , user, elapsed, totUser, totElapsed :: Double 208 | , generation :: Int 209 | } 210 | deriving (Show) 211 | 212 | instance Read Frame where 213 | readPrec = do 214 | spaces 215 | allocated <- readPrec <* spaces 216 | copied <- readPrec <* spaces 217 | live <- readPrec <* spaces 218 | user <- readPrec <* spaces 219 | elapsed <- readPrec <* spaces 220 | totUser <- readPrec <* spaces 221 | totElapsed <- readPrec <* spaces 222 | _ <- readPrec @Int <* spaces 223 | _ <- readPrec @Int <* spaces 224 | "(Gen: " <- replicateM 7 get 225 | generation <- readPrec 226 | ')' <- get 227 | return Frame { .. } 228 | where 229 | spaces = readP_to_Prec $ const P.skipSpaces 230 | 231 | loadRunLog :: RunLog -> Action [Frame] 232 | loadRunLog rl = do 233 | ll <- lines <$> readFile' (show rl) 234 | return $ mapMaybe readMaybe ll 235 | 236 | -- | A set of metrics collected from multiple runs over varying data sizes 237 | data DataSet_ f = DataSet 238 | { metric :: HKD f Metric 239 | , gc :: HKD f (GC_ f) 240 | , mode :: HKD f Mode 241 | , msgType :: HKD f MsgTypeSing 242 | } 243 | deriving (Generic) 244 | 245 | deriving via Default DataSet instance GEq DataSet 246 | deriving via Default DataSet instance GEnum DataSet 247 | deriving via Default Analysis instance GEq Analysis 248 | deriving via Default Analysis instance GEnum Analysis 249 | deriving via Default MsgTypeSing instance GEq MsgTypeSing 250 | deriving via Default MsgTypeSing instance GEnum MsgTypeSing 251 | 252 | type DataSet = DataSet_ Identity 253 | type Analysis = DataSet_ Over 254 | 255 | load :: DataSet -> Action [(Double, Double)] 256 | load dataset = do 257 | ll <- lines <$> readFile' (show dataset) 258 | return [ (read a, read b) | [a,b] <- map words ll ] 259 | 260 | instance Show DataSet where show DataSet{..} = show metric <.> show msgType <.> show mode <.> show gc <.> "dataset" 261 | instance Read DataSet where 262 | readPrec = do 263 | metric <- readPrec <* dot 264 | msgType <- readPrec <* dot 265 | mode <- readPrec <* dot 266 | gc <- readPrec <* dot 267 | "dataset" <- many get 268 | return DataSet { .. } 269 | 270 | toDataSets :: Analysis -> [DataSet] 271 | toDataSets DataSet{..} = 272 | [DataSet{..} 273 | | gc <- over gc >>= flattenGCs 274 | , mode <- over mode 275 | , metric <- over metric 276 | , msgType <- over msgType 277 | ] 278 | 279 | instance Show Analysis where 280 | show DataSet{..} = show metric <.> show msgType <.> show mode <.> show gc <.> "svg" 281 | 282 | instance Read Analysis where 283 | readPrec = do 284 | metric <- (readPrec <* dot) <|> pure OverAll 285 | msgType <- (readPrec <* dot) <|> pure OverAll 286 | mode <- (readPrec <* dot) <|> pure OverAll 287 | gc <- (readPrec <* dot) <|> pure OverAll 288 | "svg" <- many get 289 | return DataSet{ .. } 290 | 291 | -- ----------------------------------------------------------------------------------------------------------- 292 | -- Figure titles 293 | 294 | class HasTitle a where title :: a -> String 295 | instance HasTitle Metric where 296 | title Runtimes = "Runtime (s)" 297 | title Pauses = "Max Gen1 pause (s)" 298 | title MaxResidency = "Max Residency (bytes)" 299 | 300 | instance HasTitle DataSet where 301 | title DataSet{..}= show metric <> "-" <> title msgType <> "-" <> show mode <> "-" <> show gc 302 | 303 | instance HasTitle Analysis where 304 | title DataSet{..} = intercalate " - " $ filter (not.null) [show metric, title msgType, show gc, show mode] 305 | 306 | instance HasTitle Trace where 307 | title Trace { runLog = RunLog {..}, ..} = intercalate " - " 308 | $ filter (not . null) [show traceMetric, title msgType, show size, show gc, show mode] 309 | 310 | instance HasTitle MsgTypeSing where 311 | title B = "ByteStrings" 312 | title D = "Doubles" 313 | title S = "ShortByteStrings" 314 | 315 | instance HasTitle a => HasTitle (Over a) where 316 | title OverAll = "" 317 | title (Over xx) = intercalate "&&" $ map title xx 318 | 319 | -- ------------------------------------------------------------------------------------------------------------ 320 | -- Functions 321 | 322 | parsePause :: String -> [Char] 323 | parsePause input = 324 | case find (" Gen 1" `isPrefixOf`) (lines input) of 325 | Just l -> init (last $ words l) 326 | Nothing -> "" 327 | 328 | parseRuntime :: String -> String 329 | parseRuntime input = 330 | case find (" Total time" `isPrefixOf`) (lines input) of 331 | Just l -> (init $ head $ tail $ reverse $ words l) 332 | Nothing -> "" 333 | 334 | parseMaxResidency :: String -> String 335 | parseMaxResidency input = 336 | case find ("maximum residency" `isInfixOf`) (lines input) of 337 | Just l -> filter isDigit $ head (words l) 338 | Nothing -> "" 339 | 340 | enumerate :: forall a . (GEnum a) => [a] 341 | enumerate = genum 342 | 343 | plotAnalysis :: Analysis -> FilePath -> Action () 344 | plotAnalysis analysis out = do 345 | let datasets = toDataSets analysis 346 | datas <- mapM load datasets 347 | liftIO $ E.toFile E.def out $ do 348 | E.layout_title .= title analysis 349 | forM_ (zip datasets datas) $ \(d,dat) -> 350 | E.plot (E.line (labelDataSetInAnalysis analysis d) [dat]) 351 | 352 | labelDataSetInAnalysis :: Analysis -> DataSet -> String 353 | labelDataSetInAnalysis an DataSet{..} = intercalate " - " $ 354 | filter (not.null) $ 355 | [ show metric | case an of DataSet{..} -> multi (over metric)] ++ 356 | [ show msgType | case an of DataSet{..} -> multi (over msgType)] ++ 357 | [ show gc | case an of DataSet{..} -> multi (over gc >>= flattenGCs)] ++ 358 | [ show mode | case an of DataSet{..} -> multi (over mode)] 359 | 360 | plotTrace :: Trace -> FilePath -> Action () 361 | plotTrace t@Trace { traceMetric } out = do 362 | let runLogs = toRunLogs t 363 | extract = frameMetric traceMetric 364 | frames <- mapM loadRunLog runLogs 365 | liftIO $ E.toFile E.def out $ do 366 | E.layout_title .= title t 367 | forM_ (zip runLogs frames) $ \(rl, ff) -> E.plot 368 | (E.line 369 | (labelRunLogInTrace t rl) 370 | [zipWith (\i f -> (i, extract f)) [(0 :: Double) ..] ff] 371 | ) 372 | return () 373 | 374 | labelRunLogInTrace :: Trace -> RunLog -> String 375 | labelRunLogInTrace trace RunLog{..} = intercalate " - " $ 376 | filter (not.null) $ 377 | [ show size | case runLog trace of RunLog{..} -> multi (over size)] ++ 378 | [ show msgType | case runLog trace of RunLog{..} -> multi (over msgType)] ++ 379 | [ show gc | case runLog trace of RunLog{..} -> multi (over gc >>= flattenGCs)] ++ 380 | [ show mode | case runLog trace of RunLog{..} -> multi (over mode)] 381 | 382 | frameMetric :: TraceMetric -> Frame -> Double 383 | frameMetric Allocated = fromIntegral . allocated 384 | frameMetric Copied = fromIntegral . copied 385 | frameMetric Live = fromIntegral . live 386 | frameMetric Elapsed = elapsed 387 | frameMetric User = user 388 | 389 | ---------------------------------------------------- 390 | -- Dual purpose types for data and analysis 391 | 392 | type family HKD (f :: * -> *) a where 393 | HKD Identity a = a 394 | HKD f a = f a 395 | 396 | data Over a = Over [a] | OverAll 397 | deriving (Functor, Foldable, Generic, Traversable) 398 | deriving (GEq, GEnum) via Default (Over a) 399 | 400 | instance Applicative Over where 401 | pure x = Over [x] 402 | OverAll <*> _ = OverAll 403 | _ <*> OverAll = OverAll 404 | Over ff <*> Over xx = Over (ff <*> xx) 405 | 406 | instance Read a => Read (Over a) where 407 | readPrec = readP_to_Prec (\prec -> Over <$> P.sepBy1 (readPrec_to_P readPrec prec) (P.char '+')) 408 | 409 | instance Show a => Show (Over a) where 410 | show (Over xx) = intercalate "+" (map show xx) 411 | show OverAll = "" 412 | 413 | over :: GEnum a => Over a -> [a] 414 | over (Over xx) = xx 415 | over OverAll = enumerate 416 | 417 | --------------------------------------------------------- 418 | -- Parsing helpers 419 | 420 | char :: Char -> ReadPrec () 421 | char c = get >>= \c' -> guard (c == c') >> pure () 422 | 423 | string :: String -> ReadPrec () 424 | string = mapM_ char 425 | 426 | dot :: ReadPrec () 427 | dot = char '.' 428 | 429 | --------------------------------------------------------- 430 | -- Utils 431 | 432 | multi :: [a] -> Bool 433 | multi (_ : _ : _) = True 434 | multi _ = False 435 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Shorter GC pauses coming to GHC 2 | 3 | UPDATE: The incremental GC has now been [merged](https://gitlab.haskell.org/ghc/ghc/commit/7f72b540288bbdb32a6750dd64b9d366501ed10c) into GHC HEAD and the memory usage issues are gone, as the updated graphs below show. 4 | 5 | GHC >=8.10 is getting a new incremental garbage collector with a mark&sweep strategy for the older generation collections, as an alternative to the standard copy collector. Incrementality comes from performing the sweep phase concurrently with the mutator (i.e. the program), after a blocking, hopefully short marking phase. Ben Gamari gave a [talk][1] about it at MuniHac last year, please check it for all the details. Now that the collector is publicly available in the GHC repository, we can benchmark it to find out how much shorter the GC pauses are, and what the impact is in performance. The results are quite encouraging, and the new collector might be ready for mainstream use soon. 6 | 7 | All experiments are reproducible via a [Nix expression][nix] and [Shake][shake] script that will build the GHC branch, run the benchmarks and render the graphs. 8 | 9 | ## Benchmark methodology 10 | To build GHC, you can check out the branch `wip/gc/ghc-8.8-rebase`, rebase it again on top of the 8.8 branch (including submodules), and then `./boot && ./configure && make -j4`. This is roughly what the Nix script does, using a pregenerated source snapshot to simplify things. 11 | 12 | To test the new incremental garbage collector I use the well known [Pusher][3] problem: can the generation 1 pauses be short for a program that keeps a large amount of long-lived state in the heap ? The answer with the current garbage collector is no, but there are workarounds like [compact regions][2] that effectively move the data out of the garbage collected heap. These workarounds, however, require modifying or rewriting the program, and usually involve a sacrifice in performance. The new incremental collector should be able to reduce the Gen 1 pauses without any code changes, and I couldn't wait to see how much shorter the pauses are and how much performance is lost. 13 | 14 | The code for the Pusher example is very short and included below for convenience: it uses a `Data.Map.Strict` to store up to `_N` bytestring messages in 2 million iterations. By varying `_N` we can control the size of the Haskell heap and relate it to the length of the Gen 1 pauses: 15 | ``` 16 | module Main (main) where 17 | 18 | import qualified Control.Exception as Exception 19 | import qualified Control.Monad as Monad 20 | import qualified Data.ByteString as ByteString 21 | import qualified Data.Map.Strict as Map 22 | 23 | data Msg = Msg !Int !ByteString.ByteString 24 | 25 | type Chan = Map.Map Int ByteString.ByteString 26 | 27 | _N :: Int 28 | _N = 500.000 29 | 30 | message :: Int -> Msg 31 | message n = Msg n (ByteString.replicate 1024 (fromIntegral n)) 32 | 33 | pushMsg :: Chan -> Msg -> IO Chan 34 | pushMsg chan (Msg msgId msgContent) = 35 | Exception.evaluate $ 36 | let 37 | inserted = Map.insert msgId msgContent chan 38 | in 39 | if _N < Map.size inserted 40 | then Map.deleteMin inserted 41 | else inserted 42 | 43 | main :: IO () 44 | main = Monad.foldM_ pushMsg Map.empty (map message [1..2000000]) 45 | ``` 46 | 47 | To measure the max gen 1 pause length, I rely on the output of `+RTS -s`. This is what it looks like for the new incremental GC: 48 | ``` 49 | Tot time (elapsed) Avg pause Max pause 50 | Gen 0 59746 colls, 0 par 4.244s 4.283s 0.0001s 0.0002s 51 | (1a) Gen 1 25 colls, 0 par 0.730s 0.731s 0.0292s 0.0228s 52 | (1b) Gen 1 25 syncs, 0.003s 0.0001s 0.0003s 53 | (1c) Gen 1 concurrent, 5.062s 10.174s 0.4070s 1.1760s 54 | 55 | ``` 56 | 57 | `Gen 1` now gets two extra lines showing (1b) the time spent in sync pauses (after sweeping) and (1c) the time spent in concurrent sweeping. Note that (1c) is *not* a pause regardless of what the header says. Finally, my understanding is that (1a) shows the time spent marking, which is indeed a blocking pause. 58 | 59 | ## Results 60 | ### Pauses 61 | 62 | The graph below shows the max length of the Gen 1 pauses per dataset size, both with the standard and incremental GC for various sizes of N. 63 | 64 | ![][pauses] 65 | 66 | For the incremental collector the graph is showing the length of the marking pause (1a). In the copy collector case, the pause lengths are linear with _N as expected. For the incremental collector pauses are shorter, but still linear. On average, the incremental GC pauses are between five and six times shorter than the copying GC pauses. However, at 100ms, is this short enough? I asked Ben Gamari and he said: 67 | 68 | >The Pusher benchmark allocates and retains lots of large objects (namely each message carries a large ByteString). 69 | > However, the cost of the preparatory GC is linear in the number of large 70 | > objects (the assumption being these are relatively rare in most 71 | > programs) as we must clear the mark bit of each. Consequently, the 72 | > preparatory collection pause scales linearly with the size of the test's queue. 73 | > In my experience it is rather unusual for programs to carry around millions of large and pinned bytearrays. 74 | 75 | So the new collector is managing a 5-fold improvement on a worst case scenario. That's not bad but let's check the non worst case situation too; replacing the bytestrings with doubles yields the following graph: 76 | 77 | ![][pauses.double] 78 | 79 | The incremental collector pauses are dwarfed by the copying collector ones. 80 | Focusing on the incremental line, the length of the pauses is no longer proportional to the size of the surviving set: 81 | 82 | ![][pauses.double.incremental] 83 | 84 | If instead we replace ByteString with ShortByteString, the outcome is similar to Doubles up to 1200k messages, and runs out of memory after that. The incremental collector allows the heap to grow unbounded while it's performing the sweeping phase, as seen in the section Memory below. 85 | 86 | ![][pauses.short] 87 | 88 | ### Runtimes 89 | 90 | In my benchmarks the incremental collector does not have any impact on the run time. If you think this is too good to be true, that makes two of us. The mark&sweep collector is able to perform the sweeping phase in parallel using a second core of the CPU, so this performance relies on having an extra CPU core available and will probably not hold if that's not the case. 91 | 92 | The graph below shows the runtimes for each collector per dataset size: 93 | 94 | ![][runtimes] 95 | 96 | If we replace the bytestrings with doubles, the outcome is pretty much the same: 97 | 98 | ![][runtimes.double] 99 | 100 | ### Memory 101 | 102 | What effect does the new collector have on the total memory footprint of our process? To measure this, I again rely on the output of `+RTS -s`, concretely on the "maximum residency" line. The results are quite interesting. Encouragingly, the new collector uses less memory than the copy collector for the bytestrings example. 103 | 104 | ![][maxResidency] 105 | 106 | However, this behaviour is specific to bytestrings. If we look at the version using doubles, the new collector requires quite a bit more memory than the copy collector. 107 | 108 | ![][maxResidency.double] 109 | 110 | It's a bit surprising that the behaviour is so different between the two examples. More worryingly though, the memory usage seems to be linear with the number of iterations in our main loop. This is shown by the chart below illustrating the maximum residency per dataset size under the incremental collector for two different number of iterations. The two lines should be identical, as it is the case for the standard copy collector, but the graph shows the two lines differ, with the ExtraIterations version using more memory. What's going on ? 111 | 112 | ![][maxResidencyPerIterations] 113 | 114 | Drilling into how the heap evolves over time for a concrete example, using the Live bytes column of the `+RTS -S ~RTS` output, we can see that the incremental collector is "lagging behind" the main program, allowing the heap to grow very large before completing the garbage collection. The chart below shows the heap size over time for the Copying collector and for the incremental collector: 115 | 116 | ![][liveBytesComparisonDouble] 117 | 118 | Can we help the incremental collector by running with multiple capabilities via `+RTS -N -RTS`. The chart below shows that increasing the value `of +RTS -N` does seem to help, but not enough to prevent the heap from eventually running out of control: 119 | 120 | ![][liveBytesComparisonDoubleCapabilities] 121 | 122 | With ShortByteString the picture is identical to the one with Doubles, but since the messages are much larger - 1000 bytes + SBS overhead - the process runs out of memory for N larger than 600k. 123 | 124 | ![][liveBytesComparisonShort] 125 | 126 | Finally, the behaviour with ByteString is an exception once more: the incremental GC is able to collect the heap multiple times concurrently with the main program, even more so than the copying GC. 127 | 128 | ![][liveBytesComparisonBS] 129 | 130 | ### Inserting artificial pauses 131 | 132 | To investigate the theory that the collector is "lagging behind" the main program, we insert artificial pauses of M milliseconds every I iterations. This is done using `Control.Concurrent.threadDelay`. To see if having extra threads would help the incremental collector, we benchmark with multiple values of `+RTS -N`. 133 | 134 | The chart below shows various combinations of *IncrementalWithPauses-C-M-I*, where C stands for capabilities, M is the pause length in milliseconds, and I is the interval between pauses. It seems that no matter how long or frequent the pauses, the heap still doesn't get collected in a reasonable time, causing it to eventually grow out of control. 135 | 136 | ![][liveBytesWithPausesAll2] 137 | 138 | Same plot removing the Copying collector trace. 139 | 140 | ![][liveBytesWithPausesAll] 141 | 142 | ## Conclusion 143 | 144 | The incremental garbage collector offers shorter pauses than the copying collector without the need to change any code, and little to no performance costs assuming an extra core available. Compact regions afford more control to decide when and for how long to pause, and even to perform the compaction concurrently with the main program, therefore achieving pauses as short as desired with the same performance characteristics. But this is at the cost of significant complexity, whereas the incremental collector can be turned on with a simple flag. This holds the potential to make GHC a better fit for many applications that require shorter GC pauses, such as games, event sourcing engines, and high-frequency trading systems. But the collector is still [under review][5] for merging to GHC HEAD, and there are some issues with memory usage that remain unexplained. 145 | 146 | Finally, two obligatory disclaimers. First, these benchmarks are only as accurate as the output of `+RTS -S -RTS`; it's entirely possible that it does not give a full picture in the case of the new collector, as it is still in development. Secondly, I must mention that the work carried out by Well-Typed has been sponsored by my employer, Standard Chartered, but all the views expressed in this blog post are my own and not that of my employer. 147 | 148 | [1]: https://www.youtube.com/watch?v=7_ig6r2C-d4 149 | [2]: https://www.reddit.com/r/haskell/comments/81r6z0/trying_out_ghc_compact_regions_for_improved/ 150 | [3]: https://stackoverflow.com/questions/36772017/reducing-garbage-collection-pause-time-in-a-haskell-program 151 | [4]: http://hackage.haskell.org/package/compact-0.1.0.1 152 | [5]: https://gitlab.haskell.org/ghc/ghc/merge_requests/972 153 | [pauses]: Pauses.B.Normal.Copying+Incremental.svg 154 | [pauses.double]: Pauses.D.Normal.Copying+Incremental.svg 155 | [pauses.double.incremental]: Pauses.D.Normal.Incremental.svg 156 | [pauses.short]: Pauses.S.Normal.Copying+Incremental.svg 157 | [runtimes]: Runtimes.B.Normal.Copying+Incremental.svg 158 | [runtimes.double]: Runtimes.D.Normal.Copying+Incremental.svg 159 | [maxResidency]: MaxResidency.B.Normal.Copying+Incremental.svg 160 | [maxResidency.double]: MaxResidency.D.Normal.Copying+Incremental.svg 161 | [maxResidencyPerIterations]: MaxResidency.D.Incremental.svg 162 | [liveBytesComparisonDouble]: Live.1600.ExtraIterations.D.Copying+Incremental.svg 163 | [liveBytesComparisonDoubleCapabilities]: Live.1600.ExtraIterations.D.Incremental-1+Incremental-2+Incremental-4.svg 164 | [liveBytesComparisonShort]: Live.600.ExtraIterations.S.Copying+Incremental-1+Incremental-2+Incremental-4.svg 165 | [liveBytesComparisonBS]: Live.1600.ExtraIterations.B.Copying+Incremental-1+Incremental-2+Incremental-4.svg 166 | [liveBytesWithPausesAll]: Live.600.ExtraIterations.S.IncrementalWithPauses.svg 167 | [liveBytesWithPausesAll2]: Live.600.ExtraIterations.S.Copying+IncrementalWithPauses.svg 168 | [nix]: https://github.com/pepeiborra/gc-benchmarks/blob/master/default.nix 169 | [shake]: https://github.com/pepeiborra/gc-benchmarks/blob/master/Shake.hs 170 | [nofib]: https://gitlab.haskell.org/ghc/ghc/wikis/building/running-no-fib 171 | -------------------------------------------------------------------------------- /Runtimes.D.Normal.Copying+Incremental.svg: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Shake.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | import qualified Data.ByteString as BS 7 | import Data.Maybe 8 | import Development.Shake hiding (Normal) 9 | import System.Directory 10 | import System.FilePath 11 | import Text.Read 12 | 13 | import Analysis 14 | 15 | -- Could be dynamic 16 | sizes :: MsgTypeSing -> [Int] 17 | sizes S = takeWhile (<= 1200) (sizes B) 18 | sizes _ = [25, 50, 100, 200, 400, 800, 1200, 1400, 1800] 19 | 20 | -- Looks for a paragraph of markdown references at the end of a list of lines 21 | extractLinksFromLines :: [String] -> [String] 22 | extractLinksFromLines = 23 | map (drop 2 . dropWhile (/= ':')) 24 | . takeWhile (not . null) 25 | . reverse 26 | 27 | is :: forall a . Read a => String -> Bool 28 | is = isJust . readMaybe @a 29 | 30 | main :: IO () 31 | main = shakeArgs shakeOptions $ do 32 | phony "install" $ do 33 | Just out <- getEnv "out" 34 | liftIO $ createDirectoryIfMissing True out 35 | readmeLines <- readFileLines "README.md" 36 | let links = filter (\x -> is @Trace x || is @Analysis x) $ extractLinksFromLines readmeLines 37 | mapM_ ((\x -> copyFile' x (out x))) 38 | $ links ++ ["README.html"] 39 | 40 | rule @RunLog $ \RunLog {..} out -> do 41 | need [takeDirectory out "Pusher"] 42 | Stderr res <- cmd 43 | (WithStderr False) 44 | "./Pusher" 45 | ( [show (size * 1000), argMode mode, show msgType] 46 | ++ concat [ [show ms, show n] | IncrementalWithPauses _ ms n <- [gc]] 47 | ++ ["+RTS", "-S"] 48 | ++ concat [ ["-xn", "-N" <> show c] | Incremental c <- [gc] ] 49 | ++ concat [ ["-xn", "-N" <> show c] | IncrementalWithPauses c _ _ <- [gc] ] 50 | ) 51 | writeFile' out res 52 | 53 | rule @DataSet $ \DataSet {..} out -> do 54 | values <- mapM 55 | (fmap (parserFor metric) . readFile' . (takeDirectory out ) . show) 56 | [ RunLog { .. } :: RunLog | size <- sizes msgType ] 57 | writeFile' out 58 | (unlines $ zipWith (\a b -> unwords [show a, b]) (sizes msgType) values) 59 | 60 | rule @Trace $ \t out -> do 61 | putNormal $ "Plotting trace: " <> show t 62 | plotTrace t out 63 | 64 | rule @Analysis $ \analysis out -> do 65 | putNormal $ "Plotting analysis: " <> show analysis 66 | plotAnalysis analysis out 67 | 68 | "Pusher" %> \out -> do 69 | need [out <.> "hs"] 70 | cmd "ghc" ["-main-is", (takeFileName out), "-threaded", "-rtsopts", "-O2", out <.> "hs", "-o", out] 71 | 72 | "*.html" %> \out -> do 73 | let md = replaceExtension out "md" 74 | readmeLines <- readFileLines md 75 | let links = filter (\x -> is @Trace x || is @Analysis x) $ extractLinksFromLines readmeLines 76 | need links 77 | Stdout html <- cmd "pandoc" [md] 78 | liftIO $ BS.writeFile out html 79 | 80 | phony "clean" $ do 81 | cmd "rm" "*.hi *.o *.dataset *.log" 82 | 83 | -- | A helper for defining rules over 'Read'able typed file paths 84 | rule :: forall a . Read a => (a -> String -> Action ()) -> Rules () 85 | rule k = (isJust . readMaybe @a . takeFileName) ?> \out -> k (read @a (takeFileName out)) out 86 | 87 | argMode :: Mode -> [Char] 88 | argMode Normal = "5" 89 | argMode ExtraIterations = "10" 90 | 91 | -- Local Variables: 92 | -- dante-methods: (bare-ghci) 93 | -- End: 94 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | nixpkgs = fetchGit{ 3 | name = "nixpkgs-08-03"; 4 | url = https://github.com/NixOS/nixpkgs/; 5 | rev = "0fd978baf77e15c4eb9ba7a54111c340b0730b8f"; 6 | }; 7 | overlay = import ./nix/overlay.nix; 8 | in with (import nixpkgs {overlays = [overlay];}); 9 | let 10 | shakeGhc = haskellPackages.ghcWithPackages(p: [p.shake p.generic-deriving p.split p.diagrams p.diagrams-svg p.Chart p.Chart-diagrams]); 11 | shakeBuilder = stdenv.mkDerivation { 12 | name = "shakeBuilder"; 13 | src = ./.; 14 | buildPhase ="${shakeGhc}/bin/ghc -O Shake.hs"; 15 | installPhase = ''mkdir -p $out/bin && mv Shake $out/bin''; 16 | }; 17 | in stdenv.mkDerivation { 18 | name = "gc-benchmarks"; 19 | # outputs = [ "plot.svg" ]; 20 | src = ./.; 21 | buildPhase = "${shakeBuilder}/bin/Shake -j1 -V"; 22 | installPhase = "${shakeBuilder}/bin/Shake install -j1"; 23 | buildInputs = [ 24 | haskell.compiler.ghc891NonMoving 25 | plotutils 26 | coreutils 27 | pandoc 28 | ]; 29 | } 30 | -------------------------------------------------------------------------------- /nix/0001-Stats-Add-sync-pauses-to-RTS-S-output.patch: -------------------------------------------------------------------------------- 1 | From 79e192af774d576597d61b6437ba7c163b212b85 Mon Sep 17 00:00:00 2001 2 | From: Ben Gamari 3 | Date: Thu, 1 Aug 2019 09:12:03 -0400 4 | Subject: [PATCH] Stats: Add sync pauses to +RTS -S output 5 | 6 | --- 7 | rts/Stats.c | 3 +++ 8 | 1 file changed, 3 insertions(+) 9 | 10 | diff --git a/rts/Stats.c b/rts/Stats.c 11 | index c8245a1dbf..24dbe5b665 100644 12 | --- a/rts/Stats.c 13 | +++ b/rts/Stats.c 14 | @@ -344,6 +344,9 @@ stat_endNonmovingGcSync () 15 | stats.nonmoving_gc_sync_max_elapsed_ns = 16 | stg_max(stats.gc.nonmoving_gc_sync_elapsed_ns, 17 | stats.nonmoving_gc_sync_max_elapsed_ns); 18 | + if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS) { 19 | + statsPrintf("# sync %6.3f\n", TimeToSecondsDbl(stats.gc.nonmoving_gc_sync_elapsed_ns)); 20 | + } 21 | traceConcSyncEnd(); 22 | } 23 | 24 | -- 25 | 2.19.2 26 | 27 | -------------------------------------------------------------------------------- /nix/0001-Unconditionally-flush-update-remembered-set-during-m.patch: -------------------------------------------------------------------------------- 1 | From a3f7dd2828ca456311d8d5eab433c0f7b88e5ae1 Mon Sep 17 00:00:00 2001 2 | From: Ben Gamari 3 | Date: Wed, 8 May 2019 21:28:35 -0400 4 | Subject: [PATCH] Unconditionally flush update remembered set during minor GC 5 | 6 | Flush the update remembered set. The goal here is to flush periodically to 7 | ensure that we don't end up with a thread who marks their stack on their 8 | local update remembered set and doesn't flush until the nonmoving sync 9 | period as this would result in a large fraction of the heap being marked 10 | during the sync pause. 11 | --- 12 | rts/sm/GC.c | 11 +++++++++++ 13 | 1 file changed, 11 insertions(+) 14 | 15 | diff --git a/rts/sm/GC.c b/rts/sm/GC.c 16 | index 0e80ec40fe..699c01550d 100644 17 | --- a/rts/sm/GC.c 18 | +++ b/rts/sm/GC.c 19 | @@ -734,6 +734,17 @@ GarbageCollect (uint32_t collect_gen, 20 | } 21 | } // for all generations 22 | 23 | + // Flush the update remembered set. The goal here is to flush periodically to 24 | + // ensure that we don't end up with a thread who marks their stack on their 25 | + // local update remembered set and doesn't flush until the nonmoving sync 26 | + // period as this would result in a large fraction of the heap being marked 27 | + // during the sync pause. 28 | + if (RtsFlags.GcFlags.useNonmoving) { 29 | + RELEASE_SM_LOCK; 30 | + nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set.queue); 31 | + ACQUIRE_SM_LOCK; 32 | + } 33 | + 34 | // Mark and sweep the oldest generation. 35 | // N.B. This can only happen after we've moved 36 | // oldest_gen->scavenged_large_objects back to oldest_gen->large_objects. 37 | -- 38 | 2.19.2 39 | 40 | -------------------------------------------------------------------------------- /nix/8.9.1.nonMoving.nix: -------------------------------------------------------------------------------- 1 | { stdenv, pkgsBuildTarget, targetPackages 2 | 3 | # build-tools 4 | , bootPkgs 5 | , autoconf, automake, coreutils, fetchgit, fetchpatch, perl, python3, m4, sphinx 6 | , bash 7 | 8 | , libiconv ? null, ncurses 9 | 10 | , useLLVM ? !stdenv.targetPlatform.isx86 11 | , # LLVM is conceptually a run-time-only depedendency, but for 12 | # non-x86, we need LLVM to bootstrap later stages, so it becomes a 13 | # build-time dependency too. 14 | buildLlvmPackages, llvmPackages 15 | 16 | , # If enabled, GHC will be built with the GPL-free but slower integer-simple 17 | # library instead of the faster but GPLed integer-gmp library. 18 | enableIntegerSimple ? !(stdenv.lib.any (stdenv.lib.meta.platformMatch stdenv.hostPlatform) gmp.meta.platforms), gmp 19 | 20 | , # If enabled, use -fPIC when compiling static libs. 21 | enableRelocatedStaticLibs ? stdenv.targetPlatform != stdenv.hostPlatform 22 | 23 | , # Whether to build dynamic libs for the standard library (on the target 24 | # platform). Static libs are always built. 25 | enableShared ? !stdenv.targetPlatform.isWindows && !stdenv.targetPlatform.useiOSPrebuilt 26 | 27 | , # Whetherto build terminfo. 28 | enableTerminfo ? !stdenv.targetPlatform.isWindows 29 | 30 | , version ? "8.9.20191023" 31 | , # What flavour to build. An empty string indicates no 32 | # specific flavour and falls back to ghc default values. 33 | ghcFlavour ? stdenv.lib.optionalString (stdenv.targetPlatform != stdenv.hostPlatform) 34 | (if useLLVM then "perf-cross" else "perf-cross-ncg") 35 | 36 | , # Whether to disable the large address space allocator 37 | # necessary fix for iOS: https://www.reddit.com/r/haskell/comments/4ttdz1/building_an_osxi386_to_iosarm64_cross_compiler/d5qvd67/ 38 | disableLargeAddressSpace ? stdenv.targetPlatform.isDarwin && stdenv.targetPlatform.isAarch64 39 | }: 40 | 41 | assert !enableIntegerSimple -> gmp != null; 42 | 43 | let 44 | inherit (stdenv) buildPlatform hostPlatform targetPlatform; 45 | 46 | inherit (bootPkgs) ghc; 47 | 48 | # TODO(@Ericson2314) Make unconditional 49 | targetPrefix = stdenv.lib.optionalString 50 | (targetPlatform != hostPlatform) 51 | "${targetPlatform.config}-"; 52 | 53 | buildMK = '' 54 | BuildFlavour = ${ghcFlavour} 55 | ifneq \"\$(BuildFlavour)\" \"\" 56 | include mk/flavours/\$(BuildFlavour).mk 57 | endif 58 | DYNAMIC_GHC_PROGRAMS = ${if enableShared then "YES" else "NO"} 59 | INTEGER_LIBRARY = ${if enableIntegerSimple then "integer-simple" else "integer-gmp"} 60 | '' + stdenv.lib.optionalString (targetPlatform != hostPlatform) '' 61 | Stage1Only = ${if targetPlatform.system == hostPlatform.system then "NO" else "YES"} 62 | CrossCompilePrefix = ${targetPrefix} 63 | HADDOCK_DOCS = NO 64 | BUILD_SPHINX_HTML = NO 65 | BUILD_SPHINX_PDF = NO 66 | '' + stdenv.lib.optionalString enableRelocatedStaticLibs '' 67 | GhcLibHcOpts += -fPIC 68 | GhcRtsHcOpts += -fPIC 69 | '' + stdenv.lib.optionalString targetPlatform.useAndroidPrebuilt '' 70 | EXTRA_CC_OPTS += -std=gnu99 71 | ''; 72 | 73 | # Splicer will pull out correct variations 74 | libDeps = platform: stdenv.lib.optional enableTerminfo [ ncurses ] 75 | ++ stdenv.lib.optional (!enableIntegerSimple) gmp 76 | ++ stdenv.lib.optional (platform.libc != "glibc" && !targetPlatform.isWindows) libiconv; 77 | 78 | toolsForTarget = [ 79 | pkgsBuildTarget.targetPackages.stdenv.cc 80 | ] ++ stdenv.lib.optional useLLVM buildLlvmPackages.llvm; 81 | 82 | targetCC = builtins.head toolsForTarget; 83 | 84 | in 85 | stdenv.mkDerivation (rec { 86 | inherit version; 87 | inherit (src) rev; 88 | name = "${targetPrefix}ghc-${version}"; 89 | 90 | enableParallelBuilding = true; 91 | 92 | src = fetchgit { 93 | url = "https://gitlab.haskell.org/ghc/ghc.git/"; 94 | rev = "7f72b540288bbdb32a6750dd64b9d366501ed10c"; 95 | sha256 = "16fd0gv18q491312iqm7fhwp4p11bj5xrpap58gh4dp15n6q3gs9"; 96 | fetchSubmodules = true; 97 | }; 98 | 99 | outputs = [ "out" "doc" ]; 100 | 101 | patches = []; 102 | 103 | postPatch = "patchShebangs ."; 104 | 105 | # GHC is a bit confused on its cross terminology. 106 | preConfigure = '' 107 | for env in $(env | grep '^TARGET_' | sed -E 's|\+?=.*||'); do 108 | export "''${env#TARGET_}=''${!env}" 109 | done 110 | # GHC is a bit confused on its cross terminology, as these would normally be 111 | # the *host* tools. 112 | export CC="${targetCC}/bin/${targetCC.targetPrefix}cc" 113 | export CXX="${targetCC}/bin/${targetCC.targetPrefix}cxx" 114 | # Use gold to work around https://sourceware.org/bugzilla/show_bug.cgi?id=16177 115 | # and more generally have a faster linker. 116 | export LD="${targetCC.bintools}/bin/${targetCC.bintools.targetPrefix}ld${stdenv.lib.optionalString targetPlatform.isLinux ".gold"}" 117 | export AS="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}as" 118 | export AR="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}ar" 119 | export NM="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}nm" 120 | export RANLIB="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}ranlib" 121 | export READELF="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}readelf" 122 | export STRIP="${targetCC.bintools.bintools}/bin/${targetCC.bintools.targetPrefix}strip" 123 | 124 | echo -n "${buildMK}" > mk/build.mk 125 | echo ${version} >VERSION 126 | echo ${src.rev} >GIT_COMMIT_ID 127 | ./boot 128 | sed -i -e 's|-isysroot /Developer/SDKs/MacOSX10.5.sdk||' configure 129 | '' + stdenv.lib.optionalString (!stdenv.isDarwin) '' 130 | export NIX_LDFLAGS+=" -rpath $out/lib/ghc-${version}" 131 | '' + stdenv.lib.optionalString stdenv.isDarwin '' 132 | export NIX_LDFLAGS+=" -no_dtrace_dof" 133 | '' + stdenv.lib.optionalString targetPlatform.useAndroidPrebuilt '' 134 | sed -i -e '5i ,("armv7a-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "cortex-a8", ""))' llvm-targets 135 | '' + stdenv.lib.optionalString targetPlatform.isMusl '' 136 | echo "patching llvm-targets for musl targets..." 137 | echo "Cloning these existing '*-linux-gnu*' targets:" 138 | grep linux-gnu llvm-targets | sed 's/^/ /' 139 | echo "(go go gadget sed)" 140 | sed -i 's,\(^.*linux-\)gnu\(.*\)$,\0\n\1musl\2,' llvm-targets 141 | echo "llvm-targets now contains these '*-linux-musl*' targets:" 142 | grep linux-musl llvm-targets | sed 's/^/ /' 143 | 144 | echo "And now patching to preserve '-musleabi' as done with '-gnueabi'" 145 | # (aclocal.m4 is actual source, but patch configure as well since we don't re-gen) 146 | for x in configure aclocal.m4; do 147 | substituteInPlace $x \ 148 | --replace '*-android*|*-gnueabi*)' \ 149 | '*-android*|*-gnueabi*|*-musleabi*)' 150 | done 151 | ''; 152 | 153 | # TODO(@Ericson2314): Always pass "--target" and always prefix. 154 | configurePlatforms = [ "build" "host" ] 155 | ++ stdenv.lib.optional (targetPlatform != hostPlatform) "target"; 156 | # `--with` flags for libraries needed for RTS linker 157 | configureFlags = [ 158 | "--datadir=$doc/share/doc/ghc" 159 | "--with-curses-includes=${ncurses.dev}/include" "--with-curses-libraries=${ncurses.out}/lib" 160 | ] ++ stdenv.lib.optional (targetPlatform == hostPlatform && !enableIntegerSimple) [ 161 | "--with-gmp-includes=${targetPackages.gmp.dev}/include" "--with-gmp-libraries=${targetPackages.gmp.out}/lib" 162 | ] ++ stdenv.lib.optional (targetPlatform == hostPlatform && hostPlatform.libc != "glibc" && !targetPlatform.isWindows) [ 163 | "--with-iconv-includes=${libiconv}/include" "--with-iconv-libraries=${libiconv}/lib" 164 | ] ++ stdenv.lib.optionals (targetPlatform != hostPlatform) [ 165 | "--enable-bootstrap-with-devel-snapshot" 166 | ] ++ stdenv.lib.optionals (targetPlatform.isAarch32) [ 167 | "CFLAGS=-fuse-ld=gold" 168 | "CONF_GCC_LINKER_OPTS_STAGE1=-fuse-ld=gold" 169 | "CONF_GCC_LINKER_OPTS_STAGE2=-fuse-ld=gold" 170 | ] ++ stdenv.lib.optionals (disableLargeAddressSpace) [ 171 | "--disable-large-address-space" 172 | ]; 173 | 174 | # Make sure we never relax`$PATH` and hooks support for compatability. 175 | strictDeps = true; 176 | 177 | nativeBuildInputs = [ 178 | perl autoconf automake m4 python3 sphinx 179 | ghc bootPkgs.alex bootPkgs.happy bootPkgs.hscolour 180 | ]; 181 | 182 | # For building runtime libs 183 | depsBuildTarget = toolsForTarget; 184 | 185 | buildInputs = [ perl bash ] ++ (libDeps hostPlatform); 186 | 187 | propagatedBuildInputs = [ targetPackages.stdenv.cc ] 188 | ++ stdenv.lib.optional useLLVM llvmPackages.llvm; 189 | 190 | depsTargetTarget = map stdenv.lib.getDev (libDeps targetPlatform); 191 | depsTargetTargetPropagated = map (stdenv.lib.getOutput "out") (libDeps targetPlatform); 192 | 193 | # required, because otherwise all symbols from HSffi.o are stripped, and 194 | # that in turn causes GHCi to abort 195 | stripDebugFlags = [ "-S" ] ++ stdenv.lib.optional (!targetPlatform.isDarwin) "--keep-file-symbols"; 196 | 197 | checkTarget = "test"; 198 | 199 | hardeningDisable = [ "format" ] ++ stdenv.lib.optional stdenv.targetPlatform.isMusl "pie"; 200 | 201 | postInstall = '' 202 | # Install the bash completion file. 203 | install -D -m 444 utils/completion/ghc.bash $out/share/bash-completion/completions/${targetPrefix}ghc 204 | 205 | # Patch scripts to include "readelf" and "cat" in $PATH. 206 | for i in "$out/bin/"*; do 207 | test ! -h $i || continue 208 | egrep --quiet '^#!' <(head -n 1 $i) || continue 209 | sed -i -e '2i export PATH="$PATH:${stdenv.lib.makeBinPath [ targetPackages.stdenv.cc.bintools coreutils ]}"' $i 210 | done 211 | ''; 212 | 213 | passthru = { 214 | inherit bootPkgs targetPrefix; 215 | 216 | inherit llvmPackages; 217 | inherit enableShared; 218 | 219 | # Our Cabal compiler name 220 | haskellCompilerName = "ghc-${version}"; 221 | }; 222 | 223 | meta = { 224 | homepage = http://haskell.org/ghc; 225 | description = "The Glasgow Haskell Compiler"; 226 | maintainers = with stdenv.lib.maintainers; [ marcweber andres peti ]; 227 | inherit (ghc.meta) license platforms; 228 | }; 229 | 230 | } // stdenv.lib.optionalAttrs targetPlatform.useAndroidPrebuilt { 231 | dontStrip = true; 232 | dontPatchELF = true; 233 | noAuditTmpdir = true; 234 | }) 235 | -------------------------------------------------------------------------------- /nix/ghc-8.8.0.20190730-src.tar.xz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pepeiborra/gc-benchmarks/907ad3c309d72ee585b79a044fa9bf8aedbc3a93/nix/ghc-8.8.0.20190730-src.tar.xz -------------------------------------------------------------------------------- /nix/overlay.nix: -------------------------------------------------------------------------------- 1 | # Inspired by https://mpickering.github.io/posts/2018-01-05-ghchead-nix.html 2 | nixpkgs: nixpkgsSup: 3 | with nixpkgs; 4 | let 5 | patchRepo = 6 | fetchFromGitHub{ 7 | owner = "hvr"; 8 | repo = "head.hackage"; 9 | rev = "3d067229c463ca2c1eb52bf353620f7ce9ebc265"; 10 | sha256 = "1gq3c0racwmkjxfm67hg63c0akp1wfj5g855llif8q0kiivyqjap"; 11 | }; 12 | patchDir = "${patchRepo}/patches"; 13 | patchScript = "${patchRepo}/scripts/overrides.nix"; 14 | callNonMovingHaskellPackage = buildPackages.newScope { 15 | haskellLib = haskell.lib; 16 | overrides = haskell.packageOverrides; 17 | }; 18 | localHackageOverrides = sel: sup: 19 | { haskell-src-exts = sel.callHackage "haskell-src-exts" "1.20.1" {}; 20 | # fix the nixpkgs configuration for 8.9 21 | unordered-containers = sel.callHackage "unordered-containers" "0.2.10.0" {}; 22 | # overriding mkDerivation leads to circular recursion for reasons unknown 23 | # mkDerivation = drv: sup.mkDerivation (drv // { jailbreak = true; doHaddock = false;}); 24 | }; 25 | in 26 | { haskell = nixpkgsSup.haskell // { 27 | headHackagePatches = callPackage patchScript { patches = patchDir; }; 28 | headHackageOverrides = callPackage haskell.headHackagePatches {}; 29 | compiler = nixpkgsSup.haskell.compiler // { 30 | ghc891NonMoving = callPackage ./8.9.1.nonMoving.nix { 31 | bootPkgs = haskell.packages.ghc863Binary; 32 | inherit (buildPackages.python3Packages) sphinx; 33 | buildLlvmPackages = buildPackages.llvmPackages_7; 34 | llvmPackages = llvmPackages_7; 35 | }; 36 | }; 37 | packages = nixpkgsSup.haskell.packages // { 38 | ghc891NonMoving= 39 | (callNonMovingHaskellPackage "${}/pkgs/development/haskell-modules" { 40 | buildHaskellPackages = buildPackages.haskell.packages.ghc891NonMoving; 41 | ghc = buildPackages.haskell.compiler.ghc891NonMoving; 42 | compilerConfig = callNonMovingHaskellPackage "${}/pkgs/development/haskell-modules/configuration-ghc-8.8.x.nix" { }; 43 | }).extend(lib.composeExtensions localHackageOverrides haskell.headHackageOverrides) ; 44 | }; 45 | }; 46 | } 47 | --------------------------------------------------------------------------------