From 6f1c2a20bc7ef085e0cb40635db38366602f587c Mon Sep 17 00:00:00 2001 From: Ryan Slawson Date: Sun, 24 Nov 2024 20:05:56 +0100 Subject: [PATCH] Add JTAG chaining test. --- .github/workflows/ci.yml | 3 +- .../app/VexRiscvChainSimulation.hs | 307 ++++++++++++++++++ clash-vexriscv-sim/clash-vexriscv-sim.cabal | 27 +- .../data/vexriscv_chain_gdba.cfg | 45 +++ .../data/vexriscv_chain_gdbb.cfg | 45 +++ .../data/vexriscv_chain_sim.cfg | 47 +++ clash-vexriscv-sim/src/Utils/FilePath.hs | 38 +++ clash-vexriscv-sim/tests/Tests/JtagChain.hs | 173 ++++++++++ clash-vexriscv-sim/tests/tests.hs | 2 + 9 files changed, 685 insertions(+), 2 deletions(-) create mode 100644 clash-vexriscv-sim/app/VexRiscvChainSimulation.hs create mode 100644 clash-vexriscv-sim/data/vexriscv_chain_gdba.cfg create mode 100644 clash-vexriscv-sim/data/vexriscv_chain_gdbb.cfg create mode 100644 clash-vexriscv-sim/data/vexriscv_chain_sim.cfg create mode 100644 clash-vexriscv-sim/src/Utils/FilePath.hs create mode 100644 clash-vexriscv-sim/tests/Tests/JtagChain.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d94d4fb..779e7ae 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -173,7 +173,8 @@ jobs: - name: Run `clash-vexriscv-sim` unittests run: | - cabal run clash-vexriscv-sim:unittests -- -j2 + # Can't run the unit tests with multiple threads because of the common use of port 7894. + cabal run clash-vexriscv-sim:unittests -- -j1 - name: Run `clash-vexriscv-sim` HDL test run: | diff --git a/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs b/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs new file mode 100644 index 0000000..fa92f28 --- /dev/null +++ b/clash-vexriscv-sim/app/VexRiscvChainSimulation.hs @@ -0,0 +1,307 @@ +-- SPDX-FileCopyrightText: 2022-2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} + +import Clash.Prelude + +import Control.Monad (forM_, when) +import GHC.Char (chr) +import GHC.IO.Handle (hFlush, Handle, hPutStr) +import Options.Applicative (Parser, strOption, short, long, help, info, helper, fullDesc, progDesc, header, execParser) +import Protocols.Wishbone +import System.Exit (exitFailure) +import System.IO (openFile, IOMode (WriteMode), hPutStrLn, hPutChar) +import Text.Printf (printf, hPrintf) + +import Utils.DebugConfig (DebugConfiguration (..)) +import Utils.Cpu (cpu) +import Utils.ProgramLoad (loadProgramDmem) +import VexRiscv (JtagIn (JtagIn), JtagOut (JtagOut), CpuOut (dBusWbM2S, iBusWbM2S)) +import VexRiscv.JtagTcpBridge (vexrJtagBridge) + + +import qualified Data.List as L + +-- change this variable to the configuration you want to use + +debugConfig :: DebugConfiguration +debugConfig = + -- InspectWrites + RunCharacterDevice + +-- +{- + InspectBusses + 0 + 0 + (Just 100) + True + True +-- -} + +-------------------------------------- + +data RunOpts = RunOpts + { execPathA :: FilePath + , execPathB :: FilePath + , logPathA :: FilePath + , logPathB :: FilePath + } + +getRunOpts :: Parser RunOpts +getRunOpts = RunOpts + <$> strOption + ( short 'a' + <> long "a-exec" + <> help "Path to the executable for CPU A" + ) + <*> strOption + ( short 'b' + <> long "b-exec" + <> help "Path to the executable for CPU B" + ) + <*> strOption + ( short 'A' + <> long "a-log" + <> help "Path to the log file for CPU A" + ) + <*> strOption + ( short 'B' + <> long "b-log" + <> help "Path to the log file for CPU B" + ) + +jtagDaisyChain :: JtagIn -> JtagOut -> JtagIn +jtagDaisyChain (JtagIn tc ms _) (JtagOut to _) = JtagIn tc ms to + +type CpuSignals = + ( CpuOut + , JtagOut + , Maybe (BitVector 32, BitVector 32) + , WishboneS2M (BitVector 32) + , WishboneS2M (BitVector 32) + ) + +main :: IO () +main = do + RunOpts {..} <- execParser opts + + (iMemA, dMemA) <- + withClockResetEnable @System clockGen resetGen enableGen $ + loadProgramDmem @System execPathA + + (iMemB, dMemB) <- + withClockResetEnable @System clockGen resetGen enableGen $ + loadProgramDmem @System execPathB + + logFileA <- openFile logPathA WriteMode + logFileB <- openFile logPathB WriteMode + + let + jtagInA = vexrJtagBridge 7894 jtagOutB + cpuOutA@(unbundle -> (_circuitA, jtagOutA, _, _iBusA, _dBusA)) = + withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ + let + (circ, jto, writes1, iBus, dBus) = cpu (Just jtagInA) iMemA dMemA + dBus' = register emptyWishboneS2M dBus + in bundle (circ, jto, writes1, iBus, dBus') + + jtagInB = liftA2 jtagDaisyChain jtagInA jtagOutA + cpuOutB@(unbundle -> (_circuitB, jtagOutB, _, _iBusB, _dBusB)) = + withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $ + let + (circ, jto, writes1, iBus, dBus) = cpu (Just jtagInB) iMemB dMemB + dBus' = register emptyWishboneS2M dBus + in bundle (circ, jto, writes1, iBus, dBus') + + _jtagReset = L.foldl (liftA2 go1) (pure False) [jtagOutA, jtagOutB] + where + go1 acc (JtagOut _ tr) = acc || bitToBool tr + + cpuOut = bundle (cpuOutA, cpuOutB) + + runSampling + debugConfig + (logFileA, logFileB) + cpuOut + where + opts = info (getRunOpts <**> helper) + ( fullDesc + <> progDesc "Run binaries on two Vex RISC-V CPUs linked with JTAG chaining" + <> header "vex-riscv-chain-simulation - a test for JTAG chaining" + ) + +runSampling + :: DebugConfiguration + -> (Handle, Handle) + -> Signal System (CpuSignals, CpuSignals) + -> IO () +runSampling dbg (handleA, handleB) cpusOutputs = do + case dbg of + RunCharacterDevice -> + forM_ + (sample_lazy @System (bundle (register @System (unpack 0) cpusOutputs, cpusOutputs))) + $ \((a1, b1), (a0, b0)) -> do + runCharacterDevice handleA a1 a0 + runCharacterDevice handleB b1 b0 + InspectBusses initCycles uninteresting interesting iEnabled dEnabled -> do + let + skipTotal = initCycles + uninteresting + sampled = case interesting of + Nothing -> L.zip [0 ..] $ sample_lazy @System cpusOutputs + Just nInteresting -> + let total = initCycles + uninteresting + nInteresting in + L.zip [0 ..] $ L.take total $ sample_lazy @System cpusOutputs + forM_ sampled $ \(i, (cpuOutA, cpuOutB)) -> do + runInspectBusses handleA skipTotal iEnabled dEnabled i cpuOutA + runInspectBusses handleB skipTotal iEnabled dEnabled i cpuOutB + InspectWrites -> + forM_ + (sample_lazy @System cpusOutputs) + $ \((_, _, writesA, _, _), (_, _, writesB, _, _)) -> do + case (writesA, writesB) of + (Just (aA, vA), Just (aB, vB)) -> do + hPrintf handleA "W: % 8X\n" (toInteger aA) (toInteger vA) + hPrintf handleB "W: % 8X\n" (toInteger aB) (toInteger vB) + (Just (a, v), Nothing) -> hPrintf handleA "W: % 8X\n" (toInteger a) (toInteger v) + (Nothing, Just (a, v)) -> hPrintf handleB "W: % 8X\n" (toInteger a) (toInteger v) + _ -> pure () + +runCharacterDevice + :: Handle + -> CpuSignals + -> CpuSignals + -> IO () +runCharacterDevice logFile (_, _, write, dS2M, iS2M) (out1, _, _, _, _) = do + when (err dS2M) $ do + let dBusM2S = dBusWbM2S out1 + let dAddr = toInteger (addr dBusM2S) -- `shiftL` 2 + hPrintf + logFile + "D-bus ERR reply % 8X (% 8X)\n" + (toInteger $ dAddr `shiftL` 2) + (toInteger dAddr) + exitFailure + + when (err iS2M) $ do + let iBusM2S = iBusWbM2S out1 + let iAddr = toInteger (addr iBusM2S) -- `shiftL` 2 + hPrintf + logFile + "I-bus ERR reply % 8X (% 8X)\n" + (toInteger $ iAddr `shiftL` 2) + (toInteger iAddr) + hPrintf logFile "%s\n" (show iBusM2S) + exitFailure + + case write of + Just (address, value) | address == 0x0000_1000 -> do + let + (_ :: BitVector 24, b :: BitVector 8) = unpack value + char = chr (fromEnum b) + hPutChar logFile char + when (char == '\n') (hFlush logFile) + _ -> pure () + +runInspectBusses + :: Handle + -> Int + -> Bool + -> Bool + -> Int + -> CpuSignals + -> IO () +runInspectBusses + logFile + skipTotal + iEnabled + dEnabled + i + (out, _, _, iBusS2M, dBusS2M) + = do + let doPrint = i >= skipTotal + + when (doPrint && iEnabled) $ do + let + iBusM2S = iBusWbM2S out + iAddr = toInteger (addr iBusM2S) -- `shiftL` 2 + cyc = if busCycle iBusM2S then "CYC" else " " + stb = if strobe iBusM2S then "STB" else " " + iResp = + if + | acknowledge iBusS2M -> "ACK " + | err iBusS2M -> "ERR " + | retry iBusS2M -> "RETRY" + | otherwise -> "NONE " + iRespData = + if acknowledge iBusS2M + then printf "% 8X" (toInteger $ readData iBusS2M) + else "" + + hPutStr logFile $ + "iM2S: (" + <> (cyc <> " " <> stb) + <> ") (" + <> showX (busSelect iBusM2S) + <> ") " + <> printf "% 8X" iAddr + <> " (" + <> printf "%X" (iAddr `shiftL` 2) + <> ")" + hPutStrLn logFile $ "iS2M: " <> iResp <> " - " <> iRespData + + when (err iBusS2M) + exitFailure + + when (doPrint && dEnabled) $ do + let + dBusM2S = dBusWbM2S out + dAddr = toInteger (addr dBusM2S) -- `shiftL 2` + dWrite = writeEnable dBusM2S + cyc = if busCycle dBusM2S then "CYC" else " " + stb = if strobe dBusM2S then "STB" else " " + dValid = busCycle dBusM2S && strobe dBusM2S + dActive = busCycle dBusM2S + mode = if dWrite then "W" else "R" + dResp = + if + | acknowledge dBusS2M -> "ACK " + | err dBusS2M -> "ERR " + | retry dBusS2M -> "RETRY" + | otherwise -> "NONE " + dRespData + | acknowledge dBusS2M && hasUndefined (readData dBusS2M) && not dWrite = printf " - undefined!!" + | acknowledge dBusS2M && not dWrite = printf " - % 8X" (toInteger $ readData dBusS2M) + | not dWrite = " - " + | otherwise = "" + writeDat = + if dValid && dWrite + then printf "% 8X" (toInteger $ writeData dBusM2S) + else " no data" + + when (dActive || hasTerminateFlag dBusS2M) $ do + hPutStr logFile $ + "dM2S: " + <> mode + <> " (" + <> (cyc <> " " <> stb) + <> ") (" + <> showX (busSelect dBusM2S) + <> ") " + <> printf "% 8X" dAddr + <> " (" + <> printf "% 8X" (dAddr `shiftL` 2) + <> ") <" + <> writeDat + <> "> - " + hPutStrLn logFile $ + "dS2M: " + <> dResp + <> dRespData + + when (err dBusS2M) + exitFailure diff --git a/clash-vexriscv-sim/clash-vexriscv-sim.cabal b/clash-vexriscv-sim/clash-vexriscv-sim.cabal index be6eb00..c60046c 100644 --- a/clash-vexriscv-sim/clash-vexriscv-sim.cabal +++ b/clash-vexriscv-sim/clash-vexriscv-sim.cabal @@ -84,6 +84,7 @@ library exposed-modules: Utils.Cpu Utils.DebugConfig + Utils.FilePath Utils.Instance Utils.Interconnect Utils.ProgramLoad @@ -95,7 +96,10 @@ library clash-prelude, clash-protocols, clash-vexriscv, + directory, elf >= 0.31 && < 0.32, + filepath, + template-haskell, -- XXX: Doesn't really belong in clash-vexriscv-SIM executable hdl-test @@ -122,6 +126,24 @@ executable clash-vexriscv-bin containers, directory, +executable clash-vexriscv-chain-bin + import: common-options + main-is: VexRiscvChainSimulation.hs + hs-source-dirs: app + default-language: Haskell2010 + ghc-options: -threaded -rtsopts "-with-rtsopts=-M400M" + build-depends: + base, + clash-prelude, + clash-protocols, + clash-vexriscv, + clash-vexriscv-sim, + bytestring, + containers, + directory, + filepath, + optparse-applicative, + test-suite unittests import: common-options default-language: Haskell2010 @@ -129,7 +151,8 @@ test-suite unittests type: exitcode-stdio-1.0 ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: - clash-vexriscv-sim:clash-vexriscv-bin + clash-vexriscv-sim:clash-vexriscv-bin, + clash-vexriscv-sim:clash-vexriscv-chain-bin autogen-modules: Paths_clash_vexriscv_sim ghc-options: -threaded @@ -137,6 +160,7 @@ test-suite unittests other-modules: Paths_clash_vexriscv_sim Tests.Jtag + Tests.JtagChain build-depends: async, base, @@ -150,6 +174,7 @@ test-suite unittests extra, filepath, process, + streaming, tasty >= 1.2 && < 1.6, tasty-hunit >= 0.10 && < 0.11, temporary >=1.1 && <1.4, diff --git a/clash-vexriscv-sim/data/vexriscv_chain_gdba.cfg b/clash-vexriscv-sim/data/vexriscv_chain_gdba.cfg new file mode 100644 index 0000000..362d7c7 --- /dev/null +++ b/clash-vexriscv-sim/data/vexriscv_chain_gdba.cfg @@ -0,0 +1,45 @@ +# Execute using: +# +# gdb --command vexriscv_gdb.cfg +# + +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +# Assume "print_a" is running on the CPU +file "target/riscv32imc-unknown-none-elf/debug/print_a" + +# Work around issues where simulation is too slow to respond to keep-alive messages, +# confusing either OpenOCD or GDB. Note that it will still complain about "missed" +# deadlines, but it won't fail.. +set remotetimeout unlimited + +# Connect to OpenOCD +target extended-remote :3333 + +# List registers +i r + +# break on main function entrance +break main + +# Jump to start address, should run until it hits main +jump _start + +# Run until we hit function "done", meaning it should have printed "a" +disable 1 +break print_a::done +continue +disable 2 + +# Load program +file "target/riscv32imc-unknown-none-elf/debug/print_b" +load + +# Jump to start address. Should now output "b". +break print_b::done +jump _start + +# Stop running GDB +quit diff --git a/clash-vexriscv-sim/data/vexriscv_chain_gdbb.cfg b/clash-vexriscv-sim/data/vexriscv_chain_gdbb.cfg new file mode 100644 index 0000000..5de8010 --- /dev/null +++ b/clash-vexriscv-sim/data/vexriscv_chain_gdbb.cfg @@ -0,0 +1,45 @@ +# Execute using: +# +# gdb --command vexriscv_gdb.cfg +# + +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +# Assume "print_a" is running on the CPU +file "target/riscv32imc-unknown-none-elf/debug/print_b" + +# Work around issues where simulation is too slow to respond to keep-alive messages, +# confusing either OpenOCD or GDB. Note that it will still complain about "missed" +# deadlines, but it won't fail.. +set remotetimeout unlimited + +# Connect to OpenOCD +target extended-remote :3334 + +# List registers +i r + +# break on main function entrance +break main + +# Jump to start address, should run until it hits main +jump _start + +# Run until we hit function "done", meaning it should have printed "a" +disable 1 +break print_b::done +continue +disable 2 + +# Load program +file "target/riscv32imc-unknown-none-elf/debug/print_a" +load + +# Jump to start address. Should now output "b". +break print_a::done +jump _start + +# Stop running GDB +quit diff --git a/clash-vexriscv-sim/data/vexriscv_chain_sim.cfg b/clash-vexriscv-sim/data/vexriscv_chain_sim.cfg new file mode 100644 index 0000000..102e49a --- /dev/null +++ b/clash-vexriscv-sim/data/vexriscv_chain_sim.cfg @@ -0,0 +1,47 @@ +# Execute using: +# +# openocd-vexriscv -f vexriscv_sim_chain.cfg +# + +# SPDX-FileCopyrightText: 2024 Google LLC +# +# SPDX-License-Identifier: CC0-1.0 + +# See vexriscv_sim.cfg for more information on each step taken. + +adapter driver jtag_tcp +adapter speed 64000 +transport select jtag + + +set _ENDIAN little +set _TAP_TYPE 1234 + +if { [info exists CPUTAPID] } { + set _CPUTAPID $CPUTAPID +} else { + set _CPUTAPID 0x10001fff +} + +set _CHIPNAME vexrisc_ocd + +jtag newtap $_CHIPNAME chain0 -expected-id $_CPUTAPID -irlen 4 -ircapture 0x1 -irmask 0x0F +jtag newtap $_CHIPNAME chain1 -expected-id $_CPUTAPID -irlen 4 -ircapture 0x1 -irmask 0x03 + +target create $_CHIPNAME.cpu0 vexriscv -endian $_ENDIAN -chain-position $_CHIPNAME.chain1 +vexriscv readWaitCycles 10 +vexriscv cpuConfigFile clash-vexriscv/example-cpu/ExampleCpu.yaml + +target create $_CHIPNAME.cpu1 vexriscv -endian $_ENDIAN -chain-position $_CHIPNAME.chain0 +vexriscv readWaitCycles 10 +vexriscv cpuConfigFile clash-vexriscv/example-cpu/ExampleCpu.yaml + +poll_period 50 + +init + +echo "Halting processor" + +halt + +sleep 1000 diff --git a/clash-vexriscv-sim/src/Utils/FilePath.hs b/clash-vexriscv-sim/src/Utils/FilePath.hs new file mode 100644 index 0000000..3a4c6e4 --- /dev/null +++ b/clash-vexriscv-sim/src/Utils/FilePath.hs @@ -0,0 +1,38 @@ +-- SPDX-FileCopyrightText: 2022-2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 + +module Utils.FilePath where + +import Prelude + +import System.Directory (getCurrentDirectory, doesFileExist) +import System.FilePath (isDrive, takeDirectory, ()) +import Control.Exception (throwIO) + +buildDir :: FilePath -> FilePath +buildDir baseDir = baseDir "target" + +cabalProject :: String +cabalProject = "cabal.project" + +data BuildType = Debug | Release deriving (Eq) + +instance Show BuildType where + show buildType = case buildType of + Release -> "release" + Debug -> "debug" + +rustBinsDir :: FilePath -> String -> BuildType -> FilePath +rustBinsDir baseDir rsTargetArch buildType = buildDir baseDir rsTargetArch show buildType + +findParentContaining :: String -> IO FilePath +findParentContaining filename = getCurrentDirectory >>= findParentContaining' + where + findParentContaining' dir + | isDrive dir = throwIO $ userError $ "Could not find " <> filename + | otherwise = do + exists <- doesFileExist (dir filename) + if exists + then return dir + else findParentContaining' $ takeDirectory dir diff --git a/clash-vexriscv-sim/tests/Tests/JtagChain.hs b/clash-vexriscv-sim/tests/Tests/JtagChain.hs new file mode 100644 index 0000000..a972b27 --- /dev/null +++ b/clash-vexriscv-sim/tests/Tests/JtagChain.hs @@ -0,0 +1,173 @@ +-- SPDX-FileCopyrightText: 2022-2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 + +module Tests.JtagChain where + +import Prelude + +import Test.Tasty.HUnit (Assertion, testCase, (@=?)) +import Tests.Jtag (cabalListBin, getGdb, JtagDebug (JtagDebug)) +import Utils.FilePath (findParentContaining, cabalProject, rustBinsDir, BuildType (Debug)) +import System.FilePath (()) +import System.Process +import Test.Tasty (TestTree, askOption, testGroup, defaultMainWithIngredients, includingOptions, defaultIngredients) +import Data.Data (Proxy (Proxy)) +import Test.Tasty.Options (OptionDescription(Option)) +import Control.Exception (ErrorCall (ErrorCallWithLocation)) + +import qualified Streaming.Prelude as SP +import System.IO (openFile, IOMode (ReadMode, WriteMode), hClose) +import GHC.Exception (throw, Exception (toException)) +import Data.Maybe (fromJust) +import System.Directory (doesPathExist, doesDirectoryExist) +import System.Exit (ExitCode(ExitSuccess)) +import Control.Monad (when) + +getSimulateExecPath :: IO FilePath +getSimulateExecPath = cabalListBin "clash-vexriscv-sim:clash-vexriscv-chain-bin" + +getProjectRoot :: IO FilePath +getProjectRoot = findParentContaining cabalProject + +test :: + -- | Print debug output of subprocesses + Bool -> + Assertion +test debug = do + simulateExecPath <- getSimulateExecPath + projectRoot <- getProjectRoot + let + rBD = rustBinsDir projectRoot "riscv32imc-unknown-none-elf" Debug + printAElfPath = rBD "print_a" + logAPath = projectRoot "cpu_a.log" + printBElfPath = rBD "print_b" + logBPath = projectRoot "cpu_b.log" + simDataDir = projectRoot "clash-vexriscv-sim" "data" + openocdCfgPath = simDataDir "vexriscv_chain_sim.cfg" + gdbCmdPathA = simDataDir "vexriscv_chain_gdba.cfg" + gdbCmdPathB = simDataDir "vexriscv_chain_gdbb.cfg" + gdb <- getGdb + + ensureExists logAPath 46 + ensureExists logBPath 47 + + let + vexRiscvProc = + ( proc + simulateExecPath + ["-a", printAElfPath, "-b", printBElfPath, "-A", logAPath, "-B", logBPath] + ) + { std_out = CreatePipe + , cwd = Just projectRoot + } + + openOcdProc = (proc "openocd-vexriscv" ["-f", openocdCfgPath]) + { std_err = CreatePipe + , cwd = Just projectRoot + } + + gdbProcA = (proc gdb ["--command", gdbCmdPathA]) + { std_out = CreatePipe + , cwd = Just projectRoot + } + + gdbProcB = (proc gdb ["--command", gdbCmdPathB]) + { std_out = CreatePipe + , cwd = Just projectRoot + } + + withCreateProcess vexRiscvProc $ \_ _ _ _ -> do + logAHandle <- openFile logAPath ReadMode + logBHandle <- openFile logBPath ReadMode + let + logA0 = SP.fromHandle logAHandle + logB0 = SP.fromHandle logBHandle + + logA1 <- expectLineFromStream debug logA0 "[CPU] a" 83 + logB1 <- expectLineFromStream debug logB0 "[CPU] b" 84 + + withCreateProcess openOcdProc $ \_ _ (fromJust -> openOcdStdErr) _ -> do + let openOcdStream = SP.fromHandle openOcdStdErr + _ <- waitForLineInStream debug openOcdStream "Halting processor" 88 + + withCreateProcess gdbProcA $ \_ _ _ gdbProcHandleA -> do + withCreateProcess gdbProcB $ \_ _ _ gdbProcHandleB -> do + _ <- expectLineFromStream debug logA1 "[CPU] a" 92 + _ <- expectLineFromStream debug logB1 "[CPU] b" 93 + _ <- expectLineFromStream debug logA1 "[CPU] b" 94 + _ <- expectLineFromStream debug logB1 "[CPU] a" 95 + + gdbAExitCode <- waitForProcess gdbProcHandleA + gdbBExitCode <- waitForProcess gdbProcHandleB + ExitSuccess @=? gdbAExitCode + ExitSuccess @=? gdbBExitCode + +ensureExists :: FilePath -> Int -> IO () +ensureExists file line = do + pathExists <- doesPathExist file + if not pathExists + then touchFile + else do + pathIsDir <- doesDirectoryExist file + if pathIsDir + then throw . toException + $ ErrorCallWithLocation + ("log file path `" <> file <> "` points to existing directory") + ("at line " <> show line) + else touchFile + where + touchFile = do + file' <- openFile file WriteMode + hClose file' + +expectLineFromStream + :: Bool + -> SP.Stream (SP.Of String) IO () + -> String + -> Int + -> IO (SP.Stream (SP.Of String) IO ()) +expectLineFromStream debug stream lookFor line = do + result <- SP.next stream + case result of + Right (out, next) -> do + when debug $ putStrLn $ "DBG(E): " <> out + if out == lookFor + then return next + else throw . toException $ errorHelper lookFor out line + Left _ -> expectLineFromStream debug stream lookFor line + +waitForLineInStream + :: Bool + -> SP.Stream (SP.Of String) IO () + -> String + -> Int + -> IO (SP.Stream (SP.Of String) IO ()) +waitForLineInStream debug stream lookFor line = do + result <- SP.next stream + case result of + Right (out, next) -> do + when debug $ putStrLn $ "DBG(W): " <> out + if out == lookFor + then return next + else waitForLineInStream debug next lookFor line + Left _ -> expectLineFromStream debug stream lookFor line + +errorHelper :: String -> String -> Int -> ErrorCall +errorHelper expected found loc = + ErrorCallWithLocation + ("expected `" <> expected <> "`, found `" <> found <> "`") + ("at line " <> show loc) + +tests :: TestTree +tests = askOption $ \(JtagDebug debug) -> + testGroup + "JTAG chaining" + [ testCase "Basic GDB commands, breakpoints, and program loading" (test debug) + ] + +main :: IO () +main = + defaultMainWithIngredients + (includingOptions [Option (Proxy :: Proxy JtagDebug)] : defaultIngredients) + tests diff --git a/clash-vexriscv-sim/tests/tests.hs b/clash-vexriscv-sim/tests/tests.hs index bff5170..5510469 100644 --- a/clash-vexriscv-sim/tests/tests.hs +++ b/clash-vexriscv-sim/tests/tests.hs @@ -27,6 +27,7 @@ import Utils.ProgramLoad (loadProgramDmem) import Utils.Cpu (cpu) import qualified Tests.Jtag +import qualified Tests.JtagChain runProgramExpect :: -- | action to copy ELF file @@ -135,6 +136,7 @@ main = do [ testGroup "Debug builds" debugTestCases , testGroup "Release builds" releaseTestCases , Tests.Jtag.tests + , Tests.JtagChain.tests ] defaultMainWithIngredients