diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for hs-speedscope + +## 0.1 -- 2019-10-29 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Matthew Pickering + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Matthew Pickering nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,12 @@ +# hs-speedscope + +`hs-speedscope` is a simple executable for converting an eventlog into a format suitable to load into [speedscope](https://www.speedscope.app/). + +WARNING: Only GHC 8.10 supports generating an eventlog with the correct events for this program to work. + +## Usage + +1. Create an eventlog which contains time profiling events by running your program with `program +RTS -p -l-au`. +2. Run `hs-speedscope` on the resulting eventlog `hs-speedscope program.eventlog`. +3. Load the resulting `program.eventlog.json` file into [speedscope](https://speedscope.app) to visualise the profile. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import HsSpeedscope + +main :: IO () +main = entry diff --git a/hs-speedscope.cabal b/hs-speedscope.cabal new file mode 100644 --- /dev/null +++ b/hs-speedscope.cabal @@ -0,0 +1,50 @@ +cabal-version: 2.4 +-- Initial package description 'hs-speedscope.cabal' generated by 'cabal +-- init'. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: hs-speedscope +version: 0.1.0.0 +synopsis: Convert an eventlog into the speedscope json format +description: Convert an eventlog into the speedscope json format. The interactive visualisation + displays an approximate trace of the program and summary views akin to .prof files. + There is also support for parallel programs, each capability is rendered in its own + profile. +-- bug-reports: +license: BSD-3-Clause +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +category: Development +tested-with: GHC==8.8.1 +extra-source-files: CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/mpickering/hs-speedscope.git + +library + exposed-modules: HsSpeedscope + other-modules: Paths_hs_speedscope + autogen-modules: Paths_hs_speedscope + -- other-modules: + -- other-extensions: + build-depends: base >= 4.12.0.0 && < 5, + ghc-events >= 0.11, + aeson >= 1.4, + text >= 1.2, + vector >= 0.12, + extra >= 1.6, + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + +executable hs-speedscope + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.12.0.0 && < 5, hs-speedscope + hs-source-dirs: exe + default-language: Haskell2010 diff --git a/src/HsSpeedscope.hs b/src/HsSpeedscope.hs new file mode 100644 --- /dev/null +++ b/src/HsSpeedscope.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +module HsSpeedscope where + + +import Data.Aeson +import GHC.RTS.Events + +import Data.Word +import Data.Text (Text) +import qualified Data.Vector.Unboxed as V +import System.Environment +import Data.Maybe +import Data.List.Extra +import Control.Monad +import Data.Char + +import Data.Version +import Text.ParserCombinators.ReadP +import qualified Paths_hs_speedscope as Paths + +entry :: IO () +entry = do + fps <- getArgs + case fps of + [fp] -> do + el <- either error id <$> readEventLogFromFile fp + encodeFile (fp ++ ".json") (convertToSpeedscope el) + _ -> error "Usage: hs-speedscope program.eventlog" + +convertToSpeedscope :: EventLog -> Value +convertToSpeedscope (EventLog _h (Data es)) = + case el_version of + Just (ghc_version, _) | ghc_version <= makeVersion [8,9,0] -> + error ("Eventlog is from ghc-" ++ showVersion ghc_version ++ " hs-speedscope only works with GHC 8.10 or later") + _ -> object [ "version" .= ("0.0.1" :: String) + , "$schema" .= ("https://www.speedscope.app/file-format-schema.json" :: String) + , "shared" .= object [ "frames" .= ccs_json ] + , "profiles" .= map (mkProfile profile_name interval) caps + , "name" .= profile_name + , "activeProfileIndex" .= (0 :: Int) + , "exporter" .= version_string + ] + where + (EL (fromMaybe "" -> profile_name) el_version (fromMaybe 1 -> interval) frames samples) = + foldr processEvents initEL es + + initEL = EL Nothing Nothing Nothing [] [] + + version_string :: String + version_string = "hs-speedscope@" ++ showVersion Paths.version + + -- Drop 7 events for built in cost centres like GC, IDLE etc + + ccs_json :: [Value] + ccs_json = map mkFrame (reverse (drop 7 frames)) + + num_frames = length ccs_json + + + caps :: [(Capset, [[Int]])] + caps = groupSort $ mapMaybe mkSample samples + + mkFrame :: CostCentre -> Value + mkFrame (CostCentre _n l _m s) = object [ "name" .= l, "file" .= s ] + + mkSample :: Sample -> Maybe (Capset, [Int]) + -- Filter out system frames + mkSample (Sample _ti [k]) | fromIntegral k >= num_frames = Nothing + mkSample (Sample ti ccs) = Just (ti, reverse $ map (subtract 1 . fromIntegral) ccs) + + + processEvents :: Event -> EL -> EL + processEvents (Event _t ei _c) el = + case ei of + ProgramArgs _ (pname: _args) -> el { prog_name = Just pname } + RtsIdentifier _ rts_ident -> el { rts_version = parseIdent rts_ident } + ProfBegin ival -> el { prof_interval = Just ival } + HeapProfCostCentre n l m s _ -> el { cost_centres = CostCentre n l m s : cost_centres el } + ProfSampleCostCentre t _ _ st -> el { el_samples = Sample t (V.toList st) : el_samples el } + _ -> el + +mkProfile :: String -> Word64 -> (Capset, [[Int]]) -> Value +mkProfile pname interval (_n, samples) = + object [ "type" .= ("sampled" :: String) + , "unit" .= ("nanoseconds" :: String) + , "name" .= pname + , "startValue" .= (0 :: Int) + , "endValue" .= (length samples :: Int) + , "samples" .= samples + , "weights" .= sample_weights ] + where + sample_weights :: [Word64] + sample_weights = replicate (length samples) interval + +parseIdent :: String -> Maybe (Version, String) +parseIdent s = listToMaybe $ flip readP_to_S s $ do + void $ string "GHC-" + [v1, v2, v3] <- replicateM 3 (intP <* optional (char '.')) + skipSpaces + return (makeVersion [v1,v2,v3]) + where + intP = do + x <- munch1 isDigit + return $ read x + +data EL = EL { + prog_name :: Maybe String + , rts_version :: Maybe (Version, String) + , prof_interval :: Maybe Word64 + , cost_centres :: [CostCentre] + , el_samples :: [Sample] +} + +data CostCentre = CostCentre Word32 Text Text Text + +data Sample = Sample Capset [Word32]