From 0c1035d5579b6a4a6c2633965776002eaa7a44bb Mon Sep 17 00:00:00 2001 From: Just van Westerveld Date: Thu, 22 Aug 2024 16:20:46 +0200 Subject: [PATCH] Move HITL test control logic from Tcl to Haskell This enables more fine-grained control of HITL test control execution from Haskell code. It: * Moves test control logic from `bittide-shake/data/tcl/HardwareTest.tcl` to `bittide-shake/src/Clash/Shake/Vivado.hs`. Instead of letting Vivado execute Tcl files, it is now controlled by attaching to stdin and stdout of Vivado in Tcl mode through the new vivado-hs package. * Test definitions are no longer stored in JSON files, but using the new HitlTest type. --- .github/synthesis/all.json | 26 +- .github/synthesis/staging.json | 11 +- .github/workflows/ci.yml | 4 +- bittide-experiments/bittide-experiments.cabal | 1 + bittide-experiments/src/Bittide/Hitl.hs | 505 ++++------ bittide-instances/README.md | 2 +- bittide-instances/bittide-instances.cabal | 2 +- .../exe/post-board-test-extended/Main.hs | 6 +- .../src/Bittide/Instances/Hitl/BoardTest.hs | 35 +- .../src/Bittide/Instances/Hitl/FincFdec.hs | 18 +- .../Bittide/Instances/Hitl/FullMeshHwCc.hs | 54 +- .../Bittide/Instances/Hitl/FullMeshSwCc.hs | 47 +- .../Bittide/Instances/Hitl/HwCcTopologies.hs | 149 +-- .../Instances/Hitl/LinkConfiguration.hs | 24 +- .../Instances/Hitl/Post/PostProcess.hs | 6 +- .../src/Bittide/Instances/Hitl/README.md | 49 +- .../src/Bittide/Instances/Hitl/Setup.hs | 22 +- .../Bittide/Instances/Hitl/SyncInSyncOut.hs | 20 +- .../Bittide/Instances/Hitl/Tcl/ExtraProbes.hs | 59 -- .../Instances/Hitl/TemperatureMonitor.hs | 25 +- .../src/Bittide/Instances/Hitl/Tests.hs | 66 +- .../Bittide/Instances/Hitl/Transceivers.hs | 35 +- .../src/Bittide/Instances/Hitl/VexRiscv.hs | 19 +- bittide-shake/README.md | 10 +- bittide-shake/bittide-shake.cabal | 6 + bittide-shake/data/tcl/HardwareTest.tcl | 809 ---------------- bittide-shake/exe/Main.hs | 273 ++---- bittide-shake/src/Clash/Shake/Extra.hs | 29 +- bittide-shake/src/Clash/Shake/Flags.hs | 46 +- bittide-shake/src/Clash/Shake/Vivado.hs | 892 +++++++++++++++--- bittide-tools/bittide-tools.cabal | 18 - bittide-tools/clockcontrol/plot/Main.hs | 171 ++-- bittide-tools/hitl/config-gen/Main.hs | 147 --- bittide/src/Bittide/Wishbone.hs | 8 +- nix/bin/shake | 13 +- vivado-hs/src/Vivado.hs | 34 + vivado-hs/src/Vivado/Internal.hs | 29 +- vivado-hs/src/Vivado/Tcl.hs | 346 +++++++ vivado-hs/vivado-hs.cabal | 3 + 39 files changed, 1908 insertions(+), 2111 deletions(-) delete mode 100644 bittide-instances/src/Bittide/Instances/Hitl/Tcl/ExtraProbes.hs delete mode 100644 bittide-shake/data/tcl/HardwareTest.tcl delete mode 100644 bittide-tools/hitl/config-gen/Main.hs create mode 100644 vivado-hs/src/Vivado/Tcl.hs diff --git a/.github/synthesis/all.json b/.github/synthesis/all.json index e50107b50..5c0b5514b 100644 --- a/.github/synthesis/all.json +++ b/.github/synthesis/all.json @@ -12,17 +12,17 @@ {"top": "switchCalendar1k", "stage": "hdl"}, {"top": "switchCalendar1kReducedPins", "stage": "pnr"}, - {"top": "boardTestExtended", "stage": "test", "targets": "All" }, - {"top": "boardTestSimple", "stage": "test", "targets": "All" }, - {"top": "extraProbesTest", "stage": "test", "targets": "Specific [0]" }, - {"top": "fincFdecTests", "stage": "test", "targets": "Specific [-1]"}, - {"top": "fullMeshHwCcTest", "stage": "test", "targets": "All" }, - {"top": "fullMeshHwCcWithRiscvTest", "stage": "test", "targets": "All" }, - {"top": "fullMeshSwCcTest", "stage": "test", "targets": "All" }, - {"top": "hwCcTopologyTest", "stage": "test", "targets": "All" }, - {"top": "linkConfigurationTest", "stage": "test", "targets": "All" }, - {"top": "syncInSyncOut", "stage": "test", "targets": "All" }, - {"top": "temperatureMonitor", "stage": "test", "targets": "All" }, - {"top": "transceiversUpTest", "stage": "test", "targets": "All" }, - {"top": "vexRiscvTest", "stage": "test", "targets": "Specific [-1]"} + {"top": "boardTestExtended", "stage": "test"}, + {"top": "boardTestSimple", "stage": "test"}, + {"top": "extraProbesTest", "stage": "test"}, + {"top": "fincFdecTests", "stage": "test"}, + {"top": "fullMeshHwCcTest", "stage": "test"}, + {"top": "fullMeshHwCcWithRiscvTest", "stage": "test"}, + {"top": "fullMeshSwCcTest", "stage": "test"}, + {"top": "hwCcTopologyTest", "stage": "test"}, + {"top": "linkConfigurationTest", "stage": "test"}, + {"top": "syncInSyncOut", "stage": "test"}, + {"top": "temperatureMonitor", "stage": "test"}, + {"top": "transceiversUpTest", "stage": "test"}, + {"top": "vexRiscvTest", "stage": "test"} ] diff --git a/.github/synthesis/staging.json b/.github/synthesis/staging.json index d2886bb48..7e85c4207 100644 --- a/.github/synthesis/staging.json +++ b/.github/synthesis/staging.json @@ -1,8 +1,7 @@ [ - {"top": "fullMeshHwCcTest", "stage": "test", "targets": "All"}, - {"top": "fullMeshSwCcTest", "stage": "test", "targets": "All"}, - {"top": "linkConfigurationTest", "stage": "test", "targets": "All"}, - {"top": "safeDffSynchronizer", "stage": "hdl"}, - {"top": "transceiversUpTest", "stage": "test", "targets": "All"}, - {"top": "vexRiscvTest", "stage": "test", "targets": "Specific [-1]"} + {"top": "fullMeshHwCcTest", "stage": "test"}, + {"top": "fullMeshSwCcTest", "stage": "test"}, + {"top": "linkConfigurationTest", "stage": "test"}, + {"top": "transceiversUpTest", "stage": "test"}, + {"top": "vexRiscvTest", "stage": "test"} ] diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e95e635b7..e036a54cb 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -171,7 +171,7 @@ jobs: ./cargo.sh build --frozen --release export BITTIDE_ARTIFACT_ACCESS_TOKEN="${{ secrets.GITHUB_TOKEN }}" export RUNREF="${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }}" - cabal run -- bittide-tools:cc-plot ${{ github.run_id }}:hwCcTopologyTest _build/plot hitl-topology-plots + cabal run -- bittide-tools:cc-plot ${{ github.run_id }}:hwCcTopologyTest hitl-topology-plots - name: Generate clock control reports run: | @@ -641,7 +641,7 @@ jobs: - name: Run tests on hardware run: | .github/scripts/with_vivado.sh \ - shake ${{ matrix.target.top }}:test --hardware-targets="${{ matrix.target.targets}}" + shake ${{ matrix.target.top }}:test - name: Archive ILA data if: ${{ !cancelled() }} diff --git a/bittide-experiments/bittide-experiments.cabal b/bittide-experiments/bittide-experiments.cabal index 60743490a..e39e2619a 100644 --- a/bittide-experiments/bittide-experiments.cabal +++ b/bittide-experiments/bittide-experiments.cabal @@ -76,6 +76,7 @@ common common-options ghc-typelits-extra, ghc-typelits-knownnat, ghc-typelits-natnormalise, + template-haskell, library import: common-options diff --git a/bittide-experiments/src/Bittide/Hitl.hs b/bittide-experiments/src/Bittide/Hitl.hs index 6fe77af4d..97347e2ce 100644 --- a/bittide-experiments/src/Bittide/Hitl.hs +++ b/bittide-experiments/src/Bittide/Hitl.hs @@ -2,131 +2,119 @@ -- -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {- | Tooling to define hardware-in-the-loop (HITL) tests. HITL tests in the Bittide project involve FPGA designs that incorporate a -[VIO](https://www.xilinx.com/products/intellectual-property/vio.html) to -interface with the HITL test controller. It is used to start tests and -communicate test statusses. In practice, developers writing HITL tests should -make sure to do two things: +[VIO IP core](https://www.xilinx.com/products/intellectual-property/vio.html) +to interface with the HITL test controller. This VIO is used to start tests, +communicate test status and to optionally (depending on the test +definition) provide the FPGA under test with an additional configurable +parameter. In practice, developers writing HITL tests should make sure to do +two things: 1. They should incorporate a HITL VIO in their design. The HITL test controller expects such a VIO to have at minimum an output probe named @probe_test_start@ and input probes named @probe_test_done@ and - @probe_test_success@, all of type 'Bool'. See 'hitlVio' and - 'hitlVioBool' for examples. Additional probes could be added when needed - for a specific test. + @probe_test_success@, all booleans. See 'hitlVio' and + 'hitlVioBool' for examples. When parameters are used (see below) that + have a BitSize larger than 0, an @probe_test_data@ output probe with an + equivalent BitSize must be added. 2. They should define the hardware targets to run the tests against - (multiple FPGAs, or just one), and with which inputs/parameters the - tests should be run. See 'HitlTests' for examples, together with it's - convenience functions 'testsFromEnum', 'noConfigTest', 'allFpgas', and - 'singleFpga'. - -Tests are collected in @Bittide.Instances.Hitl.Tests@. The command line -utility at @bittide-tools\/hitl\/config-gen\/Main.hs@ can create YAML -configuration files that can be processed by @HardwareTest.tcl@, and in turn -configure hardware targets appropriately. - -=== __Manual test definition__ -If you cannot reasonably use `HitlTests` to define your tests, you can manually -write a HITL test configuration file. This file should be a YAML file as specified in -@HardwareTest.tcl@. In order for Shake to find it, it must still be defined -in @Bittide.Instances.Hitl.Tests@, including the definition using @loadConfig@. This will load -the configuration from a file in @bittide-instances\/data\/test_configs@. + (multiple FPGAs, or just one), and with which parameters each of these + hardware targets should be provided before the test is started. + See 'HitlTestGroup' for examples, together with its convenience functions + 'allTargets', 'paramForHwTargets', 'paramForSingleTarget' and 'testCasesFromEnum'. + +Tests are collected in @Bittide.Instances.Hitl.Tests@. === __Flow overview__ 1. User calls @shake \:test@ to run HITL tests. - 2. Shake calls @cabal run bittide-instances:hitl write \@ to generate - a HITL configuration for @\@. This will write a file @\.yml@ - to @_build/hitl@. - 3. Shake builds a bitstream, programs the FPGA, and runs the HITL tests using - the configuration file and @HardwareTest.tcl@. + 2. Shake builds a bitstream, programs the FPGA, and runs the HITL tests by + interacting with Vivado in TCL mode using the @vivado-hs@ package. -} module Bittide.Hitl ( - HitlTests, - HitlTestsWithPostProcData, - MayHavePostProcData (..), - NoPostProcData (..), - OutProbes, - FpgaIndex, - TestName, - - -- * Test construction convenience functions - allFpgas, - singleFpga, - testsFromEnum, - noConfigTest, + ClashTargetName, + FpgaId, + HwTargetRef (..), -- * Test definition + HitlTestGroup (..), + HitlTestCase (..), + MayHavePostProcData (..), Done, Success, hitlVio, hitlVioBool, - -- * Packing - packAndEncode, + -- * Test construction convenience functions + paramForHwTargets, + paramForSingleTarget, + testCasesFromEnum, + hwTargetRefsFromHitlTestGroup, ) where import Prelude -import Clash.Prelude ( - BitPack (BitSize), - Index, - KnownDomain, - Vec (Nil, (:>)), - natToInteger, - pack, - ) +import Clash.Prelude (BitPack (BitSize), KnownDomain, Vec (Nil, (:>)), natToInteger) import Clash.Cores.Xilinx.VIO (vioProbe) -import Data.Aeson (ToJSON (toJSON), Value (Number), object, (.=)) -import Data.Aeson.Encode.Pretty ( - Config (..), - NumberFormat (..), - defConfig, - encodePretty', - ) -import Data.Aeson.Text (encodeToTextBuilder) -import Data.Map (Map) +import Data.Containers.ListUtils (nubOrd) +import Data.Map.Strict (Map) import Data.Maybe (isJust) -import Data.Text (Text) -import GHC.Exts (IsList (fromList, toList)) -import GHC.Generics (Generic) +import Data.Typeable (Typeable) +import Language.Haskell.TH.Syntax (Name) import Numeric.Natural (Natural) import Clash.Prelude qualified as P -import Clash.Sized.Internal.BitVector qualified as BitVector -import Data.Aeson qualified as Aeson -import Data.ByteString.Lazy.Char8 qualified as LazyByteString -import Data.Map qualified as Map -import Data.Text qualified as Text - -{- | FPGA index pointing to a specific FPGA in the Bittide demo rig. This will be -replaced by proper device identifiers in the future. --} -type FpgaIndex = Index 8 +import Data.Map.Strict qualified as Map -type TestName = Text +{- | Fully qualified name to a function that is the target for Clash +compilation. E.g. @Bittide.Foo.topEntity@. +-} +type ClashTargetName = Name -{- | A collection of (named) tests that should be performed with hardware in the -loop. Each test defines what data a specific FPGA should receive (see "OutProbes"). -Furthermore, some additional data can be provided, if required by subsequent -post-processing steps (which must have a 'ToJSON' instance). +{- | The FPGA ID section of a Vivado hardware target. This is what Vivado seems +to call the UID of a hardware target minus the vendor string. -=== __Example: Test without configuration__ -A test that runs for all FPGAs, and does not require any input: +For example, the ID of hardware target +"localhost:3121/xilinx_tcf/Digilent/210308B0B0C2" is "210308B0B0C2". +-} +type FpgaId = String -> tests :: HitlTests () -> tests = noConfigTest allFpgas +{- | 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 + deriving (Eq, Ord, Show) + +{- | A definition of a test that should be performed with hardware in the loop. +Such a HITL test definition can have one or more named test cases that may differ in +what hardware targets (FPGAs) they involve and in what parameters they provide +to every such hardware target (see `parameters`). +Furthermore, some additional data can be provided, if required by optional +subsequent post-processing steps. + +=== __Example: Test without parameters__ +A test that runs for all FPGAs, and does not require any parameters (the +parameter is set to `()`): + +> test :: HitlTestGroup +> test = HitlTestGroup +> { topEntity = ... +> , extraXdcFiles = [] +> , testCases = [HitlTestCase "testCaseName" (paramForHwTargets allHwTargets ()) ()] +> , mPostProc = Nothing +> } This must be accompanied by a @hitlVioBool@ in the design. @@ -135,264 +123,136 @@ A test that runs for each constructor of an enum: > data ABC = A | B | C > -> tests :: HitlTests ABC -> tests = testsFromEnum allFpgas +> testExtended :: HitlTestGroup +> testExtended = HitlTestGroup +> { topEntity = ... +> , extraXdcFiles = [] +> , testCases = testCasesFromEnum @ABC allHwTargets () +> , mPostProc = Nothing +> } This must be accompanied by a @hitlVio \@ABC@ in the design. -=== __Example: Test with custom configuration and no post processing data__ -A test that runs on specific FPGAs, and requires a (hypothetical) 8-bit number -indicating the \"number of stages\" to be set on each FPGA: +=== __Example: Test without post processing data that runs on specific FPGAs, +and requires a (hypothetical) 8-bit number indicating the +\"number of stages\" to be set on each FPGA: -> type NumberOfStages = Unsigned 8 +> type NumberOfStages = P.Unsigned 8 > -> tests :: HitlTests NumberOfStages -> tests = Map.fromList -> [ ( "Twelve stages on FPGA 2 and 5" -> , ( [ (2, 12) -> , (5, 12) -> ] -> , NoPostProcData -> ) -> ) -> , ( "Six stages on FPGA 3, seven on FPGA 4" -> , ( [ (3, 6) -> , (4, 7) -> ] -> , NoPostProcData -> ) -> ) -> ] - -This must be accompanied by a @hitlVio \@NumberOfStages@ in the design. - -=== __Example: Test with custom configuration and post processing data__ -A test that runs on specific FPGAs, and requires a (hypothetical) 8-bit number -indicating the \"number of stages\" to be set on each FPGA. Additionally, -some 'Int' constant gets fixed for each test, which will be written to -the generated config files, but is not passed to the HITL test: - -> type NumberOfStages = Unsigned 8 -> -> tests :: HitlTests NumberOfStages Int -> tests = Map.fromList -> [ ( "Twelve stages on FPGA 2 and 5" -> , ( [ (2, 12) -> , (5, 12) -> ] -> , 42 -> ) -> ) -> , ( "Six stages on FPGA 3, seven on FPGA 4" -> , ( [ (3, 6) -> , (4, 7) -> ] -> , 13 -> ) -> ) -> ] +> test :: HitlTestGroup +> test = HitlTestGroup +> { topEntity = '() +> , extraXdcFiles = [] +> , testCases = +> [ HitlTestCase +> { name = "Twelve stages on FPGA 2 and 5" +> , parameters = Map.fromList +> [ (HwTargetByIndex 2, 12 :: NumberOfStages) +> , (HwTargetByIndex 5, 12) +> ] +> , postProcData = () +> } +> , HitlTestCase +> { name = "Six stages on FPGA 3, seven on FPGA 4" +> , parameters = Map.fromList +> [ (HwTargetByIndex 3, 6) +> , (HwTargetByIndex 4, 7) +> ] +> , postProcData = () +> } +> ] +> , mPostProc = Nothing +> } This must be accompanied by a @hitlVio \@NumberOfStages@ in the design. -} -type HitlTestsWithPostProcData a b = Map TestName (OutProbes a, b) - --- | The type synonym for tests without additional post processing data. -type HitlTests a = HitlTestsWithPostProcData a NoPostProcData - -{- | A list of values to be driven by output probes of VIO core instances on -specific FPGAs. See convenience methods 'allFpgas' and 'singleFpga'. +data HitlTestGroup where + HitlTestGroup :: + (Typeable a, Typeable b) => + { topEntity :: ClashTargetName + -- ^ Reference to the Design Under Test + , extraXdcFiles :: [String] + , testCases :: [HitlTestCase HwTargetRef a b] + -- ^ List of test cases + , mPostProc :: Maybe String + -- ^ Optional post processing step. If present, the name of the executable + -- in the @bittide-instances@ package. + , externalHdl :: [String] + -- ^ List of external HDL files to include in the project + } -> + HitlTestGroup + +{- | A HITL test case. One HITL test can have multiple test cases +associated with it. -} -type OutProbes a = [(FpgaIndex, a)] +data HitlTestCase h a b where + HitlTestCase :: + (Show h, Show a, BitPack a, Show b, Typeable h) => + { name :: String + , parameters :: Map h a + , postProcData :: b + } -> + HitlTestCase h a b + +deriving instance Show (HitlTestCase h a b) -- | A class for extracting optional post processing data from a test. -class MayHavePostProcData b c where +class MayHavePostProcData b where -- | Returns the test names with some post processing data of type @c@, -- if that data exists. mGetPPD :: - forall a. - HitlTestsWithPostProcData a b -> - Map TestName (Maybe c) + forall h a. + [HitlTestCase h a b] -> + Map String (Maybe b) -instance MayHavePostProcData a a where - mGetPPD = fmap (Just . snd) +instance MayHavePostProcData a where + mGetPPD cases = + Map.fromList + [(name, Just postProcData) | HitlTestCase{..} <- cases] -{- | A custom data type for indicating tests without any additional -post processing data with a custom 'ToJSON' instance. This is -required, because the TCL -> YAML interface does not support empty -lists or empty objects. --} -data NoPostProcData = NoPostProcData - -instance ToJSON NoPostProcData where toJSON _ = Aeson.Null -instance MayHavePostProcData NoPostProcData a where mGetPPD = const [] - --- | Drive a value on the `probe_test_data` VIO output probe on each FPGAs. -allFpgas :: a -> OutProbes a -allFpgas a = (,a) <$> [0 ..] +instance MayHavePostProcData () where + mGetPPD = Map.fromList . map ((,Nothing) . name) --- | Drive a value on the `probe_test_data` VIO output probe on one specific FPGA. -singleFpga :: FpgaIndex -> a -> OutProbes a -singleFpga ix a = [(ix, a)] +-- | Obtain a list of the hardware targets that are relevant for a given HITL test. +hwTargetRefsFromHitlTestGroup :: HitlTestGroup -> [HwTargetRef] +hwTargetRefsFromHitlTestGroup HitlTestGroup{testCases} = + nubOrd $ concatMap (map fst . Map.toList . parameters) testCases -{- | Define a 'HitlTests' for a test that does not accept any input. Use of 'noConfigTest' -should be paired with 'hitlVioBool'. +-- | Provide a given list of hardware targets with one parameter. +paramForHwTargets :: [HwTargetRef] -> a -> Map HwTargetRef a +paramForHwTargets hwTs param = Map.fromList $ map (,param) hwTs -Example invocation: - -> tests :: HitlTests () -> tests = noConfigTest allFpgas --} -noConfigTest :: TestName -> (forall a. a -> OutProbes a) -> HitlTests () -noConfigTest nm f = Map.singleton nm (f (), NoPostProcData) +-- | Returns the hardware target to parameter map for a single target. +paramForSingleTarget :: HwTargetRef -> a -> Map HwTargetRef a +paramForSingleTarget = Map.singleton -{- | Generate a set of tests from an enum. E.g., if you defined a data type looking -like: +{- | Generate a set of HITL test cases from an enum. E.g., if you defined a +data type looking like: > data ABC = A | B | C +> deriving (BitPack, Bounded, Enum, Generic, Show) -You can use the following to generate a test config that runs a test for each -constructor of @ABC@: - -> tests :: HitlTests ABC -> tests = testsFromEnum allFpgas --} -testsFromEnum :: (Show a, Bounded a, Enum a) => (a -> OutProbes a) -> HitlTests a -testsFromEnum f = - Map.fromList $ - map (\a -> (Text.pack (show a), (f a, NoPostProcData))) [minBound ..] - --- | A list, but with a custom "ToJSON" instance to work around Vivado issues -newtype PackedList a = PackedList [a] - -{- | XXX: Custom "ToJSON" instance for "PackedList" that converts an empty - "PackedList" into a 'Aeson.Null' to accommodate Vivado's poorly - implemented JSON/YAML parser. --} -instance (ToJSON a) => ToJSON (PackedList a) where - toJSON (PackedList []) = Aeson.Null - toJSON (PackedList l) = toJSON l - -{- | A map from a probe name to a (binary) value with a custom "ToJSON" instance -to work around Vivado issues. --} -newtype PackedProbes = PackedProbes (Map Text Natural) +You can use the following to generate a test case for each contructor +of @ABC@. Every such case is named after the constructor that gave rise +to it and receives that constructur as test parameter. -{- | XXX: Custom "ToJSON" instance for "PackedProbes" that converts an empty - "PackedProbes" into a 'Aeson.Null' to accommodate Vivado's poorly - implemented JSON/YAML parser. --} -instance ToJSON PackedProbes where - toJSON (PackedProbes []) = Aeson.Null - toJSON (PackedProbes l) = toJSON l - --- | See "PackedTests" -newtype PackedTargetRef = ByIndex {index :: Integer} - deriving (Generic, ToJSON) - --- | See "PackedTests" -data PackedTarget = PackedTarget - { target :: PackedTargetRef - , probes :: PackedProbes - } - deriving (Generic, ToJSON) - --- | See "PackedTests" -data PackedTest a = PackedTest - { targets :: PackedList PackedTarget - , postproc :: a - } - deriving (Generic, ToJSON) - -{- | Intermediate representation of "HitlTests". There to provide trivial instances -of "ToJSON". --} -data PackedTests a = PackedTests - { defaults :: PackedProbes - , tests :: Map Text (PackedTest a) - } - -instance (ToJSON a) => ToJSON (PackedTests a) where - toJSON (PackedTests{defaults, tests}) = - object - [ "defaults" .= object ["probes" .= defaults] - , "tests" .= toJSON tests - ] - -{- | Convert an \"unpacked\" "HitlTests" to a packed version. The packed version -is convertible to JSON, which in turn can be interpreted by the @HardwareTest.tcl@. --} -toPacked :: - forall a b. - (BitPack a, ToJSON b) => - HitlTestsWithPostProcData a b -> - PackedTests b -toPacked hitlTests = PackedTests{defaults, tests} - where - bitSizeA = natToInteger @(BitSize a) - tests = - fromList - [ (name, goProbes probes ppData) - | (name, (probes, ppData)) <- toList hitlTests - ] - defaults - -- If @a@ is a zero-width type, we don't want to generate any data probes - | bitSizeA == 0 = PackedProbes [] - | otherwise = PackedProbes [("probe_test_data", 0)] - - goProbes probes postproc = - PackedTest - { targets = PackedList $ goTargetList probes - , .. - } - - goTargetList probes - | bitSizeA == 0 = - [ PackedTarget - { target = ByIndex (toInteger id_) - , probes = PackedProbes [] - } - | (id_, _) <- probes - ] - | otherwise = - [ PackedTarget - { target = ByIndex (toInteger id_) - , probes = PackedProbes [("probe_test_data", BitVector.unsafeToNatural (pack dat))] - } - | (id_, dat) <- probes - ] - -{- | Convert a collection of named tests ("HitlTests") to a \"packed\" representation -readable by our TCL test infrastructure. It will generate YAML/JSON that looks -like: - -> defaults: -> probes: -> probe_test_data: 0 -> -> tests: -> testname1: -> targets: -> - id: 0 -> probes: -> probe_test_data: -> - id: 1 -> probes: -> probe_test_data: -> ... -> testname2: -> ... +> testCases :: [HitlTestCase HwTargetRef ABC ()] +> testCases = testCasesFromEnum @ABC allHwTargets () -} -packAndEncode :: +testCasesFromEnum :: forall a b. - (BitPack a, ToJSON b) => - HitlTestsWithPostProcData a b -> - LazyByteString.ByteString -packAndEncode = - encodePretty' - defConfig - { confNumFormat = Custom (encodeToTextBuilder . Number) - } - . toPacked + (Show a, Bounded a, Enum a, BitPack a, Show b, Typeable a, Typeable b) => + [HwTargetRef] -> + b -> + [HitlTestCase HwTargetRef a b] +testCasesFromEnum hwTs ppd = + [ HitlTestCase + { name = show constr + , parameters = Map.fromList ((,constr) <$> hwTs) + , postProcData = ppd + } + | (constr :: a) <- [minBound ..] + ] -- | Whether a test has been completed, see 'hitlVio'. type Done = Bool @@ -411,20 +271,21 @@ hitlVio :: ) => -- | Default value for @a@. This is an artifact of this VIO internally representing -- the output value as two probes (\"valid\" and \"data\") to accommodate the - -- TCL infrastructure. Hence, the actual value of the default doesn't matter: - -- whenever it is output, this VIO will output 'Nothing'. + -- HITL test infrastructure. Hence, the actual value of the default doesn't + -- matter: whenever it is output, this VIO will output 'Nothing'. -- -- TODO: Allow use of 'errorX' in 'vioProbe' a -> P.Clock dom -> - -- | Should be asserted when a test is done. For sanity checking the TCL + -- | Should be asserted when a test is done. For sanity checking the HITL test -- infrastructure, this must be *deasserted* when a test is not running. P.Signal dom Done -> -- | When 'Done' is asserted, this signal indicates whether a test has been -- completed successfully. P.Signal dom Success -> - -- | Test values supplied by the VIO. Test modules should export a symbol - -- @tests :: HitlTests a@ that defines the data. + -- | Test parameter supplied by the VIO. Test modules should export a symbol + -- @test :: HitlTestGroup@ that defines this parameter for every hardware target + -- (FPGA) that the test involves. P.Signal dom (Maybe a) hitlVio dflt clk done success | natToInteger @(BitSize a) == 0 = @@ -462,7 +323,7 @@ hitlVioBool :: forall dom. (KnownDomain dom) => P.Clock dom -> - -- | Should be asserted when a test is done. For sanity checking the TCL + -- | Should be asserted when a test is done. For sanity checking the HITL test -- infrastructure, this must be *deasserted* when a test is not running. P.Signal dom Done -> -- | When 'Done' is asserted, this signal indicates whether a test has been diff --git a/bittide-instances/README.md b/bittide-instances/README.md index 6d8c5ef69..987455e35 100644 --- a/bittide-instances/README.md +++ b/bittide-instances/README.md @@ -6,7 +6,7 @@ SPDX-License-Identifier: Apache-2.0 # bittide-instances Collection of monomorphic instances of realistic Bittide components. These instances are meant -to be handled bittide-shake. +to be handled by bittide-shake. This collection contains instances with various purposes: * CI tests that ensure all components will meet timing. diff --git a/bittide-instances/bittide-instances.cabal b/bittide-instances/bittide-instances.cabal index 85ccd8d0d..db8ebc308 100644 --- a/bittide-instances/bittide-instances.cabal +++ b/bittide-instances/bittide-instances.cabal @@ -123,7 +123,6 @@ library Bittide.Instances.Hitl.Post.PostProcess Bittide.Instances.Hitl.Setup Bittide.Instances.Hitl.SyncInSyncOut - Bittide.Instances.Hitl.Tcl.ExtraProbes Bittide.Instances.Hitl.TemperatureMonitor Bittide.Instances.Hitl.Tests Bittide.Instances.Hitl.Transceivers @@ -203,6 +202,7 @@ executable clash build-depends: bittide-instances, clash-ghc, + vivado-hs, executable post-board-test-extended import: common-options diff --git a/bittide-instances/exe/post-board-test-extended/Main.hs b/bittide-instances/exe/post-board-test-extended/Main.hs index 31d829399..d9b6f3b19 100644 --- a/bittide-instances/exe/post-board-test-extended/Main.hs +++ b/bittide-instances/exe/post-board-test-extended/Main.hs @@ -16,9 +16,9 @@ main :: IO () main = do args <- getArgs case args of - ilaDir : [testExitCode] -> do - csvPaths <- glob (ilaDir "*" "*" "*.csv") - let ilaCsvPaths = toFlattenedIlaCsvPathList ilaDir csvPaths + ilaDataDir : [testExitCode] -> do + csvPaths <- glob (ilaDataDir "*" "*" "*.csv") + let ilaCsvPaths = toFlattenedIlaCsvPathList ilaDataDir csvPaths let exitCode = read testExitCode postBoardTestExtended exitCode ilaCsvPaths [] -> diff --git a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs index 5bd853b49..c62a586ff 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs @@ -15,14 +15,15 @@ import Clash.Cores.Xilinx.Extra (ibufds) import Clash.Cores.Xilinx.Ila import Bittide.Hitl ( - HitlTests, - allFpgas, + HitlTestCase (HitlTestCase), + HitlTestGroup (..), hitlVio, hitlVioBool, - noConfigTest, - testsFromEnum, + paramForHwTargets, + testCasesFromEnum, ) -import Bittide.Instances.Domains +import Bittide.Instances.Domains (Ext125) +import Bittide.Instances.Hitl.Setup (allHwTargets) type TestStart = Bool data TestState = Busy | Done TestSuccess @@ -167,8 +168,22 @@ boardTestExtended diffClk = hwSeqX boardTestIla $ bundle (testDone, testSuccess) makeTopEntity 'boardTestExtended -testsSimple :: HitlTests () -testsSimple = noConfigTest "Simple" allFpgas - -testsExtended :: HitlTests Test -testsExtended = testsFromEnum allFpgas +testSimple :: HitlTestGroup +testSimple = + HitlTestGroup + { topEntity = 'boardTestSimple + , extraXdcFiles = [] + , externalHdl = [] + , testCases = [HitlTestCase "Simple" (paramForHwTargets allHwTargets ()) ()] + , mPostProc = Nothing + } + +testExtended :: HitlTestGroup +testExtended = + HitlTestGroup + { topEntity = 'boardTestExtended + , extraXdcFiles = [] + , externalHdl = [] + , testCases = testCasesFromEnum @Test allHwTargets () + , mPostProc = Just "post-board-test-extended" + } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs index 1e8f04448..795235ea1 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs @@ -21,7 +21,12 @@ import Bittide.ClockControl ( ) import Bittide.ClockControl.Si539xSpi (ConfigState (Finished), si539xSpi) import Bittide.Counter (domainDiffCounter) -import Bittide.Hitl (HitlTests, hitlVio, singleFpga, testsFromEnum) +import Bittide.Hitl ( + HitlTestGroup (..), + HwTargetRef (HwTargetByIndex), + hitlVio, + testCasesFromEnum, + ) import Bittide.Instances.Domains import Data.Maybe (isJust) @@ -210,5 +215,12 @@ fincFdecTests diffClk controlledDiffClock spiIn = {-# NOINLINE fincFdecTests #-} makeTopEntity 'fincFdecTests -tests :: HitlTests Test -tests = testsFromEnum (singleFpga maxBound) +tests :: HitlTestGroup +tests = + HitlTestGroup + { topEntity = 'fincFdecTests + , extraXdcFiles = [] + , externalHdl = [] + , testCases = testCasesFromEnum @Test [HwTargetByIndex 7] () + , mPostProc = Nothing + } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs index 9ef12aad2..560fd126b 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs @@ -28,7 +28,8 @@ module Bittide.Instances.Hitl.FullMeshHwCc ( fullMeshHwCcWithRiscvTest, fullMeshHwCcTest, clockControlConfig, - tests, + fullMeshHwCcWithRiscvTest', + fullMeshHwCcTest', ) where import Clash.Explicit.Prelude hiding (PeriodToCycles) @@ -55,7 +56,7 @@ import Bittide.DoubleBufferedRam ( registerWb, ) import Bittide.ElasticBuffer (sticky) -import Bittide.Hitl (HitlTestsWithPostProcData, allFpgas, hitlVioBool) +import Bittide.Hitl import Bittide.Instances.Domains import Bittide.ProcessingElement (PeConfig (..), processingElement) import Bittide.ProcessingElement.Util (memBlobsFromElf) @@ -82,7 +83,6 @@ import VexRiscv import qualified Bittide.Transceiver as Transceiver import qualified Bittide.Transceiver.ResetManager as ResetManager -import qualified Data.Map as Map (singleton) clockControlConfig :: $(case (instancesClockConfig (Proxy @Basic125)) of (_ :: t) -> liftTypeQ @t) @@ -497,21 +497,37 @@ fullMeshHwCcTest refClkDiff sysClkDiff syncIn rxns rxps miso = makeTopEntity 'fullMeshHwCcTest -tests :: HitlTestsWithPostProcData () CcConf -tests = - Map.singleton "CC" - $ ( allFpgas () - , def - { ccTopologyType = Complete (natToInteger @FpgaCount) - , samples = 1000 - , duration = natToNum @(PeriodToCycles Basic125 (Seconds 60)) - , stabilityMargin = snatToNum cccStabilityCheckerMargin - , stabilityFrameSize = snatToNum cccStabilityCheckerFramesize - , reframe = cccEnableReframing - , waitTime = fromEnum cccReframingWaitTime - , clockOffsets = Nothing - , startupDelays = toList $ repeat @FpgaCount 0 - } - ) +mkTest :: ClashTargetName -> HitlTestGroup +mkTest topEntity = + HitlTestGroup + { topEntity = topEntity + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "CC" + , parameters = paramForHwTargets allHwTargets () + , postProcData = + def + { ccTopologyType = Complete (natToInteger @FpgaCount) + , samples = 1000 + , duration = natToNum @(PeriodToCycles Basic125 (Seconds 60)) + , stabilityMargin = snatToNum cccStabilityCheckerMargin + , stabilityFrameSize = snatToNum cccStabilityCheckerFramesize + , reframe = cccEnableReframing + , waitTime = fromEnum cccReframingWaitTime + , clockOffsets = Nothing + , startupDelays = toList $ repeat @FpgaCount 0 + } + } + ] + , mPostProc = Nothing + } where ClockControlConfig{..} = clockControlConfig + +fullMeshHwCcWithRiscvTest' :: HitlTestGroup +fullMeshHwCcWithRiscvTest' = mkTest 'fullMeshHwCcWithRiscvTest + +fullMeshHwCcTest' :: HitlTestGroup +fullMeshHwCcTest' = mkTest 'fullMeshHwCcTest diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs index d2d5f5914..2d3d8c751 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs @@ -34,10 +34,10 @@ module Bittide.Instances.Hitl.FullMeshSwCc ( import Clash.Explicit.Prelude hiding (PeriodToCycles) import qualified Clash.Explicit.Prelude as E import Clash.Prelude (withClockResetEnable) -import qualified Prelude as P import Data.Maybe (fromMaybe) import Data.Proxy +import Data.String (fromString) import Language.Haskell.TH (runIO) import LiftType (liftTypeQ) import System.FilePath @@ -51,7 +51,7 @@ import Bittide.ClockControl.Si539xSpi (ConfigState (Error, Finished), si539xSpi) import Bittide.Counter import Bittide.DoubleBufferedRam (ContentType (Blob), InitialContent (Reloadable)) import Bittide.ElasticBuffer (Overflow, Underflow, resettableXilinxElasticBuffer, sticky) -import Bittide.Hitl (HitlTestsWithPostProcData, allFpgas, hitlVioBool) +import Bittide.Hitl import Bittide.Instances.Domains import Bittide.ProcessingElement (PeConfig (..), processingElement) import Bittide.ProcessingElement.Util (memBlobsFromElf) @@ -80,8 +80,6 @@ import VexRiscv import qualified Bittide.Transceiver as Transceiver import qualified Bittide.Transceiver.ResetManager as ResetManager -import qualified Data.Map as Map -import Data.String (fromString) type FpgaCount = 8 type LinkCount = FpgaCount - 1 @@ -668,23 +666,32 @@ makeTopEntity 'fullMeshSwCcTest testsToRun :: Int testsToRun = 1 -tests :: HitlTestsWithPostProcData () CcConf +tests :: HitlTestGroup tests = - Map.fromList - $ P.zip ["CC" <> fromString (show n) | n <- [0 .. testsToRun - 1]] - $ P.repeat - ( allFpgas () - , def - { ccTopologyType = Complete (natToInteger @FpgaCount) - , samples = 1000 - , duration = natToNum @(PeriodToCycles Basic125 (Seconds 60)) - , stabilityMargin = snatToNum cccStabilityCheckerMargin - , stabilityFrameSize = snatToNum cccStabilityCheckerFramesize - , reframe = cccEnableReframing - , waitTime = fromEnum cccReframingWaitTime - , clockOffsets = Nothing - , startupDelays = toList $ repeat @FpgaCount 0 + HitlTestGroup + { topEntity = 'fullMeshSwCcTest + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "CC" <> fromString (show n) + , parameters = paramForHwTargets allHwTargets () + , postProcData = + def + { ccTopologyType = Complete (natToInteger @FpgaCount) + , samples = 1000 + , duration = natToNum @(PeriodToCycles Basic125 (Seconds 60)) + , stabilityMargin = snatToNum cccStabilityCheckerMargin + , stabilityFrameSize = snatToNum cccStabilityCheckerFramesize + , reframe = cccEnableReframing + , waitTime = fromEnum cccReframingWaitTime + , clockOffsets = Nothing + , startupDelays = toList $ repeat @FpgaCount 0 + } } - ) + | n <- [0 .. testsToRun - 1] + ] + , mPostProc = Nothing + } where ClockControlConfig{..} = clockControlConfig diff --git a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs index 227e2e5d9..34d3a3d0e 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs @@ -38,9 +38,9 @@ import qualified Clash.Explicit.Prelude as E import Clash.Prelude (withClockResetEnable) import Data.Bifunctor (bimap) +import Data.Functor ((<&>)) import Data.Maybe (fromMaybe, isJust) import Data.Proxy -import Data.String (fromString) import GHC.Float.RealFracMethods (roundFloatInteger) import Language.Haskell.TH (runIO) import LiftType (liftTypeQ) @@ -70,7 +70,7 @@ import Bittide.Simulate.Config (CcConf (..)) import Bittide.Topology import Bittide.Transceiver (transceiverPrbsN) -import Bittide.Hitl (HitlTestsWithPostProcData, OutProbes, TestName, hitlVio) +import Bittide.Hitl import Bittide.Instances.Hitl.IlaPlot import Bittide.Instances.Hitl.Setup @@ -774,29 +774,35 @@ hwCcTopologyTest refClkDiff sysClkDiff syncIn rxns rxps miso = makeTopEntity 'hwCcTopologyTest -tests :: HitlTestsWithPostProcData TestConfig CcConf +tests :: HitlTestGroup tests = - Map.fromList - [ -- CALIBRATION -- - ----------------- - - -- detect the natual clock offsets to be elided from the later tests - calibrateClockOffsets - , -- TESTS -- - ----------- - - -- initial clock shifts startup delays topology - tt (Just icsDiamond) ((m *) <$> sdDiamond) diamond - , tt (Just icsComplete) ((m *) <$> sdComplete) $ complete d3 - , tt (Just icsCyclic) ((m *) <$> sdCyclic) $ cyclic d5 - , tt (Just icsTorus) ((m *) <$> sdTorus) $ torus2d d2 d3 - , tt (Just icsStar) ((m *) <$> sdStar) $ star d7 - , tt (Just icsLine) ((m *) <$> sdLine) $ line d4 - , tt (Just icsHourglass) ((m *) <$> sdHourglass) $ hourglass d3 - , -- CALIBRATION VERIFICATON -- - ----------------------------- - validateClockOffsetCalibration - ] + HitlTestGroup + { topEntity = 'hwCcTopologyTest + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ -- CALIBRATION -- + ----------------- + + -- detect the natual clock offsets to be elided from the later tests + calibrateClockOffsets + , -- TESTS -- + ----------- + + -- initial clock shifts startup delays topology + tt (Just icsDiamond) ((m *) <$> sdDiamond) diamond + , tt (Just icsComplete) ((m *) <$> sdComplete) $ complete d3 + , tt (Just icsCyclic) ((m *) <$> sdCyclic) $ cyclic d5 + , tt (Just icsTorus) ((m *) <$> sdTorus) $ torus2d d2 d3 + , tt (Just icsStar) ((m *) <$> sdStar) $ star d7 + , tt (Just icsLine) ((m *) <$> sdLine) $ line d4 + , tt (Just icsHourglass) ((m *) <$> sdHourglass) $ hourglass d3 + , -- CALIBRATION VERIFICATON -- + ----------------------------- + validateClockOffsetCalibration + ] + , mPostProc = Nothing + } where m = 1_000_000 @@ -838,30 +844,29 @@ tests = calibrateClockOffsets = calibrateCC False validateClockOffsetCalibration = calibrateCC True + calibrateCC :: Bool -> HitlTestCase HwTargetRef TestConfig CcConf calibrateCC validate = - ( -- the names must be chosen such that the run is executed first/last - (if validate then "zzz_validate" else "0_calibrate") <> "_clock_offsets" - , - ( toList - $ imap (,) - $ repeat @FpgaCount - TestConfig - { fpgaEnabled = True - , calibrate = - if validate - then CCCalibrationValidation - else CCCalibrate - , initialClockShift = Nothing - , startupDelay = 0 - , mask = maxBound - } - , defSimCfg - { ccTopologyType = Complete $ natToInteger @FpgaCount - , clockOffsets = Nothing - , startupDelays = toList $ repeat @FpgaCount 0 - } - ) - ) + HitlTestCase + { name = (if validate then "zzz_validate" else "0_calibrate") <> "_clock_offsets" + , parameters = + Map.fromList $ allHwTargets + <&> (,TestConfig + { fpgaEnabled = True + , calibrate = + if validate + then CCCalibrationValidation + else CCCalibrate + , initialClockShift = Nothing + , startupDelay = 0 + , mask = maxBound + }) + , postProcData = + defSimCfg + { ccTopologyType = Complete $ natToInteger @FpgaCount + , clockOffsets = Nothing + , startupDelays = toList $ repeat @FpgaCount 0 + } + } -- tests the given topology tt :: @@ -870,29 +875,31 @@ tests = Maybe (Vec n PartsPer) -> Vec n StartupDelay -> Topology n -> - (TestName, (OutProbes TestConfig, CcConf)) + HitlTestCase HwTargetRef TestConfig CcConf tt clockShifts startDelays t = - ( fromString $ topologyName t - , - ( toList - ( zipWith4 - testData - indicesI - (maybeVecToVecMaybe (map partsPerToSteps <$> clockShifts)) - startDelays - (linkMasks @n t) - ) - <> [ (fromInteger i, disabled) - | let n = natToNum @n - , i <- [n, n + 1 .. natToNum @LinkCount] - ] - , defSimCfg - { ccTopologyType = topologyType t - , clockOffsets = toList <$> clockShifts - , startupDelays = fromIntegral <$> toList startDelays - } - ) - ) + HitlTestCase + { name = topologyName t + , parameters = + Map.fromList + $ toList + ( zipWith4 + testData + indicesI + (maybeVecToVecMaybe (map partsPerToSteps <$> clockShifts)) + startDelays + (linkMasks @n t) + ) + <> [ (HwTargetByIndex (fromInteger i), disabled) + | let n = natToNum @n + , i <- [n, n + 1 .. natToNum @LinkCount] + ] + , postProcData = + defSimCfg + { ccTopologyType = topologyType t + , clockOffsets = toList <$> clockShifts + , startupDelays = fromIntegral <$> toList startDelays + } + } maybeVecToVecMaybe :: forall n a. (KnownNat n) => Maybe (Vec n a) -> Vec n (Maybe a) maybeVecToVecMaybe = \case @@ -906,9 +913,9 @@ tests = Maybe FincFdecCount -> StartupDelay -> BitVector LinkCount -> - (Index FpgaCount, TestConfig) + (HwTargetRef, TestConfig) testData i initialClockShift startupDelay mask = - ( zeroExtend @Index @n @(FpgaCount - n) i + ( HwTargetByIndex (fromIntegral i) , TestConfig { fpgaEnabled = True , calibrate = NoCCCalibration diff --git a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs index 7503a05d5..7d19f97bf 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs @@ -32,7 +32,7 @@ import Bittide.ElasticBuffer (sticky) import Bittide.Instances.Domains import Bittide.Transceiver -import Bittide.Hitl (HitlTests, NoPostProcData (..), hitlVio) +import Bittide.Hitl import Bittide.Instances.Hitl.Setup @@ -270,8 +270,22 @@ linkConfigurationTest refClkDiff sysClkDiff syncIn rxns rxps miso = makeTopEntity 'linkConfigurationTest -tests :: HitlTests (Index FpgaCount) +tests :: HitlTestGroup tests = - Map.fromList - [ ("LinkConfiguration", (toList $ zip indicesI indicesI, NoPostProcData)) - ] + HitlTestGroup + { topEntity = 'linkConfigurationTest + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "LinkConfiguration" + , parameters = + Map.fromList + [ (HwTargetByIndex (fromIntegral i), i) + | i <- [0 ..] :: [Index FpgaCount] + ] + , postProcData = () + } + ] + , mPostProc = Nothing + } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Post/PostProcess.hs b/bittide-instances/src/Bittide/Instances/Hitl/Post/PostProcess.hs index 3dd9dc7d0..4cf0aebc0 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Post/PostProcess.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Post/PostProcess.hs @@ -61,19 +61,19 @@ toFpgaNum fpgaName = base directory of ILA data. -} toNestedIlaCsvPaths :: (HasCallStack) => FilePath -> [FilePath] -> NestedIlaCsvPaths -toNestedIlaCsvPaths ilaDir = foldl addIlaCsvPath Map.empty . toFlattenedIlaCsvPathList ilaDir +toNestedIlaCsvPaths ilaDataDir = foldl addIlaCsvPath Map.empty . toFlattenedIlaCsvPathList ilaDataDir {- | Create a list of FlattenedIlaCsvPath using a list of filepaths of CSV dumps and the base directory of ILA data. -} toFlattenedIlaCsvPathList :: (HasCallStack) => FilePath -> [FilePath] -> [FlattenedIlaCsvPath] -toFlattenedIlaCsvPathList ilaDir = map go +toFlattenedIlaCsvPathList ilaDataDir = map go where go :: FilePath -> FlattenedIlaCsvPath go csvPath = FlattenedIlaCsvPath{..} where - relativeCsvPath = makeRelative ilaDir csvPath + relativeCsvPath = makeRelative ilaDataDir csvPath (testName, toFpgaNum -> fpgaNum, takeBaseName -> ilaName) = case splitDirectories relativeCsvPath of [a, b, c] -> (a, b, c) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/README.md b/bittide-instances/src/Bittide/Instances/Hitl/README.md index ede791360..1332d3a6f 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/README.md +++ b/bittide-instances/src/Bittide/Instances/Hitl/README.md @@ -11,9 +11,8 @@ all connected to a PC through their JTAG ports. This PC runs a GitHub runner. To add a HTIL test: -- Instantiate `Clash.Hitl.hitlVio` in your design +- Instantiate `Bittide.Hitl.hitlVio` in your design - Add your test to `hitlTests` in ([Tests.hs](/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs)) -- Add your test to `targets` in ([Shake.hs](/bittide-shake/bin/Shake.hs)) - Add your test to CI: - [staging](/.github/synthesis/staging.json) runs on every PR, [all](/.github/synthesis/all.json) runs every night @@ -38,22 +37,28 @@ in the design: The CSV files are written to the following directory: ``` -_build/vivado/{instance}/ila-data/{start_probe_name}/{index in rig}_{FPGA id} +_build/vivado/{instance}/ila-data/{test_case_name}/{index_in_rig}_{FPGA_id} ``` -In this directory, a CSV file with the name of the ILA is written. The name of -the ILA can be set with `setName`, identical to setting a name for a VIO. Note -that a lot of CSV files can be generated, e.g. a hardware-in-the-loop test with -2 start probes and 2 ILAs programmed on all 8 FPGAs in the demo rig results in -32 CSV files. +or, when the index in the rig could not be determined: -The default ILA configuration (`ilaConfig`, see [Clash.Cores.Xilinx.Ila](https://github.com/clash-lang/clash-compiler/blob/master/clash-cores/src/Clash/Cores/Xilinx/Ila.hs#L63) is valid +``` +_build/vivado/{instance}/ila-data/{test_case_name}/{FPGA_id} +``` + +In this directory, a CSV file and a VCD file with the name of the ILA are +written. The name of the ILA can be set with `setName`, identical to setting a +name for a VIO. Note that a lot of files can be generated, e.g. a +hardware-in-the-loop test with 2 test cases and 2 ILAs programmed on all 8 +FPGAs in the demo rig results in 32 CSV files. + +The default ILA configuration (`ilaConfig`, see [Clash.Cores.Xilinx.Ila](https://github.com/clash-lang/clash-compiler/blob/15dc344dfa091de14c63759c0b6ea107ca0fa892/clash-cores/src/Clash/Cores/Xilinx/Ila.hs#L63) is valid for hardware-in-the-loop tests. If a custom configuration is used, make sure to set `captureControl` to `True`, and use the `probeType`s described above. All ILA data is uploaded from the FPGA to the PC after the VIO test is finished -(or timed out). If an ILA did not trigger, the saved CSV file will only contain -the header. +(or has timed out). If an ILA did not trigger, the saved CSV file will only +contain the header. ## Pseudo-code of a hardware-in-the-loop test @@ -64,34 +69,36 @@ for each FPGA for each test for each FPGA assert `probe_test_done` is `0` + set `probe_test_data` to the parameter for this FPGA if there is one arm all ILAs - start test by setting `probe_test_start_x` to `1` + start test by setting `probe_test_start` to `1` for each FPGA wait for `probe_test_done` to assert print test results - if test failed - print all VIO probe values for each FPGA upload ILA data - stop test by setting `probe_test_start_x` to `0` + stop test by setting `probe_test_start` to `0` print test summary print summary all tests ``` +Test execution is implemented in `Clash.Shake.Vivado` of bittide-shake. ## Post processing of ILA data -If a Shake target has a post processing function, this is executed after the +If a Shake target has a post processing function, it is executed after the hardware test as part of the `:test` call. The post processing function can also -be called without performing the hardware test using `:post-process`. +be called without performing the hardware test again using `:post-process`. To add post processing to a bittide instance: -1. Create a Haskell file in `bittide-instances/bin/Post/` with a `main` +1. Create a Haskell file in `bittide-instances/exe/post-{test_name}/` with a `main` function. This file can import any file from `Bittide.Instances`. The function is called from Shake with 2 arguments: filepath of the ILA data directory and the exit code of the hardware test which generated the ILA data. -2. Add an executable in `bittide-instances.cabal` for the new Haskell file. -3. In `Shake.hs`, add a `Target` for the instance, and set `targetPostProcess` -to the name of the executable created in the step above. +2. Add an executable for the new Haskell file named `post-{test_name}` in +`bittide-instances.cabal`. +3. In the Haskell file containing the test definition of type +`Bittide.Hitl.HitlTestGroup`, define the `mPostProc` field to be a `Just` with the +name of the executable created in the step above as a `String`. See the example for the instance `boardTestExtended`. diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Setup.hs b/bittide-instances/src/Bittide/Instances/Hitl/Setup.hs index c33522697..c4f896cd2 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Setup.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Setup.hs @@ -5,16 +5,21 @@ module Bittide.Instances.Hitl.Setup ( FpgaCount, LinkCount, + FpgaId, TransceiverWires, + allHwTargets, channelNames, clockPaths, fpgaSetup, + knownFpgaIds, + knownFpgaIdsVec, linkMask, linkMasks, ) where import Clash.Prelude +import Bittide.Hitl (FpgaId, HwTargetRef (..)) import Bittide.Topology import Data.Constraint (Dict (..), (:-) (..)) import Data.Constraint.Nat (leTrans) @@ -42,7 +47,7 @@ clockPaths = neighbors (via the index position in the vector) according to the different hardware interfaces on the boards. -} -fpgaSetup :: Vec FpgaCount (String, Vec LinkCount (Index FpgaCount)) +fpgaSetup :: Vec FpgaCount (FpgaId, Vec LinkCount (Index FpgaCount)) fpgaSetup = -- FPGA Id SFP0 SFP1 J4 J5 J6 J7 SMA ("210308B3B272", 3 :> 2 :> 4 :> 5 :> 6 :> 7 :> 1 :> Nil) @@ -55,6 +60,21 @@ fpgaSetup = :> ("210308B0B0C2", 4 :> 5 :> 3 :> 2 :> 1 :> 0 :> 6 :> Nil) :> Nil +{- | The IDs of the Digilent chips on each of the FPGA boards of the test +setup. The indices match the position of each FPGA in the mining rig. +-} +knownFpgaIdsVec :: Vec FpgaCount FpgaId +knownFpgaIdsVec = fst <$> fpgaSetup + +{- | The IDs of the Digilent chips on each of the FPGA boards of the test +setup. The indices match the position of each FPGA in the mining rig. +-} +knownFpgaIds :: [FpgaId] +knownFpgaIds = toList knownFpgaIdsVec + +allHwTargets :: [HwTargetRef] +allHwTargets = HwTargetById <$> knownFpgaIds + {- | Determines the link mask of a particular node. >>> import Data.Graph diff --git a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs index 12442e8bc..4939e59d9 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs @@ -64,8 +64,9 @@ module Bittide.Instances.Hitl.SyncInSyncOut where import Clash.Explicit.Prelude hiding (PeriodToCycles) import Bittide.Arithmetic.Time -import Bittide.Hitl (HitlTests, allFpgas, hitlVioBool, noConfigTest) +import Bittide.Hitl import Bittide.Instances.Domains +import Bittide.Instances.Hitl.Setup (allHwTargets) import Clash.Annotations.TH import Clash.Cores.Xilinx.Xpm.Cdc.Single @@ -156,5 +157,18 @@ syncInSyncOut sysClkDiff syncIn0 = syncOut makeTopEntity 'syncInSyncOut -tests :: HitlTests () -tests = noConfigTest "SyncInSyncOut" allFpgas +tests :: HitlTestGroup +tests = + HitlTestGroup + { topEntity = 'syncInSyncOut + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "SyncInSyncOut" + , parameters = paramForHwTargets allHwTargets () + , postProcData = () + } + ] + , mPostProc = Nothing + } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Tcl/ExtraProbes.hs b/bittide-instances/src/Bittide/Instances/Hitl/Tcl/ExtraProbes.hs deleted file mode 100644 index feb3cf230..000000000 --- a/bittide-instances/src/Bittide/Instances/Hitl/Tcl/ExtraProbes.hs +++ /dev/null @@ -1,59 +0,0 @@ --- SPDX-FileCopyrightText: 2024 Google LLC --- --- SPDX-License-Identifier: Apache-2.0 -module Bittide.Instances.Hitl.Tcl.ExtraProbes where - -import Clash.Prelude - -import Bittide.Instances.Domains -import Clash.Annotations.TH (makeTopEntity) -import Clash.Cores.Xilinx.Extra -import Clash.Cores.Xilinx.Unisim.DnaPortE2 (simDna2) -import Clash.Cores.Xilinx.VIO -import Data.Maybe - -{-# NOINLINE extraProbesTest #-} - -{- | A circuit that verifies the correct behavior of the TCL infrastructure for -setting extra probes in Hitl tests. --} -extraProbesTest :: - "CLK_125MHZ" ::: DiffClock Ext125 -> - "success" ::: Signal Ext125 Bool -extraProbesTest diffClk = testSuccess - where - clk = ibufds diffClk - - testSuccess = testResult <$> testState <*> extraProbe <*> fpgaId - testDone = testStart .&&. fmap isJust fpgaId - rst = unsafeFromActiveLow testStart - fpgaId = withClockResetEnable clk rst enableGen $ readDnaPortE2I simDna2 - (testStart, testState, extraProbe) = - unbundle - $ setName @"vioHitlt" - $ vioProbe - ("probe_test_done" :> "probe_test_success" :> "fpgaId" :> Nil) - ("probe_test_start" :> "testState" :> "extraProbe" :> Nil) - (False, SetDefaultProbes, maxBound) - clk - testDone - testSuccess - fpgaId - -{- | Produce the test result based on the test state and the extra probe value. -These values should correspond to the yaml configuration. --} -testResult :: TestState -> BitVector 96 -> Maybe (BitVector 96) -> Bool -testResult s extraProbe fpgaId = case (s, extraProbe) of - (SetDefaultProbes, 0) -> True - (SetTestProbes, 0xDEADABBA) -> True - (SetFpgaSpecificProbes, _) -> extraProbe == fromMaybe simDna2 fpgaId - _ -> False - -data TestState - = SetDefaultProbes -- Check if the default probes from the yaml file are set - | SetTestProbes -- Check if the test specific probe values are set - | SetFpgaSpecificProbes -- Check if the DNA device identifier is set - deriving (Generic, NFDataX) - -makeTopEntity 'extraProbesTest diff --git a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs index aebe310bf..e2b0d9b70 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs @@ -17,7 +17,13 @@ import Clash.Annotations.TH (makeTopEntity) import Clash.Xilinx.ClockGen (clockWizardDifferential) import Bittide.Arithmetic.Time (trueFor) -import Bittide.Hitl (HitlTests, allFpgas, hitlVioBool, noConfigTest) +import Bittide.Hitl ( + HitlTestCase (..), + HitlTestGroup (..), + hitlVioBool, + paramForHwTargets, + ) +import Bittide.Instances.Hitl.Setup (allHwTargets) import Bittide.Instances.Domains @@ -94,5 +100,18 @@ temperatureMonitor diffClk = temperatureIla `hwSeqX` bundle (testDone, testSucce makeTopEntity 'temperatureMonitor -tests :: HitlTests () -tests = noConfigTest "TemperatureMonitor" allFpgas +tests :: HitlTestGroup +tests = + HitlTestGroup + { topEntity = 'temperatureMonitor + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "TemperatureMonitor" + , parameters = paramForHwTargets allHwTargets () + , postProcData = () + } + ] + , mPostProc = Nothing + } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs b/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs index 72f9b9d78..b4d7dd738 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Tests.hs @@ -4,15 +4,22 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{- | Full definitions of HITL tests. For every test, this includes: + + 1. The fully qualified name of the function that is the top-level Clash + circuit. The test controller will compile, synthesize and implement this + and program the relevant hardware targets (FPGAs). + + 2. The HITL test configuration. See `Bittide.Hitl.HitlTestGroup`. +-} module Bittide.Instances.Hitl.Tests ( - HitlTest (..), + ClashTargetName, + HitlTestGroup (..), + HitlTestCase (..), hitlTests, ) where -import Bittide.Hitl (HitlTestsWithPostProcData, MayHavePostProcData) -import Bittide.Simulate.Config (CcConf) -import Clash.Prelude (BitPack, FilePath, String, show) -import Data.Aeson (ToJSON) +import Bittide.Hitl (ClashTargetName, HitlTestCase (..), HitlTestGroup (..)) import qualified Bittide.Instances.Hitl.BoardTest as BoardTest import qualified Bittide.Instances.Hitl.FincFdec as FincFdec @@ -21,45 +28,22 @@ import qualified Bittide.Instances.Hitl.FullMeshSwCc as FullMeshSwCc import qualified Bittide.Instances.Hitl.HwCcTopologies as HwCcTopologies import qualified Bittide.Instances.Hitl.LinkConfiguration as LinkConfiguration import qualified Bittide.Instances.Hitl.SyncInSyncOut as SyncInSyncOut -import qualified Bittide.Instances.Hitl.Tcl.ExtraProbes as ExtraProbes import qualified Bittide.Instances.Hitl.TemperatureMonitor as TemperatureMonitor import qualified Bittide.Instances.Hitl.Transceivers as Transceivers import qualified Bittide.Instances.Hitl.VexRiscv as VexRiscv --- | Existential wrapper for tests with known Haskell types. -data HitlTest where - -- | Tests with known Haskell types. - KnownType :: - forall a b. - (BitPack a, ToJSON b, MayHavePostProcData b CcConf) => - String -> - (HitlTestsWithPostProcData a b) -> - HitlTest - -- | Load config from 'bittide-instances/data/test_configs' - LoadConfig :: - String -> - FilePath -> - HitlTest - --- | Available HITL tests. -hitlTests :: [HitlTest] +hitlTests :: [HitlTestGroup] hitlTests = - [ -- tests with known Haskell types - knownType 'BoardTest.boardTestExtended BoardTest.testsExtended - , knownType 'BoardTest.boardTestSimple BoardTest.testsSimple - , knownType 'FincFdec.fincFdecTests FincFdec.tests - , knownType 'FullMeshHwCc.fullMeshHwCcTest FullMeshHwCc.tests - , knownType 'FullMeshHwCc.fullMeshHwCcWithRiscvTest FullMeshHwCc.tests - , knownType 'FullMeshSwCc.fullMeshSwCcTest FullMeshSwCc.tests - , knownType 'HwCcTopologies.hwCcTopologyTest HwCcTopologies.tests - , knownType 'LinkConfiguration.linkConfigurationTest LinkConfiguration.tests - , knownType 'SyncInSyncOut.syncInSyncOut SyncInSyncOut.tests - , knownType 'TemperatureMonitor.temperatureMonitor TemperatureMonitor.tests - , knownType 'Transceivers.transceiversUpTest Transceivers.tests - , knownType 'VexRiscv.vexRiscvTest VexRiscv.tests - , -- tests that are loaded from config files - loadConfig 'ExtraProbes.extraProbesTest "extraProbesTest.yml" + [ BoardTest.testSimple + , BoardTest.testExtended + , FincFdec.tests + , FullMeshHwCc.fullMeshHwCcTest' + , FullMeshHwCc.fullMeshHwCcWithRiscvTest' + , FullMeshSwCc.tests + , HwCcTopologies.tests + , LinkConfiguration.tests + , TemperatureMonitor.tests + , SyncInSyncOut.tests + , Transceivers.tests + , VexRiscv.tests ] - where - knownType nm = KnownType (show nm) - loadConfig nm = LoadConfig (show nm) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs index e54547200..c3bfcfacd 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs @@ -5,7 +5,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} {- | Test whether clock boards are configurable and transceiver links come @@ -30,7 +29,7 @@ import Bittide.Arithmetic.Time import Bittide.ClockControl.Si5395J import Bittide.ClockControl.Si539xSpi import Bittide.ElasticBuffer (sticky) -import Bittide.Hitl (FpgaIndex, HitlTests, NoPostProcData (..), hitlVio) +import Bittide.Hitl import Bittide.Instances.Domains import Bittide.Instances.Hitl.Setup import Bittide.Transceiver @@ -45,7 +44,6 @@ import qualified Bittide.Transceiver.ResetManager as ResetManager import qualified Clash.Explicit.Prelude as E import qualified Data.List as L import qualified Data.Map as Map -import qualified Data.Text as Text {- | Start value of the counters used in 'counter' and 'expectCounter'. This is a non-zero start value, as a regression test for a bug where the transceivers @@ -83,7 +81,7 @@ expectCounter clk rst = sticky clk rst . mealy clk rst enableGen go counterStart information. -} goTransceiversUpTest :: - Signal Basic125 FpgaIndex -> + Signal Basic125 (Index FpgaCount) -> "SMA_MGT_REFCLK_C" ::: Clock Ext200 -> "SYSCLK" ::: Clock Basic125 -> "RST_LOCAL" ::: Reset Basic125 -> @@ -214,7 +212,7 @@ transceiversUpTest refClkDiff sysClkDiff syncIn rxns rxps miso = startTest = isJust <$> maybeFpgaIndex fpgaIndex = fromMaybe 0 <$> maybeFpgaIndex - maybeFpgaIndex :: Signal Basic125 (Maybe FpgaIndex) + maybeFpgaIndex :: Signal Basic125 (Maybe (Index FpgaCount)) maybeFpgaIndex = hitlVio 0 @@ -228,10 +226,25 @@ transceiversUpTest refClkDiff sysClkDiff syncIn rxns rxps miso = makeTopEntity 'transceiversUpTest -tests :: HitlTests FpgaIndex -tests = Map.fromList testsAsList +tests :: HitlTestGroup +tests = + HitlTestGroup + { topEntity = 'transceiversUpTest + , externalHdl = [] + , extraXdcFiles = [] + , testCases = iters + , mPostProc = Nothing + } where - fpgaIndices = [0 ..] - nTests = 1 - testNames = ["T" <> Text.pack (show n) | n <- [(0 :: Int) .. nTests - 1]] - testsAsList = [(nm, (L.zip fpgaIndices fpgaIndices, NoPostProcData)) | nm <- testNames] + fpgaIndices = [0 ..] :: [Index FpgaCount] + nIters = 1 + iterNames = ["I" <> show n | n <- [(0 :: Int) .. nIters - 1]] + iters = + [ HitlTestCase + { name = nm + , parameters = + Map.fromList (L.zip (HwTargetByIndex . fromIntegral <$> fpgaIndices) fpgaIndices) + , postProcData = () + } + | nm <- iterNames + ] diff --git a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs index fa383b51b..0e5ae49a4 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs @@ -22,7 +22,7 @@ import Protocols.Wishbone import VexRiscv import Bittide.DoubleBufferedRam -import Bittide.Hitl (HitlTests, allFpgas, hitlVioBool, noConfigTest) +import Bittide.Hitl import Bittide.Instances.Domains (Basic125, Ext125) import Bittide.ProcessingElement import Bittide.SharedTypes @@ -149,5 +149,18 @@ vexRiscvTest diffClk jtagIn uartRx = (testDone, testSuccess, jtagOut, uartTx) {-# NOINLINE vexRiscvTest #-} makeTopEntity 'vexRiscvTest -tests :: HitlTests () -tests = noConfigTest "VexRiscV" allFpgas +tests :: HitlTestGroup +tests = + HitlTestGroup + { topEntity = 'vexRiscvTest + , extraXdcFiles = ["jtag_config.xdc", "jtag_pmod1.xdc"] + , externalHdl = [] + , testCases = + [ HitlTestCase + { name = "VexRiscV" + , parameters = paramForSingleTarget (HwTargetByIndex 7) () + , postProcData = () + } + ] + , mPostProc = Just "post-vex-riscv-test" + } diff --git a/bittide-shake/README.md b/bittide-shake/README.md index 4999b2fa7..f1495cd75 100644 --- a/bittide-shake/README.md +++ b/bittide-shake/README.md @@ -24,7 +24,7 @@ Different build levels: * If neither is set, instances are synthesized for `SYNTHESIS_PART=xcku035-ffva1156-2-e`, which is the smaller cousin of the FPGA we've bought, but which comes with a free license. * Only targets which have the flag `targetHasXdc` can be used to generate a bitstream. This XDC file must have the same name as the instance, and be located in the `data/constraints/` directory. * For targets which have the flag `targetHasVio`, a probes file is generated alongside the bitstream. -* Only targets which have the flag `targetHasTest` can be used to perform hardware tests. +* Only targets which have a `targetTest` value can be used to perform hardware tests. ## Shake @@ -81,19 +81,19 @@ shake boardTestExtended:bitstream Example: ``` -shake boardTestExtended:program --hardware-targets=OneAny +shake boardTestExtended:program ``` -## Hardware testing +## Hardware testing and (if available) ILA data post processing Example: ``` -shake boardTestExtended:test --hardware-targets=OneAny +shake boardTestExtended:test ``` ## ILA data post processing Example: ``` -shake boardTestExtended:post-process --hardware-targets=OneAny +shake boardTestExtended:post-process ``` diff --git a/bittide-shake/bittide-shake.cabal b/bittide-shake/bittide-shake.cabal index ac1d3f6b4..3896f6514 100644 --- a/bittide-shake/bittide-shake.cabal +++ b/bittide-shake/bittide-shake.cabal @@ -20,15 +20,20 @@ common common-options aeson, base, base16-bytestring, + bittide-experiments, + bittide-instances, bytestring, clash-lib, clash-prelude, + clock, + containers, cryptohash-sha256, directory, extra, filepath, shake, string-interpolate, + template-haskell, text, vector, vivado-hs, @@ -77,6 +82,7 @@ executable shake build-depends: Glob, ansi-terminal, + bittide-experiments, bittide-shake, directory, process, diff --git a/bittide-shake/data/tcl/HardwareTest.tcl b/bittide-shake/data/tcl/HardwareTest.tcl deleted file mode 100644 index ceb2eedd4..000000000 --- a/bittide-shake/data/tcl/HardwareTest.tcl +++ /dev/null @@ -1,809 +0,0 @@ -# SPDX-FileCopyrightText: 2023 Google LLC -# -# SPDX-License-Identifier: Apache-2.0 - -# Tools to run hardware-in-the-loop (HITL) tests. Most users should consider -# `runTestGroup` as the main entry point. This function runs a group of tests -# according to a test configuration file. The test configuration file is defined -# in YAML, and looks like the following: -# -# ```yaml -# defaults: -# probes: -# $probe1: 0 -# $probe2: 0 -# -# tests: -# $test_name: -# probes: -# $probe1: 1 -# $probe2: 0xDEADABBA -# -# targets: -# - target: { index: $fpga_index } -# probes: -# $probe1: 1 -# $probe2: 0xDEADABBA -# ``` -# -# The `defaults` section contains default values for the probes. The `tests` -# section contains a list of tests, each with a list of targets and a list of -# probes. The `targets` section contains a list of targets, each with an index -# that corresponds to the index of the FPGA in the demo rig. Note that the defaults -# can be overridden by the test specific values, and the test specific values can -# be overridden by the target specific values. -# -# In the example posted above, the strings prefixed by a dollar sign are meant to -# illustrate that these are arbitrary values to be set by the user. For example, -# `$test_name` could be `test1`, and `$probe2` could be `device_id`. -# -# TODO: Allow the user to specify the timeout for the test. -# -# TODO: Allow multiple ways of specifying FPGA targets. E.g., device ID. - -package require yaml - -# The IDs of the Digilent chips on each FPGA board. The indices match the -# position of each FPGA in the mining rig. -set fpga_ids { - 210308B3B272 - 210308B0992E - 210308B0AE73 - 210308B0AE6D - 210308B0AFD4 - 210308B0AE65 - 210308B3A22D - 210308B0B0C2 -} - -# Timeout specifying how long we should wait for a test to finish before -# considering it a failed test. -set test_timeout_ms 60000 - -# Timeout specifying how long to wait for hardware targets (FPGAs) to become -# available in the hardware server. -set hw_server_timeout_ms 5000 - -# Prefix of the name of a VIO probe. -set vio_prefix {} - -# The VIO probes used for hardware-in-the-loop tests (hitlt) must end their -# prefix with 'vioHitlt'. For example, a probe named 'my_vio_vioHitlt/probe_test_done' -# has the prefix 'my_vio_vioHitlt'. Throws an error when not exactly 1 VIO core -# is present. -proc set_vio_prefix {} { - global vio_prefix - - # Use `probe_test_done` as the probe to find full probe names - set probe_done [get_hw_probes *vioHitlt/probe_test_done] - if {[llength $probe_done] != 1} { - error {Exactly 1 VIO core with the prefix '*vioHitlt' must be present} - } - set vio_prefix [lindex [split [get_property name $probe_done] /] 0] -} -proc get_extra_probes {} { - global vio_prefix - set vio_probes [get_hw_probes $vio_prefix/*] - set extra_probes [] - foreach probe $vio_probes { - set is_done [string equal $probe $vio_prefix/probe_test_done] - set is_success [string equal $probe $vio_prefix/probe_test_success] - set is_start [string equal $probe $vio_prefix/probe_test_start] - set is_input [string equal [get_property type $probe] vio_input] - if {!$is_done && !$is_success && !$is_start && !$is_input} { - lappend extra_probes $probe - } - } - return $extra_probes -} - -# Besides the required probes, the design may contain extra VIO probes. This -# function receives the test config and verifies exclusively all probes in the 'defaults' -# section are present in the design. -proc verify_extra_vio_probes {test_config} { - puts -nonewline {Verifying extra probes: } - global vio_prefix - set probe_names [dict keys [dict get $test_config defaults probes]] - set extra_probes [get_extra_probes] - foreach probe_name $probe_names { - set index [lsearch -exact $extra_probes $vio_prefix/$probe_name] - if {$index != -1} { - set extra_probes [lreplace $extra_probes $index $index] - } - } - if {[llength $extra_probes] == 0} { - puts Done - } else { - puts Failed - set err_msg "There are unmatched extra probes:\n" - foreach probe $extra_probes { - append err_msg $probe \n - } - append err_msg {Existing probes:} \n - foreach probe_name $probe_names { - append err_msg $probe_name \n - } - error $err_msg - } -} -# For the Hardware-in-the-Loop test (hitlt) at least 3 specific probes need to -# be present in the design: -# - `probe_test_done` indicates when a single test is done -# - `probe_test_success` indicates whether a single test was successful -# - `probe_test_start*` indicate the start of a specific test -# Other VIO probes may be present in the design, but are only used to print -# debug information when a test fails. -proc verify_required_vio_probes {} { - puts -nonewline {Verifying required VIO probes: } - global vio_prefix - - set done_probe [get_hw_probes $vio_prefix/probe_test_done] - set done_probe_count [llength $done_probe] - if {$done_probe_count != 1} { - set err_msg "Exactly one probe named '$vio_prefix/probe_test_done' " - append err_msg "must be present, but $done_probe_count were found" \n \ - [all_probe_names_msg] - error $err_msg - } elseif {[get_property type $done_probe] ne {vio_input}} { - set probe_name [get_property name.short $done_probe] - set err_msg "Probe '$probe_name' must have type 'vio_input'\n" - append err_msg [all_probe_names_msg] - error $err_msg - } elseif {[get_property width $done_probe] != 1} { - set probe_name [get_property name.short $done_probe] - set err_msg "Probe '$probe_name' must have a width of 1 bit\n" - append err_msg [all_probe_names_msg] - error $err_msg - } - - set success_probe [get_hw_probes $vio_prefix/probe_test_success] - set success_probe_count [llength $success_probe] - if {$success_probe_count != 1} { - set err_msg "Exactly one probe named '$vio_prefix/probe_test_success' " - append err_msg "must be present, but $success_probe_count were found" \ - \n [all_probe_names_msg] - error $err_msg - } - if {[get_property type $success_probe] ne {vio_input}} { - set probe_name [get_property name.short $success_probe] - set err_msg "Probe '$probe_name' must have type 'vio_input'\n" - append err_msg [all_probe_names_msg] - error $err_msg - } elseif {[get_property width $success_probe] != 1} { - set probe_name [get_property name.short $success_probe] - set err_msg "Probe '$probe_name' must have a width of 1 bit\n" - append err_msg [all_probe_names_msg] - error $err_msg - } - - set start_probe [get_hw_probes $vio_prefix/probe_test_start] - set start_probe_count [llength $start_probe] - if {$start_probe_count != 1} { - set err_msg "Exactly one probe named '$vio_prefix/probe_test_start' " - append err_msg "must be present, but $start_probe_count were found" \ - [all_probe_names_msg] - error $err_msg - } - if {[get_property type $start_probe] ne {vio_output}} { - set probe_name [get_property name.short $start_probe] - set err_msg "Probe '$probe_name' must have type 'vio_output'\n" - append err_msg [all_probe_names_msg] - error $err_msg - } elseif {[get_property width $start_probe] != 1} { - set probe_name [get_property name.short $start_probe] - set err_msg "Probe '$probe_name' must have a width of 1 bit\n" - append err_msg [all_probe_names_msg] - error $err_msg - } - puts Done -} - -# Create a list of dictionaries where each dictionary corresponds to one ILA. -# Each dictionary has the following keys: -# name : short name of the ILA -# cell_name : name of the cell the ILA is in -# trigger_probe : name of the trigger probe -# capture_probe : name of the capture probe -# data_probes : list of names of all other probes -proc get_ila_dicts {} { - set ila_dicts {} - - set hw_ilas [get_hw_ilas -quiet] - set ila_count [llength $hw_ilas] - if {$ila_count == 0} { - puts "\nNo ILAs in design" - return {} - } - - puts "\nFound $ila_count ILAs:" - foreach hw_ila $hw_ilas { - set ila_dict {} - - # The short name is the name of the module the ILA is in. For example a - # cell named `fullMeshSwCcTest/ilaPlot/ila_inst` will give the short - # name `ilaPlot`. - set cell_name [get_property CELL_NAME $hw_ila] - set before_last [expr [string last / $cell_name] - 1] - set module_name [string range $cell_name 0 $before_last] - set after_second_to_last [expr [string last / $module_name] + 1] - set short_name [string range $cell_name $after_second_to_last $before_last] - dict set ila_dict name $short_name - dict set ila_dict cell_name $cell_name - - # Get trigger probe and verify it conforms with ILA framework - set trigger_probe [get_hw_probes -of_objects $hw_ila */trigger*] - set trigger_probe_count [llength $trigger_probe] - if {$trigger_probe_count != 1} { - set err_msg "Exactly one probe named 'trigger*' must be present, " - append err_msg "but $trigger_probe_count were found" \n \ - [all_probe_names_msg] - error $err_msg - } elseif {[get_property is_trigger $trigger_probe] != 1} { - set probe_name_short [get_property name.short $trigger_probe] - set err_msg "Probe '$probe_name_short' should have probeType " - append err_msg {Trigger or DataAndTrigger} \n [all_probe_names_msg] - error $err_msg - } elseif {[get_property width $trigger_probe] != 1} { - set probe_name_short [get_property name.short $trigger_probe] - set err_msg "Probe '$probe_name_short' must have a width of 1 bit\n" - append err_msg [all_probe_names_msg] - error $err_msg - } else { - dict set ila_dict trigger_probe [get_property name $trigger_probe] - } - - # Get capture probe and verify it conforms with ILA framework - set capture_probe [get_hw_probes -of_objects $hw_ila */capture*] - set capture_probe_count [llength $capture_probe] - if {$capture_probe_count != 1} { - set err_msg {Exactly one probe named 'capture*' must be present, } - append err_msg "but $capture_probe_count were found" \n \ - [all_probe_names_msg] - error $err_msg - } elseif {[get_property is_trigger $capture_probe] != 1} { - set probe_name_short [get_property name.short $capture_probe] - set err_msg "Probe '$probe_name_short' should have probeType " - append err_msg {Trigger or DataAndTrigger} \n [all_probe_names_msg] - error $err_msg - } elseif {[get_property width $capture_probe] != 1} { - set probe_name_short [get_property name.short $capture_probe] - set err_msg "Probe '$probe_name_short' must have a width of 1 bit\n" - append err_msg [all_probe_names_msg] - error $err_msg - } else { - dict set ila_dict capture_probe [get_property name $capture_probe] - } - - # Get all data probes and verify each conforms with ILA framework - set all_probes [get_hw_probes -of_objects $hw_ila] - if {[llength $all_probes] < 3} { - set err_msg "ILA '$short_name' has no data probes, at least 1 " - append err_msg {data probe is required} \n [all_probe_names_msg] - error $err_msg - } - dict set ila_dict data_probes [list] - foreach probe $all_probes { - if {$probe eq $trigger_probe || $probe eq $capture_probe} { - continue - } elseif {[get_property is_data $probe] != 1} { - set probe_name_short [get_property name.short $probe] - set err_msg "Probe '$probe_name_short' should have probeType " - append err_msg {Data or DataAndTrigger} \n [all_probe_names_msg] - error $err_msg - } else { - dict update ila_dict data_probes probe_list { - lappend probe_list [get_property name $probe] - } - } - } - lappend ila_dicts $ila_dict - - # Print all ILA probes - puts "ILA $short_name with probes:" - set probe_name_short [get_property name.short $trigger_probe] - puts "\t$probe_name_short" - set probe_name_short [get_property name.short $capture_probe] - puts "\t$probe_name_short" - foreach probe_name [dict get $ila_dict data_probes] { - set idx_start [expr {[string first / $probe_name] + 1}] - set probe_name_short [string range $probe_name $idx_start end] - puts "\t$probe_name_short" - } - } - return $ila_dicts -} - -proc all_probe_names_msg {} { - set probes [get_hw_probes] - set msg "All probes in design:\n" - foreach probe $probes { - append msg \t [get_property name $probe] \n - } - return msg -} - -proc get_part_name {url id} { - return $url/xilinx_tcf/Digilent/$id -} - -# Creates an ordered dictionary which maps indices of FPGAs in the demo rack to -# their respecive FPGA IDs. If an empty list of fpga_nrs is given, the FPGA ID -# of the first hardware target is given (this can be any FPGA). -proc get_target_dict {url fpga_nrs} { - global fpga_ids - set target_dict [dict create] - if {[llength $fpga_nrs] == 0} { - set fpga_nrs -1 - } - foreach fpga_nr $fpga_nrs { - if {$fpga_nr == -1} { - set target_name [lindex [get_hw_targets] 0] - set target_id [lindex [split $target_name /] 3] - } else { - set target_id [lindex $fpga_ids $fpga_nr] - } - dict set target_dict $fpga_nr $target_id - } - return $target_dict -} - - -# Build a string that shows all VIOs in the radix they are set. A current -# hardware device must be set before calling this function. Probes are grouped -# by VIO. -proc all_vios_msg {} { - set probes [get_hw_probes -of_objects [get_hw_vios]] - - # Find the maximum widths of each column, with a minimum of the header length - set w_name 4 - set w_value 5 - set w_radix 5 - foreach probe $probes { - set type [get_property type $probe] - set w_name_cur [string length [get_property name.short $probe]] - if {$type eq {vio_input}} { - set w_value_cur [string length [get_property input_value $probe]] - set w_radix_cur [string length [get_property input_value_radix $probe]] - } else { - set w_value_cur [string length [get_property output_value $probe]] - set w_radix_cur [string length [get_property output_value_radix $probe]] - } - set w_name [expr {max($w_name, $w_name_cur)}] - set w_value [expr {max($w_value, $w_value_cur)}] - set w_radix [expr {max($w_radix, $w_radix_cur)}] - } - - set msg "Printing all probes\n" - set sep +-[string repeat - $w_name]-+-[string repeat - $w_value]-+-[\ - string repeat - $w_radix]-+ - set hdr [format {| %-*s | %-*s | %-*s |} $w_name Name $w_value Value \ - $w_radix Radix] - append msg $sep \n $hdr \n $sep \n - - foreach vio [get_hw_vios] { - set input_probes [get_hw_probes -of_objects $vio -filter {type == vio_input} -quiet] - foreach input_probe $input_probes { - set name [get_property name.short $input_probe] - set value [get_property input_value $input_probe] - set radix [get_property input_value_radix $input_probe] - set row [format {| %-*s | %*s | %-*s |} $w_name $name $w_value \ - $value $w_radix $radix] - append msg $row \n - } - append msg $sep \n - - set output_probes [get_hw_probes -of_objects $vio -filter {type == vio_output} -quiet] - foreach output_probe $output_probes { - set name [get_property name.short $output_probe] - set value [get_property output_value $output_probe] - set radix [get_property output_value_radix $output_probe] - set row [format {| %-*s | %*s | %-*s |} $w_name $name $w_value \ - $value $w_radix $radix] - append msg $row \n - } - append msg $sep \n - } - return $msg -} - -# Return all values in lista, which are not listb. -proc difference {lista listb} { - set A {} - foreach a $lista { - dict set A $a 0 - } - foreach b $listb { - dict unset A $b - } - return [dict keys $A] -} - -# Return the intersection of two lists. Note that this functions complexity is -# O(n^2), and should not be used for big lists. -proc intersection {lista listb} { - set intersect {} - foreach a $lista { - if {$a in $listb} { - lappend intersect $a - } - } - return $intersect -} - -# Checks whether the expected hardware targets are connected, if not exit. -proc has_expected_targets {url expected_target_dict} { - set expected_names {} - dict for {nr id} $expected_target_dict { - lappend expected_names [get_part_name $url $id] - } - set expected_count [dict size $expected_target_dict] - - set start_time [clock milliseconds] - set i 0 - while 1 { - # Check if expected hardware targets are connected - set hw_targets [get_hw_targets -quiet] - set hw_target_count [llength $hw_targets] - set found_targets [intersection $expected_names $hw_targets] - set found_targets_count [llength $found_targets] - if {$found_targets_count == $expected_count} { - puts "Hardware server at $url hosts $hw_target_count hardware targets:" - foreach hw_target $hw_targets { - puts "\t$hw_target" - } - puts {} - break - } - - # Timeout if test takes longer than `hw_server_timeout_ms` - global hw_server_timeout_ms - set current_time [clock milliseconds] - set time_spent [expr {$current_time - $start_time}] - if {$time_spent > $hw_server_timeout_ms} { - set err_msg "Expected hardware targets:\n" - dict for {nr id} $expected_target_dict { - set tgt [get_part_name $url $id] - append err_msg "$tgt - FPGA $nr" - if {[lsearch -exact $hw_targets $tgt] == -1} { - append err_msg { <- not found} - } - append err_msg \n - } - set unexpected_targets [difference $hw_targets $expected_names] - if {[llength $unexpected_targets] > 0} { - append err_msg "Hardware targets which are not expected:\n" - foreach tgt $unexpected_targets { - append err_msg $tgt \n - } - } - error $err_msg - } - - puts "Attempt $i : Found $found_targets_count out of expected $expected_count hardware targets" - incr i - after 500 - refresh_hw_server - } -} - -# Set the target board as the current hardware target and return its device -proc load_target_device {target_name} { - if {$target_name ne [get_property NAME [current_hw_target]]} { - close_hw_target - current_hw_target [get_hw_targets $target_name] - } - open_hw_target [current_hw_target] - current_hw_device [lindex [get_hw_devices] 0] - set device [current_hw_device] - return $device -} - -# Format a time given in millseconds to a human-readable string -proc format_time {time_ms} { - return [format %s.%03d \ - [clock format [expr {$time_ms / 1000}] -format %T] \ - [expr {$time_ms % 1000}] \ - ] -} - -# Program the current hardware device with the given program and probes file. -proc program_fpga {program_file probes_file} { - set device [current_hw_device] - set_property PROGRAM.FILE $program_file $device - set_property PROBES.FILE $probes_file $device - # Program the device and close properly - program_hw_devices $device - refresh_hw_device $device -} - -# Verify that `done` is not set before starting the test -proc verify_before_start {} { - global vio_prefix - refresh_hw_vio [get_hw_vios] - set done [get_property INPUT_VALUE [get_hw_probes $vio_prefix/probe_test_done]] - if {$done != 0} { - set err_msg "\tERROR: test is done before starting the test\n" - append err_msg [all_vios_msg] - error $err_msg - } -} - -# Refresh the input probes until the done flag is set. Retries for up to -# `test_timeout_ms` milliseconds, counting from a given `start_time`. -proc wait_test_end {start_time} { - global vio_prefix - while 1 { - # Check test status, break if test is done - refresh_hw_vio [get_hw_vios] - set done [get_property INPUT_VALUE [get_hw_probes $vio_prefix/probe_test_done]] - set success [get_property INPUT_VALUE [get_hw_probes $vio_prefix/probe_test_success]] - if {$done == 1} { - break - } - - # Timeout if test takes longer than `test_timeout_ms` - global test_timeout_ms - set current_time [clock milliseconds] - set time_spent [expr {$current_time - $start_time}] - if {$time_spent > $test_timeout_ms} { - break - } - } - set end_time [clock milliseconds] - return [list $done $success $start_time $end_time] -} - -# Print test results. Prints all VIO probes when a test fails -proc print_test_results {done success start_time end_time} { - if {$done == 0} { - global test_timeout_ms - puts "\tTest timeout: done flag not set after ${test_timeout_ms} ms" - set timestamp_start [format_time $start_time] - puts "\tStarted test: $timestamp_start" - set timestamp_end [format_time $end_time] - puts "\tEnded test: $timestamp_end" - puts [all_vios_msg] - } elseif {$success == 0} { - puts "\tTest failed" - puts [all_vios_msg] - } else { - puts "\tTest passed" - } -} - -# Get the test names from the test config file. -# The test names are the keys of the tests dictionary in the yaml file, exluding -# the 'defaults' key, which is used for default values. -proc get_test_names {test_config} { - global vio_prefix - set tests [dict get $test_config tests] - set test_names [dict keys $tests] - set test_names [lsearch -all -inline -not -exact $test_names defaults] - return $test_names -} - -# Receives the test config, the index of the currently active FPGA and current test name. -# It sets the extra probes defined in the test config for the specified test and FPGA. -proc set_extra_probes {yaml_dict fpga_index test_name} { - puts -nonewline "Setting extra probes for test: $test_name, fpga: $fpga_index: " - global fpga_ids - global vio_prefix - set defaults_dict [dict get $yaml_dict defaults] - - set probe_dicts [] - - # Add the default probes to the list of probe_dicts - if {[dict exists $defaults_dict probes]} { - lappend probe_dicts [dict get $defaults_dict probes] - } - - # Add test specific probes - set test_dict [dict get $yaml_dict tests $test_name] - if {[dict exists $test_dict probes]} { - lappend probe_dicts [dict get $test_dict probes] - } - - # Add FPGA specific probes - if {[dict exists $test_dict targets]} { - set target_list [dict get $test_dict targets] - foreach target $target_list { - if {[dict get $target target index] == $fpga_index} { - if {[dict exists $target probes]} { - lappend probe_dicts [dict get $target probes] - } - } - } - } - - # For each probe dictionary, set the probes - set changed_vios [] - foreach probe_dict $probe_dicts { - dict for {vio_name vio_value} $probe_dict { - set probe [get_hw_probes $vio_prefix/$vio_name] - if {[lsearch -exact $changed_vios $probe] } { - lappend changed_vios $probe - } - set bit_width [get_property width $probe] - set hex_width [expr {(3 + $bit_width)/4}] - set vio_value [format %0${hex_width}llX $vio_value] - puts "Setting $vio_name to $vio_value" - set_property OUTPUT_VALUE $vio_value $probe - } - } - - # Commit the probes if any were set - if {[llength $changed_vios] == 0} { - puts {No extra probes to set} - } else { - puts Done - commit_hw_vio $changed_vios - foreach vio $changed_vios { - puts "Set [get_property name.short $vio] to [get_property output_value $vio]" - } - } -} - -# Run a group of tests according to a test configuration file. See module documentation. -# -# Arguments: -# -# probes_file: The path to the probes file - an LTX file produced by Vivado. -# -# test_config_path: -# The path to the test configuration file, see the module documentation for -# more information. -# -# target_dict: -# An ordered dictionary which maps indices of FPGAs in the demo rack to -# their FPGA device IDs. -# -# url: The URL of the hardware server. -# -# ila_data_dir: The directory where the ILA data will be stored. -# -proc run_test_group {probes_file test_config_path target_dict url ila_data_dir} { - # Load the device of the first target - set target_id [lindex [dict values $target_dict] 0] - set target_name [get_part_name $url $target_id] - set device [load_target_device $target_name] - set_property PROBES.FILE $probes_file $device - refresh_hw_device $device - - # Set the prefix of VIO probes and verify all required probes are present. - set_vio_prefix - verify_required_vio_probes - global vio_prefix - set test_config [yaml::yaml2dict -file $test_config_path] - verify_extra_vio_probes $test_config - set ila_dicts [get_ila_dicts] - set successful_tests 0 - set target_count [dict size $target_dict] - - # Get all the test names - set test_names [get_test_names $test_config] - set test_count [llength $test_names] - puts "\nFound $test_count tests:" - foreach test_name $test_names { - puts "\t$test_name" - set last_test $test_name - } - - foreach test_name $test_names { - set successful_targets 0 - puts "\nRunning test: $test_name" - - # Verify pre-start condition and start test - dict for {target_nr target_id} $target_dict { - - # Load device - set device [load_target_device [get_part_name $url $target_id]] - set_property PROBES.FILE $probes_file $device - refresh_hw_device $device -quiet - - # Reset all start probes and check if done is not set. - set start_probe [get_hw_probes $vio_prefix/probe_test_start] - set_property OUTPUT_VALUE 0 $start_probe - commit_hw_vio [get_hw_vios] - verify_before_start - set_extra_probes $test_config $target_nr $test_name - - # Activate the trigger for each ILA - foreach ila_dict $ila_dicts { - set cell_name [dict get $ila_dict cell_name] - set ila [get_hw_ilas -filter CELL_NAME=={$cell_name}] - # Set trigger probe (active high boolean) - set trigger_probe [get_hw_probes [dict get $ila_dict trigger_probe]] - set_property trigger_compare_value eq1'b1 $trigger_probe - - # Enable capture control and set capture probe (active high boolean) - set_property control.capture_mode BASIC $ila - set capture_probe [get_hw_probes [dict get $ila_dict capture_probe]] - set_property capture_compare_value eq1'b1 $capture_probe - - # Set the trigger position - set_property control.trigger_position 0 $ila - - run_hw_ila $ila - } - - # Start the test - set_property OUTPUT_VALUE 1 $start_probe - commit_hw_vio [get_hw_vios] - - puts "Start test for FPGA $target_nr with ID $target_id" - } - - puts "\nWaiting on test end: $test_name" - set start_time [clock milliseconds] - dict for {target_nr target_id} $target_dict { - # Load device - set device [load_target_device [get_part_name $url $target_id]] - set_property PROBES.FILE $probes_file $device - refresh_hw_device $device -quiet - - # Wait for the test to end - set test_results [wait_test_end $start_time] - lassign $test_results done success start_time end_time - - # Print test results of this FPGA - puts "\tTested for FPGA $target_nr with ID $target_id" - print_test_results $done $success $start_time $end_time - if {$done == 1 && $success == 1} { - incr successful_targets - } - } - - puts "\nStopping test: $test_name" - dict for {target_nr target_id} $target_dict { - # Load device - set device [load_target_device [get_part_name $url $target_id]] - set_property PROBES.FILE $probes_file $device - refresh_hw_device $device -quiet - - # Load the ILA data from the FPGA - foreach ila_dict $ila_dicts { - # Create the directory, if it does not exist already - if {$target_nr < 0} { - set index_id "X_$target_id" - } else { - set index_id "${target_nr}_$target_id" - } - set dir [file join $ila_data_dir $test_name $index_id] - file mkdir $dir - set ila_name [dict get $ila_dict name] - set file_path [file join $dir $ila_name] - - set cell_name [dict get $ila_dict cell_name] - set ila [get_hw_ilas -filter CELL_NAME=={$cell_name}] - - set ila_data [upload_hw_ila_data $ila] - # Legacy CSV excludes radix information - write_hw_ila_data -force -legacy_csv_file $file_path $ila_data - write_hw_ila_data -force -vcd_file $file_path $ila_data - } - - # Reset all start probes - if {$test_name != $last_test} { - set start_probe [get_hw_probes $vio_prefix/probe_test_start] - set_property OUTPUT_VALUE 0 $start_probe - commit_hw_vio [get_hw_vios] - } - } - # Print summary of individual test - puts "\nTest $test_name passed on $successful_targets out of $target_count targets" - if {$successful_targets == $target_count} { - incr successful_tests - } - } - - # Print summary of all tests - if {$successful_tests == $test_count} { - puts "\nAll $successful_tests tests passed on $target_count targets" - puts [all_vios_msg] - exit 0 - } else { - set failed_tests [expr {$test_count - $successful_tests}] - puts "\nFailed for $failed_tests/$test_count tests" - exit 1 - } -} diff --git a/bittide-shake/exe/Main.hs b/bittide-shake/exe/Main.hs index 2973b6808..614e1ad01 100644 --- a/bittide-shake/exe/Main.hs +++ b/bittide-shake/exe/Main.hs @@ -16,18 +16,22 @@ module Main where import Prelude +import Bittide.Hitl (HitlTestGroup (..), hwTargetRefsFromHitlTestGroup) +import Bittide.Instances.Hitl.Tests (ClashTargetName, hitlTests) +import Clash.DataFiles (tclConnector) import Clash.Shake.Extra import Clash.Shake.Flags import Clash.Shake.Vivado import Control.Monad (forM_, unless, when) -import Control.Monad.Extra (ifM, unlessM) +import Control.Monad.Extra (ifM, unlessM, (&&^)) import Data.Foldable (for_) import Data.Function ((&)) import Data.List (isPrefixOf, sort, uncons) -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromJust, fromMaybe, isJust) import Development.Shake import Development.Shake.Classes import GHC.Stack (HasCallStack) +import Language.Haskell.TH.Syntax (mkName) import System.Console.ANSI (setSGR) import System.Directory hiding (doesFileExist) import System.Exit (ExitCode (..), exitWith) @@ -99,9 +103,9 @@ watchFilesPath = buildDir "watch_files.txt" -- | Build and run the executable for post processing of ILA data doPostProcessing :: String -> FilePath -> ExitCode -> Assertion -doPostProcessing postProcessMain ilaDir testExitCode = do +doPostProcessing postProcessMain ilaDataDir testExitCode = do callProcess "cabal" ["build", postProcessMain] - callProcess "cabal" ["run", postProcessMain, ilaDir, show testExitCode] + callProcess "cabal" ["run", postProcessMain, ilaDataDir, show testExitCode] {- | Searches for a file called @cabal.project@ It will look for it in the current working directory. If it can't find it there, it will traverse up @@ -124,17 +128,18 @@ findProjectRoot = goUp =<< getCurrentDirectory projectFilename = "cabal.project" +-- | Shake target data Target = Target - { targetName :: TargetName + { targetName :: ClashTargetName -- ^ TemplateHaskell reference to top entity to synthesize , targetHasXdc :: Bool -- ^ Whether target has an associated XDC file in 'data/constraints'. An XDC -- file implies that a bitstream can be generated. , targetHasVio :: Bool -- ^ Whether target has one or more VIOs - , targetHasTest :: Bool + , targetTest :: Maybe HitlTestGroup -- ^ Whether target has a VIO probe that can be used to run hardware-in-the- - -- loop tests. Note that this flag, 'targetHasTest', implies 'targetHasVio'. + -- loop tests. Note that this flag, 'targetTest', implies 'targetHasVio'. , targetPostProcess :: Maybe String -- ^ Name of the executable for post processing of ILA CSV data, or Nothing -- if it has none. @@ -145,86 +150,57 @@ data Target = Target -- instance. Generates tck that utilizes https://www.tcl.tk/man/tcl8.6/TclCmd/glob.htm } -defTarget :: TargetName -> Target +defTarget :: ClashTargetName -> Target defTarget name = Target { targetName = name , targetHasXdc = False , targetHasVio = False - , targetHasTest = False + , targetTest = Nothing , targetPostProcess = Nothing , targetExtraXdc = [] , targetExternalHdl = [] } -testTarget :: TargetName -> Target -testTarget name = +testTarget :: HitlTestGroup -> Target +testTarget test@(HitlTestGroup{..}) = Target - { targetName = name + { targetName = topEntity , targetHasXdc = True , targetHasVio = True - , targetHasTest = True - , targetPostProcess = Nothing - , targetExtraXdc = [] - , targetExternalHdl = [] + , targetTest = Just test + , targetPostProcess = mPostProc + , targetExtraXdc = extraXdcFiles + , targetExternalHdl = externalHdl } enforceValidTarget :: Target -> Target enforceValidTarget target@Target{..} - | targetHasTest && not targetHasVio = + | isJust targetTest && not targetHasVio = error $ show targetName - <> " should have set 'targetHasVio', because " - <> "'targetHasTest' was asserted." + <> " should have set 'targetHasVio', because" + <> " the target has a test ('targetTest')." | otherwise = target -- | All synthesizable targets targets :: [Target] targets = - map - enforceValidTarget - [ defTarget "Bittide.Instances.Pnr.Calendar.switchCalendar1k" - , defTarget "Bittide.Instances.Pnr.Calendar.switchCalendar1kReducedPins" - , defTarget "Bittide.Instances.Pnr.ClockControl.callisto3" - , defTarget "Bittide.Instances.Pnr.Counter.counterReducedPins" - , defTarget "Bittide.Instances.Pnr.ElasticBuffer.elasticBuffer5" - , defTarget "Bittide.Instances.Pnr.ScatterGather.gatherUnit1K" - , defTarget "Bittide.Instances.Pnr.ScatterGather.gatherUnit1KReducedPins" - , defTarget "Bittide.Instances.Pnr.ScatterGather.scatterUnit1K" - , defTarget "Bittide.Instances.Pnr.ScatterGather.scatterUnit1KReducedPins" - , defTarget "Bittide.Instances.Pnr.Si539xSpi.si5391Spi" - , defTarget "Bittide.Instances.Pnr.StabilityChecker.stabilityChecker_3_1M" - , defTarget "Bittide.Instances.Pnr.Synchronizer.safeDffSynchronizer" - , (defTarget "Bittide.Instances.Pnr.Ethernet.vexRiscEthernet") - { targetHasXdc = True - , targetExternalHdl = - [ "$env(VERILOG_ETHERNET_SRC)/rtl/*.v" - , "$env(VERILOG_ETHERNET_SRC)/lib/axis/rtl/*.v" - ] - , targetExtraXdc = - ["jtag_config.xdc", "jtag_pmod1.xdc", "sgmii.xdc"] - } - , (testTarget "Bittide.Instances.Hitl.BoardTest.boardTestExtended") - { targetPostProcess = Just "post-board-test-extended" - } - , testTarget "Bittide.Instances.Hitl.BoardTest.boardTestSimple" - , testTarget "Bittide.Instances.Hitl.FincFdec.fincFdecTests" - , testTarget "Bittide.Instances.Hitl.FullMeshHwCc.fullMeshHwCcTest" - , testTarget "Bittide.Instances.Hitl.FullMeshHwCc.fullMeshHwCcWithRiscvTest" - , (testTarget "Bittide.Instances.Hitl.FullMeshSwCc.fullMeshSwCcTest") - { targetPostProcess = Just "post-fullMeshSwCcTest" - } - , testTarget "Bittide.Instances.Hitl.HwCcTopologies.hwCcTopologyTest" - , testTarget "Bittide.Instances.Hitl.LinkConfiguration.linkConfigurationTest" - , testTarget "Bittide.Instances.Hitl.SyncInSyncOut.syncInSyncOut" - , testTarget "Bittide.Instances.Hitl.Tcl.ExtraProbes.extraProbesTest" - , testTarget "Bittide.Instances.Hitl.TemperatureMonitor.temperatureMonitor" - , testTarget "Bittide.Instances.Hitl.Transceivers.transceiversUpTest" - , (testTarget "Bittide.Instances.Hitl.VexRiscv.vexRiscvTest") - { targetPostProcess = Just "post-vex-riscv-test" - , targetExtraXdc = ["jtag_config.xdc", "jtag_pmod1.xdc"] - } + map enforceValidTarget $ + [ defTarget $ mkName "Bittide.Instances.Pnr.Calendar.switchCalendar1k" + , defTarget $ mkName "Bittide.Instances.Pnr.Calendar.switchCalendar1kReducedPins" + , defTarget $ mkName "Bittide.Instances.Pnr.ClockControl.callisto3" + , defTarget $ mkName "Bittide.Instances.Pnr.Counter.counterReducedPins" + , defTarget $ mkName "Bittide.Instances.Pnr.ElasticBuffer.elasticBuffer5" + , defTarget $ mkName "Bittide.Instances.Pnr.ScatterGather.gatherUnit1K" + , defTarget $ mkName "Bittide.Instances.Pnr.ScatterGather.gatherUnit1KReducedPins" + , defTarget $ mkName "Bittide.Instances.Pnr.ScatterGather.scatterUnit1K" + , defTarget $ mkName "Bittide.Instances.Pnr.ScatterGather.scatterUnit1KReducedPins" + , defTarget $ mkName "Bittide.Instances.Pnr.Si539xSpi.si5391Spi" + , defTarget $ mkName "Bittide.Instances.Pnr.StabilityChecker.stabilityChecker_3_1M" + , defTarget $ mkName "Bittide.Instances.Pnr.Synchronizer.safeDffSynchronizer" ] + <> (testTarget <$> Bittide.Instances.Hitl.Tests.hitlTests) shakeOpts :: ShakeOptions shakeOpts = @@ -234,22 +210,6 @@ shakeOpts = , shakeVersion = "11" } --- | Run Vivado on given TCL script. Can collect the ExitCode. -vivadoFromTcl :: (CmdResult r) => FilePath -> Action r -vivadoFromTcl tclPath = - command - [AddEnv "XILINX_LOCAL_USER_DATA" "no"] -- Prevents multiprocessing issues - "vivado" - ["-mode", "batch", "-source", tclPath] - --- | Run Vivado on given TCL script -vivadoFromTcl_ :: FilePath -> Action () -vivadoFromTcl_ tclPath = - command_ - [AddEnv "XILINX_LOCAL_USER_DATA" "no"] -- Prevents multiprocessing issues - "vivado" - ["-mode", "batch", "-source", tclPath, "-notrace"] - {- | Constructs a 'BoardPart' based on environment variables @SYNTHESIS_BOARD@ or @SYNTHESIS_PART@. Errors if both are set, returns a default (free) part if neither is set. @@ -271,7 +231,7 @@ found. meetsDrcOrError :: FilePath -> FilePath -> FilePath -> IO () meetsDrcOrError methodologyPath summaryPath checkpointPath = unlessM - (liftA2 (&&) (meetsTiming methodologyPath) (meetsTiming summaryPath)) + (meetsTiming methodologyPath &&^ meetsTiming summaryPath) ( error [I.i| Design did not meet design rule checks (DRC). Check out the timing summary at: @@ -290,15 +250,10 @@ meetsDrcOrError methodologyPath summaryPath checkpointPath = ) -- | Newtype used for adding oracle rules for flags to Shake -newtype HardwareTargetsFlag = HardwareTargetsFlag () - deriving (Show) - deriving newtype (Eq, Typeable, Hashable, Binary, NFData) - -type instance RuleResult HardwareTargetsFlag = HardwareTargets - newtype ForceTestRerun = ForceTestRerun () deriving (Show) deriving newtype (Eq, Typeable, Hashable, Binary, NFData) + type instance RuleResult ForceTestRerun = Bool {- | Defines a Shake build executable for calling Vivado. Like Make, in Shake @@ -326,26 +281,12 @@ main = do rules = do _ <- addOracle $ \(ForceTestRerun _) -> return forceTestRerun - _ <- addOracle $ \(HardwareTargetsFlag _) -> return hardwareTargets -- 'all' builds all targets defined below phony "all" $ do for_ targets $ \Target{..} -> do need [entityName targetName <> ":synth"] - (hitlBuildDir "*.yml") %> \path -> do - needWatchFiles - let entity = takeFileName (dropExtension path) - command_ - [] - "cabal" - [ "run" - , "--" - , "bittide-tools:hitl-config-gen" - , "write" - , entity - ] - (dataFilesDir "**") %> \_ -> do Stdout out <- command @@ -388,18 +329,11 @@ main = do -- TODO: Dehardcode these paths. They're currently hardcoded in both the -- TCL and here, which smells. manifestPath = getManifestLocation clashBuildDir targetName - synthesisDir = vivadoBuildDir targetName + synthesisDir = vivadoBuildDir show targetName checkpointsDir = synthesisDir "checkpoints" netlistDir = synthesisDir "netlist" reportDir = synthesisDir "reports" - ilaDir = synthesisDir "ila-data" - - runSynthTclPath = synthesisDir "run_synth.tcl" - runPlaceAndRouteTclPath = synthesisDir "run_place_and_route.tcl" - runBitstreamTclPath = synthesisDir "run_bitstream.tcl" - runProbesGenTclPath = synthesisDir "run_probes_gen.tcl" - runBoardProgramTclPath = synthesisDir "run_board_program.tcl" - runHardwareTestTclPath = synthesisDir "run_hardware_test.tcl" + ilaDataDir = synthesisDir "ila-data" postSynthCheckpointPath = checkpointsDir "post_synth.dcp" postPlaceCheckpointPath = checkpointsDir "post_place.dcp" @@ -410,9 +344,8 @@ main = do , netlistDir "netlist.xdc" ] bitstreamPath = synthesisDir "bitstream.bit" - probesPath = synthesisDir "probes.ltx" + probesFilePath = synthesisDir "probes.ltx" testExitCodePath = synthesisDir "test_exit_code" - hitlConfigPath = hitlBuildDir targetName <> ".yml" postRouteMethodologyPath = reportDir "post_route_methodology.rpt" postRouteTimingSummaryPath = reportDir "post_route_timing_summary.rpt" @@ -442,7 +375,8 @@ main = do -- will therefore fail to invalidate caches. While there are -- ways to tell Cabal/GHC to depend on these files, they are -- known to be broken in our tool versions. This workaround - -- removes all build artifacts _except_ for "bittide-shake". + -- removes all build artifacts _except_ for "bittide-shake" + -- and "vivado-hs". -- -- See: https://github.com/haskell/cabal/issues/4746 -- @@ -457,8 +391,8 @@ main = do when (ci == "false") $ do buildDirs <- liftIO (glob "dist-newstyle/build/*/ghc-*/*") forM_ buildDirs $ \dir -> do - let fileName = takeFileName dir - unless ("bittide-shake" `isPrefixOf` fileName) $ + let dirName = takeFileName dir + unless (any (`isPrefixOf` dirName) ["bittide-shake", "vivado-hs"]) $ do command_ [] "rm" ["-rf", dir] -- Generate RTL @@ -474,7 +408,14 @@ main = do produces [path] -- Synthesis - runSynthTclPath %> \path -> do + (postSynthCheckpointPath : synthReportsPaths) |%> \_ -> do + -- XXX: Will not re-run if _dependencies_ mentioned in 'manifestPath' + -- change. This is only relevant in designs with multiple + -- binders with 'Synthesize' pragmas, which we currently do + -- not have. Ideally we would parse the manifest file and + -- also depend on the dependencies' manifest files, etc. + connector <- liftIO tclConnector + need [manifestPath, connector] let xdcNames = entityName targetName <> ".xdc" : targetExtraXdc xdcPaths = map ((dataFilesDir "constraints") ) xdcNames @@ -488,47 +429,30 @@ main = do synthesisPart <- getBoardPart locatedManifest <- decodeLocatedManifest manifestPath - tcl <- - mkSynthesisTcl + liftIO $ + runSynthesis synthesisDir -- Output directory for Vivado False -- Out of context run synthesisPart -- Part we're synthesizing for constraints -- List of filenames with constraints targetExternalHdl -- List of external HDL files to be included in synthesis locatedManifest - - writeFileChanged path tcl - - (postSynthCheckpointPath : synthReportsPaths) |%> \_ -> do - -- XXX: Will not re-run if _dependencies_ mentioned in 'manifestPath' - -- change. This is only relevant in designs with multiple - -- binders with 'Synthesize' pragmas, which we currently do - -- not have. Ideally we would parse the manifest file and - -- also depend on the dependencies' manifest files, etc. - need [runSynthTclPath, manifestPath] - vivadoFromTcl_ runSynthTclPath + connector -- Path to tclConnector script -- Routing + netlist generation - runPlaceAndRouteTclPath %> \path -> do - writeFileChanged path (mkPlaceAndRouteTcl synthesisDir) - ( postPlaceCheckpointPath : postRouteCheckpointPath : routeReportsPaths <> netlistPaths ) |%> \_ -> do - need [runPlaceAndRouteTclPath, postSynthCheckpointPath] - vivadoFromTcl_ runPlaceAndRouteTclPath + need [postSynthCheckpointPath] + liftIO $ runPlaceAndRoute synthesisDir -- Design should meet design rule checks (DRC). liftIO $ unlessM - ( liftA2 - (&&) - (meetsTiming postRouteMethodologyPath) - (meetsTiming postRouteTimingSummaryPath) - ) + (meetsTiming postRouteMethodologyPath &&^ meetsTiming postRouteTimingSummaryPath) ( error [I.i| Design did not meet design rule checks (DRC). Check out the timing summary at: @@ -578,53 +502,29 @@ main = do ) -- Bitstream generation - runBitstreamTclPath %> \path -> do - writeFileChanged path (mkBitstreamTcl synthesisDir) - bitstreamPath %> \_ -> do - need [runBitstreamTclPath, postRouteCheckpointPath] - vivadoFromTcl_ runBitstreamTclPath + need [postRouteCheckpointPath] + liftIO $ runBitstreamGen synthesisDir -- Probes file generation - runProbesGenTclPath %> \path -> do - writeFileChanged path (mkProbesGenTcl synthesisDir) - - probesPath %> \_ -> do - need [runProbesGenTclPath, bitstreamPath] - vivadoFromTcl_ runProbesGenTclPath - - -- Write bitstream to board - runBoardProgramTclPath %> \path -> do - hwTargets <- askOracle $ HardwareTargetsFlag () - url <- getEnvWithDefault "localhost:3121" "HW_SERVER_URL" - boardProgramTcl <- - liftIO $ mkBoardProgramTcl synthesisDir hwTargets url targetHasVio - writeFileChanged path boardProgramTcl + probesFilePath %> \_ -> do + need [bitstreamPath] + liftIO $ runProbesFileGen synthesisDir -- Run hardware test - runHardwareTestTclPath %> \path -> do - hwTargets <- askOracle $ HardwareTargetsFlag () - need [hitlConfigPath] - forceRerun <- askOracle $ ForceTestRerun () - when forceRerun alwaysRerun - url <- getEnvWithDefault "localhost:3121" "HW_SERVER_URL" - hardwareTestTcl <- - liftIO $ mkHardwareTestTcl hitlConfigPath synthesisDir hwTargets url ilaDir - writeFileChanged path hardwareTestTcl - testExitCodePath %> \path -> do forceRerun <- askOracle $ ForceTestRerun () when forceRerun alwaysRerun need - [ runBoardProgramTclPath - , runHardwareTestTclPath + [ entityName targetName <> ":program" , bitstreamPath - , probesPath - , hitlConfigPath + , probesFilePath ] - vivadoFromTcl_ runBoardProgramTclPath - exitCode <- vivadoFromTcl @ExitCode runHardwareTestTclPath - writeFileChanged path $ show exitCode + url <- getEnvWithDefault "localhost:3121" "HW_SERVER_URL" + exitCode <- + liftIO $ + runHitlTest (fromJust targetTest) url probesFilePath ilaDataDir + writeFileChanged path (show exitCode) shortenNamesPy <- liftIO $ @@ -643,20 +543,33 @@ main = do when targetHasXdc $ do phony (entityName targetName <> ":bitstream") $ do - when targetHasVio $ need [probesPath] + when targetHasVio $ need [probesFilePath] need [bitstreamPath] + -- Write bitstream to hardware target(s) phony (entityName targetName <> ":program") $ do - when targetHasVio $ need [probesPath] - need [runBoardProgramTclPath, bitstreamPath] - vivadoFromTcl_ runBoardProgramTclPath + when targetHasVio $ need [probesFilePath] + need [bitstreamPath] + let hwTRefs = + hwTargetRefsFromHitlTestGroup $ + fromMaybe + ( error $ + "Asked to program target " + ++ show targetName + ++ " while the " + <> "hardware targets to program could not be found as this target does not " + <> "have a HITL test associated with it." + ) + targetTest + url <- getEnvWithDefault "localhost:3121" "HW_SERVER_URL" + liftIO $ programBitstream synthesisDir hwTRefs url targetHasVio - when targetHasTest $ do + when (isJust targetTest) $ do phony (entityName targetName <> ":test") $ do need [testExitCodePath] exitCode <- read <$> readFile' testExitCodePath when (isJust targetPostProcess) $ do - liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDir exitCode + liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDataDir exitCode unless (exitCode == ExitSuccess) $ do liftIO $ exitWith exitCode @@ -664,7 +577,7 @@ main = do phony (entityName targetName <> ":post-process") $ do need [testExitCodePath] exitCode <- read <$> readFile' testExitCodePath - liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDir exitCode + liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDataDir exitCode if null shakeTargets then rules diff --git a/bittide-shake/src/Clash/Shake/Extra.hs b/bittide-shake/src/Clash/Shake/Extra.hs index ee9d8c451..56d326f31 100644 --- a/bittide-shake/src/Clash/Shake/Extra.hs +++ b/bittide-shake/src/Clash/Shake/Extra.hs @@ -10,6 +10,7 @@ module Clash.Shake.Extra where import Prelude +import Bittide.Hitl (ClashTargetName) import Clash.Annotations.Primitive (HDL (Verilog)) import Data.Char (toLower) import Development.Shake @@ -25,9 +26,8 @@ hdlToFlag :: HDL -> String hdlToFlag = ("--" <>) . map toLower . show -- | Calculate a SHA256 hex digest of a given file path -hexDigestFile :: FilePath -> Action String +hexDigestFile :: FilePath -> IO String hexDigestFile path = do - need [path] contents <- liftIO (ByteStringLazy.readFile path) pure $ Text.unpack $ @@ -46,10 +46,10 @@ clashCmd :: -- | HDL to compile to HDL -> -- | Entity to compile - TargetName -> + ClashTargetName -> -- | Extra arguments to pass to Clash [String] -> - -- (command, arguments) + -- | (command, arguments) (String, [String]) clashCmd buildDir hdl topName extraArgs = ( "cabal" @@ -73,25 +73,22 @@ clashCmd buildDir hdl topName extraArgs = (modName, funcName) = splitName topName pkgName = "bittide-instances" --- | Fully qualified name to a function. E.g. @Bittide.Foo.topEntity@. -type TargetName = String - --- | Split a 'TargetName' into the fully qualified module name and the function name. -splitName :: TargetName -> (String, String) +-- | Split a 'ClashTargetName' into the fully qualified module name and the function name. +splitName :: ClashTargetName -> (String, String) splitName qualifiedName = - let (f, m) = break (== '.') $ reverse qualifiedName + let (f, m) = break (== '.') $ reverse $ show qualifiedName in (reverse $ tail m, reverse f) -entityName :: TargetName -> String +entityName :: ClashTargetName -> String entityName = snd . splitName -moduleName :: TargetName -> String +moduleName :: ClashTargetName -> String moduleName = fst . splitName -defaultClashCmd :: FilePath -> TargetName -> (String, [String]) +defaultClashCmd :: FilePath -> ClashTargetName -> (String, [String]) defaultClashCmd buildDir topName = clashCmd buildDir Verilog topName [] --- | Given a 'TargetName', return expected location of Clash manifest file. -getManifestLocation :: FilePath -> TargetName -> String +-- | Given a 'ClashTargetName', return expected location of Clash manifest file. +getManifestLocation :: FilePath -> ClashTargetName -> String getManifestLocation buildDir topName = - buildDir topName "clash-manifest.json" + buildDir show topName "clash-manifest.json" diff --git a/bittide-shake/src/Clash/Shake/Flags.hs b/bittide-shake/src/Clash/Shake/Flags.hs index 9f642f6ec..699ef1156 100644 --- a/bittide-shake/src/Clash/Shake/Flags.hs +++ b/bittide-shake/src/Clash/Shake/Flags.hs @@ -1,68 +1,30 @@ --- SPDX-FileCopyrightText: 2023 Google LLC +-- SPDX-FileCopyrightText: 2023-2024 Google LLC -- -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -- | Flags used by Shake module Clash.Shake.Flags where import Prelude -import Development.Shake.Classes -import GHC.Generics (Generic) -import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), OptDescr (Option)) -import Text.Read (readMaybe) +import System.Console.GetOpt (ArgDescr (NoArg), OptDescr (Option)) data Options = Options - { hardwareTargets :: HardwareTargets - , forceTestRerun :: Bool + { forceTestRerun :: Bool } defaultOptions :: Options defaultOptions = Options - { hardwareTargets = OneAny - , forceTestRerun = False + { forceTestRerun = False } --- | Number of hardware targets to program and optionally test -data HardwareTargets - = -- | Program the first FPGA found by Vivado. This is not necessarily the first - -- FPGA in the demo rack. - OneAny - | -- | Program the FPGAs in the demo rack at the specific indices. The actual - -- IDs of the FPGAs in the demo rack are specified in @HardwareTest.tcl@. - Specific [Int] - | -- | Program all connected FPGAs. Note that we currently hardcode a list of all - -- FPGAs in our possesion. If we can't find them all, the program will exit with - -- and error code. - All - deriving (Read, Show, Eq, Typeable, Generic, Hashable, Binary, NFData) - -{- | Parse string to 'HardwareTargets'. Return 'Left' if given string could not -be parsed. --} -parseHardwareTargetsFlag :: String -> Either String (Options -> Options) -parseHardwareTargetsFlag s = - case readMaybe s of - Just f -> - case f of - Specific [] -> Left ("Specify at least one index from the demo rack, or use OneAny") - _ -> Right (\opts -> opts{hardwareTargets = f}) - Nothing -> Left ("Not a valid hardware target: " ++ s) - {- | List of custom flags supported by us. Note that we currently support only one flag, 'HardwareTargets'. -} customFlags :: [OptDescr (Either String (Options -> Options))] customFlags = [ Option - "" -- no short flags - ["hardware-targets"] -- long name of flag - (ReqArg parseHardwareTargetsFlag "TARGET") - "Options: OneAny, Specific, All. See 'HardwareTargets' in 'Flags.hs'." - , Option "" -- no short flags ["force-test-rerun"] (NoArg $ Right (\opts -> opts{forceTestRerun = True})) diff --git a/bittide-shake/src/Clash/Shake/Vivado.hs b/bittide-shake/src/Clash/Shake/Vivado.hs index 90815a987..f19dd070c 100644 --- a/bittide-shake/src/Clash/Shake/Vivado.hs +++ b/bittide-shake/src/Clash/Shake/Vivado.hs @@ -2,46 +2,65 @@ -- -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} - -{- | Generate a TCL script to simulate generated VHDL - -Run with @vivado -mode batch -source ...@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- | Helper functions to do things like synthesis, place & route, bitstream +generation, programming and running hardware tests for the Bittide project. +This is realized by letting Vivado execute Tcl using the `vivado-hs` package. +Refer to @bittide-instances/src/Bittide/Instances/Hitl/README.md@ and +`Bittide.Hitl` for more information on the HITL test infrastructure. -} module Clash.Shake.Vivado ( LocatedManifest (..), BoardPart (..), TclGlobPattern, decodeLocatedManifest, - mkSynthesisTcl, - mkPlaceAndRouteTcl, - mkBitstreamTcl, - mkProbesGenTcl, - mkBoardProgramTcl, - mkHardwareTestTcl, + runSynthesis, + runPlaceAndRoute, + runBitstreamGen, + runProbesFileGen, + programBitstream, + runHitlTest, meetsTiming, meetsDrc, ) where import Prelude -import Development.Shake +import Development.Shake (Action) import Development.Shake.Extra (decodeFile) -import Clash.DataFiles (tclConnector) +import Bittide.Hitl +import Bittide.Instances.Hitl.Setup (knownFpgaIds) import Clash.Driver.Manifest -import Control.Monad.Extra (andM, orM) -import Data.List (intercalate, isInfixOf) +import Clash.Prelude (BitPack (BitSize), Natural, natToNatural, pack) +import Clash.Shake.Extra (hexDigestFile) +import qualified Clash.Sized.Internal.BitVector as BitVector +import Control.Concurrent (threadDelay) +import Control.Exception (try) +import Control.Monad.Extra (andM, forM, forM_, orM, unless, when) +import Data.Containers.ListUtils (nubOrd) +import Data.Either (lefts, rights) +import Data.Functor ((<&>)) +import Data.List (elemIndex, isInfixOf, isSuffixOf, sort, sortOn, (\\)) +import Data.List.Extra (anySame, split, (!?)) +import Data.Map.Strict (fromList, keys, mapKeys, toAscList) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromJust, fromMaybe) import Data.String.Interpolate (__i) +import Data.Text (unpack) +import System.Clock (Clock (Monotonic), diffTimeSpec, getTime, toNanoSecs) +import System.Directory (createDirectoryIfMissing) +import System.Exit (ExitCode (..)) import System.FilePath (dropFileName, ()) - -import Clash.Shake.Extra (hexDigestFile) -import Clash.Shake.Flags (HardwareTargets (..)) - -import Paths_bittide_shake +import Text.Read (readMaybe) +import Vivado (TclException (..), VivadoHandle, execPrint, execPrint_, with) +import Vivado.Tcl -- | Satisfied if all actions result in 'False' noneM :: (Monad m) => [m Bool] -> m Bool @@ -67,8 +86,8 @@ meetsDrc path = meetsTiming :: FilePath -> IO Bool meetsTiming path = andM - [ meetsDrc path -- for safety; users should use meetDrc for useful error reporting - , fmap not $ inFile "Timing constraints are not met" path + [ meetsDrc path -- for safety; users should use meetsDrc for useful error reporting + , not <$> inFile "Timing constraints are not met" path ] -- | Patterns compatible with https://www.tcl.tk/man/tcl8.6/TclCmd/glob.htm @@ -102,7 +121,9 @@ mkBoardPartTcl boardPart = case boardPart of HDL files generated by Clash. The caller is responsible for starting synthesis or simulation. -} -mkBaseTcl :: +execBaseTcl :: + -- | Handle to a Vivado object that is to execute the Tcl. + VivadoHandle -> -- | Where to create ip directory. FilePath -> -- | List of glob patterns to external HDL files. @@ -111,10 +132,11 @@ mkBaseTcl :: LocatedManifest -> -- | Board part or part to synthesize for BoardPart -> - -- | TCL script - Action String -mkBaseTcl outputDir globPatterns LocatedManifest{lmPath} boardPart = do - connector <- liftIO tclConnector + -- | Path to tclConnector: a Tcl script that can parse Clash output and emit + -- the correct commands for loading the design into Vivado + FilePath -> + IO () +execBaseTcl v outputDir globPatterns LocatedManifest{lmPath} boardPart connector = do connectorDigest <- hexDigestFile connector lmPathDigest <- hexDigestFile lmPath let @@ -135,7 +157,8 @@ mkBaseTcl outputDir globPatterns LocatedManifest{lmPath} boardPart = do add_files $extra_hdl_files |] - pure + execPrint_ + v [__i| \# #{lmPath}: #{lmPathDigest} \# #{connector}: #{connectorDigest} @@ -168,7 +191,7 @@ mkBaseTcl outputDir globPatterns LocatedManifest{lmPath} boardPart = do set_property TOP $clash::topEntity [current_fileset] |] -mkSynthesisTcl :: +runSynthesis :: -- | Directory to write logs and checkpoints to FilePath -> -- | Out of context? @@ -181,55 +204,72 @@ mkSynthesisTcl :: [TclGlobPattern] -> -- | Manifests of which the first is the top-level to synthesize LocatedManifest -> - -- | Rendered TCL - Action String -mkSynthesisTcl + -- | Path to tclConnector: a Tcl script that can parse Clash output and emit + -- the correct commands for loading the design into Vivado + FilePath -> + IO () +runSynthesis outputDir outOfContext boardPart constraints globPatterns - manifest@LocatedManifest{lmManifest} = do - baseTcl <- mkBaseTcl outputDir globPatterns manifest boardPart - constraintDigests <- unlines <$> mapM constraintDigest constraints - pure $ - baseTcl - <> "\n" - <> [__i| - #{constraintDigests} - set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR - - #{constraintsString} - file mkdir {#{outputDir "reports"}} - file mkdir {#{outputDir "checkpoints"}} - - \# Synthesis - synth_design -name #{name} -mode #{outOfContextStr} - report_methodology -file {#{outputDir "reports" "post_synth_methodology.rpt"}} - report_timing_summary -file {#{outputDir "reports" "post_synth_timing_summary.rpt"}} - report_utilization -file {#{outputDir "reports" "post_synth_util.rpt"}} - write_checkpoint -force {#{outputDir "checkpoints" "post_synth.dcp"}} + manifest@LocatedManifest{lmManifest} + connector = with $ \v -> do + execBaseTcl v outputDir globPatterns manifest boardPart connector - \# Netlist - file mkdir {#{outputDir "netlist"}} - write_verilog -force {#{outputDir "netlist" "netlist.v"}} - write_xdc -no_fixed_only -force {#{outputDir "netlist" "netlist.xdc"}} - |] + constraintDigests <- unlines <$> mapM constraintDigest constraints + putStrLn constraintDigests + + execCmd_ v "set_msg_config" ["-severity {CRITICAL WARNING}", "-new_severity ERROR"] + forM_ constraints (\xdcPath -> execCmd v "read_xdc" ["-unmanaged {" <> xdcPath <> "}"]) + + -- Synthesis + execCmd_ + v + "synth_design" + [ "-name " <> unpack (topComponent lmManifest) + , "-mode " <> if outOfContext then "outOfContext" else "default" + ] + createDirectoryIfMissing True $ outputDir "reports" + createDirectoryIfMissing True $ outputDir "checkpoints" + execCmd_ + v + "report_methodology" + ["-file {" <> outputDir "reports" "post_synth_methodology.rpt}"] + execCmd_ + v + "report_timing_summary" + ["-file {" <> outputDir "reports" "post_synth_timing_summary.rpt}"] + execCmd_ + v + "report_utilization" + ["-file {" <> outputDir "reports" "post_synth_util.rpt}"] + execCmd_ + v + "write_checkpoint" + ["-force", "{" <> outputDir "checkpoints" "post_synth.dcp}"] + + -- Netlist + createDirectoryIfMissing True $ outputDir "netlist" + execCmd_ + v + "write_verilog" + ["-force", outputDir "netlist" "netlist.v"] + execCmd_ + v + "write_xdc" + ["-no_fixed_only", "-force", outputDir "netlist" "netlist.xdc"] where - name = topComponent lmManifest - outOfContextStr - | outOfContext = "out_of_context" :: String - | otherwise = "default" - constraintReader constr = "read_xdc -unmanaged {" <> constr <> "}\n" - constraintsString = concatMap constraintReader constraints - constraintDigest path = do pathDigest <- hexDigestFile path pure [__i|\# #{path}: #{pathDigest}|] -mkPlaceAndRouteTcl :: FilePath -> String -mkPlaceAndRouteTcl outputDir = - [__i| +runPlaceAndRoute :: FilePath -> IO () +runPlaceAndRoute outputDir = with $ \v -> + execPrint_ + v + [__i| set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR \# Pick up where synthesis left off @@ -259,118 +299,658 @@ mkPlaceAndRouteTcl outputDir = write_xdc -no_fixed_only -force {#{outputDir "netlist" "netlist.xdc"}} |] -mkBitstreamTcl :: FilePath -> String -mkBitstreamTcl outputDir = - [__i| - set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR +runBitstreamGen :: FilePath -> IO () +runBitstreamGen outputDir = with $ \v -> do + execCmd_ v "set_msg_config" ["-severity {CRITICAL WARNING}", "-new_severity ERROR"] - \# Pick up where netlist left off - open_checkpoint {#{outputDir "checkpoints" "post_route.dcp"}} + -- Pick up where netlist left off + execPrint_ + v + ("open_checkpoint {" <> outputDir "checkpoints" "post_route.dcp" <> "}") - \# Generate bitstream - set_property BITSTREAM.GENERAL.COMPRESS TRUE [current_design] - write_bitstream -force {#{outputDir "bitstream.bit"}} -|] + -- Generate bitstream + execPrint_ v "set_property BITSTREAM.GENERAL.COMPRESS TRUE [current_design]" + execPrint_ v ("write_bitstream -force {" <> outputDir "bitstream.bit" <> "}") -mkProbesGenTcl :: FilePath -> String -mkProbesGenTcl outputDir = - [__i| - set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR +runProbesFileGen :: FilePath -> IO () +runProbesFileGen outputDir = with $ \v -> do + execPrint_ v "set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR" - \# Pick up where netlist left off - open_checkpoint {#{outputDir "checkpoints" "post_route.dcp"}} + -- Pick up where netlist left off + execPrint_ + v + ("open_checkpoint {" <> outputDir "checkpoints" "post_route.dcp" <> "}") - \# Generate probes file - write_debug_probes -force {#{outputDir "probes.ltx"}} -|] + -- Generate probes file + execPrint_ v ("write_debug_probes -force {" <> outputDir "probes.ltx" <> "}") -{- | Convert HardwareTargets to a Tcl list of target FPGAs. To be used in -combination with `fpga_ids` in `HardwareTest.tcl` +{- | Attempts to find and return the ID of a hardware target referenced by a given +`HwTargetRef`. This is what Vivado seems to call the UID minus the vendor string. -} -toTclTarget :: HardwareTargets -> String -toTclTarget hwTargets = +idFromHwTRef :: HwTargetRef -> FpgaId +idFromHwTRef (HwTargetByIndex i) = + fromMaybe + ("The given index " <> show i <> " is out of range for the list of known FPGA IDs") + (knownFpgaIds !? fromIntegral i) +idFromHwTRef (HwTargetById targetId) = targetId + +{- | Takes the ID part of a Vivado hardware target. This is what Vivado seems to +call the UID minus the vendor string. + +==== __Example__ +>>> idFromHwT (HwTarget "localhost:3121/xilinx_tcf/Digilent/210308B0B0C2") +"210308B0B0C2" +-} +idFromHwT :: HwTarget -> FpgaId +idFromHwT = fromMaybe err . (!? 3) . split (== '/') . fromHwTarget + where + err = error "Unexpected format for hw_target Tcl object" + +{- | Attempt to determine the hardware target index/position in the HITL +test setup to prepend it to its prettier name. +-} +prettyShow :: HwTarget -> String +prettyShow hwT = + let hwTId = idFromHwT hwT + in case hwTId `elemIndex` knownFpgaIds of + Just index -> show index <> "_" <> hwTId + Nothing -> hwTId + +{- | Tries to find the hardware target with a specific FPGA ID in a given list of hardware targets. +Returns the FPGA ID wrapped in a `Left` on failure to find such a target. +-} +findHwTWithId :: FpgaId -> [HwTarget] -> Either FpgaId HwTarget +findHwTWithId fpgaId hwTs = do + case filter ((== fpgaId) . idFromHwT) hwTs of + [] -> Left fpgaId + [hwT] -> Right hwT + hwTs' -> error $ "Found multiple hardware targets with the same ID: " <> show hwTs' + +{- | Attempts to resolve a given list of hardware target references and return a +`Map HwTargetRef HwTarget`. The available hardware targets on the connected +hardware servers are queried for a limited number of times and errors if the +requested targets cannot be found. +-} +resolveHwTRefs :: + -- | Handle to a Vivado object that is to execute the Tcl. + VivadoHandle -> + [HwTargetRef] -> + IO (Map.Map HwTargetRef HwTarget) +resolveHwTRefs v requestedHwTRefs = do + let requestedIds = idFromHwTRef <$> requestedHwTRefs let - listToTcl :: [Int] -> String - listToTcl xs = "[list " <> (intercalate " " $ map show xs) <> "]" - in - case hwTargets of - OneAny -> listToTcl [] - Specific xs -> listToTcl $ map (`mod` 8) xs - All -> listToTcl [0 .. 7] - -mkBoardProgramTcl :: - -- | Directory where the bitstream file are located + go :: Int -> IO (Map.Map HwTargetRef HwTarget) + go numTries = do + foundTargets <- get_hw_targets v [] + printInfo foundTargets + let matchingTargets = (`findHwTWithId` foundTargets) <$> requestedIds + if null (lefts matchingTargets) + then do + pure $ fromList $ zip requestedHwTRefs (rights matchingTargets) + else do + putStrLn $ + "WARNING: The connected hardware servers did not host the requested " + <> "hardware targets with IDs " + <> show (lefts matchingTargets) + if numTries < 0 + then error "Giving up." + else do + putStrLn "Retrying..." + threadDelay 500000 -- In μs + refresh_hw_server v [] + go (numTries - 1) + go 10 + where + printInfo foundTargets = do + putStrLn $ + "The connected hardware servers host " + <> show (length foundTargets) + <> " hardware targets:" + mapM_ (putStrLn . ('\t' :) . show) foundTargets + let foundFpgaIds = idFromHwT <$> foundTargets + when (sort foundFpgaIds /= sort knownFpgaIds) $ + putStrLn $ + "WARNING: The IDs of the hosted hardware targets do not match the known ones." + <> "\n\tNot found but expected: " + <> show (knownFpgaIds \\ foundFpgaIds) + <> "\n\tFound but unexpected: " + <> show (foundFpgaIds \\ knownFpgaIds) + +{- | Open the given hardware target and set the current hardware device to the +Xilinx FPGA on it. +-} +openHwT :: VivadoHandle -> HwTarget -> IO () +openHwT v hwT = do + currentHwT <- current_hw_target v [] + currentIsOpened <- + execPrint v "get_property IS_OPENED [current_hw_target]" <&> \case + "1" -> True + "0" -> False + o -> error $ "Property IS_OPENED was " <> show o <> " where 0 or 1 was expected." + if currentHwT == hwT + then do + unless currentIsOpened $ + open_hw_target v [] + else do + when currentIsOpened $ + close_hw_target v ["-quiet"] + _ <- current_hw_target v [show hwT] + open_hw_target v [] + -- Assumes that the open target has the Xilinx device to program at index 0. + -- This is also what Xilinx does in its examples in UG908. + hwD <- current_hw_device v ["[lindex [get_hw_devices] 0]"] + when (null (fromHwDevice hwD)) $ + error "Setting the current hardware device failed." + +programBitstream :: + -- | Directory where the bitstream files are located FilePath -> - -- | Hardware targets to program, see `Flags.hs` - HardwareTargets -> + -- | References to the hardware targets to program + [HwTargetRef] -> -- | Hardware server URL String -> -- | Flag indicating if the target has a probes file. If true, the probes file -- is programmed alongside the bitstream. Bool -> - -- | Rendered Tcl - IO String -mkBoardProgramTcl outputDir hwTargets url hasProbesFile = do - hardwareTestTclPath <- getDataFileName ("data" "tcl" "HardwareTest.tcl") - let - probesTcl :: String - probesTcl - | hasProbesFile = [__i|set probes_file {#{outputDir "probes.ltx"}}|] - | otherwise = "set probes_file {}" + IO () +programBitstream outputDir hwTRefs url hasProbesFile = with $ \v -> do + putStrLn "Starting programming of given hardware targets..." + if null hwTRefs + then putStrLn "WARNING: Not programming as no hardware target references were given." + else do + execCmd_ v "set_msg_config" ["-severity {CRITICAL WARNING}", "-new_severity ERROR"] + execCmd_ v "open_hw_manager" [] + execCmd_ v "connect_hw_server" ["-url " <> url] + refToHwTMap <- resolveHwTRefs v hwTRefs + let hwTs = nubOrd $ Map.elems refToHwTMap + forM_ hwTs $ \hwT -> do + openHwT v hwT + execCmd_ + v + "set_property" + [ "PROGRAM.FILE" + , embrace (outputDir "bitstream.bit") + , "[current_hw_device]" + ] + execCmd_ + v + "set_property" + [ "PROBES.FILE" + , if hasProbesFile then embrace (outputDir "probes.ltx") else "{}" + , "[current_hw_device]" + ] + -- Program the device and close properly + _ <- program_hw_devices v ["[current_hw_device]"] + refresh_hw_device v ["[current_hw_device]"] + +data VioProbeInfo = VioProbeInfo + { probeName :: String + , probeType :: String + , probeWidth :: String + } - pure - [__i| - source {#{hardwareTestTclPath}} -notrace - global fpga_ids +{- | Verifies whether the bitstream programmed on the current hardware target +includes a VIO IP core that is configured as required by this HITL framework. +See `Bittide.Hitl` for details. - set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR +Make sure that the `PROBES.FILE` property is set for the `current_hw_device` +and that `refresh_hw_device` has been run afterwards. +-} +verifyHitlVio :: VivadoHandle -> Natural -> IO () +verifyHitlVio v paramBitSize = do + vioProbes <- get_hw_probes v ["-of_objects [get_hw_vios]", "*vioHitlt/*"] + let unexpectedProbes = + [ show probe + | probe <- vioProbes + , not (any (`isSuffixOf` show probe) requiredProbeSimpleNames) + ] + where + requiredProbeSimpleNames = map (last . split (== '/') . probeName) requiredProbes + unless (null unexpectedProbes) $ do + putStrLn "WARNING: Encountered unexpected HITL VIO probes, they will be ignored:" + mapM_ (putStrLn . ('\t' :)) unexpectedProbes + mapM_ (`verifyHitlProbe` vioProbes) requiredProbes + where + requiredProbes = + [ VioProbeInfo "*vioHitlt/probe_test_start" "vio_output" "1" + , VioProbeInfo "*vioHitlt/probe_test_done" "vio_input" "1" + , VioProbeInfo "*vioHitlt/probe_test_success" "vio_input" "1" + ] + <> [ VioProbeInfo "*vioHitlt/probe_test_data" "vio_output" (show paramBitSize) + | paramBitSize /= 0 + ] + verifyHitlProbe :: VioProbeInfo -> [HwProbe] -> IO () + verifyHitlProbe VioProbeInfo{..} vioProbes = do + let simpleName = last (split (== '/') probeName) + let probe = case filter (('/' : simpleName) `isSuffixOf`) (show <$> vioProbes) of + [p] -> p + ps -> + error $ + "Exactly one probe named '" + <> probeName + <> "' " + <> "must be present but " + <> show (length ps) + <> " were found." + execCmd_ + v + "set" + [ simpleName + , "[get_hw_probes -of_objects [get_hw_vios] " <> probeName <> "]" + ] + typeProp <- execCmd v "get_property" ["type", "$" <> simpleName] + unless (typeProp == probeType) $ + error $ + "Probe '" + <> probe + <> "' must have type " + <> probeType + <> " but has '" + <> typeProp + <> "'." + widthProp <- execCmd v "get_property" ["width", "$" <> simpleName] + unless (widthProp == probeWidth) $ + error $ + "Probe '" <> probe <> "' must have width " <> probeWidth <> " but it is " <> widthProp + +getTestProbeTcl :: String -> String +getTestProbeTcl probeNm = + "[get_hw_probes -of_objects [get_hw_vios] " <> probeNm <> "]" + +{- | Tcl code to get the HITL VIO test start output probe. +Run `verifyHitlVio` beforehand to ensure that the probe is available. +-} +getProbeTestStartTcl :: String +getProbeTestStartTcl = getTestProbeTcl "*vioHitlt/probe_test_start" - set fpga_nrs #{toTclTarget hwTargets} - set program_file {#{outputDir "bitstream.bit"}} - set url {#{url}} - #{probesTcl} +{- | Tcl code to get the HITL VIO test data output probe. +Run `verifyHitlVio` beforehand and verify that the HITL test parameter +`BitSize` isn't zero to ensure that the probe is available. +-} +getProbeTestDataTcl :: String +getProbeTestDataTcl = getTestProbeTcl "*vioHitlt/probe_test_data" - open_hw_manager - connect_hw_server -url $url - set target_dict [get_target_dict ${url} ${fpga_nrs}] - has_expected_targets ${url} ${target_dict} +{- | Tcl code to get the HITL VIO test done input probe. +Run `verifyHitlVio` beforehand to ensure that the probe is available. +-} +getProbeTestDoneTcl :: String +getProbeTestDoneTcl = getTestProbeTcl "*vioHitlt/probe_test_done" + +{- | Tcl code to get the HITL VIO test success input probe. +Run `verifyHitlVio` beforehand to ensure that the probe is available. +-} +getProbeTestSuccessTcl :: String +getProbeTestSuccessTcl = getTestProbeTcl "*vioHitlt/probe_test_success" + +{- | Observed instances of property CELL_NAME of an hw_ila object include: +- "Bittide_Instances_Hitl_FullMeshSwCc_fullMeshSwCcTest_callistoClockControlWithIla_callistoResult/ilaPlot/ilaPlot" +- "instructionBus/dataBus" + +This short name should return "ilaPlot" and "instructionBus" for +those examples respectively. Could be improved, see +https://github.com/bittide/bittide-hardware/issues/530 +-} +getCurrentIlaShortName :: VivadoHandle -> IO String +getCurrentIlaShortName v = do + ilaCellName <- execCmd v "get_property" ["CELL_NAME", "[current_hw_ila]"] + pure $ + fromMaybe + (error $ "Determining short name failed for ILA with CELL_NAME " <> ilaCellName) + (reverse (split (== '/') ilaCellName) !? 1) + +{- | Verify hardware ILAs. Verification should be performed before the `HwIla` +objects are used for the first time. +-} +verifyHwIlas :: VivadoHandle -> IO () +verifyHwIlas v = do + -- TODO either use or remove the Tcl dictionary + execPrint_ + v + [__i| + \# Create a list of dictionaries where each dictionary corresponds to one ILA. + \# Each dictionary has the following keys: + \# name : short name of the ILA + \# cell_name : name of the cell the ILA is in + \# trigger_probe : name of the trigger probe + \# capture_probe : name of the capture probe + \# data_probes : list of names of all other probes + proc get_ila_dicts {} { + set ila_dicts {} + + set hw_ilas [get_hw_ilas -quiet] + set ila_count [llength $hw_ilas] + if {$ila_count == 0} { + puts "\nNo ILAs in design" + return {} + } - dict for {target_nr target_id} $target_dict { - set target_name [get_part_name $url $target_id] - set device [load_target_device $target_name] - program_fpga ${program_file} ${probes_file} + puts "\nFound $ila_count ILAs:" + foreach hw_ila $hw_ilas { + set ila_dict {} + + \# The short name is the name of the module the ILA is in. For example a + \# cell named `fullMeshSwCcTest/ilaPlot/ila_inst` will give the short + \# name `ilaPlot`. + set cell_name [get_property CELL_NAME $hw_ila] + set before_last [expr [string last / $cell_name] - 1] + set module_name [string range $cell_name 0 $before_last] + set after_second_to_last [expr [string last / $module_name] + 1] + set short_name [string range $cell_name $after_second_to_last $before_last] + dict set ila_dict name $short_name + dict set ila_dict cell_name $cell_name + + \# Get trigger probe and verify it conforms with ILA framework + set trigger_probe [get_hw_probes -of_objects $hw_ila */trigger*] + set trigger_probe_count [llength $trigger_probe] + if {$trigger_probe_count != 1} { + set err_msg "Exactly one probe named 'trigger*' must be present, " + append err_msg "but $trigger_probe_count were found" \n [all_probe_names_msg] + error $err_msg + } elseif {[get_property is_trigger $trigger_probe] != 1} { + set probe_name_short [get_property name.short $trigger_probe] + set err_msg "Probe '$probe_name_short' should have probeType " + append err_msg {Trigger or DataAndTrigger} \n [all_probe_names_msg] + error $err_msg + } elseif {[get_property width $trigger_probe] != 1} { + set probe_name_short [get_property name.short $trigger_probe] + set err_msg "Probe '$probe_name_short' must have a width of 1 bit\n" + append err_msg [all_probe_names_msg] + error $err_msg + } else { + dict set ila_dict trigger_probe [get_property name $trigger_probe] + } + + \# Get capture probe and verify it conforms with ILA framework + set capture_probe [get_hw_probes -of_objects $hw_ila */capture*] + set capture_probe_count [llength $capture_probe] + if {$capture_probe_count != 1} { + set err_msg {Exactly one probe named 'capture*' must be present, } + append err_msg "but $capture_probe_count were found" \n [all_probe_names_msg] + error $err_msg + } elseif {[get_property is_trigger $capture_probe] != 1} { + set probe_name_short [get_property name.short $capture_probe] + set err_msg "Probe '$probe_name_short' should have probeType " + append err_msg {Trigger or DataAndTrigger} \n [all_probe_names_msg] + error $err_msg + } elseif {[get_property width $capture_probe] != 1} { + set probe_name_short [get_property name.short $capture_probe] + set err_msg "Probe '$probe_name_short' must have a width of 1 bit\n" + append err_msg [all_probe_names_msg] + error $err_msg + } else { + dict set ila_dict capture_probe [get_property name $capture_probe] + } + + \# Get all data probes and verify each conforms with ILA framework + set all_probes [get_hw_probes -of_objects $hw_ila] + if {[llength $all_probes] < 3} { + set err_msg "ILA '$short_name' has no data probes, at least 1 " + append err_msg {data probe is required} \n [all_probe_names_msg] + error $err_msg + } + dict set ila_dict data_probes [list] + foreach probe $all_probes { + if {$probe eq $trigger_probe || $probe eq $capture_probe} { + continue + } elseif {[get_property is_data $probe] != 1} { + set probe_name_short [get_property name.short $probe] + set err_msg "Probe '$probe_name_short' should have probeType " + append err_msg {Data or DataAndTrigger} \n [all_probe_names_msg] + error $err_msg + } else { + dict update ila_dict data_probes probe_list { + lappend probe_list [get_property name $probe] + } + } + } + lappend ila_dicts $ila_dict + + \# Print all ILA probes + puts "ILA $short_name with probes:" + set probe_name_short [get_property name.short $trigger_probe] + puts "\t$probe_name_short" + set probe_name_short [get_property name.short $capture_probe] + puts "\t$probe_name_short" + foreach probe_name [dict get $ila_dict data_probes] { + set idx_start [expr {[string first / $probe_name] + 1}] + set probe_name_short [string range $probe_name $idx_start end] + puts "\t$probe_name_short" + } + } + return $ila_dicts } |] + execCmd_ v "set" ["ila_dicts", "[get_ila_dicts]"] -mkHardwareTestTcl :: - -- | Path to test configuration - FilePath -> - -- | Directory where the probes file is located - FilePath -> - -- | Hardware targets to program, see `Flags.hs` - HardwareTargets -> +{- | Waits (with a timeout) until a HITL test case is finished by probing +the probe_test_done probe. Returns whether the test case was successful. +-} +waitTestCaseEnd :: VivadoHandle -> HitlTestCase HwTarget a b -> FilePath -> IO ExitCode +waitTestCaseEnd v HitlTestCase{..} probesFilePath = do + startTime <- getTime Monotonic + let calcTimeSpentMs = (`div` 1000000) . toNanoSecs . diffTimeSpec startTime <$> getTime Monotonic + exitCodes <- forM (keys parameters) $ \hwT -> do + openHwT v hwT + execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] + let + pollTestDone :: IO ExitCode + pollTestDone = do + refresh_hw_device v ["-quiet"] + timeSpentMs <- calcTimeSpentMs + done <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestDoneTcl] + success <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestSuccessTcl] + case (done, success, timeSpentMs >= testTimeoutMs) of + ("1", "1", _) -> do + pure ExitSuccess + ("1", _, _) -> do + putStrLn $ "HITL test case failure for hardware target " <> prettyShow hwT + pure (ExitFailure 2) + (_, _, True) -> do + putStrLn $ + "HITL test case timeout (≥" + <> show testTimeoutMs + <> "ms) for hardware target " + <> prettyShow hwT + pure (ExitFailure 3) + _ -> do + threadDelay 1000 -- In μs + pollTestDone + pollTestDone + + -- Print summary of test case + timeSpentMs <- calcTimeSpentMs + putStrLn $ + "HITL test case'" + <> name + <> "' passed on " + <> show (length (filter (== ExitSuccess) exitCodes)) + <> " out of " + <> show (length exitCodes) + <> " hardware targets in " + <> show timeSpentMs + <> "ms." + pure (maximum exitCodes) + where + -- \| Timeout specifying how long we should wait for a test to finish before + -- considering it a failed test. + -- TODO: Allow the user to specify the timeout for a test. + testTimeoutMs = 60000 :: Integer + +runHitlTest :: + -- | The HITL test definition to execute + HitlTestGroup -> -- | Hardware server URL String -> + -- | Path to the generated probes file + FilePath -> -- | Filepath the the ILA data dump directory FilePath -> - -- | Rendered Tcl - IO String -mkHardwareTestTcl testConfigPath outputDir hwTargets url ilaDataPath = do - hardwareTestTclPath <- getDataFileName ("data" "tcl" "HardwareTest.tcl") - pure - [__i| - source {#{hardwareTestTclPath}} -notrace - set_msg_config -severity {CRITICAL WARNING} -new_severity ERROR - - set fpga_nrs #{toTclTarget hwTargets} - set probes_file {#{outputDir "probes.ltx"}} - set test_config_file {#{testConfigPath}} - set url {#{url}} - - open_hw_manager - connect_hw_server -url $url - set target_dict [get_target_dict ${url} ${fpga_nrs}] - has_expected_targets ${url} ${target_dict} - - run_test_group $probes_file $test_config_file $target_dict $url {#{ilaDataPath}} - |] + IO ExitCode +runHitlTest test@HitlTestGroup{topEntity, testCases} url probesFilePath ilaDataDir = do + putStrLn $ + "Starting HITL test for FPGA design '" + <> show topEntity + <> "' with " + <> show (length testCases) + <> " test cases..." + result <- try @TclException $ with $ \v -> do + let testCaseNames = name <$> testCases + when (anySame testCaseNames) $ + error $ + "HITL test case names must be unique within their test. Offenders: " + <> show (testCaseNames \\ nubOrd testCaseNames) + execCmd_ v "set_msg_config" ["-severity {CRITICAL WARNING}", "-new_severity ERROR"] + execCmd_ v "open_hw_manager" [] + execCmd_ v "connect_hw_server" ["-url " <> url] + refToHwTMap <- resolveHwTRefs v (hwTargetRefsFromHitlTestGroup test) + + testResults <- forM (zip [1 :: Int ..] testCases) $ \(nr, HitlTestCase{..}) -> do + putStrLn $ + "Starting HITL test case " + <> show nr + <> " out of " + <> show (length testCases) + <> " named '" + <> name + <> "'..." + let requestedIds = map (idFromHwTRef . fst) (Map.toList parameters) + when (anySame requestedIds) $ + error $ + "Multiple references to the same hardware target: " + <> show (requestedIds \\ nubOrd requestedIds) + -- Resolve the test case definition by replacing the references to + -- hardware targets with the actual hardware targets. + let resolvedTestCase = + HitlTestCase + { parameters = mapKeys (fromJust . (`Map.lookup` refToHwTMap)) parameters + , .. + } + exitCode <- runHitlTestCase v resolvedTestCase probesFilePath ilaDataDir + pure (name, exitCode) + + let failedTestCaseNames = fst <$> filter ((/= ExitSuccess) . snd) testResults + if null failedTestCaseNames + then do + putStrLn $ "All " <> show (length testCases) <> " HITL test cases passed." + else do + putStrLn $ + show (length failedTestCaseNames) + <> " out of " + <> show (length testCases) + <> " HITL test cases failed or timed out, namely:" + mapM_ (putStrLn . ('\t' :)) failedTestCaseNames + pure $ maximum $ map snd testResults + + case result of + Left e@TclException{retCode} -> do + print e + pure $ ExitFailure (fromMaybe 1 (readMaybe @Int retCode)) + Right exitCode -> pure exitCode + +-- | Runs one test case of a HITL test group +runHitlTestCase :: + forall a b. + -- | Handle to a Vivado object that is to execute the Tcl + VivadoHandle -> + -- | The definition of the HITL test case run + HitlTestCase HwTarget a b -> + -- | Path to the generated probes file + FilePath -> + -- | Filepath the the ILA data dump directory + FilePath -> + IO ExitCode +runHitlTestCase v testCase@HitlTestCase{..} probesFilePath ilaDataDir = do + if null parameters + then do + putStrLn + "WARNING: The HITL test case does not reference any hardware targets. Exiting." + pure ExitSuccess + else do + openHwT v (head (keys parameters)) + verifyHwIlas v + -- XXX: We should not rely on start probe assertion order. + -- See https://github.com/bittide/bittide-hardware/issues/638. + forM_ (sortOn (prettyShow . fst) (toAscList parameters)) $ \(hwT, param) -> do + openHwT v hwT + execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] + refresh_hw_device v [] + let paramBitSize = natToNatural @(BitSize a) + verifyHitlVio v paramBitSize + + execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] + commit_hw_vio v ["[get_hw_vios]"] + refresh_hw_vio v ["[get_hw_vios]"] + done <- execCmd v "get_property" ["INPUT_VALUE", "$probe_test_done"] + when (done /= "0") $ + error $ + "Hardware target '" + <> prettyShow hwT + <> "' asserted its HITL " + <> "VIO probe done before the test was started." + unless (paramBitSize == 0) $ do + hexWidth <- execCmd v "expr" [embrace ("(3 + " <> show paramBitSize <> ")/4")] + vioValue <- + execCmd + v + "format" + ["%0" <> hexWidth <> "llX " <> show (BitVector.unsafeToNatural (pack param))] + putStrLn $ "Setting probe_test_data to " <> vioValue <> "..." + execCmd_ v "set_property" ["OUTPUT_VALUE", vioValue, getProbeTestDataTcl] + + -- Activate the trigger for each ILA. + putStrLn "Verifying ILAs..." + ilas <- get_hw_ilas v [] + unless (null ilas) $ + putStrLn "Configuring and arming ILAs..." + forM_ ilas $ \ila -> do + _ <- current_hw_ila v [show ila] + + -- Set trigger probe (active high boolean) + -- TODO get probe from Tcl dictionary? + let triggerProbe = "[get_hw_probes -of_objects [current_hw_ila] */trigger*]" + execCmd_ v "set_property" ["trigger_compare_value", "eq1'b1", triggerProbe] + + -- Enable capture control and set capture probe (active high boolean) + execCmd_ v "set_property" ["control.capture_mode", "BASIC", "[current_hw_ila]"] + let captureProbe = "[get_hw_probes -of_objects [current_hw_ila] */capture*]" + execCmd_ v "set_property" ["capture_compare_value", "eq1'b1", captureProbe] + + -- Set the trigger position + execCmd_ v "set_property" ["control.trigger_position", "0", "[current_hw_ila]"] + + run_hw_ila v ["[current_hw_ila]"] + + -- Deassert HitlVio start probe + -- XXX: We should not rely on start probe values to be asserted after a + -- test ends. See https://github.com/bittide/bittide-hardware/issues/639. + execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] + commit_hw_vio v ["[get_hw_vios]"] + + -- Assert HitlVio start probe + execCmd_ v "set_property" ["OUTPUT_VALUE", "1", getProbeTestStartTcl] + commit_hw_vio v ["[get_hw_vios]"] + putStrLn $ "Started test case for hardware target " <> prettyShow hwT <> "." + + putStrLn $ "Waiting for test case '" <> name <> "' to end..." + testCaseExitCode <- waitTestCaseEnd v testCase probesFilePath + + putStrLn "Saving captured ILA data (if relevant)..." + forM_ (keys parameters) $ \hwT -> do + openHwT v hwT + execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] + refresh_hw_device v ["-quiet"] + ilas <- get_hw_ilas v [] + let dir = ilaDataDir name prettyShow hwT + unless (null ilas) $ + putStrLn $ + "Saving captured ILA data to: " <> dir + forM_ ilas $ \ila -> do + _ <- current_hw_ila v [show ila] + ilaShortName <- getCurrentIlaShortName v + createDirectoryIfMissing True dir + execCmd_ v "current_hw_ila_data" ["[upload_hw_ila_data [current_hw_ila]]"] + -- Legacy CSV excludes radix information + execCmd_ v "write_hw_ila_data" ["-force", "-legacy_csv_file " <> dir ilaShortName] + execCmd_ v "write_hw_ila_data" ["-force", "-vcd_file " <> dir ilaShortName] + + pure testCaseExitCode diff --git a/bittide-tools/bittide-tools.cabal b/bittide-tools/bittide-tools.cabal index 8bc7c5204..3cf2374ae 100644 --- a/bittide-tools/bittide-tools.cabal +++ b/bittide-tools/bittide-tools.cabal @@ -124,21 +124,3 @@ executable cc-plot -Wcompat -threaded -rtsopts - -executable hitl-config-gen - import: common-options - main-is: hitl/config-gen/Main.hs - build-depends: - aeson, - bittide-experiments, - bittide-instances, - bytestring, - directory, - filepath, - optparse-applicative, - template-haskell, - - ghc-options: - -Wall - -Wcompat - -threaded diff --git a/bittide-tools/clockcontrol/plot/Main.hs b/bittide-tools/clockcontrol/plot/Main.hs index 91bfd0654..10830bedc 100644 --- a/bittide-tools/clockcontrol/plot/Main.hs +++ b/bittide-tools/clockcontrol/plot/Main.hs @@ -59,14 +59,12 @@ import Conduit ( import Control.Arrow (first) import Control.Exception (Exception (..), catch, throw) import Control.Monad (filterM, forM, forM_, unless, when) -import Control.Monad.Extra (unlessM) +import Control.Monad.Extra (ifM, unlessM) import Data.Bifunctor (bimap) -import Data.Bool import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BSC import Data.ByteString.Lazy qualified as BSL import Data.ByteString.UTF8 qualified as UTF8 -import Data.Char (isDigit) import Data.Csv ( FromField (..), FromNamedRecord (..), @@ -80,19 +78,20 @@ import Data.Csv.Conduit ( CsvStreamRecordParseError (..), fromNamedCsvStreamError, ) -import Data.Functor ((<&>)) import Data.HashMap.Strict qualified as HashMap -import Data.List (find, isPrefixOf, isSuffixOf, uncons, unzip4) +import Data.List (isSuffixOf, unzip4) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe) import Data.Proxy (Proxy (..)) import Data.Set qualified as Set import Data.String (fromString) import Data.Text qualified as Text +import Data.Typeable (cast) import Data.Vector qualified as Vector import GHC.IO.Exception (IOErrorType (..), IOException (..)) import GHC.Stack (HasCallStack) import System.Directory ( + canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, listDirectory, @@ -100,7 +99,6 @@ import System.Directory ( import System.Environment (getArgs, getProgName) import System.Exit (die) import System.FilePath ( - isExtensionOf, takeBaseName, takeExtensions, takeFileName, @@ -117,6 +115,7 @@ import System.IO ( openFile, withFile, ) +import Text.Read (readMaybe) import "bittide-extra" Numeric.Extra (parseHex) import Bittide.Arithmetic.PartsPer (PartsPer (..), cyclesToPartsPerI, ppm) @@ -127,12 +126,12 @@ import Bittide.Hitl import Bittide.Instances.Domains import Bittide.Instances.Hitl.IlaPlot import Bittide.Instances.Hitl.Setup -import Bittide.Instances.Hitl.Tests import Bittide.Plot import Bittide.Report.ClockControl import Bittide.Simulate.Config (CcConf, saveCcConfig, simTopologyFileName) import Bittide.Topology +import Bittide.Instances.Hitl.Tests (hitlTests) import Bittide.Simulate.Config qualified as CcConf -- A newtype wrapper for working with hex encoded types. @@ -482,18 +481,21 @@ fromCsvDump t i links (csvHandle, csvFile) = {- | The HITL tests, whose post proc data offers a simulation config for plotting. -} -knownTestsWithCcConf :: (HasCallStack) => [(String, [(String, CcConf)])] -knownTestsWithCcConf = hasCcConf <$> hitlTests +knownTestsWithCcConf :: (HasCallStack) => Map.Map String [(String, CcConf)] +knownTestsWithCcConf = Map.fromList (mapMaybe go hitlTests) where - hasCcConf = \case - LoadConfig name _ -> (name, []) - KnownType name test -> - let !simConfMap = Map.mapMaybeWithKey justOrDie (mGetPPD @_ @CcConf test) - in (name, first Text.unpack <$> Map.toList simConfMap) - justOrDie _ (Just x) = Just x justOrDie k Nothing = error $ "No CcConf for " <> show k + go HitlTestGroup{topEntity, testCases = iters :: [HitlTestCase HwTargetRef q r]} = + case cast @[HitlTestCase HwTargetRef q r] @[HitlTestCase HwTargetRef q CcConf] iters of + Just q -> + Just + ( show topEntity + , Map.toList (Map.mapMaybeWithKey justOrDie (mGetPPD @CcConf @HwTargetRef q)) + ) + Nothing -> Nothing + {- | Calculate an offset such that the clocks start at their set offsets. That is to say, we consider the reference clock to be at 0 fs by definition. The offsets of the other clocks are then measured relative to this reference clock. We don't @@ -711,103 +713,62 @@ plotTest refDom testDir cfg dir globalOutDir = do hFlush h hClose h +{- | Try to parse a run artifact reference. + +>>> parseArtifactRef "123:build-debug" +Just (123,"build-debug") +>>> parseArtifactRef "123_my_dir" +Nothing +-} +parseArtifactRef :: String -> Maybe (Int, String) +parseArtifactRef arg = case span (/= ':') arg of + (readMaybe -> Just jobId, _ : jobName) -> Just (jobId, jobName) + _ -> Nothing + +{- | Given either a Github artifact reference (see 'parseArtifactRef') or a local +directory, return the fully qualified test name and the directory containing +a folder called \"ila-data\". +-} +getSourceData :: String -> IO (String, FilePath) +getSourceData artifactRef | Just (jobId, jobName) <- parseArtifactRef artifactRef = do + -- Get artifact from Github + let fullArtifactName = "_build-" <> jobName <> "-debug" + artifactResult <- retrieveArtifact (show jobId) fullArtifactName ("_build" "plot") + case artifactResult of + Just err -> die (unlines ["Cannot retrieve artifact.", show err]) + Nothing -> do + let vivadoDir = "_build" "plot" "vivado" + dirs <- listDirectory vivadoDir + case filter (('.' : jobName) `isSuffixOf`) dirs of + [dir] -> getSourceData (vivadoDir dir) + _ -> + die $ "No or multiple directories with name containing " <> jobName <> " in " <> vivadoDir +getSourceData dir = do + -- Get artifact from local directory + let ilaDataDir = dir "ila-data" + fullyQualifiedTestName <- takeFileName <$> canonicalizePath dir + ifM + (doesDirectoryExist ilaDataDir) + (return (fullyQualifiedTestName, ilaDataDir)) + (die $ "No 'ila-data' directory in " <> dir) + main :: IO () main = getArgs >>= \case - [] -> wrongNumberOfArguments - plotDataSource : xr -> do - (plotDataDir, outDir, mArtifactName) <- do - isDir <- doesDirectoryExist plotDataSource - (plotDataDir, yr, mA) <- - if isDir - then return (plotDataSource, xr, Nothing) - else case isRunArtifactReference plotDataSource of - Nothing -> die $ "Invalid argument: " <> plotDataSource - Just (runId, artifactName) -> case xr of - [] -> wrongNumberOfArguments - dir : yr -> - let fullArtifactName = "_build-" <> artifactName <> "-debug" - in retrieveArtifact runId fullArtifactName dir >>= \case - Just err -> - die $ - unlines - [ "Cannot retrieve artifact." - , show err - ] - Nothing -> return (dir, yr, Just artifactName) - let (outDir, zr) = fromMaybe (".", []) $ uncons yr - unless (null zr) wrongNumberOfArguments - return (plotDataDir, outDir, mA) - - tests <- do - dirs <- listDirectory plotDataDir - let hitlDir = plotDataDir "hitl" - files <- - bool - (die $ "No 'hitl' folder in " <> fromMaybe plotDataDir mArtifactName) - (listDirectory hitlDir) - ("hitl" `elem` dirs) - case filter (".yml" `isExtensionOf`) files of - [] -> die $ "No YAML files in " <> hitlDir - [x] -> return $ getTestsWithCcConf $ takeBaseName x - _ -> die $ "Too many YAML files in " <> hitlDir - - (testDirs, testsDir) <- do - let epsfix = maybe (Left "Bittide.Instances.Hitl.") Right mArtifactName - dir <- diveDownInto epsfix plotDataDir - listDirectory dir - >>= filterM (doesDirectoryExist . (dir )) - <&> (,dir) - - let sDirs = Set.fromList testDirs - sNames = Set.fromList $ fst <$> tests - when (sDirs /= sNames) $ - die $ - if sDirs `Set.isProperSubsetOf` sNames - then - "Missing tests " - <> show (Set.toList (sNames `Set.difference` sDirs)) - <> " in " - <> testsDir - else - "Unknown tests " - <> show (Set.toList (sDirs `Set.difference` sNames)) - <> " in " - <> testsDir - - forM_ tests $ \(test, cfg) -> - plotTest (Proxy @Basic125) test cfg (testsDir test) outDir + [plotDataSource, outputDir] -> do + (fullyQualifiedTestName, plotDataDir) <- getSourceData plotDataSource + ccConfs <- case Map.lookup fullyQualifiedTestName knownTestsWithCcConf of + Nothing -> die $ "Could not find test config: " <> fullyQualifiedTestName + Just ccConfs -> pure ccConfs + + forM_ ccConfs $ \(testName, ccConf) -> do + plotTest (Proxy @Basic125) testName ccConf (plotDataDir testName) outputDir + _ -> wrongNumberOfArguments where - getTestsWithCcConf name = - maybe [] snd $ find ((== name) . fst) knownTestsWithCcConf - - diveDownInto epsfix dir = - listDirectory dir - >>= filterM doesDirectoryExist . fmap (dir ) - >>= \case - [] -> die $ "Empty directory: " <> dir - dirs -> - let subDirs = takeFileName <$> dirs - in if - | "vivado" `elem` subDirs -> - diveDownInto epsfix $ dir "vivado" - | "ila-data" `elem` subDirs -> - diveDownInto epsfix $ dir "ila-data" - | otherwise -> - case filter (either isPrefixOf isSuffixOf epsfix) subDirs of - subDir : _ -> diveDownInto epsfix $ dir subDir - _ -> return dir - - isRunArtifactReference arg = case span (/= ':') arg of - (xs, ':' : ys) - | all isDigit xs && ':' `notElem` ys -> Just (xs, ys) - | otherwise -> Nothing - _ -> Nothing - wrongNumberOfArguments = do name <- getProgName die $ "Wrong number of arguments. Aborting.\n\n" <> "Usage: " <> name - <> " []" + <> " " diff --git a/bittide-tools/hitl/config-gen/Main.hs b/bittide-tools/hitl/config-gen/Main.hs deleted file mode 100644 index 9b0fd13bf..000000000 --- a/bittide-tools/hitl/config-gen/Main.hs +++ /dev/null @@ -1,147 +0,0 @@ --- SPDX-FileCopyrightText: 2024 Google LLC --- --- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PackageImports #-} - -{- | Program that writes YAML configuration files to '_build/hitl', to be used -by the TCL using Vivado to run hardware-in-the-loop tests. - -By default, it writes all known files. If given an identifier, it will only -write that one. --} -module Main where - -import Clash.Prelude (BitPack) -import Prelude - -import Control.Monad (forM, forM_, when) -import Data.Aeson (ToJSON) -import Data.List (intercalate) -import Options.Applicative -import Paths.Bittide.Instances (getDataFileName) -import System.Directory (createDirectoryIfMissing) -import System.Exit (die) -import System.FilePath (()) -import System.IO (hPutStrLn, stderr) - -import Bittide.Hitl (HitlTestsWithPostProcData, packAndEncode) -import Bittide.Instances.Hitl.Tests (HitlTest (..), hitlTests) - -import Data.ByteString.Lazy.Char8 qualified as LazyByteString - --- | A HITL test configuration encoded as YAML accompanied by a test name. -data Config = Config - { name :: String - , yaml :: LazyByteString.ByteString - } - --- | Known configurations that can be written to @_build/hitl@ -configs :: IO [Config] -configs = forM hitlTests $ \case - KnownType nm config -> pure $ makeConfig nm config - LoadConfig nm fileName -> loadConfig nm fileName - --- | First argument on command line, as Haskell type -data Arg - = Write - { fqn :: Maybe String - -- ^ Fully qualified name of HITL YAML to render. If 'Nothing', render all - -- known identifiers - } - | List - --- | Be verbose to stderr? -type Verbose = Bool - --- | First argument passed on command line parser -argParser :: Parser (Verbose, Arg) -argParser = (,) <$> verbose <*> arg - where - verbose = switch (long "verbose" <> short 'v' <> help "Whether to be verbose") - - arg = - subparser $ - command - "write" - (info writeConfigsParser (progDesc "Write all known configs to _build/hitl")) - <> command - "list" - (info (pure List) (progDesc "List all known configs stdout")) - --- | Parser for the write command, now expecting an optional identifier -writeConfigsParser :: Parser Arg -writeConfigsParser = - fmap Write $ - optional $ - strArgument $ - metavar "FULLY_QUALIFIED_NAME" - <> help "For example, 'Bittide.Instances.Hitl.FincFdec.fincFdecTests'" - --- | Load config from an existing YAML file in 'data/test_configs' -loadConfig :: String -> FilePath -> IO Config -loadConfig nm fileName = do - fullPath <- getDataFileName ("data" "test_configs" fileName) - yamlContents <- LazyByteString.readFile fullPath - pure $ - Config - { name = nm - , yaml = yamlContents - } - --- | Create config from a known HITL test. -makeConfig :: - forall a b. - (BitPack a, ToJSON b) => - String -> - HitlTestsWithPostProcData a b -> - Config -makeConfig nm config = - Config - { name = nm - , yaml = packAndEncode config - } - -main :: IO () -main = do - let buildDir = "_build/hitl" - createDirectoryIfMissing True buildDir - configs1 <- configs - - customExecParser parserPrefs opts >>= \case - -- Write all configs - (verbose, Write Nothing) -> do - forM_ configs1 $ \Config{name, yaml} -> do - let path = buildDir name <> ".yml" - when verbose $ hPutStrLn stderr $ "Writing " <> path <> ".." - LazyByteString.writeFile path yaml - - -- Write specific config - (verbose, Write (Just fqn)) -> do - let - matchedConfig = filter (\Config{name} -> name == fqn) configs1 - names = intercalate "\n" (map name configs1) - - case matchedConfig of - [] -> die $ "No config found for '" <> fqn <> "'. Available: \n\n" <> names - (_ : _ : _) -> die $ "Multiple configs matched '" <> fqn <> "'" - [Config{name, yaml}] -> do - let path = buildDir name <> ".yml" - when verbose $ hPutStrLn stderr $ "Writing " <> path <> ".." - LazyByteString.writeFile path yaml - (_verbose, List) -> do - forM_ configs1 $ \Config{name} -> - putStrLn name - where - parserPrefs = - prefs $ - showHelpOnError - <> showHelpOnEmpty - <> noBacktrack - - opts = - info - (argParser <**> helper <**> versionOption) - (fullDesc <> progDesc "HITL config rendering") - - versionOption = infoOption "1.0" (long "version" <> help "Show version") diff --git a/bittide/src/Bittide/Wishbone.hs b/bittide/src/Bittide/Wishbone.hs index ee5b2c8db..771d9ace7 100644 --- a/bittide/src/Bittide/Wishbone.hs +++ b/bittide/src/Bittide/Wishbone.hs @@ -124,10 +124,10 @@ ilaWb :: (Wishbone dom 'Standard addrW a) ilaWb SSymbol stages0 depth0 = Circuit $ \(m2s, s2m) -> let - -- Our TCL infrastructure looks for 'trigger' and 'capture' and uses it to - -- trigger the ILA and do selective capture. Though defaults are changable - -- using Vivado, we set it to capture only valid Wishbone transactions plus - -- a single cycle after it. + -- Our HITL test infrastructure looks for 'trigger' and 'capture' and uses + -- it to trigger the ILA and do selective capture. Though defaults are + -- changable using Vivado, we set it to capture only valid Wishbone + -- transactions plus a single cycle after it. trigger = Wishbone.strobe <$> m2s .&&. Wishbone.busCycle <$> m2s capture = trigger .||. dflipflop trigger diff --git a/nix/bin/shake b/nix/bin/shake index 54e64ef99..e1d2a30a2 100755 --- a/nix/bin/shake +++ b/nix/bin/shake @@ -1,5 +1,16 @@ #!/usr/bin/env bash -# SPDX-FileCopyrightText: 2022 Google LLC +# SPDX-FileCopyrightText: 2022-2024 Google LLC # # SPDX-License-Identifier: Apache-2.0 + +# TODO: Calling cargo here is a workaround for the Shakefile now importing +# Bittide.Instances.Hitl.Tests which requires Bittide.Instances.Hitl.VexRiscv +# which uses Template Haskell to read firmware binaries. I.e. Shake can +# no longer call cargo to build the binaries before they are required. +# The future goal is to not have the firmware in the FPGA bitstream as +# described here: https://github.com/bittide/bittide-hardware/issues/502 +echo "Building firmware binaries..." +$(cd firmware-binaries/; cargo build --release) +$(cd firmware-binaries/; cargo build) + cabal run shake -- "$@" diff --git a/vivado-hs/src/Vivado.hs b/vivado-hs/src/Vivado.hs index c70459876..46b42216f 100644 --- a/vivado-hs/src/Vivado.hs +++ b/vivado-hs/src/Vivado.hs @@ -2,6 +2,40 @@ -- -- SPDX-License-Identifier: Apache-2.0 +{- | Lets Vivado execute Tcl code by attaching to stdin and stdout of Vivado in +Tcl mode. + +There are two main things to keep in mind when working with this module: + + 1. Vivado Tcl commands can return objects that, when evaluated, are echoed + to the Vivado console and log file as a Tcl string due to a feature of + Tcl called "shimmering". This module can then return them as a Haskell + string. Commands that expect such objects cannot be passed the shimmered + string. There are several options to work around this: + + a. Keep the object in Tcl land by storing it in a variable using `set`. + + b. Keep the object in Tcl land by using dedicated Vivado helper commands + such as `connect_hw_server`, `current_hw_target`, `current_hw_ila`, + etc, to "set" the current object of that type. + + c. Pass the shimmered string from Haskell to a function that can lookup + the corresponding object again. This can be done using the same + commands as in the previous option, but now used to get the objects + instead of setting them. + + 3. Bringing objects into Haskell results in shimmering, which changes their + representation from a faster native Tcl object to a Tcl string. This may + have performance implications. Furthermore, Vivado truncates shimmered + strings to the number of characters set in the + tcl.collectionResultDisplayLimit parameter, which supposedly has a + default value of 500. This implies that it is challenging to transfer + large amounts of data from Vivado to Haskell through the approach taken + by this module. + +Refer to the "Vivado Design Suite Tcl Command Reference Guide" (UG835) for +more information. +-} module Vivado ( with, exec, diff --git a/vivado-hs/src/Vivado/Internal.hs b/vivado-hs/src/Vivado/Internal.hs index d33cda004..e3e1f503a 100644 --- a/vivado-hs/src/Vivado/Internal.hs +++ b/vivado-hs/src/Vivado/Internal.hs @@ -24,6 +24,7 @@ import Data.String.Interpolate (__i) import Data.Typeable (Typeable) import GHC.Stack (HasCallStack) import System.Directory.Extra (removeFile) +import System.Environment (setEnv) import System.IO (Handle) import System.Process @@ -189,7 +190,7 @@ exec v cmd = do inputAvailable <- IO.hReady v.stdout return $ if inputAvailable then Continue else Stop -{- | Execute a command in Vivado, ignore its output +{- | Execute a command in Vivado and ignore the command result. Careful: do not use this function with unverified user input, as it does not attempt to sanitize the input. @@ -197,12 +198,24 @@ attempt to sanitize the input. exec_ :: VivadoHandle -> String -> IO () exec_ v cmd = void (exec v cmd) +{- | Execute a command in Vivado, print the resulting standard output and return +the command result. + +Careful: do not use this function with unverified user input, as it does not +attempt to sanitize the input. +-} execPrint :: VivadoHandle -> String -> IO String execPrint v cmd = do (stdout, result) <- exec v cmd putStr stdout return result +{- | Execute a command in Vivado, print the resulting standard output and ignore +the command result. + +Careful: do not use this function with unverified user input, as it does not +attempt to sanitize the input. +-} execPrint_ :: VivadoHandle -> String -> IO () execPrint_ v cmd = do (stdout, _) <- exec v cmd @@ -225,12 +238,14 @@ with f = do a <- finally -- do: - ( withCreateProcess vivadoProc $ - \(fromJust -> stdin) (fromJust -> stdout) _stderr process -> do - IO.hSetBuffering stdout IO.LineBuffering - IO.hSetBuffering stdin IO.LineBuffering - let v = VivadoHandle{..} - f v + ( do + setEnv "XILINX_LOCAL_USER_DATA" "no" -- Prevents multiprocessing issues + withCreateProcess vivadoProc $ + \(fromJust -> stdin) (fromJust -> stdout) _stderr process -> do + IO.hSetBuffering stdout IO.LineBuffering + IO.hSetBuffering stdin IO.LineBuffering + let v = VivadoHandle{..} + f v ) -- finally: ( do diff --git a/vivado-hs/src/Vivado/Tcl.hs b/vivado-hs/src/Vivado/Tcl.hs new file mode 100644 index 000000000..589571c64 --- /dev/null +++ b/vivado-hs/src/Vivado/Tcl.hs @@ -0,0 +1,346 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} + +{- | Haskell abstractions over Vivado Hardware Manager Tcl objects and commands. +See section "Description of Hardware Manager Tcl Objects and Commands" of the +"Vivado Design Suite User Guide Programming and Debugging" (UG908) for more +information. +-} +module Vivado.Tcl where + +import Control.Monad (unless, void, when) +import Data.Maybe (listToMaybe) +import Vivado + +-- | Executes a TCL command with an optional list of arguments. +execCmd :: VivadoHandle -> String -> [String] -> IO String +execCmd v cmd args = execPrint v $ unwords $ cmd : args + +-- | Executes a TCL command with an optional list of arguments. +execCmd_ :: VivadoHandle -> String -> [String] -> IO () +execCmd_ v cmd = void . execCmd v cmd + +{- | Attempts to interpret a Tcl expression as a list and return it as a Haskell +list. May very well fail, even with valid Tcl lists. +-} +tclToList :: String -> [String] +tclToList = go [] + where + go :: [String] -> String -> [String] + go acc [] = acc + go acc (' ' : xs) = go acc xs + go acc ('\n' : xs) = go acc xs + go acc list@('"' : xs) = do + let (word, list') = span (/= '"') xs + unless (listToMaybe list' == Just '"') $ + error $ + "No closing '\"' found in " <> show list + go (acc <> [word]) (tail list') + go acc list@('{' : xs) = do + let (word, list') = span (/= '}') xs + unless (listToMaybe list' == Just '}') $ + error $ + "No closing brace '}' found in " <> show list + when ('{' `elem` list) $ + error "Nested Tcl braces ('{', '}') are not supported by this function." + go (acc <> [word]) (tail list') + go acc xs = go (acc <> [head $ words xs]) (unwords $ tail $ words xs) + +embrace :: String -> String +embrace s = '{' : s <> "}" + +-- | Produces a Tcl expression for a list from a given Haskell list. +listToTcl :: [String] -> String +listToTcl l = "[list " <> unwords (toWord <$> l) <> "]" + where + toWord s = if ' ' `elem` s then embrace s else s + +-- * Hardware Manager Tcl objects and commands + +-- ** hw_server Tcl commands + +-- | hw_server Tcl object +newtype HwServer = HwServer {fromHwServer :: String} + deriving (Eq) + +instance Show HwServer where + show = fromHwServer + +-- | Open a connection to a hardware server. Wrapper for the equally named Vivado Hardware Server Tcl command. +connect_hw_server :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwServer +connect_hw_server v = fmap HwServer . execCmd v "connect_hw_server" + +-- | Get or set the current hardware server. +current_hw_server :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwServer +current_hw_server v = fmap HwServer . execCmd v "current_hw_server" + +-- | Close a connection to a hardware server. +disconnect_hw_server :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +disconnect_hw_server v = execCmd_ v "disconnect_hw_server" + +-- | Get list of hardware server names for the hardware servers. +get_hw_servers :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwServer] +get_hw_servers v args = do + hwServers <- execCmd v "get_hw_servers" args + return $ HwServer <$> tclToList hwServers + +-- | Refresh a connection to a hardware server. +refresh_hw_server :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +refresh_hw_server v = execCmd_ v "refresh_hw_server" + +-- ** hw_target Tcl commands + +-- | hw_target Tcl object +newtype HwTarget = HwTarget {fromHwTarget :: String} + deriving (Eq, Ord) + +instance Show HwTarget where + show = fromHwTarget + +-- | Close a hardware target. +close_hw_target :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +close_hw_target v = execCmd_ v "close_hw_target" + +-- | Get or set the current hardware target. +current_hw_target :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwTarget +current_hw_target v = fmap HwTarget . execCmd v "current_hw_target" + +-- | Get list of hardware targets for the hardware servers. +get_hw_targets :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwTarget] +get_hw_targets v args = do + hwTargets <- execCmd v "get_hw_targets" args + return $ HwTarget <$> tclToList hwTargets + +-- | Open a connection to a hardware target on the hardware server. +open_hw_target :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +open_hw_target v = execCmd_ v "open_hw_target" + +-- | Refresh a connection to a hardware server. +refresh_hw_target :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +refresh_hw_target v = execCmd_ v "refresh_hw_target" + +-- ** hw_device Tcl commands + +-- | hw_device Tcl object +newtype HwDevice = HwDevice {fromHwDevice :: String} + deriving (Eq) + +instance Show HwDevice where + show = fromHwDevice + +-- | Get or set the current hardware device. +current_hw_device :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwDevice +current_hw_device v = fmap HwDevice . execCmd v "current_hw_device" + +-- | Get list of hardware devices for the target. +get_hw_devices :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwDevice] +get_hw_devices v args = do + hwDevices <- execCmd v "get_hw_devices" args + return $ HwDevice <$> tclToList hwDevices + +-- | Program AMD FPGA devices. +program_hw_devices :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwDevice] +program_hw_devices v args = do + hwDevices <- execCmd v "program_hw_devices" args + return $ HwDevice <$> tclToList hwDevices + +-- | Refresh a hardware device. +refresh_hw_device :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +refresh_hw_device v = execCmd_ v "refresh_hw_device" + +-- ** hw_ila Tcl commands + +-- | hw_ila Tcl object +newtype HwIla = HwIla {fromHwIla :: String} + deriving (Eq) + +instance Show HwIla where + show = fromHwIla + +-- | Get or set the current hardware ILA. +current_hw_ila :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwIla +current_hw_ila v = fmap HwIla . execCmd v "current_hw_ila" + +-- | Get list of hardware ILAs for the target. +get_hw_ilas :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwIla] +get_hw_ilas v args = do + hwIlas <- execCmd v "get_hw_ilas" args + return $ HwIla <$> tclToList hwIlas + +-- | Reset hw_ila control properties to default values. +reset_hw_ila :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +reset_hw_ila v = execCmd_ v "reset_hw_ila" + +-- | Arm hw_ila triggers. +run_hw_ila :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +run_hw_ila v = execCmd_ v "run_hw_ila" + +-- | Wait until all data has been captured. +wait_on_hw_ila :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +wait_on_hw_ila v = execCmd_ v "wait_on_hw_ila" + +-- ** hw_probe Tcl commands + +-- | hw_probe Tcl object +newtype HwProbe = HwProbe {fromHwProbe :: String} + deriving (Eq) + +instance Show HwProbe where + show = fromHwProbe + +-- | Creates a new hardware probe from physical ILA probe ports and/or constant values. +create_hw_probe :: + VivadoHandle -> + -- | Arguments + [String] -> + IO HwProbe +create_hw_probe v = fmap HwProbe . execCmd v "create_hw_probe" + +-- | Deletes a user-defined hardware probe creating using the create_hw_probe command. +delete_hw_probe :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +delete_hw_probe v = execCmd_ v "delete_hw_probe" + +-- | Get list of hardware probes. +get_hw_probes :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwProbe] +get_hw_probes v args = do + hwProbes <- execCmd v "get_hw_probes" args + return $ HwProbe <$> tclToList hwProbes + +-- ** hw_vio Tcl commands + +-- | hw_vio Tcl object +newtype HwVio = HwVio {fromHwVio :: String} + deriving (Eq) + +instance Show HwVio where + show = fromHwVio + +-- | Write hw_probe OUTPUT_VALUE properties values to VIO cores. +commit_hw_vio :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +commit_hw_vio v = execCmd_ v "commit_hw_vio" + +-- | Get a list of hw_vios. +get_hw_vios :: + VivadoHandle -> + -- | Arguments + [String] -> + IO [HwVio] +get_hw_vios v args = do + hwVios <- execCmd v "get_hw_vios" args + return $ HwVio <$> tclToList hwVios + +-- | Update hw_probe INPUT_VALUE and ACTIVITY_VALUE properties with values read from VIO cores. +refresh_hw_vio :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +refresh_hw_vio v = execCmd_ v "refresh_hw_vio" + +-- | Reset VIO ACTIVITY_VALUE properties, for hw_probes associated with specified hw_vio objects. +reset_hw_vio_activity :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +reset_hw_vio_activity v = execCmd_ v "reset_hw_vio_activity" + +-- | Reset VIO core outputs to initial values. +reset_hw_vio_outputs :: + VivadoHandle -> + -- | Arguments + [String] -> + IO () +reset_hw_vio_outputs v = execCmd_ v "refresh_hw_vio" diff --git a/vivado-hs/vivado-hs.cabal b/vivado-hs/vivado-hs.cabal index 5971a1533..0b353a2c7 100644 --- a/vivado-hs/vivado-hs.cabal +++ b/vivado-hs/vivado-hs.cabal @@ -52,6 +52,9 @@ library import: common-options exposed-modules: Vivado + Vivado.Tcl + + other-modules: Vivado.Internal build-depends: