From d4a9694a98e033f09e4a96bd71737b161e61d07b Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 4 Dec 2024 12:52:28 +0100 Subject: [PATCH] Add optional VCD tracing --- .../app/VexRiscvChainSimulation.hs | 4 +- clash-vexriscv-sim/app/VexRiscvSimulation.hs | 2 +- clash-vexriscv-sim/src/Utils/Cpu.hs | 6 ++- clash-vexriscv-sim/src/Utils/Instance.hs | 2 +- clash-vexriscv-sim/tests/tests.hs | 4 +- clash-vexriscv/src/VexRiscv.hs | 50 +++++++++++-------- clash-vexriscv/src/VexRiscv/FFI.hsc | 10 ++-- clash-vexriscv/src/ffi/impl.cpp | 37 +++++++++++--- 8 files changed, 77 insertions(+), 38 deletions(-) diff --git a/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs b/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs index fa92f28..b9bfb36 100644 --- a/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs +++ b/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs @@ -106,7 +106,7 @@ main = do cpuOutA@(unbundle -> (_circuitA, jtagOutA, _, _iBusA, _dBusA)) = withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ let - (circ, jto, writes1, iBus, dBus) = cpu (Just jtagInA) iMemA dMemA + (circ, jto, writes1, iBus, dBus) = cpu Nothing (Just jtagInA) iMemA dMemA dBus' = register emptyWishboneS2M dBus in bundle (circ, jto, writes1, iBus, dBus') @@ -114,7 +114,7 @@ main = do cpuOutB@(unbundle -> (_circuitB, jtagOutB, _, _iBusB, _dBusB)) = withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ let - (circ, jto, writes1, iBus, dBus) = cpu (Just jtagInB) iMemB dMemB + (circ, jto, writes1, iBus, dBus) = cpu Nothing (Just jtagInB) iMemB dMemB dBus' = register emptyWishboneS2M dBus in bundle (circ, jto, writes1, iBus, dBus') diff --git a/clash-vexriscv-sim/app/VexRiscvSimulation.hs b/clash-vexriscv-sim/app/VexRiscvSimulation.hs index f298b2f..a886b30 100644 --- a/clash-vexriscv-sim/app/VexRiscvSimulation.hs +++ b/clash-vexriscv-sim/app/VexRiscvSimulation.hs @@ -58,7 +58,7 @@ main = do jtagPort = vexrJtagBridge 7894 jtagOut cpuOut@(unbundle -> (_circuit, jtagOut, writes, _iBus, _dBus)) = withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ - let (circ, jto, writes1, iBus, dBus) = cpu (Just jtagPort) iMem dMem + let (circ, jto, writes1, iBus, dBus) = cpu Nothing (Just jtagPort) iMem dMem dBus' = register emptyWishboneS2M dBus in bundle (circ, jto, writes1, iBus, dBus') diff --git a/clash-vexriscv-sim/src/Utils/Cpu.hs b/clash-vexriscv-sim/src/Utils/Cpu.hs index 4088c84..1521c24 100644 --- a/clash-vexriscv-sim/src/Utils/Cpu.hs +++ b/clash-vexriscv-sim/src/Utils/Cpu.hs @@ -40,6 +40,8 @@ cpu :: -- convenient it is to use this within a design with synchronous resets. -- , HasAsynchronousReset dom ) => + -- | VCD dump path + Maybe FilePath -> Maybe (Signal dom JtagIn) -> DMemory dom -> DMemory dom -> @@ -52,7 +54,7 @@ cpu :: , -- dBus responses Signal dom (WishboneS2M (BitVector 32)) ) -cpu jtagIn0 bootIMem bootDMem = +cpu maybeVcdPath jtagIn0 bootIMem bootDMem = ( cpuOut , jtagOut , writes @@ -60,7 +62,7 @@ cpu jtagIn0 bootIMem bootDMem = , dS2M ) where - (cpuOut, jtagOut) = vexRiscv hasClock (hasReset `unsafeOrReset` jtagReset) input jtagIn1 + (cpuOut, jtagOut) = vexRiscv maybeVcdPath hasClock (hasReset `unsafeOrReset` jtagReset) input jtagIn1 jtagReset = unsafeFromActiveHigh $ register False $ diff --git a/clash-vexriscv-sim/src/Utils/Instance.hs b/clash-vexriscv-sim/src/Utils/Instance.hs index 0ba606c..663a770 100644 --- a/clash-vexriscv-sim/src/Utils/Instance.hs +++ b/clash-vexriscv-sim/src/Utils/Instance.hs @@ -20,6 +20,6 @@ circuit :: ( "CPU_OUTPUT" ::: Signal System CpuOut , "JTAG_OUT" ::: Signal System JtagOut ) circuit clk rst input jtagIn = - vexRiscv clk rst input jtagIn + vexRiscv Nothing clk rst input jtagIn {-# CLASH_OPAQUE circuit #-} makeTopEntity 'circuit diff --git a/clash-vexriscv-sim/tests/tests.hs b/clash-vexriscv-sim/tests/tests.hs index 5510469..ab07efa 100644 --- a/clash-vexriscv-sim/tests/tests.hs +++ b/clash-vexriscv-sim/tests/tests.hs @@ -44,7 +44,7 @@ runProgramExpect act n expected = withSystemTempFile "ELF" $ \fp _ -> do let _all@(unbundle -> (_circuit, _, writes, _iBus, _dBus)) = withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ - bundle (cpu Nothing iMem dMem) + bundle (cpu Nothing Nothing iMem dMem) let output = L.take (BS.length expected) $ flip mapMaybe (sampleN_lazy n writes) $ \case @@ -104,7 +104,7 @@ runTest :: FilePath -> TestTree runTest name mode n elfPath expectPath = - testCase ("Integration test `" <> name <> "` (" <> mode <> ")") $ do + testCase ("Integration test " <> name <> " (" <> mode <> ")") $ do expected <- BS.readFile expectPath let act = copyFile elfPath diff --git a/clash-vexriscv/src/VexRiscv.hs b/clash-vexriscv/src/VexRiscv.hs index edd6f2e..70e1187 100644 --- a/clash-vexriscv/src/VexRiscv.hs +++ b/clash-vexriscv/src/VexRiscv.hs @@ -20,9 +20,10 @@ import Clash.Signal.Internal import Data.Bifunctor (first) import Data.String.Interpolate (__i) import Data.Word (Word64) -import Foreign (Ptr) +import Foreign (Ptr, nullPtr) import Foreign.Marshal (alloca) import Foreign.Storable +import Foreign.C.String (newCString) import GHC.IO (unsafePerformIO, unsafeInterleaveIO) import GHC.Stack (HasCallStack) import Language.Haskell.TH.Syntax @@ -81,6 +82,8 @@ vexRiscv :: forall dom . ( HasCallStack , KnownDomain dom) => + -- | VCD dump path + Maybe FilePath -> Clock dom -> Reset dom -> Signal dom CpuIn -> @@ -88,7 +91,7 @@ vexRiscv :: ( Signal dom CpuOut , Signal dom JtagOut ) -vexRiscv clk rst cpuInput jtagInput = +vexRiscv maybeVcdPath clk rst cpuInput jtagInput = ( CpuOut <$> (WishboneM2S <$> iBus_ADR @@ -161,7 +164,7 @@ vexRiscv clk rst cpuInput jtagInput = , dBus_BTE , debug_resetOut , jtag_TDO - ) = vexRiscv# sourcePath clk rst + ) = vexRiscv# maybeVcdPath sourcePath clk rst timerInterrupt externalInterrupt softwareInterrupt @@ -181,7 +184,8 @@ vexRiscv clk rst cpuInput jtagInput = vexRiscv# :: KnownDomain dom - => String + => Maybe FilePath + -> String -> Clock dom -> Reset dom -- input signals @@ -228,7 +232,7 @@ vexRiscv# , Signal dom Bit -- ^ debug_resetOut , Signal dom Bit -- ^ jtag_TDO ) -vexRiscv# !_sourcePath clk rst0 +vexRiscv# maybeVcdPath !_sourcePath clk rst0 timerInterrupt0 externalInterrupt0 softwareInterrupt0 @@ -243,7 +247,7 @@ vexRiscv# !_sourcePath clk rst0 jtag_TCK0 jtag_TMS0 jtag_TDI0 = unsafePerformIO $ do - (v, initStage1, initStage2, stepRising, stepFalling, _shutDown) <- vexCPU + (v, initStage1, initStage2, stepRising, stepFalling, _shutDown) <- vexCPU maybeVcdPath -- Make sure all the inputs are defined let @@ -366,7 +370,8 @@ vexRiscv# !_sourcePath clk rst0 ( -- ARGs - _ + _knownDomain + , _vcdPath , srcPath , clk , rst @@ -404,7 +409,7 @@ vexRiscv# !_sourcePath clk rst0 , jtag_TDO , cpu - ) = vecToTuple $ indicesI @35 + ) = vecToTuple $ indicesI @36 in InlineYamlPrimitive [Verilog] [__i| BlackBox: @@ -505,23 +510,28 @@ vexRiscv# !_sourcePath clk rst0 -- | Return a function that performs an execution step and a function to free -- the internal CPU state -vexCPU :: IO - ( Ptr VexRiscv - , Ptr VexRiscv -> NON_COMB_INPUT -> IO OUTPUT -- initStage1 - , Ptr VexRiscv -> COMB_INPUT -> IO () -- initStage2 - , Ptr VexRiscv -> Word64 -> NON_COMB_INPUT -> IO OUTPUT -- rising - , Ptr VexRiscv -> Word64 -> COMB_INPUT -> IO () -- falling - , Ptr VexRiscv -> IO () - ) -vexCPU = do +vexCPU :: + -- | VCD dump path + Maybe FilePath -> + IO + ( Ptr VexRiscv + , Ptr VexRiscv -> NON_COMB_INPUT -> IO OUTPUT -- initStage1 + , Ptr VexRiscv -> COMB_INPUT -> IO () -- initStage2 + , Ptr VexRiscv -> Word64 -> NON_COMB_INPUT -> IO OUTPUT -- rising + , Ptr VexRiscv -> Word64 -> COMB_INPUT -> IO () -- falling + , Ptr VexRiscv -> IO () + ) +vexCPU maybeVcdPath = do v <- vexrInit + vcdPath <- maybe (pure nullPtr) newCString maybeVcdPath + vcd <- vexrInitVcd v vcdPath let {-# NOINLINE initStage1 #-} initStage1 vPtr nonCombInput = alloca $ \nonCombInputFFI -> alloca $ \outputFFI -> do poke nonCombInputFFI nonCombInput - vexrInitStage1 vPtr nonCombInputFFI outputFFI + vexrInitStage1 vcd vPtr nonCombInputFFI outputFFI peek outputFFI {-# NOINLINE initStage2 #-} @@ -534,14 +544,14 @@ vexCPU = do stepRising vPtr fsSinceLastEvent nonCombInput = alloca $ \nonCombInputFFI -> alloca $ \outputFFI -> do poke nonCombInputFFI nonCombInput - vexrStepRisingEdge vPtr fsSinceLastEvent nonCombInputFFI outputFFI + vexrStepRisingEdge vcd vPtr fsSinceLastEvent nonCombInputFFI outputFFI peek outputFFI {-# NOINLINE stepFalling #-} stepFalling vPtr fsSinceLastEvent combInput = alloca $ \combInputFFI -> do poke combInputFFI combInput - vexrStepFallingEdge vPtr fsSinceLastEvent combInputFFI + vexrStepFallingEdge vcd vPtr fsSinceLastEvent combInputFFI shutDown = vexrShutdown diff --git a/clash-vexriscv/src/VexRiscv/FFI.hsc b/clash-vexriscv/src/VexRiscv/FFI.hsc index 572cad8..9fc929d 100644 --- a/clash-vexriscv/src/VexRiscv/FFI.hsc +++ b/clash-vexriscv/src/VexRiscv/FFI.hsc @@ -10,6 +10,7 @@ module VexRiscv.FFI where import Foreign.Storable import Foreign.Ptr +import Foreign.C (CString) import Prelude import Clash.Prelude import Data.Word @@ -18,15 +19,18 @@ import Data.Word data VexRiscv +data VerilatedVcdC + data VexRiscvJtagBridge foreign import ccall unsafe "vexr_init" vexrInit :: IO (Ptr VexRiscv) +foreign import ccall unsafe "vexr_init_vcd" vexrInitVcd :: Ptr VexRiscv -> CString -> IO (Ptr VerilatedVcdC) foreign import ccall unsafe "vexr_shutdown" vexrShutdown :: Ptr VexRiscv -> IO () -foreign import ccall unsafe "vexr_init_stage1" vexrInitStage1 :: Ptr VexRiscv -> Ptr NON_COMB_INPUT -> Ptr OUTPUT -> IO () +foreign import ccall unsafe "vexr_init_stage1" vexrInitStage1 :: Ptr VerilatedVcdC -> Ptr VexRiscv -> Ptr NON_COMB_INPUT -> Ptr OUTPUT -> IO () foreign import ccall unsafe "vexr_init_stage2" vexrInitStage2 :: Ptr VexRiscv -> Ptr COMB_INPUT -> IO () -foreign import ccall unsafe "vexr_step_rising_edge" vexrStepRisingEdge :: Ptr VexRiscv -> Word64 -> Ptr NON_COMB_INPUT -> Ptr OUTPUT -> IO () -foreign import ccall unsafe "vexr_step_falling_edge" vexrStepFallingEdge :: Ptr VexRiscv -> Word64 -> Ptr COMB_INPUT -> IO () +foreign import ccall unsafe "vexr_step_rising_edge" vexrStepRisingEdge :: Ptr VerilatedVcdC -> Ptr VexRiscv -> Word64 -> Ptr NON_COMB_INPUT -> Ptr OUTPUT -> IO () +foreign import ccall unsafe "vexr_step_falling_edge" vexrStepFallingEdge :: Ptr VerilatedVcdC -> Ptr VexRiscv -> Word64 -> Ptr COMB_INPUT -> IO () foreign import ccall unsafe "vexr_jtag_bridge_init" vexrJtagBridgeInit :: Word16 -> IO (Ptr VexRiscvJtagBridge) foreign import ccall unsafe "vexr_jtag_bridge_step" vexrJtagBridgeStep :: Ptr VexRiscvJtagBridge -> Ptr JTAG_OUTPUT -> Ptr JTAG_INPUT -> IO () diff --git a/clash-vexriscv/src/ffi/impl.cpp b/clash-vexriscv/src/ffi/impl.cpp index 7fe8dad..2beff32 100644 --- a/clash-vexriscv/src/ffi/impl.cpp +++ b/clash-vexriscv/src/ffi/impl.cpp @@ -4,6 +4,7 @@ #include "VVexRiscv.h" #include "verilated.h" +#include #include "interface.h" #include @@ -31,12 +32,13 @@ typedef struct { extern "C" { VVexRiscv* vexr_init(); + VerilatedVcdC* vexr_init_vcd(VVexRiscv *top, const char* path); void vexr_shutdown(VVexRiscv *top); - void vexr_init_stage1(VVexRiscv *top, const NON_COMB_INPUT *input, OUTPUT *output); + void vexr_init_stage1(VerilatedVcdC *vcd, VVexRiscv *top, const NON_COMB_INPUT *input, OUTPUT *output); void vexr_init_stage2(VVexRiscv *top, const COMB_INPUT *input); - void vexr_step_rising_edge(VVexRiscv *top, uint64_t time_add, const NON_COMB_INPUT *input, OUTPUT *output); - void vexr_step_falling_edge(VVexRiscv *top, uint64_t time_add, const COMB_INPUT *input); + void vexr_step_rising_edge(VerilatedVcdC *vcd, VVexRiscv *top, uint64_t time_add, const NON_COMB_INPUT *input, OUTPUT *output); + void vexr_step_falling_edge(VerilatedVcdC *vcd, VVexRiscv *top, uint64_t time_add, const COMB_INPUT *input); vexr_jtag_bridge_data *vexr_jtag_bridge_init(uint16_t port); void vexr_jtag_bridge_step(vexr_jtag_bridge_data *d, const JTAG_OUTPUT *output, JTAG_INPUT *input); @@ -51,11 +53,23 @@ VVexRiscv* vexr_init() { contextp = new VerilatedContext; VVexRiscv *v = new VVexRiscv(contextp); - Verilated::traceEverOn(true); v->clk = false; return v; } +VerilatedVcdC* vexr_init_vcd(VVexRiscv *top, const char* path) +{ + if (path != NULL){ + VerilatedVcdC* vcd = new VerilatedVcdC; + Verilated::traceEverOn(true); + top->trace(vcd, 99); + vcd->open(path); + return vcd; + } + + return NULL; +} + // Set all inputs that cannot combinationaly depend on outputs. I.e., all inputs // except the Wishbone buses. void set_non_comb_inputs(VVexRiscv *top, const NON_COMB_INPUT *input) @@ -106,7 +120,7 @@ void set_ouputs(VVexRiscv *top, OUTPUT *output) output->jtag_TDO = top->jtag_tdo; } -void vexr_init_stage1(VVexRiscv *top, const NON_COMB_INPUT *input, OUTPUT *output) +void vexr_init_stage1(VerilatedVcdC *vcd, VVexRiscv *top, const NON_COMB_INPUT *input, OUTPUT *output) { // Set all inputs that cannot combinationaly depend on outputs. I.e., all inputs // except the Wishbone buses. @@ -114,6 +128,9 @@ void vexr_init_stage1(VVexRiscv *top, const NON_COMB_INPUT *input, OUTPUT *outpu // Combinatorially respond to the inputs top->eval(); + if (vcd != NULL){ + vcd->dump (contextp->time()); + } set_ouputs(top, output); // Advance time by 50 nanoseconds. This is an arbitrary value. Ideally, we would @@ -134,7 +151,7 @@ void vexr_shutdown(VVexRiscv *top) } -void vexr_step_rising_edge(VVexRiscv *top, uint64_t time_add, const NON_COMB_INPUT *input, OUTPUT *output) +void vexr_step_rising_edge(VerilatedVcdC *vcd, VVexRiscv *top, uint64_t time_add, const NON_COMB_INPUT *input, OUTPUT *output) { // Advance time since last event. Note that this is 0 for the first call to // this function. To get a sensisble waveform, vexr_init has already advanced @@ -146,12 +163,15 @@ void vexr_step_rising_edge(VVexRiscv *top, uint64_t time_add, const NON_COMB_INP top->clk = true; top->eval(); + if (vcd != NULL){ + vcd->dump (contextp->time()); + } // Set all outputs set_ouputs(top, output); } -void vexr_step_falling_edge(VVexRiscv *top, uint64_t time_add, const COMB_INPUT *input) +void vexr_step_falling_edge(VerilatedVcdC *vcd, VVexRiscv *top, uint64_t time_add, const COMB_INPUT *input) { // advance time since last event contextp->timeInc(time_add); // time_add is in femtoseconds, timeinc expects picoseconds @@ -162,6 +182,9 @@ void vexr_step_falling_edge(VVexRiscv *top, uint64_t time_add, const COMB_INPUT // Evaluate the simulation top->eval(); + if (vcd != NULL){ + vcd->dump (contextp->time()); + } } vexr_jtag_bridge_data *vexr_jtag_bridge_init(uint16_t port)