diff --git a/bittide-instances/bittide-instances.cabal b/bittide-instances/bittide-instances.cabal index dbfc0cc4a..df2a5a05c 100644 --- a/bittide-instances/bittide-instances.cabal +++ b/bittide-instances/bittide-instances.cabal @@ -191,6 +191,7 @@ test-suite unittests -threaded other-modules: + Tests.ClockControlWb Tests.OverflowResistantDiff Wishbone.Axi Wishbone.CaptureUgn diff --git a/bittide-instances/tests/Tests/ClockControlWb.hs b/bittide-instances/tests/Tests/ClockControlWb.hs new file mode 100644 index 000000000..f8340650c --- /dev/null +++ b/bittide-instances/tests/Tests/ClockControlWb.hs @@ -0,0 +1,307 @@ +-- SPDX-FileCopyrightText: 2023 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=20 #-} +{-# OPTIONS_GHC -fplugin=Protocols.Plugin #-} + +module Tests.ClockControlWb where + +import Clash.Explicit.Prelude hiding (PeriodToCycles, many) + +import Clash.Signal (withClockResetEnable) +import Data.Char (chr) +import Data.Either (isRight) +import qualified Data.List as L +import Data.Maybe (mapMaybe) +import Language.Haskell.TH +import Project.FilePath +import System.FilePath +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH +import Text.Parsec +import Text.Read (readEither) + +import Bittide.Arithmetic.Time (PeriodToCycles) +import Bittide.ClockControl (SpeedChange) +import Bittide.ClockControl.DebugRegister (DebugRegisterCfg (..), debugRegisterWb) +import Bittide.ClockControl.Registers (ClockControlData, clockControlWb, clockMod) +import Bittide.DoubleBufferedRam +import Bittide.Instances.Hitl.HwCcTopologies (cSigMap, csDupe) +import Bittide.Instances.Hitl.Setup (LinkCount) +import Bittide.ProcessingElement +import Bittide.ProcessingElement.Util +import Bittide.SharedTypes +import Bittide.Wishbone + +import Protocols +import Protocols.Idle +import qualified Protocols.Df as Df + +case_clock_control_wb_self_test :: Assertion +case_clock_control_wb_self_test = assertBool msg assertion + where + msg = case readCcdResult of + Left m -> "failure:\n" <> m + Right m -> "pass:\n" <> m + assertion = isRight readCcdResult + -- readUartResult = resultFromUartOutput uartString + readUartResult :: Either ParseError [Int] + readUartResult = parse outputFieldsParser "" uartString + readCcdResult :: Either String String + readCcdResult = case readUartResult of + Left err -> Left $ show err + Right val -> resultFromCcdOutput val ccData + + uartString :: String + uartString = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream + (uartStream, ccData) = sampleC def dut + +tests :: TestTree +tests = $(testGroupGenerator) + +type Margin = SNat 2 +margin :: Margin +margin = SNat + +type Framesize = PeriodToCycles System (Seconds 1) +framesize :: SNat Framesize +framesize = SNat + +linkCount :: Int +linkCount = snatToNum (SNat @LinkCount) +linkMask :: BitVector LinkCount +linkMask = 0b1011011 +linkMaskInt :: Int +linkMaskInt = fromIntegral linkMask +linkMaskPopcnt :: Int +linkMaskPopcnt = fromIntegral $ popCount linkMask + +dataCounts :: Vec LinkCount (Signed 27) +dataCounts = iterateI (satSucc SatWrap) 0 + +debugRegisterConfig :: DebugRegisterCfg +debugRegisterConfig = + DebugRegisterCfg + { reframingEnabled = False + } + +dut :: + Circuit () (Df System (BitVector 8), CSignal System (ClockControlData LinkCount)) +dut = + withClockResetEnable + clockGen + resetGen + enableGen + $ circuit + $ \_unit -> do + (uartRx, jtag) <- idleSource -< () + [uartBus, ccWb, dbgWb] <- processingElement peConfig -< jtag + (uartTx, _uartStatus) <- uartInterfaceWb d2 d2 uartSim -< (uartBus, uartRx) + [ccd0, ccd1] <- + csDupe + <| clockControlWb + margin + framesize + (pure linkMask) + (pure <$> dataCounts) + -< ccWb + cm <- cSigMap clockMod -< ccd0 + _dbg <- debugRegisterWb (pure debugRegisterConfig) -< (dbgWb, cm) + idC -< (uartTx, ccd1) + where + (iMem, dMem) = + $( do + root <- runIO $ findParentContaining "cabal.project" + let + elfDir = root firmwareBinariesDir "riscv32imc-unknown-none-elf" Release + elfPath = elfDir "clock-control-wb" + iSize = 8 * 1024 -- 16 KB + dSize = 64 * 1024 -- 256 KB + memBlobsFromElf BigEndian (Just iSize, Just dSize) elfPath Nothing + ) + + peConfig = + PeConfig + (0b100 :> 0b010 :> 0b001 :> 0b110 :> 0b111 :> Nil) + (Reloadable $ Blob iMem) + (Reloadable $ Blob dMem) + +type UartSample = Maybe (BitVector 8) + +resultFromCcdOutput :: [Int] -> [ClockControlData LinkCount] -> Either String String +resultFromCcdOutput speedChanges ccdSamples = output2 + where + numSCs = L.length speedChanges + + scList = mapMaybe (.clockMod) ccdSamples + scIntList = L.map getSCInt scList + + output1 = scCheck speedChanges scIntList + output2 = output1 >>= finalCheck + + scCheck :: [Int] -> [Int] -> Either String [Int] + scCheck l1 l2 = case (l1, l2) of + (_, []) -> undefined + ([], rest) -> Right rest + (h1 : t1, h2 : t2) -> next + where + next = + if h1 == h2 + then scCheck t1 t2 + else + Left + $ "UART sample says `" + <> show h1 + <> "`, but CcWb says `" + <> show h2 + <> "`" + + finalCheck :: [Int] -> Either String String + finalCheck = finalCheck' linkMaskPopcnt + where + finalCheck' 0 _ = + Right $ "clockMod: successfully read " <> show numSCs <> "speed changes" + finalCheck' n [] = + Left + $ "reached end of stream while trying to read clock change padding. remaining: " + <> show (n - 1) + finalCheck' n (h : t) = + if h == 0 + then finalCheck' (n - 1) t + else + Left + $ "failed to read clock change padding. expected `0`, found `" + <> show h + <> "`" + +getSCInt :: SpeedChange -> Int +getSCInt = fromIntegral . pack + +outputFieldsParser :: Parsec String st [Int] +outputFieldsParser = do + _ <- outputFieldParserEq "nLinks" linkCount + _ <- outputFieldParserEq "linkMask" linkMaskInt + _ <- outputFieldParserEq "linkMaskPopcnt" linkMaskPopcnt + _ <- outputFieldParser "reframingEnabled" not "'expected `False`'" + _ <- outputFieldParserLte "linksStable" linkCount + _ <- outputFieldParserLte "linksSettled" linkCount + _ <- outputDataCounts + outputCMods + +outputFieldParserEq :: + (Eq a, Read a, Show a) => + String -> + a -> + Parsec String st () +outputFieldParserEq name val = + outputFieldParser + name + (== val) + ("failed on `== " <> show val <> "`") + +outputFieldParserLte :: + (Ord a, Read a, Show a) => + String -> + a -> + Parsec String st () +outputFieldParserLte name val = + outputFieldParser + name + (<= val) + ("failed on `<= " <> show val <> "`") + +outputFieldParser :: + (Read a, Show a) => + String -> + (a -> Bool) -> + String -> + Parsec String st () +outputFieldParser name cond errmsg = do + _ <- nameParser name ": " + _ <- valueParser cond '\n' errmsg + return () + +nameParser :: String -> String -> Parsec String st () +nameParser name term = do + name' <- manyTill anyChar (try (string term)) + if name == name' + then return () + else + unexpected + $ "names do not match. expected `" + <> show name + <> "`, found `" + <> show name' + <> "`" + +valueParser :: (Read a, Show a) => (a -> Bool) -> Char -> String -> Parsec String st a +valueParser cond term errmsg = do + value <- manyTill anyChar (try (char term)) + case readEither value of + Right val -> if cond val + then return val + else + unexpected + $ "value `" + <> show val + <> "` did not meet condition. msg: " + <> errmsg + Left err -> unexpected err + +outputDataCounts :: Parsec String st () +outputDataCounts = output + where + output = do + _ <- nameParser "dataCounts" ": " + _ <- readDataCountsList + _ <- char '\n' + return () + readDataCountsList = between (char '[') (char ']') sepByCommas + sepByCommas = sepBy readDataCount (string ", ") + readDataCount = between (char '(') (char ')') countPair + countPair = do + countPair0 <- manyTill anyChar (try (string ", ")) + -- _ <- string ", " + countPair1 <- many (noneOf ")") + case (readEither countPair0 :: Either String Int) of + Right _ -> case (readEither countPair1 :: Either String Int) of + Right _ -> return () + Left err -> unexpected + $ "failed to parse `" + <> countPair1 + <> "` as a number. msg: " + <> err + Left err -> unexpected + $ "failed to parse `" + <> countPair0 + <> "` as a number. msg: " + <> err + +outputCMods :: Parsec String st [Int] +outputCMods = output + where + output = do + _ <- nameParser "clockMod" "(" + numCMods <- valueParser (const True) ')' "" + _ <- string ": " + list <- readClockModList + if numCMods == L.length list + then return list + else unexpected + $ "specified list length " + <> show numCMods + <> " does not match actual length " + <> show (L.length list) + readClockModList = between (char '[') (char ']') sepByCommas + sepByCommas = sepBy readClockMod (try (string ", ")) + readClockMod = do + clockMod <- anyChar + case clockMod of + '0' -> return 0 + '1' -> return 1 + '2' -> return 2 + _ -> unexpected $ "unknown speed change `" <> show clockMod <> "`" diff --git a/bittide-instances/tests/unittests.hs b/bittide-instances/tests/unittests.hs index 7e6cd6e55..b5c8b5b0e 100644 --- a/bittide-instances/tests/unittests.hs +++ b/bittide-instances/tests/unittests.hs @@ -8,6 +8,7 @@ import Prelude import Test.Tasty +import qualified Tests.ClockControlWb as ClockControlWb import qualified Tests.OverflowResistantDiff as Ord import qualified Wishbone.Axi as Axi import qualified Wishbone.CaptureUgn as CaptureUgn @@ -19,6 +20,7 @@ tests = testGroup "Unittests" [ CaptureUgn.tests + , ClockControlWb.tests , DnaPortE2.tests , Ord.tests , Time.tests diff --git a/bittide/src/Bittide/ClockControl/Registers.hs b/bittide/src/Bittide/ClockControl/Registers.hs index b7690b343..0979ae23b 100644 --- a/bittide/src/Bittide/ClockControl/Registers.hs +++ b/bittide/src/Bittide/ClockControl/Registers.hs @@ -24,7 +24,7 @@ data ClockControlData (nLinks :: Nat) = ClockControlData , allStable :: Bool , allSettled :: Bool } - deriving (Generic, NFDataX) + deriving (Generic, NFDataX, ShowX, Show) instance HasField diff --git a/bittide/src/Bittide/ClockControl/StabilityChecker.hs b/bittide/src/Bittide/ClockControl/StabilityChecker.hs index a99636f42..35f186604 100644 --- a/bittide/src/Bittide/ClockControl/StabilityChecker.hs +++ b/bittide/src/Bittide/ClockControl/StabilityChecker.hs @@ -20,7 +20,7 @@ data StabilityIndication = StabilityIndication -- ^ Indicates whether the signal is stable and close to -- 'targetDataCount'. } - deriving (Generic, NFDataX, BitPack) + deriving (Generic, NFDataX, BitPack, ShowX, Show) {- | Checks whether the @Signal@ of buffer occupancies from an elastic buffer is stable and settled. The @Signal@ is considered to be diff --git a/firmware-binaries/Cargo.lock b/firmware-binaries/Cargo.lock index 2af676c1b..ef39efb21 100644 --- a/firmware-binaries/Cargo.lock +++ b/firmware-binaries/Cargo.lock @@ -97,6 +97,16 @@ dependencies = [ "ufmt", ] +[[package]] +name = "clock-control-wb" +version = "0.1.0" +dependencies = [ + "bittide-sys", + "rand", + "riscv-rt", + "ufmt", +] + [[package]] name = "critical-section" version = "1.1.1" diff --git a/firmware-binaries/Cargo.toml b/firmware-binaries/Cargo.toml index 68371bfb3..786a7b9f9 100644 --- a/firmware-binaries/Cargo.toml +++ b/firmware-binaries/Cargo.toml @@ -17,6 +17,7 @@ members = [ "examples/smoltcp_client", "test-cases/capture_ugn_test", + "test-cases/clock-control-wb", "test-cases/dna_port_e2_test", "test-cases/time_self_test", "test-cases/axi_stream_self_test", diff --git a/firmware-binaries/test-cases/clock-control-wb/Cargo.lock.license b/firmware-binaries/test-cases/clock-control-wb/Cargo.lock.license new file mode 100644 index 000000000..848612f0e --- /dev/null +++ b/firmware-binaries/test-cases/clock-control-wb/Cargo.lock.license @@ -0,0 +1,3 @@ +SPDX-FileCopyrightText: 2022 Google LLC + +SPDX-License-Identifier: CC0-1.0 diff --git a/firmware-binaries/test-cases/clock-control-wb/Cargo.toml b/firmware-binaries/test-cases/clock-control-wb/Cargo.toml new file mode 100644 index 000000000..d4b2f53a8 --- /dev/null +++ b/firmware-binaries/test-cases/clock-control-wb/Cargo.toml @@ -0,0 +1,18 @@ +# SPDX-FileCopyrightText: 2022 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +[package] +name = "clock-control-wb" +version = "0.1.0" +edition = "2021" +license = "Apache-2.0" +authors = ["Google LLC"] + +# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html + +[dependencies] +bittide-sys = { path = "../../../firmware-support/bittide-sys" } +rand = {version = "0.8.3", features = ["small_rng"], default-features = false } +riscv-rt = "0.11.0" +ufmt = "0.2.0" diff --git a/firmware-binaries/test-cases/clock-control-wb/build.rs b/firmware-binaries/test-cases/clock-control-wb/build.rs new file mode 100644 index 000000000..19bbae6e4 --- /dev/null +++ b/firmware-binaries/test-cases/clock-control-wb/build.rs @@ -0,0 +1,30 @@ +// SPDX-FileCopyrightText: 2022 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use std::env; +use std::fs; +use std::path::Path; +use std::time::SystemTime; +use std::time::UNIX_EPOCH; + +/// Put the linker script somewhere the linker can find it. +fn main() { + let out_dir = env::var("OUT_DIR").expect("No out dir"); + let dest_path = Path::new(&out_dir).join("memory.x"); + fs::write(dest_path, include_bytes!("memory.x")).expect("Could not write file"); + + if env::var("CARGO_CFG_TARGET_ARCH").unwrap() == "riscv32" { + println!("cargo:rustc-link-arg=-Tmemory.x"); + println!("cargo:rustc-link-arg=-Tlink.x"); // linker script from riscv-rt + } + println!("cargo:rustc-link-search={out_dir}"); + + let now = SystemTime::now(); + let rng_seed = now.duration_since(UNIX_EPOCH).unwrap().as_millis(); + println!("cargo:rustc-env=RNG_SEED='{rng_seed:0128b}'"); + + println!("cargo:rerun-if-changed=memory.x"); + println!("cargo:rerun-if-changed=build.rs"); +} + diff --git a/firmware-binaries/test-cases/clock-control-wb/memory.x b/firmware-binaries/test-cases/clock-control-wb/memory.x new file mode 100644 index 000000000..5b0e902e8 --- /dev/null +++ b/firmware-binaries/test-cases/clock-control-wb/memory.x @@ -0,0 +1,18 @@ +/* +SPDX-FileCopyrightText: 2024 Google LLC + +SPDX-License-Identifier: CC0-1.0 +*/ + +MEMORY +{ + IMEM : ORIGIN = 0x80000000, LENGTH = 64K + DMEM : ORIGIN = 0x40000000, LENGTH = 32K +} + +REGION_ALIAS("REGION_TEXT", IMEM); +REGION_ALIAS("REGION_RODATA", DMEM); +REGION_ALIAS("REGION_DATA", DMEM); +REGION_ALIAS("REGION_BSS", DMEM); +REGION_ALIAS("REGION_HEAP", DMEM); +REGION_ALIAS("REGION_STACK", DMEM); diff --git a/firmware-binaries/test-cases/clock-control-wb/src/main.rs b/firmware-binaries/test-cases/clock-control-wb/src/main.rs new file mode 100644 index 000000000..f4f3c037a --- /dev/null +++ b/firmware-binaries/test-cases/clock-control-wb/src/main.rs @@ -0,0 +1,102 @@ +#![no_std] +#![cfg_attr(not(test), no_main)] + +// SPDX-FileCopyrightText: 2022 Google LLC +// +// SPDX-License-Identifier: Apache-2.0 + +use core::panic::PanicInfo; + +use bittide_sys::{ + clock_control::{ClockControl, SpeedChange}, + uart::Uart, debug_register::DebugRegister, +}; +use core::fmt::Write; +use rand::{distributions::Uniform, rngs::SmallRng, Rng, SeedableRng}; + +#[cfg(not(test))] +use riscv_rt::entry; + +const RNG_SEED: [u8; 16] = { + let rng_seed = core::env!("RNG_SEED").as_bytes(); + let mut out = [0; 16]; + + let mut i = 0; + while i < rng_seed.len() && (i / 8) < 16 { + let byte = i / 8; + let shift = i % 8; + let val = rng_seed[i]; + i += 1; + let val = match val { + b'0' => 0, + b'1' => 1, + _ => continue, + }; + out[byte] |= val << shift; + } + out +}; + +#[cfg_attr(not(test), entry)] +#[allow(clippy::empty_loop)] +fn main() -> ! { + #[allow(clippy::zero_ptr)] // we might want to change the address! + let mut uart = unsafe { Uart::new(0x2000_0000 as *const ()) }; + let mut cc = unsafe { ClockControl::from_base_addr(0xC000_0000 as *const u32) }; + let dbg = unsafe { DebugRegister::from_base_addr(0xE000_0000 as *const u32) }; + + writeln!(uart, "nLinks: {}", cc.num_links()).unwrap(); + writeln!(uart, "linkMask: {}", cc.link_mask()).unwrap(); + writeln!(uart, "linkMaskPopcnt: {}", cc.up_links()).unwrap(); + writeln!( + uart, + "reframingEnabled: {}", + if dbg.reframing_enabled() { + "True" + } else { + "False" + } + ) + .unwrap(); + writeln!(uart, "linksStable: {}", cc.links_stable()).unwrap(); + writeln!(uart, "linksSettled: {}", cc.links_settled()).unwrap(); + + write!(uart, "dataCounts: [").unwrap(); + cc.data_counts().enumerate().for_each(|(i, dc)| { + let sep = if i + 1 < cc.num_links() as usize { + ", " + } else { + "" + }; + write!(uart, "({i}, {dc}){sep}").unwrap(); + }); + writeln!(uart, "]").unwrap(); + + let mut rng = SmallRng::from_seed(RNG_SEED); + let amt = rng.gen_range(16..=128); + write!(uart, "clockMod({amt}): [").unwrap(); + rng.sample_iter(Uniform::new_inclusive(0, 2)) + .take(amt) + .map(|val| unsafe { core::mem::transmute::(val) }) + .enumerate() + .for_each(|(i, sc)| { + let sep = if i + 1 < amt { ", " } else { "" }; + cc.change_speed(sc); + write!(uart, "{}{sep}", sc as u8).unwrap(); + }); + writeln!(uart, "]").unwrap(); + + // Mark end of transmission - should hopefully be unique enough? + for _ in 0..cc.up_links() { + cc.change_speed(SpeedChange::NoChange); + } + + loop {} +} + +#[panic_handler] +fn panic_handler(_info: &PanicInfo) -> ! { + loop { + continue; + } +}