diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 25808c4..2f9d1bc 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -1,20 +1,20 @@ -# packcheck-0.6.0 +# packcheck-0.7.1 # You can use any of the options supported by packcheck as environment # variables here. See https://github.com/composewell/packcheck for all # options and their explanation. -name: packcheck +name: TEST #----------------------------------------------------------------------------- # Events on which the build should be triggered #----------------------------------------------------------------------------- on: + workflow_dispatch: + pull_request: push: branches: - master - pull_request: - #----------------------------------------------------------------------------- # Build matrix @@ -23,18 +23,11 @@ on: jobs: build: name: >- - ${{ matrix.name }} - ${{ matrix.command }} ${{ matrix.runner }} + ${{ matrix.command }} ${{ matrix.ghc_version }} + ${{ matrix.name }} env: - # ------------------------------------------------------------------------ - # Common options - # ------------------------------------------------------------------------ - # GHC_OPTIONS: "-Werror" - CABAL_REINIT_CONFIG: y - LC_ALL: C.UTF-8 - # ------------------------------------------------------------------------ # What to build # ------------------------------------------------------------------------ @@ -48,113 +41,470 @@ jobs: # ------------------------------------------------------------------------ # Selecting tool versions # ------------------------------------------------------------------------ - GHCVER: ${{ matrix.ghc_version }} - # RESOLVER: ${{ matrix.stack_resolver }} + # For updating see: https://downloads.haskell.org/~ghcup/ + #GHCUP_VERSION: 0.1.50.2 # ------------------------------------------------------------------------ - # stack options + # cabal options + # ------------------------------------------------------------------------ + + # CABAL_BUILD_OPTIONS="-j1" + # Enable the above option if you: + # 1. want logs in serial order to be able to correlate them better. + # + # 2. run into memory issues due to Build paralellism. We need to + # have sufficient per CPU memory, if not we can use a lower -j + # option; cabal default is ncpus. + # + # Currently (2026-03-12) from packcheck output we see: + # Linux: 15GB, 4 cpus + # macOS: 7GB, 3 cpus + # Windows: 16GB, 4 cpus + + # ------------------------------------------------------------------------ + # stack options (if using stack builds) # ------------------------------------------------------------------------ # Note requiring a specific version of stack using STACKVER may fail due to # github API limit while checking and upgrading/downgrading to the specific # version. #STACKVER: "1.6.5" #STACK_UPGRADE: "y" - STACK_YAML: "stack.yaml" # ------------------------------------------------------------------------ - # cabal options + # Common options # ------------------------------------------------------------------------ - CABAL_CHECK_RELAX: y - CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com" - CABAL_PROJECT: ${{ matrix.cabal_project }} - CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }} - DISABLE_SDIST_PROJECT_CHECK: y - DISABLE_DOCS: "y" - DISABLE_TEST: "y" - DISABLE_BENCH: "y" - # ------------------------------------------------------------------------ - # Where to find the required tools - # ------------------------------------------------------------------------ - PATH: /opt/ghc/bin:/sbin:/usr/sbin:/bin:/usr/bin - #TOOLS_DIR: /opt + # Subdir + SUBDIR: ${{ matrix.subdir }} + + # If this option is enabled packcheck clears out the environment + # and only uses the options explicitly set on the command line, + # implicit environment won't affect the build. if you find this + # annoying comment this. + CHECK_ENV: "y" + + # NOTE: by capturing the options in env variables here quotes + # are presrved, if we expand them directly into the script + # quotes are lost. + # + # WARNING! you cannot use comments in this + COMMON_OPTIONS: >- + LC_ALL=C.UTF-8 + BUILD_PREFETCH=y + GHCUP_VERSION=latest + GHCVER=${{ matrix.ghc_version }} + + # WARNING! you cannot use comments in this + CABAL_OPTIONS: >- + CABAL_REINIT_CONFIG=y + CABAL_CHECK_RELAX=y + + MATRIX_OPTIONS: ${{ matrix.pack_options }} # ------------------------------------------------------------------------ # Location of packcheck.sh (the shell script invoked to perform CI tests ). # ------------------------------------------------------------------------ - # You can either commit the packcheck.sh script at this path in your repo or - # you can use it by specifying the PACKCHECK_REPO_URL option below in which - # case it will be automatically copied from the packcheck repo to this path - # during CI tests. In any case it is finally invoked from this path. - PACKCHECK: "./packcheck.sh" + # You can either commit the packcheck.sh script in your repo root or + # you can use it by specifying the PACKCHECK_REPO_URL option. # If you have not committed packcheck.sh in your repo at PACKCHECK # then it is automatically pulled from this URL. PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck" - PACKCHECK_GITHUB_COMMIT: "v0.6.0" - - # ------------------------------------------------------------------------ - # Final build variables - # ------------------------------------------------------------------------ - PACKCHECK_COMMAND: ${{ matrix.command }} ${{ matrix.pack_options }} + PACKCHECK_GITHUB_COMMIT: "b91dd7daf50d91047ca8c1cce47e8634e34dfcbc" + # ubuntu seems to have better support than debian on CI systems runs-on: ${{ matrix.runner }} + #continue-on-error: ${{ matrix.ignore_error }} strategy: fail-fast: false matrix: + + # The order of jobs is important to optimize fail-fast, if + # fail-fast is set to true. + + # This section is to order the important jobs first especially for + # "fail-fast" so that these are the ones started first. + #name: + # - ci + + # IMPORTANT NOTE: + # If runner, command, ghc version are identical then the name of + # CI is used to distinguish the cache key. + + # The reason we have an explicit "name" field in the following + # entries is to force an additional config instead of adding to + # an existing config while adding additional configs. + # Look at + # for more info about adding matrix elements. + # Adding any element to the list will increase the number of matrix + # elements proportional to the cross product. + include: - - name: 9.4.4-linux - command: cabal-v2 + + #- name: ci + # runner: ubuntu-latest + # command: cabal + # ghc_version: head + # # The URL may change, to find a working URL go to https://gitlab.haskell.org/ghc/ghc/-/jobs/ + # # Find a debian10/11/12 job, click on a passed/failed status, at the + # # end of the output you will find the tar.xz name, put that tar + # # name after "raw/", and put the job name after "job=". + # # Also see https://github.com/mpickering/ghc-artefact-nix/blob/master/gitlab-artifact.nix + # # + # # May also use ghcup for installing ghc head version, use the + # # version "LatestNightly", and the following config: + # # ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml + # # WARNING! cannot use # comments inside pack_options. + # pack_options: >- + # GHCUP_GHC_OPTIONS="-u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-deb10-int_native-validate.tar.xz?job=x86_64-linux-deb10-int_native-validate" + # CABAL_PROJECT=cabal.project.ghc-head + # DISABLE_SDIST_BUILD="y" + + - name: ci + runner: ubuntu-latest + command: cabal + ghc_version: 9.14.1 + # WARNING! cannot use # comments inside pack_options. + #pack_options: >- + # CABAL_PROJECT=cabal.project + + - name: ci + runner: macos-latest + command: cabal + ghc_version: 9.12.4 + # autoreconf required by SDIST build when a configure script + # is present, is not available by default on macOS, so + # disable it. + # WARNING! cannot use # comments inside pack_options. + pack_options: >- + DISABLE_SDIST_BUILD=y + + - name: ci runner: ubuntu-latest - ghc_version: 9.4.4 - cabal_project: cabal.project.user + command: cabal + ghc_version: 9.10.3 + # WARNING! cannot use # comments inside pack_options. + #pack_options: >- + # CABAL_PROJECT=cabal.project - - name: 9.2.7-linux - command: cabal-v2 + - name: ghc-9.10.3 runner: ubuntu-latest - ghc_version: 9.2.7 - cabal_project: cabal.project.user + command: stack + # WARNING! cannot use # comments inside pack_options. + # STACK_YAML="stack.yaml" + pack_options: >- + STACK_UPGRADE="y" + RESOLVER= + DISABLE_SDIST_BUILD="y" + + - name: ci + runner: ubuntu-latest + command: cabal + ghc_version: 9.8.4 + # WARNING! cannot use # comments inside pack_options. + #pack_options: >- + # CABAL_PROJECT=cabal.project + + - name: ci + runner: ubuntu-latest + command: cabal + ghc_version: 9.6.3 + # WARNING! cannot use # comments inside pack_options. + #pack_options: >- + # CABAL_PROJECT=cabal.project + + - name: ci + runner: windows-latest + command: cabal + ghc_version: 9.14.1 + # On Windows, DISABLE_SDIST_BUILD is useful for (1) avoiding + # path length restriction, (2) avoid installing autoreconf + # for configure builds. + # WARNING! cannot use # comments inside pack_options. + pack_options: >- + DISABLE_SDIST_BUILD="y" - - name: 9.0.2-linux - command: cabal-v2 + - name: ci runner: ubuntu-latest - ghc_version: 9.0.2 - cabal_project: cabal.project.user + command: hlint + # WARNING! cannot use # comments inside pack_options. + pack_options: >- + HLINT_VERSION=3.6.1 + HLINT_OPTIONS="lint" + HLINT_TARGETS="src" + + #- name: docspec + # runner: ubuntu-latest + # command: cabal + # ghc_version: 9.12.4 + # # WARNING! cannot use # comments inside pack_options. + # pack_options: >- + # ENABLE_DOCSPEC="y" + # DOCSPEC_URL=https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20250606/cabal-docspec-0.0.0.20250606-x86_64-linux.xz + # DOCSPEC_OPTIONS="--timeout 60" + # CABAL_PROJECT=cabal.project + +#----------------------------------------------------------------------------- +# Usually you do not need to change anything below, this is generic code for +# caching and running packcheck on Linux/Mac/Windows. +#----------------------------------------------------------------------------- steps: - - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 - if: ${{ matrix.name != 'hlint' }} + - name: Enable long paths on Windows + if: runner.os == 'Windows' + shell: powershell + continue-on-error: true + run: | + # Enable long paths. Sometimes failures occur due to path + # length limitation. + Set-ItemProperty -Path 'HKLM:\System\CurrentControlSet\Control\FileSystem' -Name 'LongPathsEnabled' -value 1 + + # Cache saving is very slow on Windows, it could be due to tar, + # or the compression program or the file system. Changing the + # compression level of zstd does not help. We are also not able to pick + # another tar program by changing the path, tar is picked up by the + # cache action itself. + + # This does not seem to make much difference. + # Disable Windows Defender to speed up IO/Tar operations + #Set-MpPreference -DisableRealtimeMonitoring $true + + - uses: actions/checkout@v4 + + # This should happen before cache restore. + - name: Remove ~/.ghcup symlink (non-Windows) + if: runner.os != 'Windows' + run: | + rm -f ~/.ghcup + + # See the "cabal path" output in the CI logs to tweak the cache + # locations. + + # Shared by all tests, all platforms + - name: Restore hackage package index (non-Windows) + id: restore-hackage + uses: actions/cache/restore@v4 + if: runner.os != 'Windows' with: - ghc-version: ${{ matrix.ghc_version }} - enable-stack: true - stack-version: 'latest' - cabal-version: 'latest' + path: | + ~/.cache/cabal/packages + key: cabal-hackage-index-non-windows + + # GHC is not test/options specific + - name: Restore ghcup and ghc (non-Windows) + id: restore-ghcup + uses: actions/cache/restore@v4 + if: runner.os != 'Windows' + with: + path: | + ~/.ghcup + key: ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }} - - uses: actions/cache@v2 - name: Cache common directories + # GHC is not test/options specific + #- name: Restore ghcup and ghc (Windows) + # id: restore-ghcup-win + # uses: actions/cache/restore@v4 + # if: runner.os == 'Windows' + # with: + # path: | + # C:/ghcup + # key: ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }} + + # XXX If we want to invalidate the cache on resolver change we + # should use a separate cache for stack as it should be keyed on + # resolver as well. But that requires resolver as a matrix element + # and then copied to pack_options from there, needs some work. It + # should be fine as resolver minor version change can only increase + # the cache size. + # Deps are test/options specific + - name: Restore build dependencies (non-Windows) + id: restore-deps-nonwin + uses: actions/cache/restore@v4 + if: runner.os != 'Windows' with: + # cabal: ~/.local/bin, ~/.local/state/cabal + # ~/.cache/cabal/packages can be cached, but will increase the + # cache size. But can save the "cabal update" time. path: | - ~/.cabal - ~/.ghc - ~/.local + ~/.local/bin + ~/.local/state/cabal ~/.stack - key: ${{ matrix.command }}-${{ matrix.ghc_version }}-${{ matrix.runner }} + key: ${{ matrix.command }}-deps-ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }}-${{ matrix.name }} + + # Deps are test/options specific + - name: Restore build dependencies, hackage index, local/bin (Windows) + id: restore-deps-win + uses: actions/cache/restore@v4 + if: runner.os == 'Windows' + with: + path: | + C:/cabal + key: ${{ matrix.command }}-deps-ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }}-${{ matrix.name }} - name: Download packcheck + # on windows-latest GitHub Actions defaults to PowerShell + shell: bash + run: | + download_one () { + if test ! -e "$1" + then + if test -z "$PACKCHECK_GITHUB_COMMIT" + then + die "Downloading [$1]: PACKCHECK_GITHUB_COMMIT env var is not specified." + fi + PACKCHECK_URL_PREFIX=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT} + curl --fail -sLO ${PACKCHECK_URL_PREFIX}/$1 || exit 1 + chmod +x "$1" + elif test ! -x "$1" + then + chmod +x $1 + fi + } + if test -n "$SUBDIR"; then + cd "$SUBDIR" + fi + download_one packcheck.sh + + # Store the function in a file so that it can be reused across multiple + # steps. + - name: Setup packcheck + shell: bash run: | - # Check for PACKCHECK_GITHUB_COMMIT - if test -z "$PACKCHECK_GITHUB_COMMIT" - then - die "PACKCHECK_GITHUB_COMMIT is not specified." + if test -n "$SUBDIR"; then + rm -f cabal.project + cd "$SUBDIR" fi + cat << 'EOF' > packcheck-setup.sh + setup_packcheck_args() { + ARGS="${{ matrix.command }} $COMMON_OPTIONS" + if test "${{ matrix.command }}" = "cabal"; then + ARGS="$ARGS $CABAL_OPTIONS" + fi + + # Caution: do not use matrix.pack_options directly here + # quotes will get stripped. + ARGS="$ARGS $MATRIX_OPTIONS" + PATH_VAR=/bin:/usr/bin:/sbin:/usr/sbin - # Get packcheck if needed - CURL=$(which curl) - PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh - if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi; - chmod +x $PACKCHECK + case "$(uname)" in + Linux) + export GHCUP_INSTALL_BASE_PREFIX=$HOME + # Access usr/local seems to be much slower on github + #PATH_VAR="$PATH_VAR:/usr/local/.ghcup/bin" + ;; + CYGWIN*|MINGW*|MSYS*) + for var in APPDATA CABAL_DIR; do + val="${!var}" + [ -n "$val" ] && ARGS="$ARGS $var=\"$(cygpath -u "$val")\"" + done + ARGS="$ARGS CABAL_BUILDDIR=\"/c/b\" WINVER=$WINVER" + ARGS="$ARGS NUMBER_OF_PROCESSORS=$NUMBER_OF_PROCESSORS" + ARGS="$ARGS PROCESSOR_IDENTIFIER=\"$PROCESSOR_IDENTIFIER\"" + PATH_VAR="$PATH_VAR:/c/ghcup:/c/Program Files/7-Zip:/mingw64/bin" + ;; + esac + ARGS="$ARGS PATH=\"$PATH_VAR\"" + export ARGS + } + EOF - - name: Run packcheck + - name: Run packcheck (dependencies only) + id: deps-only + # Check the relevant step based on the runner OS + if: | + (runner.os != 'Windows' && steps.restore-deps-nonwin.outputs.cache-hit != 'true') || + (runner.os == 'Windows' && steps.restore-deps-win.outputs.cache-hit != 'true') + shell: bash run: | - bash -c "$PACKCHECK $PACKCHECK_COMMAND" + if test -n "$SUBDIR"; then + cd "$SUBDIR" + fi + source packcheck-setup.sh + setup_packcheck_args + eval "./packcheck.sh $ARGS BUILD_DEPS_ONLY=y" + + - name: Save hackage package index (non-Windows) + uses: actions/cache/save@v4 + if: always() && steps.deps-only.outcome == 'success' && runner.os != 'Windows' && steps.restore-hackage.outputs.cache-hit != 'true' + with: + path: ~/.cache/cabal/packages + key: cabal-hackage-index-non-windows + + - name: Save ghcup and ghc (non-Windows) + uses: actions/cache/save@v4 + if: always() && steps.deps-only.outcome == 'success' && runner.os != 'Windows' && steps.restore-ghcup.outputs.cache-hit != 'true' + with: + path: ~/.ghcup + key: ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }} + + # On Windows, ghc restore step takes 2-3 minutes whereas installing + # GHC takes less than 2 minutes. On top of this saving the ghc cache + # takes 7 minutes. So this does not make sense. + #- name: Save ghcup and ghc (Windows) + # uses: actions/cache/save@v4 + # if: always() && steps.deps-only.outcome == 'success' && runner.os == 'Windows' && steps.restore-ghcup-win.outputs.cache-hit != 'true' + # with: + # path: | + # C:/ghcup + # key: ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }} + + # Deps are test/options specific, hence, matrix.name in the key + - name: Save build dependencies (non-Windows) + uses: actions/cache/save@v4 + if: always() && steps.deps-only.outcome == 'success' && runner.os != 'Windows' && steps.restore-deps-nonwin.outputs.cache-hit != 'true' + with: + path: | + ~/.local/bin + ~/.local/state/cabal + ~/.stack + key: ${{ matrix.command }}-deps-ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }}-${{ matrix.name }} + + # hackage package index is part of C:/cabal + # Deps are test/options specific, hence, matrix.name in the key + # Add if needed ~/AppData/Roaming/local + - name: Save build dependencies (Windows) + uses: actions/cache/save@v4 + if: always() && steps.deps-only.outcome == 'success' && runner.os == 'Windows' && steps.restore-deps-win.outputs.cache-hit != 'true' + with: + path: | + C:/cabal + key: ${{ matrix.command }}-deps-ghc-${{ matrix.ghc_version }}-v${{ matrix.ghc_salt }}-${{ matrix.runner }}-${{ matrix.name }} + + - name: Run packcheck (final build) + shell: bash + run: | + if test -n "$SUBDIR"; then + cd "$SUBDIR" + fi + source packcheck-setup.sh + setup_packcheck_args + eval "./packcheck.sh $ARGS BUILD_PACKAGE_ONLY=y" + + # Enable for debugging, this itself takes 50 sec on Windows, in packcheck + # build which is tiny. + #- name: Check cache locations + # shell: bash + # run: | + # # We want to see if any cache paths are symlinks; e.g. on github + # # ~/.ghcup is a pre-existing symlink to /usr/local. + # if [ "$RUNNER_OS" == "Windows" ]; then + # # Convert Windows paths to Unix-style for Bash + # APPDATA_UNIX=$(cygpath "$APPDATA") + # list="$APPDATA_UNIX/local C:/ghcup C:/cabal" + # else + # list="$HOME/.local/bin $HOME/.local/state/cabal $HOME/.ghcup $HOME/.stack" + # fi + + # for dir in $list; do + # # macOS does not have --no-dereference option + # if [ -L "$dir" ]; then + # echo "$dir is a symlink -> $(readlink $dir)" + # elif [ -d "$dir" ]; then + # du -sh "$dir" 2>/dev/null || echo "$dir permission denied" + # else + # echo "$dir missing or not a dir" + # fi + # done + # echo + # #ls -ld $list 2>/dev/null || true + # ls -al $list 2>/dev/null || true diff --git a/.packcheck.ignore b/.packcheck.ignore index 95dbc69..6efc0c7 100644 --- a/.packcheck.ignore +++ b/.packcheck.ignore @@ -2,3 +2,5 @@ .github/workflows/haskell.yml cabal.project.user .gitignore +flake.lock +flake.nix diff --git a/README.md b/README.md index b3ac152..e78b8a9 100644 --- a/README.md +++ b/README.md @@ -1,378 +1,57 @@ -# haskell-perf +# Haskell Performance Analysis -GHC Patch: https://github.com/composewell/ghc/tree/ghc-8.10.7-eventlog-enhancements +## Analysis Methods: -## Enable Linux perf counters +There are three different ways of investigating the performance: -Enable unrestricted use of perf counters: +* GHC RTS Stats (available in stock GHC) +* threadCPUTime# RTS primitive (available in patched GHC) +* GHC Event logging (available in patched GHC) -``` -# echo -1 > /proc/sys/kernel/perf_event_paranoid -``` +## Why this package? -## Disable CPU scaling +* GHC RTS does not provide thread-wise stats, so it is not useful in + multi-threaded programs. Not useful in production systems. +* It does not give accurate point-to-point allocation stats, only gc-to-gc + stats which are not very useful in production systems. -Set the scaling governer of all your cpus to `performance`: +threadCPUTime# primtive added vis a RTS patch allows us to find accurate CPU +time, allocation, cache misses and many other CPU performace counters on a per +thread basis between point A to point B in a program. -``` -echo performance > /sys/devices/system/cpu/cpu0/cpufreq/scaling_governor -echo performance > /sys/devices/system/cpu/cpu1/cpufreq/scaling_governor -... -... -echo performance > /sys/devices/system/cpu/cpu7/cpufreq/scaling_governor -``` +The event logging patch is the most powerful method and records what the entire +system is doing at any point of time via events logged to a file. The file is +later analyzed to find out the CPU time, allocations and other stats on a per +thread basis or on defined window basis. -## Generating the eventlog +The RTS patch added additional events required to record the cpu time, +allocations and other counters accurately. This package provides a +program to analyze the generated event log file and build correct +performance picture of the program. -To generate the event log, we need to compile the program with the eventlog enabled -and run the program setting the `-l` rts option. +## What it does -There are multiple ways of doing this. +With these tools you can find: -__Using plain GHC__: +* Analyze the entire program to: + * where is the program spending time + * How much time and allocations each thread is doing + * account for each and every microsecond spent and bytes allocated +* Zoom into smaller parts of the program to find why it is expensive: + * analyze smaller windows in more detail + * report micro level hardware counters e.g. cache misses +* It can run in production systems without much overhead -``` -ghc Main.hs -rtsopts -eventlog -./Main +RTS -l -RTS -``` +## What it provides? -__Using Cabal__: +* A library for easy data collection and reporting in a running a program +* An executable to analyze the eventlog offline -The `.cabal` file should contain the following ghc options -``` -ghc-options: -eventlog "-with-rtsopts=-l" -``` +## Detailed documents -If the `-threaded` option is used while compiling. You may want to use the `-N1` -rts option. - -## Creating windows - -Helper function to create windows: - -``` -{-# LANGUAGE BangPatterns #-} - -import Control.Monad.IO.Class (MonadIO(..)) -import Debug.Trace (traceEventIO) - -{-# INLINE withTracingFlow #-} -withTracingFlow :: MonadIO m => String -> m a -> m a -withTracingFlow tag action = do - liftIO $ traceEventIO ("START:" ++ tag) - !res <- action - liftIO $ traceEventIO ("END:" ++ tag) - pure res -``` - -We can wrap parts of the flow we want to analyze with `withTracingFlow` using a -tag to help us identify it. - -## End of Window - -You can put the END of the window in different paths but ensure that all paths -are covered: - -``` - r <- f x - case r of - Just val -> do - -- _ <- L.runIO $ traceEventIO $ "END:" ++ "window" - -- Some processing - Nothing -> do - -- _ <- L.runIO $ traceEventIO $ "END:" ++ "window" - -- Some processing -``` - -## Measurement Overhead - -Even when you are measuring an empty block of code there will be some minimum -timing and allocations reported because of the measurement overhead. - -``` - _ <- traceEventIO $ "START:emptyWindow" - _ <- traceEventIO $ "END:emptyWindow" -``` - -The timing is due to the time measurement system call itself. The allocations -are due to the traceEventIO haskell code execution. TODO: fix the allocations. - -## Measurement with Lazy Evaluation - -If we want to measure the cost of the lookup in the code below we need -to evaluate it right there: - -``` - m <- readIORef _configCache - return . snd $ SimpleLRU.lookup k m -``` - -For correct measurement use the following code: - -``` - m <- readIORef _configCache - _ <- traceEventIO $ "START:" ++ "mapLookup" - let !v = HM.lookup k m - _ <- traceEventIO $ "END:" ++ "mapLookup" - return v -``` - -## Labelling Threads - -We should label our threads to identify the thread to scrutinize while reading -the stats. - -For example, - -To scrutinize the main thread: - -``` -import GHC.Conc (myThreadId, labelThread) - -main :: IO () -main = do - tid <- myThreadId - labelThread tid "main-thread" - withTracingFlow "main" $ do - ... -``` - -To scrutinize the server thread in warp we can use the following middleware: - -``` -eventlogMiddleware :: Application -> Application -eventlogMiddleware app request respond = do - tid <- myThreadId - labelThread tid "server" - traceEventIO ("START:server") - app request respond1 - - where - - respond1 r = do - res <- respond r - traceEventIO ("END:server") - return res - -``` - -We can use `eventlogMiddleware` as the outermost layer. - -## Reading the results - -We get a lot of output currently. We are in the process of simplifying the -statistics and making the details controllable via options. - -Currently, the program prints a lot of information. It's essential to understand -what to ignore given the use case. - -The use-case we assume is: __Understand the window CPU time and Thread allocated__. - -Consider the following program: - -``` -{-# LANGUAGE BangPatterns #-} - -import Control.Monad (unless) -import Control.Monad.IO.Class (MonadIO(..)) -import Debug.Trace (traceEventIO) -import GHC.Conc (myThreadId, labelThread) - -{-# INLINE withTracingFlow #-} -withTracingFlow :: MonadIO m => String -> m a -> m a -withTracingFlow tag action = do - liftIO $ traceEventIO ("START:" ++ tag) - !res <- action - liftIO $ traceEventIO ("END:" ++ tag) - pure res - -{-# INLINE printSumLoop #-} -printSumLoop :: Int -> Int -> Int -> IO () -printSumLoop _ _ 0 = print "All Done!" -printSumLoop chunksOf from times = do - withTracingFlow "sum" $ print $ sum [from..(from + chunksOf)] - printSumLoop chunksOf (from + chunksOf) (times - 1) - -main :: IO () -main = do - tid <- myThreadId - labelThread tid "main-thread" - withTracingFlow "main" $ do - printSumLoop 10000 1 100 -``` - -The statics gleaned from the eventlog of the above program will look like the -following: - -``` --------------------------------------------------- -Summary Stats --------------------------------------------------- - -Global thread wise stat summary -tid label samples ThreadCPUTime ThreadAllocated ---- ----------- ------- ------------- --------------- - 1 main-thread 2 967,479 434,384 - 2 - 1 5,854 17,664 - - - - 3 973,333 452,048 - - -Window [1:main] thread wise stat summary -ProcessCPUTime: 1,174,455 -ProcessUserCPUTime: 0 -ProcessSystemCPUTime: 1,175,000 - -ThreadCPUTime:934,898 -GcCPUTime:0 -RtsCPUTime:239,557 -tid label samples ThreadCPUTime ThreadAllocated ---- ----------- ------- ------------- --------------- - 1 main-thread 1 934,898 429,952 - - - - 1 934,898 429,952 - - -Window [1:sum] thread wise stat summary -ProcessCPUTime: 953,862 -ProcessUserCPUTime: 0 -ProcessSystemCPUTime: 949,000 - -ThreadCPUTime:833,991 -GcCPUTime:0 -RtsCPUTime:119,871 -tid label samples ThreadCPUTime ThreadAllocated ---- ----------- ------- ------------- --------------- - 1 main-thread 100 833,991 328,224 - - - - 100 833,991 328,224 - - --------------------------------------------------- -Detailed Stats --------------------------------------------------- - -Window [1:main] thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------ - 1 main-thread 934,898 1 934,898 934,898 934,898 0 - - -Grand total: 934,898 - -Window [1:main] thread wise stats for [ThreadAllocated] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------ - 1 main-thread 429,952 1 429,952 429,952 429,952 0 - - -Grand total: 429,952 - -Window [1:sum] thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ----- ------- ------- ------ - 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 - - -Grand total: 833,991 - -Window [1:sum] thread wise stats for [ThreadAllocated] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ----- ------- ------- ------ - 1 main-thread 328,224 100 3,282 2,960 31,584 2,844 - - -Grand total: 328,224 - -Global thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------- - 1 main-thread 967,479 2 483,740 33,519 933,960 450,220 - 2 - 5,854 1 5,854 5,854 5,854 0 - - -Grand total: 973,333 - -Global thread wise stats for [ThreadAllocated] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------- - 1 main-thread 434,384 2 217,192 4,920 429,464 212,272 - 2 - 17,664 1 17,664 17,664 17,664 0 - - -Grand total: 452,048 -``` - -From the __Global thread wise stat summary__ under __Summary Stats__ figure out -the thread id we want to scrutinize. In this case, we care about the -`main-thread`. The thread id is `1`. - -We can skip to the __Detailed Stats__ section. - -We want to look at all the windows we want to scrutinize that run in the -`main-thread`. The windows in the above program are `main` and `sum`. The -thread id is prepended to the windows. So we want to look at sections -corresponding to `[1:main]` and `[1:sum]`. - -That is, -``` -Window [1:main] thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------ - 1 main-thread 934,898 1 934,898 934,898 934,898 0 - - -Grand total: 934,898 - -Window [1:main] thread wise stats for [ThreadAllocated] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ------- ------- ------- ------ - 1 main-thread 429,952 1 429,952 429,952 429,952 0 - - -Grand total: 429,952 - -Window [1:sum] thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ----- ------- ------- ------ - 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 - - -Grand total: 833,991 - -Window [1:sum] thread wise stats for [ThreadAllocated] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ----- ------- ------- ------ - 1 main-thread 328,224 100 3,282 2,960 31,584 2,844 -``` - -Consider one specific section, - -``` -Window [1:sum] thread wise stats for [ThreadCPUTime] -tid label total count avg minimum maximum stddev ---- ----------- ------- ----- ----- ------- ------- ------ - 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 -``` - -This section is a table. It has 8 columns. It can have multiple rows. We should -only scrutinize the row where the `tid` matches `main-thread`. ie. `tid == 1`. - -The granularity of `ThreadCPUTime` is in nanoseconds and `ThreadAllocated` is -in bytes. - -Columns: - -- `tid`: The thread id -- `label`: The thread label -- `total`: The total accumulated sum of all the samples -- `count`: Number of samples or the times this window is seen -- `avg`: The average size of the samples -- `minimum`: The minimum of all the samples -- `maximum`: The maximum of all the samples -- `stddev`: The standard deviation of the samples - -__NOTE__: It is important to look at `stddev`. If `stddev` is more than 30% of -the average and if the difference between the `minimum` and `maximum` is too -much, the `average` might have unecessary outliers. In the future we would like -to remove outliers automatically. +For more details on each of the performance analysis methods see the following +documents: +* [GHC RTS Stats](docs/ghc-rts-performance-analysis.md) +* [threadCPUTime# RTS primitive](docs/thread-cputime-primop.md) +* [GHC Event logging](docs/eventlog-performance-analysis.md) +* [GHC patches details](dev/ghc-work.md) diff --git a/dev/Methods.md b/dev/Methods.md index 4a7b58f..072b397 100644 --- a/dev/Methods.md +++ b/dev/Methods.md @@ -1,17 +1,17 @@ # Methods -There are 2 methods of measuring accurate haskell performance. +There are 2 methods of measuring accurate Haskell performance. ## Eventlog method __Pros__: -- Enables us to perform extensive analisys. +- Enables us to perform extensive analysis. - We can understand the state of the system completely at any given time. - We can make more elaborate windows. - We can see all the other threads in a given window. - The windows are not confined to a single thread. -- Relatievely less invasive change in the RTS. +- Relatively less invasive change in the RTS. __Cons__: @@ -29,10 +29,10 @@ __Pros__: __Cons__: - Relatively more invasive. -- Very simple analisys. Relative analisys isn't possible to understand the system. +- Very simple analysis. Relative analysis isn't possible to understand the system. __Implementation detail__: -- We need to hang the perfomance counters block from the TSO. -- On every tield we can update the perf counters. +- We need to hang the performance counters block from the TSO. +- On every yield we can update the perf counters. - To get the updated value of the counter we need to yield. diff --git a/dev/ghc-work.md b/dev/ghc-work.md new file mode 100644 index 0000000..c486b00 --- /dev/null +++ b/dev/ghc-work.md @@ -0,0 +1,76 @@ +## **GHC 8.8.4** + +### **Original Work** + +* **Tag:** `ghc-8.8.4-eventlog-enhancements` + + * Introduced `threadCPUTime#` primop early in development. + * CPU time was initially measured using `clock_gettime` before and after thread execution in the scheduler. + * Later transitioned to **eventlog-based measurement**, making the primop unused in practice. + +#### ↳ **Follow-up Work** + +* **Tag:** `ghc-8.8.4-threadCPUTime-add-alloc-sched-count` + + * Revived `threadCPUTime#` primop hooks. + * Added additional counters: + + * Scheduler count + * Allocation tracking + * Enabled **in-memory performance data collection**, allowing: + + * CPU time + * Allocations + * Scheduler count + * Works **without requiring eventlogs**. + +--- + +## **GHC 8.10.7** + +### **Eventlog Enhancements Port** + +* **Tag:** `ghc-8.10.7-eventlog-enhancements` + + * Port of eventlog-based counter work from 8.8.4. + +#### ↳ **Primop Enhancements** + +* **Tag:** `ghc-8.10.7-primop-enhancements` + + * Port of in-memory performance counter collection using primops. + +##### ↳ **Debug Enhancements** + +* **Tag:** `ghc-8.10.7-debug-enhancements` + + * Added tracing hooks in `forkOn`. + * Purpose: + + * Track and account for all threads created + * Covers both: + + * GHC runtime-created threads + * User-created threads + +--- + +## **GHC 9.2.8** + +### **File Lock Debugging** + +* **Tag:** `ghc-9.2.8-file-lock-debug` + + * Introduced debugging code for a file locking bug in GHC. + +### **Performance Counters (threadCPUTime#)** + +* **Tag:** `ghc-9.2.8-perf-counters-1-rc1` + + * Port of the 8.10.7 `primop-enhancements` work. + +#### ↳ **Memory Leak Profiling** + +* **Tag:** `ghc-9.2.8-leak-profiling-1-rc1` + + * Added work related to memory leak profiling. diff --git a/docs/eventlog-performance-analysis.md b/docs/eventlog-performance-analysis.md new file mode 100644 index 0000000..e7a444b --- /dev/null +++ b/docs/eventlog-performance-analysis.md @@ -0,0 +1,394 @@ +# GHC Event logging + +Available in GHC 9.2.8 RTS patch. Can be ported to later GHCs. + + + +Eventlog based Haskell thread aware time and allocation analysis is +possible with stock GHC but there are some limitations and drawbacks +which are fixed in the RTS patch described below. The patch adds +accurate timing and allocation information and hardware performance +counters, and we then use a custom event log analysis program to provide +an accurate and comprehensive analysis of all the threads in the entire +program not just the current thread. + + + +## Enable Linux perf counters + +Enable unrestricted use of perf counters: + +``` +# echo -1 > /proc/sys/kernel/perf_event_paranoid +``` + +## Disable CPU scaling + +Set the scaling governer of all your cpus to `performance`: + +``` +echo performance > /sys/devices/system/cpu/cpu0/cpufreq/scaling_governor +echo performance > /sys/devices/system/cpu/cpu1/cpufreq/scaling_governor +... +... +echo performance > /sys/devices/system/cpu/cpu7/cpufreq/scaling_governor +``` + +## Generating the eventlog + +To generate the event log, we need to compile the program with the eventlog enabled +and run the program setting the `-l` rts option. + +There are multiple ways of doing this. + +__Using plain GHC__: + +``` +ghc Main.hs -rtsopts -eventlog +./Main +RTS -l -RTS +``` + +__Using Cabal__: + +The `.cabal` file should contain the following ghc options +``` +ghc-options: -eventlog "-with-rtsopts=-l" +``` + +If the `-threaded` option is used while compiling. You may want to use the `-N1` +rts option. + +## Creating windows + +Helper function to create windows: + +``` +{-# LANGUAGE BangPatterns #-} + +import Control.Monad.IO.Class (MonadIO(..)) +import Debug.Trace (traceEventIO) + +{-# INLINE withTracingFlow #-} +withTracingFlow :: MonadIO m => String -> m a -> m a +withTracingFlow tag action = do + liftIO $ traceEventIO ("START:" ++ tag) + !res <- action + liftIO $ traceEventIO ("END:" ++ tag) + pure res +``` + +We can wrap parts of the flow we want to analyze with `withTracingFlow` using a +tag to help us identify it. + +## End of Window + +You can put the END of the window in different paths but ensure that all paths +are covered: + +``` + r <- f x + case r of + Just val -> do + -- _ <- L.runIO $ traceEventIO $ "END:" ++ "window" + -- Some processing + Nothing -> do + -- _ <- L.runIO $ traceEventIO $ "END:" ++ "window" + -- Some processing +``` + +## Measurement Overhead + +Even when you are measuring an empty block of code there will be some minimum +timing and allocations reported because of the measurement overhead. + +``` + _ <- traceEventIO $ "START:emptyWindow" + _ <- traceEventIO $ "END:emptyWindow" +``` + +The timing is due to the time measurement system call itself. The allocations +are due to the traceEventIO haskell code execution. TODO: fix the allocations. + +## Measurement with Lazy Evaluation + +If we want to measure the cost of the lookup in the code below we need +to evaluate it right there: + +``` + m <- readIORef _configCache + return . snd $ SimpleLRU.lookup k m +``` + +For correct measurement use the following code: + +``` + m <- readIORef _configCache + _ <- traceEventIO $ "START:" ++ "mapLookup" + let !v = HM.lookup k m + _ <- traceEventIO $ "END:" ++ "mapLookup" + return v +``` + +## Labelling Threads + +We should label our threads to identify the thread to scrutinize while reading +the stats. + +For example, + +To scrutinize the main thread: + +``` +import GHC.Conc (myThreadId, labelThread) + +main :: IO () +main = do + tid <- myThreadId + labelThread tid "main-thread" + withTracingFlow "main" $ do + ... +``` + +To scrutinize the server thread in warp we can use the following middleware: + +``` +eventlogMiddleware :: Application -> Application +eventlogMiddleware app request respond = do + tid <- myThreadId + labelThread tid "server" + traceEventIO ("START:server") + app request respond1 + + where + + respond1 r = do + res <- respond r + traceEventIO ("END:server") + return res + +``` + +We can use `eventlogMiddleware` as the outermost layer. + +## Reading the results + +We get a lot of output currently. We are in the process of simplifying the +statistics and making the details controllable via options. + +Currently, the program prints a lot of information. It's essential to understand +what to ignore given the use case. + +The use-case we assume is: __Understand the window CPU time and Thread allocated__. + +Consider the following program: + +``` +{-# LANGUAGE BangPatterns #-} + +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO(..)) +import Debug.Trace (traceEventIO) +import GHC.Conc (myThreadId, labelThread) + +{-# INLINE withTracingFlow #-} +withTracingFlow :: MonadIO m => String -> m a -> m a +withTracingFlow tag action = do + liftIO $ traceEventIO ("START:" ++ tag) + !res <- action + liftIO $ traceEventIO ("END:" ++ tag) + pure res + +{-# INLINE printSumLoop #-} +printSumLoop :: Int -> Int -> Int -> IO () +printSumLoop _ _ 0 = print "All Done!" +printSumLoop chunksOf from times = do + withTracingFlow "sum" $ print $ sum [from..(from + chunksOf)] + printSumLoop chunksOf (from + chunksOf) (times - 1) + +main :: IO () +main = do + tid <- myThreadId + labelThread tid "main-thread" + withTracingFlow "main" $ do + printSumLoop 10000 1 100 +``` + +The statics gleaned from the eventlog of the above program will look like the +following: + +``` +-------------------------------------------------- +Summary Stats +-------------------------------------------------- + +Global thread wise stat summary +tid label samples ThreadCPUTime ThreadAllocated +--- ----------- ------- ------------- --------------- + 1 main-thread 2 967,479 434,384 + 2 - 1 5,854 17,664 + + - - 3 973,333 452,048 + + +Window [1:main] thread wise stat summary +ProcessCPUTime: 1,174,455 +ProcessUserCPUTime: 0 +ProcessSystemCPUTime: 1,175,000 + +ThreadCPUTime:934,898 +GcCPUTime:0 +RtsCPUTime:239,557 +tid label samples ThreadCPUTime ThreadAllocated +--- ----------- ------- ------------- --------------- + 1 main-thread 1 934,898 429,952 + + - - 1 934,898 429,952 + + +Window [1:sum] thread wise stat summary +ProcessCPUTime: 953,862 +ProcessUserCPUTime: 0 +ProcessSystemCPUTime: 949,000 + +ThreadCPUTime:833,991 +GcCPUTime:0 +RtsCPUTime:119,871 +tid label samples ThreadCPUTime ThreadAllocated +--- ----------- ------- ------------- --------------- + 1 main-thread 100 833,991 328,224 + + - - 100 833,991 328,224 + + +-------------------------------------------------- +Detailed Stats +-------------------------------------------------- + +Window [1:main] thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------ + 1 main-thread 934,898 1 934,898 934,898 934,898 0 + + +Grand total: 934,898 + +Window [1:main] thread wise stats for [ThreadAllocated] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------ + 1 main-thread 429,952 1 429,952 429,952 429,952 0 + + +Grand total: 429,952 + +Window [1:sum] thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ----- ------- ------- ------ + 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 + + +Grand total: 833,991 + +Window [1:sum] thread wise stats for [ThreadAllocated] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ----- ------- ------- ------ + 1 main-thread 328,224 100 3,282 2,960 31,584 2,844 + + +Grand total: 328,224 + +Global thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------- + 1 main-thread 967,479 2 483,740 33,519 933,960 450,220 + 2 - 5,854 1 5,854 5,854 5,854 0 + + +Grand total: 973,333 + +Global thread wise stats for [ThreadAllocated] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------- + 1 main-thread 434,384 2 217,192 4,920 429,464 212,272 + 2 - 17,664 1 17,664 17,664 17,664 0 + + +Grand total: 452,048 +``` + +From the __Global thread wise stat summary__ under __Summary Stats__ figure out +the thread id we want to scrutinize. In this case, we care about the +`main-thread`. The thread id is `1`. + +We can skip to the __Detailed Stats__ section. + +We want to look at all the windows we want to scrutinize that run in the +`main-thread`. The windows in the above program are `main` and `sum`. The +thread id is prepended to the windows. So we want to look at sections +corresponding to `[1:main]` and `[1:sum]`. + +That is, +``` +Window [1:main] thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------ + 1 main-thread 934,898 1 934,898 934,898 934,898 0 + + +Grand total: 934,898 + +Window [1:main] thread wise stats for [ThreadAllocated] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ------- ------- ------- ------ + 1 main-thread 429,952 1 429,952 429,952 429,952 0 + + +Grand total: 429,952 + +Window [1:sum] thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ----- ------- ------- ------ + 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 + + +Grand total: 833,991 + +Window [1:sum] thread wise stats for [ThreadAllocated] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ----- ------- ------- ------ + 1 main-thread 328,224 100 3,282 2,960 31,584 2,844 +``` + +Consider one specific section, + +``` +Window [1:sum] thread wise stats for [ThreadCPUTime] +tid label total count avg minimum maximum stddev +--- ----------- ------- ----- ----- ------- ------- ------ + 1 main-thread 833,991 100 8,340 5,533 63,493 5,714 +``` + +This section is a table. It has 8 columns. It can have multiple rows. We should +only scrutinize the row where the `tid` matches `main-thread`. ie. `tid == 1`. + +The granularity of `ThreadCPUTime` is in nanoseconds and `ThreadAllocated` is +in bytes. + +Columns: + +- `tid`: The thread id +- `label`: The thread label +- `total`: The total accumulated sum of all the samples +- `count`: Number of samples or the times this window is seen +- `avg`: The average size of the samples +- `minimum`: The minimum of all the samples +- `maximum`: The maximum of all the samples +- `stddev`: The standard deviation of the samples + +__NOTE__: It is important to look at `stddev`. If `stddev` is more than 30% of +the average and if the difference between the `minimum` and `maximum` is too +much, the `average` might have unecessary outliers. In the future we would like +to remove outliers automatically. diff --git a/docs/ghc-rts-performance-analysis.md b/docs/ghc-rts-performance-analysis.md new file mode 100644 index 0000000..f114341 --- /dev/null +++ b/docs/ghc-rts-performance-analysis.md @@ -0,0 +1,144 @@ + + +# Components of a Haskell Process + +* An OS level process +* Multiple OS level threads in the OS process +* Multiple Haskell green threads that are scheduled on the OS threads. Haskell + threads can run on any of the available OS threads every time it is ready to + run. + +# A prototypical program + +A simple yet comprehensive program to understand different components of +performance analysis and stats. You can play with this to understand how things +work, how the stats add up and what they mean. + +See examples/console-loop-multi-thread.hs . + +# How many OS threads do we have? + +To see how may OS threads a haskell process is using on Linux. +Run examples/console-loop-multi-thread.hs , note its pid printed in the output. +All of its OS threads are: +``` +ls /proc//task +``` + +Even when compiled without the `-threaded` option we might see two threads +because the RTS still uses a separate thread for GC and for forking async +cleanup threads via GC. + +One of the tasks will have the same pid as the process pid, this is the main OS +thread. You can try changing the number of capabilities using +RTS -N and see +the effect. + +GHC may also use independent OS threads for ffi, for GC, for IO manager, +however it will guarantee that only as many user threads can run at a time as +specified with the -N rts option. + +Usually we see 3 threads plus 2 threads per capability when compiled +with `-threaded` option. + +# GHC RTS stats + +The getRTSStats call gives us the CPU time (essentially get_clocktime +or getrusage under the hood to get the CPU time) of the process and +allocation count at the last GC. Can we use getRTSStats at point A and then +getRTSStats at point B and diff them? + +There are two problems with this. (1) the allocation count is recorded +from the last GC which does not correspond to point A or point B unless +we force a GC at both the points which is not practical and is going to +change the performance characterstics of the program drastically. (2) +the CPU time that we get is for the entire process which includes all +the OS threads, if the program is built with `-threaded` option then +this is always going to be inaccurate; even if we get OS thread level +CPU time we cannot attribute it correctly to Haskell threads that run on +top of OS threads; even if we build the program without `-threaded` we +may have multiple Haskell threads running and if between our measurement +points the threads are switched we will attribute the other thread's +time incorrectly to our current control flow. Even if we have a single +Haskell thread if there is a threadDelay or an IO call in the middle of +the two points the thread will switch out and even the time when it was +not scheduled will be counted in our measurement. So the only case left +is when we build without `-threaded`, we have a single Haskell thread +and we ensure it will not yield in the middle. + +This is used in this way in micro-benchmarking programs but it is very +restrictive and useless in practice. + +For small programs though the `+RTS -s` options is very useful to assess the +performance characterstics. I often take out the small piece that I want to +measure and run it with `+RTS -s`. + +# Using it + +In the haskell-perf library we do have a convenient way to wrap a function +around and use getRTSStats before and after it. If the function passes the +criterion mentioned above then we can get a decent measurement, not very +accurate but workable. We automatically perform a GC before and after. + +# Interpreting the RTS Stats + +We divide the stats in two categories. The first category is the non-gc +stats, these stats are accurate up to the time of the `getRTSStats` +call. These stats include: + +* `cpu_ns`: the total accumulated `user` (note that it DOES NOT INCLUDE the + system time) process CPU time till now starting after RTS init. So it + includes the following: + * Haskell thread CPU time + * the RTS scheduler overhead + * GC CPU time +* `mutator_cpu_ns` = `cpu_ns` - GC CPU time +* `elapsed_ns`: the total wall-clock time since RTS init. +* `mutator_elapsed_ns` = `elapsed_ns` - wall-clock time elapsed in GCs. + +The second category is the GC stats, these stats are updated at the end +of a minor or major GC. They remain unchanged between GCs. All other +stats returned by `getRTSStats`, other than the ones listed above fall +in this category. + +Note that the GC cpu time should be computed by adding the `gc_cpu_ns` +and `nonmoving_gc_cpu_ns` when the non-moving gc is enabled. + +# Variability of Measurements + +Performance measurement is tricky and there are many factors to take care of if +you want to get reliable results: + +* cannot use wall-clock time, need to use process cpu time +* disable CPU frequency scaling +* Memory contention can affect the measurement, do not run other things on the + same machine. +* cache effect due to context switching can affect it, do not run other things + on the same machine. +* Different CPUs running at different frequencies can make the results + unpredictable. +* The clocks of different CPUs may not be in sync. + +To counter the last two factors we should use instruction count or allocation +count rather than time as a reliable measure. diff --git a/docs/intro.md b/docs/thread-cputime-primop.md similarity index 53% rename from docs/intro.md rename to docs/thread-cputime-primop.md index 6df4995..f6f9173 100644 --- a/docs/intro.md +++ b/docs/thread-cputime-primop.md @@ -1,39 +1,4 @@ -# Haskell Performance Analysis - -## GHC RTS Stats - -RTS Stats give entire OS process level (not OS thread level) cpu time -and not Haskell thread cpu time. When multiple OS threads are used, the -cpu time recorded is the cpu time of all the threads combined. Also, the -way kernel accounts this time it could be off by a little (microseconds) -because each thread's cpu time is recorded at the last accounting -event. Allocations are recorded by the GHC RTS only at the GC boundary, -so the allocations reported are from the point when the last GC -happened. So we need to be careful when using or interpreting these -stats. - -If we built the program without -threaded and we are using a single -Haskell thread then we can get cpu time between any two points in the -program accurately. Accurate accounting of allocations will require a GC -to be forced which is not usually practical. - -In a multithreaded program using RTS stats we can only tell time how -much total CPU time (and allocations) the entire Haskell process (all -threads) spent between two points, but we cannot tell which Haskell -thread spent how much time. - -## GHC Event logging - -Eventlog based Haskell thread aware time and allocation analysis is -possible with stock GHC but there are some limitations and drawbacks -which are fixed in the RTS patch described below. The patch basically -adds accurate information and more information, and we then use a custom -event log analysis program to provide an accurate and comprehensive -picture of the entire program. - -TBD: document the exact limitations and differences. - -## threadCPUTime# prim op +# threadCPUTime# prim op Available in the [GHC 9.2.8 RTS patch](https://github.com/composewell/ghc/releases/tag/ghc-9.2.8-perf-counters-1-rc1). @@ -56,7 +21,7 @@ and B in a program, diff will tell us the time spent and allocations between the two points. We have to ensure that we are diffing the data for the same thread id at -both the points. See [this example program](./threadCPUTime.hs). +both the points. See [this example program](../examples/threadCPUTime.hs). The API has some measurement overhead but it is not very high. If we are nesting measurements be aware that outer measurement will measure @@ -82,13 +47,3 @@ though. For accurate synchronization (if needed) of all threads at the given points we can stop-the-world, can be useful in testing but not a good idea in production though. Also, managing windows with possible nesting can complicate the RTS code. - -## Eventlog based perf counters - -Available in GHC 8.10.7 RTS patch. Can be ported to later GHCs. - -This gives you a more comprehensive picture of the entire program -between any two specified points, it gives a detailed report about all -the threads in the system not just the current thread. - -See the [README](../README.md) for more details on this. diff --git a/examples/README.md b/examples/README.md new file mode 100644 index 0000000..4656fa9 --- /dev/null +++ b/examples/README.md @@ -0,0 +1,15 @@ +# Simple Programs + +hello.hs +console-loop.hs -- console echo loop +delay-loop.hs -- threadDelay in a loop +ffi.hs -- fork one thread + FFI c_sleep + +# In memory collection + +threadCPUTime.hs -- single threaded stat collection + +# Eventlog reporting + +traceEventIO.hs -- traceEventIO around c_sleep ffi +traceEventIOWarp.hs -- traceEventIO warp server threads diff --git a/examples/console-loop-multi-thread.hs b/examples/console-loop-multi-thread.hs new file mode 100644 index 0000000..75d3465 --- /dev/null +++ b/examples/console-loop-multi-thread.hs @@ -0,0 +1,35 @@ +import Control.Concurrent +import Control.Monad +import System.Posix.Process (getProcessID) + +consoleLoop :: IO () +consoleLoop = do + line <- getLine + putStrLn line + consoleLoop + +threadLoop :: IO () +threadLoop = do + tid <- myThreadId + putStrLn $ "running thread: " ++ show tid + -- tight loop with occasional delay + forever $ go (0 :: Integer) + + where + + go n = + if n `mod` 1000000 == 0 + then threadDelay 1 + else go (n+1) + +main :: IO () +main = do + pid <- getProcessID + putStrLn $ "pid: " ++ show pid + tid <- myThreadId + putStrLn $ "main thread: " ++ show tid + tid1 <- forkIO threadLoop + putStrLn $ "forked thread: " ++ show tid1 + tid2 <- forkIO threadLoop + putStrLn $ "forked thread: " ++ show tid2 + consoleLoop -- `catch` (\(e :: IOException) -> return ()) diff --git a/examples/console-loop.hs b/examples/console-loop.hs new file mode 100644 index 0000000..e9e009c --- /dev/null +++ b/examples/console-loop.hs @@ -0,0 +1,10 @@ +loop :: IO () +loop = do + line <- getLine + -- let n = read line :: Int + -- putStrLn $ "You entered: " ++ show n + putStrLn line + loop + +main :: IO () +main = loop -- `catch` (\(e :: IOException) -> return ()) diff --git a/examples/delay-loop.hs b/examples/delay-loop.hs new file mode 100644 index 0000000..8368237 --- /dev/null +++ b/examples/delay-loop.hs @@ -0,0 +1,13 @@ +import Control.Concurrent (myThreadId, threadDelay, forkIO) + +loop :: IO () +loop = do + tid <- myThreadId + print tid + threadDelay 10000000 + loop + +main :: IO () +main = do + -- tid <- forkIO (return ()) + loop diff --git a/examples/ffi.hs b/examples/ffi.hs new file mode 100644 index 0000000..8b8954b --- /dev/null +++ b/examples/ffi.hs @@ -0,0 +1,20 @@ +import Control.Concurrent +import Control.Monad +import Foreign.C.Types +import System.Posix.Signals +import Debug.Trace + +foreign import ccall unsafe "unistd.h sleep" + c_sleep :: CUInt -> IO CUInt + +main :: IO () +main = do + tid <- myThreadId + print tid + forkIO (forever (putStrLn "hello" >> threadDelay 1000000)) + blockSignals fullSignalSet + threadDelay 10000000 + putStrLn "before sleep" + c_sleep 10 + putStrLn "after sleep" + return () diff --git a/examples/hello.hs b/examples/hello.hs new file mode 100644 index 0000000..cbddc35 --- /dev/null +++ b/examples/hello.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Hello world!" diff --git a/docs/threadCPUTime.hs b/examples/threadCPUTime.hs similarity index 100% rename from docs/threadCPUTime.hs rename to examples/threadCPUTime.hs diff --git a/examples/traceEventIO.hs b/examples/traceEventIO.hs new file mode 100644 index 0000000..f49e14f --- /dev/null +++ b/examples/traceEventIO.hs @@ -0,0 +1,14 @@ +import Foreign.C.Types +import System.Posix.Signals +import Debug.Trace + +foreign import ccall unsafe "unistd.h sleep" + c_sleep :: CUInt -> IO CUInt + +main :: IO () +main = do + blockSignals fullSignalSet + traceEventIO "before sleep" + c_sleep 10 + traceEventIO "after sleep" + return () diff --git a/examples/traceEventIOWarp.hs b/examples/traceEventIOWarp.hs new file mode 100644 index 0000000..c2f791d --- /dev/null +++ b/examples/traceEventIOWarp.hs @@ -0,0 +1,21 @@ +import GHC.Conc (labelThread, myThreadId) +import Debug.Trace (traceEventIO) + +withEventLog :: Application -> Application +withEventLog app request respond = do + tid <- myThreadId + labelThread tid "server" + traceEventIO ("START:server") + app request respond1 + + where + + respond1 r = do + res <- respond r + traceEventIO ("END:server") + return res + +main :: IO () +main = + runSettings settings $ withEventLog $ app + diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..114d59a --- /dev/null +++ b/flake.lock @@ -0,0 +1,88 @@ +{ + "nodes": { + "basepkgs": { + "inputs": { + "basepkgs": "basepkgs_2", + "nixpkgs": "nixpkgs", + "nixpkgs-darwin": "nixpkgs-darwin" + }, + "locked": { + "lastModified": 1776414440, + "narHash": "sha256-Be67u+Qea2sEuI+3BVjkc+o4fYgRT/fOANGNAp2OuFk=", + "ref": "refs/heads/master", + "rev": "69728978adc44f53b3dd907acb2eb5bd2415fd60", + "revCount": 125, + "type": "git", + "url": "ssh://git@github.com/composewell/streamly-packages" + }, + "original": { + "rev": "69728978adc44f53b3dd907acb2eb5bd2415fd60", + "type": "git", + "url": "ssh://git@github.com/composewell/streamly-packages" + } + }, + "basepkgs_2": { + "locked": { + "lastModified": 1776376172, + "narHash": "sha256-tVn1PuKG+kJGH2PUnV3weRHDnbtgUDlwwSC0K3A45aM=", + "owner": "composewell", + "repo": "nixpack", + "rev": "f50a0b2aaaab434f46847bc171240957b508b901", + "type": "github" + }, + "original": { + "owner": "composewell", + "repo": "nixpack", + "rev": "f50a0b2aaaab434f46847bc171240957b508b901", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1774106199, + "narHash": "sha256-US5Tda2sKmjrg2lNHQL3jRQ6p96cgfWh3J1QBliQ8Ws=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6c9a78c09ff4d6c21d0319114873508a6ec01655", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6c9a78c09ff4d6c21d0319114873508a6ec01655", + "type": "github" + } + }, + "nixpkgs-darwin": { + "locked": { + "lastModified": 1774106199, + "narHash": "sha256-US5Tda2sKmjrg2lNHQL3jRQ6p96cgfWh3J1QBliQ8Ws=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6c9a78c09ff4d6c21d0319114873508a6ec01655", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6c9a78c09ff4d6c21d0319114873508a6ec01655", + "type": "github" + } + }, + "root": { + "inputs": { + "basepkgs": "basepkgs", + "nixpkgs": [ + "basepkgs", + "nixpkgs" + ], + "nixpkgs-darwin": [ + "basepkgs", + "nixpkgs-darwin" + ] + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..c448661 --- /dev/null +++ b/flake.nix @@ -0,0 +1,19 @@ +{ + description = "streamly-fsevents"; + + inputs = { + basepkgs.url = "git+ssh://git@github.com/composewell/streamly-packages?rev=69728978adc44f53b3dd907acb2eb5bd2415fd60"; + nixpkgs.follows = "basepkgs/nixpkgs"; + nixpkgs-darwin.follows = "basepkgs/nixpkgs-darwin"; + }; + + outputs = { self, nixpkgs, nixpkgs-darwin, basepkgs }: + basepkgs.nixpack.mkOutputs { + inherit nixpkgs nixpkgs-darwin basepkgs; + name = "streamly-fsevents"; + sources = basepkgs.nixpack.lib.localSource "streamly-fsevents" ./.; + packages = basepkgs.nixpack.lib.devPackage "streamly-fsevents"; + #sources = import ./sources.nix; + #packages = import ./packages.nix; + }; +} diff --git a/haskell-perf.cabal b/haskell-perf.cabal index eb93ddf..040a566 100644 --- a/haskell-perf.cabal +++ b/haskell-perf.cabal @@ -23,7 +23,12 @@ build-type: Simple extra-doc-files: Changelog.md README.md - dev/*.md + dev/GhcFlags.md dev/Methods.md dev/README.md dev/ghc-work.md + docs/*.md + examples/README.md + +extra-source-files: + examples/*.hs source-repository head type: git @@ -34,10 +39,10 @@ flag dev manual: True default: False -flag fusion-plugin - description: Use fusion plugin for benchmarks and executables - manual: True - default: False +-- flag fusion-plugin +-- description: Use fusion plugin for benchmarks and executables +-- manual: True +-- default: False ------------------------------------------------------------------------------- -- Common stanzas @@ -79,7 +84,7 @@ common default-extensions -- UnboxedTuples -- interferes with (#.) common compile-options - import default-extensions + import: default-extensions default-language: Haskell2010 ghc-options: -Weverything @@ -105,6 +110,17 @@ common compile-options -Wall-missed-specialisations -fno-ignore-asserts +executable console-loop-multi-thread + import: compile-options + hs-source-dirs: examples + ghc-options: -threaded -rtsopts + main-is: console-loop-multi-thread.hs + build-depends: + base >= 4.9 && < 5 + , unix < 2.9 + if os(windows) + buildable: False + executable hperf import: compile-options hs-source-dirs: src @@ -113,7 +129,9 @@ executable hperf ghc-options: -O2 -fmax-worker-args=16 -fspec-constr-recursive=16 build-depends: base >= 4.9 && < 5 - , containers - , streamly-core == 0.2.0 - , format-numbers - , text + , containers < 0.9 + , optparse-applicative < 0.20 + , streamly-core >= 0.3.0 && < 0.4 + , streamly-statistics < 0.3 + , format-numbers < 0.2 + , text < 2.2 diff --git a/src/Aggregator.hs b/src/Aggregator.hs index 4a160dc..a06f657 100644 --- a/src/Aggregator.hs +++ b/src/Aggregator.hs @@ -9,7 +9,8 @@ import Data.Int (Int64) import Data.Set (Set) import Data.Word (Word32) import EventParser (Event (..), Counter(..), Location(..)) -import Streamly.Internal.Data.Fold (Fold(..), Step(..)) +import Streamly.Internal.Data.Fold (Step(..)) +import Streamly.Internal.Data.Scanl (Scanl(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import qualified Data.List as List @@ -51,8 +52,8 @@ import qualified Data.Set as Set newtype Window = Window (Set Word32) -- thread ids that have joined the window {-# INLINE translateThreadEvents #-} -translateThreadEvents :: Fold IO Event [Event] -translateThreadEvents = Fold step initial extract extract +translateThreadEvents :: Scanl IO Event [Event] +translateThreadEvents = Scanl step initial extract extract where @@ -202,9 +203,9 @@ data CollectState = -- XXX Pass the window, counter as well for information in errors {-# INLINE collectThreadCounter #-} collectThreadCounter :: - Fold IO ((Word32, String, Counter), (Location, Int64)) + Scanl IO ((Word32, String, Counter), (Location, Int64)) (Maybe (Either (Maybe Int64) Int64)) -collectThreadCounter = Fold step initial extract extract +collectThreadCounter = Scanl step initial extract extract where diff --git a/src/EventParser.hs b/src/EventParser.hs index dd60935..5033e5f 100644 --- a/src/EventParser.hs +++ b/src/EventParser.hs @@ -29,7 +29,6 @@ import qualified Streamly.Data.Fold as Fold import qualified Streamly.Data.Stream as Stream import qualified Streamly.Data.StreamK as StreamK import qualified Streamly.Data.Parser as Parser -import qualified Streamly.Data.ParserK as ParserK {- #define EVENT_HEADER_BEGIN 0x68647262 @@ -73,18 +72,18 @@ eventTypeEnd = w8 "ete\0" -- (event Id, event size) eventType :: ParserK (Array Word8) IO (Int, Int) eventType = do - _ <- ParserK.adaptC (Parser.listEq eventTypeBegin) - eventId <- ParserK.adaptC word16be + _ <- Array.toParserK (Parser.listEq eventTypeBegin) + eventId <- Array.toParserK word16be -- ParserK.fromEffect $ print $ "Event id =" ++ show eventId - eventSize <- ParserK.adaptC int16be + eventSize <- Array.toParserK int16be -- ParserK.fromEffect $ print $ "Event size =" ++ show eventSize - descLen <- ParserK.adaptC word32be - _desc <- ParserK.adaptC (Parser.takeEQ (fromIntegral descLen) Fold.toList) + descLen <- Array.toParserK word32be + _desc <- Array.toParserK (Parser.takeEQ (fromIntegral descLen) Fold.toList) -- ParserK.fromEffect $ putStrLn (map (chr . fromIntegral) desc) - infoLen <- ParserK.adaptC word32be + infoLen <- Array.toParserK word32be -- ParserK.fromEffect $ print $ "info len =" ++ show infoLen - ParserK.adaptC (Parser.takeEQ (fromIntegral infoLen) Fold.drain) - _ <- ParserK.adaptC (Parser.listEq eventTypeEnd) + Array.toParserK (Parser.takeEQ (fromIntegral infoLen) Fold.drain) + _ <- Array.toParserK (Parser.listEq eventTypeEnd) return (fromIntegral eventId, fromIntegral eventSize) --------------------- @@ -109,7 +108,7 @@ parseEventTypes :: -> IO (Map.IntMap Int, StreamK IO (Array Word8)) parseEventTypes kv stream = do -- putStrLn "parsing eventType" - (r, rest) <- StreamK.parseBreakChunks eventType stream + (r, rest) <- Array.parseBreak eventType stream case r of -- XXX When the parser fails the original stream should not change, we -- should be able to use "rest" here. @@ -120,14 +119,14 @@ parseEventTypes kv stream = do headerPre :: ParserK (Array Word8) IO () headerPre = do - _ <- ParserK.adaptC (Parser.listEq headerBegin) - _ <- ParserK.adaptC (Parser.listEq hetBegin) + _ <- Array.toParserK (Parser.listEq headerBegin) + _ <- Array.toParserK (Parser.listEq hetBegin) return () headerPost :: ParserK (Array Word8) IO () headerPost = do - _ <- ParserK.adaptC (Parser.listEq hetEnd) - _ <- ParserK.adaptC (Parser.listEq headerEnd) + _ <- Array.toParserK (Parser.listEq hetEnd) + _ <- Array.toParserK (Parser.listEq headerEnd) return () {- @@ -147,12 +146,12 @@ header = do parseLogHeader :: StreamK IO (Array Word8) -> IO (Map.IntMap Int, StreamK IO (Array Word8)) parseLogHeader stream = do - (res, rest) <- StreamK.parseBreakChunks headerPre stream + (res, rest) <- Array.parseBreak headerPre stream case res of Left err -> fail $ show err Right () -> do (kv, rest1) <- parseEventTypes Map.empty rest - (res1, rest2) <- StreamK.parseBreakChunks headerPost rest1 + (res1, rest2) <- Array.parseBreak headerPost rest1 case res1 of Left err -> putStrLn "header end not found" >> (fail $ show err) Right () -> return (kv, rest2) @@ -169,8 +168,8 @@ dataBegin = w8 "datb" parseDataHeader :: StreamK IO (Array Word8) -> IO (StreamK IO (Array Word8)) parseDataHeader stream = do - let p = ParserK.adaptC (Parser.listEq dataBegin) - (res, rest) <- StreamK.parseBreakChunks p stream + let p = Array.toParserK (Parser.listEq dataBegin) + (res, rest) <- Array.parseBreak p stream case res of Left err -> fail $ show err Right _ -> return rest @@ -374,5 +373,5 @@ parseEvents kv = Stream.catMaybes . Stream.catRights . Stream.parseMany (event kv) - . Stream.unfoldMany Array.reader + . Stream.unfoldEach Array.reader . StreamK.toStream diff --git a/src/Main.hs b/src/Main.hs index ae03a03..3194f06 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,6 @@ +-- Until we fix the use of "head" +{-# OPTIONS_GHC "-Wno-x-partial" #-} + module Main (main) where import Aggregator @@ -24,8 +27,11 @@ import EventParser import Streamly.Data.Array (Array) import Streamly.Data.Stream (Stream) import Streamly.Data.StreamK (StreamK) -import Streamly.Internal.Data.Fold (Fold (..)) -import System.Environment (getArgs) +import Streamly.Internal.Data.Fold (Fold (..), postscanlMaybe) +import qualified Streamly.Data.Scanl as Scanl +import qualified Streamly.Internal.Data.Scanl as Scanl (scanlMany, cumulativeScan) +import qualified Streamly.Statistics.Scanl as Stats +import Options.Applicative import Text.Printf (printf) import qualified Data.List as List @@ -36,7 +42,8 @@ import qualified Streamly.Data.Fold as Fold import qualified Streamly.Data.Stream as Stream import qualified Streamly.Data.StreamK as StreamK import qualified Streamly.Data.Unfold as Unfold -import qualified Streamly.FileSystem.File as File +import qualified Streamly.FileSystem.FileIO as File +import qualified Streamly.FileSystem.Path as Path import qualified Streamly.Internal.Data.Fold as Fold (demuxKvToMap, kvToMap) @@ -67,11 +74,11 @@ secondMaybe f = fmap f1 (Fold.unzip (fmap fromJust Fold.the) f) double :: Int -> Double double = fromIntegral -untilLeft :: Monad m => Fold m b1 b2 -> Fold m (Either (Maybe b1) b1) b2 +untilLeft :: Monad m => Scanl.Scanl m b1 b2 -> Scanl.Scanl m (Either (Maybe b1) b1) b2 untilLeft f = - Fold.takeEndBy isLeft - $ Fold.lmap (either id Just) - $ Fold.catMaybes f + Scanl.takeEndBy isLeft + $ Scanl.lmap (either id Just) + $ Scanl.catMaybes f {- {-# INLINE combineStats #-} @@ -101,27 +108,28 @@ combineWindowStats = Fold.kvToMap combineStats -} -- Statistics collection for each counter + {-# INLINE stats #-} -stats :: Fold IO Int64 [(String, Int)] +stats :: Scanl.Scanl IO Int64 [(String, Int)] stats = - Fold.lmap (fromIntegral :: Int64 -> Int) - $ Fold.distribute - [ fmap (\x -> ("latest", fromJust x)) Fold.latest - , fmap (\x -> ("total", x)) Fold.sum - , fmap (\x -> ("count", x)) Fold.length - , fmap (\x -> ("avg", round x)) (Fold.lmap double Fold.mean) - , fmap (\x -> ("minimum", fromJust x)) Fold.minimum - , fmap (\x -> ("maximum", fromJust x)) Fold.maximum - , fmap (\x -> ("stddev", round x)) (Fold.lmap double Fold.stdDev) + Scanl.lmap (fromIntegral :: Int64 -> Int) + $ Scanl.distribute + [ fmap (\x -> ("latest", fromJust x)) Scanl.latest + , fmap (\x -> ("total", x)) Scanl.sum + , fmap (\x -> ("count", x)) Scanl.length + , fmap (\x -> ("avg", round x)) (Scanl.lmap double Scanl.mean) + , fmap (\x -> ("minimum", fromJust x)) Scanl.minimum + , fmap (\x -> ("maximum", fromJust x)) Scanl.maximum + , fmap (\x -> ("stddev", round x)) (Scanl.lmap double (Scanl.cumulativeScan Stats.incrStdDev)) ] {-# INLINE threadStats #-} -threadStats :: Fold IO (Either (Maybe Int64) Int64) [(String, Int)] +threadStats :: Scanl.Scanl IO (Either (Maybe Int64) Int64) [(String, Int)] threadStats = untilLeft stats {-# INLINE windowStats #-} -windowStats :: Fold IO (Either (Maybe Int64) Int64) [(String, Int)] -windowStats = Fold.many (untilLeft Fold.sum) stats +windowStats :: Scanl.Scanl IO (Either (Maybe Int64) Int64) [(String, Int)] +windowStats = Scanl.scanlMany (untilLeft Scanl.sum) stats {-# INLINE toStats #-} toStats :: @@ -131,17 +139,17 @@ toStats :: ((Word32, String, Counter), (Location, Int64)) -- Map (tid, window tag, counter) (Maybe [(stat name, value)]) (Map (Word32, String, Counter) (Maybe [(String, Int)])) -toStats = Fold.demuxKvToMap (\k -> pure (f1 k)) +toStats = Fold.demuxKvToMap (\k -> pure (Just (f1 k))) where f k1 collectStats = Fold.lmap (\x -> (k1, x)) - -- $ Fold.lmapM (\x -> print x >> pure x) - $ Fold.scanMaybe collectThreadCounter - $ Fold.postscan collectStats - -- $ Fold.filter (\kv -> snd (snd kv !! 0) > 50000) - -- $ Fold.trace print + -- $ Fold.lmapM (\x -> print x >> pure x) + $ postscanlMaybe collectThreadCounter + $ Fold.postscanl collectStats + -- $ Fold.filter (\kv -> snd (snd kv !! 0) > 50000) + -- $ Fold.trace print $ Fold.latest -- For the main thread @@ -155,8 +163,8 @@ generateEvents :: -> StreamK IO (Array Word8) -> Stream IO Event generateEvents kv = - Stream.unfoldMany Unfold.fromList - . Stream.postscan translateThreadEvents + Stream.unfoldEach Unfold.fromList + . Stream.postscanl translateThreadEvents -- . Stream.trace print . parseEvents kv @@ -174,7 +182,7 @@ printTable :: [[String]] -> IO () printTable rows = do case map (unwords . fillRow) rows of [] -> putStrLn "printTable: empty rows" - (header:rest) -> putStrLn $ unlines $ header:unwords separatorRow:rest + (hdr:rest) -> putStrLn $ unlines $ hdr:unwords separatorRow:rest where @@ -187,11 +195,12 @@ getStatField :: String -> (k, [(String, Int)]) -> Maybe Int getStatField x kv = List.lookup x $ snd kv printWindowCounter :: - [((Word32, String, Counter), [(String, Int)])] + Int + -> [((Word32, String, Counter), [(String, Int)])] -> Map Word32 String -> (String, Counter) -> IO () -printWindowCounter statsRaw tidMap (w, ctr) = do +printWindowCounter maxLines statsRaw tidMap (w, ctr) = do if w == "default" then putStrLn $ "Global thread wise stats for [" ++ show ctr ++ "]" @@ -207,8 +216,7 @@ printWindowCounter statsRaw tidMap (w, ctr) = do statsString = map (\(k, v) -> (k, map toString v)) statsOrdered allRows = map addTid statsString cnt = length allRows - maxLines = 10 - printTable (header : take maxLines allRows) + printTable (colHeaders : take maxLines allRows) if cnt > maxLines then putStrLn $ "..." ++ show (cnt - maxLines) ++ " lines omitted ..." else return () @@ -226,7 +234,7 @@ printWindowCounter statsRaw tidMap (w, ctr) = do , "maximum" , "stddev" ] - header = + colHeaders = ["tid" , "label" ] ++ statNames @@ -264,13 +272,14 @@ windowLevelCounters = -- real time. We will need a Map of windows, which will store a Map of tids -- which will store a list or Map of counters. printAllCounters :: - Bool + Int + -> Bool -> [((Word32, String, Counter), [(String, Int)])] -> Map Word32 String -> [Counter] -> String -> IO () -printAllCounters concurrent statsRaw tidMap ctrs w = do +printAllCounters maxLines concurrent statsRaw tidMap ctrs w = do let windowTotals :: [((Word32, Counter), Int)] windowTotals = fmap toTotal $ filter selectWindow statsRaw @@ -344,8 +353,7 @@ printAllCounters concurrent statsRaw tidMap ctrs w = do putStrLn $ "RtsCPUTime:" ++ toString rtsCPUTime let cnt = length allRows - maxLines = 10 - printTable ((header : take maxLines allRows) ++ [separator, summary]) + printTable ((colHeaders : take maxLines allRows) ++ [separator, summary]) if cnt > maxLines then putStrLn $ "..." ++ show (cnt - maxLines) ++ " lines omitted ..." else return () @@ -375,7 +383,7 @@ printAllCounters concurrent statsRaw tidMap ctrs w = do ++ " in window " ++ w toString = Text.unpack . prettyI (Just ',') - header = + colHeaders = ["tid" , "label" , "samples" @@ -412,15 +420,60 @@ flattenStats statsRaw = do return statsFiltered +------------------------------------------------------------------------------- +-- CLI +------------------------------------------------------------------------------- + +data Config = Config + { configFile :: FilePath + , configFlattenWindows :: Bool + , configMaxLines :: Int + } + +configParser :: Parser Config +configParser = Config + <$> argument str + ( metavar "EVENTLOG-FILE" + <> help "Path to the GHC eventlog file to analyse" + ) + <*> switch + ( long "flatten-windows" + <> short 'f' + <> help "Collapse window-level stats across threads" + ) + <*> option auto + ( long "max-lines" + <> short 'n' + <> metavar "N" + <> value 10 + <> showDefault + <> help "Maximum number of thread rows to print per table" + ) + +optsInfo :: ParserInfo Config +optsInfo = info (configParser <**> helper) + ( fullDesc + <> progDesc "Analyse CPU cost, heap allocations, and Linux perf event \ + \counters for Haskell threads and user-defined code windows." + <> header "hperf - Haskell performance analysis tool" + ) + +------------------------------------------------------------------------------- +-- Entry point +------------------------------------------------------------------------------- + -- XXX Are the events for a particular thread guaranteed to come in order. What -- if a thread logged events to a particular capability buffer and then got -- scheduled on another capability before its eventlog could be flushed from -- the previous capability? main :: IO () main = do - let flattenWindows = False - (path:[]) <- getArgs - let stream = File.readChunks path + Config { configFile = path + , configFlattenWindows = flattenWindows + , configMaxLines = maxLines + } <- execParser optsInfo + let stream = File.readChunks (Path.fromString_ path) + (kv, rest) <- parseLogHeader $ StreamK.fromStream stream -- putStrLn $ show kv events <- parseDataHeader rest @@ -437,7 +490,7 @@ main = do -- TODO: get the sorting field from Config/CLI -- List.sortOn (getStatField "tid") -- TODO: get the threshold from Config/CLI - -- $ filter (\x -> fromJust (getStatField "total" x) > 0) + -- $ filter (\x -> fromJust (getStatField "total" x) > 0) map (\(k, v) -> (k, filter (\(k1,_) -> k1 /= "latest") v)) $ map (\(k, v) -> (k, fromJust v)) $ filter (\(_, v) -> isJust v) @@ -471,7 +524,7 @@ main = do let f w = printAllCounters - flattenWindows (getStats w) (fmap fromJust tidMap) ctrs w + maxLines flattenWindows (getStats w) (fmap fromJust tidMap) ctrs w in mapM_ f wins putStrLn "--------------------------------------------------" @@ -480,7 +533,7 @@ main = do putStrLn "" -- For each (window, counter) list all threads - let f (w,c) = printWindowCounter (getStats w) (fmap fromJust tidMap) (w,c) + let f (w,c) = printWindowCounter maxLines (getStats w) (fmap fromJust tidMap) (w,c) in mapM_ f windowCounterList where