From a03d0f7d7317bba9b04be5209970c356a5e79fc1 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 14 Aug 2024 14:10:57 +0200 Subject: [PATCH 1/2] Convert various units to `ms` --- .../src/Bittide/Report/ClockControl.hs | 43 ++++++++++++++----- bittide-tools/clockcontrol/plot/Main.hs | 2 +- 2 files changed, 33 insertions(+), 12 deletions(-) diff --git a/bittide-experiments/src/Bittide/Report/ClockControl.hs b/bittide-experiments/src/Bittide/Report/ClockControl.hs index fca6d5bda..891159529 100644 --- a/bittide-experiments/src/Bittide/Report/ClockControl.hs +++ b/bittide-experiments/src/Bittide/Report/ClockControl.hs @@ -3,6 +3,7 @@ -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ImplicitPrelude #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} module Bittide.Report.ClockControl ( generateReport, @@ -11,9 +12,12 @@ module Bittide.Report.ClockControl ( formatThousands, ) where +import Clash.Prelude (Domain, KnownDomain, Milliseconds, natToNum) + import Data.Bool (bool) import Data.List (intercalate) import Data.List.Extra (chunksOf) +import Data.Proxy (Proxy (..)) import System.Directory (doesDirectoryExist, doesFileExist, findExecutable) import System.Environment (lookupEnv) import System.FilePath (takeFileName, ()) @@ -29,6 +33,7 @@ import System.IO ( import System.IO.Temp (withSystemTempDirectory) import System.Process (callProcess, readProcess) +import Bittide.Arithmetic.Time (PeriodToCycles) import Bittide.Plot import Bittide.Simulate.Config @@ -45,6 +50,9 @@ formatThousands :: (Num a, Show a) => a -> String formatThousands = reverse . intercalate "," . chunksOf 3 . reverse . show generateReport :: + (KnownDomain refDom) => + -- | Reference domain + Proxy (refDom :: Domain) -> -- | Document description header String -> -- | Directory containing the intermediate plot results @@ -54,7 +62,7 @@ generateReport :: -- | The utilized simulation configuration SimConf -> IO () -generateReport (("Bittide - " <>) -> header) dir ids cfg = +generateReport refDom (("Bittide - " <>) -> header) dir ids cfg = withSystemTempDirectory "generate-report" $ \tmpDir -> do Just runref <- lookupEnv "RUNREF" -- remove the 'n' prefix from the node names @@ -101,7 +109,7 @@ generateReport (("Bittide - " <>) -> header) dir ids cfg = -- create the latex report withFile (tmpDir "report.tex") WriteMode $ \h -> do hSetBuffering h NoBuffering - hPutStr h $ toLatex datetime runref header clocksPdf ebsPdf topTikz ids cfg + hPutStr h $ toLatex refDom datetime runref header clocksPdf ebsPdf topTikz ids cfg hFlush h hClose h -- create the report pdf @@ -159,6 +167,10 @@ checkIntermediateResults dir = <$> doesFileExist f toLatex :: + forall refDom. + (KnownDomain refDom) => + -- | Reference domain + Proxy (refDom :: Domain) -> -- | date & time reference String -> -- | Github run reference @@ -176,7 +188,7 @@ toLatex :: -- | The utilized simulation configuration SimConf -> String -toLatex datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = +toLatex _refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = unlines [ "\\documentclass[landscape]{article}" , "" @@ -187,6 +199,7 @@ toLatex datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = , "\\usepackage{pifont}" , "\\usepackage{fancyhdr}" , "\\usepackage{tikz}" + , "\\usepackage{siunitx}" , "" , "\\usetikzlibrary{shapes, calc, shadows}" , "" @@ -242,25 +255,25 @@ toLatex datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = , "" , "\\begin{large}" , " \\begin{tabular}{rl}" - , " duration \\textit{(clock cycles)}:" - , " & " <> formatThousands duration <> " \\\\" + , " timeout after:" + , " & " <> qtyMs durationMs <> " \\\\" , " stability detector - framesize:" - , " & " <> formatThousands stabilityFrameSize <> " \\\\" + , " & " <> qtyMs stabilityFrameSizeMs <> " \\\\" , " stability detector - margin:" , " & \\textpm\\," <> formatThousands stabilityMargin <> " elements \\\\" - , " when stable, automatically stop after \\textit{(clock cycles)}:" - , " & " <> maybe "not used" formatThousands stopAfterStable <> " \\\\" + , " when stable, stop after:" + , " & " <> maybe "not used" qtyMs stopAfterStableMs <> " \\\\" , " clock offsets \\textit{(fs)}:" , " & " <> intercalate "; " (show <$> clockOffsets) <> " \\\\" - , " startup delays \\textit{(clock cycles)}:" - , " & " <> intercalate "; " (formatThousands <$> startupDelays) <> " \\\\" + , " startup delays:" + , " & " <> intercalate "; " (qtyMs <$> startupDelaysMs) <> " \\\\" , " reframing:" , " & " <> "\\textit{" <> bool "disabled" "enabled" reframe <> "} \\\\" , if reframe then " wait time: & " <> show waitTime <> " \\\\" else "" - , " all buffers stable at the end of simulation:" + , " all buffers stable end of run:" , " & " <> maybe "" @@ -319,3 +332,11 @@ toLatex datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = , "" , "\\end{document}" ] + where + qtyMs ms = "\\qty{" <> show ms <> "}{\\milli\\second}" + + nCyclesOneMs = natToNum @(PeriodToCycles refDom (Milliseconds 1)) + durationMs = duration `div` nCyclesOneMs + stabilityFrameSizeMs = stabilityFrameSize `div` nCyclesOneMs + startupDelaysMs = (`div` nCyclesOneMs) <$> startupDelays + stopAfterStableMs = (`div` nCyclesOneMs) <$> stopAfterStable diff --git a/bittide-tools/clockcontrol/plot/Main.hs b/bittide-tools/clockcontrol/plot/Main.hs index a8600b1e9..c6ebe8655 100644 --- a/bittide-tools/clockcontrol/plot/Main.hs +++ b/bittide-tools/clockcontrol/plot/Main.hs @@ -668,7 +668,7 @@ plotTest testDir mCfg dir globalOutDir = do Just (DotFile f) -> readFile f >>= writeTop . Just Just tt -> fromTopologyType tt >>= either die (`saveSimConfig` cfg) checkIntermediateResults outDir - >>= maybe (generateReport "HITLT Report" outDir ids cfg) die + >>= maybe (generateReport (Proxy @Basic125) "HITLT Report" outDir ids cfg) die _ -> die "Empty topology" _ -> die "Topology is larger than expected" where From 9968084b814d36cccd6b92ea1c7b6f17153dee35 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 14 Aug 2024 16:34:00 +0200 Subject: [PATCH 2/2] Use PPM as measure in clock plots Fixes #597 --- bittide-experiments/src/Bittide/Plot.hs | 41 +++++++++++++------ .../src/Bittide/Report/ClockControl.hs | 16 ++++++-- bittide-experiments/src/Bittide/Simulate.hs | 4 +- bittide-tools/clockcontrol/plot/Main.hs | 16 ++++++-- bittide-tools/clockcontrol/sim/src/Main.hs | 4 +- 5 files changed, 60 insertions(+), 21 deletions(-) diff --git a/bittide-experiments/src/Bittide/Plot.hs b/bittide-experiments/src/Bittide/Plot.hs index 3dd416e98..65bbdc85b 100644 --- a/bittide-experiments/src/Bittide/Plot.hs +++ b/bittide-experiments/src/Bittide/Plot.hs @@ -10,16 +10,18 @@ module Bittide.Plot ( plot, plotClocksFileName, plotElasticBuffersFileName, + fsToPpm, ) where -import Clash.Prelude (KnownNat, Vec) -import Clash.Signal.Internal (Femtoseconds (..)) +import Clash.Prelude (KnownDomain, KnownNat, Vec) +import Clash.Signal.Internal (Femtoseconds (..), unFemtoseconds) import Clash.Sized.Vector qualified as Vec import Control.Monad (void) import Data.Graph (edges) import Data.Int (Int64) import Data.List (foldl', transpose, unzip4, zip4) +import Data.Proxy (Proxy) import System.FilePath (()) import Graphics.Matplotlib ( @@ -38,7 +40,7 @@ import Graphics.Matplotlib ( ) import Graphics.Matplotlib qualified as MP (plot) -import Bittide.ClockControl (RelDataCount) +import Bittide.ClockControl (RelDataCount, clockPeriodFs) import Bittide.ClockControl.Callisto (ReframingState (..)) import Bittide.ClockControl.StabilityChecker qualified as SC (StabilityIndication (..)) import Bittide.Topology @@ -63,8 +65,10 @@ fromRfState = \case Done{} -> RSDone plot :: - forall nNodes m. - (KnownNat nNodes, KnownNat m) => + forall nNodes m refDom. + (KnownNat nNodes, KnownNat m, KnownDomain refDom) => + -- | Reference domain + Proxy refDom -> -- | output directory for storing the results FilePath -> -- | topology corresponding to the plot @@ -79,7 +83,7 @@ plot :: ) ] -> IO () -plot outputDir graph plotData = +plot refDom outputDir graph plotData = matplotWrite outputDir clockPlots elasticBufferPlots where clockPlots = Vec.imap toClockPlot plotData @@ -100,7 +104,7 @@ plot outputDir graph plotData = else snd ) $ zip (filter (hasEdge graph nodeIndex) [0, 1 ..]) - $ fmap plotEbData + $ fmap (plotEbData refDom) -- Organize data by node instead of by timestamp. I.e., the first item in -- 'timedBuffers' is for this node's first neighbor. $ transpose @@ -108,10 +112,12 @@ plot outputDir graph plotData = | (t, r, bs) <- zip3 time reframingStage buffersPerNode ] - toClockPlot nodeIndex (unzip4 -> (time, relativeOffset, _, _)) = + toClockPlot nodeIndex (unzip4 -> (time, relativeOffsetFs, _, _)) = withLegend $ (@@ [o2 "label" $ fromEnum nodeIndex]) $ - MP.plot (map fsToMs time) relativeOffset + MP.plot + (map fsToMs time) + (map (fsToPpm refDom . fromIntegral . unFemtoseconds) relativeOffsetFs) withLegend = ( @@ @@ -129,16 +135,27 @@ fsToMs (Femtoseconds fs) = -- fs -> ps -> ns -> µs -> ms fs `div` 1_000_000_000_000 +{- | Convert femtoseconds to parts per million, where femtoseconds represents +the relative shortening or lengthening of a clock period. +-} +fsToPpm :: (KnownDomain dom) => Proxy dom -> Double -> Double +fsToPpm refDom fs = fs / onePpm + where + onePpm = case clockPeriodFs refDom of + Femtoseconds f -> fromIntegral f / 1_000_000 + {- | Plots the datacount of an elastic buffer and marks those parts of the plots that are reported to be stable/settled by the stability checker as well as the time frames at which the reframing detector is in the waiting state. -} plotEbData :: - (KnownNat m) => + (KnownNat m, KnownDomain refDom) => + -- | Reference domain + Proxy refDom -> [(Femtoseconds, ReframingStage, RelDataCount m, SC.StabilityIndication)] -> Matplotlib -plotEbData (unzip4 -> (timestampsFs, reframingStages, dataCounts, stabilities)) = +plotEbData _refDom (unzip4 -> (timestampsFs, reframingStages, dataCounts, stabilities)) = foldPlots markedIntervals % ebPlot where timestamps = map fsToMs timestampsFs @@ -195,7 +212,7 @@ matplotWrite dir clockDats ebDats = do file (dir plotClocksFileName) $ constrained ( xlabel "Time (ms)" - % ylabel "Relative period (fs) [0 = ideal frequency]" + % ylabel "Relative frequency (ppm)" % foldPlots (reverse $ Vec.toList clockDats) ) void $ diff --git a/bittide-experiments/src/Bittide/Report/ClockControl.hs b/bittide-experiments/src/Bittide/Report/ClockControl.hs index 891159529..291adc6a9 100644 --- a/bittide-experiments/src/Bittide/Report/ClockControl.hs +++ b/bittide-experiments/src/Bittide/Report/ClockControl.hs @@ -18,6 +18,8 @@ import Data.Bool (bool) import Data.List (intercalate) import Data.List.Extra (chunksOf) import Data.Proxy (Proxy (..)) +import GHC.Float.RealFracMethods (roundDoubleInteger) +import Numeric.Extra (floatToDouble) import System.Directory (doesDirectoryExist, doesFileExist, findExecutable) import System.Environment (lookupEnv) import System.FilePath (takeFileName, ()) @@ -188,7 +190,7 @@ toLatex :: -- | The utilized simulation configuration SimConf -> String -toLatex _refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = +toLatex refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} = unlines [ "\\documentclass[landscape]{article}" , "" @@ -203,6 +205,9 @@ toLatex _refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} , "" , "\\usetikzlibrary{shapes, calc, shadows}" , "" + , "% Not actually an SI unit" + , "\\DeclareSIUnit\\ppm{ppm}" + , "" , "\\pagestyle{fancy}" , "\\fancyhf{}" , "\\fancyhead[L]{\\large \\textbf{" <> header <> "}}" @@ -263,8 +268,12 @@ toLatex _refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} , " & \\textpm\\," <> formatThousands stabilityMargin <> " elements \\\\" , " when stable, stop after:" , " & " <> maybe "not used" qtyMs stopAfterStableMs <> " \\\\" - , " clock offsets \\textit{(fs)}:" - , " & " <> intercalate "; " (show <$> clockOffsets) <> " \\\\" + , " clock offsets:" + , " & " + <> intercalate + "; " + (qtyPpm . roundDoubleInteger . fsToPpm refDom . floatToDouble <$> clockOffsets) + <> " \\\\" , " startup delays:" , " & " <> intercalate "; " (qtyMs <$> startupDelaysMs) <> " \\\\" , " reframing:" @@ -334,6 +343,7 @@ toLatex _refDom datetime runref header clocksPdf ebsPdf topTikz ids SimConf{..} ] where qtyMs ms = "\\qty{" <> show ms <> "}{\\milli\\second}" + qtyPpm ppm = "\\qty{" <> show ppm <> "}{\\ppm}" nCyclesOneMs = natToNum @(PeriodToCycles refDom (Milliseconds 1)) durationMs = duration `div` nCyclesOneMs diff --git a/bittide-experiments/src/Bittide/Simulate.hs b/bittide-experiments/src/Bittide/Simulate.hs index c76e0568e..bc2313b02 100644 --- a/bittide-experiments/src/Bittide/Simulate.hs +++ b/bittide-experiments/src/Bittide/Simulate.hs @@ -210,7 +210,9 @@ simPlot# simSettings ccc t = do saveSettings Nothing case mode of - PDF -> plot dir t $ fmap (fmap (\(a, b, c, d) -> (a, b, fromRfState c, d))) simResult + PDF -> + plot (Proxy @dom) dir t $ + fmap (fmap (\(a, b, c, d) -> (a, b, fromRfState c, d))) simResult CSV -> dumpCsv simResult let result = allSettled $ V.map last simResult diff --git a/bittide-tools/clockcontrol/plot/Main.hs b/bittide-tools/clockcontrol/plot/Main.hs index c6ebe8655..facfa0347 100644 --- a/bittide-tools/clockcontrol/plot/Main.hs +++ b/bittide-tools/clockcontrol/plot/Main.hs @@ -22,6 +22,7 @@ module Main (main, knownTestsWithSimConf) where import Clash.Prelude ( BitPack (..), Index, + KnownDomain, SNat (..), Vec, checkedTruncateB, @@ -555,8 +556,15 @@ knownTestsWithSimConf = hasSimConf <$> hitlTests KnownType name test -> (name, first Text.unpack <$> Map.toList (mGetPPD @_ @SimConf test)) -plotTest :: FilePath -> Maybe SimConf -> FilePath -> FilePath -> IO () -plotTest testDir mCfg dir globalOutDir = do +plotTest :: + (KnownDomain refDom) => + Proxy refDom -> + FilePath -> + Maybe SimConf -> + FilePath -> + FilePath -> + IO () +plotTest refDom testDir mCfg dir globalOutDir = do unless (isNothing mCfg) $ checkDependencies >>= maybe (return ()) die putStrLn $ "Creating plots for test case: " <> testName @@ -646,7 +654,7 @@ plotTest testDir mCfg dir globalOutDir = do return (toPlotData <$> rs) createDirectoryIfMissing True outDir - plot outDir t $ Vec.unsafeFromList postProcessData + plot refDom outDir t $ Vec.unsafeFromList postProcessData let allStable = all @@ -762,7 +770,7 @@ main = <> testsDir forM_ tests $ \(test, cfg) -> - plotTest test cfg (testsDir test) outDir + plotTest (Proxy @Basic125) test cfg (testsDir test) outDir where getTestsWithSimConf name = maybe [] snd $ find ((== name) . fst) knownTestsWithSimConf diff --git a/bittide-tools/clockcontrol/sim/src/Main.hs b/bittide-tools/clockcontrol/sim/src/Main.hs index a0fff87dc..6d9d8b6cc 100644 --- a/bittide-tools/clockcontrol/sim/src/Main.hs +++ b/bittide-tools/clockcontrol/sim/src/Main.hs @@ -84,7 +84,9 @@ main = do saveSimConfig t cfg when (isJust isStable && createReport) $ checkIntermediateResults outDir - >>= maybe (generateReport "Simulation Report" outDir [] cfg) die + >>= maybe + (generateReport (Proxy @Bittide) "Simulation Report" outDir [] cfg) + die , .. }