add JTAG support to the core

.gitignore

@@ -65,3 +65,6 @@ log
 vivado_*
 tight_setup_hold_pins.txt
 .Xil
+
+# Verilator debug output
+simulation_dump.vcd

Cargo.toml

@@ -13,5 +13,6 @@ opt-level = "z"
 [workspace]
 members = [
   "clash-vexriscv-sim/test-programs",
+  "debug-test",
 ]
 resolver = "2"

cabal.project

@@ -7,7 +7,6 @@ packages:
   clash-vexriscv-sim/
 
 write-ghc-environment-files: always
-
 tests: True
 
 

clash-vexriscv-sim/app/ElfToHex.hs

@@ -0,0 +1,88 @@
+-- | Convert an ELF file to a set of @.mem@ files, suitable for use with
+-- Verilog simulators. Use in combination with @readmemh@ in Verilog.
+module Main where
+
+import Prelude
+
+import Control.Concurrent.Async (mapConcurrently_)
+import Control.Monad (forM_)
+import Data.IntMap (IntMap, findWithDefault)
+import Data.Tuple.Extra (uncurry3)
+import System.Environment (getArgs)
+import System.Exit (die)
+import System.IO (withFile, IOMode(WriteMode), hPutStrLn)
+import Text.Printf (printf)
+import Text.Read (readMaybe)
+import Utils.ReadElf (readElfFromMemory)
+
+import qualified Data.ByteString as BS
+import qualified Clash.Prelude as C
+
+iMEM_START :: Int
+iMEM_START = 0x20000000
+
+dMEM_START :: Int
+dMEM_START = 0x40000000
+
+-- | Like 'zipWithM_', but execute concurrently
+zipWithConcurrently_ :: (a -> b -> IO ()) -> [a] -> [b] -> IO ()
+zipWithConcurrently_ f xs ys = mapConcurrently_ (uncurry f) (zip xs ys)
+
+-- | Like 'zipWith3M_', but execute concurrently
+zipWith3Concurrently_ :: (a -> b -> c -> IO ()) -> [a] -> [b] -> [c] -> IO ()
+zipWith3Concurrently_ f xs ys zs = mapConcurrently_ (uncurry3 f) (zip3 xs ys zs)
+
+-- | Convenience function to get data from a memory map. If a memory address is
+-- not found, return 0.
+getData :: Num a => IntMap a -> Int -> a
+getData mem addr = findWithDefault 0 addr mem
+
+-- | Generate the addresses for the four memory banks, given the total size in
+-- bytes, and the start address.
+getAddrs :: Int -> Int -> ([Int], [Int], [Int], [Int])
+getAddrs size start =
+  ( [start + 0, start + 4 .. start + size - 1]
+  , [start + 1, start + 5 .. start + size - 1]
+  , [start + 2, start + 6 .. start + size - 1]
+  , [start + 3, start + 7 .. start + size - 1] )
+
+-- | Write a single @.mem@ file
+writeByteMem :: IntMap (C.BitVector 8) -> FilePath -> [Int] -> IO ()
+writeByteMem mem path addrs = do
+  putStrLn $ "Writing " <> path
+  withFile path WriteMode $ \h ->
+    forM_ addrs $ \addr -> do
+      hPutStrLn h (toHex (getData mem addr))
+
+-- | Write four @.mem@ files
+writeMem :: Int -> IntMap (C.BitVector 8) -> FilePath -> Int -> IO ()
+writeMem size mem prefix start = do
+  let (addrs0, addrs1, addrs2, addrs3) = getAddrs size start
+
+  zipWithConcurrently_
+    (writeByteMem mem)
+    [prefix <> show n <> ".mem" | n <- [(0::Int)..]]
+    [addrs0, addrs1, addrs2, addrs3]
+
+-- | Print a byte as a hex string of the form 0x00.
+toHex :: C.BitVector 8 -> String
+toHex = printf "0x%02x" . toInteger
+
+main :: IO ()
+main = do
+  let usage = "Usage: elf-to-hex <size> <elf-file>"
+
+  (sizeStr, elfFile) <- getArgs >>= \case
+    [sizeStr, elfFile] -> pure (sizeStr, elfFile)
+    args -> die $ usage <> "\n\n" <> "Expected 2 arguments, but got " <> show (length args)
+
+  size <- case readMaybe @Int sizeStr of
+    Just x -> pure x
+    Nothing -> die $ usage <> "\n\n" <> "<size> must be an integer, but got: " <> sizeStr
+  (_addr, iMem, dMem) <- readElfFromMemory <$> BS.readFile elfFile
+
+  zipWith3Concurrently_
+    (writeMem size)
+    [iMem, dMem]
+    ["imem", "dmem"]
+    [iMEM_START, dMEM_START]

clash-vexriscv-sim/app/HdlTest.hs

@@ -10,10 +10,13 @@ import VexRiscv
 circuit ::
   "CLK" ::: Clock System ->
   "RST" ::: Reset System ->
-  "INPUT" ::: Signal System Input ->
-  "OUTPUT" ::: Signal System Output
-circuit clk rst input =
-  withClockResetEnable clk rst enableGen vexRiscv input
+  "CPU_COMB_INPUT" ::: Signal System CpuIn ->
+  "JTAG_IN_" ::: Signal System JtagIn ->
+  "" :::
+    ( "CPU_OUTPUT" ::: Signal System CpuOut
+    , "JTAG_OUT_" ::: Signal System JtagOut)
+circuit clk rst input jtagIn =
+  vexRiscv clk rst input jtagIn
 
 makeTopEntity 'circuit
 

clash-vexriscv-sim/app/VexRiscvSimulation.hs

@@ -5,23 +5,26 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE GADTs #-}
 
+{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}
+
 import Clash.Prelude
 
 import Protocols.Wishbone
-import VexRiscv (Output(iBusWbM2S, dBusWbM2S))
+import VexRiscv (CpuOut(iBusWbM2S, dBusWbM2S))
 
 import qualified Data.List as L
 
 import Control.Monad (forM_, when)
 import Data.Char (chr)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import System.Environment (getArgs)
 import System.IO (putChar, hFlush, stdout)
 import Text.Printf (printf)
 
 
 import Utils.ProgramLoad (loadProgram)
 import Utils.Cpu (cpu)
+import System.Exit (exitFailure)
 
 --------------------------------------
 --
@@ -59,9 +62,9 @@ debugConfig =
 --
 {-
   InspectBusses
-    50
     0
-    (Just 300)
+    0
+    (Just 100)
     True
     True
 -- -}
@@ -77,37 +80,58 @@ main = do
     withClockResetEnable @System clockGen resetGen enableGen $
       loadProgram @System elfFile
 
-  let cpuOut@(unbundle -> (_circuit, writes, iBus, dBus)) =
+  let cpuOut@(unbundle -> (_circuit, writes, _iBus, _dBus)) =
         withClockResetEnable @System clockGen (resetGenN (SNat @2)) enableGen $
-          bundle (cpu iMem dMem)
+          let (circ, writes1, iBus, dBus) = cpu (Just 7894) iMem dMem
+              dBus' = register Nothing dBus
+          in bundle (circ, writes1, iBus, dBus')
 
   case debugConfig of
     RunCharacterDevice ->
-      forM_ (sample_lazy @System (bundle (dBus, iBus, writes))) $ \(dS2M, iS2M, write) -> do
-        when (err dS2M) $
-          putStrLn "D-bus ERR reply"
+      forM_ (sample_lazy @System (bundle (register @System (unpack 0) cpuOut, cpuOut))) $
+        \((_out, write, dS2M0, iS2M0), (out1, _write, _dS2M, _iS2M)) -> do
+        let
+          iS2M = fromMaybe emptyWishboneS2M iS2M0
+          dS2M = fromMaybe emptyWishboneS2M dS2M0
+
+        when (err dS2M) $ do
+          let dBusM2S = dBusWbM2S out1
+          let dAddr = toInteger (addr dBusM2S) -- `shiftL` 2
+          -- printf "D-bus ERR reply % 8X (% 8X)\n" (toInteger $ dAddr `shiftL` 2) (toInteger dAddr)
+          -- exitFailure
+          pure ()
+
+        when (err iS2M) $ do
+          let iBusM2S = iBusWbM2S out1
+          let iAddr = toInteger (addr iBusM2S) -- `shiftL` 2
+          -- printf "I-bus ERR reply % 8X (% 8X)\n" (toInteger $ iAddr `shiftL` 2) (toInteger iAddr)
+          -- printf "%s\n" (showX iBusM2S)
+          -- exitFailure
+          pure ()
 
-        when (err iS2M) $
-          putStrLn "I-bus ERR reply"
-
         case write of
           Just (address, value) | address == 0x0000_1000 -> do
             let (_ :: BitVector 24, b :: BitVector 8) = unpack value
             putChar $ chr (fromEnum b)
             hFlush stdout
+            pure ()
           _ -> pure ()
       -- performPrintsToStdout 0x0000_1000 (sample_lazy $ bitCoerce <$> writes)
     InspectBusses initCycles uninteresting interesting iEnabled dEnabled -> do
-      
+
       let skipTotal = initCycles + uninteresting
 
       let sampled = case interesting of
             Nothing -> L.zip [0 ..] $ sample_lazy @System cpuOut
             Just nInteresting ->
-              let total = initCycles + uninteresting + nInteresting in L.zip [0 ..] $ L.take total $ sample_lazy @System cpuOut
+              let total = initCycles + uninteresting + nInteresting in
+              L.zip [0 ..] $ L.take total $ sample_lazy @System cpuOut
 
-      forM_ sampled $ \(i, (out, _, iBusS2M, dBusS2M)) -> do
-        let doPrint = i >= skipTotal
+      forM_ sampled $ \(i, (out, _, iBusS2M0, dBusS2M0)) -> do
+        let
+          iBusS2M = fromMaybe emptyWishboneS2M iBusS2M0
+          dBusS2M = fromMaybe emptyWishboneS2M dBusS2M0
+          doPrint = i >= skipTotal
 
         -- I-bus interactions
 
@@ -143,6 +167,9 @@ main = do
               <> ")"
           putStrLn $ "            - iS2M: " <> iResp <> " - " <> iRespData
 
+        when (err iBusS2M)
+          exitFailure
+
         -- D-bus interactions
 
         when (doPrint && dEnabled) $ do
@@ -192,6 +219,9 @@ main = do
                 <> writeDat
                 <> "> - "
             putStrLn $ "dS2M: " <> dResp <> dRespData
+
+        when (err dBusS2M)
+          exitFailure
     InspectWrites ->
       forM_ (catMaybes $ sample_lazy @System writes) $ \(address, value) -> do
         printf "W: % 8X <- % 8X\n" (toInteger address) (toInteger value)

clash-vexriscv-sim/clash-vexriscv-sim.cabal

@@ -100,6 +100,19 @@ executable hdl-test
     clash-vexriscv,
     clash-vexriscv-sim,
 
+executable elf-to-hex
+  import: common-options
+  main-is: ElfToHex.hs
+  hs-source-dirs: app
+  default-language: Haskell2010
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+    async,
+    base,
+    bytestring,
+    clash-vexriscv-sim,
+    extra,
+
 executable clash-vexriscv-bin
   import: common-options
   main-is: VexRiscvSimulation.hs

clash-vexriscv-sim/src/Utils/Cpu.hs

@@ -5,19 +5,25 @@
 {-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RecordWildCards #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Utils.Cpu where
 
 import Clash.Prelude
 
 import Protocols.Wishbone
 import VexRiscv
+import VexRiscv.JtagTcpBridge as JTag
 import VexRiscv.VecToTuple (vecToTuple)
 
 import GHC.Stack (HasCallStack)
 
 import Utils.ProgramLoad (Memory)
 import Utils.Interconnect (interconnectTwo)
 
+createDomain vXilinxSystem{vName="Basic50", vPeriod= hzToPeriod 50_000_000}
+
 {-
 Address space
 
@@ -27,37 +33,54 @@ Address space
 -}
 cpu ::
   (HasCallStack, HiddenClockResetEnable dom) =>
+  Maybe Integer ->
   Memory dom ->
   Memory dom ->
-  ( Signal dom Output,
+  ( Signal dom CpuOut,
     -- writes
     Signal dom (Maybe (BitVector 32, BitVector 32)),
     -- iBus responses
-    Signal dom (WishboneS2M (BitVector 32)),
+    Signal dom (Maybe (WishboneS2M (BitVector 32))),
     -- dBus responses
-    Signal dom (WishboneS2M (BitVector 32))
+    Signal dom (Maybe (WishboneS2M (BitVector 32)))
+  )
+cpu jtagPort bootIMem bootDMem =
+  ( output
+  , writes
+  , mux validI (Just <$> iS2M) (pure Nothing)
+  , mux validD (Just <$> dS2M) (pure Nothing)
   )
-cpu bootIMem bootDMem = (output, writes, iS2M, dS2M)
   where
-    output = vexRiscv input
+    (output, jtagOut) = vexRiscv hasClock hasReset input jtagIn
+
+    jtagIn = case jtagPort of
+      Just port -> vexrJtagBridge (fromInteger port) jtagOut
+      Nothing -> pure JTag.defaultIn
+    -- (unbundle -> (jtagIn', _debugReset)) = unsafePerformIO $ jtagTcpBridge' 7894 hasReset (jtagOut <$> output)
+
     dM2S = dBusWbM2S <$> output
+    validD = fmap busCycle dM2S .&&. fmap strobe dM2S
 
     iM2S = unBusAddr . iBusWbM2S <$> output
+    validI = fmap busCycle iM2S .&&. fmap strobe iM2S
 
-    iS2M = bootIMem (mapAddr (\x -> x - 0x2000_0000) <$> iM2S)
+    iS2M = bootIMem (mapAddr (\x -> -- trace (printf "I-addr = % 8X (% 8X)\n" (toInteger $ x - 0x2000_0000) (toInteger x))
+                      x - 0x2000_0000) <$> iM2S)
 
     dummy = dummyWb
 
     dummyS2M = dummy dummyM2S
     bootDS2M = bootDMem bootDM2S
 
     (dS2M, vecToTuple . unbundle -> (dummyM2S, bootDM2S)) = interconnectTwo
-      (unBusAddr <$> dM2S)
+      ((\x ->
+          -- trace (printf "DBUS %08X" (toInteger (addr x)))
+          x) <$> (unBusAddr <$> dM2S))
       ((0x0000_0000, dummyS2M) :> (0x4000_0000, bootDS2M) :> Nil)
 
     input =
       ( \iBus dBus ->
-          Input
+          CpuIn
             { timerInterrupt = low,
               externalInterrupt = low,
               softwareInterrupt = low,