diff --git a/clash-cores/clash-cores.cabal b/clash-cores/clash-cores.cabal index 7b3a44d650..d55dc0b7d2 100644 --- a/clash-cores/clash-cores.cabal +++ b/clash-cores/clash-cores.cabal @@ -98,13 +98,14 @@ common basic-config base >= 4.10 && < 5, clash-prelude, constraints, - ghc-typelits-natnormalise >= 0.6, + containers >=0.5 && <0.7, ghc-typelits-extra >= 0.3.2, ghc-typelits-knownnat >= 0.6, - string-interpolate ^>= 0.3, + ghc-typelits-natnormalise >= 0.6, + lens, QuickCheck, + string-interpolate ^>= 0.3, template-haskell, - containers >=0.5 && <0.7 library import: basic-config @@ -119,6 +120,8 @@ library Clash.Cores.Xilinx.DcFifo.Internal.BlackBoxes Clash.Cores.Xilinx.DcFifo.Internal.Instances Clash.Cores.Xilinx.DcFifo.Internal.Types + Clash.Cores.Xilinx.Ila + Clash.Cores.Xilinx.Ila.Internal Clash.Cores.Xilinx.VIO Clash.Cores.Xilinx.VIO.Internal.BlackBoxes Clash.Cores.Xilinx.Floating diff --git a/clash-cores/src/Clash/Cores/Xilinx/Ila.hs b/clash-cores/src/Clash/Cores/Xilinx/Ila.hs new file mode 100644 index 0000000000..85e8544858 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Xilinx/Ila.hs @@ -0,0 +1,142 @@ +{-| +Copyright : (C) 2023, Google Inc, +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. + +Support for [Xilinx Integrated Logic Analyzer v6.2](https://docs.xilinx.com/v/u/en-US/pg172-ila). +An Integrated Logic Analyzer (ILA) is a feature provided by Xilinx in its design +tools, notably Vivado, that allows designers to debug their FPGA logic in +real-time. It stores the signals it samples in a ring buffer, allowing users to +see values before and after a trigger point. + +It is necessary to read the product guide linked above in order to effectively +use the IP. Clash simulation is not applicable for this IP. + +When using the generated ILAs make sure you have set the correct JTAG clock speed: +[/"For non-Versal architectures, if your design contains debug cores, ensure that the JTAG clock is 2.5 times slower than the debug hub clock."/](https://www.xilinx.com/content/dam/xilinx/support/documents/sw_manuals/xilinx2022_2/ug908-vivado-programming-debugging.pdf) + +-} + +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns#-} + +-- See [Note: eta port names for trueDualPortBlockRam] +{-# OPTIONS_GHC -fno-do-lambda-eta-expansion #-} + +module Clash.Cores.Xilinx.Ila + ( ila + + -- * Config + , IlaConfig(..) + , ilaConfig + , ProbeType(..) + , Depth(..) + + -- * Utilities + , Ila(..) + ) where + +import Clash.Explicit.Prelude + +import Clash.Annotations.Primitive (Primitive (InlineYamlPrimitive)) + +import Data.String.Interpolate (__i) + +import Clash.Cores.Xilinx.Ila.Internal + +-- | A default ILA config that: +-- +-- * Configures no pipeline registers +-- * Stores 4096 samples +-- * Sets 2 comparators per probe +-- * Sets all probes to be suited for DATA and TRIGGER +-- * Enables capture control +-- +-- See 'IlaConfig' for more information. +ilaConfig :: Vec n String -> IlaConfig n +ilaConfig names = IlaConfig + { stages = 0 + , depth = D4096 + , comparators = Left 2 + , probeTypes = Left DataAndTrigger + , probeNames = names + , captureControl = True + , advancedTriggers = False + } + + +class Ila (dom :: Domain) a where + ilaX :: a + +instance Ila dom (Signal dom ()) where + ilaX = pure () + +instance Ila dom a => Ila dom (Signal dom i -> a) where + ilaX !_i = ilaX @dom @a + +-- | A [polyvariadic](https://github.com/AJFarmar/haskell-polyvariadic) function +-- that instantiates a Xilinx Integrated Logic Analyzer (ILA). +-- +-- Example invocation: +-- +-- @ +-- myAdder :: +-- forall dom . +-- 'Signal' dom ('Unsigned' 8) -> +-- 'Signal' dom ('Unsigned' 8) -> +-- 'Signal' dom ('Unsigned' 8) +-- myAdder a b = ilaOut \`'hwSeqX'\` c +-- where +-- c = a + b +-- +-- ilaOut :: Signal dom () +-- ilaOut = 'ila' ('ilaConfig' ("a" :> "b" :> "add_result" :> Nil)) clk a b c +-- @ +-- +-- Note that signal names do not have to correspond to names passed to the ILA. +-- +-- __N.B.__ Use 'Clash.XException.hwSeqX' to make sure the ILA does not get +-- optimized away by GHC. +ila :: + forall dom a n . + (KnownDomain dom, Ila dom a, 1 <= n) => + IlaConfig n -> + -- | Clock to sample inputs on. Note that this is not necessarily the clock + -- Xilinx's debug hub will run at, if multiple ILAs are instantiated. + Clock dom -> + -- | Any number of 'Signal' arguments. The result will always be + -- @Signal dom ()@. You need to make sure this does not get optimized away by + -- GHC by using 'Clash.XException.hwSeqX'. + a +ila conf clk = + ila# @dom @a conf clk +{-# CLASH_OPAQUE ila #-} + +-- | Primitive for 'ila'. Defining a wrapper like this makes the ILA +-- instantiation be rendered in its own module to reduce naming collision +-- probabilities. +ila# :: + forall dom a n . + (KnownDomain dom, Ila dom a, 1 <= n) => + IlaConfig n -> + Clock dom -> + a +ila# !_conf !_clk = ilaX @dom @a +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE ila# #-} +{-# ANN ila# ( + let primName = 'ila# + tfName = 'ilaBBF + in InlineYamlPrimitive [minBound..] [__i| + BlackBoxHaskell: + name: #{primName} + templateFunction: #{tfName} + workInfo: Always + |]) #-} diff --git a/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs new file mode 100644 index 0000000000..f87eb2ac31 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Xilinx/Ila/Internal.hs @@ -0,0 +1,329 @@ +{-| + Copyright : (C) 2022-2023, Google Inc + 2022, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Black box implementation for primitives in "Clash.Cores.Xilinx.Ila". +-} + +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_HADDOCK hide #-} + +module Clash.Cores.Xilinx.Ila.Internal where + +import Prelude +import qualified Clash.Prelude as C + +import Control.Monad (when, zipWithM) +import Control.Monad.State (State) +import Data.Either (lefts, rights) +import Data.List (zip4, group) +import Data.List.Infinite((...), Infinite((:<))) +import Data.Proxy (Proxy(..)) +import Data.String.Interpolate (__i) +import Data.Maybe (isJust) +import Data.Text.Prettyprint.Doc.Extra (Doc) +import GHC.Stack (HasCallStack) +import GHC.TypeLits (KnownNat, SomeNat(..), someNatVal) +import Language.Haskell.TH.Syntax (Lift) +import Text.Show.Pretty (ppShow) + +import qualified Control.Lens as Lens +import qualified Data.List.Infinite as Infinite +import qualified Data.Text as T + +import Clash.Annotations.SynthesisAttributes (Attr(StringAttr)) +import Clash.Backend (Backend) +import Clash.Netlist.Types +import Clash.Netlist.BlackBox.Types +import Clash.Core.TermLiteral (TermLiteral(..), deriveTermLiteral, termToDataError) +import Clash.Core.TermLiteral.TH (deriveTermToData) +import Clash.Core.Type (Type(LitTy), LitTy(NumTy), coreView) +import Clash.Sized.Vector (Vec) + +import qualified Clash.Netlist.Id as Id +import qualified Clash.Primitives.DSL as DSL +import qualified Clash.Util.Interpolate as I + +import Clash.Cores.Xilinx.Internal + ( TclPurpose(..) + , IpConfig(..) + , defIpConfig + , property + , renderTcl + ) + +-- | Number of samples to store +data Depth + = D1024 + | D2048 + | D4096 + | D8192 + | D16384 + | D32768 + | D65536 + | D131072 + deriving (Show, Lift) + +depthToWord :: Depth -> Word +depthToWord = \case + D1024 -> 1024 + D2048 -> 2048 + D4096 -> 4096 + D8192 -> 8192 + D16384 -> 16384 + D32768 -> 32768 + D65536 -> 65536 + D131072 -> 131072 + +data ProbeType + = DataAndTrigger + -- ^ Probe can be used for data collection and to trigger data capture + | Data + -- ^ Probe can only be used for data collection + | Trigger + -- ^ Probe can only be used to trigger data capture + deriving (Eq, Show, Lift, Enum) + +-- | Configures the static properties of an 'Clash.Cores.Xilinx.Ila.ila'. Note +-- that most properties (triggers, number of samples before/after trigger, ...) +-- are configured at runtime using Vivado. When applicable, configuration fields +-- will refer to the names of configuration labels mentioned in the product +-- guide. +-- +-- Use 'Clash.Cores.Xilinx.Ila.ilaConfig' to construct this with some sensible +-- defaults. +data IlaConfig n = IlaConfig + { probeNames :: Vec n String + -- ^ Probe names. Clash will error if it cannot generate names passed here. + , depth :: Depth + -- ^ Number of samples to store. Corresponds to @C_DATA_DEPTH@. + , captureControl :: Bool + -- ^ Whether probes marked 'Trigger' or 'DataAndTrigger' can be used to control + -- data capture. That is, a trigger marks the start of data collection, while + -- capture control marks when to sample. Corresponds to @C_EN_STRG_QUAL@. + , stages :: C.Index 7 + -- ^ Number of registers to insert at each probe. Supported values: 0-6. + -- Corresponds to @C_INPUT_PIPE_STAGES@. + , comparators :: Either Int (Vec n Int) + -- ^ Comparators available at each probe. If 'Left', all probes will get the + -- same number of comparators. If 'Right', each probe gets a configurable + -- number of comparators. Supported values: 2 - 16. Corresponds to + -- @C_PROBE_MU_CNT@ + -- + -- __N.B.__: Xilinx strongly recommends to use the same number of comparators + -- for every probe (without explanation). + , probeTypes :: Either ProbeType (Vec n ProbeType) + -- ^ Purpose of probe. If 'Left', all probes will be set to the same type. If + -- 'Right', each probe type can be set individually. Also see 'ProbeType'. + -- Corresponds to @C_PROBE_TYPE@. + , advancedTriggers :: Bool + -- ^ Whether state machines can be used to describe trigger logic. + -- Corresponds to @C_ADV_TRIGGER@. + } + deriving (Show, Lift) + +-- XXX: I'd move this 'deriveTermLiteral' up, but Template Haskell complains.. +deriveTermLiteral ''ProbeType +deriveTermLiteral ''Depth +instance KnownNat n => TermLiteral (IlaConfig n) where + termToData = $(deriveTermToData ''IlaConfig) + +probeTypesVec :: KnownNat n => IlaConfig n -> Vec n ProbeType +probeTypesVec = either C.repeat id . probeTypes + +comparatorsVec :: KnownNat n => IlaConfig n -> Vec n Int +comparatorsVec = either C.repeat id . comparators + +-- | Are all values in a list equal? If so, return the element. +areEqual :: Eq a => [a] -> Maybe a +areEqual = \case { [x:_] -> Just x; _ -> Nothing } . group + +ilaBBF :: HasCallStack => BlackBoxFunction +ilaBBF _isD _primName args _resTys = Lens.view tcCache >>= go + where + go tcm + | _:_:_:config:_ <- lefts args + , _:_:(coreView tcm -> LitTy (NumTy n)):_ <- rights args + , Just (SomeNat (Proxy :: Proxy n)) <- someNatVal n + = case termToDataError @(IlaConfig n) config of + Left s -> error ("ilaBBF, bad config:\n" <> s) + Right c -> pure $ Right (bbMeta c, bb c) + | otherwise = error $ "ilaBBF, bad args:\n" <> ppShow args + + bbMeta :: KnownNat n => IlaConfig n -> BlackBoxMeta + bbMeta config = emptyBlackBoxMeta + { bbKind = TDecl + , bbRenderVoid = RenderVoid + , bbIncludes = + [ ( ("ila", "clash.tcl") + , BBFunction (show 'ilaTclTF) 0 (ilaTclTF config) + ) + ] + } + + bb :: KnownNat n => IlaConfig n -> BlackBox + bb config = BBFunction (show 'ilaTF) 0 (ilaTF config) + +usedArguments :: [Int] +usedArguments = ilaConfig : clock : inputProbes + where + ( _knownDomain + :< _ilaConstraint + :< _1nConstraint + :< ilaConfig + :< clock + :< (Infinite.take 8096 -> inputProbes) + ) = (0...) -- This function is polyvariadic so in theory it supports an + -- unlimited number of arguments. To prevent evaluation loops + -- when forcing this argument to NF we limit it to a modest + -- 8096 input ports. + +ilaTF :: (HasCallStack, KnownNat n) => IlaConfig n -> TemplateFunction +ilaTF config = TemplateFunction usedArguments (const True) (ilaBBTF config) + +checkNameCollision :: HasCallStack => T.Text -> DSL.TExpr -> DSL.TExpr +checkNameCollision userName tExpr@(DSL.TExpr _ (Identifier (Id.toText -> name) Nothing)) + | userName == name = tExpr + | otherwise = error [I.i| + Tried create a signal called '#{userName}', but identifier generation + returned '#{name}'. Refusing to instantiate Ila with unreliable probe + names. + |] +checkNameCollision _ tExpr = error [I.i| + Internal error: Expected 'TExpr' with the following form: + + TExpr _ (Identifier _ Nothing) + + got: + + #{ppShow tExpr} +|] + +ilaBBTF :: + forall s n . + (Backend s, KnownNat n, HasCallStack) => + IlaConfig n -> + BlackBoxContext -> + State s Doc +ilaBBTF config bbCtx + | ( _knownDomainDom + : _ilaConstraint + : _1nConstraint + : _ilaConfig + : clk + : inputs + ) <- map fst $ DSL.tInputs bbCtx + , [ilaName] <- bbQsysIncName bbCtx + , let inTys = map DSL.ety inputs + = do + let userInputNames = T.pack <$> C.toList (probeNames config) + + when (length inTys /= C.natToNum @n) $ + error [I.i| + Number of input names did not match number of input probes. Expected + #{length inTys} input name(s), got #{length userInputNames}. Got input + name(s): + + #{ppShow userInputNames} + |] + + ilaInstName <- Id.makeBasic (getIlaName (bbCtxName bbCtx)) + + let + inPs = filter ((> (0 :: Int)) . DSL.tySize . DSL.ety) inputs + inNames = map (T.pack . ("probe" <>) . show) [(0 :: Int)..] + inBVs = map (BitVector . (fromInteger . DSL.tySize . DSL.ety)) inPs + + DSL.declarationReturn bbCtx "ila_inst_block" $ do + DSL.compInBlock ilaName (("clk", Bit) : zip inNames inBVs) [] + + inProbes <- zipWithM DSL.assign inNames inPs + inProbesBV <- zipWithM toNameCheckedBv userInputNames inProbes + + DSL.instDecl + Empty + (Id.unsafeMake ilaName) + ilaInstName + [] -- Generics / parameters + (("clk", clk) : zip inNames inProbesBV) + [] -- outputs + + pure [] + + | otherwise = error $ "ilaBBTF, bad bbCtx: " <> ppShow bbCtx + where + -- The HDL attribute 'KEEP' is added to the signals connected to the + -- probe ports so they are not optimized away by the synthesis tool. + keepAttrs = [StringAttr "KEEP" "true"] + + toNameCheckedBv nameHint inProbe = + checkNameCollision nameHint <$> + DSL.toBvWithAttrs keepAttrs nameHint inProbe + + -- Return user-friendly name given a context name hint. Note that we ignore + -- @__VOID_TDECL_NOOP__@. It is created by 'mkPrimitive' whenever a user hint + -- is _not_ given and the primitive returns a zero-width type. + getIlaName :: Maybe T.Text -> T.Text + getIlaName Nothing = "ila_inst" + getIlaName (Just "result") = getIlaName Nothing + getIlaName (Just "__VOID_TDECL_NOOP__") = getIlaName Nothing + getIlaName (Just s) = s + +ilaTclTF :: (HasCallStack, KnownNat n) => IlaConfig n -> TemplateFunction +ilaTclTF config = TemplateFunction usedArguments (const True) (ilaTclBBTF config) + +ilaTclBBTF :: + forall s n . + (HasCallStack, KnownNat n, Backend s) => + IlaConfig n -> + BlackBoxContext -> + State s Doc +ilaTclBBTF config@IlaConfig{..} bbCtx + | [ilaName] <- bbQsysIncName bbCtx + , ( _knownDomainDom + : _IlaConstraint + : _1nConstraint + : _ilaConfig + : _clk + : inputs + ) <- map fst $ DSL.tInputs bbCtx + , let inTys = map DSL.ety inputs + = pure $ renderTcl $ pure $ IpConfigPurpose $ + (defIpConfig "ila" "6.2" ilaName){properties=properties inTys} + | otherwise = error $ "ilaBBTF, bad bbCtx:\n\n" <> ppShow bbCtx + where + probesTypesL = C.toList (probeTypesVec config) + compsL = C.toList (comparatorsVec config) + sameMu = areEqual compsL + + properties inTys = globalProperties inTys <> portProperties inTys + + globalProperties inTys = + [ property @Int "C_NUM_OF_PROBES" (length inTys) + , property @Word "C_INPUT_PIPE_STAGES" (fromIntegral stages) + , property @Word "C_DATA_DEPTH" (depthToWord depth) + , property @Bool "ALL_PROBE_SAME_MU" (isJust sameMu) + , property @Int "C_EN_STRG_QUAL" (if captureControl then 1 else 0) + , property @Bool "C_TRIGIN_EN" False + , property @Bool "C_ADV_TRIGGER" advancedTriggers + ] <> + [ property @Int "ALL_PROBE_SAME_MU_CNT" mu | Just mu <- [sameMu] + ] + + portProperties inTys = concat $ + [ [ property @Int [__i|C_PROBE#{i}_WIDTH|] width + , property @Int [__i|C_PROBE#{i}_TYPE|] (fromEnum probeType) + , property @Int [__i|C_PROBE#{i}_MU_CNT|] compC + ] + | (i, ty, probeType, compC) <- zip4 [(0 :: Int)..] inTys probesTypesL compsL + , let width = fromInteger $ DSL.tySize ty + ] diff --git a/clash-cores/src/Clash/Cores/Xilinx/Internal.hs b/clash-cores/src/Clash/Cores/Xilinx/Internal.hs index 0a0af3c096..8f11193882 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/Internal.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/Internal.hs @@ -82,6 +82,7 @@ instance TclShow Text where tclShow = id instance TclShow Int +instance TclShow Word instance TclShow Integer instance TclShow Natural diff --git a/clash-lib/src/Clash/Core/TermLiteral.hs b/clash-lib/src/Clash/Core/TermLiteral.hs index ff08c416b3..22a4f9214e 100644 --- a/clash-lib/src/Clash/Core/TermLiteral.hs +++ b/clash-lib/src/Clash/Core/TermLiteral.hs @@ -41,6 +41,7 @@ import Data.Typeable (Typeable, typeRep) import GHC.Natural import GHC.Stack import GHC.TypeNats (KnownNat) +import Text.Show.Pretty (ppShow) import Clash.Annotations.SynthesisAttributes (Attr) import Clash.Core.DataCon (DataCon(..)) @@ -50,6 +51,7 @@ import Clash.Core.Pretty (showPpr) import Clash.Core.Term (Term(Literal, Data), collectArgs) import Clash.Promoted.Nat import Clash.Promoted.Nat.Unsafe +import Clash.Sized.Index (Index) import Clash.Sized.Vector (Vec (Nil, Cons), fromList) import qualified Clash.Util.Interpolate as I import qualified Clash.Verification.Internal as Cv @@ -107,6 +109,13 @@ instance TermLiteral Text where #endif termToData t = Left t +instance KnownNat n => TermLiteral (Index n) where + termToData t@(collectArgs -> (_, [_, _, Left (Literal (IntegerLiteral n))])) + | n < 0 = Left t + | n >= natToNum @n = Left t + | otherwise = Right (fromInteger n) + termToData t = Left t + instance TermLiteral Int where termToData (collectArgs -> (_, [Left (Literal (IntLiteral n))])) = Right (fromInteger n) @@ -227,7 +236,7 @@ termToDataError term = bimap err id (termToData term) In its non-pretty-printed form: - #{show failedTerm} + #{ppShow failedTerm} In the full term: diff --git a/clash-lib/src/Clash/Core/TermLiteral/TH.hs b/clash-lib/src/Clash/Core/TermLiteral/TH.hs index 2351d1f09a..e360193981 100644 --- a/clash-lib/src/Clash/Core/TermLiteral/TH.hs +++ b/clash-lib/src/Clash/Core/TermLiteral/TH.hs @@ -80,7 +80,7 @@ deriveTermLiteral :: Name -> Q [Dec] deriveTermLiteral typName = do TyConI (DataD _ _ typeVars _ _ _) <- reify typName typeVarNames <- mapM typeVarName typeVars - showsTypePrec <- deriveShowsTypePrec typName typeVarNames + showsTypePrec <- deriveShowsTypePrec typName termToDataBody <- deriveTermToData typName let termToData = FunD termToDataName [Clause [] (NormalB termToDataBody) []] @@ -101,9 +101,11 @@ deriveTermLiteral typName = do -- > in -- > showParen (n > 10) showType -- -deriveShowsTypePrec :: Name -> [(Name, Maybe Type)] -> Q Dec -deriveShowsTypePrec typName typeVars = do - showTypeBody <- mkShowTypeBody +deriveShowsTypePrec :: Name -> Q Dec +deriveShowsTypePrec typName = do + TyConI (DataD _ _ typeVars _ _ _) <- reify typName + typeVarNames <- mapM typeVarName typeVars + showTypeBody <- mkShowTypeBody typeVarNames pure (FunD showsTypePrecName [Clause [VarP nName, WildP] (NormalB showTypeBody) []]) where showTypeName = [| showString $(litE (StringL (nameBase typName))) |] @@ -131,9 +133,9 @@ deriveShowsTypePrec typName typeVars = do -- This is wrapped in an if-statement wrapping the result in parentheses if the -- incoming prec is more than 10 (function application). -- - mkShowTypeBody :: Q Exp - mkShowTypeBody = - case typeVars of + mkShowTypeBody :: [(Name, Maybe Type)] -> Q Exp + mkShowTypeBody typeVarNames = + case typeVarNames of [] -> -- We seq on `n` here to prevent _unused variable_ warnings. This is a -- bit of a hack (the real solution would be to selectively pattern @@ -142,7 +144,7 @@ deriveShowsTypePrec typName typeVars = do _ -> [| let showSpace = showChar ' ' - precCalls = $(listE (map mkTypePrecCall typeVars)) + precCalls = $(listE (map mkTypePrecCall typeVarNames)) interspersedPrecCalls = intersperse showSpace precCalls showType = foldl (.) $(showTypeName) (showSpace : interspersedPrecCalls) in diff --git a/tests/Main.hs b/tests/Main.hs index 71acb66485..efe8ba4657 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -589,6 +589,28 @@ runClashTest = defaultMain $ clashTestRoot ] } in runTest "VIO" _opts + , let _opts = + def{ hdlTargets=[VHDL, Verilog, SystemVerilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific [ "testWithDefaultsOne" + , "testWithDefaultsThree" + , "testWithLefts" + , "testWithRights" + , "testWithRightsSameCu" + ] + } + in runTest "Ila" _opts + , let _opts = + def{ hdlTargets=[VHDL, Verilog, SystemVerilog] + , buildTargets=BuildSpecific [ "testWithDefaultsOne" + , "testWithDefaultsThree" + , "testWithLefts" + , "testWithRights" + , "testWithRightsSameCu" + ] + } + in outputTest "Ila" _opts , outputTest "VIO" def{ hdlTargets=[VHDL] , buildTargets=BuildSpecific ["withSetName", "withSetNameNoResult"] diff --git a/tests/shouldwork/Cores/Xilinx/Ila.hs b/tests/shouldwork/Cores/Xilinx/Ila.hs new file mode 100644 index 0000000000..ac8e69cbb5 --- /dev/null +++ b/tests/shouldwork/Cores/Xilinx/Ila.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Ila where + +import Clash.Explicit.Prelude + +import Data.List +import System.Directory +import System.Environment +import System.FilePath +import System.FilePath.Glob +import qualified Language.Haskell.TH as TH + +import Clash.Annotations.TH +import Clash.Cores.Xilinx.Ila +import Clash.Explicit.Testbench + +type Dom = XilinxSystem + +top :: "result" ::: Unsigned 8 +top = 0 +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE top #-} +makeTopEntity 'top + +noReset :: KnownDomain dom => Reset dom +noReset = unsafeFromActiveHigh (pure False) + +oneCounter :: IlaConfig 1 -> Clock Dom -> Signal Dom () +oneCounter config clk = setName @"one_counter_ila" $ ila @Dom config clk counter + where + counter :: Signal Dom (Unsigned 64) + counter = register clk noReset enableGen 0 (counter + 1) + +threeCounters :: IlaConfig 3 -> Clock Dom -> Signal Dom () +threeCounters config clk = + setName @"three_counters_ila" $ + ila @Dom config clk counter0 counter1 counter2 + where + counter0 :: Signal Dom (Unsigned 64) + counter0 = register clk noReset enableGen 0 (counter0 + 1) + + counter1 :: Signal Dom (Unsigned 64) + counter1 = register clk noReset enableGen 0 (counter1 + 2) + + counter2 :: Signal Dom (Unsigned 64) + counter2 = register clk noReset enableGen 0 (counter2 + 3) + +testWithDefaultsOne :: Clock Dom -> Signal Dom () +testWithDefaultsOne = oneCounter (ilaConfig ("foo" :> Nil)) +{-# ANN testWithDefaultsOne (TestBench 'top) #-} +{-# ANN testWithDefaultsOne (defSyn "testWithDefaultsOne") #-} + +testWithDefaultsThree :: Clock Dom -> Signal Dom () +testWithDefaultsThree = threeCounters (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) +{-# ANN testWithDefaultsThree (TestBench 'top) #-} +{-# ANN testWithDefaultsThree (defSyn "testWithDefaultsThree") #-} + +testWithLefts :: Clock Dom -> Signal Dom () +testWithLefts = threeCounters $ + (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) + { comparators = Left 3 + , probeTypes = Left Data + , depth = D2048 + , captureControl = False + , stages = 5 + } +{-# ANN testWithLefts (TestBench 'top) #-} +{-# ANN testWithLefts (defSyn "testWithLefts") #-} + +testWithRights :: Clock Dom -> Signal Dom () +testWithRights = threeCounters $ + (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) + { comparators = Right (4 :> 5 :> 6 :> Nil) + , probeTypes = Right (DataAndTrigger :> Data :> Trigger :> Nil) + , depth = D1024 + , captureControl = True + , stages = 3 + } +{-# ANN testWithRights (TestBench 'top) #-} +{-# ANN testWithRights (defSyn "testWithRights") #-} + +testWithRightsSameCu :: Clock Dom -> Signal Dom () +testWithRightsSameCu = threeCounters $ + (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) + { comparators = Right (4 :> 4 :> 4 :> Nil) + , probeTypes = Right (Trigger :> Data :> DataAndTrigger :> Nil) + , depth = D4096 + , captureControl = True + , stages = 1 + , advancedTriggers = True + } +{-# ANN testWithRightsSameCu (TestBench 'top) #-} +{-# ANN testWithRightsSameCu (defSyn "testWithRightsSameCu") #-} + +mainVHDL :: IO () +mainVHDL = do + [dir] <- getArgs + + -- TCL content check: + main + + -- HDL content check: + let hdlDir = dir show 'testWithDefaultsOne + [path] <- glob (hdlDir "Ila_testWithDefaultsOne_oneCounter*.vhdl") + contents <- readFile path + assertIn contents "attribute KEEP of foo : signal is \"true\";" -- signal name + assertIn contents "one_counter_ila : testWithDefaultsOne_ila" -- instantiation label + +mainVerilog :: IO () +mainVerilog = main + +mainSystemVerilog :: IO () +mainSystemVerilog = main + +getTcl :: TH.Name -> IO String +getTcl nm = do + [dir] <- getArgs + let topDir = dir show nm + [tclFileName] <- filter (".tcl" `isSuffixOf`) <$> listDirectory topDir + let tclPath = topDir tclFileName + readFile tclPath + +assertIn :: String -> String -> IO () +assertIn haystack needle + | needle `isInfixOf` haystack = return () + | otherwise = error $ mconcat [ "Expected:\n\n ", needle + , "\n\nIn:\n\n", haystack ] + +main :: IO () +main = do + tcl <- getTcl 'testWithDefaultsOne + assertIn tcl "C_NUM_OF_PROBES 1" + assertIn tcl "C_INPUT_PIPE_STAGES 0" + assertIn tcl "C_DATA_DEPTH 4096" + assertIn tcl "ALL_PROBE_SAME_MU true" + assertIn tcl "C_EN_STRG_QUAL 1" + assertIn tcl "C_TRIGIN_EN false" + assertIn tcl "ALL_PROBE_SAME_MU_CNT 2" + assertIn tcl "C_PROBE0_WIDTH 64" + assertIn tcl "C_PROBE0_TYPE 0" + assertIn tcl "C_PROBE0_MU_CNT 2" + assertIn tcl "C_ADV_TRIGGER false" + + tcl <- getTcl 'testWithDefaultsThree + assertIn tcl "C_NUM_OF_PROBES 3" + assertIn tcl "C_INPUT_PIPE_STAGES 0" + assertIn tcl "C_DATA_DEPTH 4096" + assertIn tcl "ALL_PROBE_SAME_MU true" + assertIn tcl "C_EN_STRG_QUAL 1" + assertIn tcl "C_TRIGIN_EN false" + assertIn tcl "ALL_PROBE_SAME_MU_CNT 2" + assertIn tcl "C_PROBE0_WIDTH 64" + assertIn tcl "C_PROBE0_TYPE 0" + assertIn tcl "C_PROBE0_MU_CNT 2" + assertIn tcl "C_PROBE1_WIDTH 64" + assertIn tcl "C_PROBE1_TYPE 0" + assertIn tcl "C_PROBE1_MU_CNT 2" + assertIn tcl "C_PROBE2_WIDTH 64" + assertIn tcl "C_PROBE2_TYPE 0" + assertIn tcl "C_PROBE2_MU_CNT 2" + assertIn tcl "C_ADV_TRIGGER false" + + tcl <- getTcl 'testWithLefts + assertIn tcl "C_NUM_OF_PROBES 3" + assertIn tcl "C_INPUT_PIPE_STAGES 5" + assertIn tcl "C_DATA_DEPTH 2048" + assertIn tcl "ALL_PROBE_SAME_MU true" + assertIn tcl "C_EN_STRG_QUAL 0" + assertIn tcl "C_TRIGIN_EN false" + assertIn tcl "ALL_PROBE_SAME_MU_CNT 3" + assertIn tcl "C_PROBE0_WIDTH 64" + assertIn tcl "C_PROBE0_TYPE 1" + assertIn tcl "C_PROBE0_MU_CNT 3" + assertIn tcl "C_PROBE1_WIDTH 64" + assertIn tcl "C_PROBE1_TYPE 1" + assertIn tcl "C_PROBE1_MU_CNT 3" + assertIn tcl "C_PROBE2_WIDTH 64" + assertIn tcl "C_PROBE2_TYPE 1" + assertIn tcl "C_PROBE2_MU_CNT 3" + assertIn tcl "C_ADV_TRIGGER false" + + tcl <- getTcl 'testWithRights + assertIn tcl "C_NUM_OF_PROBES 3" + assertIn tcl "C_INPUT_PIPE_STAGES 3" + assertIn tcl "C_DATA_DEPTH 1024" + assertIn tcl "ALL_PROBE_SAME_MU false" + assertIn tcl "C_EN_STRG_QUAL 1" + assertIn tcl "C_TRIGIN_EN false" + assertIn tcl "C_PROBE0_WIDTH 64" + assertIn tcl "C_PROBE0_TYPE 0" + assertIn tcl "C_PROBE0_MU_CNT 4" + assertIn tcl "C_PROBE1_WIDTH 64" + assertIn tcl "C_PROBE1_TYPE 1" + assertIn tcl "C_PROBE1_MU_CNT 5" + assertIn tcl "C_PROBE2_WIDTH 64" + assertIn tcl "C_PROBE2_TYPE 2" + assertIn tcl "C_PROBE2_MU_CNT 6" + assertIn tcl "C_ADV_TRIGGER false" + + tcl <- getTcl 'testWithRightsSameCu + assertIn tcl "C_NUM_OF_PROBES 3" + assertIn tcl "C_INPUT_PIPE_STAGES 1" + assertIn tcl "C_DATA_DEPTH 4096" + assertIn tcl "ALL_PROBE_SAME_MU true" + assertIn tcl "C_EN_STRG_QUAL 1" + assertIn tcl "C_TRIGIN_EN false" + assertIn tcl "ALL_PROBE_SAME_MU_CNT 4" + assertIn tcl "C_PROBE0_WIDTH 64" + assertIn tcl "C_PROBE0_TYPE 2" + assertIn tcl "C_PROBE0_MU_CNT 4" + assertIn tcl "C_PROBE1_WIDTH 64" + assertIn tcl "C_PROBE1_TYPE 1" + assertIn tcl "C_PROBE1_MU_CNT 4" + assertIn tcl "C_PROBE2_WIDTH 64" + assertIn tcl "C_PROBE2_TYPE 0" + assertIn tcl "C_PROBE2_MU_CNT 4" + assertIn tcl "C_ADV_TRIGGER true"