From 36554f84c6f832c428bb044a374e09708a08b5ae Mon Sep 17 00:00:00 2001 From: Lucas Bollen Date: Wed, 4 Dec 2024 11:24:53 +0100 Subject: [PATCH] Add `sim` function for `vexRiscV` hitl test --- .../src/Bittide/Instances/Hitl/Ethernet.hs | 5 ++ .../src/Bittide/Instances/Hitl/VexRiscv.hs | 59 ++++++++++++-- .../src/Bittide/Instances/Pnr/Ethernet.hs | 76 +++++++++++++++---- bittide-instances/tests/Wishbone/Axi.hs | 7 ++ bittide-instances/tests/Wishbone/DnaPortE2.hs | 18 +++-- bittide-instances/tests/Wishbone/Time.hs | 6 +- 6 files changed, 141 insertions(+), 30 deletions(-) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs b/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs index f818ed43f..a4de72e5e 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs @@ -13,6 +13,11 @@ import Clash.Explicit.Prelude import Clash.Xilinx.ClockGen import VexRiscv +import qualified Bittide.Instances.Pnr.Ethernet as Pnr + +sim :: IO () +sim = Pnr.sim + vexRiscvTcpTest :: DiffClock Ext125 -> Reset Ext125 -> diff --git a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs index f21bdf99a..b000e89fb 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs @@ -1,7 +1,9 @@ -- SPDX-FileCopyrightText: 2022 Google LLC -- -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fplugin=Protocols.Plugin #-} @@ -28,6 +30,14 @@ import Bittide.Instances.Hitl.Setup (allHwTargets) import Bittide.ProcessingElement import Bittide.SharedTypes import Bittide.Wishbone +import Clash.Cores.UART.Extra + +#ifdef CPU_INCLUDE_BINARIES +import Bittide.ProcessingElement.Util +import Language.Haskell.TH +import Project.FilePath +import System.FilePath +#endif data TestStatus = Running | Success | Fail deriving (Enum, Eq, Generic, NFDataX, BitPack) @@ -37,11 +47,29 @@ type TestSuccess = Bool type UartRx = Bit type UartTx = Bit +#ifdef SIM_BAUD_RATE +type Baud = MaxBaudRate Basic125 +#else +type Baud = 921_600 +#endif + +baud :: SNat Baud +baud = SNat + +-- | To use this function, change the initial contents of the iMem and dMem +sim :: IO () +sim = + uartIO stdin stdout baud $ withClockResetEnable clockGen resetGen enableGen $ Circuit go + where + go (uartRx, _) = (pure (), uartTx) + where + (_, _, uartTx) = vexRiscvInner @Basic125 (pure $ unpack 0) uartRx + vexRiscvInner :: forall dom. ( HiddenClockResetEnable dom , 1 <= DomainPeriod dom - , ValidBaud dom 921600 + , ValidBaud dom Baud ) => Signal dom JtagIn -> Signal dom UartRx -> @@ -65,7 +93,7 @@ vexRiscvInner jtagIn0 uartRx = Circuit circuitFn = circuit $ \(uartRx, jtag) -> do [timeBus, uartBus, statusRegisterBus] <- processingElement NoDumpVcd peConfig -< jtag (uartTx, _uartStatus) <- - uartInterfaceWb @dom d16 d16 (uartDf $ SNat @921600) -< (uartBus, uartRx) + uartInterfaceWb @dom d16 d16 (uartDf baud) -< (uartBus, uartRx) timeWb -< timeBus testResult <- statusRegister -< statusRegisterBus idC -< (testResult, uartTx) @@ -110,14 +138,33 @@ vexRiscvInner jtagIn0 uartRx = -- │ 0b110. │ 0xC │ 3 │ UART │ -- │ 0b111. │ 0xE │ 4 │ Test status register │ -- ╰────────┴───────┴───────┴────────────────────────────────────╯ - -- - -- peConfig :: PeConfig 5 + + memMap = 0b100 :> 0b010 :> 0b101 :> 0b110 :> 0b111 :> Nil + +#ifdef CPU_INCLUDE_BINARIES peConfig = PeConfig - (0b100 :> 0b010 :> 0b101 :> 0b110 :> 0b111 :> Nil) + memMap + (Reloadable $ Blob iMem) + (Reloadable $ Blob dMem) + (iMem, dMem) = + $( do + root <- runIO $ findParentContaining "cabal.project" + let + elfDir = root firmwareBinariesDir "riscv32imc-unknown-none-elf" Release + elfPath = elfDir "hello" + iSize = 8 * 1024 -- 16 KB + dSize = 64 * 1024 -- 256 KB + memBlobsFromElf BigEndian (Just iSize, Just dSize) elfPath Nothing + ) +{- FOURMOLU_ENABLE -} +#else + peConfig = + PeConfig + memMap (Undefined @(Div (64 * 1024) 4)) -- 64 KiB (Undefined @(Div (64 * 1024) 4)) -- 64 KiB - +#endif vexRiscvTest :: "CLK_125MHZ" ::: DiffClock Ext125 -> "JTAG" ::: Signal Basic125 JtagIn -> diff --git a/bittide-instances/src/Bittide/Instances/Pnr/Ethernet.hs b/bittide-instances/src/Bittide/Instances/Pnr/Ethernet.hs index 42580b311..539917381 100644 --- a/bittide-instances/src/Bittide/Instances/Pnr/Ethernet.hs +++ b/bittide-instances/src/Bittide/Instances/Pnr/Ethernet.hs @@ -1,11 +1,13 @@ -- SPDX-FileCopyrightText: 2024 Google LLC -- -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS -fplugin=Protocols.Plugin #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS -fplugin=Protocols.Plugin #-} + module Bittide.Instances.Pnr.Ethernet where import Clash.Explicit.Prelude @@ -13,8 +15,10 @@ import Clash.Explicit.Reset.Extra import Clash.Prelude (HiddenClockResetEnable, withClockResetEnable) import Clash.Cores.UART (ValidBaud) +import Clash.Cores.UART.Extra import Clash.Cores.Xilinx.Ethernet.Gmii import Clash.Cores.Xilinx.Unisim.DnaPortE2 (simDna2) +import Clash.Explicit.Testbench import Protocols import VexRiscv @@ -26,11 +30,36 @@ import Bittide.ProcessingElement import Bittide.Wishbone import Protocols.Idle +#ifdef CPU_INCLUDE_BINARIES +import Bittide.ProcessingElement.Util +import Bittide.SharedTypes +import Language.Haskell.TH +import Project.FilePath +import System.FilePath +#endif + +#ifdef SIM_BAUD_RATE +type Baud = MaxBaudRate Basic125 +#else type Baud = 921_600 +#endif baud :: SNat Baud baud = SNat +sim :: IO () +sim = + uartIO @Basic125B stdin stdout baud $ Circuit go + where + go (uartRx, _) = (pure (), uartTx) + where + (_, uartTx, _, _) = + vexRiscEthernet + clockGen + resetGen + (clockToDiffClock clockGen) + (pure $ unpack 0, uartRx, pure $ unpack 0) + {- | Instance containing: * VexRiscv CPU * UART @@ -45,7 +74,7 @@ vexRiscGmii :: , KnownDomain tx , KnownNat (DomainPeriod logic) , 1 <= DomainPeriod logic - , ValidBaud logic 921600 + , ValidBaud logic Baud ) => SNat gpioWidth -> Clock logic -> @@ -113,21 +142,40 @@ vexRiscGmii SNat sysClk sysRst rxClk rxRst txClk txRst fwd = wcre :: (((HiddenClockResetEnable logic) => a) -> a) wcre = withClockResetEnable sysClk sysRst enableGen + memMap = + 0b1000 + :> 0b0001 + :> 0b0010 + :> 0b0011 + :> 0b0101 + :> 0b0110 + :> 0b0111 + :> 0b0100 + :> 0b1001 + :> Nil + +#ifdef CPU_INCLUDE_BINARIES peConfig = - PeConfig - ( 0b1000 - :> 0b0001 - :> 0b0010 - :> 0b0011 - :> 0b0101 - :> 0b0110 - :> 0b0111 - :> 0b0100 - :> 0b1001 - :> Nil - ) + PeConfig memMap + (Reloadable $ Blob iMem) + (Reloadable $ Blob dMem) + + (iMem, dMem) = + $( do + root <- runIO $ findParentContaining "cabal.project" + let + elfDir = root firmwareBinariesDir "riscv32imc-unknown-none-elf" Release + elfPath = elfDir "smoltcp_client" + iSize = 256 * 1024 -- 256 KB + dSize = 64 * 1024 -- 64 KB + memBlobsFromElf BigEndian (Just iSize, Just dSize) elfPath Nothing + ) +#else + peConfig = + PeConfig memMap (Undefined @(DivRU (256 * 1024) 4)) (Undefined @(DivRU (64 * 1024) 4)) +#endif vexRiscEthernet :: Clock Basic125B -> diff --git a/bittide-instances/tests/Wishbone/Axi.hs b/bittide-instances/tests/Wishbone/Axi.hs index d0e9d1acf..faeefc7a1 100644 --- a/bittide-instances/tests/Wishbone/Axi.hs +++ b/bittide-instances/tests/Wishbone/Axi.hs @@ -43,6 +43,13 @@ import VexRiscv (DumpVcd (NoDumpVcd)) import qualified Protocols.Df as Df import qualified Protocols.DfConv as DfConv +sim :: IO () +sim = + putStr + $ fmap (chr . fromIntegral) + . mapMaybe Df.dataToMaybe + $ (sampleC def dut) + {- | Run the axi module self test with processingElement and inspect it's uart output. The test returns names of tests and a boolean indicating if the test passed. -} diff --git a/bittide-instances/tests/Wishbone/DnaPortE2.hs b/bittide-instances/tests/Wishbone/DnaPortE2.hs index 6dcff4c11..b2a50b570 100644 --- a/bittide-instances/tests/Wishbone/DnaPortE2.hs +++ b/bittide-instances/tests/Wishbone/DnaPortE2.hs @@ -33,6 +33,14 @@ import Bittide.Wishbone import qualified Protocols.Df as Df +sim :: IO () +sim = putStr simResult + +simResult :: String +simResult = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream + where + uartStream = sampleC def $ withClockResetEnable clockGen resetGen enableGen $ dut @System + -- | Test whether we can read the DNA from the DNA port peripheral. case_dna_port_self_test :: Assertion case_dna_port_self_test = assertBool msg (receivedDna == simDna2) @@ -43,10 +51,6 @@ case_dna_port_self_test = assertBool msg (receivedDna == simDna2) <> " not equal to expected dna " <> showHex simDna2 "" receivedDna = parseResult simResult - clk = clockGen - rst = resetGen - simResult = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream - uartStream = sampleC def $ withClockResetEnable clk rst enableGen $ dut @System <| idleSource {- | A simple instance containing just VexRisc with UART and the DNA peripheral which runs the `dna_port_e2_test` binary from `firmware-binaries`. @@ -54,9 +58,9 @@ runs the `dna_port_e2_test` binary from `firmware-binaries`. dut :: forall dom. (HiddenClockResetEnable dom) => - Circuit (Df dom (BitVector 8)) (Df dom (BitVector 8)) -dut = circuit $ \uartRx -> do - jtag <- idleSource -< () + Circuit () (Df dom (BitVector 8)) +dut = circuit $ \_unit -> do + (uartRx, jtag) <- idleSource -< () [uartBus, dnaWb] <- processingElement @dom NoDumpVcd peConfig -< jtag (uartTx, _uartStatus) <- uartInterfaceWb d2 d2 uartSim -< (uartBus, uartRx) readDnaPortE2Wb simDna2 -< dnaWb diff --git a/bittide-instances/tests/Wishbone/Time.hs b/bittide-instances/tests/Wishbone/Time.hs index 0052780f9..a0e67f7d1 100644 --- a/bittide-instances/tests/Wishbone/Time.hs +++ b/bittide-instances/tests/Wishbone/Time.hs @@ -39,8 +39,10 @@ import qualified Protocols.Df as Df sim :: IO () sim = putStrLn simResult + +simResult :: String +simResult = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream where - simResult = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream uartStream = sampleC def dut {- | Run the timing module self test with processingElement and inspect it's uart output. @@ -56,8 +58,6 @@ case_time_rust_self_test = where assertResult (TestResult name (Just err)) = assertFailure ("Test " <> name <> " failed with error" <> err) assertResult (TestResult _ Nothing) = return () - simResult = chr . fromIntegral <$> mapMaybe Df.dataToMaybe uartStream - uartStream = sampleC def dut {- | A simple instance containing just VexRisc and UART as peripheral. Runs the `hello` binary from `firmware-binaries`.