Parse UGNs, print IGNs, and some cleanup.

bittide-instances/src/Bittide/Instances/Hitl/Driver/Demo.hs

@@ -6,19 +6,23 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-module Bittide.Instances.Hitl.Driver.Demo where
+module Bittide.Instances.Hitl.Driver.Demo (
+  OcdInitData (..),
+  driverFunc,
+) where
 
 import Clash.Prelude
 
 import Bittide.Hitl
-import Bittide.Instances.Hitl.Setup (demoRigInfo)
+import Bittide.Instances.Hitl.Setup (demoRigInfo, fpgaSetup)
 import Bittide.Instances.Hitl.Utils.Program
 import Bittide.Instances.Hitl.Utils.Vivado
 
+import Clash.Functor.Extra ((<<$>>))
 import Control.Monad (forM_, zipWithM)
 import Control.Monad.IO.Class
 import Data.List.Extra (trim)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromJust, fromMaybe)
 import Data.String.Interpolate (i)
 import Project.FilePath
 import Project.Handle
@@ -34,12 +38,6 @@ import qualified Control.Monad.Trans.Control as CMTC
 import qualified Data.List as L
 import qualified System.Timeout.Lifted as STL
 
--- connect EBs over WB
--- read/write regs with MU, ensure that correct values show up
--- check over GDB too
--- no input data
--- just one test case
-
 data OcdInitData = OcdInitData
   { muPort :: Int
   , ccPort :: Int
@@ -301,7 +299,7 @@ driverFunc testName targets = do
       inner innerInit
 
     muGetUgns ::
-      (HwTarget, DeviceInfo) -> ProcessStdIoHandles -> VivadoM [(Unsigned 64, Unsigned 64)]
+      (HwTarget, DeviceInfo) -> ProcessStdIoHandles -> VivadoM [(Integer, Integer)]
     muGetUgns (_, d) gdb = do
       let
         mmioAddrs :: [String]
@@ -315,7 +313,7 @@ driverFunc testName targets = do
           , "0x70000000"
           ]
 
-        readUgnMmio :: String -> IO (Unsigned 64, Unsigned 64)
+        readUgnMmio :: String -> IO (Integer, Integer)
         readUgnMmio addr = do
           let
             startString = "START OF UGN (" <> addr <> ")"
@@ -331,9 +329,14 @@ driverFunc testName targets = do
               $ readUntil gdb.stdoutHandle startString
           gdbRead <-
             tryWithTimeout "Reading UGN over GDB" 15_000_000 $ readUntil gdb.stdoutHandle endString
-          -- Temporary debug print of this so I can get a proper parsing setup going later:
+          let
+            outputLine = L.head $ L.lines $ trim gdbRead
+            outputDataWords = L.words $ trim $ outputLine
           putStrLn $ "GDB output: {{\n" <> gdbRead <> "}}"
-          return (0, 0)
+          case L.drop (L.length outputDataWords - 2) outputDataWords of
+            [read -> txIJ, read -> rxIJ] -> return (txIJ, rxIJ)
+            other ->
+              fail $ "Could not read output data. Line: '" <> outputLine <> "', data: " <> show other
 
       liftIO $ putStrLn $ "Getting UGNs for device " <> show d.deviceId
       liftIO $ mapM readUgnMmio mmioAddrs
@@ -384,11 +387,51 @@ driverFunc testName targets = do
               $ putStrLn
                 [i|Test case #{testName} stabilised on #{sCount} of #{L.length targets} targets|]
 
-            liftIO $ putStrLn "Doing GDB checks for each MU"
-            _ <- zipWithM muGetUgns targets muGdbs
+            liftIO $ putStrLn "Getting "
+            ugnPairsTable <- zipWithM muGetUgns targets muGdbs
+            liftIO $ printAllIgns ugnPairsTable fpgaSetup
 
             let
               finalExit =
                 fromMaybe ExitSuccess
                   $ L.find (/= ExitSuccess) [stabilityExitCode, gdbExitCode0, gdbExitCode1]
             return finalExit
+
+printAllIgns ::
+  forall m n.
+  (KnownNat m, KnownNat n) =>
+  [[(Integer, Integer)]] ->
+  Vec n (FpgaId, Vec m (Index n)) ->
+  IO ()
+printAllIgns ugnPairsTable fpgasTable = do
+  let
+    ugnsTable :: [[Integer]]
+    ugnsTable = uncurry (-) <<$>> ugnPairsTable
+    fpgasMap :: Vec n (Vec m (Index n))
+    fpgasMap = snd <$> fpgasTable
+    indicesM :: Vec m (Index n)
+    indicesM = generateI (+ 1) 0
+    indicesN :: Vec n (Index m)
+    indicesN = generateI (+ 1) 0
+    printIgns :: Index m -> (FpgaId, Vec m (Index n)) -> IO ()
+    printIgns rowI (myId, row) = do
+      let
+        rowIN :: Index n
+        rowIN = fromIntegral rowI
+        printIgn :: Index n -> Index n -> IO Integer
+        printIgn colI otherRowI = do
+          let
+            otherRow :: Vec m (Index n)
+            otherRow = fpgasMap !! otherRowI
+            myIndex :: Index m
+            myIndex = fromJust $ findIndex (== rowIN) otherRow
+            myUgn = ugnsTable L.!! (fromIntegral rowI) L.!! (fromIntegral colI)
+            otherUgn = ugnsTable L.!! (fromIntegral otherRowI) L.!! (fromIntegral myIndex)
+            ign = myUgn + otherUgn
+          return ign
+      igns <- sequence $ zipWith printIgn indicesM row
+      putStrLn $ "IGNs for FPGA " <> myId <> " (" <> show rowI <> "): " <> show igns
+      return ()
+
+  _ <- sequence $ zipWith printIgns indicesN fpgasTable
+  return ()