From 808cec87677b18b561c116ed0c47767e13a474c3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 30 Dec 2020 12:57:48 +0000 Subject: [PATCH 1/4] Perform memory measurement on SIGUSR1 --- ghcide/src/Development/IDE/Core/Shake.hs | 3 +- ghcide/src/Development/IDE/Core/Tracing.hs | 55 +++++++++++++--------- hls-plugin-api/src/Ide/PluginUtils.hs | 10 +++- 3 files changed, 43 insertions(+), 25 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 7d5a9eca5a..787b02dbe5 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -406,8 +406,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress clientCapabilitie let ideState = IdeState{..} IdeOptions{ optOTMemoryProfiling = IdeOTMemoryProfiling otProfilingEnabled } <- getIdeOptionsIO shakeExtras - when otProfilingEnabled $ - startTelemetry logger $ state shakeExtras + startTelemetry otProfilingEnabled logger $ state shakeExtras return ideState where diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 698115585a..4d70957f26 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -13,7 +13,7 @@ import Control.Concurrent.Extra (Var, modifyVar_, newVar, readVar, threadDelay) import Control.Exception (evaluate) import Control.Exception.Safe (catch, SomeException) -import Control.Monad (unless, forM_, forever, (>=>)) +import Control.Monad (void, when, unless, forM_, forever, (>=>)) import Control.Monad.Extra (whenJust) import Control.Seq (r0, seqList, seqTuple2, using) import Data.Dynamic (Dynamic) @@ -28,12 +28,13 @@ import Development.IDE.Core.RuleTypes (GhcSession (GhcSession), import Development.IDE.Types.Logger (logInfo, Logger, logDebug) import Development.IDE.Types.Shake (Key (..), Value, Values) import Development.Shake (Action, actionBracket, liftIO) +import Ide.PluginUtils (installSigUsr1Handler) import Foreign.Storable (Storable (sizeOf)) import HeapSize (recursiveSize, runHeapsize) import Language.Haskell.LSP.Types (NormalizedFilePath, fromNormalizedFilePath) import Numeric.Natural (Natural) -import OpenTelemetry.Eventlog (addEvent, beginSpan, endSpan, +import OpenTelemetry.Eventlog (Synchronicity(Asynchronous), Instrument, addEvent, beginSpan, endSpan, mkValueObserver, observe, setTag, withSpan, withSpan_) @@ -71,35 +72,45 @@ otTracedAction key file success act = actionBracket unless (success res) $ setTag sp "error" "1" return res) -startTelemetry :: Logger -> Var Values -> IO () -startTelemetry logger stateRef = do +startTelemetry :: Bool -> Logger -> Var Values -> IO () +startTelemetry allTheTime logger stateRef = do instrumentFor <- getInstrumentCached mapCountInstrument <- mkValueObserver "values map count" - _ <- regularly (1 * seconds) $ - withSpan_ "Measure length" $ - readVar stateRef - >>= observe mapCountInstrument . length - - _ <- regularly (1 * seconds) $ do - values <- readVar stateRef - let keys = nub - $ Key GhcSession : Key GhcSessionDeps - : [ k | (_,k) <- HMap.keys values - -- do GhcSessionIO last since it closes over stateRef itself - , k /= Key GhcSessionIO] - ++ [Key GhcSessionIO] - !groupedForSharing <- evaluate (keys `using` seqList r0) - measureMemory logger [groupedForSharing] instrumentFor stateRef - `catch` \(e::SomeException) -> - logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e)) - return () + installSigUsr1Handler $ do + logInfo logger "SIGUSR1 received: performing memory measurement" + performMeasurement logger stateRef instrumentFor mapCountInstrument + + when allTheTime $ void $ regularly (1 * seconds) $ + performMeasurement logger stateRef instrumentFor mapCountInstrument where seconds = 1000000 regularly :: Int -> IO () -> IO (Async ()) regularly delay act = async $ forever (act >> threadDelay delay) + +performMeasurement :: + Logger -> + Var (HMap.HashMap (NormalizedFilePath, Key) (Value Dynamic)) -> + (Maybe Key -> IO OurValueObserver) -> + Instrument 'Asynchronous a m' -> + IO () +performMeasurement logger stateRef instrumentFor mapCountInstrument = do + withSpan_ "Measure length" $ readVar stateRef >>= observe mapCountInstrument . length + + values <- readVar stateRef + let keys = nub + $ Key GhcSession : Key GhcSessionDeps + : [ k | (_,k) <- HMap.keys values + -- do GhcSessionIO last since it closes over stateRef itself + , k /= Key GhcSessionIO] + ++ [Key GhcSessionIO] + !groupedForSharing <- evaluate (keys `using` seqList r0) + measureMemory logger [groupedForSharing] instrumentFor stateRef + `catch` \(e::SomeException) -> + logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e)) + {-# ANN startTelemetry ("HLint: ignore Use nubOrd" :: String) #-} type OurValueObserver = Int -> IO () diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index caa0768c0e..48c2c3e0c5 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -18,7 +18,7 @@ module Ide.PluginUtils fullRange, mkLspCommand, mkLspCmdId, - allLspCmdIds,allLspCmdIds') + allLspCmdIds,allLspCmdIds',installSigUsr1Handler) where @@ -35,6 +35,7 @@ import Language.Haskell.LSP.Types.Capabilities #ifdef mingw32_HOST_OS import qualified System.Win32.Process as P (getCurrentProcessId) #else +import System.Posix.Signals import qualified System.Posix.Process as P (getProcessID) #endif import qualified Data.Aeson as J @@ -42,6 +43,7 @@ import qualified Data.Default import qualified Data.Map.Strict as Map import Ide.Plugin.Config import qualified Language.Haskell.LSP.Core as LSP +import Control.Monad (void) -- --------------------------------------------------------------------- @@ -246,8 +248,14 @@ getPid :: IO T.Text getPid = T.pack . show <$> getProcessID getProcessID :: IO Int +installSigUsr1Handler :: IO () -> IO () + #ifdef mingw32_HOST_OS getProcessID = fromIntegral <$> P.getCurrentProcessId +installSigUsr1Handler _ = return () + #else getProcessID = fromIntegral <$> P.getProcessID + +installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif From 6e9125faed35232c1ff5453c4aa3f3d33d563dbf Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 31 Dec 2020 17:10:09 +0000 Subject: [PATCH 2/4] remove nub --- ghcide/src/Development/IDE/Core/Tracing.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 4d70957f26..1f5cf72743 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -100,18 +100,19 @@ performMeasurement logger stateRef instrumentFor mapCountInstrument = do withSpan_ "Measure length" $ readVar stateRef >>= observe mapCountInstrument . length values <- readVar stateRef - let keys = nub - $ Key GhcSession : Key GhcSessionDeps - : [ k | (_,k) <- HMap.keys values + let keys = Key GhcSession + : Key GhcSessionDeps + : [ k | (_,k) <- HMap.keys values -- do GhcSessionIO last since it closes over stateRef itself - , k /= Key GhcSessionIO] - ++ [Key GhcSessionIO] + , k /= Key GhcSession + , k /= Key GhcSessionDeps + , k /= Key GhcSessionIO + ] ++ [Key GhcSessionIO] !groupedForSharing <- evaluate (keys `using` seqList r0) measureMemory logger [groupedForSharing] instrumentFor stateRef `catch` \(e::SomeException) -> logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e)) -{-# ANN startTelemetry ("HLint: ignore Use nubOrd" :: String) #-} type OurValueObserver = Int -> IO () From de28245b645f583aaa55a174b9fb9c72b38999d8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 31 Dec 2020 17:12:20 +0000 Subject: [PATCH 3/4] Update the open telemetry docs --- ghcide/docs/opentelemetry.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ghcide/docs/opentelemetry.md b/ghcide/docs/opentelemetry.md index 81c915a243..49d65d5c2c 100644 --- a/ghcide/docs/opentelemetry.md +++ b/ghcide/docs/opentelemetry.md @@ -19,7 +19,9 @@ Then, you can run `ghcide`, giving it a file to dump eventlog information into. ghcide +RTS -l -ol ghcide.eventlog -RTS ``` -You can also optionally enable reporting detailed memory data with `--ot-memory-profiling` +# Profiling the Shake cache + +The flag `--ot-memory-profiling` profiles the values map repeatedly with 1s pauses in between. ```sh ghcide --ot-memory-profiling +RTS -A4G -l -ol ghcide.eventlog -RTS @@ -27,6 +29,8 @@ ghcide --ot-memory-profiling +RTS -A4G -l -ol ghcide.eventlog -RTS *Note:* This option, while functional, is extremely slow. You will notice this because the memory graph in the output will have datapoints spaced apart by a couple of minutes. The nursery must be big enough (-A1G or larger) or the measurements will self-abort. +Another way to profile the heap is by sending a USR1 signal (`kill -s USR1`) to the process. + ## Viewing with tracy After installing `opentelemetry-extra` and `tracy`, you can view the opentelementry output: From 1f8a67a3ba038dfd0e2a4b0044efaf86e0a05029 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 31 Dec 2020 18:41:59 +0000 Subject: [PATCH 4/4] remove redundant bang --- ghcide/src/Development/IDE/Core/Tracing.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 1f5cf72743..79973be520 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -108,7 +108,7 @@ performMeasurement logger stateRef instrumentFor mapCountInstrument = do , k /= Key GhcSessionDeps , k /= Key GhcSessionIO ] ++ [Key GhcSessionIO] - !groupedForSharing <- evaluate (keys `using` seqList r0) + groupedForSharing <- evaluate (keys `using` seqList r0) measureMemory logger [groupedForSharing] instrumentFor stateRef `catch` \(e::SomeException) -> logInfo logger ("MEMORY PROFILING ERROR: " <> fromString (show e))