From 77f02b2fc984c760592e68df90ac6c49b8886719 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 4 Jun 2024 14:42:04 +0200 Subject: [PATCH 1/4] Add `vivado-hs` A way of controlling a Vivado instance from Haskell --- cabal.project | 1 + vivado-hs/LICENSE | 202 +++++++++++++++++++++++++++ vivado-hs/src/Vivado.hs | 12 ++ vivado-hs/src/Vivado/Internal.hs | 224 ++++++++++++++++++++++++++++++ vivado-hs/tests/Tests/Vivado.hs | 56 ++++++++ vivado-hs/tests/unittests.hs | 19 +++ vivado-hs/vivado-hs.cabal | 90 ++++++++++++ vivado-hs/vivado-hs.cabal.license | 3 + 8 files changed, 607 insertions(+) create mode 100644 vivado-hs/LICENSE create mode 100644 vivado-hs/src/Vivado.hs create mode 100644 vivado-hs/src/Vivado/Internal.hs create mode 100644 vivado-hs/tests/Tests/Vivado.hs create mode 100644 vivado-hs/tests/unittests.hs create mode 100644 vivado-hs/vivado-hs.cabal create mode 100644 vivado-hs/vivado-hs.cabal.license diff --git a/cabal.project b/cabal.project index 305480eaa..44cacd190 100644 --- a/cabal.project +++ b/cabal.project @@ -9,6 +9,7 @@ packages: bittide-tools/ bittide/ clash-vexriscv/clash-vexriscv/ + vivado-hs write-ghc-environment-files: always -- index state, to go along with the cabal.project.freeze file. update the index diff --git a/vivado-hs/LICENSE b/vivado-hs/LICENSE new file mode 100644 index 000000000..d64569567 --- /dev/null +++ b/vivado-hs/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/vivado-hs/src/Vivado.hs b/vivado-hs/src/Vivado.hs new file mode 100644 index 000000000..25757d348 --- /dev/null +++ b/vivado-hs/src/Vivado.hs @@ -0,0 +1,12 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 + +module Vivado ( + with, + exec, + exec_, + TclException (..), +) where + +import Vivado.Internal diff --git a/vivado-hs/src/Vivado/Internal.hs b/vivado-hs/src/Vivado/Internal.hs new file mode 100644 index 000000000..5628dbe34 --- /dev/null +++ b/vivado-hs/src/Vivado/Internal.hs @@ -0,0 +1,224 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NoFieldSelectors #-} + +module Vivado.Internal where + +import Prelude + +import Control.Exception (Exception, finally, throwIO) +import Control.Monad (forM_, unless, void) +import Data.Foldable (toList) +import Data.List.Extra (isPrefixOf, splitOn, trim) +import Data.Maybe (fromJust) +import Data.Sequence (Seq ((:|>))) +import Data.String.Interpolate (__i) +import Data.Typeable (Typeable) +import GHC.Stack (HasCallStack) +import System.Directory.Extra (removeFile) +import System.IO (Handle) +import System.Process + +import System.IO qualified as IO +import System.IO.Temp qualified as Temp + +data VivadoHandle = VivadoHandle + { stdin :: Handle + -- ^ Handle to write to + , stdout :: Handle + -- ^ Handle to read from. Note that TCL does not use stderr. + , process :: ProcessHandle + , logHandle :: Handle + -- ^ Handle to full log: everything that Vivado writes to stdout, and everything + -- that we write to Vivado. + , logPath :: FilePath + , prettyLogHandle :: Handle + -- ^ Handle to pretty log: everything that Vivado writes to stdout, and everything + -- that we write to Vivado, but without the magic and error handling cruft. + , prettyLogPath :: FilePath + } + +data TclException = TclException + { cmd :: String + , stdout :: [String] + , error :: String + , logPath :: String + , prettyLogPath :: String + } + deriving (Typeable) + +instance Show TclException where + show :: TclException -> String + show (TclException{error = e, ..}) = + "TclException: " + <> [__i| + Got error while executing: + + #{cmd} + + Error was: + + #{e} + + Output before and during the crash: + + #{trim (unlines stdout)} + + Log up to the crash: + + Full: #{logPath} + Pretty: #{prettyLogPath} + |] + +instance Exception TclException + +{- | Magic string that Vivado will echo back to us to signal that it has +finished processing a command. +-} +magic :: String +magic = "471ac6f71ba9bd7982741d53edfe809d50f43035645fe99f890761b2bf1ef6bfac18" + +data Error = Ok | Error String +data Filter = Continue | Stop Error + +{- | Utility function that reads lines from a handle, and applies a filter to +each line. If the filter returns 'Continue', the function will continue +reading lines. If the filter returns @Stop Ok@, the function will return +successfully. If the filter returns @Stop e@, the function will return a +'Just' with the supplied error message. +-} +expectLine :: + (HasCallStack) => + VivadoHandle -> + (String -> Filter) -> + IO (Seq String, Maybe String) +expectLine v f = go mempty + where + go lines0 = do + line <- IO.hGetLine v.stdout + IO.hPutStrLn v.logHandle line + unless (magic `isPrefixOf` line) $ + IO.hPutStrLn v.prettyLogHandle line + + let + lines1 = lines0 :|> line + cont = go lines1 + if null line + then cont + else case f line of + Continue -> cont + Stop Ok -> pure (lines1, Nothing) + Stop (Error e) -> pure (lines1, Just e) + +-- | Write a line to the Vivado handle +writeLine :: VivadoHandle -> String -> String -> IO () +writeLine v prettyS s = do + forM_ (lines prettyS) $ \l -> IO.hPutStrLn v.prettyLogHandle (">>> " <> l) + forM_ (lines s) $ \l -> IO.hPutStrLn v.logHandle (">>> " <> l) + IO.hPutStrLn v.stdin s + +{- | Execute a command in Vivado and return the output + +Careful: do not use this function with unverified user input, as it does not +attempt to sanitize the input. +-} +exec :: VivadoHandle -> String -> IO String +exec v cmd = do + writeLine + v + cmd + [__i| + if { [catch {#{cmd}} error_#{magic}] } { + puts -nonewline {#{magic} } + puts -nonewline {ERR } + puts $error_#{magic} + } else { + puts {#{magic} OK} + } + |] + + expectLine v go >>= \case + (stdout, Just e) -> do + IO.hPutStrLn v.prettyLogHandle e + throwIO + ( TclException + { cmd + , stdout = toList stdout + , error = e + , logPath = v.logPath + , prettyLogPath = v.prettyLogPath + } + ) + (stdout, Nothing) -> pure (unlines (toList (seqInit stdout))) + where + seqInit (x :|> _) = x + seqInit x = x + + go :: String -> Filter + go s = + case splitOn " " (trim s) of + (w : ws) | w == magic -> + case ws of + ["OK"] -> Stop Ok + ("ERR" : err) -> Stop (Error (unwords err)) + [] -> error "Internal error: unexpected bare magic string" + err -> error $ "Internal error: unexpected magic string arguments: " <> unwords err + _ -> Continue + +{- | Execute a command in Vivado, ignore its output + +Careful: do not use this function with unverified user input, as it does not +attempt to sanitize the input. +-} +exec_ :: VivadoHandle -> String -> IO () +exec_ v cmd = void (exec v cmd) + +{- | Run a block of code with a Vivado handle. Example usage: + +> import qualified Vivado as V +> +> V.with $ \v -> do +> output <- V.exec v "puts hello" +> putStrLn output +-} +with :: (VivadoHandle -> IO a) -> IO a +with f = do + systemTmpDir <- Temp.getCanonicalTemporaryDirectory + (logPath, logHandle) <- Temp.openTempFile systemTmpDir "vivado-hs.log" + (prettyLogPath, prettyLogHandle) <- Temp.openTempFile systemTmpDir "pretty-vivado-hs.log" + + 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{..} + exec_ v "puts init" + f v + ) + -- finally: + ( do + IO.hClose logHandle + IO.hClose prettyLogHandle + ) + + -- Remove log files if there weren't any exceptions + removeFile logPath + removeFile prettyLogPath + + pure a + where + vivadoProc = + (proc "vivado" ["-mode", "tcl"]) + { std_in = CreatePipe + , std_out = CreatePipe + } diff --git a/vivado-hs/tests/Tests/Vivado.hs b/vivado-hs/tests/Tests/Vivado.hs new file mode 100644 index 000000000..4d1be2527 --- /dev/null +++ b/vivado-hs/tests/Tests/Vivado.hs @@ -0,0 +1,56 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE DuplicateRecordFields #-} + +module Tests.Vivado where + +import Control.Concurrent.Async (forConcurrently) +import Control.Exception (try) + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH + +import Vivado qualified as V + +case_hello_world :: Assertion +case_hello_world = do + output <- V.with $ \v -> V.exec v "puts hello" + output @?= "hello\n" + +case_error :: Assertion +case_error = do + result <- try (V.with (`V.exec` "error fail")) + case result of + Left (V.TclException{error = e}) -> e @?= "fail" + _ -> assertFailure "Expected an error" + +case_invalidCommand :: Assertion +case_invalidCommand = do + result <- try (V.with (`V.exec` " / ")) + case result of + Left (V.TclException{error = e}) -> e @?= "invalid command name \"/\"" + _ -> assertFailure "Expected an error" + +case_usable_after_error :: Assertion +case_usable_after_error = do + V.with $ \v -> do + result <- try $ V.exec v "error fail" + case result of + Left (V.TclException{error = e}) -> do + e @?= "fail" + output <- V.exec v "puts hello" + output @?= "hello\n" + _ -> assertFailure "Expected an error" + +case_async :: Assertion +case_async = do + let nsExpected = [1 .. 8] + nsActual <- forConcurrently nsExpected $ \n -> do + V.with $ \v -> do + V.exec v $ "puts " <> show (n :: Int) + nsActual @?= map ((<> "\n") . show) nsExpected + +tests :: TestTree +tests = $(testGroupGenerator) diff --git a/vivado-hs/tests/unittests.hs b/vivado-hs/tests/unittests.hs new file mode 100644 index 000000000..9a48256b1 --- /dev/null +++ b/vivado-hs/tests/unittests.hs @@ -0,0 +1,19 @@ +-- SPDX-FileCopyrightText: 2024 Google LLC +-- +-- SPDX-License-Identifier: Apache-2.0 + +module Main where + +import Test.Tasty + +import Tests.Vivado qualified + +tests :: TestTree +tests = + testGroup + "unittests" + [ Tests.Vivado.tests + ] + +main :: IO () +main = defaultMain tests diff --git a/vivado-hs/vivado-hs.cabal b/vivado-hs/vivado-hs.cabal new file mode 100644 index 000000000..5971a1533 --- /dev/null +++ b/vivado-hs/vivado-hs.cabal @@ -0,0 +1,90 @@ +cabal-version: 3.4 +name: vivado-hs +version: 0.1.0.0 +synopsis: Haskell wrapper around Vivado TCL +homepage: https://github.com/bittide/bittide +license: Apache-2.0 +license-file: LICENSE +author: QBayLogic B.V. +maintainer: devops@qbaylogic.com +copyright: Google LLC +category: Development +build-type: Simple + +common common-options + default-extensions: + -- TemplateHaskell is used to support convenience functions such as + -- 'listToVecTH' and 'bLit'. + BangPatterns + BinaryLiterals + ConstraintKinds + DataKinds + DefaultSignatures + DeriveAnyClass + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + InstanceSigs + KindSignatures + LambdaCase + NoStarIsType + PolyKinds + QuasiQuotes + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + + ghc-options: + -Wall + -Wcompat + +library + import: common-options + exposed-modules: + Vivado + Vivado.Internal + + build-depends: + base, + containers, + deepseq, + extra, + process, + string-interpolate, + temporary, + + hs-source-dirs: src + default-language: GHC2021 + +test-suite unittests + import: common-options + type: exitcode-stdio-1.0 + main-is: unittests.hs + other-modules: + Tests.Vivado + + build-depends: + async, + base, + tasty, + tasty-hunit, + tasty-th, + vivado-hs, + + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + + hs-source-dirs: tests + default-language: GHC2021 diff --git a/vivado-hs/vivado-hs.cabal.license b/vivado-hs/vivado-hs.cabal.license new file mode 100644 index 000000000..2b4d55897 --- /dev/null +++ b/vivado-hs/vivado-hs.cabal.license @@ -0,0 +1,3 @@ +SPDX-FileCopyrightText: 2024 Google LLC + +SPDX-License-Identifier: CC0-1.0 From 06b3b0882ce6407cb35d1998541f4cf157b91c78 Mon Sep 17 00:00:00 2001 From: Just van Westerveld Date: Tue, 18 Jun 2024 16:51:31 +0200 Subject: [PATCH 2/4] Vivado-hs: support getting back return values Also now support Vivado stdout without a newline at the end (e.g. `puts -nonewline`) --- bittide-shake/bittide-shake.cabal | 3 + cabal.project | 11 ++- vivado-hs/src/Vivado.hs | 3 + vivado-hs/src/Vivado/Internal.hs | 127 ++++++++++++++++++------------ vivado-hs/tests/Tests/Vivado.hs | 40 +++++++--- 5 files changed, 124 insertions(+), 60 deletions(-) diff --git a/bittide-shake/bittide-shake.cabal b/bittide-shake/bittide-shake.cabal index 68b27dc15..ac1d3f6b4 100644 --- a/bittide-shake/bittide-shake.cabal +++ b/bittide-shake/bittide-shake.cabal @@ -24,12 +24,14 @@ common common-options clash-lib, clash-prelude, cryptohash-sha256, + directory, extra, filepath, shake, string-interpolate, text, vector, + vivado-hs, library import: common-options @@ -79,3 +81,4 @@ executable shake directory, process, tasty-hunit, + vivado-hs, diff --git a/cabal.project b/cabal.project index 44cacd190..3ed03ffd8 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ packages: bittide-tools/ bittide/ clash-vexriscv/clash-vexriscv/ - vivado-hs + vivado-hs/ write-ghc-environment-files: always -- index state, to go along with the cabal.project.freeze file. update the index @@ -125,6 +125,15 @@ package clash-vexriscv-sim -RTS -j8 +package vivado-hs + ghc-options: + +RTS + -xp + -qn8 + -A64M + -RTS + -j8 + -- index state, to go along with the cabal.project.freeze file. update the index -- state by running `cabal update` twice and looking at the index state it -- displays to you (as the second update will be a no-op) diff --git a/vivado-hs/src/Vivado.hs b/vivado-hs/src/Vivado.hs index 25757d348..c70459876 100644 --- a/vivado-hs/src/Vivado.hs +++ b/vivado-hs/src/Vivado.hs @@ -6,6 +6,9 @@ module Vivado ( with, exec, exec_, + execPrint, + execPrint_, + VivadoHandle (..), TclException (..), ) where diff --git a/vivado-hs/src/Vivado/Internal.hs b/vivado-hs/src/Vivado/Internal.hs index 5628dbe34..d33cda004 100644 --- a/vivado-hs/src/Vivado/Internal.hs +++ b/vivado-hs/src/Vivado/Internal.hs @@ -16,6 +16,7 @@ import Prelude import Control.Exception (Exception, finally, throwIO) import Control.Monad (forM_, unless, void) import Data.Foldable (toList) +import Data.List (intercalate) import Data.List.Extra (isPrefixOf, splitOn, trim) import Data.Maybe (fromJust) import Data.Sequence (Seq ((:|>))) @@ -47,8 +48,9 @@ data VivadoHandle = VivadoHandle data TclException = TclException { cmd :: String - , stdout :: [String] - , error :: String + , stdout :: String + , retCode :: ErrorCode + , errMsg :: String , logPath :: String , prettyLogPath :: String } @@ -56,20 +58,20 @@ data TclException = TclException instance Show TclException where show :: TclException -> String - show (TclException{error = e, ..}) = + show (TclException{..}) = "TclException: " <> [__i| - Got error while executing: + Got return code #{retCode} while executing: #{cmd} - Error was: + Error message was: - #{e} + #{errMsg} Output before and during the crash: - #{trim (unlines stdout)} + #{trim stdout} Log up to the crash: @@ -79,14 +81,14 @@ instance Show TclException where instance Exception TclException -{- | Magic string that Vivado will echo back to us to signal that it has -finished processing a command. +{- | Magic string that we'll instruct Vivado to echo back to us to signal that +it has finished processing a command. -} magic :: String magic = "471ac6f71ba9bd7982741d53edfe809d50f43035645fe99f890761b2bf1ef6bfac18" -data Error = Ok | Error String -data Filter = Continue | Stop Error +type ErrorCode = String +data Filter = Continue | Stop | StopWithError ErrorCode {- | Utility function that reads lines from a handle, and applies a filter to each line. If the filter returns 'Continue', the function will continue @@ -97,25 +99,23 @@ successfully. If the filter returns @Stop e@, the function will return a expectLine :: (HasCallStack) => VivadoHandle -> - (String -> Filter) -> - IO (Seq String, Maybe String) + (String -> IO Filter) -> + IO (Seq String, Maybe ErrorCode) expectLine v f = go mempty where - go lines0 = do + go :: Seq String -> IO (Seq String, Maybe ErrorCode) + go acc = do line <- IO.hGetLine v.stdout + IO.hPutStrLn v.logHandle line unless (magic `isPrefixOf` line) $ IO.hPutStrLn v.prettyLogHandle line - let - lines1 = lines0 :|> line - cont = go lines1 - if null line - then cont - else case f line of - Continue -> cont - Stop Ok -> pure (lines1, Nothing) - Stop (Error e) -> pure (lines1, Just e) + let lines' = acc :|> line + f line >>= \case + Continue -> go lines' + Stop -> return (lines', Nothing) + StopWithError code -> return (lines', Just code) -- | Write a line to the Vivado handle writeLine :: VivadoHandle -> String -> String -> IO () @@ -124,53 +124,70 @@ writeLine v prettyS s = do forM_ (lines s) $ \l -> IO.hPutStrLn v.logHandle (">>> " <> l) IO.hPutStrLn v.stdin s -{- | Execute a command in Vivado and return the output +{- | Execute a command in Vivado and return the resulting standard output and +the command result. Careful: do not use this function with unverified user input, as it does not attempt to sanitize the input. -} -exec :: VivadoHandle -> String -> IO String +exec :: VivadoHandle -> String -> IO (String, String) exec v cmd = do + -- handle exceptionHandler $ do + -- Write a line that would let Vivado run the command in a catch construct and + -- print our magic string after that. If an error occurred, the return code is + -- included and what is returned is the error message. Otherwise the command + -- result is returned. writeLine v cmd [__i| - if { [catch {#{cmd}} error_#{magic}] } { - puts -nonewline {#{magic} } - puts -nonewline {ERR } - puts $error_#{magic} + if { [catch {#{cmd}} result_#{magic} opt_dict_#{magic}] } { + puts {} + puts -nonewline {#{magic} ERR } + puts [dict get $opt_dict_#{magic} {-code}] + puts $result_#{magic} } else { + puts {} puts {#{magic} OK} + puts $result_#{magic} } |] - expectLine v go >>= \case - (stdout, Just e) -> do - IO.hPutStrLn v.prettyLogHandle e + -- Discard the line with the magic string at the end + (stdout :|> _, mErr) <- expectLine v filtUntilMagic + let stdoutS = intercalate "\n" $ toList stdout + + -- The return value + (retVal, _) <- expectLine v filtUntilEnd + let retValS = intercalate "\n" $ toList retVal + + case mErr of + Nothing -> + return (stdoutS, retValS) + Just returnCode -> do throwIO ( TclException - { cmd - , stdout = toList stdout - , error = e + { cmd = cmd + , stdout = stdoutS + , retCode = returnCode + , errMsg = retValS , logPath = v.logPath , prettyLogPath = v.prettyLogPath } ) - (stdout, Nothing) -> pure (unlines (toList (seqInit stdout))) where - seqInit (x :|> _) = x - seqInit x = x - - go :: String -> Filter - go s = - case splitOn " " (trim s) of - (w : ws) | w == magic -> - case ws of - ["OK"] -> Stop Ok - ("ERR" : err) -> Stop (Error (unwords err)) - [] -> error "Internal error: unexpected bare magic string" - err -> error $ "Internal error: unexpected magic string arguments: " <> unwords err - _ -> Continue + filtUntilMagic :: String -> IO Filter + filtUntilMagic line + | magic `isPrefixOf` line = case splitOn " " line of + [_magic, "OK"] -> return Stop + [_magic, "ERR", code] -> return (StopWithError code) + _ -> error $ "Unexpected magic string format: " <> line + | otherwise = return Continue + + filtUntilEnd :: String -> IO Filter + filtUntilEnd _ = do + inputAvailable <- IO.hReady v.stdout + return $ if inputAvailable then Continue else Stop {- | Execute a command in Vivado, ignore its output @@ -180,6 +197,17 @@ attempt to sanitize the input. exec_ :: VivadoHandle -> String -> IO () exec_ v cmd = void (exec v cmd) +execPrint :: VivadoHandle -> String -> IO String +execPrint v cmd = do + (stdout, result) <- exec v cmd + putStr stdout + return result + +execPrint_ :: VivadoHandle -> String -> IO () +execPrint_ v cmd = do + (stdout, _) <- exec v cmd + putStr stdout + {- | Run a block of code with a Vivado handle. Example usage: > import qualified Vivado as V @@ -202,7 +230,6 @@ with f = do IO.hSetBuffering stdout IO.LineBuffering IO.hSetBuffering stdin IO.LineBuffering let v = VivadoHandle{..} - exec_ v "puts init" f v ) -- finally: diff --git a/vivado-hs/tests/Tests/Vivado.hs b/vivado-hs/tests/Tests/Vivado.hs index 4d1be2527..468306a4f 100644 --- a/vivado-hs/tests/Tests/Vivado.hs +++ b/vivado-hs/tests/Tests/Vivado.hs @@ -16,21 +16,40 @@ import Vivado qualified as V case_hello_world :: Assertion case_hello_world = do - output <- V.with $ \v -> V.exec v "puts hello" - output @?= "hello\n" + (stdout, retval) <- V.with $ \v -> V.exec v "" >> V.exec v "puts hello" + stdout @?= "hello\n" + retval @?= "" + +case_hello_world_nonewline :: Assertion +case_hello_world_nonewline = do + (stdout, retval) <- V.with $ \v -> V.exec v "" >> V.exec v "puts -nonewline hello" + stdout @?= "hello" + retval @?= "" + +case_returnVal :: Assertion +case_returnVal = do + (stdout, retval) <- V.with $ \v -> do + _ <- V.exec v "proc my_proc {} { return \"hello\nthere\" }" + V.exec v "my_proc" + stdout @?= "" + retval @?= "hello\nthere" case_error :: Assertion case_error = do result <- try (V.with (`V.exec` "error fail")) case result of - Left (V.TclException{error = e}) -> e @?= "fail" + Left (V.TclException{retCode, errMsg}) -> do + retCode @?= "1" + errMsg @?= "fail" _ -> assertFailure "Expected an error" case_invalidCommand :: Assertion case_invalidCommand = do result <- try (V.with (`V.exec` " / ")) case result of - Left (V.TclException{error = e}) -> e @?= "invalid command name \"/\"" + Left (V.TclException{retCode, errMsg}) -> do + retCode @?= "1" + errMsg @?= "invalid command name \"/\"" _ -> assertFailure "Expected an error" case_usable_after_error :: Assertion @@ -38,10 +57,12 @@ case_usable_after_error = do V.with $ \v -> do result <- try $ V.exec v "error fail" case result of - Left (V.TclException{error = e}) -> do - e @?= "fail" - output <- V.exec v "puts hello" - output @?= "hello\n" + Left (V.TclException{retCode, errMsg}) -> do + retCode @?= "1" + errMsg @?= "fail" + (stdout, retval) <- V.exec v "puts hello" + stdout @?= "hello\n" + retval @?= "" _ -> assertFailure "Expected an error" case_async :: Assertion @@ -49,7 +70,8 @@ case_async = do let nsExpected = [1 .. 8] nsActual <- forConcurrently nsExpected $ \n -> do V.with $ \v -> do - V.exec v $ "puts " <> show (n :: Int) + V.exec_ v "" -- To get rid of the Vivado initialization message + fmap fst $ V.exec v $ "puts " <> show (n :: Int) nsActual @?= map ((<> "\n") . show) nsExpected tests :: TestTree From 44bf0e43ba9d482b8d0cf557597a53e668a054b6 Mon Sep 17 00:00:00 2001 From: Just van Westerveld Date: Thu, 22 Aug 2024 16:20:46 +0200 Subject: [PATCH 3/4] 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 | 10 +- .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 | 891 +++++++++++++++--- 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, 1907 insertions(+), 2110 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..400590721 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": "fincFdecTests", "stage": "test"}, + {"top": "fullMeshHwCcTest", "stage": "test"}, + {"top": "fullMeshHwCcWithRiscvTest", "stage": "test"}, + {"top": "fullMeshSwCcTest", "stage": "test"}, + {"top": "hwCcTopologyTest", "stage": "test"}, + {"top": "linkConfigurationTest", "stage": "test"}, + {"top": "safeDffSynchronizer", "stage": "hdl" }, + {"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..ece08bd3f 100644 --- a/.github/synthesis/staging.json +++ b/.github/synthesis/staging.json @@ -1,8 +1,8 @@ [ - {"top": "fullMeshHwCcTest", "stage": "test", "targets": "All"}, - {"top": "fullMeshSwCcTest", "stage": "test", "targets": "All"}, - {"top": "linkConfigurationTest", "stage": "test", "targets": "All"}, + {"top": "fullMeshHwCcTest", "stage": "test"}, + {"top": "fullMeshSwCcTest", "stage": "test"}, + {"top": "linkConfigurationTest", "stage": "test"}, {"top": "safeDffSynchronizer", "stage": "hdl"}, - {"top": "transceiversUpTest", "stage": "test", "targets": "All"}, - {"top": "vexRiscvTest", "stage": "test", "targets": "Specific [-1]"} + {"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..699524cf1 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', 'paramForSingleHwTarget' 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, + paramForSingleHwTarget, + 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 group 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 hardware target. +paramForSingleHwTarget :: HwTargetRef -> a -> Map HwTargetRef a +paramForSingleHwTarget = 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..fb5119b91 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 group 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..86d18909e 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 = paramForSingleHwTarget (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..5fa9831d2 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,657 @@ 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 group 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 (Map.keys 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 HITL test case to 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..58d0bd6b1 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 `current_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. + + 2. 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: From 8ce49786a72efa0068ed78100deca6df37770ed8 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Fri, 6 Sep 2024 20:17:29 +0200 Subject: [PATCH 4/4] Disable fourmolu for table --- .../Bittide/Instances/Hitl/HwCcTopologies.hs | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs index 34d3a3d0e..71b13a4cc 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs @@ -775,34 +775,7 @@ hwCcTopologyTest refClkDiff sysClkDiff syncIn rxns rxps miso = makeTopEntity 'hwCcTopologyTest tests :: HitlTestGroup -tests = - 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 - } +tests = testGroup where m = 1_000_000 @@ -844,6 +817,7 @@ tests = calibrateClockOffsets = calibrateCC False validateClockOffsetCalibration = calibrateCC True + calibrateCC :: Bool -> HitlTestCase HwTargetRef TestConfig CcConf calibrateCC validate = HitlTestCase @@ -922,3 +896,29 @@ tests = , .. } ) + +{- FOURMOLU_DISABLE -} -- fourmolu doesn't do well with tabular structures + testGroup = + HitlTestGroup + { topEntity = 'hwCcTopologyTest + , extraXdcFiles = [] + , externalHdl = [] + , testCases = + [ -- detect the natual clock offsets to be elided from the later tests + calibrateClockOffsets + + -- 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) + + -- make sure the clock offsets detected during calibration is still the same + , validateClockOffsetCalibration + ] + , mPostProc = Nothing + } +{- FOURMOLU_ENABLE -}