add pre-processing and monitor function

.github/synthesis/debug.json

@@ -0,0 +1,10 @@
+[
+  {
+    "top": "vexRiscvTest",
+    "stage": "test"
+  },
+  {
+    "top": "dnaOverSerial",
+    "stage": "test"
+  }
+]

bittide-experiments/bittide-experiments.cabal

@@ -106,6 +106,7 @@ library
     text,
     typelits-witnesses,
     vector,
+    vivado-hs,
 
   exposed-modules:
     Bittide.Github.Artifacts

bittide-experiments/src/Bittide/Hitl.hs

@@ -41,16 +41,20 @@ Tests are collected in @Bittide.Instances.Hitl.Tests@.
 module Bittide.Hitl (
   ClashTargetName,
   FpgaId,
+  DeviceInfo (..),
   HwTargetRef (..),
 
   -- * Test definition
   HitlTestGroup (..),
   HitlTestCase (..),
+  CasePreProcessing (..),
+  TestStepResult (..),
   MayHavePostProcData (..),
   Done,
   Success,
   hitlVio,
   hitlVioBool,
+  noPreProcess,
 
   -- * Test construction convenience functions
   paramForHwTargets,
@@ -62,7 +66,13 @@ where
 
 import Prelude
 
-import Clash.Prelude (BitPack (BitSize), KnownDomain, Vec (Nil, (:>)), natToInteger)
+import Clash.Prelude (
+  BitPack (BitSize),
+  BitVector,
+  KnownDomain,
+  Vec (Nil, (:>)),
+  natToInteger,
+ )
 
 import Clash.Cores.Xilinx.VIO (vioProbe)
 
@@ -76,6 +86,11 @@ import Numeric.Natural (Natural)
 import Clash.Prelude qualified as P
 import Data.Map.Strict qualified as Map
 
+import System.Exit (ExitCode)
+
+import Vivado (VivadoHandle)
+import Vivado.Tcl (HwTarget)
+
 {- | Fully qualified name to a function that is the target for Clash
 compilation. E.g. @Bittide.Foo.topEntity@.
 -}
@@ -89,12 +104,25 @@ For example, the ID of hardware target
 -}
 type FpgaId = String
 
+data DeviceInfo = DeviceInfo
+  { deviceId :: String
+  , dna :: BitVector 96
+  , serial :: String
+  , usbAdapterLocation :: String
+  }
+  deriving (Eq, Ord, Show)
+
 {- | A reference to an FPGA hardware target, either by index/relative position
 in the Bittide demo rig or by ID.
 -}
 data HwTargetRef
   = HwTargetByIndex Natural
-  | HwTargetById FpgaId
+  | HwTargetById FpgaId DeviceInfo
+  deriving (Eq, Ord, Show)
+
+data TestStepResult a
+  = TestStepSuccess a
+  | TestStepFailure String
   deriving (Eq, Ord, Show)
 
 {- | A definition of a test that should be performed with hardware in the loop.
@@ -161,48 +189,67 @@ and requires a (hypothetical) 8-bit number indicating the
 >           , postProcData = ()
 >           }
 >       ]
+>   , mPreProc = Nothing
 >   , mPostProc = Nothing
 >   }
 
 This must be accompanied by a @hitlVio \@NumberOfStages@ in the design.
 -}
 data HitlTestGroup where
   HitlTestGroup ::
-    (Typeable a, Typeable b) =>
+    (Typeable a, Typeable b, Typeable c) =>
     { topEntity :: ClashTargetName
     -- ^ Reference to the Design Under Test
     , extraXdcFiles :: [String]
-    , testCases :: [HitlTestCase HwTargetRef a b]
+    , testCases :: [HitlTestCase HwTargetRef a b c]
     -- ^ List of test cases
-    , mPostProc :: Maybe String
-    -- ^ Optional post processing step. If present, the name of the executable
-    -- in the @bittide-instances@ package.
+    , mPreProc ::
+        ( VivadoHandle -> String -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult c)
+        )
+    -- ^ Pre-processing step. First argument is the name of the test
+    , mDriverProc ::
+        Maybe (VivadoHandle -> String -> FilePath -> [(HwTarget, DeviceInfo, c)] -> IO ExitCode)
+    -- ^ Optional function driving the test after pre-processing.
+    , mPostProc :: Maybe (FilePath -> ExitCode -> IO (TestStepResult ()))
+    -- ^ Optional post processing step.
     , externalHdl :: [String]
-    -- ^ List of external HDL files to include in the project
+    -- ^ List of external HDL files to include in he project
     } ->
     HitlTestGroup
 
 {- | A HITL test case. One HITL test group can have multiple test cases
 associated with it.
 -}
-data HitlTestCase h a b where
+data HitlTestCase h a b c where
   HitlTestCase ::
-    (Show h, Show a, BitPack a, Show b, Typeable h) =>
+    (Show h, Show a, BitPack a, Show b, Typeable h, Typeable c) =>
     { name :: String
     , parameters :: Map h a
+    , preProc :: CasePreProcessing c
     , postProcData :: b
     } ->
-    HitlTestCase h a b
+    HitlTestCase h a b c
 
-deriving instance Show (HitlTestCase h a b)
+deriving instance Show (HitlTestCase h a b c)
+
+data CasePreProcessing c
+  = InheritPreProcess
+  | -- | Instead of using the test-group pre-process function, use an override for
+    -- this specific test case.
+    CustomPreProcess
+      (VivadoHandle -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult c))
+
+instance Show (CasePreProcessing a) where
+  show InheritPreProcess = "InheritPreProcess"
+  show (CustomPreProcess _) = "CustomPreProcess <func>"
 
 -- | A class for extracting optional post processing data from a test.
 class MayHavePostProcData b where
   -- | Returns the test names with some post processing data of type @c@,
   -- if that data exists.
   mGetPPD ::
-    forall h a.
-    [HitlTestCase h a b] ->
+    forall h a c.
+    [HitlTestCase h a b c] ->
     Map String (Maybe b)
 
 instance MayHavePostProcData a where
@@ -213,6 +260,11 @@ instance MayHavePostProcData a where
 instance MayHavePostProcData () where
   mGetPPD = Map.fromList . map ((,Nothing) . name)
 
+-- | Pre-process function that always succeeds and uses '()' as user-data.
+noPreProcess ::
+  VivadoHandle -> String -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult ())
+noPreProcess _ _ _ _ _ = pure (TestStepSuccess ())
+
 -- | Obtain a list of the hardware targets that are relevant for a given HITL test.
 hwTargetRefsFromHitlTestGroup :: HitlTestGroup -> [HwTargetRef]
 hwTargetRefsFromHitlTestGroup HitlTestGroup{testCases} =
@@ -240,16 +292,26 @@ to it and receives that constructur as test parameter.
 > testCases = testCasesFromEnum @ABC allHwTargets ()
 -}
 testCasesFromEnum ::
-  forall a b.
-  (Show a, Bounded a, Enum a, BitPack a, Show b, Typeable a, Typeable b) =>
+  forall a b c.
+  ( Show a
+  , Bounded a
+  , Enum a
+  , BitPack a
+  , Show b
+  , Show c
+  , Typeable a
+  , Typeable b
+  , Typeable c
+  ) =>
   [HwTargetRef] ->
   b ->
-  [HitlTestCase HwTargetRef a b]
+  [HitlTestCase HwTargetRef a b c]
 testCasesFromEnum hwTs ppd =
   [ HitlTestCase
     { name = show constr
     , parameters = Map.fromList ((,constr) <$> hwTs)
     , postProcData = ppd
+    , preProc = InheritPreProcess
     }
   | (constr :: a) <- [minBound ..]
   ]

bittide-instances/bittide-instances.cabal

@@ -76,6 +76,7 @@ common common-options
 
   default-language: Haskell2010
   build-depends:
+    Glob,
     MissingH,
     aeson,
     async,
@@ -94,6 +95,7 @@ common common-options
     constraints >=0.13.3 && <0.15,
     containers,
     cryptohash-sha256,
+    deepseq,
     directory,
     extra,
     filepath,
@@ -118,6 +120,7 @@ common common-options
     time,
     unix,
     vector,
+    vivado-hs,
 
 library
   import: common-options
@@ -127,6 +130,9 @@ library
     Bittide.Instances.Hacks
     Bittide.Instances.Hitl.BoardTest
     Bittide.Instances.Hitl.DnaOverSerial
+    Bittide.Instances.Hitl.Driver.DnaOverSerial
+    Bittide.Instances.Hitl.Driver.VexRiscv
+    Bittide.Instances.Hitl.Driver.VexRiscvTcp
     Bittide.Instances.Hitl.Ethernet
     Bittide.Instances.Hitl.FincFdec
     Bittide.Instances.Hitl.FullMeshHwCc
@@ -135,13 +141,16 @@ library
     Bittide.Instances.Hitl.IlaPlot
     Bittide.Instances.Hitl.LinkConfiguration
     Bittide.Instances.Hitl.Post.BoardTestExtended
+    Bittide.Instances.Hitl.Post.FullMeshSwCc
     Bittide.Instances.Hitl.Post.PostProcess
-    Bittide.Instances.Hitl.Post.TcpServer
     Bittide.Instances.Hitl.Setup
     Bittide.Instances.Hitl.SyncInSyncOut
     Bittide.Instances.Hitl.TemperatureMonitor
     Bittide.Instances.Hitl.Tests
     Bittide.Instances.Hitl.Transceivers
+    Bittide.Instances.Hitl.Utils.Gdb
+    Bittide.Instances.Hitl.Utils.Program
+    Bittide.Instances.Hitl.Utils.Vivado
     Bittide.Instances.Hitl.VexRiscv
     Bittide.Instances.Pnr.Calendar
     Bittide.Instances.Pnr.ClockControl
@@ -156,7 +165,6 @@ library
     Paths.Bittide.Instances
     Project.FilePath
     Project.Handle
-    Project.Programs
 
   other-modules:
     Paths_bittide_instances
@@ -223,88 +231,3 @@ executable clash
     bittide-instances,
     clash-ghc,
     vivado-hs,
-
-executable post-board-test-extended
-  import: common-options
-  ghc-options:
-    -Wall
-    -Wcompat
-    -threaded
-
-  main-is: exe/post-board-test-extended/Main.hs
-  build-depends:
-    Glob,
-    bittide-instances,
-    filepath,
-
-executable post-vex-riscv-test
-  import: common-options
-  ghc-options:
-    -Wall
-    -Wcompat
-    -threaded
-
-  main-is: exe/post-vex-riscv-test/Main.hs
-  build-depends:
-    bittide-instances,
-    extra,
-    process,
-    tasty,
-    tasty-hunit,
-    tasty-th,
-    temporary,
-
-  other-modules: Paths_bittide_instances
-
-executable post-vex-riscv-tcp-test
-  import: common-options
-  ghc-options:
-    -Wall
-    -Wcompat
-    -threaded
-
-  main-is: exe/post-vex-riscv-tcp-test/Main.hs
-  build-depends:
-    bittide-instances,
-    extra,
-    process,
-    tasty,
-    tasty-hunit,
-    tasty-th,
-    temporary,
-
-  other-modules: Paths_bittide_instances
-
-executable post-fullMeshSwCcTest
-  import: common-options
-  ghc-options:
-    -Wall
-    -Wcompat
-    -threaded
-
-  main-is: exe/post-fullMeshSwCcTest/Main.hs
-  build-depends:
-    base,
-    bittide-instances,
-    bytestring,
-    cassava,
-    deepseq,
-    filepath,
-    vector,
-
-executable post-dna-over-serial
-  import: common-options
-  ghc-options:
-    -Wall
-    -Wcompat
-    -threaded
-
-  main-is: exe/post-dna-over-serial/Main.hs
-  build-depends:
-    bittide-instances,
-    process,
-    tasty,
-    tasty-hunit,
-    tasty-th,
-
-  other-modules: Paths_bittide_instances

bittide-instances/data/openocd/ports.tcl

@@ -1,7 +1,13 @@
 # SPDX-FileCopyrightText: 2024 Google LLC
 #
 # SPDX-License-Identifier: Apache-2.0
+
+set user_gdb_port [env GDB_PORT]
+if { $user_gdb_port == "" } {
+  error "Required environment variable 'GDB_PORT' is not set."
+}
+
 bindto 0.0.0.0
-gdb_port 3333
+gdb_port $user_gdb_port
 tcl_port 6666
 telnet_port 4444