From baa12143507a6a9c62379db5f0974b4919addce0 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Tue, 6 Jul 2021 15:37:29 +0200 Subject: [PATCH 01/36] clash-cores New: Xilinx float addition (#1869) Single-precision floating point addition, realized through instantiation of the Xilinx Floating-Point LogiCORE IP v7.1. --- Xilinx/Floating.hs | 194 +++++++++++++++++ Xilinx/Floating/Annotations.hs | 34 +++ Xilinx/Floating/TH.hs | 370 +++++++++++++++++++++++++++++++++ 3 files changed, 598 insertions(+) create mode 100644 Xilinx/Floating.hs create mode 100644 Xilinx/Floating/Annotations.hs create mode 100644 Xilinx/Floating/TH.hs diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs new file mode 100644 index 0000000..9747581 --- /dev/null +++ b/Xilinx/Floating.hs @@ -0,0 +1,194 @@ +{-| +Copyright : (C) 2021, QBayLogic B.V., +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. +-} + +module Floating where + +import Clash.Prelude +import qualified Clash.Explicit.Prelude as CEP +import Clash.Explicit.Testbench + +import qualified Prelude as P +import Numeric (showHex) + +import qualified Clash.Cores.Xilinx.Floating as F + +import Floating.Annotations +import Floating.TH + +newtype FloatVerifier = FloatVerifier Float + +instance Eq FloatVerifier where + (FloatVerifier x) == (FloatVerifier y) = pack x == pack y + +instance ShowX FloatVerifier where + showsPrecX = showsPrecXWith showsPrec + +instance Show FloatVerifier where + showsPrec = floatVerifierShowsPrec# + +floatVerifierShowsPrec# + :: Int + -> FloatVerifier + -> ShowS +floatVerifierShowsPrec# _ (FloatVerifier x) + | isNaN x = nanSign . nanString . showHex payload . (')':) + | otherwise = shows x + where + nanSign | msb (pack x) == 0 = ('+':) + | otherwise = ('-':) + nanString + | testBit (pack x) 22 = ("qNaN(0x" P.++) + | otherwise = ("sNaN(0x" P.++) + payload = truncateB $ pack x :: BitVector 22 + +playSampleRom + :: forall n a dom + . ( KnownDomain dom + , KnownNat n + , BitPack a + , 1 <= n + ) + => Clock dom + -> Reset dom + -> SNat n + -> FilePath + -> (Signal dom Bool, Signal dom a) +playSampleRom clk rst n file = (done, out) + where + out = unpack . asyncRomFile n file <$> cnt + done = CEP.register clk rst enableGen False $ (== maxBound) <$> cnt + cnt :: Signal dom (Index n) + cnt = CEP.register clk rst enableGen 0 $ satSucc SatBound <$> cnt + +basicBinaryTB + :: forall n d + . ( KnownNat n + , KnownNat d + ) + => ( Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem d Float + ) + -> Vec n (Float, Float, Float) + -> Signal XilinxSystem Bool +basicBinaryTB comp samples = done + where + (inputX, inputY, expectedOutput) = unzip3 samples + testInputX = fromSignal $ stimuliGenerator clk rst inputX + testInputY = fromSignal $ stimuliGenerator clk rst inputY + expectOutput = outputVerifier' clk rst (repeat @d 0 ++ expectedOutput) + done = + expectOutput . ignoreFor clk rst en (SNat @d) 0 + . toSignal $ comp clk testInputX testInputY + clk = tbClockGen (not <$> done) + rst = resetGen + en = enableGen +{-# INLINE basicBinaryTB #-} + +basicRomTB + :: forall d n + . ( KnownNat n + , KnownNat d + , 1 <= n + ) + => ( Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem d Float + ) + -> SNat n + -> FilePath + -> Signal XilinxSystem Bool +basicRomTB comp n sampleFile = done + where + (done0, samples) = playSampleRom clk rst n sampleFile + (inputX, inputY, expectedOutput) = unbundle samples + -- Only assert while not finished + done = mux done0 done0 + $ assert clk rst "basicRomTB" out (fmap FloatVerifier expectedOutput) + done0 + out = + fmap FloatVerifier . ignoreFor clk rst en (SNat @d) 0 + . toSignal $ comp clk (fromSignal inputX) (fromSignal inputY) + clk = tbClockGen (not <$> done) + rst = resetGen + en = enableGen +{-# INLINE basicRomTB #-} + +addBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.AddDefDelay Float +addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y +{-# NOINLINE addBasic #-} +{-# ANN addBasic (binTopAnn "addBasic") #-} + +addBasicTB :: Signal XilinxSystem Bool +addBasicTB = + uncurry (basicRomTB addBasic) + $(romDataFromFile "samplerom.bin" addBasicSamples) +{-# ANN addBasicTB (TestBench 'addBasic) #-} + +addEnable + :: Clock XilinxSystem + -> Enable XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 11 Float +addEnable clk en x y = withClock clk $ withEnable en $ F.add x y +{-# NOINLINE addEnable #-} +{-# ANN addEnable (binEnTopAnn "addEnable") #-} + +addEnableTB :: Signal XilinxSystem Bool +addEnableTB = done + where + testInput = + fromSignal $ stimuliGenerator clk rst $(listToVecTH [1 :: Float .. 25]) + en = + toEnable $ stimuliGenerator clk rst + ( (replicate d11 True ++ replicate d4 True ++ replicate d4 False) + :< True) + expectedOutput = + replicate d11 0 + ++ $(listToVecTH . P.map (\i -> i + i) $ + [1 :: Float .. 4] + -- Stall for four cycles + P.++ P.replicate 4 5 + -- Still in the pipeline (11 deep) from before the stall. + P.++ P.take 11 [5 .. 25] + -- We "lose" four samples of what remains due to not being enabled + -- for those inputs. + P.++ P.drop 4 (P.drop 11 [5 .. 25]) + ) + expectOutput = + outputVerifier' clk rst expectedOutput + done = + expectOutput . ignoreFor clk rst enableGen d11 0 + . toSignal $ addEnable clk en testInput testInput + clk = tbClockGen (not <$> done) + rst = resetGen +{-# ANN addEnableTB (TestBench 'addEnable) #-} + +addShortPL + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 6 Float +addShortPL clk x y = + withClock clk $ withEnable enableGen $ F.addWith F.defConfig x y +{-# NOINLINE addShortPL #-} +{-# ANN addShortPL (binTopAnn "addShortPL") #-} + +addShortPLTB :: Signal XilinxSystem Bool +addShortPLTB = + basicBinaryTB addShortPL + $(listToVecTH [ (1, 4, 5) :: (Float, Float, Float) + , (2, 5, 7) + , (3, 6, 9) + ]) +{-# ANN addShortPLTB (TestBench 'addShortPL) #-} diff --git a/Xilinx/Floating/Annotations.hs b/Xilinx/Floating/Annotations.hs new file mode 100644 index 0000000..eb62d2a --- /dev/null +++ b/Xilinx/Floating/Annotations.hs @@ -0,0 +1,34 @@ +{-| +Copyright : (C) 2021, QBayLogic B.V., +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. +-} + +module Floating.Annotations where + +import Clash.Prelude + +binTopAnn :: String -> TopEntity +binTopAnn name = + Synthesize + { t_name = name + , t_inputs = + [ PortName "clk" + , PortName "x" + , PortName "y" + ] + , t_output = PortName "result" + } + +binEnTopAnn :: String -> TopEntity +binEnTopAnn name = + Synthesize + { t_name = name + , t_inputs = + [ PortName "clk" + , PortName "en" + , PortName "x" + , PortName "y" + ] + , t_output = PortName "result" + } diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs new file mode 100644 index 0000000..234f436 --- /dev/null +++ b/Xilinx/Floating/TH.hs @@ -0,0 +1,370 @@ +{-| +Copyright : (C) 2021, QBayLogic B.V., +License : BSD2 (see the file LICENSE) +Maintainer : QBayLogic B.V. +-} + +{-# LANGUAGE ViewPatterns #-} + +module Floating.TH where + +import Clash.Prelude (BitPack, natToNum, SNat(..), unpack) +import Clash.Prelude.ROM.File (memFile) + +import Prelude +import Language.Haskell.TH + (appTypeE, conE, ExpQ, litE, litT, numTyLit, stringL, tupE) +import Language.Haskell.TH.Syntax (qRunIO) +import Numeric.IEEE + (epsilon, infinity, maxFinite, minDenormal, minNormal) + +import Clash.Cores.Xilinx.Floating as F +import Clash.Cores.Xilinx.Floating.Internal as F + +romDataFromFile + :: BitPack a + => FilePath + -> [a] + -> ExpQ +romDataFromFile file es = + qRunIO (writeFile file $ memFile (Just 0) es) + >> tupE [ appTypeE (conE 'SNat) (litT . numTyLit . toInteger $ length es) + , litE $ stringL file + ] + +delayOutput + :: Int + -> [(Float, Float, Float)] + -> [(Float, Float, Float)] +delayOutput d es = zip3 xs ys rs + where + (xs0, ys0, rs0) = unzip3 es + xs = xs0 ++ repeat (last xs0) + ys = ys0 ++ repeat (last ys0) + rs = replicate d 0 ++ rs0 + +addBasicSamples :: [(Float, Float, Float)] +addBasicSamples = + delayOutput (natToNum @F.AddDefDelay) $ + [ (1, 4, 5) + , (2, 5, 7) + , (3, 6, 9) + -- Subnormal positive number is conditioned to plus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( -minNormal + , minNormal + maxDenormal + , 0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( -minNormal + , minNormal + minDenormal + , 0 + ) + -- Subnormal negative number is conditioned to minus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( minNormal + , -minNormal - maxDenormal + , -0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( minNormal + , -minNormal - minDenormal + , -0 + ) + -- Subnormals on input are conditioned to zero + -- + -- The result would normally be the smallest normal number, but due to + -- conditioning it is zero. + , ( maxDenormal + , minDenormal + , 0 + ) + -- The result would normally be almost twice the smallest normal number, + -- well within normal range, but due to conditioning it is again zero. + , ( maxDenormal + , maxDenormal + , 0 + ) + -- The result would normally be exact, but the second input is conditioned + -- to zero. + , ( minNormal + , minDenormal + , minNormal + ) + -- Idem dito. + , ( minNormal + , maxDenormal + , minNormal + ) + -- Subnormals on input are conditioned to zero, negative version + -- + -- The result would normally be the normal number of smallest magnitude, + -- but due to conditioning it is zero. + , ( -maxDenormal + , -minDenormal + , -0 + ) + -- The result would normally be almost twice the normal number of smallest + -- magnitude, well within normal range, but due to conditioning it is again + -- zero. + , ( -maxDenormal + , -maxDenormal + , -0 + ) + -- The result would normally be exact, but the second input is conditioned + -- to zero. + , ( -minNormal + , -minDenormal + , -minNormal + ) + -- Idem dito. + , ( -minNormal + , -maxDenormal + , -minNormal + ) + -- Round to nearest + -- + -- For a datatype with 4 bits of precision, the significands align as: + -- 1000 + -- 1001 + -- -------- + + -- 1001 + , ( 2 ^ (digits - 1) + , encodeFloat (2 ^ (digits - 1) + 1) (-digits) + , 2 ^ (digits - 1) + 1 + ) + -- 1000 + -- 01111 + -- --------- + + -- 1000 + , ( 2 ^ (digits - 1) + , encodeFloat (2 ^ digits - 1) (-digits - 1) + , 2 ^ (digits - 1) + ) + -- Ties to even + -- + -- 1000 + -- 1000 + -- -------- + + -- 1000 + , ( 2 ^ (digits - 1) + , encodeFloat (2 ^ (digits - 1)) (-digits) + , 2 ^ (digits - 1) + ) + -- Round to nearest + -- + -- For a datatype with 4 bits of precision, the significands align as: + -- 1001 + -- 1001 + -- -------- + + -- 1010 + , ( 2 ^ (digits - 1) + 1 + , encodeFloat (2 ^ (digits - 1) + 1) (-digits) + , 2 ^ (digits - 1) + 2 + ) + -- 1001 + -- 01111 + -- --------- + + -- 1001 + , ( 2 ^ (digits - 1) + 1 + , encodeFloat (2 ^ digits - 1) (-digits - 1) + , 2 ^ (digits - 1) + 1 + ) + -- Ties to even + -- + -- 1001 + -- 1000 + -- -------- + + -- 1010 + , ( 2 ^ (digits - 1) + 1 + , encodeFloat (2 ^ (digits - 1)) (-digits) + , 2 ^ (digits - 1) + 2 + ) + -- Rounding at maximum exponent + -- + -- 1111 + -- 1000 + -- -------- + + -- infinity + , ( maxFinite + , encodeFloat (2 ^ (digits - 1)) (maxExp - 2*digits) + , 1/0 + ) + -- 1111 + -- 01111 + -- --------- + + -- 1111 + , ( maxFinite + , encodeFloat (2 ^ digits - 1) (maxExp - 2*digits - 1) + , encodeFloat (2 ^ digits - 1) (maxExp - digits) + ) + -- Infinities + , (infinity, 1, infinity) + , (-infinity, 1, -infinity) + , (infinity, -infinity, F.xilinxNaN) + ] + ++ cartesianProductTest model interesting interesting + ++ nanTest + where + digits = floatDigits (undefined :: Float) + (_, maxExp) = floatRange (undefined :: Float) + model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x + y + +cartesianProductTest + :: (a -> b -> c) + -> [a] + -> [b] + -> [(a,b,c)] +cartesianProductTest f as bs = + map (\(a,b) -> (a, b, f a b)) $ cartesianProduct as bs + +cartesianProduct + :: [a] + -> [b] + -> [(a,b)] +cartesianProduct as bs = + concatMap (\a -> map (\b -> (a,b)) bs) as + +interesting :: [Float] +interesting = + [ infinity + , minDenormal + , maxDenormal + , minNormal + , maxFinite + , epsilon + , F.xilinxNaN + -- Some basic numbers + , 1 + , 2 + , 42 + ] + +nanTest :: [(Float, Float, Float)] +nanTest = + concatMap testNaN + [ qNaN0PL + , negQNaN0PL + , qNaN1 + , negQNaN1 + , sNaN1 + , negSNaN1 + , qNaNMsb + , negQNaNMsb + , sNaNMsb + , negSNaNMsb + , qNaNMax + , negQNaNMax + , sNaNMax + , negSNaNMax + , qNaNR1 + , negQNaNR1 + , sNaNR1 + , negSNaNR1 + , qNaNR2 + , negQNaNR2 + , sNaNR2 + , negSNaNR2 + ] + where + testNaN :: Float -> [(Float, Float, Float)] + testNaN nan = + [ (nan, 1, F.xilinxNaN) + , (1, nan, F.xilinxNaN) + , (nan, nan, F.xilinxNaN) + ] + +-- Maximum subnormal value +maxDenormal :: Float +maxDenormal = minNormal - minDenormal + +-- Quiet NaN with no payload +-- Actually, this is equal to F.xilinxNaN +qNaN0PL :: Float +qNaN0PL = unpack 0b0111_1111_1100_0000_0000_0000_0000_0000 + +-- Negative version +negQNaN0PL :: Float +negQNaN0PL = unpack 0b1111_1111_1100_0000_0000_0000_0000_0000 + +-- Quiet NaN with payload 1 +qNaN1 :: Float +qNaN1 = unpack 0b0111_1111_1100_0000_0000_0000_0000_0001 + +-- Negative version +negQNaN1 :: Float +negQNaN1 = unpack 0b1111_1111_1100_0000_0000_0000_0000_0001 + +-- Signaling NaN with payload 1 +sNaN1 :: Float +sNaN1 = unpack 0b0111_1111_1000_0000_0000_0000_0000_0001 + +-- Negative version +negSNaN1 :: Float +negSNaN1 = unpack 0b1111_1111_1000_0000_0000_0000_0000_0001 + +-- Quiet NaN with payload with only MSB set +qNaNMsb :: Float +qNaNMsb = unpack 0b0111_1111_1110_0000_0000_0000_0000_0000 + +-- Negative version +negQNaNMsb :: Float +negQNaNMsb = unpack 0b1111_1111_1110_0000_0000_0000_0000_0000 + +-- Signaling NaN with payload with only MSB set +sNaNMsb :: Float +sNaNMsb = unpack 0b0111_1111_1010_0000_0000_0000_0000_0000 + +-- Negative version +negSNaNMsb :: Float +negSNaNMsb = unpack 0b1111_1111_1010_0000_0000_0000_0000_0000 + +-- Quiet NaN with maximum-valued payload +qNaNMax :: Float +qNaNMax = unpack 0b0111_1111_1111_1111_1111_1111_1111_1111 + +-- Negative version +negQNaNMax :: Float +negQNaNMax = unpack 0b1111_1111_1111_1111_1111_1111_1111_1111 + +-- Signaling NaN with maximum-valued payload +sNaNMax :: Float +sNaNMax = unpack 0b0111_1111_1011_1111_1111_1111_1111_1111 + +-- Negative version +negSNaNMax :: Float +negSNaNMax = unpack 0b1111_1111_1011_1111_1111_1111_1111_1111 + +-- Quiet NaN with random payload +qNaNR1 :: Float +qNaNR1 = unpack 0b0111_1111_1110_0000_1011_0001_0011_1100 + +-- Negative version +negQNaNR1 :: Float +negQNaNR1 = unpack 0b1111_1111_1110_0000_1011_0001_0011_1100 + +-- Signaling NaN with random payload +sNaNR1 :: Float +sNaNR1 = unpack 0b0111_1111_1010_0000_1011_0001_0011_1100 + +-- Negative version +negSNaNR1 :: Float +negSNaNR1 = unpack 0b1111_1111_1010_0000_1011_0001_0011_1100 + +-- Quiet NaN with random payload +qNaNR2 :: Float +qNaNR2 = unpack 0b0111_1111_1100_0010_0011_0000_1110_0101 + +-- Negative version +negQNaNR2 :: Float +negQNaNR2 = unpack 0b1111_1111_1100_0010_0011_0000_1110_0101 + +-- Signaling NaN with random payload +sNaNR2 :: Float +sNaNR2 = unpack 0b0111_1111_1000_0010_0011_0000_1110_0101 + +-- Negative version +negSNaNR2 :: Float +negSNaNR2 = unpack 0b1111_1111_1000_0010_0011_0000_1110_0101 From 1fdf4a3699ccec4e353c2296caf2eb31685a5ff3 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Tue, 6 Jul 2021 15:37:29 +0200 Subject: [PATCH 02/36] clash-cores New: Xilinx float sub, mul and div Single-precision floating point operations, realized through instantiation of the Xilinx Floating-Point LogiCORE IP v7.1. --- Xilinx/Floating.hs | 47 ++++++- Xilinx/Floating/TH.hs | 284 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 318 insertions(+), 13 deletions(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index 9747581..1e23821 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -131,7 +131,7 @@ addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y addBasicTB :: Signal XilinxSystem Bool addBasicTB = uncurry (basicRomTB addBasic) - $(romDataFromFile "samplerom.bin" addBasicSamples) + $(romDataFromFile "add-samplerom.bin" addBasicSamples) {-# ANN addBasicTB (TestBench 'addBasic) #-} addEnable @@ -192,3 +192,48 @@ addShortPLTB = , (3, 6, 9) ]) {-# ANN addShortPLTB (TestBench 'addShortPL) #-} + +subBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.SubDefDelay Float +subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y +{-# NOINLINE subBasic #-} +{-# ANN subBasic (binTopAnn "subBasic") #-} + +subBasicTB :: Signal XilinxSystem Bool +subBasicTB = + uncurry (basicRomTB subBasic) + $(romDataFromFile "sub-samplerom.bin" subBasicSamples) +{-# ANN subBasicTB (TestBench 'subBasic) #-} + +mulBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.MulDefDelay Float +mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y +{-# NOINLINE mulBasic #-} +{-# ANN mulBasic (binTopAnn "mulBasic") #-} + +mulBasicTB :: Signal XilinxSystem Bool +mulBasicTB = + uncurry (basicRomTB mulBasic) + $(romDataFromFile "mul-samplerom.bin" mulBasicSamples) +{-# ANN mulBasicTB (TestBench 'mulBasic) #-} + +divBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.DivDefDelay Float +divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y +{-# NOINLINE divBasic #-} +{-# ANN divBasic (binTopAnn "divBasic") #-} + +divBasicTB :: Signal XilinxSystem Bool +divBasicTB = + uncurry (basicRomTB divBasic) + $(romDataFromFile "div-samplerom.bin" divBasicSamples) +{-# ANN divBasicTB (TestBench 'divBasic) #-} diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs index 234f436..ca98cf4 100644 --- a/Xilinx/Floating/TH.hs +++ b/Xilinx/Floating/TH.hs @@ -49,10 +49,32 @@ addBasicSamples = [ (1, 4, 5) , (2, 5, 7) , (3, 6, 9) - -- Subnormal positive number is conditioned to plus zero + ] + ++ addSubBasicSamples + ++ cartesianProductTest model interesting interesting + ++ nanTest + where + model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x + y + +subBasicSamples :: [(Float, Float, Float)] +subBasicSamples = + delayOutput (natToNum @F.SubDefDelay) $ + [ (1, 6, -5) + , (2, 5, -3) + , (3, 4, -1) + ] + ++ map (\(a,b,c) -> (a, negate b, c)) addSubBasicSamples + ++ cartesianProductTest model interesting interesting + ++ nanTest + where + model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x - y + +addSubBasicSamples :: [(Float, Float, Float)] +addSubBasicSamples = + [ -- Subnormal positive number is conditioned to plus zero -- -- The unconditioned result is the subnormal of largest magnitude - , ( -minNormal + ( -minNormal , minNormal + maxDenormal , 0 ) @@ -93,9 +115,10 @@ addBasicSamples = , minDenormal , minNormal ) - -- Idem dito. - , ( minNormal - , maxDenormal + -- The result would normally be exact, but the first input is conditioned + -- to zero. + , ( maxDenormal + , minNormal , minNormal ) -- Subnormals on input are conditioned to zero, negative version @@ -119,9 +142,10 @@ addBasicSamples = , -minDenormal , -minNormal ) - -- Idem dito. - , ( -minNormal - , -maxDenormal + -- The result would normally be exact, but the first input is conditioned + -- to zero. + , ( -maxDenormal + , -minNormal , -minNormal ) -- Round to nearest @@ -190,7 +214,7 @@ addBasicSamples = -- infinity , ( maxFinite , encodeFloat (2 ^ (digits - 1)) (maxExp - 2*digits) - , 1/0 + , infinity ) -- 1111 -- 01111 @@ -201,16 +225,250 @@ addBasicSamples = , encodeFloat (2 ^ digits - 1) (maxExp - digits) ) -- Infinities - , (infinity, 1, infinity) - , (-infinity, 1, -infinity) + , (infinity, -maxFinite, infinity) + , (-infinity, maxFinite, -infinity) + , (infinity, -infinity, F.xilinxNaN) + ] + where + digits = floatDigits (undefined :: Float) + (_, maxExp) = floatRange (undefined :: Float) + +mulBasicSamples :: [(Float, Float, Float)] +mulBasicSamples = + delayOutput (natToNum @F.MulDefDelay) $ + [ (1, 4, 4) + , (2, 5, 10) + , (3, 6, 18) + -- Subnormal positive number is conditioned to plus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( 1/2 + , encodeFloat (2 ^ digits - 2) (minExp - digits) + , 0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( encodeFloat 1 (1 - digits) + , minNormal + , 0 + ) + -- Subnormal negative number is conditioned to minus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( -1/2 + , encodeFloat (2 ^ digits - 2) (minExp - digits) + , -0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( encodeFloat 1 (1 - digits) + , -minNormal + , -0 + ) + -- Subnormals on input are conditioned to zero + -- + -- The result would normally be about four, but due to conditioning it is + -- zero. + , ( maxDenormal + , maxFinite + , 0 + ) + -- The result would normally be minNormal, but due to conditioning it is + -- zero. + , ( encodeFloat 1 (digits - 1) + , minDenormal + , 0 + ) + -- Subnormals on input are conditioned to zero, negative version + -- + -- + -- The result would normally be about -4, but due to conditioning it is + -- zero. + , ( -maxDenormal + , maxFinite + , -0 + ) + -- The result would normally be -minNormal, but due to conditioning it is + -- zero. + , ( encodeFloat 1 (digits - 1) + , -minDenormal + , -0 + ) + -- Round to nearest + -- + -- A small program has been used to determine the two numbers to be + -- multiplied such that they lead to the desired product. For ease of + -- comprehension, the result is shown in the comments in two formats. + -- + -- First, in an easily read format: as if it were the 8-bit result of a + -- product of two 4-bit mantissa's, to show the desired rounding (cf. + -- comments in addSubBasicSamples). + -- + -- If the structure of the full result is exactly equal to the ideal 8-bit + -- result, that is all. However, if the structure is not ideal, the 8-bit + -- result is shown with variable placeholders, and there, let XX = xx + 1. + -- + -- In addition, the precise result is shown for completenes in this case. + -- + -- 1xx0 1001 + -- -------- round + -- 1xx1 + -- + -- 0b1000_0000_0000_0000_0000_0110_1000_0000_0000_0000_0000_0001 + -- ------------------------------------------------------------- round + -- 0b1000_0000_0000_0000_0000_0111 + -- + , ( 14220287 + , 9896959 + , encodeFloat 0b1000_0000_0000_0000_0000_0111 digits + ) + -- + -- 1000 0111 + -- --------- round + -- 1000 + -- + , ( 10066329 + , 13981015 + , encodeFloat (2 ^ (digits - 1)) digits + ) + -- Ties to even + -- + -- 1000 1000 + -- --------- round + -- 1000 + , ( 12713984 + , 11069504 + , encodeFloat (2 ^ (digits - 1)) digits + ) + -- Round to nearest + -- + -- 1xx1 1001 + -- --------- round + -- 1XX0 + -- + -- 0b1000_0000_0000_0000_0000_1101_1000_0000_0000_0000_0000_0001 + -- ------------------------------------------------------------- round + -- 0b1000_0000_0000_0000_0000_1110 + -- + , ( 12427923 + , 11324315 + , encodeFloat 0b1000_0000_0000_0000_0000_1110 digits + ) + -- 1xx1 0111 + -- --------- round + -- 1xx1 + -- + -- 0b1000_0000_0000_0000_0000_1001_0111_1111_1111_1111_1111_1111 + -- ------------------------------------------------------------- round + -- 0b1000_0000_0000_0000_0000_1001 + -- + , ( 10837383 + , 12986313 + , encodeFloat 0b1000_0000_0000_0000_0000_1001 digits + ) + -- Ties to even + -- + -- 1001 1000 + -- --------- round + -- 1010 + , ( 12689408 + , 11090944 + , encodeFloat (2 ^ (digits - 1) + 2) digits + ) + -- Infinities + , (infinity, minNormal, infinity) + , (-infinity, minNormal, -infinity) + , (infinity, -minNormal, -infinity) + , (-infinity, -minNormal, infinity) + , (infinity, 0, F.xilinxNaN) + , (-infinity, 0, F.xilinxNaN) + , (infinity, -0, F.xilinxNaN) + , (-infinity, -0, F.xilinxNaN) + ] + ++ cartesianProductTest model interesting interesting + ++ nanTest + where + digits = floatDigits (undefined :: Float) + (minExp, _) = floatRange (undefined :: Float) + model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x * y + +divBasicSamples :: [(Float, Float, Float)] +divBasicSamples = + delayOutput (natToNum @F.DivDefDelay) $ + [ (1, 2, 0.5) + , (3, 4, 0.75) + , (7, 8, 0.875) + -- Subnormal positive number is conditioned to plus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( encodeFloat (2 ^ digits - 2) (1 - digits) + , encodeFloat 1 (maxExp - 1) + , 0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( encodeFloat 2 (1 - digits) + , encodeFloat 1 (maxExp - 1) + , 0 + ) + -- Subnormal negative number is conditioned to minus zero + -- + -- The unconditioned result is the subnormal of largest magnitude + , ( -encodeFloat (2 ^ digits - 2) (1 - digits) + , encodeFloat 1 (maxExp - 1) + , -0 + ) + -- The unconditioned result is the subnormal of smallest magnitude + , ( -encodeFloat 2 (1 - digits) + , encodeFloat 1 (maxExp - 1) + , -0 + ) + -- Subnormals on input are conditioned to zero + -- + -- The result would normally be about one, but due to conditioning it is + -- zero. + , ( maxDenormal + , minNormal + , 0 + ) + -- The result would normally be about maxFinite/2, but due to + -- conditioning it is division by zero -> infinity. + , ( encodeFloat 2 (1 - digits) + , minDenormal + , infinity + ) + -- Subnormals on input are conditioned to zero, negative version + -- + -- + -- The result would normally be about -1, but due to conditioning it is + -- zero. + , ( -maxDenormal + , minNormal + , -0 + ) + -- The result would normally be about -maxFinite/2, but due to + -- conditioning it is division by zero -> negative infinity. + , ( encodeFloat 2 (1 - digits) + , -minDenormal + , -infinity + ) + -- Infinities + , (infinity, maxFinite, infinity) + , (-infinity, maxFinite, -infinity) + , (infinity, -maxFinite, -infinity) + , (-infinity, -maxFinite, infinity) + , (1, 0, infinity) + , (-1, 0, -infinity) + , (1, -0, -infinity) + , (-1, -0, infinity) + , (infinity, infinity, F.xilinxNaN) + , (-infinity, infinity, F.xilinxNaN) , (infinity, -infinity, F.xilinxNaN) + , (-infinity, -infinity, F.xilinxNaN) ] ++ cartesianProductTest model interesting interesting ++ nanTest where digits = floatDigits (undefined :: Float) (_, maxExp) = floatRange (undefined :: Float) - model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x + y + model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x / y cartesianProductTest :: (a -> b -> c) @@ -237,8 +495,10 @@ interesting = , epsilon , F.xilinxNaN -- Some basic numbers + , 0 , 1 , 2 + , 4 , 42 ] From d27d578e7bdd98ebfa3144ac23c6a56ca2623147 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Thu, 31 Mar 2022 15:58:31 +0200 Subject: [PATCH 03/36] `Xilinx.Floating` tests: Use `MemBlob` Also don't use `MagicHash` since it's not enabled by default for `clash-testsuite`. --- Xilinx/Floating.hs | 39 +++++++++++++++------------------------ Xilinx/Floating/TH.hs | 19 ++----------------- 2 files changed, 17 insertions(+), 41 deletions(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index 1e23821..566ade4 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -1,5 +1,5 @@ {-| -Copyright : (C) 2021, QBayLogic B.V., +Copyright : (C) 2021-2022, QBayLogic B.V., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -27,13 +27,13 @@ instance ShowX FloatVerifier where showsPrecX = showsPrecXWith showsPrec instance Show FloatVerifier where - showsPrec = floatVerifierShowsPrec# + showsPrec = floatVerifierShowsPrec -floatVerifierShowsPrec# +floatVerifierShowsPrec :: Int -> FloatVerifier -> ShowS -floatVerifierShowsPrec# _ (FloatVerifier x) +floatVerifierShowsPrec _ (FloatVerifier x) | isNaN x = nanSign . nanString . showHex payload . (')':) | otherwise = shows x where @@ -53,12 +53,11 @@ playSampleRom ) => Clock dom -> Reset dom - -> SNat n - -> FilePath + -> MemBlob n (BitSize a) -> (Signal dom Bool, Signal dom a) -playSampleRom clk rst n file = (done, out) +playSampleRom clk rst content = (done, out) where - out = unpack . asyncRomFile n file <$> cnt + out = unpack . asyncRomBlob content <$> cnt done = CEP.register clk rst enableGen False $ (== maxBound) <$> cnt cnt :: Signal dom (Index n) cnt = CEP.register clk rst enableGen 0 $ satSucc SatBound <$> cnt @@ -67,6 +66,7 @@ basicBinaryTB :: forall n d . ( KnownNat n , KnownNat d + , 1 <= n ) => ( Clock XilinxSystem -> DSignal XilinxSystem 0 Float @@ -100,12 +100,11 @@ basicRomTB -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem d Float ) - -> SNat n - -> FilePath + -> MemBlob n (BitSize (Float, Float, Float)) -> Signal XilinxSystem Bool -basicRomTB comp n sampleFile = done +basicRomTB comp sampleBlob = done where - (done0, samples) = playSampleRom clk rst n sampleFile + (done0, samples) = playSampleRom clk rst sampleBlob (inputX, inputY, expectedOutput) = unbundle samples -- Only assert while not finished done = mux done0 done0 @@ -129,9 +128,7 @@ addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y {-# ANN addBasic (binTopAnn "addBasic") #-} addBasicTB :: Signal XilinxSystem Bool -addBasicTB = - uncurry (basicRomTB addBasic) - $(romDataFromFile "add-samplerom.bin" addBasicSamples) +addBasicTB = basicRomTB addBasic $(memBlobTH Nothing addBasicSamples) {-# ANN addBasicTB (TestBench 'addBasic) #-} addEnable @@ -203,9 +200,7 @@ subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y {-# ANN subBasic (binTopAnn "subBasic") #-} subBasicTB :: Signal XilinxSystem Bool -subBasicTB = - uncurry (basicRomTB subBasic) - $(romDataFromFile "sub-samplerom.bin" subBasicSamples) +subBasicTB = basicRomTB subBasic $(memBlobTH Nothing subBasicSamples) {-# ANN subBasicTB (TestBench 'subBasic) #-} mulBasic @@ -218,9 +213,7 @@ mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y {-# ANN mulBasic (binTopAnn "mulBasic") #-} mulBasicTB :: Signal XilinxSystem Bool -mulBasicTB = - uncurry (basicRomTB mulBasic) - $(romDataFromFile "mul-samplerom.bin" mulBasicSamples) +mulBasicTB = basicRomTB mulBasic $(memBlobTH Nothing mulBasicSamples) {-# ANN mulBasicTB (TestBench 'mulBasic) #-} divBasic @@ -233,7 +226,5 @@ divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y {-# ANN divBasic (binTopAnn "divBasic") #-} divBasicTB :: Signal XilinxSystem Bool -divBasicTB = - uncurry (basicRomTB divBasic) - $(romDataFromFile "div-samplerom.bin" divBasicSamples) +divBasicTB = basicRomTB divBasic $(memBlobTH Nothing divBasicSamples) {-# ANN divBasicTB (TestBench 'divBasic) #-} diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs index ca98cf4..df59ad1 100644 --- a/Xilinx/Floating/TH.hs +++ b/Xilinx/Floating/TH.hs @@ -1,5 +1,5 @@ {-| -Copyright : (C) 2021, QBayLogic B.V., +Copyright : (C) 2021-2022, QBayLogic B.V., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -8,30 +8,15 @@ Maintainer : QBayLogic B.V. module Floating.TH where -import Clash.Prelude (BitPack, natToNum, SNat(..), unpack) -import Clash.Prelude.ROM.File (memFile) +import Clash.Prelude (natToNum, unpack) import Prelude -import Language.Haskell.TH - (appTypeE, conE, ExpQ, litE, litT, numTyLit, stringL, tupE) -import Language.Haskell.TH.Syntax (qRunIO) import Numeric.IEEE (epsilon, infinity, maxFinite, minDenormal, minNormal) import Clash.Cores.Xilinx.Floating as F import Clash.Cores.Xilinx.Floating.Internal as F -romDataFromFile - :: BitPack a - => FilePath - -> [a] - -> ExpQ -romDataFromFile file es = - qRunIO (writeFile file $ memFile (Just 0) es) - >> tupE [ appTypeE (conE 'SNat) (litT . numTyLit . toInteger $ length es) - , litE $ stringL file - ] - delayOutput :: Int -> [(Float, Float, Float)] From b544e84e5339c85d72f2cb801fb2dce252e73b96 Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Tue, 27 Sep 2022 18:34:50 +0200 Subject: [PATCH 04/36] New: `Xilinx.Floating.fromU32` New in `clash-cores`: convert `Unsigned 32` to `Float` with Xilinx IP. --- Xilinx/Floating.hs | 71 +++++++++++++++++++++++++++++++--- Xilinx/Floating/Annotations.hs | 32 +++++++++++++-- Xilinx/Floating/TH.hs | 36 ++++++++++++++++- 3 files changed, 128 insertions(+), 11 deletions(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index 566ade4..e616055 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -1,5 +1,6 @@ {-| Copyright : (C) 2021-2022, QBayLogic B.V., + 2022 , Google Inc., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -125,7 +126,7 @@ addBasic -> DSignal XilinxSystem F.AddDefDelay Float addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y {-# NOINLINE addBasic #-} -{-# ANN addBasic (binTopAnn "addBasic") #-} +{-# ANN addBasic (binaryTopAnn "addBasic") #-} addBasicTB :: Signal XilinxSystem Bool addBasicTB = basicRomTB addBasic $(memBlobTH Nothing addBasicSamples) @@ -139,7 +140,7 @@ addEnable -> DSignal XilinxSystem 11 Float addEnable clk en x y = withClock clk $ withEnable en $ F.add x y {-# NOINLINE addEnable #-} -{-# ANN addEnable (binEnTopAnn "addEnable") #-} +{-# ANN addEnable (binaryEnTopAnn "addEnable") #-} addEnableTB :: Signal XilinxSystem Bool addEnableTB = done @@ -179,7 +180,7 @@ addShortPL addShortPL clk x y = withClock clk $ withEnable enableGen $ F.addWith F.defConfig x y {-# NOINLINE addShortPL #-} -{-# ANN addShortPL (binTopAnn "addShortPL") #-} +{-# ANN addShortPL (binaryTopAnn "addShortPL") #-} addShortPLTB :: Signal XilinxSystem Bool addShortPLTB = @@ -197,7 +198,7 @@ subBasic -> DSignal XilinxSystem F.SubDefDelay Float subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y {-# NOINLINE subBasic #-} -{-# ANN subBasic (binTopAnn "subBasic") #-} +{-# ANN subBasic (binaryTopAnn "subBasic") #-} subBasicTB :: Signal XilinxSystem Bool subBasicTB = basicRomTB subBasic $(memBlobTH Nothing subBasicSamples) @@ -210,7 +211,7 @@ mulBasic -> DSignal XilinxSystem F.MulDefDelay Float mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y {-# NOINLINE mulBasic #-} -{-# ANN mulBasic (binTopAnn "mulBasic") #-} +{-# ANN mulBasic (binaryTopAnn "mulBasic") #-} mulBasicTB :: Signal XilinxSystem Bool mulBasicTB = basicRomTB mulBasic $(memBlobTH Nothing mulBasicSamples) @@ -223,8 +224,66 @@ divBasic -> DSignal XilinxSystem F.DivDefDelay Float divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y {-# NOINLINE divBasic #-} -{-# ANN divBasic (binTopAnn "divBasic") #-} +{-# ANN divBasic (binaryTopAnn "divBasic") #-} divBasicTB :: Signal XilinxSystem Bool divBasicTB = basicRomTB divBasic $(memBlobTH Nothing divBasicSamples) {-# ANN divBasicTB (TestBench 'divBasic) #-} + +fromUBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 (Unsigned 32) + -> DSignal XilinxSystem F.FromU32DefDelay Float +fromUBasic clk x = withClock clk $ withEnable enableGen $ F.fromU32 x +{-# NOINLINE fromUBasic #-} +{-# ANN fromUBasic (unaryTopAnn "fromUBasic") #-} + +fromUBasicTB :: Signal XilinxSystem Bool +fromUBasicTB = done + where + (done0, samples) = + playSampleRom clk rst $(memBlobTH Nothing fromUBasicSamples) + (input, expectedOutput) = unbundle samples + -- Only assert while not finished + done = mux done0 done0 $ + assert clk rst "fromUBasicTB" out expectedOutput done0 + out = ignoreFor clk rst en (SNat @F.FromU32DefDelay) 0 . toSignal . + fromUBasic clk $ fromSignal input + clk = tbClockGen (not <$> done) + rst = resetGen + en = enableGen +{-# ANN fromUBasicTB (TestBench 'fromUBasic) #-} + +fromUEnable + :: Clock XilinxSystem + -> Enable XilinxSystem + -> DSignal XilinxSystem 0 (Unsigned 32) + -> DSignal XilinxSystem 5 Float +fromUEnable clk en x = withClock clk $ withEnable en $ F.fromU32 x +{-# NOINLINE fromUEnable #-} +{-# ANN fromUEnable (unaryEnTopAnn "fromUEnable") #-} + +fromUEnableTB :: Signal XilinxSystem Bool +fromUEnableTB = done + where + testInput = fromSignal $ + stimuliGenerator clk rst $(listToVecTH [1 :: Unsigned 32 .. 20]) + en = toEnable $ stimuliGenerator clk rst + ((replicate d5 True ++ replicate d4 True ++ replicate d4 False) :< True) + expectedOutput = replicate d5 0 ++ + $(listToVecTH $ + [1 :: Float .. 4] + -- Stall for four cycles + <> P.replicate 4 5 + -- Still in the pipeline (5 deep) from before the stall. + <> P.take 5 [5 .. 20] + -- We "lose" four samples of what remains due to not being enabled + -- for those inputs. + <> P.drop 4 (P.drop 5 [5 .. 20]) + ) + expectOutput = outputVerifier' clk rst expectedOutput + done = expectOutput . ignoreFor clk rst enableGen d5 0 . toSignal $ + fromUEnable clk en testInput + clk = tbClockGen (not <$> done) + rst = resetGen +{-# ANN fromUEnableTB (TestBench 'fromUEnable) #-} diff --git a/Xilinx/Floating/Annotations.hs b/Xilinx/Floating/Annotations.hs index eb62d2a..fc17a83 100644 --- a/Xilinx/Floating/Annotations.hs +++ b/Xilinx/Floating/Annotations.hs @@ -1,5 +1,6 @@ {-| Copyright : (C) 2021, QBayLogic B.V., + 2022, Google Inc., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -8,8 +9,8 @@ module Floating.Annotations where import Clash.Prelude -binTopAnn :: String -> TopEntity -binTopAnn name = +binaryTopAnn :: String -> TopEntity +binaryTopAnn name = Synthesize { t_name = name , t_inputs = @@ -20,8 +21,8 @@ binTopAnn name = , t_output = PortName "result" } -binEnTopAnn :: String -> TopEntity -binEnTopAnn name = +binaryEnTopAnn :: String -> TopEntity +binaryEnTopAnn name = Synthesize { t_name = name , t_inputs = @@ -32,3 +33,26 @@ binEnTopAnn name = ] , t_output = PortName "result" } + +unaryTopAnn :: String -> TopEntity +unaryTopAnn name = + Synthesize + { t_name = name + , t_inputs = + [ PortName "clk" + , PortName "x" + ] + , t_output = PortName "result" + } + +unaryEnTopAnn :: String -> TopEntity +unaryEnTopAnn name = + Synthesize + { t_name = name + , t_inputs = + [ PortName "clk" + , PortName "en" + , PortName "x" + ] + , t_output = PortName "result" + } diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs index df59ad1..33202ce 100644 --- a/Xilinx/Floating/TH.hs +++ b/Xilinx/Floating/TH.hs @@ -1,5 +1,6 @@ {-| Copyright : (C) 2021-2022, QBayLogic B.V., + 2022 , Google Inc., License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} @@ -8,7 +9,7 @@ Maintainer : QBayLogic B.V. module Floating.TH where -import Clash.Prelude (natToNum, unpack) +import Clash.Prelude (natToNum, unpack, Unsigned) import Prelude import Numeric.IEEE @@ -521,6 +522,39 @@ nanTest = , (nan, nan, F.xilinxNaN) ] +fromUBasicSamples :: [(Unsigned 32, Float)] +fromUBasicSamples = delayOutput0 (natToNum @F.FromU32DefDelay) $ + map (\x -> (x, fromIntegral x)) + [ 0 + , 1 + , maxBound + + -- Patterns 0xaa and 0x55, but treating the "sign bit" separately. Floats + -- are stored in sign/magnitude form so signed and unsigned numbers are + -- not interchangeable like with two's complement. All these numbers + -- should be unsigned, verify that they are treated as such. + , 0b0010_1010_1010_1010_1010_1010_1010_1010 + , 0b0101_0101_0101_0101_0101_0101_0101_0101 + , 0b1010_1010_1010_1010_1010_1010_1010_1010 + , 0b1101_0101_0101_0101_0101_0101_0101_0101 + + , -- Longest exactly representable + 0b0000_0000_1111_1111_1111_1111_1111_1111 + + , -- Smallest with rounding + 0b0000_0001_0000_0000_0000_0000_0000_0001 + + -- More rounding tests + , 0b0000_0001_0000_0000_0000_0000_0000_0011 + , 0b0000_0010_0000_0000_0000_0000_0000_0001 + ] + where + delayOutput0 d es = zip is os + where + (is0, os0) = unzip es + is = is0 ++ repeat (last is0) + os = replicate d 0 ++ os0 + -- Maximum subnormal value maxDenormal :: Float maxDenormal = minNormal - minDenormal From ef7b125d620e30ee9975015c75da5d48e8dba019 Mon Sep 17 00:00:00 2001 From: Vanessa McHale Date: Mon, 24 Oct 2022 09:22:10 -0400 Subject: [PATCH 05/36] Add Xilinx dual clock FIFO to clash-cores (#2270) Only a limited number of configurations is supported; see module documentation. The Haskell model does not correspond exactly to RTL. This closes https://github.com/bittide/bittide-hardware/issues/59 Co-authored-by: Martijn Bastiaan Co-authored-by: Peter Lebbing --- Xilinx/DcFifo/Abstract.hs | 166 ++++++++++++++++++++++++++++++++++++++ Xilinx/DcFifo/Basic.hs | 137 +++++++++++++++++++++++++++++++ Xilinx/DcFifo0.hs | 14 ++++ Xilinx/DcFifo1.hs | 14 ++++ Xilinx/DcFifo2.hs | 14 ++++ 5 files changed, 345 insertions(+) create mode 100644 Xilinx/DcFifo/Abstract.hs create mode 100644 Xilinx/DcFifo/Basic.hs create mode 100644 Xilinx/DcFifo0.hs create mode 100644 Xilinx/DcFifo1.hs create mode 100644 Xilinx/DcFifo2.hs diff --git a/Xilinx/DcFifo/Abstract.hs b/Xilinx/DcFifo/Abstract.hs new file mode 100644 index 0000000..73301c6 --- /dev/null +++ b/Xilinx/DcFifo/Abstract.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module DcFifo.Abstract where + +import Clash.Explicit.Prelude +import Clash.Cores.Xilinx.DcFifo +import Clash.Explicit.Testbench +import Data.Maybe (isJust) + +type ReadLastCycle = Bool +type Stall = Bool +type ExpectedToRead n = BitVector n +type UnexpectedRead = Bool + +createDomain vXilinxSystem{vName="Dom2", vPeriod=hzToPeriod 2e7} +createDomain vXilinxSystem{vName="Dom3", vPeriod=hzToPeriod 3e7} +createDomain vXilinxSystem{vName="Dom17", vPeriod=hzToPeriod 17e7} + +-- | Produce a 'Just' when predicate is True, else Nothing +orNothing :: Bool -> a -> Maybe a +orNothing True a = Just a +orNothing False _ = Nothing + +lfsrF :: + KnownDomain dom => + Clock dom -> Reset dom -> Enable dom -> + BitVector 16 -> + Signal dom Bit +lfsrF clk rst ena seed = msb <$> r + where + r = register clk rst ena seed (lfsrF' <$> r) + + lfsrF' :: BitVector 16 -> BitVector 16 + lfsrF' s = pack lfsrFeedback ++# slice d15 d1 s + where + five, three, two, zero :: Unsigned 16 + (five, three, two, zero) = (5, 3, 2, 0) + lfsrFeedback = s ! five `xor` s ! three `xor` s ! two `xor` s ! zero +{-# NOINLINE lfsrF #-} + +fifoSampler :: + KnownDomain dom => + Clock dom -> Reset dom -> Enable dom -> + -- | Stall circuit? For this test case, this signal comes from 'lfsrF' + Signal dom Stall -> + -- | Signals from FIFO + Signal dom (Empty, DataCount depth, a) -> + -- | Maybe output read from FIFO + Signal dom (Bool, Maybe a) +fifoSampler clk rst ena stalls inps = + mealy clk rst ena go False (bundle (stalls, inps)) + where + go :: + ReadLastCycle -> + (Stall, (Empty, DataCount depth, a)) -> + (ReadLastCycle, (Bool, Maybe a)) + go readLastCycle (stall, (fifoEmpty, _dataCount, readData)) = (readNow, (readNow, maybeData)) + where + maybeData = readLastCycle `orNothing` readData + readNow = not stall && not fifoEmpty +{-# NOINLINE fifoSampler #-} + +-- | Drives Xilinx FIFO with an ascending sequence of 'BitVector's. Stalls +-- intermittently based on stall input. +fifoDriver :: + forall a dom depth . + ( KnownDomain dom + , NFDataX a + , Enum a + , Num a + ) => + Clock dom -> Reset dom -> Enable dom -> + -- | Stall circuit? For this test case, this signal comes from 'lfsrF' + Signal dom Stall -> + -- | Signals from FIFO + Signal dom (Full, DataCount depth) -> + -- | Maybe write input to FIFO + Signal dom (Maybe a) +fifoDriver clk rst ena stalls inps = + mealyB clk rst ena go 0 (stalls, inps) + where + go :: + a -> + (Stall, (Full, DataCount depth)) -> + (a, Maybe a) + go n0 (stall, (full, _dataCount)) = (n1, maybeWrite) + where + maybeWrite = willWrite `orNothing` n0 + willWrite = not stall && not full + n1 = if willWrite then succ n0 else n0 + +type ConfiguredFifo a read write = + Clock write -> + Reset write -> + Clock read -> + Reset read -> + + -- | Write data + Signal write (Maybe a) -> + -- | Read enable + Signal read Bool -> + FifoOut read write 4 a + +mkTestBench :: + forall a read write. + ( Num a + , Enum a + , NFDataX a + , Ord a + , ShowX a + , KnownDomain write + , KnownDomain read + ) => + ConfiguredFifo a read write -> + Signal read Bool +mkTestBench cFifo = done + where + (rClk, wClk) = biTbClockGen (not <$> done) + + noRRst = unsafeFromHighPolarity $ pure False + noWRst = unsafeFromHighPolarity $ pure False + + rEna = enableGen + wEna = enableGen + + -- Driver + wLfsr = bitToBool <$> lfsrF wClk noWRst wEna 0xDEAD + writeData = fifoDriver wClk noWRst wEna wLfsr (bundle (isFull, writeCount)) + + -- Sampler + rLfsr = bitToBool <$> lfsrF rClk noRRst rEna 0xBEEF + (readEnable, maybeReadData) = + unbundle $ + fifoSampler rClk noRRst rEna rLfsr (bundle (isEmpty, readCount, fifoData)) + + FifoOut{isFull, writeCount, isEmpty, readCount, fifoData} = + cFifo wClk noWRst rClk noRRst writeData readEnable + + done = fifoVerifier rClk noRRst rEna maybeReadData +{-# INLINE mkTestBench #-} + +fifoVerifier :: + forall a dom . + ( KnownDomain dom + , Ord a + , Num a + , NFDataX a + , ShowX a + ) => + Clock dom -> Reset dom -> Enable dom -> + Signal dom (Maybe a) -> + Signal dom Bool +fifoVerifier clk rst ena actual = done0 + where + expected = regEn clk rst ena 0 (isJust <$> actual) $ expected + 1 + samplesDone = expected .>. 100 + stuckCnt :: Signal dom (Index 25000) + stuckCnt = regEn clk rst ena 0 (not <$> stuck) $ stuckCnt + 1 + stuck = stuckCnt .==. pure maxBound + -- Delay one cycle so assertion definitely triggers before stopping simulation + done = register clk rst ena False $ samplesDone .||. stuck + expected0 = liftA2 (<$) expected actual + done0 = + assert clk rst "Doesn't time out" stuck (pure False) $ + assert clk rst "fifoVerifier" actual expected0 done +{-# NOINLINE fifoVerifier #-} diff --git a/Xilinx/DcFifo/Basic.hs b/Xilinx/DcFifo/Basic.hs new file mode 100644 index 0000000..d9a13d7 --- /dev/null +++ b/Xilinx/DcFifo/Basic.hs @@ -0,0 +1,137 @@ +module Basic where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench +import Clash.Sized.Internal.BitVector (undefined#) +import Clash.Cores.Xilinx.DcFifo + +-- Configurables +type Overfill = 4 +type DepthParam = 4 +type ActualDepth = 15 +-- End of configurables + +type TotalElems = ActualDepth + Overfill +type Elem = Index TotalElems + +data FSM + = Push (Index TotalElems) + | StartRead + | Pop (Index TotalElems) + | Done + deriving (Show, Generic, NFDataX) + +topEntity :: + Clock XilinxSystem -> + Reset XilinxSystem -> + Signal XilinxSystem (Maybe Elem) -> + Signal XilinxSystem Bool -> + ( FifoOut XilinxSystem XilinxSystem DepthParam Elem + , FifoOut XilinxSystem XilinxSystem DepthParam Elem + ) +topEntity clk rst writeData rEnable = + ( dcFifo minOpt clk rst clk rst writeData rEnable + , dcFifo maxOpt clk rst clk rst writeData rEnable + ) + where + minOpt = DcConfig + { dcDepth=SNat + , dcReadDataCount=False + , dcWriteDataCount=False + , dcOverflow=False + , dcUnderflow=False + } + maxOpt = DcConfig + { dcDepth=SNat + , dcReadDataCount=True + , dcWriteDataCount=True + , dcOverflow=True + , dcUnderflow=True + } +{-# NOINLINE topEntity #-} + +testBench :: + Signal XilinxSystem Bool +testBench = done + where + fsmOut = let (s', o) = unbundle $ fsm <$> register clk noRst en (Push 0) s' + in o + (minOut, maxOut) = + topEntity clk noRst (fWriteData <$> fsmOut) (fREnable <$> fsmOut) + done = + register clk noRst en False + $ assertBitVector clk noRst "FIFO min full" + (pack <$> isFull minOut) (fExpectedFull <$> fsmOut) + $ assertBitVector clk noRst "FIFO max full" + (pack <$> isFull maxOut) (fExpectedFull <$> fsmOut) + $ assertBitVector clk noRst "FIFO max overflow" + (pack <$> isOverflow maxOut) (fExpectedOverflow <$> fsmOut) + $ assertBitVector clk noRst "FIFO min empty" + (pack <$> isEmpty minOut) (fExpectedEmpty <$> fsmOut) + $ assertBitVector clk noRst "FIFO max empty" + (pack <$> isEmpty maxOut) (fExpectedEmpty <$> fsmOut) + $ assertBitVector clk noRst "FIFO max underflow" + (pack <$> isUnderflow maxOut) (fExpectedUnderflow <$> fsmOut) + $ assertBitVector clk noRst "FIFO min data out" + (pack <$> fifoData minOut) (fExpectedData <$> fsmOut) + $ assertBitVector clk noRst "FIFO max data out" + (pack <$> fifoData maxOut) (fExpectedData <$> fsmOut) + (fDone <$> fsmOut) + clk = tbClockGen (not <$> done) + noRst = unsafeFromHighPolarity $ pure False + en = enableGen +{-# NOINLINE testBench #-} + +data FsmOut = FsmOut + { fDone :: Bool + , fWriteData :: Maybe Elem + , fREnable :: Bool + , fExpectedFull :: BitVector 1 + , fExpectedOverflow :: BitVector 1 + , fExpectedEmpty :: BitVector 1 + , fExpectedUnderflow :: BitVector 1 + , fExpectedData :: BitVector (BitSize Elem) + } + +defFsmOut :: FsmOut +defFsmOut = + FsmOut{ fDone=False + , fWriteData=Nothing + , fREnable=False + , fExpectedFull=undefined# + , -- Assert overflow false by default + fExpectedOverflow=pack False + , fExpectedEmpty=undefined# + , -- Assert underflow false by default + fExpectedUnderflow=pack False + , fExpectedData=undefined# + } + +fsm :: + FSM -> + (FSM, FsmOut) +fsm (Push i) = + let s' = if (i == maxBound) then StartRead else Push (i + 1) + o = defFsmOut{ fWriteData=Just i + , fExpectedFull=pack (i >= actualDepth) + , fExpectedOverflow=pack (i > actualDepth) + } + in (s', o) +fsm StartRead = (Pop 0, defFsmOut{ fREnable=True + , fExpectedOverflow=pack True + }) +fsm (Pop i) = + let isLast = i == maxBound + s' = if isLast then Done else Pop (i + 1) + underflow = i >= actualDepth + o = defFsmOut{ fREnable=not isLast + , fExpectedEmpty=pack (i >= actualDepth - 1) + , fExpectedUnderflow=pack underflow + , fExpectedData=if underflow then undefined# + else pack (resize i) + } + in (s', o) +fsm Done = (Done, defFsmOut{fDone=True, fExpectedEmpty=pack True}) + +actualDepth :: Index TotalElems +actualDepth = natToNum @ActualDepth diff --git a/Xilinx/DcFifo0.hs b/Xilinx/DcFifo0.hs new file mode 100644 index 0000000..d2cc406 --- /dev/null +++ b/Xilinx/DcFifo0.hs @@ -0,0 +1,14 @@ +module DcFifo0 where + +import Clash.Cores.Xilinx.DcFifo +import Clash.Explicit.Prelude + +import DcFifo.Abstract + +topEntity :: ConfiguredFifo (BitVector 16) Dom17 Dom2 +topEntity = dcFifo defConfig +{-# NOINLINE topEntity #-} + +testBench :: Signal Dom17 Bool +testBench = mkTestBench topEntity +{-# NOINLINE testBench #-} diff --git a/Xilinx/DcFifo1.hs b/Xilinx/DcFifo1.hs new file mode 100644 index 0000000..ed89303 --- /dev/null +++ b/Xilinx/DcFifo1.hs @@ -0,0 +1,14 @@ +module DcFifo1 where + +import Clash.Cores.Xilinx.DcFifo +import Clash.Explicit.Prelude + +import DcFifo.Abstract + +topEntity :: ConfiguredFifo (BitVector 16) Dom2 Dom17 +topEntity = dcFifo defConfig +{-# NOINLINE topEntity #-} + +testBench :: Signal Dom2 Bool +testBench = mkTestBench topEntity +{-# NOINLINE testBench #-} diff --git a/Xilinx/DcFifo2.hs b/Xilinx/DcFifo2.hs new file mode 100644 index 0000000..2f79c34 --- /dev/null +++ b/Xilinx/DcFifo2.hs @@ -0,0 +1,14 @@ +module DcFifo2 where + +import Clash.Cores.Xilinx.DcFifo +import Clash.Explicit.Prelude + +import DcFifo.Abstract + +topEntity :: ConfiguredFifo (Unsigned 16) Dom2 Dom2 +topEntity = dcFifo defConfig +{-# NOINLINE topEntity #-} + +testBench :: Signal Dom2 Bool +testBench = mkTestBench topEntity +{-# NOINLINE testBench #-} From d10f458ed06ea5e6418ce99f4e811b903a53f3f4 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 25 Oct 2022 13:40:19 +0200 Subject: [PATCH 06/36] New: Xilinx.Floating.fromS32 (#2343) New in `clash-cores`: convert `Signed 32` to `Float` with Xilinx IP. --- Xilinx/Floating.hs | 58 +++++++++++++++++++++++++++++++++++++++++++ Xilinx/Floating/TH.hs | 38 +++++++++++++++++++++++++++- 2 files changed, 95 insertions(+), 1 deletion(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index e616055..3e38360 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -287,3 +287,61 @@ fromUEnableTB = done clk = tbClockGen (not <$> done) rst = resetGen {-# ANN fromUEnableTB (TestBench 'fromUEnable) #-} + +fromSBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 (Signed 32) + -> DSignal XilinxSystem F.FromS32DefDelay Float +fromSBasic clk x = withClock clk $ withEnable enableGen $ F.fromS32 x +{-# NOINLINE fromSBasic #-} +{-# ANN fromSBasic (unaryTopAnn "fromSBasic") #-} + +fromSBasicTB :: Signal XilinxSystem Bool +fromSBasicTB = done + where + (done0, samples) = + playSampleRom clk rst $(memBlobTH Nothing fromSBasicSamples) + (input, expectedOutput) = unbundle samples + -- Only assert while not finished + done = mux done0 done0 $ + assert clk rst "fromSBasicTB" out expectedOutput done0 + out = ignoreFor clk rst en (SNat @F.FromS32DefDelay) 0 . toSignal . + fromSBasic clk $ fromSignal input + clk = tbClockGen (not <$> done) + rst = resetGen + en = enableGen +{-# ANN fromSBasicTB (TestBench 'fromSBasic) #-} + +fromSEnable + :: Clock XilinxSystem + -> Enable XilinxSystem + -> DSignal XilinxSystem 0 (Signed 32) + -> DSignal XilinxSystem 6 Float +fromSEnable clk en x = withClock clk $ withEnable en $ F.fromS32 x +{-# NOINLINE fromSEnable #-} +{-# ANN fromSEnable (unaryEnTopAnn "fromSEnable") #-} + +fromSEnableTB :: Signal XilinxSystem Bool +fromSEnableTB = done + where + testInput = fromSignal $ + stimuliGenerator clk rst $(listToVecTH [1 :: Signed 32 .. 21]) + en = toEnable $ stimuliGenerator clk rst + ((replicate d6 True ++ replicate d4 True ++ replicate d4 False) :< True) + expectedOutput = replicate d6 0 ++ + $(listToVecTH $ + [1 :: Float .. 4] + -- Stall for four cycles + <> P.replicate 4 5 + -- Still in the pipeline (6 deep) from before the stall. + <> P.take 6 [5 .. 21] + -- We "lose" four samples of what remains due to not being enabled + -- for those inputs. + <> P.drop 4 (P.drop 6 [5 .. 21]) + ) + expectOutput = outputVerifier' clk rst expectedOutput + done = expectOutput . ignoreFor clk rst enableGen d6 0 . toSignal $ + fromSEnable clk en testInput + clk = tbClockGen (not <$> done) + rst = resetGen +{-# ANN fromSEnableTB (TestBench 'fromSEnable) #-} diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs index 33202ce..b553525 100644 --- a/Xilinx/Floating/TH.hs +++ b/Xilinx/Floating/TH.hs @@ -9,7 +9,7 @@ Maintainer : QBayLogic B.V. module Floating.TH where -import Clash.Prelude (natToNum, unpack, Unsigned) +import Clash.Prelude (natToNum, unpack, Signed, Unsigned) import Prelude import Numeric.IEEE @@ -555,6 +555,42 @@ fromUBasicSamples = delayOutput0 (natToNum @F.FromU32DefDelay) $ is = is0 ++ repeat (last is0) os = replicate d 0 ++ os0 +fromSBasicSamples :: [(Signed 32, Float)] +fromSBasicSamples = delayOutput0 (natToNum @F.FromS32DefDelay) $ + map (\x -> (x, fromIntegral x)) (specials ++ map (* (-1)) specials) + + where + specials = + [ 0 + , 1 + , minBound + , maxBound + + -- Patterns 0xaa and 0x55, but treating the "sign bit" separately. Floats + -- are stored in sign/magnitude form so signed and unsigned numbers are + -- not interchangeable like with two's complement. + , 0b0010_1010_1010_1010_1010_1010_1010_1010 + , 0b0101_0101_0101_0101_0101_0101_0101_0101 + , 0b1010_1010_1010_1010_1010_1010_1010_1010 + , 0b1101_0101_0101_0101_0101_0101_0101_0101 + + , -- Longest exactly representable + 0b0000_0000_1111_1111_1111_1111_1111_1111 + + , -- Smallest with rounding + 0b0000_0001_0000_0000_0000_0000_0000_0001 + + -- More rounding tests + , 0b0000_0001_0000_0000_0000_0000_0000_0011 + , 0b0000_0010_0000_0000_0000_0000_0000_0001 + ] + + delayOutput0 d es = zip is os + where + (is0, os0) = unzip es + is = is0 ++ repeat (last is0) + os = replicate d 0 ++ os0 + -- Maximum subnormal value maxDenormal :: Float maxDenormal = minNormal - minDenormal From fe27718b78e13b69a1f0c7c59c608bd5aff2323f Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 26 Oct 2022 10:56:59 +0200 Subject: [PATCH 07/36] New: `Clash.Cores.Xilinx.Floating.compare` --- Xilinx/Floating.hs | 109 ++++++++++++++++++++++++++++++++++-------- Xilinx/Floating/TH.hs | 62 ++++++++++++++++++++---- 2 files changed, 142 insertions(+), 29 deletions(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index 3e38360..fc72e14 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -5,10 +5,13 @@ License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 -Wall -Werror #-} + module Floating where import Clash.Prelude import qualified Clash.Explicit.Prelude as CEP +import qualified Clash.Signal.Delayed as D import Clash.Explicit.Testbench import qualified Prelude as P @@ -20,6 +23,7 @@ import Floating.Annotations import Floating.TH newtype FloatVerifier = FloatVerifier Float + deriving (Generic, BitPack) instance Eq FloatVerifier where (FloatVerifier x) == (FloatVerifier y) = pack x == pack y @@ -64,26 +68,28 @@ playSampleRom clk rst content = (done, out) cnt = CEP.register clk rst enableGen 0 $ satSucc SatBound <$> cnt basicBinaryTB - :: forall n d + :: forall n d x y z . ( KnownNat n , KnownNat d + , Eq z, ShowX z , 1 <= n ) => ( Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem d Float + -> DSignal XilinxSystem 0 x + -> DSignal XilinxSystem 0 y + -> DSignal XilinxSystem d z ) - -> Vec n (Float, Float, Float) + -> z + -> Vec n (x, y, z) -> Signal XilinxSystem Bool -basicBinaryTB comp samples = done +basicBinaryTB comp zDef samples = done where (inputX, inputY, expectedOutput) = unzip3 samples testInputX = fromSignal $ stimuliGenerator clk rst inputX testInputY = fromSignal $ stimuliGenerator clk rst inputY - expectOutput = outputVerifier' clk rst (repeat @d 0 ++ expectedOutput) + expectOutput = outputVerifier' clk rst (repeat @d zDef ++ expectedOutput) done = - expectOutput . ignoreFor clk rst en (SNat @d) 0 + expectOutput . ignoreFor clk rst en (SNat @d) zDef . toSignal $ comp clk testInputX testInputY clk = tbClockGen (not <$> done) rst = resetGen @@ -91,28 +97,32 @@ basicBinaryTB comp samples = done {-# INLINE basicBinaryTB #-} basicRomTB - :: forall d n + :: forall d n x y z . ( KnownNat n , KnownNat d + , BitPack x + , BitPack y + , Eq z, ShowX z, BitPack z , 1 <= n ) => ( Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem d Float + -> DSignal XilinxSystem 0 x + -> DSignal XilinxSystem 0 y + -> DSignal XilinxSystem d z ) - -> MemBlob n (BitSize (Float, Float, Float)) + -> z + -> MemBlob n (BitSize (x, y, z)) -> Signal XilinxSystem Bool -basicRomTB comp sampleBlob = done +basicRomTB comp resDef sampleBlob = done where (done0, samples) = playSampleRom clk rst sampleBlob (inputX, inputY, expectedOutput) = unbundle samples -- Only assert while not finished done = mux done0 done0 - $ assert clk rst "basicRomTB" out (fmap FloatVerifier expectedOutput) + $ assert clk rst "basicRomTB" out expectedOutput done0 out = - fmap FloatVerifier . ignoreFor clk rst en (SNat @d) 0 + ignoreFor clk rst en (SNat @d) resDef . toSignal $ comp clk (fromSignal inputX) (fromSignal inputY) clk = tbClockGen (not <$> done) rst = resetGen @@ -129,7 +139,11 @@ addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y {-# ANN addBasic (binaryTopAnn "addBasic") #-} addBasicTB :: Signal XilinxSystem Bool -addBasicTB = basicRomTB addBasic $(memBlobTH Nothing addBasicSamples) +addBasicTB = + basicRomTB + (\clk a b -> FloatVerifier <$> addBasic clk a b) + (FloatVerifier 0.0) + $(memBlobTH Nothing addBasicSamples) {-# ANN addBasicTB (TestBench 'addBasic) #-} addEnable @@ -184,7 +198,7 @@ addShortPL clk x y = addShortPLTB :: Signal XilinxSystem Bool addShortPLTB = - basicBinaryTB addShortPL + basicBinaryTB addShortPL 0.0 $(listToVecTH [ (1, 4, 5) :: (Float, Float, Float) , (2, 5, 7) , (3, 6, 9) @@ -201,7 +215,11 @@ subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y {-# ANN subBasic (binaryTopAnn "subBasic") #-} subBasicTB :: Signal XilinxSystem Bool -subBasicTB = basicRomTB subBasic $(memBlobTH Nothing subBasicSamples) +subBasicTB = + basicRomTB + (\clk a b -> FloatVerifier <$> subBasic clk a b) + (FloatVerifier 0.0) + $(memBlobTH Nothing subBasicSamples) {-# ANN subBasicTB (TestBench 'subBasic) #-} mulBasic @@ -214,7 +232,11 @@ mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y {-# ANN mulBasic (binaryTopAnn "mulBasic") #-} mulBasicTB :: Signal XilinxSystem Bool -mulBasicTB = basicRomTB mulBasic $(memBlobTH Nothing mulBasicSamples) +mulBasicTB = + basicRomTB + (\clk a b -> FloatVerifier <$> mulBasic clk a b) + (FloatVerifier 0.0) + $(memBlobTH Nothing mulBasicSamples) {-# ANN mulBasicTB (TestBench 'mulBasic) #-} divBasic @@ -227,9 +249,54 @@ divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y {-# ANN divBasic (binaryTopAnn "divBasic") #-} divBasicTB :: Signal XilinxSystem Bool -divBasicTB = basicRomTB divBasic $(memBlobTH Nothing divBasicSamples) +divBasicTB = + basicRomTB + (\clk a b -> FloatVerifier <$> divBasic clk a b) + (FloatVerifier 0.0) + $(memBlobTH Nothing divBasicSamples) {-# ANN divBasicTB (TestBench 'divBasic) #-} +compareBasic + :: Clock XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.CompareDefDelay F.Ordering +compareBasic clk x y = + withClock clk $ withEnable enableGen $ F.compare x y +{-# NOINLINE compareBasic #-} +{-# ANN compareBasic (binaryTopAnn "compareBasic") #-} + +compareBasicTB :: Signal XilinxSystem Bool +compareBasicTB = + basicRomTB compareBasic F.NaN $(memBlobTH Nothing compareBasicSamples) +{-# ANN compareBasicTB (TestBench 'compareBasic) #-} + +compareEnable + :: Clock XilinxSystem + -> Enable XilinxSystem + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem 0 Float + -> DSignal XilinxSystem F.CompareDefDelay F.Ordering +compareEnable clk en x y = withClock clk $ withEnable en $ F.compare x y +{-# NOINLINE compareEnable #-} +{-# ANN compareEnable (binaryEnTopAnn "compareEnable") #-} + +compareEnableTB :: Signal XilinxSystem Bool +compareEnableTB = done + where + done = outputVerifier' clk rst $(listToVecTH compareFloatsEnableExpected) actual1 + + actual1 = ignoreFor clk rst enableGen d6 F.EQ (D.toSignal actual0) + actual0 = compareEnable clk ena (D.fromSignal testInputA) (D.fromSignal testInputB) + + clk = tbClockGen (not <$> done) + rst = resetGen + ena = toEnable $ CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInput) + + testInputA = CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInputA) + testInputB = CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInputB) +{-# ANN compareEnableTB (TestBench 'compareEnable) #-} + fromUBasic :: Clock XilinxSystem -> DSignal XilinxSystem 0 (Unsigned 32) diff --git a/Xilinx/Floating/TH.hs b/Xilinx/Floating/TH.hs index b553525..a1e3541 100644 --- a/Xilinx/Floating/TH.hs +++ b/Xilinx/Floating/TH.hs @@ -5,6 +5,11 @@ License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} +{-# OPTIONS_GHC -Wall -Werror #-} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} module Floating.TH where @@ -18,20 +23,51 @@ import Numeric.IEEE import Clash.Cores.Xilinx.Floating as F import Clash.Cores.Xilinx.Floating.Internal as F +-- | For @compareEnableTB@. Obtained by running an RNG. +compareFloatsEnableInputA :: [Float] +compareFloatsEnableInputA = + [ 63, 73, 85, 68, 14, 36, 52, 38, 97, 60, 80, 10, 94, 58, 47, 59, 70, 9, 64 + , 79, 5, 49, 88, 93, 43, 90, 99, 56, 98, 12, 11, 20, 100, 57, 37, 33, 74, 83 + , 19, 84, 95, 53, 34, 89, 75, 55, 76, 44, 18, 28 + ] + +-- | For @compareEnableTB@. Obtained by running an RNG. +compareFloatsEnableInputB :: [Float] +compareFloatsEnableInputB = + [ 74, 62, 11, 12, 41, 10, 76, 90, 26, 93, 43, 29, 33, 79, 77, 80, 57, 70, 22 + , 19, 14, 8, 37, 2, 85, 89, 36, 86, 91, 17, 53, 4, 25, 97, 72, 24, 50, 9, 99 + , 95, 65, 30, 63, 7, 92, 15, 28, 82, 87, 84 + ] + +-- | For @compareEnableTB@. +compareFloatsEnableInput :: [Bool] +compareFloatsEnableInput = map (<= 50) compareFloatsEnableInputA + +-- | For @compareEnableTB@. Obtained by sampling Haskell model. +compareFloatsEnableExpected :: [F.Ordering] +compareFloatsEnableExpected = + [ F.EQ, F.EQ, F.EQ, F.EQ, F.EQ, F.EQ -- First samples undefined, replaced by EQ in TB + , F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT, F.LT, F.LT, F.LT, F.LT, F.LT + , F.LT, F.LT, F.LT, F.LT, F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT + , F.LT, F.LT, F.LT, F.GT, F.LT, F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT + , F.LT, F.LT, F.LT, F.LT, F.LT + ] + delayOutput :: Int - -> [(Float, Float, Float)] - -> [(Float, Float, Float)] -delayOutput d es = zip3 xs ys rs + -> a + -> [(Float, Float, a)] + -> [(Float, Float, a)] +delayOutput d aDef es = zip3 xs ys rs where (xs0, ys0, rs0) = unzip3 es xs = xs0 ++ repeat (last xs0) ys = ys0 ++ repeat (last ys0) - rs = replicate d 0 ++ rs0 + rs = replicate d aDef ++ rs0 addBasicSamples :: [(Float, Float, Float)] addBasicSamples = - delayOutput (natToNum @F.AddDefDelay) $ + delayOutput (natToNum @F.AddDefDelay) 0.0 $ [ (1, 4, 5) , (2, 5, 7) , (3, 6, 9) @@ -44,7 +80,7 @@ addBasicSamples = subBasicSamples :: [(Float, Float, Float)] subBasicSamples = - delayOutput (natToNum @F.SubDefDelay) $ + delayOutput (natToNum @F.SubDefDelay) 0.0 $ [ (1, 6, -5) , (2, 5, -3) , (3, 4, -1) @@ -221,7 +257,7 @@ addSubBasicSamples = mulBasicSamples :: [(Float, Float, Float)] mulBasicSamples = - delayOutput (natToNum @F.MulDefDelay) $ + delayOutput (natToNum @F.MulDefDelay) 0.0 $ [ (1, 4, 4) , (2, 5, 10) , (3, 6, 18) @@ -378,7 +414,7 @@ mulBasicSamples = divBasicSamples :: [(Float, Float, Float)] divBasicSamples = - delayOutput (natToNum @F.DivDefDelay) $ + delayOutput (natToNum @F.DivDefDelay) 0.0 $ [ (1, 2, 0.5) , (3, 4, 0.75) , (7, 8, 0.875) @@ -456,6 +492,16 @@ divBasicSamples = (_, maxExp) = floatRange (undefined :: Float) model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x / y +compareBasicSamples :: [(Float, Float, F.Ordering)] +compareBasicSamples = + delayOutput (natToNum @F.CompareDefDelay) F.NaN + $ [ (1.0, 2.0, F.LT) + , (2.0, 1.0, F.GT) + , (1.0, 1.0, F.EQ) + , (F.xilinxNaN, 1.0, F.NaN) + , (1.0, F.xilinxNaN, F.NaN) + ] ++ cartesianProductTest xilinxCompare interesting interesting + cartesianProductTest :: (a -> b -> c) -> [a] From e9c18b5d17041cdcb84dbc5342a4ec7621ce2aa4 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Sat, 19 Nov 2022 01:00:55 +0100 Subject: [PATCH 08/36] Add support for GHC 9.2 to clash-testsuite --- Xilinx/Floating.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index fc72e14..91502bc 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -23,7 +23,8 @@ import Floating.Annotations import Floating.TH newtype FloatVerifier = FloatVerifier Float - deriving (Generic, BitPack) + deriving (Generic) + deriving anyclass BitPack instance Eq FloatVerifier where (FloatVerifier x) == (FloatVerifier y) = pack x == pack y From 9442dbefcad7f3efcab55e0c95a397146c36967a Mon Sep 17 00:00:00 2001 From: Peter Lebbing Date: Wed, 16 Nov 2022 17:45:27 +0100 Subject: [PATCH 09/36] Test suite: multiple tests in one file PR #2345 made it possible to use multiple build targets in all tools. This PR leverages that functionality, combining build targets that were previously split over multiple top entity files. Not counting Vivado, 90% of `clash-testsuite`'s execution time is spent on Clash startup costs. These costs are shared between the multiple build targets, making the test suite a bit quicker. --- Xilinx/DcFifo/{Abstract.hs => Lfsr.hs} | 32 +++++++++++++++++++++++++- Xilinx/DcFifo0.hs | 14 ----------- Xilinx/DcFifo1.hs | 14 ----------- Xilinx/DcFifo2.hs | 14 ----------- 4 files changed, 31 insertions(+), 43 deletions(-) rename Xilinx/DcFifo/{Abstract.hs => Lfsr.hs} (81%) delete mode 100644 Xilinx/DcFifo0.hs delete mode 100644 Xilinx/DcFifo1.hs delete mode 100644 Xilinx/DcFifo2.hs diff --git a/Xilinx/DcFifo/Abstract.hs b/Xilinx/DcFifo/Lfsr.hs similarity index 81% rename from Xilinx/DcFifo/Abstract.hs rename to Xilinx/DcFifo/Lfsr.hs index 73301c6..438ce4b 100644 --- a/Xilinx/DcFifo/Abstract.hs +++ b/Xilinx/DcFifo/Lfsr.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -Wno-orphans #-} -module DcFifo.Abstract where +module Lfsr where import Clash.Explicit.Prelude import Clash.Cores.Xilinx.DcFifo @@ -164,3 +164,33 @@ fifoVerifier clk rst ena actual = done0 assert clk rst "Doesn't time out" stuck (pure False) $ assert clk rst "fifoVerifier" actual expected0 done {-# NOINLINE fifoVerifier #-} + +topEntity_17_2 :: ConfiguredFifo (BitVector 16) Dom17 Dom2 +topEntity_17_2 = dcFifo defConfig +{-# NOINLINE topEntity_17_2 #-} +{-# ANN topEntity_17_2 (defSyn "topEntity_17_2") #-} + +testBench_17_2 :: Signal Dom17 Bool +testBench_17_2 = mkTestBench topEntity_17_2 +{-# NOINLINE testBench_17_2 #-} +{-# ANN testBench_17_2 (TestBench 'topEntity_17_2) #-} + +topEntity_2_17 :: ConfiguredFifo (BitVector 16) Dom2 Dom17 +topEntity_2_17 = dcFifo defConfig +{-# NOINLINE topEntity_2_17 #-} +{-# ANN topEntity_2_17 (defSyn "topEntity_2_17") #-} + +testBench_2_17 :: Signal Dom2 Bool +testBench_2_17 = mkTestBench topEntity_2_17 +{-# NOINLINE testBench_2_17 #-} +{-# ANN testBench_2_17 (TestBench 'topEntity_2_17) #-} + +topEntity_2_2 :: ConfiguredFifo (Unsigned 16) Dom2 Dom2 +topEntity_2_2 = dcFifo defConfig +{-# NOINLINE topEntity_2_2 #-} +{-# ANN topEntity_2_2 (defSyn "topEntity_2_2") #-} + +testBench_2_2 :: Signal Dom2 Bool +testBench_2_2 = mkTestBench topEntity_2_2 +{-# NOINLINE testBench_2_2 #-} +{-# ANN testBench_2_2 (TestBench 'topEntity_2_2) #-} diff --git a/Xilinx/DcFifo0.hs b/Xilinx/DcFifo0.hs deleted file mode 100644 index d2cc406..0000000 --- a/Xilinx/DcFifo0.hs +++ /dev/null @@ -1,14 +0,0 @@ -module DcFifo0 where - -import Clash.Cores.Xilinx.DcFifo -import Clash.Explicit.Prelude - -import DcFifo.Abstract - -topEntity :: ConfiguredFifo (BitVector 16) Dom17 Dom2 -topEntity = dcFifo defConfig -{-# NOINLINE topEntity #-} - -testBench :: Signal Dom17 Bool -testBench = mkTestBench topEntity -{-# NOINLINE testBench #-} diff --git a/Xilinx/DcFifo1.hs b/Xilinx/DcFifo1.hs deleted file mode 100644 index ed89303..0000000 --- a/Xilinx/DcFifo1.hs +++ /dev/null @@ -1,14 +0,0 @@ -module DcFifo1 where - -import Clash.Cores.Xilinx.DcFifo -import Clash.Explicit.Prelude - -import DcFifo.Abstract - -topEntity :: ConfiguredFifo (BitVector 16) Dom2 Dom17 -topEntity = dcFifo defConfig -{-# NOINLINE topEntity #-} - -testBench :: Signal Dom2 Bool -testBench = mkTestBench topEntity -{-# NOINLINE testBench #-} diff --git a/Xilinx/DcFifo2.hs b/Xilinx/DcFifo2.hs deleted file mode 100644 index 2f79c34..0000000 --- a/Xilinx/DcFifo2.hs +++ /dev/null @@ -1,14 +0,0 @@ -module DcFifo2 where - -import Clash.Cores.Xilinx.DcFifo -import Clash.Explicit.Prelude - -import DcFifo.Abstract - -topEntity :: ConfiguredFifo (Unsigned 16) Dom2 Dom2 -topEntity = dcFifo defConfig -{-# NOINLINE topEntity #-} - -testBench :: Signal Dom2 Bool -testBench = mkTestBench topEntity -{-# NOINLINE testBench #-} From 27e65eea18d04fc4758e336fcfd69898308ec26f Mon Sep 17 00:00:00 2001 From: Felix Klein Date: Wed, 8 Feb 2023 15:54:21 +0100 Subject: [PATCH 10/36] Add Xilinx VIO IP Core --- Xilinx/VIO.hs | 246 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 246 insertions(+) create mode 100644 Xilinx/VIO.hs diff --git a/Xilinx/VIO.hs b/Xilinx/VIO.hs new file mode 100644 index 0000000..b150851 --- /dev/null +++ b/Xilinx/VIO.hs @@ -0,0 +1,246 @@ +module VIO where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO +import Clash.Annotations.TH +import Clash.Annotations.BitRepresentation + +type Dom = XilinxSystem + +noInputTrue :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom Bool +noInputTrue = vioProbe @Dom True + +makeTopEntityWithName 'noInputTrue "" + + +noInputFalse :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom Bool +noInputFalse = vioProbe @Dom False + +makeTopEntityWithName 'noInputFalse "" + + +noInputLow :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom Bit +noInputLow = vioProbe @Dom low + +makeTopEntityWithName 'noInputLow "" + + +noInputHigh :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom Bit +noInputHigh = vioProbe @Dom high + +makeTopEntityWithName 'noInputHigh "" + + +noInputSigned :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Signed 2) +noInputSigned = vioProbe @Dom (-1) + +makeTopEntityWithName 'noInputSigned "" + + +noInputUnsigned :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Unsigned 2) +noInputUnsigned = vioProbe @Dom 3 + +makeTopEntityWithName 'noInputUnsigned "" + + +noInputBitVector :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (BitVector 7) +noInputBitVector = vioProbe @Dom 111 + +makeTopEntityWithName 'noInputBitVector "" + + +noInputPair :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Bit, Bool) +noInputPair = vioProbe @Dom (high, False) + +makeTopEntityWithName 'noInputPair "" + + +noInputVec :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Vec 4 (Unsigned 2)) +noInputVec = vioProbe @Dom (0 :> 1 :> 2 :> 3 :> Nil) + +makeTopEntityWithName 'noInputVec "" + + +data D1 = D1 Bool Bit (Unsigned 2) + +noInputCustom :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom D1 +noInputCustom = vioProbe @Dom (D1 True high 1) + +makeTopEntityWithName 'noInputCustom "" + + +data D2 = D2 Bool (Vec 2 D1) + +noInputNested :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom D2 +noInputNested = vioProbe @Dom (D2 True (D1 True high 1 :> D1 False low 0 :> Nil)) + +makeTopEntityWithName 'noInputNested "" + + +data T = R Bool Bool +{-# ANN module (DataReprAnn + $(liftQ [t|T|]) + 3 + [ ConstrRepr 'R 0b111 0b000 [0b010, 0b001] + ]) #-} +{- TODO: Custom bit representations are not supported within VIOs + yet. See Clash.Cores.Xilinx.VIO.Internal.BlackBoxes for details. +noInputCustomRep :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom T +noInputCustomRep = vioProbe @Dom (R True False) + +makeTopEntityWithName 'noInputCustomRep "" +-} + + +singleInputBool :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom Bool -> + "out" ::: Signal Dom () +singleInputBool = vioProbe @Dom () + +makeTopEntityWithName 'singleInputBool "" + + +singleInputBit :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom Bit -> + "out" ::: Signal Dom () +singleInputBit = vioProbe @Dom () + +makeTopEntityWithName 'singleInputBit "" + + +singleInputSigned :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (Signed 2) -> + "out" ::: Signal Dom () +singleInputSigned = vioProbe @Dom () + +makeTopEntityWithName 'singleInputSigned "" + + +singleInputUnsigned :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (Unsigned 2) -> + "out" ::: Signal Dom () +singleInputUnsigned = vioProbe @Dom () + +makeTopEntityWithName 'singleInputUnsigned "" + + +singleInputBitVector :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (BitVector 7) -> + "out" ::: Signal Dom () +singleInputBitVector = vioProbe @Dom () + +makeTopEntityWithName 'singleInputBitVector "" + + +singleInputPair :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (Bit, Bool) -> + "out" ::: Signal Dom () +singleInputPair = vioProbe @Dom () + +makeTopEntityWithName 'singleInputPair "" + + +singleInputVec :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Vec 4 (Unsigned 2)) -> + "out" ::: Signal Dom () +singleInputVec = vioProbe @Dom () + +makeTopEntityWithName 'singleInputVec "" + + +singleInputCustom :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom D1 -> + "out" ::: Signal Dom () +singleInputCustom = vioProbe @Dom () + +makeTopEntityWithName 'singleInputCustom "" + + +singleInputNested :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom D2 -> + "out" ::: Signal Dom () +singleInputNested = vioProbe @Dom () + +makeTopEntityWithName 'singleInputNested "" + + +multipleInputs :: + "clk" ::: Clock Dom -> + "in1" ::: Signal Dom Bit -> + "in2" ::: Signal Dom Bool -> + "in3" ::: Signal Dom (Unsigned 3) -> + "in4" ::: Signal Dom (Signed 4) -> + "in5" ::: Signal Dom (Bit, Bool, Bit) -> + "in6" ::: Signal Dom (Vec 3 (Unsigned 2)) -> + "in7" ::: Signal Dom D1 -> + "in8" ::: Signal Dom (BitVector 7) -> + "out" ::: Signal Dom (Vec 0 Bool) +multipleInputs = vioProbe @Dom Nil + +makeTopEntityWithName 'multipleInputs "" + + +inputsAndOutputs :: + "clk" ::: Clock Dom -> + "in1" ::: Signal Dom Bit -> + "in2" ::: Signal Dom Bool -> + "in3" ::: Signal Dom ( Unsigned 3 ) -> + "in4" ::: Signal Dom ( Signed 4 ) -> + "in5" ::: Signal Dom ( Bit, Bool, Bit ) -> + "in6" ::: Signal Dom ( Vec 3 (Unsigned 2) ) -> + "in7" ::: Signal Dom D1 -> + "in8" ::: Signal Dom ( BitVector 7 ) -> + "out" ::: Signal Dom ( Bit + , Bool + , Unsigned 5 + , Signed 2 + , (Bool, Bit, Bool) + , Vec 2 (Unsigned 3) + , D1 + , BitVector 6 + ) +inputsAndOutputs = vioProbe @Dom + ( low + , True + , 1 + , -1 + , (True, low, False) + , 5 :> 3 :> Nil + , D1 False high 0 + , 0b111000 + ) + +makeTopEntityWithName 'inputsAndOutputs "" From 6609a6783d96e8513671283a5c1b43a349eb73b6 Mon Sep 17 00:00:00 2001 From: Felix Klein Date: Wed, 8 Feb 2023 15:54:21 +0100 Subject: [PATCH 11/36] Add Xilinx VIO IP Core --- Xilinx/VIO/InputBusWidthExceeded.hs | 12 ++++++++++++ Xilinx/VIO/InputProbesExceeded.hs | 12 ++++++++++++ Xilinx/VIO/OutputBusWidthExceeded.hs | 11 +++++++++++ Xilinx/VIO/OutputProbesExceeded.hs | 11 +++++++++++ 4 files changed, 46 insertions(+) create mode 100644 Xilinx/VIO/InputBusWidthExceeded.hs create mode 100644 Xilinx/VIO/InputProbesExceeded.hs create mode 100644 Xilinx/VIO/OutputBusWidthExceeded.hs create mode 100644 Xilinx/VIO/OutputProbesExceeded.hs diff --git a/Xilinx/VIO/InputBusWidthExceeded.hs b/Xilinx/VIO/InputBusWidthExceeded.hs new file mode 100644 index 0000000..582d187 --- /dev/null +++ b/Xilinx/VIO/InputBusWidthExceeded.hs @@ -0,0 +1,12 @@ +module InputBusWidthExceeded where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +topEntity :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (BitVector 257) -> + "out" ::: Signal Dom () +topEntity = vioProbe @Dom () diff --git a/Xilinx/VIO/InputProbesExceeded.hs b/Xilinx/VIO/InputProbesExceeded.hs new file mode 100644 index 0000000..b420cd2 --- /dev/null +++ b/Xilinx/VIO/InputProbesExceeded.hs @@ -0,0 +1,12 @@ +module InputProbesExceeded where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +topEntity :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (Vec 257 Bool) -> + "out" ::: Signal Dom () +topEntity = vioProbe @Dom () diff --git a/Xilinx/VIO/OutputBusWidthExceeded.hs b/Xilinx/VIO/OutputBusWidthExceeded.hs new file mode 100644 index 0000000..e2dacf2 --- /dev/null +++ b/Xilinx/VIO/OutputBusWidthExceeded.hs @@ -0,0 +1,11 @@ +module OutputBusWidthExceeded where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +topEntity :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (BitVector 257) +topEntity = vioProbe @Dom 0 diff --git a/Xilinx/VIO/OutputProbesExceeded.hs b/Xilinx/VIO/OutputProbesExceeded.hs new file mode 100644 index 0000000..c6a8dc1 --- /dev/null +++ b/Xilinx/VIO/OutputProbesExceeded.hs @@ -0,0 +1,11 @@ +module OutputProbesExceeded where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +topEntity :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Vec 257 Bit) +topEntity = vioProbe @Dom (replicate (SNat @257) low) From fb2253ed08765604ead6284197ab0ee16c852065 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 22 Mar 2023 12:43:37 +0100 Subject: [PATCH 12/36] Add Xilinx `tdpbram` to `clash-cores` Co-authored-by: Peter Lebbing --- Xilinx/TdpBlockRam.hs | 211 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 211 insertions(+) create mode 100644 Xilinx/TdpBlockRam.hs diff --git a/Xilinx/TdpBlockRam.hs b/Xilinx/TdpBlockRam.hs new file mode 100644 index 0000000..cbef871 --- /dev/null +++ b/Xilinx/TdpBlockRam.hs @@ -0,0 +1,211 @@ +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} + +module TdpBlockRam where + +import Clash.Cores.Xilinx.BlockRam (tdpbram) +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +createDomain vXilinxSystem{vName="A", vPeriod=hzToPeriod 10e6 } +createDomain vXilinxSystem{vName="B", vPeriod=hzToPeriod 7e6 } + +topEntity :: + Clock A -> + Clock B -> + Signal A (Bool, Index 500, BitVector 2, Unsigned 16) -> + Signal B (Bool, Index 500, BitVector 2, Unsigned 16) -> + (Signal A (Unsigned 16), Signal B (Unsigned 16)) +topEntity + clkA clkB + (unbundle -> (enA, addrA, byteEnaA, datA)) + (unbundle -> (enB, addrB, byteEnaB, datB)) = + tdpbram + clkA (toEnable enA) addrA byteEnaA datA + clkB (toEnable enB) addrB byteEnaB datB +{-# NOINLINE topEntity #-} + +noRstA :: Reset A +noRstA = unsafeFromHighPolarity (pure False) + +noRstB :: Reset B +noRstB = unsafeFromHighPolarity (pure False) + +tb :: + ( KnownNat n0, KnownNat n1, KnownNat n2, KnownNat n3 + , 1 <= n0, 1 <= n1, 1 <= n2, 1 <= n3 ) => + -- | Input on port A + Vec n0 (Bool, Index 500, BitVector 2, Unsigned 16)-> + -- | Expected data from port A + Vec n1 (Unsigned 16) -> + -- | Input on port B + Vec n2 (Bool, Index 500, BitVector 2, Unsigned 16) -> + -- | Expected data from port B + Vec n3 (Unsigned 16) -> + Signal A Bool +tb inputA expectedA inputB expectedB = + strictAnd <$> doneA <*> (unsafeSynchronizer clkB clkA doneB) + where + strictAnd !a !b = (&&) a b + + -- topEntity output + (actualA0, actualB0) = + topEntity + clkA clkB + (stimuliGenerator clkA noRstA inputA) + (stimuliGenerator clkB noRstB inputB) + + actualA1 = ignoreFor clkA noRstA enableGen d1 0 actualA0 + actualB1 = ignoreFor clkB noRstB enableGen d1 0 actualB0 + + -- Verification + outputVerifierA = outputVerifierWith + (\clk rst -> assert clk rst "outputVerifier Port A") + outputVerifierB = outputVerifierWith + (\clk rst -> assert clk rst "outputVerifier Port B") + + doneA = outputVerifierA clkA clkA noRstA expectedA actualA1 + doneB = outputVerifierB clkB clkB noRstB expectedB actualB1 + + -- Testbench clocks + clkA :: Clock A + clkA = tbClockGen (not <$> doneA) + clkB :: Clock B + clkB = tbClockGen (not <$> doneB) + +{-# NOINLINE normalWritesTB #-} +{-# ANN normalWritesTB (TestBench 'topEntity) #-} +-- | Test bench doing some (non-overlapping) writes and reads on two ports, either +-- with the byte enable fully set, or fully unset. +normalWritesTB :: Signal A Bool +normalWritesTB = tb inputA expectedA inputB expectedB + where + -- Note that the initial value coming from the blockram is undefined, but we + -- mask it using 'ignoreFor'. + initVal = 0 + + expectedA = + (initVal :> 55 :> 66 :> 55 :> 66 :> Nil) ++ + (repeat @10 66) ++ + (77 :> 88 :> Nil) + expectedB = + (initVal :> 77 :> 88 :> 77 :> 88 :> Nil) ++ + (repeat @10 88) ++ + (55 :> 66 :> Nil) + + doWrite = maxBound + noWrite = 0 + noOp = (False, 0, 0, 0) + + inputA = + ( (True, 0, doWrite, 55) + :> (True, 1, doWrite, 66) + :> (True, 0, noWrite, 0) + :> (True, 1, noWrite, 0) + :> Nil + ) ++ repeat @10 noOp ++ + ( + (True, 2, noWrite, 0) + :> (True, 3, noWrite, 0) + :> Nil + ) + ++ repeat @10 noOp + + inputB = + ( (True, 2, doWrite, 77) + :> (True, 3, doWrite, 88) + :> (True, 2, noWrite, 0) + :> (True, 3, noWrite, 0) + :> Nil + ) ++ repeat @10 noOp ++ + ( + (True, 0, noWrite, 0) + :> (True, 1, noWrite, 0) + :> Nil + ) ++ repeat @10 noOp + +{-# NOINLINE writeEnableWritesTB #-} +{-# ANN writeEnableWritesTB (TestBench 'topEntity) #-} +-- | Test bench doing some (non-overlapping) writes and reads on two ports, with +-- varying byte enables. +writeEnableWritesTB :: Signal A Bool +writeEnableWritesTB = tb inputA expectedA inputB expectedB + where + -- Note that the initial value coming from the blockram is undefined, but we + -- mask it using 'ignoreFor'. + initVal = 0 + + expectedA = + initVal + :> 0 + :> 0 + :> 0 + :> 0 + + :> 0 + :> 0x00AA + :> 0xAA00 + :> 0xAAAA + + :> 0 + :> 0x00AA + :> 0xAA00 + :> 0xAAAA + :> Nil + + expectedB = + initVal + :> 0 + :> 0 + :> 0 + :> 0 + + :> 0 + :> 0x00AA + :> 0xAA00 + :> 0xAAAA + + :> 0 + :> 0x00AA + :> 0xAA00 + :> 0xAAAA + :> Nil + + noWrite = 0 + + inputA = + ( (True, 0, 0b11, 0 ) + :> (True, 1, 0b11, 0 ) + :> (True, 2, 0b11, 0 ) + :> (True, 3, 0b11, 0 ) + + :> (True, 0, 0b00, 0xAAAA) + :> (True, 1, 0b01, 0xAAAA) + :> (True, 2, 0b10, 0xAAAA) + :> (True, 3, 0b11, 0xAAAA) + + :> (True, 0, noWrite, 0 ) + :> (True, 1, noWrite, 0 ) + :> (True, 2, noWrite, 0 ) + :> (True, 3, noWrite, 0 ) + :> Nil + ) + + inputB = + ( (True, 4, 0b11, 0 ) + :> (True, 5, 0b11, 0 ) + :> (True, 6, 0b11, 0 ) + :> (True, 7, 0b11, 0 ) + :> (True, 4, 0b00, 0xAAAA) + :> (True, 5, 0b01, 0xAAAA) + :> (True, 6, 0b10, 0xAAAA) + :> (True, 7, 0b11, 0xAAAA) + :> (True, 4, noWrite, 0 ) + :> (True, 5, noWrite, 0 ) + :> (True, 6, noWrite, 0 ) + :> (True, 7, noWrite, 0 ) + :> Nil + ) From c10a85b11d9ebdd5acc5216a53cdb278823bd3b5 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Fri, 21 Apr 2023 16:19:28 +0200 Subject: [PATCH 13/36] Add `XPM_CDC_GRAY` to `clash-cores` --- Xilinx/XpmCdcGray.hs | 69 ++++++++++++++++++++++++++++++++++++ Xilinx/XpmCdcGrayTypes.hs | 73 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 142 insertions(+) create mode 100644 Xilinx/XpmCdcGray.hs create mode 100644 Xilinx/XpmCdcGrayTypes.hs diff --git a/Xilinx/XpmCdcGray.hs b/Xilinx/XpmCdcGray.hs new file mode 100644 index 0000000..6db599f --- /dev/null +++ b/Xilinx/XpmCdcGray.hs @@ -0,0 +1,69 @@ +module XpmCdcGray where + +import Clash.Explicit.Prelude +import Data.Proxy + +import XpmCdcGrayTypes (D3, D5, D10, D11) + +import qualified XpmCdcGrayTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 + +tb0 = done + where + -- src dst width stages samples + done = Types.tb @D3 @D5 @16 @4 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D3 @D5 @16 @4 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} + +tb1 = done + where + -- src dst width stages samples + done = Types.tb @D5 @D3 @16 @4 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D5 @D3 @16 @4 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} + +tb2 = done + where + -- src dst width stages samples + done = Types.tb @D3 @D5 @16 @10 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D3 @D5 @16 @10 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} + +tb3 = done + where + -- src dst width stages samples + done = Types.tb @D3 @D5 @16 @2 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D3 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} + +tb4 = done + where + -- src dst width stages samples + done = Types.tb @D5 @D10 @16 @2 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D5 @D10 @16 @2 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} + +tb5 = done + where + -- src dst width stages samples + done = Types.tb @D10 @D5 @16 @2 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D10 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} + +tb6 = done + where + -- src dst width stages samples + done = Types.tb @D5 @D11 @16 @2 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D5 @D11 @16 @2 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} + +tb7 = done + where + -- src dst width stages samples + done = Types.tb @D11 @D5 @16 @2 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D11 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) +{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/Xilinx/XpmCdcGrayTypes.hs b/Xilinx/XpmCdcGrayTypes.hs new file mode 100644 index 0000000..fb2a949 --- /dev/null +++ b/Xilinx/XpmCdcGrayTypes.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE BangPatterns #-} + +module XpmCdcGrayTypes where + +import Clash.Cores.Xilinx.Xpm.Cdc.Gray +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench +import Data.Proxy +import Language.Haskell.TH.Lib + +createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} +createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} +createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} +createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} + +noRst :: KnownDomain dom => Reset dom +noRst = unsafeFromHighPolarity (pure False) + +tb :: + forall a b width stages n . + ( KnownNat n, 1 <= n + , KnownNat stages, 2 <= stages, stages <= 10 + , KnownNat width, 2 <= width, width <= 32 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> SNat stages -> + -- | Expected data + Vec n (BitVector width) -> + Signal b Bool +tb Proxy Proxy SNat expectedDat = done + where + counter = delay clkA enableGen 0 (counter + 1) + + actual = xpmCdcGrayWith @stages @width (XpmCdcGrayConfig SNat True) clkA clkB counter + + done = + outputVerifierWith + (\clk rst -> assertBitVector clk rst "outputVerifier Port A") + clkB clkB (noRst @b) + expectedDat + (pack <$> actual) + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b n stages samples . + ( KnownDomain a + , KnownDomain b + , 2 <= stages, stages <= 10 + , 2 <= n, n <= 32 + ) => + Proxy a -> + Proxy b -> + SNat n -> + SNat stages -> + SNat samples -> + ExpQ +expected Proxy Proxy SNat SNat SNat = listToVecTH out1 + where + out0 = + xpmCdcGrayWith + @stages @n + (XpmCdcGrayConfig SNat True) + (clockGen @a) + (clockGen @b) + (fromList [0..]) + + out1 = pack <$> sampleN (natToNum @samples) out0 From 27a27fe6bc82c25160bce55b20508ca1d00241bf Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 25 Apr 2023 16:13:17 +0200 Subject: [PATCH 14/36] Add `XPM_CDC_SINGLE` to `clash-cores` --- Xilinx/XpmCdcSingle.hs | 70 ++++++++++++++++++++++++++++++ Xilinx/XpmCdcSingleTypes.hs | 85 +++++++++++++++++++++++++++++++++++++ 2 files changed, 155 insertions(+) create mode 100644 Xilinx/XpmCdcSingle.hs create mode 100644 Xilinx/XpmCdcSingleTypes.hs diff --git a/Xilinx/XpmCdcSingle.hs b/Xilinx/XpmCdcSingle.hs new file mode 100644 index 0000000..5931822 --- /dev/null +++ b/Xilinx/XpmCdcSingle.hs @@ -0,0 +1,70 @@ +module XpmCdcSingle where + +import Clash.Explicit.Prelude + +import Data.Proxy + +import XpmCdcSingleTypes (D3, D5, D10, D11) + +import qualified XpmCdcSingleTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 + +tb0 = done + where + -- src dst stages samples init reg + done = Types.tb @D3 @D5 @4 @100 Proxy Proxy False False SNat expected + expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy False False SNat SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} + +tb1 = done + where + -- src dst stages samples init reg + done = Types.tb @D5 @D3 @4 @100 Proxy Proxy False True SNat expected + expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy False True SNat SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} + +tb2 = done + where + -- src dst stages samples init reg + done = Types.tb @D3 @D5 @10 @100 Proxy Proxy True False SNat expected + expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy True False SNat SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} + +tb3 = done + where + -- src dst stages samples init reg + done = Types.tb @D3 @D5 @2 @100 Proxy Proxy True True SNat expected + expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy True True SNat SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} + +tb4 = done + where + -- src dst stages samples init reg + done = Types.tb @D5 @D10 @2 @100 Proxy Proxy False False SNat expected + expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy False False SNat SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} + +tb5 = done + where + -- src dst stages samples init reg + done = Types.tb @D10 @D5 @2 @100 Proxy Proxy False True SNat expected + expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy False True SNat SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} + +tb6 = done + where + -- src dst stages samples init reg + done = Types.tb @D5 @D11 @2 @100 Proxy Proxy True False SNat expected + expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy True False SNat SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} + +tb7 = done + where + -- src dst stages samples init reg + done = Types.tb @D11 @D5 @2 @100 Proxy Proxy True True SNat expected + expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy True True SNat SNat) +{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/Xilinx/XpmCdcSingleTypes.hs b/Xilinx/XpmCdcSingleTypes.hs new file mode 100644 index 0000000..c3068b1 --- /dev/null +++ b/Xilinx/XpmCdcSingleTypes.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE BangPatterns #-} + +module XpmCdcSingleTypes where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +import Data.Proxy +import Language.Haskell.TH.Lib + +import Clash.Cores.Xilinx.Xpm.Cdc.Single + +createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} +createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} +createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} +createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} + +noRst :: KnownDomain dom => Reset dom +noRst = unsafeFromHighPolarity (pure False) + +tb :: + forall a b stages n . + ( KnownNat n, 1 <= n + , KnownNat stages, 2 <= stages, stages <= 10 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> + -- | Initial values + Bool -> + -- | Registered input + Bool -> + SNat stages -> + -- | Expected data + Vec n (BitVector 1) -> + Signal b Bool +tb Proxy Proxy initVals regInput SNat expectedDat = done + where + counter = delay clkA enableGen 0 (counter + 1) + + actual = + xpmCdcSingleWith + @stages @(Unsigned 1) + (XpmCdcSingleConfig SNat initVals regInput) + clkA clkB counter + + done = + outputVerifierWith + (\clk rst -> assertBitVector clk rst "outputVerifier Port A") + clkB clkB (noRst @b) + expectedDat + (pack <$> actual) + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b stages samples . + ( KnownDomain a + , KnownDomain b + , 2 <= stages, stages <= 10 + ) => + Proxy a -> + Proxy b -> + -- | Initial values + Bool -> + -- | Registered input + Bool -> + SNat stages -> + SNat samples -> + ExpQ +expected Proxy Proxy initVals regInput SNat SNat = listToVecTH out1 + where + out0 = + xpmCdcSingleWith + @stages @(Unsigned 1) + (XpmCdcSingleConfig SNat initVals regInput) + (clockGen @a) + (clockGen @b) + (fromList [0..]) + + out1 = pack <$> sampleN (natToNum @samples) out0 From c82b73a81be5b2819f230d86290ba1e42d16ad39 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 10 May 2023 20:47:42 +0200 Subject: [PATCH 15/36] GHC 9.4 support for test Cores/Xilinx/DcFifo/Basic --- Xilinx/DcFifo/Basic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Xilinx/DcFifo/Basic.hs b/Xilinx/DcFifo/Basic.hs index d9a13d7..4ac3807 100644 --- a/Xilinx/DcFifo/Basic.hs +++ b/Xilinx/DcFifo/Basic.hs @@ -128,7 +128,7 @@ fsm (Pop i) = , fExpectedEmpty=pack (i >= actualDepth - 1) , fExpectedUnderflow=pack underflow , fExpectedData=if underflow then undefined# - else pack (resize i) + else pack i } in (s', o) fsm Done = (Done, defFsmOut{fDone=True, fExpectedEmpty=pack True}) From 05f542fe39ce1670f5ddc3f442c30baf86da1776 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 23 May 2023 20:27:13 +0200 Subject: [PATCH 16/36] Add `XPM_CDC_ARRAY_SINGLE` to `clash-cores` (#2459) --- Xilinx/XpmCdcArraySingle.hs | 69 +++++++++++++++++++++++++ Xilinx/XpmCdcArraySingleTypes.hs | 88 ++++++++++++++++++++++++++++++++ 2 files changed, 157 insertions(+) create mode 100644 Xilinx/XpmCdcArraySingle.hs create mode 100644 Xilinx/XpmCdcArraySingleTypes.hs diff --git a/Xilinx/XpmCdcArraySingle.hs b/Xilinx/XpmCdcArraySingle.hs new file mode 100644 index 0000000..fd50bfb --- /dev/null +++ b/Xilinx/XpmCdcArraySingle.hs @@ -0,0 +1,69 @@ +module XpmCdcArraySingle where + +import Clash.Explicit.Prelude +import Data.Proxy + +import XpmCdcArraySingleTypes (D3, D5, D10, D11) + +import qualified XpmCdcArraySingleTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 + +tb0 = done + where + -- src dst stages width samples init reg + done = Types.tb @D3 @D5 @4 @1 @100 Proxy Proxy False False SNat expected + expected = $(Types.expected @D3 @D5 @4 @1 @100 Proxy Proxy False False SNat SNat SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} + +tb1 = done + where + -- src dst stages width samples init reg + done = Types.tb @D5 @D3 @4 @2 @100 Proxy Proxy False True SNat expected + expected = $(Types.expected @D5 @D3 @4 @2 @100 Proxy Proxy False True SNat SNat SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} + +tb2 = done + where + -- src dst stages width samples init reg + done = Types.tb @D3 @D5 @10 @16 @100 Proxy Proxy True False SNat expected + expected = $(Types.expected @D3 @D5 @10 @16 @100 Proxy Proxy True False SNat SNat SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} + +tb3 = done + where + -- src dst stages width samples init reg + done = Types.tb @D3 @D5 @2 @1024 @100 Proxy Proxy True True SNat expected + expected = $(Types.expected @D3 @D5 @2 @1024 @100 Proxy Proxy True True SNat SNat SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} + +tb4 = done + where + -- src dst stages width samples init reg + done = Types.tb @D5 @D10 @2 @7 @100 Proxy Proxy False False SNat expected + expected = $(Types.expected @D5 @D10 @2 @7 @100 Proxy Proxy False False SNat SNat SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} + +tb5 = done + where + -- src dst stages width samples init reg + done = Types.tb @D10 @D5 @2 @16 @100 Proxy Proxy False True SNat expected + expected = $(Types.expected @D10 @D5 @2 @16 @100 Proxy Proxy False True SNat SNat SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} + +tb6 = done + where + -- src dst stages width samples init reg + done = Types.tb @D5 @D11 @2 @16 @100 Proxy Proxy True False SNat expected + expected = $(Types.expected @D5 @D11 @2 @16 @100 Proxy Proxy True False SNat SNat SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} + +tb7 = done + where + -- src dst stages width samples init reg + done = Types.tb @D11 @D5 @2 @16 @100 Proxy Proxy True True SNat expected + expected = $(Types.expected @D11 @D5 @2 @16 @100 Proxy Proxy True True SNat SNat SNat) +{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/Xilinx/XpmCdcArraySingleTypes.hs b/Xilinx/XpmCdcArraySingleTypes.hs new file mode 100644 index 0000000..9eea589 --- /dev/null +++ b/Xilinx/XpmCdcArraySingleTypes.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE BangPatterns #-} + +module XpmCdcArraySingleTypes where + +import Clash.Cores.Xilinx.Xpm.Cdc.ArraySingle +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench +import Data.Proxy +import Language.Haskell.TH.Lib + +createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} +createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} +createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} +createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} + +noRst :: KnownDomain dom => Reset dom +noRst = unsafeFromHighPolarity (pure False) + +tb :: + forall a b stages width n . + ( KnownNat n, 1 <= n + , KnownNat stages, 2 <= stages, stages <= 10 + , KnownNat width, 1 <= width, width <= 1024 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> + -- | Initial values + Bool -> + -- | Registered input + Bool -> + SNat stages -> + -- | Expected data + Vec n (BitVector width) -> + Signal b Bool +tb Proxy Proxy initVals regInput SNat expectedDat = done + where + counter = delay clkA enableGen 0 (counter + 1) + + actual = + xpmCdcArraySingleWith + @stages @(Unsigned width) + (XpmCdcArraySingleConfig SNat initVals regInput) + clkA + clkB + counter + + done = + outputVerifierWith + (\clk rst -> assertBitVector clk rst "outputVerifier Port A") + clkB clkB (noRst @b) + expectedDat + (pack <$> actual) + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b stages width samples . + ( KnownDomain a + , KnownDomain b + , 2 <= stages, stages <= 10 + , 1 <= width, width <= 1024 + ) => + Proxy a -> + Proxy b -> + -- | Initial values + Bool -> + -- | Registered input + Bool -> + SNat stages -> + SNat width -> + SNat samples -> + ExpQ +expected Proxy Proxy initVals regInput SNat SNat SNat = listToVecTH out1 + where + out0 = + xpmCdcArraySingleWith + @stages @(Unsigned width) + (XpmCdcArraySingleConfig SNat initVals regInput) + (clockGen @a) + (clockGen @b) + (fromList [0..]) + + out1 = pack <$> sampleN (natToNum @samples) out0 From 8348fcfab2fd90e77bd2018027060b272b085f62 Mon Sep 17 00:00:00 2001 From: Hidde Moll Date: Wed, 24 May 2023 10:15:12 +0200 Subject: [PATCH 17/36] Add loading of HDL to VIO tests Before adding the `KEEP` attribute to `vioProbe` ports, clash did not generate valid VHDL since the types of vioProbe declaration and instantiation did not match. This has been fixed, but to make sure these bugs do not occur again the circuits in `shouldwork` are now loaded in Vivado. The circuits in `shouldwork` also did not produce valid VHDL, as the words `in` and `out` are reserved. The names of ports have been updated to produce valid VHDL. --- Xilinx/VIO.hs | 137 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 83 insertions(+), 54 deletions(-) diff --git a/Xilinx/VIO.hs b/Xilinx/VIO.hs index b150851..853c0a6 100644 --- a/Xilinx/VIO.hs +++ b/Xilinx/VIO.hs @@ -4,99 +4,117 @@ import Clash.Prelude import Clash.Cores.Xilinx.VIO import Clash.Annotations.TH import Clash.Annotations.BitRepresentation +import Clash.Explicit.Testbench type Dom = XilinxSystem +top :: "result" ::: Unsigned 8 +top = 0 +{-# NOINLINE top #-} + +makeTopEntity 'top + noInputTrue :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom Bool + "result" ::: Signal Dom Bool noInputTrue = vioProbe @Dom True +{-# ANN noInputTrue (TestBench 'top) #-} -makeTopEntityWithName 'noInputTrue "" +makeTopEntity 'noInputTrue noInputFalse :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom Bool + "result" ::: Signal Dom Bool noInputFalse = vioProbe @Dom False +{-# ANN noInputFalse (TestBench 'top) #-} -makeTopEntityWithName 'noInputFalse "" +makeTopEntity 'noInputFalse noInputLow :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom Bit + "result" ::: Signal Dom Bit noInputLow = vioProbe @Dom low +{-# ANN noInputLow (TestBench 'top) #-} -makeTopEntityWithName 'noInputLow "" +makeTopEntity 'noInputLow noInputHigh :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom Bit + "result" ::: Signal Dom Bit noInputHigh = vioProbe @Dom high +{-# ANN noInputHigh (TestBench 'top) #-} -makeTopEntityWithName 'noInputHigh "" +makeTopEntity 'noInputHigh noInputSigned :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Signed 2) + "result" ::: Signal Dom (Signed 2) noInputSigned = vioProbe @Dom (-1) +{-# ANN noInputSigned (TestBench 'top) #-} -makeTopEntityWithName 'noInputSigned "" +makeTopEntity 'noInputSigned noInputUnsigned :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Unsigned 2) + "result" ::: Signal Dom (Unsigned 2) noInputUnsigned = vioProbe @Dom 3 +{-# ANN noInputUnsigned (TestBench 'top) #-} -makeTopEntityWithName 'noInputUnsigned "" +makeTopEntity 'noInputUnsigned noInputBitVector :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (BitVector 7) + "result" ::: Signal Dom (BitVector 7) noInputBitVector = vioProbe @Dom 111 +{-# ANN noInputBitVector (TestBench 'top) #-} -makeTopEntityWithName 'noInputBitVector "" +makeTopEntity 'noInputBitVector noInputPair :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Bit, Bool) + "result" ::: Signal Dom (Bit, Bool) noInputPair = vioProbe @Dom (high, False) +{-# ANN noInputPair (TestBench 'top) #-} -makeTopEntityWithName 'noInputPair "" +makeTopEntity 'noInputPair noInputVec :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Vec 4 (Unsigned 2)) + "result" ::: Signal Dom (Vec 4 (Unsigned 2)) noInputVec = vioProbe @Dom (0 :> 1 :> 2 :> 3 :> Nil) +{-# ANN noInputVec (TestBench 'top) #-} -makeTopEntityWithName 'noInputVec "" +makeTopEntity 'noInputVec data D1 = D1 Bool Bit (Unsigned 2) noInputCustom :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom D1 + "result" ::: Signal Dom D1 noInputCustom = vioProbe @Dom (D1 True high 1) +{-# ANN noInputCustom (TestBench 'top) #-} -makeTopEntityWithName 'noInputCustom "" +makeTopEntity 'noInputCustom data D2 = D2 Bool (Vec 2 D1) noInputNested :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom D2 + "result" ::: Signal Dom D2 noInputNested = vioProbe @Dom (D2 True (D1 True high 1 :> D1 False low 0 :> Nil)) +{-# ANN noInputNested (TestBench 'top) #-} -makeTopEntityWithName 'noInputNested "" +makeTopEntity 'noInputNested data T = R Bool Bool @@ -109,7 +127,7 @@ data T = R Bool Bool yet. See Clash.Cores.Xilinx.VIO.Internal.BlackBoxes for details. noInputCustomRep :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom T + "result" ::: Signal Dom T noInputCustomRep = vioProbe @Dom (R True False) makeTopEntityWithName 'noInputCustomRep "" @@ -118,83 +136,92 @@ makeTopEntityWithName 'noInputCustomRep "" singleInputBool :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom Bool -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom Bool -> + "result" ::: Signal Dom () singleInputBool = vioProbe @Dom () +{-# ANN singleInputBool (TestBench 'top) #-} -makeTopEntityWithName 'singleInputBool "" +makeTopEntity 'singleInputBool singleInputBit :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom Bit -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom Bit -> + "result" ::: Signal Dom () singleInputBit = vioProbe @Dom () +{-# ANN singleInputBit (TestBench 'top) #-} -makeTopEntityWithName 'singleInputBit "" +makeTopEntity 'singleInputBit singleInputSigned :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom (Signed 2) -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom (Signed 2) -> + "result" ::: Signal Dom () singleInputSigned = vioProbe @Dom () +{-# ANN singleInputSigned (TestBench 'top) #-} -makeTopEntityWithName 'singleInputSigned "" +makeTopEntity 'singleInputSigned singleInputUnsigned :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom (Unsigned 2) -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom (Unsigned 2) -> + "result" ::: Signal Dom () singleInputUnsigned = vioProbe @Dom () +{-# ANN singleInputUnsigned (TestBench 'top) #-} -makeTopEntityWithName 'singleInputUnsigned "" +makeTopEntity 'singleInputUnsigned singleInputBitVector :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom (BitVector 7) -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom (BitVector 7) -> + "result" ::: Signal Dom () singleInputBitVector = vioProbe @Dom () +{-# ANN singleInputBitVector (TestBench 'top) #-} -makeTopEntityWithName 'singleInputBitVector "" +makeTopEntity 'singleInputBitVector singleInputPair :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom (Bit, Bool) -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom (Bit, Bool) -> + "result" ::: Signal Dom () singleInputPair = vioProbe @Dom () +{-# ANN singleInputPair (TestBench 'top) #-} -makeTopEntityWithName 'singleInputPair "" +makeTopEntity 'singleInputPair singleInputVec :: "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Vec 4 (Unsigned 2)) -> - "out" ::: Signal Dom () + "result" ::: Signal Dom (Vec 4 (Unsigned 2)) -> + "result" ::: Signal Dom () singleInputVec = vioProbe @Dom () +{-# ANN singleInputVec (TestBench 'top) #-} -makeTopEntityWithName 'singleInputVec "" +makeTopEntity 'singleInputVec singleInputCustom :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom D1 -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom D1 -> + "result" ::: Signal Dom () singleInputCustom = vioProbe @Dom () +{-# ANN singleInputCustom (TestBench 'top) #-} -makeTopEntityWithName 'singleInputCustom "" +makeTopEntity 'singleInputCustom singleInputNested :: "clk" ::: Clock Dom -> - "in" ::: Signal Dom D2 -> - "out" ::: Signal Dom () + "inp" ::: Signal Dom D2 -> + "result" ::: Signal Dom () singleInputNested = vioProbe @Dom () +{-# ANN singleInputNested (TestBench 'top) #-} -makeTopEntityWithName 'singleInputNested "" +makeTopEntity 'singleInputNested multipleInputs :: @@ -207,10 +234,11 @@ multipleInputs :: "in6" ::: Signal Dom (Vec 3 (Unsigned 2)) -> "in7" ::: Signal Dom D1 -> "in8" ::: Signal Dom (BitVector 7) -> - "out" ::: Signal Dom (Vec 0 Bool) + "result" ::: Signal Dom (Vec 0 Bool) multipleInputs = vioProbe @Dom Nil +{-# ANN multipleInputs (TestBench 'top) #-} -makeTopEntityWithName 'multipleInputs "" +makeTopEntity 'multipleInputs inputsAndOutputs :: @@ -223,7 +251,7 @@ inputsAndOutputs :: "in6" ::: Signal Dom ( Vec 3 (Unsigned 2) ) -> "in7" ::: Signal Dom D1 -> "in8" ::: Signal Dom ( BitVector 7 ) -> - "out" ::: Signal Dom ( Bit + "result" ::: Signal Dom ( Bit , Bool , Unsigned 5 , Signed 2 @@ -242,5 +270,6 @@ inputsAndOutputs = vioProbe @Dom , D1 False high 0 , 0b111000 ) +{-# ANN inputsAndOutputs (TestBench 'top) #-} -makeTopEntityWithName 'inputsAndOutputs "" +makeTopEntity 'inputsAndOutputs From fcacc027911fbcf8e75de3523c7715c4dbfa42fa Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 30 May 2023 14:24:38 +0200 Subject: [PATCH 18/36] Add custom naming to VIO probes (#2483) A design with VIO probes is inspected (through the GUI of the synthesis tool) when programmed on an FPGA. It therefore makes sense to give each individual probe a logical name. The names of in- and output ports should be given as two `Vec`tor of `Strings`, where the length should match the number of probes. Co-authored-by: Hidde Moll --- Xilinx/VIO.hs | 131 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 100 insertions(+), 31 deletions(-) diff --git a/Xilinx/VIO.hs b/Xilinx/VIO.hs index 853c0a6..58f8e9c 100644 --- a/Xilinx/VIO.hs +++ b/Xilinx/VIO.hs @@ -6,6 +6,8 @@ import Clash.Annotations.TH import Clash.Annotations.BitRepresentation import Clash.Explicit.Testbench +import qualified Data.List as L + type Dom = XilinxSystem top :: "result" ::: Unsigned 8 @@ -17,7 +19,10 @@ makeTopEntity 'top noInputTrue :: "clk" ::: Clock Dom -> "result" ::: Signal Dom Bool -noInputTrue = vioProbe @Dom True +noInputTrue = vioProbe @Dom inNames outNames True + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputTrue (TestBench 'top) #-} makeTopEntity 'noInputTrue @@ -26,7 +31,10 @@ makeTopEntity 'noInputTrue noInputFalse :: "clk" ::: Clock Dom -> "result" ::: Signal Dom Bool -noInputFalse = vioProbe @Dom False +noInputFalse = vioProbe @Dom inNames outNames False + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputFalse (TestBench 'top) #-} makeTopEntity 'noInputFalse @@ -35,7 +43,10 @@ makeTopEntity 'noInputFalse noInputLow :: "clk" ::: Clock Dom -> "result" ::: Signal Dom Bit -noInputLow = vioProbe @Dom low +noInputLow = vioProbe @Dom inNames outNames low + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputLow (TestBench 'top) #-} makeTopEntity 'noInputLow @@ -44,7 +55,10 @@ makeTopEntity 'noInputLow noInputHigh :: "clk" ::: Clock Dom -> "result" ::: Signal Dom Bit -noInputHigh = vioProbe @Dom high +noInputHigh = vioProbe @Dom inNames outNames high + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputHigh (TestBench 'top) #-} makeTopEntity 'noInputHigh @@ -53,7 +67,10 @@ makeTopEntity 'noInputHigh noInputSigned :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (Signed 2) -noInputSigned = vioProbe @Dom (-1) +noInputSigned = vioProbe @Dom inNames outNames (-1) + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputSigned (TestBench 'top) #-} makeTopEntity 'noInputSigned @@ -62,7 +79,10 @@ makeTopEntity 'noInputSigned noInputUnsigned :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (Unsigned 2) -noInputUnsigned = vioProbe @Dom 3 +noInputUnsigned = vioProbe @Dom inNames outNames 3 + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputUnsigned (TestBench 'top) #-} makeTopEntity 'noInputUnsigned @@ -71,7 +91,10 @@ makeTopEntity 'noInputUnsigned noInputBitVector :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (BitVector 7) -noInputBitVector = vioProbe @Dom 111 +noInputBitVector = vioProbe @Dom inNames outNames 111 + where + inNames = Nil + outNames = singleton "probe_out" {-# ANN noInputBitVector (TestBench 'top) #-} makeTopEntity 'noInputBitVector @@ -80,7 +103,10 @@ makeTopEntity 'noInputBitVector noInputPair :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (Bit, Bool) -noInputPair = vioProbe @Dom (high, False) +noInputPair = vioProbe @Dom inNames outNames (high, False) + where + inNames = Nil + outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0,1])) {-# ANN noInputPair (TestBench 'top) #-} makeTopEntity 'noInputPair @@ -89,7 +115,10 @@ makeTopEntity 'noInputPair noInputVec :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (Vec 4 (Unsigned 2)) -noInputVec = vioProbe @Dom (0 :> 1 :> 2 :> 3 :> Nil) +noInputVec = vioProbe @Dom inNames outNames (0 :> 1 :> 2 :> 3 :> Nil) + where + inNames = Nil + outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..3])) {-# ANN noInputVec (TestBench 'top) #-} makeTopEntity 'noInputVec @@ -100,7 +129,10 @@ data D1 = D1 Bool Bit (Unsigned 2) noInputCustom :: "clk" ::: Clock Dom -> "result" ::: Signal Dom D1 -noInputCustom = vioProbe @Dom (D1 True high 1) +noInputCustom = vioProbe @Dom inNames outNames (D1 True high 1) + where + inNames = Nil + outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..2])) {-# ANN noInputCustom (TestBench 'top) #-} makeTopEntity 'noInputCustom @@ -111,7 +143,10 @@ data D2 = D2 Bool (Vec 2 D1) noInputNested :: "clk" ::: Clock Dom -> "result" ::: Signal Dom D2 -noInputNested = vioProbe @Dom (D2 True (D1 True high 1 :> D1 False low 0 :> Nil)) +noInputNested = vioProbe @Dom inNames outNames (D2 True (D1 True high 1 :> D1 False low 0 :> Nil)) + where + inNames = Nil + outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..1])) {-# ANN noInputNested (TestBench 'top) #-} makeTopEntity 'noInputNested @@ -138,7 +173,10 @@ singleInputBool :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom Bool -> "result" ::: Signal Dom () -singleInputBool = vioProbe @Dom () +singleInputBool = vioProbe @Dom inNames outNames () + where + inNames = singleton "probe_in" + outNames = Nil {-# ANN singleInputBool (TestBench 'top) #-} makeTopEntity 'singleInputBool @@ -148,7 +186,10 @@ singleInputBit :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom Bit -> "result" ::: Signal Dom () -singleInputBit = vioProbe @Dom () +singleInputBit = vioProbe @Dom inNames outNames () + where + inNames = singleton "probe_in" + outNames = Nil {-# ANN singleInputBit (TestBench 'top) #-} makeTopEntity 'singleInputBit @@ -158,7 +199,10 @@ singleInputSigned :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom (Signed 2) -> "result" ::: Signal Dom () -singleInputSigned = vioProbe @Dom () +singleInputSigned = vioProbe @Dom inNames outNames () + where + inNames = singleton "probe_in" + outNames = Nil {-# ANN singleInputSigned (TestBench 'top) #-} makeTopEntity 'singleInputSigned @@ -168,7 +212,10 @@ singleInputUnsigned :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom (Unsigned 2) -> "result" ::: Signal Dom () -singleInputUnsigned = vioProbe @Dom () +singleInputUnsigned = vioProbe @Dom inNames outNames () + where + inNames = singleton "probe_in" + outNames = Nil {-# ANN singleInputUnsigned (TestBench 'top) #-} makeTopEntity 'singleInputUnsigned @@ -178,7 +225,10 @@ singleInputBitVector :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom (BitVector 7) -> "result" ::: Signal Dom () -singleInputBitVector = vioProbe @Dom () +singleInputBitVector = vioProbe @Dom inNames outNames () + where + inNames = singleton "probe_in" + outNames = Nil {-# ANN singleInputBitVector (TestBench 'top) #-} makeTopEntity 'singleInputBitVector @@ -188,7 +238,10 @@ singleInputPair :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom (Bit, Bool) -> "result" ::: Signal Dom () -singleInputPair = vioProbe @Dom () +singleInputPair = vioProbe @Dom inNames outNames () + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..1])) + outNames = Nil {-# ANN singleInputPair (TestBench 'top) #-} makeTopEntity 'singleInputPair @@ -198,7 +251,10 @@ singleInputVec :: "clk" ::: Clock Dom -> "result" ::: Signal Dom (Vec 4 (Unsigned 2)) -> "result" ::: Signal Dom () -singleInputVec = vioProbe @Dom () +singleInputVec = vioProbe @Dom inNames outNames () + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..3])) + outNames = Nil {-# ANN singleInputVec (TestBench 'top) #-} makeTopEntity 'singleInputVec @@ -208,7 +264,10 @@ singleInputCustom :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom D1 -> "result" ::: Signal Dom () -singleInputCustom = vioProbe @Dom () +singleInputCustom = vioProbe @Dom inNames outNames () + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..2])) + outNames = Nil {-# ANN singleInputCustom (TestBench 'top) #-} makeTopEntity 'singleInputCustom @@ -218,7 +277,10 @@ singleInputNested :: "clk" ::: Clock Dom -> "inp" ::: Signal Dom D2 -> "result" ::: Signal Dom () -singleInputNested = vioProbe @Dom () +singleInputNested = vioProbe @Dom inNames outNames () + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..1])) + outNames = Nil {-# ANN singleInputNested (TestBench 'top) #-} makeTopEntity 'singleInputNested @@ -235,7 +297,10 @@ multipleInputs :: "in7" ::: Signal Dom D1 -> "in8" ::: Signal Dom (BitVector 7) -> "result" ::: Signal Dom (Vec 0 Bool) -multipleInputs = vioProbe @Dom Nil +multipleInputs = vioProbe @Dom inNames outNames Nil + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..7])) + outNames = Nil {-# ANN multipleInputs (TestBench 'top) #-} makeTopEntity 'multipleInputs @@ -260,16 +325,20 @@ inputsAndOutputs :: , D1 , BitVector 6 ) -inputsAndOutputs = vioProbe @Dom - ( low - , True - , 1 - , -1 - , (True, low, False) - , 5 :> 3 :> Nil - , D1 False high 0 - , 0b111000 - ) +inputsAndOutputs = vioProbe @Dom inNames outNames initVals + where + inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..7])) + outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..7])) + initVals = + ( low + , True + , 1 + , -1 + , (True, low, False) + , 5 :> 3 :> Nil + , D1 False high 0 + , 0b111000 + ) {-# ANN inputsAndOutputs (TestBench 'top) #-} makeTopEntity 'inputsAndOutputs From 28f66491ab6b2c0f4e3ebdeb8309eab1c45ee466 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Tue, 30 May 2023 14:24:38 +0200 Subject: [PATCH 19/36] Add custom naming to VIO probes (#2483) A design with VIO probes is inspected (through the GUI of the synthesis tool) when programmed on an FPGA. It therefore makes sense to give each individual probe a logical name. The names of in- and output ports should be given as two `Vec`tor of `Strings`, where the length should match the number of probes. Co-authored-by: Hidde Moll --- Xilinx/VIO/InputBusWidthExceeded.hs | 5 ++++- Xilinx/VIO/InputProbesExceeded.hs | 7 ++++++- Xilinx/VIO/OutputBusWidthExceeded.hs | 5 ++++- Xilinx/VIO/OutputProbesExceeded.hs | 7 ++++++- 4 files changed, 20 insertions(+), 4 deletions(-) diff --git a/Xilinx/VIO/InputBusWidthExceeded.hs b/Xilinx/VIO/InputBusWidthExceeded.hs index 582d187..7a394e8 100644 --- a/Xilinx/VIO/InputBusWidthExceeded.hs +++ b/Xilinx/VIO/InputBusWidthExceeded.hs @@ -5,8 +5,11 @@ import Clash.Cores.Xilinx.VIO type Dom = XilinxSystem +inNames = singleton "probe_in" +outNames = Nil + topEntity :: "clk" ::: Clock Dom -> "in" ::: Signal Dom (BitVector 257) -> "out" ::: Signal Dom () -topEntity = vioProbe @Dom () +topEntity = vioProbe @Dom inNames outNames () diff --git a/Xilinx/VIO/InputProbesExceeded.hs b/Xilinx/VIO/InputProbesExceeded.hs index b420cd2..edf8467 100644 --- a/Xilinx/VIO/InputProbesExceeded.hs +++ b/Xilinx/VIO/InputProbesExceeded.hs @@ -3,10 +3,15 @@ module InputProbesExceeded where import Clash.Prelude import Clash.Cores.Xilinx.VIO +import qualified Data.List as L + type Dom = XilinxSystem +inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0::Int, 1..256])) +outNames = Nil + topEntity :: "clk" ::: Clock Dom -> "in" ::: Signal Dom (Vec 257 Bool) -> "out" ::: Signal Dom () -topEntity = vioProbe @Dom () +topEntity = vioProbe @Dom inNames outNames () diff --git a/Xilinx/VIO/OutputBusWidthExceeded.hs b/Xilinx/VIO/OutputBusWidthExceeded.hs index e2dacf2..44b89c6 100644 --- a/Xilinx/VIO/OutputBusWidthExceeded.hs +++ b/Xilinx/VIO/OutputBusWidthExceeded.hs @@ -5,7 +5,10 @@ import Clash.Cores.Xilinx.VIO type Dom = XilinxSystem +inNames = Nil +outNames = singleton "probe_out" + topEntity :: "clk" ::: Clock Dom -> "out" ::: Signal Dom (BitVector 257) -topEntity = vioProbe @Dom 0 +topEntity = vioProbe @Dom inNames outNames 0 diff --git a/Xilinx/VIO/OutputProbesExceeded.hs b/Xilinx/VIO/OutputProbesExceeded.hs index c6a8dc1..8ccefb5 100644 --- a/Xilinx/VIO/OutputProbesExceeded.hs +++ b/Xilinx/VIO/OutputProbesExceeded.hs @@ -3,9 +3,14 @@ module OutputProbesExceeded where import Clash.Prelude import Clash.Cores.Xilinx.VIO +import qualified Data.List as L + type Dom = XilinxSystem +inNames = Nil +outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0::Int, 1..256])) + topEntity :: "clk" ::: Clock Dom -> "out" ::: Signal Dom (Vec 257 Bit) -topEntity = vioProbe @Dom (replicate (SNat @257) low) +topEntity = vioProbe @Dom inNames outNames (replicate (SNat @257) low) From 3b12f8efb8fcf3c4177a6a57d67ff82ee1bb4b2b Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Sat, 29 Apr 2023 11:44:39 +0200 Subject: [PATCH 20/36] Add `XPM_CDC_HANDSHAKE` to `clash-cores` --- Xilinx/XpmCdcHandshake.hs | 82 ++++++++++++++++++++++ Xilinx/XpmCdcHandshakeTypes.hs | 123 +++++++++++++++++++++++++++++++++ 2 files changed, 205 insertions(+) create mode 100644 Xilinx/XpmCdcHandshake.hs create mode 100644 Xilinx/XpmCdcHandshakeTypes.hs diff --git a/Xilinx/XpmCdcHandshake.hs b/Xilinx/XpmCdcHandshake.hs new file mode 100644 index 0000000..e87c74c --- /dev/null +++ b/Xilinx/XpmCdcHandshake.hs @@ -0,0 +1,82 @@ +module XpmCdcHandshake where + +import Clash.Cores.Xilinx.Xpm.Cdc.Handshake +import Clash.Explicit.Prelude +import Data.Proxy + +import XpmCdcHandshakeTypes (D3, D5, D10, D11) + +import qualified XpmCdcHandshakeTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 +{-# NOINLINE topEntity #-} + +tb0 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D3 @D5 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D3 @D5 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} +{-# NOINLINE tb0 #-} + +tb1 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} +{-# NOINLINE tb1 #-} + +tb2 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} +{-# NOINLINE tb2 #-} + +tb3 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D5 @D10 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D5 @D10 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} +{-# NOINLINE tb3 #-} + +tb4 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} +{-# NOINLINE tb4 #-} + +tb5 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D3 @D11 @3 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D3 @D11 @3 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} +{-# NOINLINE tb5 #-} + +tb6 = done + where + -- src dst srcStages dstStages samples init + done = Types.tb @D3 @D11 @2 @3 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected + expected = $(Types.expected @D3 @D11 @2 @3 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} +{-# NOINLINE tb6 #-} + +-- XXX: Test code does not handle undefined values. Given that this primitive +-- is defined purely in terms of translatable/synthesizable constructs +-- though, I don't think it is too bad to skip this test though. +-- tb7 = done +-- where +-- -- src dst srcStages dstStages samples init +-- done = Types.tb @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat False) expected +-- expected = $(Types.expected @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat False) SNat) +-- {-# ANN tb7 (TestBench 'topEntity) #-} +-- {-# NOINLINE tb7 #-} diff --git a/Xilinx/XpmCdcHandshakeTypes.hs b/Xilinx/XpmCdcHandshakeTypes.hs new file mode 100644 index 0000000..c0eb101 --- /dev/null +++ b/Xilinx/XpmCdcHandshakeTypes.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} + + +module XpmCdcHandshakeTypes where + +import Clash.Cores.Xilinx.Xpm.Cdc.Handshake +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench +import Data.Proxy +import Language.Haskell.TH.Lib + +createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} +createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} +createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} +createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} + +data State = WaitForDeassert | WaitForAssert deriving (Generic, NFDataX) + +noRst :: KnownDomain dom => Reset dom +noRst = unsafeFromHighPolarity (pure False) + +-- | Transfer 1, 2, 3, ... to destination domain +srcFsm :: + forall a src . + ( KnownDomain src + , Num a + , NFDataX a + ) => + Clock src -> + Signal src Bool -> + Signal src (a, Bool) +srcFsm clk = mealy clk noRst enableGen go (0, WaitForDeassert) + where + go (n, WaitForDeassert) True = ((n, WaitForDeassert), (n, False)) + go (n, WaitForDeassert) False = ((n + 1, WaitForAssert), (n + 1, True)) + go (n, WaitForAssert) False = ((n, WaitForAssert), (n, True)) + go (n, WaitForAssert) True = ((n, WaitForDeassert), (n, False)) +{-# NOINLINE srcFsm #-} + +-- | Receives data from source domain +dstFsm :: + forall a dst . + KnownDomain dst => + Clock dst -> + Signal dst (Bool, a) -> + Signal dst (Bool, Maybe a) +dstFsm clk = mealy clk noRst enableGen go WaitForAssert + where + go WaitForAssert (False, _) = (WaitForAssert, (False, Nothing)) + go WaitForAssert (True, n) = (WaitForDeassert, (True, Just n)) + go WaitForDeassert (True, _) = (WaitForDeassert, (True, Nothing)) + go WaitForDeassert (False, _) = (WaitForAssert, (False, Nothing)) +{-# NOINLINE dstFsm #-} + +-- | Composition of 'srcFsm' and 'dstFsm' +top :: + forall a srcStages dstStages src dst . + ( KnownDomain src + , KnownDomain dst + , Num a + , NFDataX a + , BitPack a + , 1 <= BitSize a, BitSize a <= 1024 + , 2 <= srcStages, srcStages <= 10 + , 2 <= dstStages, dstStages <= 10 + ) => + XpmCdcHandshakeConfig srcStages dstStages -> + Clock src -> + Clock dst -> + Signal dst (Maybe a) +top opts clkSrc clkDst = maybeDat + where + (srcIn, srcSend) = unbundle $ srcFsm @a clkSrc srcRcv + + (destOut, destReq, srcRcv) = + xpmCdcHandshakeWith opts clkSrc clkDst srcIn srcSend destAck + + (destAck, maybeDat) = + unbundle $ dstFsm @a clkDst $ bundle (destReq, destOut) +{-# NOINLINE top #-} + +tb :: + forall a b srcStages dstStages n . + ( KnownNat n, 1 <= n + , 2 <= srcStages, srcStages <= 10 + , 2 <= dstStages, dstStages <= 10 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> + XpmCdcHandshakeConfig srcStages dstStages -> + -- | Expected data + Vec n (Maybe (Unsigned 8)) -> + Signal b Bool +tb Proxy Proxy opts expectedDat = done + where + actual = top @(Unsigned 8) opts clkA clkB + + done = outputVerifier' clkB (noRst @b) expectedDat actual + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b srcStages dstStages samples . + ( KnownDomain a + , KnownDomain b + , 2 <= srcStages, srcStages <= 10 + , 2 <= dstStages, dstStages <= 10 + ) => + Proxy a -> + Proxy b -> + XpmCdcHandshakeConfig srcStages dstStages -> + SNat samples -> + ExpQ +expected Proxy Proxy opts SNat = listToVecTH out1 + where + out0 = top @(Unsigned 8) opts (clockGen @a) (clockGen @b) + out1 = sampleN (natToNum @samples) out0 From 4a6a82ab88b43de7e1b2639d3bc42f0e5788589c Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Wed, 14 Jun 2023 12:03:33 +0200 Subject: [PATCH 21/36] Error on unreliable name generation in VIO blackbox Fixes #2497 --- Xilinx/VIO/DuplicateInputNames.hs | 15 +++++++++++++++ Xilinx/VIO/DuplicateInputOutputNames.hs | 15 +++++++++++++++ Xilinx/VIO/DuplicateOutputNames.hs | 14 ++++++++++++++ 3 files changed, 44 insertions(+) create mode 100644 Xilinx/VIO/DuplicateInputNames.hs create mode 100644 Xilinx/VIO/DuplicateInputOutputNames.hs create mode 100644 Xilinx/VIO/DuplicateOutputNames.hs diff --git a/Xilinx/VIO/DuplicateInputNames.hs b/Xilinx/VIO/DuplicateInputNames.hs new file mode 100644 index 0000000..74ecc56 --- /dev/null +++ b/Xilinx/VIO/DuplicateInputNames.hs @@ -0,0 +1,15 @@ +module DuplicateInputNames where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +inNames = "a" :> "a" :> Nil +outNames = "b" :> Nil + +topEntity :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom (Bit, Bit) -> + "out" ::: Signal Dom Bit +topEntity = vioProbe @Dom inNames outNames 0 diff --git a/Xilinx/VIO/DuplicateInputOutputNames.hs b/Xilinx/VIO/DuplicateInputOutputNames.hs new file mode 100644 index 0000000..18ef81f --- /dev/null +++ b/Xilinx/VIO/DuplicateInputOutputNames.hs @@ -0,0 +1,15 @@ +module DuplicateInputOutputNames where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +inNames = "a" :> Nil +outNames = "a" :> Nil + +topEntity :: + "clk" ::: Clock Dom -> + "in" ::: Signal Dom Bit -> + "out" ::: Signal Dom Bit +topEntity = vioProbe @Dom inNames outNames 0 diff --git a/Xilinx/VIO/DuplicateOutputNames.hs b/Xilinx/VIO/DuplicateOutputNames.hs new file mode 100644 index 0000000..78d29ce --- /dev/null +++ b/Xilinx/VIO/DuplicateOutputNames.hs @@ -0,0 +1,14 @@ +module DuplicateOutputNames where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO + +type Dom = XilinxSystem + +inNames = Nil +outNames = "a" :> "a" :> Nil + +topEntity :: + "clk" ::: Clock Dom -> + "out" ::: Signal Dom (Bit, Bit) +topEntity = vioProbe @Dom inNames outNames (0, 0) From e57c91e008491063150e3e1483db4c9ae0acc452 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Mon, 3 Jul 2023 09:12:58 +0200 Subject: [PATCH 22/36] Account for `setName` and friends in `vioProbe` (#2524) Fixes #2501 --- Xilinx/VIO.hs | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/Xilinx/VIO.hs b/Xilinx/VIO.hs index 58f8e9c..3dcdca7 100644 --- a/Xilinx/VIO.hs +++ b/Xilinx/VIO.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module VIO where import Clash.Prelude @@ -6,6 +8,14 @@ import Clash.Annotations.TH import Clash.Annotations.BitRepresentation import Clash.Explicit.Testbench +import Control.Monad (unless) +import Control.Monad.Extra (anyM) +import GHC.Stack (HasCallStack) +import System.Environment (getArgs) +import System.FilePath (()) +import System.FilePath.Glob (globDir1) + +import qualified Language.Haskell.TH as TH import qualified Data.List as L type Dom = XilinxSystem @@ -342,3 +352,45 @@ inputsAndOutputs = vioProbe @Dom inNames outNames initVals {-# ANN inputsAndOutputs (TestBench 'top) #-} makeTopEntity 'inputsAndOutputs + +withSetName :: + "clk" ::: Clock Dom -> + "arg" ::: Signal Dom Bit -> + "result" ::: Signal Dom Bit +withSetName = + setName @"my_vio" $ + vioProbe @Dom ("a" :> Nil) ("b" :> Nil) low +{-# ANN withSetName (TestBench 'top) #-} + +makeTopEntity 'withSetName + +withSetNameNoResult :: + "clk" ::: Clock Dom -> + "arg" ::: Signal Dom Bit -> + "result" ::: Signal Dom () +withSetNameNoResult = + setName @"my_vio" $ + vioProbe @Dom ("a" :> Nil) (Nil) () +{-# ANN withSetNameNoResult (TestBench 'top) #-} + +makeTopEntity 'withSetNameNoResult + +mainVHDL :: IO () +mainVHDL = do + [topDir] <- getArgs + + test topDir 'withSetName + test topDir 'withSetNameNoResult + + where + test :: HasCallStack => FilePath -> TH.Name -> IO () + test topDir nm = do + let hdlDir = topDir show nm + paths <- L.sort <$> globDir1 "*.vhdl" hdlDir + result <- anyM containsMyVio paths + unless result $ error $ "'my_vio' not found in any of: " <> show paths + + containsMyVio :: FilePath -> IO Bool + containsMyVio path = do + contents <- readFile path + pure $ "my_vio" `L.isInfixOf` contents From 304af20e1224eca7e959e8c790b4e6d2498de15f Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Sun, 2 Jul 2023 15:28:27 +0200 Subject: [PATCH 23/36] Use `CLASH_OPAQUE` through libraries --- Xilinx/DcFifo/Basic.hs | 8 ++++++-- Xilinx/DcFifo/Lfsr.hs | 28 +++++++++++++++++++--------- Xilinx/Floating.hs | 38 ++++++++++++++++++++++++++------------ Xilinx/TdpBlockRam.hs | 10 +++++++--- Xilinx/VIO.hs | 4 +++- 5 files changed, 61 insertions(+), 27 deletions(-) diff --git a/Xilinx/DcFifo/Basic.hs b/Xilinx/DcFifo/Basic.hs index 4ac3807..b500dec 100644 --- a/Xilinx/DcFifo/Basic.hs +++ b/Xilinx/DcFifo/Basic.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Basic where import Clash.Explicit.Prelude @@ -48,7 +50,8 @@ topEntity clk rst writeData rEnable = , dcOverflow=True , dcUnderflow=True } -{-# NOINLINE topEntity #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE topEntity #-} testBench :: Signal XilinxSystem Bool @@ -80,7 +83,8 @@ testBench = done clk = tbClockGen (not <$> done) noRst = unsafeFromHighPolarity $ pure False en = enableGen -{-# NOINLINE testBench #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE testBench #-} data FsmOut = FsmOut { fDone :: Bool diff --git a/Xilinx/DcFifo/Lfsr.hs b/Xilinx/DcFifo/Lfsr.hs index 438ce4b..cdd3e22 100644 --- a/Xilinx/DcFifo/Lfsr.hs +++ b/Xilinx/DcFifo/Lfsr.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -Wno-orphans #-} module Lfsr where @@ -36,7 +37,8 @@ lfsrF clk rst ena seed = msb <$> r five, three, two, zero :: Unsigned 16 (five, three, two, zero) = (5, 3, 2, 0) lfsrFeedback = s ! five `xor` s ! three `xor` s ! two `xor` s ! zero -{-# NOINLINE lfsrF #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE lfsrF #-} fifoSampler :: KnownDomain dom => @@ -58,7 +60,8 @@ fifoSampler clk rst ena stalls inps = where maybeData = readLastCycle `orNothing` readData readNow = not stall && not fifoEmpty -{-# NOINLINE fifoSampler #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fifoSampler #-} -- | Drives Xilinx FIFO with an ascending sequence of 'BitVector's. Stalls -- intermittently based on stall input. @@ -163,34 +166,41 @@ fifoVerifier clk rst ena actual = done0 done0 = assert clk rst "Doesn't time out" stuck (pure False) $ assert clk rst "fifoVerifier" actual expected0 done -{-# NOINLINE fifoVerifier #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fifoVerifier #-} topEntity_17_2 :: ConfiguredFifo (BitVector 16) Dom17 Dom2 topEntity_17_2 = dcFifo defConfig -{-# NOINLINE topEntity_17_2 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE topEntity_17_2 #-} {-# ANN topEntity_17_2 (defSyn "topEntity_17_2") #-} testBench_17_2 :: Signal Dom17 Bool testBench_17_2 = mkTestBench topEntity_17_2 -{-# NOINLINE testBench_17_2 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE testBench_17_2 #-} {-# ANN testBench_17_2 (TestBench 'topEntity_17_2) #-} topEntity_2_17 :: ConfiguredFifo (BitVector 16) Dom2 Dom17 topEntity_2_17 = dcFifo defConfig -{-# NOINLINE topEntity_2_17 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE topEntity_2_17 #-} {-# ANN topEntity_2_17 (defSyn "topEntity_2_17") #-} testBench_2_17 :: Signal Dom2 Bool testBench_2_17 = mkTestBench topEntity_2_17 -{-# NOINLINE testBench_2_17 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE testBench_2_17 #-} {-# ANN testBench_2_17 (TestBench 'topEntity_2_17) #-} topEntity_2_2 :: ConfiguredFifo (Unsigned 16) Dom2 Dom2 topEntity_2_2 = dcFifo defConfig -{-# NOINLINE topEntity_2_2 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE topEntity_2_2 #-} {-# ANN topEntity_2_2 (defSyn "topEntity_2_2") #-} testBench_2_2 :: Signal Dom2 Bool testBench_2_2 = mkTestBench topEntity_2_2 -{-# NOINLINE testBench_2_2 #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE testBench_2_2 #-} {-# ANN testBench_2_2 (TestBench 'topEntity_2_2) #-} diff --git a/Xilinx/Floating.hs b/Xilinx/Floating.hs index 91502bc..482799f 100644 --- a/Xilinx/Floating.hs +++ b/Xilinx/Floating.hs @@ -5,6 +5,8 @@ License : BSD2 (see the file LICENSE) Maintainer : QBayLogic B.V. -} +{-# LANGUAGE CPP #-} + {-# OPTIONS_GHC -fconstraint-solver-iterations=10 -Wall -Werror #-} module Floating where @@ -136,7 +138,8 @@ addBasic -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem F.AddDefDelay Float addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y -{-# NOINLINE addBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE addBasic #-} {-# ANN addBasic (binaryTopAnn "addBasic") #-} addBasicTB :: Signal XilinxSystem Bool @@ -154,7 +157,8 @@ addEnable -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem 11 Float addEnable clk en x y = withClock clk $ withEnable en $ F.add x y -{-# NOINLINE addEnable #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE addEnable #-} {-# ANN addEnable (binaryEnTopAnn "addEnable") #-} addEnableTB :: Signal XilinxSystem Bool @@ -194,7 +198,8 @@ addShortPL -> DSignal XilinxSystem 6 Float addShortPL clk x y = withClock clk $ withEnable enableGen $ F.addWith F.defConfig x y -{-# NOINLINE addShortPL #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE addShortPL #-} {-# ANN addShortPL (binaryTopAnn "addShortPL") #-} addShortPLTB :: Signal XilinxSystem Bool @@ -212,7 +217,8 @@ subBasic -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem F.SubDefDelay Float subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y -{-# NOINLINE subBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE subBasic #-} {-# ANN subBasic (binaryTopAnn "subBasic") #-} subBasicTB :: Signal XilinxSystem Bool @@ -229,7 +235,8 @@ mulBasic -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem F.MulDefDelay Float mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y -{-# NOINLINE mulBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE mulBasic #-} {-# ANN mulBasic (binaryTopAnn "mulBasic") #-} mulBasicTB :: Signal XilinxSystem Bool @@ -246,7 +253,8 @@ divBasic -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem F.DivDefDelay Float divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y -{-# NOINLINE divBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE divBasic #-} {-# ANN divBasic (binaryTopAnn "divBasic") #-} divBasicTB :: Signal XilinxSystem Bool @@ -264,7 +272,8 @@ compareBasic -> DSignal XilinxSystem F.CompareDefDelay F.Ordering compareBasic clk x y = withClock clk $ withEnable enableGen $ F.compare x y -{-# NOINLINE compareBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE compareBasic #-} {-# ANN compareBasic (binaryTopAnn "compareBasic") #-} compareBasicTB :: Signal XilinxSystem Bool @@ -279,7 +288,8 @@ compareEnable -> DSignal XilinxSystem 0 Float -> DSignal XilinxSystem F.CompareDefDelay F.Ordering compareEnable clk en x y = withClock clk $ withEnable en $ F.compare x y -{-# NOINLINE compareEnable #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE compareEnable #-} {-# ANN compareEnable (binaryEnTopAnn "compareEnable") #-} compareEnableTB :: Signal XilinxSystem Bool @@ -303,7 +313,8 @@ fromUBasic -> DSignal XilinxSystem 0 (Unsigned 32) -> DSignal XilinxSystem F.FromU32DefDelay Float fromUBasic clk x = withClock clk $ withEnable enableGen $ F.fromU32 x -{-# NOINLINE fromUBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fromUBasic #-} {-# ANN fromUBasic (unaryTopAnn "fromUBasic") #-} fromUBasicTB :: Signal XilinxSystem Bool @@ -328,7 +339,8 @@ fromUEnable -> DSignal XilinxSystem 0 (Unsigned 32) -> DSignal XilinxSystem 5 Float fromUEnable clk en x = withClock clk $ withEnable en $ F.fromU32 x -{-# NOINLINE fromUEnable #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fromUEnable #-} {-# ANN fromUEnable (unaryEnTopAnn "fromUEnable") #-} fromUEnableTB :: Signal XilinxSystem Bool @@ -361,7 +373,8 @@ fromSBasic -> DSignal XilinxSystem 0 (Signed 32) -> DSignal XilinxSystem F.FromS32DefDelay Float fromSBasic clk x = withClock clk $ withEnable enableGen $ F.fromS32 x -{-# NOINLINE fromSBasic #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fromSBasic #-} {-# ANN fromSBasic (unaryTopAnn "fromSBasic") #-} fromSBasicTB :: Signal XilinxSystem Bool @@ -386,7 +399,8 @@ fromSEnable -> DSignal XilinxSystem 0 (Signed 32) -> DSignal XilinxSystem 6 Float fromSEnable clk en x = withClock clk $ withEnable en $ F.fromS32 x -{-# NOINLINE fromSEnable #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE fromSEnable #-} {-# ANN fromSEnable (unaryEnTopAnn "fromSEnable") #-} fromSEnableTB :: Signal XilinxSystem Bool diff --git a/Xilinx/TdpBlockRam.hs b/Xilinx/TdpBlockRam.hs index cbef871..055998f 100644 --- a/Xilinx/TdpBlockRam.hs +++ b/Xilinx/TdpBlockRam.hs @@ -2,6 +2,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} module TdpBlockRam where @@ -26,7 +27,8 @@ topEntity tdpbram clkA (toEnable enA) addrA byteEnaA datA clkB (toEnable enB) addrB byteEnaB datB -{-# NOINLINE topEntity #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE topEntity #-} noRstA :: Reset A noRstA = unsafeFromHighPolarity (pure False) @@ -76,7 +78,8 @@ tb inputA expectedA inputB expectedB = clkB :: Clock B clkB = tbClockGen (not <$> doneB) -{-# NOINLINE normalWritesTB #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE normalWritesTB #-} {-# ANN normalWritesTB (TestBench 'topEntity) #-} -- | Test bench doing some (non-overlapping) writes and reads on two ports, either -- with the byte enable fully set, or fully unset. @@ -127,7 +130,8 @@ normalWritesTB = tb inputA expectedA inputB expectedB :> Nil ) ++ repeat @10 noOp -{-# NOINLINE writeEnableWritesTB #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE writeEnableWritesTB #-} {-# ANN writeEnableWritesTB (TestBench 'topEntity) #-} -- | Test bench doing some (non-overlapping) writes and reads on two ports, with -- varying byte enables. diff --git a/Xilinx/VIO.hs b/Xilinx/VIO.hs index 3dcdca7..483ebc3 100644 --- a/Xilinx/VIO.hs +++ b/Xilinx/VIO.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module VIO where @@ -22,7 +23,8 @@ type Dom = XilinxSystem top :: "result" ::: Unsigned 8 top = 0 -{-# NOINLINE top #-} +-- See: https://github.com/clash-lang/clash-compiler/pull/2511 +{-# CLASH_OPAQUE top #-} makeTopEntity 'top From 8c311de0022e9e003f63aea4962ede3797cce9ac Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Thu, 13 Jul 2023 15:49:38 +0200 Subject: [PATCH 24/36] Add `unsafe{From,To}Active{Low,High}` --- Xilinx/DcFifo/Basic.hs | 2 +- Xilinx/DcFifo/Lfsr.hs | 4 ++-- Xilinx/TdpBlockRam.hs | 4 ++-- Xilinx/XpmCdcArraySingleTypes.hs | 2 +- Xilinx/XpmCdcGrayTypes.hs | 2 +- Xilinx/XpmCdcHandshakeTypes.hs | 2 +- Xilinx/XpmCdcSingleTypes.hs | 2 +- 7 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Xilinx/DcFifo/Basic.hs b/Xilinx/DcFifo/Basic.hs index b500dec..2914b47 100644 --- a/Xilinx/DcFifo/Basic.hs +++ b/Xilinx/DcFifo/Basic.hs @@ -81,7 +81,7 @@ testBench = done (pack <$> fifoData maxOut) (fExpectedData <$> fsmOut) (fDone <$> fsmOut) clk = tbClockGen (not <$> done) - noRst = unsafeFromHighPolarity $ pure False + noRst = unsafeFromActiveHigh $ pure False en = enableGen -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE testBench #-} diff --git a/Xilinx/DcFifo/Lfsr.hs b/Xilinx/DcFifo/Lfsr.hs index cdd3e22..12ea82f 100644 --- a/Xilinx/DcFifo/Lfsr.hs +++ b/Xilinx/DcFifo/Lfsr.hs @@ -120,8 +120,8 @@ mkTestBench cFifo = done where (rClk, wClk) = biTbClockGen (not <$> done) - noRRst = unsafeFromHighPolarity $ pure False - noWRst = unsafeFromHighPolarity $ pure False + noRRst = unsafeFromActiveHigh $ pure False + noWRst = unsafeFromActiveHigh $ pure False rEna = enableGen wEna = enableGen diff --git a/Xilinx/TdpBlockRam.hs b/Xilinx/TdpBlockRam.hs index 055998f..f38a668 100644 --- a/Xilinx/TdpBlockRam.hs +++ b/Xilinx/TdpBlockRam.hs @@ -31,10 +31,10 @@ topEntity {-# CLASH_OPAQUE topEntity #-} noRstA :: Reset A -noRstA = unsafeFromHighPolarity (pure False) +noRstA = unsafeFromActiveHigh (pure False) noRstB :: Reset B -noRstB = unsafeFromHighPolarity (pure False) +noRstB = unsafeFromActiveHigh (pure False) tb :: ( KnownNat n0, KnownNat n1, KnownNat n2, KnownNat n3 diff --git a/Xilinx/XpmCdcArraySingleTypes.hs b/Xilinx/XpmCdcArraySingleTypes.hs index 9eea589..2ab8f32 100644 --- a/Xilinx/XpmCdcArraySingleTypes.hs +++ b/Xilinx/XpmCdcArraySingleTypes.hs @@ -14,7 +14,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b stages width n . diff --git a/Xilinx/XpmCdcGrayTypes.hs b/Xilinx/XpmCdcGrayTypes.hs index fb2a949..a5827bf 100644 --- a/Xilinx/XpmCdcGrayTypes.hs +++ b/Xilinx/XpmCdcGrayTypes.hs @@ -14,7 +14,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b width stages n . diff --git a/Xilinx/XpmCdcHandshakeTypes.hs b/Xilinx/XpmCdcHandshakeTypes.hs index c0eb101..c6f75ee 100644 --- a/Xilinx/XpmCdcHandshakeTypes.hs +++ b/Xilinx/XpmCdcHandshakeTypes.hs @@ -18,7 +18,7 @@ createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} data State = WaitForDeassert | WaitForAssert deriving (Generic, NFDataX) noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) -- | Transfer 1, 2, 3, ... to destination domain srcFsm :: diff --git a/Xilinx/XpmCdcSingleTypes.hs b/Xilinx/XpmCdcSingleTypes.hs index c3068b1..c844713 100644 --- a/Xilinx/XpmCdcSingleTypes.hs +++ b/Xilinx/XpmCdcSingleTypes.hs @@ -16,7 +16,7 @@ createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromHighPolarity (pure False) +noRst = unsafeFromActiveHigh (pure False) tb :: forall a b stages n . From 460c40d9099ce93e433a508619825f6de2132179 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 20 Jul 2023 11:49:29 +0200 Subject: [PATCH 25/36] Allow zero-bit result for prim fun-args (#2550) Fixes #2549 --- Xilinx/T2549.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 Xilinx/T2549.hs diff --git a/Xilinx/T2549.hs b/Xilinx/T2549.hs new file mode 100644 index 0000000..94dcfd5 --- /dev/null +++ b/Xilinx/T2549.hs @@ -0,0 +1,17 @@ +module T2549 where + +import Clash.Prelude +import Clash.Cores.Xilinx.VIO +import GHC.Magic + +topEntity :: Clock System -> Signal System Bit +topEntity c = hwSeqX probe v -- improper use of hwSeqX, the first argument of + -- hwSeqX should not have a function type. When + -- the first argument has a function type, it will + -- not be rendered. + where + probe :: Signal System Bit -> Signal System () + probe = vioProbe ("v1" :> "v2" :> Nil) Nil () c v + {-# INLINE probe #-} + + v = pure high From 52eccc69bbc64eee49d2086a2c0c71fa0beb43ec Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Thu, 13 Jul 2023 11:47:47 +0200 Subject: [PATCH 26/36] Add `Clash.Cores.Xilinx.Ila` --- Xilinx/Ila.hs | 219 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 Xilinx/Ila.hs diff --git a/Xilinx/Ila.hs b/Xilinx/Ila.hs new file mode 100644 index 0000000..ac8e69c --- /dev/null +++ b/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" From 05c6bba8ac23d3ae88926c5a5619a23ab52f4c76 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Thu, 13 Jul 2023 14:34:38 +0200 Subject: [PATCH 27/36] Add `noReset`, `andReset`, and `orReset` Co-authored-by: Peter Lebbing --- Xilinx/DcFifo/Basic.hs | 23 +++++++++++------------ Xilinx/DcFifo/Lfsr.hs | 15 ++++++--------- Xilinx/Ila.hs | 3 --- Xilinx/TdpBlockRam.hs | 18 ++++++------------ Xilinx/XpmCdcArraySingleTypes.hs | 5 +---- Xilinx/XpmCdcGrayTypes.hs | 5 +---- Xilinx/XpmCdcHandshakeTypes.hs | 9 +++------ Xilinx/XpmCdcSingleTypes.hs | 5 +---- 8 files changed, 29 insertions(+), 54 deletions(-) diff --git a/Xilinx/DcFifo/Basic.hs b/Xilinx/DcFifo/Basic.hs index 2914b47..9a760bb 100644 --- a/Xilinx/DcFifo/Basic.hs +++ b/Xilinx/DcFifo/Basic.hs @@ -57,31 +57,30 @@ testBench :: Signal XilinxSystem Bool testBench = done where - fsmOut = let (s', o) = unbundle $ fsm <$> register clk noRst en (Push 0) s' + fsmOut = let (s', o) = unbundle $ fsm <$> delay clk en (Push 0) s' in o (minOut, maxOut) = - topEntity clk noRst (fWriteData <$> fsmOut) (fREnable <$> fsmOut) + topEntity clk noReset (fWriteData <$> fsmOut) (fREnable <$> fsmOut) done = - register clk noRst en False - $ assertBitVector clk noRst "FIFO min full" + register clk noReset en False + $ assertBitVector clk noReset "FIFO min full" (pack <$> isFull minOut) (fExpectedFull <$> fsmOut) - $ assertBitVector clk noRst "FIFO max full" + $ assertBitVector clk noReset "FIFO max full" (pack <$> isFull maxOut) (fExpectedFull <$> fsmOut) - $ assertBitVector clk noRst "FIFO max overflow" + $ assertBitVector clk noReset "FIFO max overflow" (pack <$> isOverflow maxOut) (fExpectedOverflow <$> fsmOut) - $ assertBitVector clk noRst "FIFO min empty" + $ assertBitVector clk noReset "FIFO min empty" (pack <$> isEmpty minOut) (fExpectedEmpty <$> fsmOut) - $ assertBitVector clk noRst "FIFO max empty" + $ assertBitVector clk noReset "FIFO max empty" (pack <$> isEmpty maxOut) (fExpectedEmpty <$> fsmOut) - $ assertBitVector clk noRst "FIFO max underflow" + $ assertBitVector clk noReset "FIFO max underflow" (pack <$> isUnderflow maxOut) (fExpectedUnderflow <$> fsmOut) - $ assertBitVector clk noRst "FIFO min data out" + $ assertBitVector clk noReset "FIFO min data out" (pack <$> fifoData minOut) (fExpectedData <$> fsmOut) - $ assertBitVector clk noRst "FIFO max data out" + $ assertBitVector clk noReset "FIFO max data out" (pack <$> fifoData maxOut) (fExpectedData <$> fsmOut) (fDone <$> fsmOut) clk = tbClockGen (not <$> done) - noRst = unsafeFromActiveHigh $ pure False en = enableGen -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE testBench #-} diff --git a/Xilinx/DcFifo/Lfsr.hs b/Xilinx/DcFifo/Lfsr.hs index 12ea82f..0ee0985 100644 --- a/Xilinx/DcFifo/Lfsr.hs +++ b/Xilinx/DcFifo/Lfsr.hs @@ -120,26 +120,23 @@ mkTestBench cFifo = done where (rClk, wClk) = biTbClockGen (not <$> done) - noRRst = unsafeFromActiveHigh $ pure False - noWRst = unsafeFromActiveHigh $ pure False - rEna = enableGen wEna = enableGen -- Driver - wLfsr = bitToBool <$> lfsrF wClk noWRst wEna 0xDEAD - writeData = fifoDriver wClk noWRst wEna wLfsr (bundle (isFull, writeCount)) + wLfsr = bitToBool <$> lfsrF wClk noReset wEna 0xDEAD + writeData = fifoDriver wClk noReset wEna wLfsr (bundle (isFull, writeCount)) -- Sampler - rLfsr = bitToBool <$> lfsrF rClk noRRst rEna 0xBEEF + rLfsr = bitToBool <$> lfsrF rClk noReset rEna 0xBEEF (readEnable, maybeReadData) = unbundle $ - fifoSampler rClk noRRst rEna rLfsr (bundle (isEmpty, readCount, fifoData)) + fifoSampler rClk noReset rEna rLfsr (bundle (isEmpty, readCount, fifoData)) FifoOut{isFull, writeCount, isEmpty, readCount, fifoData} = - cFifo wClk noWRst rClk noRRst writeData readEnable + cFifo wClk noReset rClk noReset writeData readEnable - done = fifoVerifier rClk noRRst rEna maybeReadData + done = fifoVerifier rClk noReset rEna maybeReadData {-# INLINE mkTestBench #-} fifoVerifier :: diff --git a/Xilinx/Ila.hs b/Xilinx/Ila.hs index ac8e69c..17684db 100644 --- a/Xilinx/Ila.hs +++ b/Xilinx/Ila.hs @@ -24,9 +24,6 @@ top = 0 {-# 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 diff --git a/Xilinx/TdpBlockRam.hs b/Xilinx/TdpBlockRam.hs index f38a668..405ada8 100644 --- a/Xilinx/TdpBlockRam.hs +++ b/Xilinx/TdpBlockRam.hs @@ -30,12 +30,6 @@ topEntity -- See: https://github.com/clash-lang/clash-compiler/pull/2511 {-# CLASH_OPAQUE topEntity #-} -noRstA :: Reset A -noRstA = unsafeFromActiveHigh (pure False) - -noRstB :: Reset B -noRstB = unsafeFromActiveHigh (pure False) - tb :: ( KnownNat n0, KnownNat n1, KnownNat n2, KnownNat n3 , 1 <= n0, 1 <= n1, 1 <= n2, 1 <= n3 ) => @@ -57,11 +51,11 @@ tb inputA expectedA inputB expectedB = (actualA0, actualB0) = topEntity clkA clkB - (stimuliGenerator clkA noRstA inputA) - (stimuliGenerator clkB noRstB inputB) + (stimuliGenerator clkA noReset inputA) + (stimuliGenerator clkB noReset inputB) - actualA1 = ignoreFor clkA noRstA enableGen d1 0 actualA0 - actualB1 = ignoreFor clkB noRstB enableGen d1 0 actualB0 + actualA1 = ignoreFor clkA noReset enableGen d1 0 actualA0 + actualB1 = ignoreFor clkB noReset enableGen d1 0 actualB0 -- Verification outputVerifierA = outputVerifierWith @@ -69,8 +63,8 @@ tb inputA expectedA inputB expectedB = outputVerifierB = outputVerifierWith (\clk rst -> assert clk rst "outputVerifier Port B") - doneA = outputVerifierA clkA clkA noRstA expectedA actualA1 - doneB = outputVerifierB clkB clkB noRstB expectedB actualB1 + doneA = outputVerifierA clkA clkA noReset expectedA actualA1 + doneB = outputVerifierB clkB clkB noReset expectedB actualB1 -- Testbench clocks clkA :: Clock A diff --git a/Xilinx/XpmCdcArraySingleTypes.hs b/Xilinx/XpmCdcArraySingleTypes.hs index 2ab8f32..0ee74f2 100644 --- a/Xilinx/XpmCdcArraySingleTypes.hs +++ b/Xilinx/XpmCdcArraySingleTypes.hs @@ -13,9 +13,6 @@ createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} -noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromActiveHigh (pure False) - tb :: forall a b stages width n . ( KnownNat n, 1 <= n @@ -48,7 +45,7 @@ tb Proxy Proxy initVals regInput SNat expectedDat = done done = outputVerifierWith (\clk rst -> assertBitVector clk rst "outputVerifier Port A") - clkB clkB (noRst @b) + clkB clkB noReset expectedDat (pack <$> actual) diff --git a/Xilinx/XpmCdcGrayTypes.hs b/Xilinx/XpmCdcGrayTypes.hs index a5827bf..8b037c3 100644 --- a/Xilinx/XpmCdcGrayTypes.hs +++ b/Xilinx/XpmCdcGrayTypes.hs @@ -13,9 +13,6 @@ createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} -noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromActiveHigh (pure False) - tb :: forall a b width stages n . ( KnownNat n, 1 <= n @@ -37,7 +34,7 @@ tb Proxy Proxy SNat expectedDat = done done = outputVerifierWith (\clk rst -> assertBitVector clk rst "outputVerifier Port A") - clkB clkB (noRst @b) + clkB clkB noReset expectedDat (pack <$> actual) diff --git a/Xilinx/XpmCdcHandshakeTypes.hs b/Xilinx/XpmCdcHandshakeTypes.hs index c6f75ee..3fc9071 100644 --- a/Xilinx/XpmCdcHandshakeTypes.hs +++ b/Xilinx/XpmCdcHandshakeTypes.hs @@ -17,9 +17,6 @@ createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} data State = WaitForDeassert | WaitForAssert deriving (Generic, NFDataX) -noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromActiveHigh (pure False) - -- | Transfer 1, 2, 3, ... to destination domain srcFsm :: forall a src . @@ -30,7 +27,7 @@ srcFsm :: Clock src -> Signal src Bool -> Signal src (a, Bool) -srcFsm clk = mealy clk noRst enableGen go (0, WaitForDeassert) +srcFsm clk = mealy clk noReset enableGen go (0, WaitForDeassert) where go (n, WaitForDeassert) True = ((n, WaitForDeassert), (n, False)) go (n, WaitForDeassert) False = ((n + 1, WaitForAssert), (n + 1, True)) @@ -45,7 +42,7 @@ dstFsm :: Clock dst -> Signal dst (Bool, a) -> Signal dst (Bool, Maybe a) -dstFsm clk = mealy clk noRst enableGen go WaitForAssert +dstFsm clk = mealy clk noReset enableGen go WaitForAssert where go WaitForAssert (False, _) = (WaitForAssert, (False, Nothing)) go WaitForAssert (True, n) = (WaitForDeassert, (True, Just n)) @@ -97,7 +94,7 @@ tb Proxy Proxy opts expectedDat = done where actual = top @(Unsigned 8) opts clkA clkB - done = outputVerifier' clkB (noRst @b) expectedDat actual + done = outputVerifier' clkB noReset expectedDat actual -- Testbench clocks clkA :: Clock a diff --git a/Xilinx/XpmCdcSingleTypes.hs b/Xilinx/XpmCdcSingleTypes.hs index c844713..4f8c267 100644 --- a/Xilinx/XpmCdcSingleTypes.hs +++ b/Xilinx/XpmCdcSingleTypes.hs @@ -15,9 +15,6 @@ createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} -noRst :: KnownDomain dom => Reset dom -noRst = unsafeFromActiveHigh (pure False) - tb :: forall a b stages n . ( KnownNat n, 1 <= n @@ -47,7 +44,7 @@ tb Proxy Proxy initVals regInput SNat expectedDat = done done = outputVerifierWith (\clk rst -> assertBitVector clk rst "outputVerifier Port A") - clkB clkB (noRst @b) + clkB clkB noReset expectedDat (pack <$> actual) From 0ea8be31cc4ee14644bdd2f4d6838efdcd9f72ad Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 22 Nov 2023 17:17:52 +0100 Subject: [PATCH 28/36] clash-cores: Fix xpmCdcHandshake (#2610) * The HDL generated incorrectly set DEST_EXT_HSK=0, configuring it to generate acks automatically. While the exposed API and simulation model assumed external handshaking. * The dstStages and srcStages settings were flipped. This also updates the test so it can detect that first error. And improves the haddock a bit to clarify what the settings do and relate them to the XPM documentation. --- Xilinx/XpmCdcHandshakeTypes.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Xilinx/XpmCdcHandshakeTypes.hs b/Xilinx/XpmCdcHandshakeTypes.hs index 3fc9071..f2c0962 100644 --- a/Xilinx/XpmCdcHandshakeTypes.hs +++ b/Xilinx/XpmCdcHandshakeTypes.hs @@ -15,7 +15,7 @@ createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} -data State = WaitForDeassert | WaitForAssert deriving (Generic, NFDataX) +data State = WaitForDeassert | WaitForAssert (Index 2) deriving (Generic, NFDataX) -- | Transfer 1, 2, 3, ... to destination domain srcFsm :: @@ -29,10 +29,11 @@ srcFsm :: Signal src (a, Bool) srcFsm clk = mealy clk noReset enableGen go (0, WaitForDeassert) where - go (n, WaitForDeassert) True = ((n, WaitForDeassert), (n, False)) - go (n, WaitForDeassert) False = ((n + 1, WaitForAssert), (n + 1, True)) - go (n, WaitForAssert) False = ((n, WaitForAssert), (n, True)) - go (n, WaitForAssert) True = ((n, WaitForDeassert), (n, False)) + go (n, WaitForDeassert) True = ((n, WaitForDeassert), (0, False)) + go (n, WaitForDeassert) False = ((n + 1, WaitForAssert maxBound), (n + 1, True)) + go (n, WaitForAssert _) False = ((n, WaitForAssert maxBound), (n, True)) + go (n, WaitForAssert 0) True = ((n, WaitForDeassert), (0, False)) + go (n, WaitForAssert w) True = ((n, WaitForAssert (w-1)), (n, True)) -- seen src_rcv, wait a little before dropping src_send {-# NOINLINE srcFsm #-} -- | Receives data from source domain @@ -42,12 +43,13 @@ dstFsm :: Clock dst -> Signal dst (Bool, a) -> Signal dst (Bool, Maybe a) -dstFsm clk = mealy clk noReset enableGen go WaitForAssert +dstFsm clk = mealy clk noReset enableGen go (WaitForAssert maxBound) where - go WaitForAssert (False, _) = (WaitForAssert, (False, Nothing)) - go WaitForAssert (True, n) = (WaitForDeassert, (True, Just n)) - go WaitForDeassert (True, _) = (WaitForDeassert, (True, Nothing)) - go WaitForDeassert (False, _) = (WaitForAssert, (False, Nothing)) + go (WaitForAssert _) (False, _) = (WaitForAssert maxBound, (False, Nothing)) + go (WaitForAssert 0) (True, n) = (WaitForDeassert, (True, Just n)) + go (WaitForAssert w) (True, n) = (WaitForAssert (w-1), (False, Nothing)) -- seen dest_req, wait a little before asserting dest_ack + go WaitForDeassert (True, _) = (WaitForDeassert, (True, Nothing)) + go WaitForDeassert (False, _) = (WaitForAssert maxBound, (False, Nothing)) {-# NOINLINE dstFsm #-} -- | Composition of 'srcFsm' and 'dstFsm' From 2123259d68698b094d64ee49eef1d252f63c7cb2 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Mon, 4 Mar 2024 11:21:23 +0100 Subject: [PATCH 29/36] Combine function names when specializing Given a global binder `accum` and an application `f accum`, Clash now calls the new, specialized binder `f_accum` instead of just `accum`, provided that both are marked `NOINLINE`/`OPAQUE`. This more accurately reflects the body of the function and will result in more sensible file names. For example, previously Clash would generate a separate file `accum.{v,vhdl}` that contained the inlined bodies of both `f` and `accum`. After this patch, it will generate `f_accum.{v,vhdl}`. Tabulated the new behavior looks like: | OPAQUE | Old name for `f g` | New name for `f g` | |---------------|--------------------|--------------------| | `f` | `g` | `f` | | `g` | `g` | `g` | | `f` and `g` | `g` | `f_g` | | !`f` and !`g` | `g` | `f_g` | Fixes #2508 --- Xilinx/Ila.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Xilinx/Ila.hs b/Xilinx/Ila.hs index 17684db..ac22155 100644 --- a/Xilinx/Ila.hs +++ b/Xilinx/Ila.hs @@ -100,7 +100,7 @@ mainVHDL = do -- HDL content check: let hdlDir = dir show 'testWithDefaultsOne - [path] <- glob (hdlDir "Ila_testWithDefaultsOne_oneCounter*.vhdl") + [path] <- glob (hdlDir "Ila_testWithDefaultsOne_ila.vhdl") contents <- readFile path assertIn contents "attribute KEEP of foo : signal is \"true\";" -- signal name assertIn contents "one_counter_ila : testWithDefaultsOne_ila" -- instantiation label From 8d00c75594976f3c63844a24c0e1a228b1eea2f9 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Thu, 30 Nov 2023 17:19:53 +0100 Subject: [PATCH 30/36] Clean up XpmCdc tests code --- Xilinx/XpmCdcArraySingle.hs | 2 +- Xilinx/XpmCdcArraySingleTypes.hs | 7 +------ Xilinx/XpmCdcGray.hs | 2 +- Xilinx/XpmCdcGrayTypes.hs | 5 ----- Xilinx/XpmCdcHandshake.hs | 2 +- Xilinx/XpmCdcHandshakeTypes.hs | 5 ----- Xilinx/XpmCdcSingle.hs | 2 +- Xilinx/XpmCdcSingleTypes.hs | 7 +------ Xilinx/XpmTestCommon.hs | 8 ++++++++ 9 files changed, 14 insertions(+), 26 deletions(-) create mode 100644 Xilinx/XpmTestCommon.hs diff --git a/Xilinx/XpmCdcArraySingle.hs b/Xilinx/XpmCdcArraySingle.hs index fd50bfb..01cc1f4 100644 --- a/Xilinx/XpmCdcArraySingle.hs +++ b/Xilinx/XpmCdcArraySingle.hs @@ -3,7 +3,7 @@ module XpmCdcArraySingle where import Clash.Explicit.Prelude import Data.Proxy -import XpmCdcArraySingleTypes (D3, D5, D10, D11) +import XpmTestCommon (D3, D5, D10, D11) import qualified XpmCdcArraySingleTypes as Types diff --git a/Xilinx/XpmCdcArraySingleTypes.hs b/Xilinx/XpmCdcArraySingleTypes.hs index 0ee74f2..0368ada 100644 --- a/Xilinx/XpmCdcArraySingleTypes.hs +++ b/Xilinx/XpmCdcArraySingleTypes.hs @@ -8,11 +8,6 @@ import Clash.Explicit.Testbench import Data.Proxy import Language.Haskell.TH.Lib -createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} -createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} -createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} -createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} - tb :: forall a b stages width n . ( KnownNat n, 1 <= n @@ -44,7 +39,7 @@ tb Proxy Proxy initVals regInput SNat expectedDat = done done = outputVerifierWith - (\clk rst -> assertBitVector clk rst "outputVerifier Port A") + (\clk rst -> assertBitVector clk rst "outputVerifier A") clkB clkB noReset expectedDat (pack <$> actual) diff --git a/Xilinx/XpmCdcGray.hs b/Xilinx/XpmCdcGray.hs index 6db599f..65b2c61 100644 --- a/Xilinx/XpmCdcGray.hs +++ b/Xilinx/XpmCdcGray.hs @@ -3,7 +3,7 @@ module XpmCdcGray where import Clash.Explicit.Prelude import Data.Proxy -import XpmCdcGrayTypes (D3, D5, D10, D11) +import XpmTestCommon (D3, D5, D10, D11) import qualified XpmCdcGrayTypes as Types diff --git a/Xilinx/XpmCdcGrayTypes.hs b/Xilinx/XpmCdcGrayTypes.hs index 8b037c3..2862f84 100644 --- a/Xilinx/XpmCdcGrayTypes.hs +++ b/Xilinx/XpmCdcGrayTypes.hs @@ -8,11 +8,6 @@ import Clash.Explicit.Testbench import Data.Proxy import Language.Haskell.TH.Lib -createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} -createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} -createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} -createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} - tb :: forall a b width stages n . ( KnownNat n, 1 <= n diff --git a/Xilinx/XpmCdcHandshake.hs b/Xilinx/XpmCdcHandshake.hs index e87c74c..4345455 100644 --- a/Xilinx/XpmCdcHandshake.hs +++ b/Xilinx/XpmCdcHandshake.hs @@ -4,7 +4,7 @@ import Clash.Cores.Xilinx.Xpm.Cdc.Handshake import Clash.Explicit.Prelude import Data.Proxy -import XpmCdcHandshakeTypes (D3, D5, D10, D11) +import XpmTestCommon (D3, D5, D10, D11) import qualified XpmCdcHandshakeTypes as Types diff --git a/Xilinx/XpmCdcHandshakeTypes.hs b/Xilinx/XpmCdcHandshakeTypes.hs index f2c0962..3fb479f 100644 --- a/Xilinx/XpmCdcHandshakeTypes.hs +++ b/Xilinx/XpmCdcHandshakeTypes.hs @@ -10,11 +10,6 @@ import Clash.Explicit.Testbench import Data.Proxy import Language.Haskell.TH.Lib -createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} -createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} -createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} -createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} - data State = WaitForDeassert | WaitForAssert (Index 2) deriving (Generic, NFDataX) -- | Transfer 1, 2, 3, ... to destination domain diff --git a/Xilinx/XpmCdcSingle.hs b/Xilinx/XpmCdcSingle.hs index 5931822..2bb35a6 100644 --- a/Xilinx/XpmCdcSingle.hs +++ b/Xilinx/XpmCdcSingle.hs @@ -4,7 +4,7 @@ import Clash.Explicit.Prelude import Data.Proxy -import XpmCdcSingleTypes (D3, D5, D10, D11) +import XpmTestCommon (D3, D5, D10, D11) import qualified XpmCdcSingleTypes as Types diff --git a/Xilinx/XpmCdcSingleTypes.hs b/Xilinx/XpmCdcSingleTypes.hs index 4f8c267..02ff264 100644 --- a/Xilinx/XpmCdcSingleTypes.hs +++ b/Xilinx/XpmCdcSingleTypes.hs @@ -10,11 +10,6 @@ import Language.Haskell.TH.Lib import Clash.Cores.Xilinx.Xpm.Cdc.Single -createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} -createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} -createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} -createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} - tb :: forall a b stages n . ( KnownNat n, 1 <= n @@ -43,7 +38,7 @@ tb Proxy Proxy initVals regInput SNat expectedDat = done done = outputVerifierWith - (\clk rst -> assertBitVector clk rst "outputVerifier Port A") + (\clk rst -> assertBitVector clk rst "outputVerifier") clkB clkB noReset expectedDat (pack <$> actual) diff --git a/Xilinx/XpmTestCommon.hs b/Xilinx/XpmTestCommon.hs new file mode 100644 index 0000000..3fb521d --- /dev/null +++ b/Xilinx/XpmTestCommon.hs @@ -0,0 +1,8 @@ +module XpmTestCommon where + +import Clash.Explicit.Prelude + +createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} +createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} +createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} +createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} From faacebe85ed10e04bc14ade258da97d8e20aa798 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Thu, 30 Nov 2023 17:18:00 +0100 Subject: [PATCH 31/36] Fix tests XpmCdcSingle, XpmCdcArraySingle, XpmCdcGray XpmCdcSingle was using as iots test signal: fromList [0..] :: Signal dom (Unsigned 1) which evaluates to 0 :> 1 :> errorX "finite list". When that flows though sample . fmap pack . unsafeSynchronizer it turns into [0b0, 0b1, 0b., 0b., 0b., ... Now we use the random package to generate random test data. And the seed is also randomly generated via TH on each compile. So everytime you recompile you get different test data. --- Xilinx/XpmCdcArraySingle.hs | 4 ++-- Xilinx/XpmCdcArraySingleTypes.hs | 14 ++++++++------ Xilinx/XpmCdcGray.hs | 4 ++-- Xilinx/XpmCdcGrayTypes.hs | 2 +- Xilinx/XpmCdcSingleTypes.hs | 12 +++++++----- Xilinx/XpmTestCommon.hs | 22 ++++++++++++++++++++++ 6 files changed, 42 insertions(+), 16 deletions(-) diff --git a/Xilinx/XpmCdcArraySingle.hs b/Xilinx/XpmCdcArraySingle.hs index 01cc1f4..691abc4 100644 --- a/Xilinx/XpmCdcArraySingle.hs +++ b/Xilinx/XpmCdcArraySingle.hs @@ -36,8 +36,8 @@ tb2 = done tb3 = done where -- src dst stages width samples init reg - done = Types.tb @D3 @D5 @2 @1024 @100 Proxy Proxy True True SNat expected - expected = $(Types.expected @D3 @D5 @2 @1024 @100 Proxy Proxy True True SNat SNat SNat) + done = Types.tb @D3 @D5 @2 @64 @100 Proxy Proxy True True SNat expected + expected = $(Types.expected @D3 @D5 @2 @64 @100 Proxy Proxy True True SNat SNat SNat) {-# ANN tb3 (TestBench 'topEntity) #-} tb4 = done diff --git a/Xilinx/XpmCdcArraySingleTypes.hs b/Xilinx/XpmCdcArraySingleTypes.hs index 0368ada..dd97578 100644 --- a/Xilinx/XpmCdcArraySingleTypes.hs +++ b/Xilinx/XpmCdcArraySingleTypes.hs @@ -7,12 +7,16 @@ import Clash.Explicit.Prelude import Clash.Explicit.Testbench import Data.Proxy import Language.Haskell.TH.Lib +import XpmTestCommon + +testData :: (KnownNat width, KnownDomain dom, width <= 64) => Clock dom -> Signal dom (Unsigned width) +testData = genTestData randomSeed tb :: forall a b stages width n . ( KnownNat n, 1 <= n , KnownNat stages, 2 <= stages, stages <= 10 - , KnownNat width, 1 <= width, width <= 1024 + , KnownNat width, 1 <= width, width <= 64 , KnownDomain a , KnownDomain b ) => @@ -27,15 +31,13 @@ tb :: Signal b Bool tb Proxy Proxy initVals regInput SNat expectedDat = done where - counter = delay clkA enableGen 0 (counter + 1) - actual = xpmCdcArraySingleWith @stages @(Unsigned width) (XpmCdcArraySingleConfig SNat initVals regInput) clkA clkB - counter + (testData clkA) done = outputVerifierWith @@ -55,7 +57,7 @@ expected :: ( KnownDomain a , KnownDomain b , 2 <= stages, stages <= 10 - , 1 <= width, width <= 1024 + , 1 <= width, width <= 64 ) => Proxy a -> Proxy b -> @@ -75,6 +77,6 @@ expected Proxy Proxy initVals regInput SNat SNat SNat = listToVecTH out1 (XpmCdcArraySingleConfig SNat initVals regInput) (clockGen @a) (clockGen @b) - (fromList [0..]) + (testData clockGen) out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/Xilinx/XpmCdcGray.hs b/Xilinx/XpmCdcGray.hs index 65b2c61..9d9ad26 100644 --- a/Xilinx/XpmCdcGray.hs +++ b/Xilinx/XpmCdcGray.hs @@ -15,8 +15,8 @@ topEntity = 0 tb0 = done where -- src dst width stages samples - done = Types.tb @D3 @D5 @16 @4 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D3 @D5 @16 @4 @100 Proxy Proxy SNat SNat SNat) + done = Types.tb @D3 @D5 @4 @4 @100 Proxy Proxy SNat expected + expected = $(Types.expected @D3 @D5 @4 @4 @100 Proxy Proxy SNat SNat SNat) {-# ANN tb0 (TestBench 'topEntity) #-} tb1 = done diff --git a/Xilinx/XpmCdcGrayTypes.hs b/Xilinx/XpmCdcGrayTypes.hs index 2862f84..d98eb9f 100644 --- a/Xilinx/XpmCdcGrayTypes.hs +++ b/Xilinx/XpmCdcGrayTypes.hs @@ -60,6 +60,6 @@ expected Proxy Proxy SNat SNat SNat = listToVecTH out1 (XpmCdcGrayConfig SNat True) (clockGen @a) (clockGen @b) - (fromList [0..]) + (fromList (cycle [0..])) out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/Xilinx/XpmCdcSingleTypes.hs b/Xilinx/XpmCdcSingleTypes.hs index 02ff264..24c33c7 100644 --- a/Xilinx/XpmCdcSingleTypes.hs +++ b/Xilinx/XpmCdcSingleTypes.hs @@ -9,6 +9,10 @@ import Data.Proxy import Language.Haskell.TH.Lib import Clash.Cores.Xilinx.Xpm.Cdc.Single +import XpmTestCommon + +testData :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 1) +testData = genTestData randomSeed tb :: forall a b stages n . @@ -28,17 +32,15 @@ tb :: Signal b Bool tb Proxy Proxy initVals regInput SNat expectedDat = done where - counter = delay clkA enableGen 0 (counter + 1) - actual = xpmCdcSingleWith @stages @(Unsigned 1) (XpmCdcSingleConfig SNat initVals regInput) - clkA clkB counter + clkA clkB (testData clkA) done = outputVerifierWith - (\clk rst -> assertBitVector clk rst "outputVerifier") + (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) clkB clkB noReset expectedDat (pack <$> actual) @@ -72,6 +74,6 @@ expected Proxy Proxy initVals regInput SNat SNat = listToVecTH out1 (XpmCdcSingleConfig SNat initVals regInput) (clockGen @a) (clockGen @b) - (fromList [0..]) + (testData clockGen) out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/Xilinx/XpmTestCommon.hs b/Xilinx/XpmTestCommon.hs index 3fb521d..1fed722 100644 --- a/Xilinx/XpmTestCommon.hs +++ b/Xilinx/XpmTestCommon.hs @@ -1,8 +1,30 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fforce-recomp #-} module XpmTestCommon where import Clash.Explicit.Prelude +import Language.Haskell.TH (runIO) +import System.Random + createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} + +randomSeed :: Int +randomSeed = $(runIO (randomIO @Int) >>= lift) + +genTestData :: forall dom a z. (KnownDomain dom, BitPack a, BitSize a <= 64) => Int -> Clock dom -> Signal dom a +genTestData seed clk = (unpack . truncateToSize . pack) <$> out + where + (out,gen) = unbundle $ genWord64 <$> delay clk enableGen (mkStdGen seed) gen + truncateToSize :: BitVector 64 -> BitVector (BitSize a) + truncateToSize = leToPlus @(BitSize a) @64 truncateB + +-- dummy implementation +instance NFDataX StdGen where + deepErrorX = errorX + hasUndefined = const False + ensureSpine = id + rnfX = const () From fbef76a9280a8394de05cab88def64e8239ea097 Mon Sep 17 00:00:00 2001 From: Martijn Bastiaan Date: Sun, 30 Apr 2023 11:40:43 +0200 Subject: [PATCH 32/36] Add `XPM_CDC_PULSE` to `clash-cores` --- Xilinx/XpmCdcPulse.hs | 70 ++++++++++++++++++++++++++++++++ Xilinx/XpmCdcPulseTypes.hs | 81 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 151 insertions(+) create mode 100644 Xilinx/XpmCdcPulse.hs create mode 100644 Xilinx/XpmCdcPulseTypes.hs diff --git a/Xilinx/XpmCdcPulse.hs b/Xilinx/XpmCdcPulse.hs new file mode 100644 index 0000000..1174ba0 --- /dev/null +++ b/Xilinx/XpmCdcPulse.hs @@ -0,0 +1,70 @@ +module XpmCdcPulse where + +import Clash.Explicit.Prelude + +import Data.Proxy + +import XpmTestCommon (D3, D5, D10, D11) + +import qualified XpmCdcPulseTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 + +tb0 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D3 @D5 @4 @100 Proxy Proxy False False True SNat expected + expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy False False True SNat SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} + +tb1 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D5 @D3 @4 @100 Proxy Proxy False True True SNat expected + expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy False True True SNat SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} + +tb2 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D3 @D5 @10 @100 Proxy Proxy True False False SNat expected + expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy True False False SNat SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} + +tb3 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D3 @D5 @2 @100 Proxy Proxy True True True SNat expected + expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy True True True SNat SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} + +tb4 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D5 @D10 @2 @100 Proxy Proxy False False True SNat expected + expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy False False True SNat SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} + +tb5 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D10 @D5 @2 @100 Proxy Proxy False True True SNat expected + expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy False True True SNat SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} + +tb6 = done + where + -- src dst stages samples init reg rstUsed + done = Types.tb @D5 @D11 @2 @100 Proxy Proxy True False True SNat expected + expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy True False True SNat SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} + +tb7 = done + where + -- src dst stages samples init reg + done = Types.tb @D11 @D5 @2 @100 Proxy Proxy True True True SNat expected + expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy True True True SNat SNat) +{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/Xilinx/XpmCdcPulseTypes.hs b/Xilinx/XpmCdcPulseTypes.hs new file mode 100644 index 0000000..3530d37 --- /dev/null +++ b/Xilinx/XpmCdcPulseTypes.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE BangPatterns #-} + +module XpmCdcPulseTypes where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +import Data.Proxy +import Language.Haskell.TH.Lib + +import Clash.Cores.Xilinx.Xpm.Cdc.Pulse +import XpmTestCommon + +testData :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 1) +testData clk = conditionTestData $ genTestData randomSeed clk + where + conditionTestData = id + +tb :: + forall a b stages n . + ( KnownNat n, 1 <= n + , KnownNat stages, 2 <= stages, stages <= 10 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> + -- | Initial values + Bool -> + -- | Registered output + Bool -> + SNat stages -> + -- | Expected data + Vec n (BitVector 1) -> + Signal b Bool +tb Proxy Proxy initVals regInput SNat expectedDat = done + where + actual = + xpmCdcPulseWith + @stages @(Unsigned 1) + (XpmCdcPulseConfig SNat initVals regInput) + clkA clkB (testData clkA) + + done = + outputVerifierWith + (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) + clkB clkB noReset + expectedDat + (pack <$> actual) + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b stages samples . + ( KnownDomain a + , KnownDomain b + , 2 <= stages, stages <= 10 + ) => + Proxy a -> + Proxy b -> + -- | Initial values + Bool -> + -- | Registered output + Bool -> + SNat stages -> + SNat samples -> + ExpQ +expected Proxy Proxy initVals regInput SNat SNat = listToVecTH out1 + where + out0 = + xpmCdcPulseWith + @stages @(Unsigned 1) + (XpmCdcPulseConfig SNat initVals regInput) + (clockGen @a) + (clockGen @b) + (testData clockGen) + + out1 = pack <$> sampleN (natToNum @samples) out0 From 868952f4e54b2ec2356d8222591de30f6874b3d5 Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Mon, 11 Dec 2023 18:32:55 +0100 Subject: [PATCH 33/36] Add resets to xpmCdcPulseWith --- Xilinx/XpmCdcPulseTypes.hs | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/Xilinx/XpmCdcPulseTypes.hs b/Xilinx/XpmCdcPulseTypes.hs index 3530d37..1d37f50 100644 --- a/Xilinx/XpmCdcPulseTypes.hs +++ b/Xilinx/XpmCdcPulseTypes.hs @@ -12,9 +12,13 @@ import Clash.Cores.Xilinx.Xpm.Cdc.Pulse import XpmTestCommon testData :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 1) -testData clk = conditionTestData $ genTestData randomSeed clk - where - conditionTestData = id +testData clk = genTestData (randomSeed+1) clk + +randomRstSrc :: KnownDomain dom => Clock dom -> Reset dom +randomRstSrc clk = unsafeFromActiveHigh $ genTestData (randomSeed+2) clk + +randomRstDst :: KnownDomain dom => Clock dom -> Reset dom +randomRstDst clk = unsafeFromActiveHigh $ genTestData (randomSeed+3) clk tb :: forall a b stages n . @@ -28,17 +32,19 @@ tb :: Bool -> -- | Registered output Bool -> + -- | Resets used + Bool -> SNat stages -> -- | Expected data Vec n (BitVector 1) -> Signal b Bool -tb Proxy Proxy initVals regInput SNat expectedDat = done +tb Proxy Proxy initVals regOutput rstUsed SNat expectedDat = done where actual = xpmCdcPulseWith @stages @(Unsigned 1) - (XpmCdcPulseConfig SNat initVals regInput) - clkA clkB (testData clkA) + (XpmCdcPulseConfig (SNat @stages) initVals regOutput rstUsed) + clkA rstA clkB rstB (testData clkA) done = outputVerifierWith @@ -46,6 +52,8 @@ tb Proxy Proxy initVals regInput SNat expectedDat = done clkB clkB noReset expectedDat (pack <$> actual) + rstA = randomRstSrc clkA + rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA -- Testbench clocks clkA :: Clock a @@ -65,17 +73,23 @@ expected :: Bool -> -- | Registered output Bool -> + -- | Resets used + Bool -> SNat stages -> SNat samples -> ExpQ -expected Proxy Proxy initVals regInput SNat SNat = listToVecTH out1 +expected Proxy Proxy initVals regOutput rstUsed SNat SNat = listToVecTH out1 where out0 = xpmCdcPulseWith @stages @(Unsigned 1) - (XpmCdcPulseConfig SNat initVals regInput) - (clockGen @a) - (clockGen @b) + (XpmCdcPulseConfig (SNat @stages) initVals regOutput rstUsed) + clkA rstA + clkB rstB (testData clockGen) + clkA = clockGen @a + clkB = clockGen @b + rstA = randomRstSrc clkA + rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA out1 = pack <$> sampleN (natToNum @samples) out0 From 77080f451f2511410843130edca0fc4c5468999a Mon Sep 17 00:00:00 2001 From: Leon Schoorl Date: Wed, 20 Dec 2023 16:08:26 +0100 Subject: [PATCH 34/36] Add xpmCdcSyncRst --- Xilinx/XpmCdcSyncRst.hs | 71 ++++++++++++++++++++++++++++++++ Xilinx/XpmCdcSyncRstTypes.hs | 79 ++++++++++++++++++++++++++++++++++++ 2 files changed, 150 insertions(+) create mode 100644 Xilinx/XpmCdcSyncRst.hs create mode 100644 Xilinx/XpmCdcSyncRstTypes.hs diff --git a/Xilinx/XpmCdcSyncRst.hs b/Xilinx/XpmCdcSyncRst.hs new file mode 100644 index 0000000..95d6704 --- /dev/null +++ b/Xilinx/XpmCdcSyncRst.hs @@ -0,0 +1,71 @@ +module XpmCdcSyncRst where + +import Clash.Explicit.Prelude + +import Data.Proxy + +import XpmTestCommon (D3, D5, D10, D11) + +import Clash.Cores.Xilinx.Xpm.Cdc.SyncRst (Asserted(..)) +import qualified XpmCdcSyncRstTypes as Types + +-- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot +-- find the test benches. +topEntity :: Unsigned 1 +topEntity = 0 + +tb0 = done + where + -- src dst stages samples init + done = Types.tb @D3 @D5 @4 @100 Proxy Proxy Nothing SNat expected + expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy Nothing SNat SNat) +{-# ANN tb0 (TestBench 'topEntity) #-} + +tb1 = done + where + -- src dst stages samples init + done = Types.tb @D5 @D3 @4 @100 Proxy Proxy Nothing SNat expected + expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy Nothing SNat SNat) +{-# ANN tb1 (TestBench 'topEntity) #-} + +tb2 = done + where + -- src dst stages samples init + done = Types.tb @D3 @D5 @10 @100 Proxy Proxy (Just Asserted) SNat expected + expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy (Just Asserted) SNat SNat) +{-# ANN tb2 (TestBench 'topEntity) #-} + +tb3 = done + where + -- src dst stages samples init + done = Types.tb @D3 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat expected + expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat SNat) +{-# ANN tb3 (TestBench 'topEntity) #-} + +tb4 = done + where + -- src dst stages samples init + done = Types.tb @D5 @D10 @2 @100 Proxy Proxy Nothing SNat expected + expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy Nothing SNat SNat) +{-# ANN tb4 (TestBench 'topEntity) #-} + +tb5 = done + where + -- src dst stages samples init + done = Types.tb @D10 @D5 @2 @100 Proxy Proxy Nothing SNat expected + expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy Nothing SNat SNat) +{-# ANN tb5 (TestBench 'topEntity) #-} + +tb6 = done + where + -- src dst stages samples init + done = Types.tb @D5 @D11 @2 @100 Proxy Proxy (Just Asserted) SNat expected + expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy (Just Asserted) SNat SNat) +{-# ANN tb6 (TestBench 'topEntity) #-} + +tb7 = done + where + -- src dst stages samples init + done = Types.tb @D11 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat expected + expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat SNat) +{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/Xilinx/XpmCdcSyncRstTypes.hs b/Xilinx/XpmCdcSyncRstTypes.hs new file mode 100644 index 0000000..f8a2bd7 --- /dev/null +++ b/Xilinx/XpmCdcSyncRstTypes.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE BangPatterns #-} + +module XpmCdcSyncRstTypes where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench + +import Data.Proxy +import Language.Haskell.TH.Lib + +import Clash.Cores.Xilinx.Xpm.Cdc.SyncRst +import XpmTestCommon + +randomRstSrc :: KnownDomain dom => Clock dom -> Reset dom +randomRstSrc clk = unsafeFromActiveHigh $ genTestData randomSeed clk + +tb :: + forall a b stages n . + ( KnownNat n, 1 <= n + , KnownNat stages, 2 <= stages, stages <= 10 + , KnownDomain a + , KnownDomain b + ) => + Proxy a -> Proxy b -> + -- | Initial values + Maybe Asserted -> + SNat stages -> + -- | Expected data + Vec n (BitVector 1) -> + Signal b Bool +tb Proxy Proxy initVals SNat expectedDat = done + where + actual = + xpmCdcSyncRstWith + @stages + (XpmCdcSyncRstConfig (SNat @stages) initVals) + clkA clkB (randomRstSrc clkA) + + done = + outputVerifierWith + (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) + clkB clkB noReset + expectedDat + (pack <$> unsafeToActiveHigh actual) + rstA = randomRstSrc clkA + rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA + + -- Testbench clocks + clkA :: Clock a + clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) + clkB :: Clock b + clkB = tbClockGen (not <$> done) + +expected :: + forall a b stages samples . + ( KnownDomain a + , KnownDomain b + , 2 <= stages, stages <= 10 + ) => + Proxy a -> + Proxy b -> + -- | Initial values + Maybe Asserted -> + SNat stages -> + SNat samples -> + ExpQ +expected Proxy Proxy initVals SNat SNat = listToVecTH out1 + where + out0 = unsafeToActiveHigh $ + xpmCdcSyncRstWith + @stages + (XpmCdcSyncRstConfig (SNat @stages) initVals) + clkA + clkB + (randomRstSrc clkA) + clkA = clockGen @a + clkB = clockGen @b + + out1 = pack <$> sampleN (natToNum @samples) out0 From b6cc60da9e2a36c258bbfff1bbaaf4e671095d1f Mon Sep 17 00:00:00 2001 From: Lucas Bollen Date: Sun, 7 Apr 2024 13:05:42 +0200 Subject: [PATCH 35/36] Add `Clash.Cores.Xilinx.Unisim.DnaPortE2` Co-authored-by: Martijn Bastiaan --- Xilinx/DnaPortE2.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 Xilinx/DnaPortE2.hs diff --git a/Xilinx/DnaPortE2.hs b/Xilinx/DnaPortE2.hs new file mode 100644 index 0000000..af95000 --- /dev/null +++ b/Xilinx/DnaPortE2.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP #-} + +module DnaPortE2 where + +import Clash.Explicit.Prelude +import Clash.Explicit.Testbench +import Clash.Cores.Xilinx.Unisim.DnaPortE2 + +topEntity :: + Clock XilinxSystem -> + Reset XilinxSystem -> + Signal XilinxSystem (Maybe (BitVector 96)) +topEntity clk rst = readDnaPortE2 clk rst enableGen simDna2 +{-# CLASH_OPAQUE topEntity #-} + +testBench :: Signal XilinxSystem Bool +testBench = done + where + expected = + ($(listToVecTH (sampleN 200 $ + readDnaPortE2 (clockGen @XilinxSystem) noReset enableGen simDna2))) + done = outputVerifier' clk rst expected (topEntity clk rst) + clk = tbClockGen (not <$> done) + rst = noReset +{-# CLASH_OPAQUE testBench #-} From e1d612d19057a854ca701edbeb8bc1b38b514a33 Mon Sep 17 00:00:00 2001 From: t-wallet Date: Mon, 26 Aug 2024 14:53:02 +0200 Subject: [PATCH 36/36] Move over relevant clash-testsuite tests --- clash-cores.cabal | 23 ++ nix/nixpkgs.nix | 16 +- nix/sources.json | 6 +- test/cores-testsuite.hs | 322 ++++++++++++++++++ .../Xilinx/VIO/DuplicateInputNames.hs | 0 .../Xilinx/VIO/DuplicateInputOutputNames.hs | 0 .../Xilinx/VIO/DuplicateOutputNames.hs | 0 .../Xilinx/VIO/InputBusWidthExceeded.hs | 0 .../Xilinx/VIO/InputProbesExceeded.hs | 0 .../Xilinx/VIO/OutputBusWidthExceeded.hs | 0 .../Xilinx/VIO/OutputProbesExceeded.hs | 0 .../shouldwork}/Xilinx/DcFifo/Basic.hs | 0 .../shouldwork}/Xilinx/DcFifo/Lfsr.hs | 0 .../shouldwork}/Xilinx/DnaPortE2.hs | 0 .../shouldwork}/Xilinx/Floating.hs | 0 .../Xilinx/Floating/Annotations.hs | 0 .../shouldwork}/Xilinx/Floating/TH.hs | 0 .../Cores => test/shouldwork}/Xilinx/Ila.hs | 0 .../Cores => test/shouldwork}/Xilinx/T2549.hs | 0 .../shouldwork}/Xilinx/TdpBlockRam.hs | 0 .../Cores => test/shouldwork}/Xilinx/VIO.hs | 0 .../shouldwork}/Xilinx/XpmCdcArraySingle.hs | 0 .../Xilinx/XpmCdcArraySingleTypes.hs | 0 .../shouldwork}/Xilinx/XpmCdcGray.hs | 0 .../shouldwork}/Xilinx/XpmCdcGrayTypes.hs | 0 .../shouldwork}/Xilinx/XpmCdcHandshake.hs | 0 .../Xilinx/XpmCdcHandshakeTypes.hs | 0 .../shouldwork}/Xilinx/XpmCdcPulse.hs | 0 .../shouldwork}/Xilinx/XpmCdcPulseTypes.hs | 0 .../shouldwork}/Xilinx/XpmCdcSingle.hs | 0 .../shouldwork}/Xilinx/XpmCdcSingleTypes.hs | 0 .../shouldwork}/Xilinx/XpmCdcSyncRst.hs | 0 .../shouldwork}/Xilinx/XpmCdcSyncRstTypes.hs | 0 .../shouldwork}/Xilinx/XpmTestCommon.hs | 0 34 files changed, 363 insertions(+), 4 deletions(-) create mode 100644 test/cores-testsuite.hs rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/DuplicateInputNames.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/DuplicateInputOutputNames.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/DuplicateOutputNames.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/InputBusWidthExceeded.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/InputProbesExceeded.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/OutputBusWidthExceeded.hs (100%) rename {tests/shouldfail/Cores => test/shouldfail}/Xilinx/VIO/OutputProbesExceeded.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/DcFifo/Basic.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/DcFifo/Lfsr.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/DnaPortE2.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/Floating.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/Floating/Annotations.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/Floating/TH.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/Ila.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/T2549.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/TdpBlockRam.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/VIO.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcArraySingle.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcArraySingleTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcGray.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcGrayTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcHandshake.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcHandshakeTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcPulse.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcPulseTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcSingle.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcSingleTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcSyncRst.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmCdcSyncRstTypes.hs (100%) rename {tests/shouldwork/Cores => test/shouldwork}/Xilinx/XpmTestCommon.hs (100%) diff --git a/clash-cores.cabal b/clash-cores.cabal index 163b805..a6177a4 100644 --- a/clash-cores.cabal +++ b/clash-cores.cabal @@ -235,3 +235,26 @@ test-suite doctests clash-cores, doctest-parallel >= 0.2 && < 0.4, filepath + +test-suite cores-testsuite + import: basic-config + hs-source-dirs: test + type: exitcode-stdio-1.0 + main-is: cores-testsuite.hs + + build-depends: + base, + data-default, + directory, + extra, + filepath, + ghc, + process, + tasty >= 1.5, + tasty-hunit, + text, + clash-cores, + clash-ghc, + clash-lib, + clash-prelude, + clash-testsuite diff --git a/nix/nixpkgs.nix b/nix/nixpkgs.nix index 884d8a5..303342e 100644 --- a/nix/nixpkgs.nix +++ b/nix/nixpkgs.nix @@ -23,7 +23,19 @@ let # Haskell overrides haskellPackages = pkgs.haskell.packages.${haskell_compiler}.override { overrides = self: super: { - # Add overrides here + # Ignore dependency bounds for tasty < 1.5 + cabal2nix = pkgs.haskell.lib.doJailbreak super.cabal2nix; + quickcheck-instances = pkgs.haskell.lib.doJailbreak super.quickcheck-instances; + aeson = pkgs.haskell.lib.doJailbreak super.aeson; + time-compat = pkgs.haskell.lib.doJailbreak super.time-compat; + indexed-traversable-instances = pkgs.haskell.lib.doJailbreak super.indexed-traversable-instances; + + tasty = super.tasty_1_5; + + # Required by clash-testsuite. The tests of singletons-base-3.2 are + # unfortunately broken, so we have to override it like this. + singletons-base = pkgs.haskell.lib.dontCheck super.singletons-base; + circuit-notation = self.callCabal2nix "circuit-notation" sources.circuit-notation {}; doctest-parallel = @@ -36,6 +48,8 @@ let self.callCabal2nix "clash-ghc" (sources.clash-compiler + "/clash-ghc") {}; clash-prelude-hedgehog = self.callCabal2nix "clash-prelude" (sources.clash-compiler + "/clash-prelude-hedgehog") {}; + clash-testsuite = + self.callCabal2nix "clash-testsuite" (sources.clash-compiler + "/tests") {}; tasty-hedgehog = self.callCabal2nix "tasty-hedgehog" sources.tasty-hedgehog {}; hedgehog = diff --git a/nix/sources.json b/nix/sources.json index 613a609..2902c90 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "https://clash-lang.org/", "owner": "clash-lang", "repo": "clash-compiler", - "rev": "aba55fed9f45711c8336935721a43d243f7f78c1", - "sha256": "1hrzp8g189v46qfr9ds7w6w0yj5w8y4im1pa3lf5vjx3z64v26qv", + "rev": "b14ff0ef2ccfad8854210a9035e9db1e32b3be07", + "sha256": "00gq0v4fi2dy13xchllxxhhjfpvvj0ig8cgp5y65c7zb7qw5b30y", "type": "tarball", - "url": "https://github.com/clash-lang/clash-compiler/archive/aba55fed9f45711c8336935721a43d243f7f78c1.tar.gz", + "url": "https://github.com/clash-lang/clash-compiler/archive/b14ff0ef2ccfad8854210a9035e9db1e32b3be07.tar.gz", "url_template": "https://github.com///archive/.tar.gz", "version": "1.8.1" }, diff --git a/test/cores-testsuite.hs b/test/cores-testsuite.hs new file mode 100644 index 0000000..919ab13 --- /dev/null +++ b/test/cores-testsuite.hs @@ -0,0 +1,322 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Prelude + +import Clash.Annotations.Primitive (HDL(..)) +import Data.Default (def) +import Data.List (intercalate) +import Data.List.Extra (trim) +import Data.Version (versionBranch) +import System.Directory + (getCurrentDirectory, doesDirectoryExist, makeAbsolute, setCurrentDirectory) +import System.Environment +import System.Info +import System.Process (readProcess) +import GHC.Conc (numCapabilities) +import GHC.Stack +import GHC.IO.Unsafe (unsafePerformIO) +import Text.Printf (printf) + +import Test.Tasty +import Test.Tasty.Clash + +-- | GHC version as major.minor.patch1. For example: 8.10.2. +ghcVersion3 :: String +ghcVersion3 = +#ifdef __GLASGOW_HASKELL_PATCHLEVEL2__ + let ghc_p1 = __GLASGOW_HASKELL_PATCHLEVEL1__ + ghc_p2 = __GLASGOW_HASKELL_PATCHLEVEL2__ in + case ghc_p2 of + 0 -> + intercalate "." (map show (versionBranch compilerVersion <> [ghc_p1])) + _ -> + intercalate "." (map show (versionBranch compilerVersion <> [ghc_p1,ghc_p2])) +#else + let ghc_p1 = __GLASGOW_HASKELL_PATCHLEVEL1__ in + intercalate "." (map show (versionBranch compilerVersion <> [ghc_p1])) +#endif + +-- Directory clash binary is expected to live in +cabalClashBinDir :: IO String +cabalClashBinDir = makeAbsolute rel_path + where + rel_path = printf templ platform ghcVersion3 (VERSION_clash_ghc :: String) + platform :: String -- XXX: Hardcoded + platform = case os of + "mingw32" -> arch <> "-windows" + _ -> arch <> "-" <> os + templ = "dist-newstyle/build/%s/ghc-%s/clash-ghc-%s/x/clash/build/clash/" :: String + +-- | Set GHC_PACKAGE_PATH for local Cabal install. Currently hardcoded for Unix; +-- override by setting @store_dir@ to point to local cabal installation. +setCabalPackagePaths :: IO () +setCabalPackagePaths = do + ch <- lookupEnv "store_dir" + storeDir <- case ch of + Just dir -> pure dir + Nothing -> case os of + "mingw32" -> pure "C:/cabal/store" -- default ghcup location + _ -> (<> "/.cabal/store") <$> getEnv "HOME" + here <- getCurrentDirectory + setEnv "GHC_PACKAGE_PATH" $ + storeDir <> "/ghc-" <> ghcVersion3 <> "/package.db" + <> ":" + <> here <> "/dist-newstyle/packagedb/ghc-" <> ghcVersion3 + <> ":" + +-- | See 'compiledWith' +data RunWith + = Stack + | Cabal + | Global + deriving (Show, Eq) + +-- | Detects Clash binary the testsuite should use (in order): +-- +-- * If USE_GLOBAL_CLASH=1, use globally installed Clash +-- * If STACK_EXE is present, use Stack's Clash +-- * If dist-newstyle is present, use Cabal's Clash +-- * Use globally installed Clash +-- +compiledWith :: RunWith +compiledWith = unsafePerformIO $ do + clash_global <- lookupEnv "USE_GLOBAL_CLASH" + stack_exe <- lookupEnv "STACK_EXE" + distNewstyleExists <- doesDirectoryExist "dist-newstyle" + + pure $ case (clash_global, stack_exe, distNewstyleExists) of + (Just "1", Just _, _ ) -> error "Can't use global clash with 'stack run'" + (Just "1", _, _ ) -> Global + (_, Just _, _ ) -> Stack + (_, _ , True) -> Cabal + (_, _ , _ ) -> Global +{-# NOINLINE compiledWith #-} + +-- | Set environment variables that allow Clash to be executed by simply calling +-- 'clash' without extra arguments. +setClashEnvs :: HasCallStack => RunWith -> IO () +setClashEnvs Global = setEnv "GHC_ENVIRONMENT" "-" +setClashEnvs Stack = pure () +setClashEnvs Cabal = do + binDir <- cabalClashBinDir + path <- getEnv "PATH" + let seperator = case os of { "mingw32" -> ";"; _ -> ":" } + setEnv "PATH" (binDir <> seperator <> path) + setCabalPackagePaths + +clashTestRoot + :: [[TestName] -> TestTree] + -> TestTree +clashTestRoot testTrees = + clashTestGroup "." testTrees [] + +-- | `clashTestGroup` and `clashTestRoot` make sure that each test knows its +-- fully qualified test name at construction time. This is used to pass -i flags +-- to Clash as the test layout matches the layout in @shouldwork/@. +clashTestGroup + :: TestName + -> [[TestName] -> TestTree] + -> ([TestName] -> TestTree) +clashTestGroup testName testTrees = + \parentNames -> + testGroup testName $ + zipWith ($) testTrees (repeat (testName : parentNames)) + +runClashTest :: IO () +runClashTest = defaultMain $ clashTestRoot + [ clashTestGroup "test" + [ clashTestGroup "shouldfail" + [ clashTestGroup "Xilinx" + [ clashTestGroup "VIO" + [ runTest "DuplicateOutputNames" def{ + hdlTargets=[VHDL] + , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") + } + , runTest "DuplicateInputNames" def{ + hdlTargets=[VHDL] + , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") + } + , runTest "DuplicateInputOutputNames" def{ + hdlTargets=[VHDL] + , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") + } + , runTest "OutputBusWidthExceeded" def{ + hdlTargets=[VHDL, Verilog, SystemVerilog] + , expectClashFail=Just (def, "Probe signals must be been between 1 and 256 bits wide.") + } + , runTest "OutputProbesExceeded" def{ + hdlTargets=[VHDL, Verilog, SystemVerilog] + , expectClashFail=Just (def, "At most 256 input/output probes are supported.") + } + , runTest "InputBusWidthExceeded" def{ + hdlTargets=[VHDL, Verilog, SystemVerilog] + , expectClashFail=Just (def, "Probe signals must be been between 1 and 256 bits wide.") + } + , runTest "InputProbesExceeded" def{ + hdlTargets=[VHDL, Verilog, SystemVerilog] + , expectClashFail=Just (def, "At most 256 input/output probes are supported.") + } + ] + ] + ] + , clashTestGroup "shouldwork" + [ clashTestGroup "Xilinx" + [ runTest "TdpBlockRam" def + { -- Compiling with VHDL gives: + -- https://github.com/clash-lang/clash-compiler/issues/2446 + hdlTargets = [Verilog] + , hdlLoad = [Vivado] + , hdlSim = [Vivado] + , clashFlags=["-fclash-hdlsyn", "Vivado"] + , buildTargets=BuildSpecific [ "normalWritesTB", "writeEnableWritesTB" ] + } + , let _opts = def{ hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + -- addShortPLTB now segfaults :-( + , buildTargets=BuildSpecific [ "addBasicTB" + , "addEnableTB" + -- , "addShortPLTB" + , "subBasicTB" + , "mulBasicTB" + , "divBasicTB" + , "compareBasicTB" + , "compareEnableTB" + , "fromUBasicTB" + , "fromUEnableTB" + , "fromSBasicTB" + , "fromSEnableTB" + ] + } + in runTest "Floating" _opts + , runTest "XpmCdcArraySingle" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] + } + , runTest "XpmCdcGray" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] + } + , runTest "XpmCdcHandshake" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..6]] + } + , runTest "XpmCdcPulse" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] + } + , runTest "XpmCdcSingle" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] + } + , runTest "XpmCdcSyncRst" $ def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] + } + , runTest "DnaPortE2" def + { hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + } + , clashTestGroup "DcFifo" + [ let _opts = + def{ hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + } + in runTest "Basic" _opts + , let _opts = def{ hdlTargets=[VHDL, Verilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific [ "testBench_17_2" + , "testBench_2_17" + , "testBench_2_2" + ] + } + in runTest "Lfsr" _opts + ] + , let _opts = + def{ hdlTargets=[VHDL, Verilog, SystemVerilog] + , hdlLoad=[Vivado] + , hdlSim=[Vivado] + , buildTargets=BuildSpecific [ "noInputTrue" + , "noInputFalse" + , "noInputLow" + , "noInputHigh" + , "noInputSigned" + , "noInputUnsigned" + , "noInputBitVector" + , "noInputPair" + , "noInputVec" + , "noInputCustom" + , "noInputNested" + , "singleInputBool" + , "singleInputBit" + , "singleInputSigned" + , "singleInputUnsigned" + , "singleInputBitVector" + , "singleInputPair" + , "singleInputVec" + , "singleInputCustom" + , "singleInputNested" + , "multipleInputs" + , "inputsAndOutputs" + , "withSetName" + , "withSetNameNoResult" + ] + } + 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"] + } + , runTest "T2549" def{hdlTargets=[Verilog],hdlSim=[]} + ] + ] -- end shouldwork + ] + ] -- end . + +main :: IO () +main = do + projectRoot <- trim <$> readProcess "git" ["rev-parse", "--show-toplevel"] "" + setCurrentDirectory projectRoot + setEnv "TASTY_NUM_THREADS" (show numCapabilities) + setClashEnvs compiledWith + runClashTest diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputNames.hs b/test/shouldfail/Xilinx/VIO/DuplicateInputNames.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputNames.hs rename to test/shouldfail/Xilinx/VIO/DuplicateInputNames.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputOutputNames.hs b/test/shouldfail/Xilinx/VIO/DuplicateInputOutputNames.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputOutputNames.hs rename to test/shouldfail/Xilinx/VIO/DuplicateInputOutputNames.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateOutputNames.hs b/test/shouldfail/Xilinx/VIO/DuplicateOutputNames.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/DuplicateOutputNames.hs rename to test/shouldfail/Xilinx/VIO/DuplicateOutputNames.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/InputBusWidthExceeded.hs b/test/shouldfail/Xilinx/VIO/InputBusWidthExceeded.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/InputBusWidthExceeded.hs rename to test/shouldfail/Xilinx/VIO/InputBusWidthExceeded.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/InputProbesExceeded.hs b/test/shouldfail/Xilinx/VIO/InputProbesExceeded.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/InputProbesExceeded.hs rename to test/shouldfail/Xilinx/VIO/InputProbesExceeded.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/OutputBusWidthExceeded.hs b/test/shouldfail/Xilinx/VIO/OutputBusWidthExceeded.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/OutputBusWidthExceeded.hs rename to test/shouldfail/Xilinx/VIO/OutputBusWidthExceeded.hs diff --git a/tests/shouldfail/Cores/Xilinx/VIO/OutputProbesExceeded.hs b/test/shouldfail/Xilinx/VIO/OutputProbesExceeded.hs similarity index 100% rename from tests/shouldfail/Cores/Xilinx/VIO/OutputProbesExceeded.hs rename to test/shouldfail/Xilinx/VIO/OutputProbesExceeded.hs diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs b/test/shouldwork/Xilinx/DcFifo/Basic.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs rename to test/shouldwork/Xilinx/DcFifo/Basic.hs diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs b/test/shouldwork/Xilinx/DcFifo/Lfsr.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs rename to test/shouldwork/Xilinx/DcFifo/Lfsr.hs diff --git a/tests/shouldwork/Cores/Xilinx/DnaPortE2.hs b/test/shouldwork/Xilinx/DnaPortE2.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/DnaPortE2.hs rename to test/shouldwork/Xilinx/DnaPortE2.hs diff --git a/tests/shouldwork/Cores/Xilinx/Floating.hs b/test/shouldwork/Xilinx/Floating.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/Floating.hs rename to test/shouldwork/Xilinx/Floating.hs diff --git a/tests/shouldwork/Cores/Xilinx/Floating/Annotations.hs b/test/shouldwork/Xilinx/Floating/Annotations.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/Floating/Annotations.hs rename to test/shouldwork/Xilinx/Floating/Annotations.hs diff --git a/tests/shouldwork/Cores/Xilinx/Floating/TH.hs b/test/shouldwork/Xilinx/Floating/TH.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/Floating/TH.hs rename to test/shouldwork/Xilinx/Floating/TH.hs diff --git a/tests/shouldwork/Cores/Xilinx/Ila.hs b/test/shouldwork/Xilinx/Ila.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/Ila.hs rename to test/shouldwork/Xilinx/Ila.hs diff --git a/tests/shouldwork/Cores/Xilinx/T2549.hs b/test/shouldwork/Xilinx/T2549.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/T2549.hs rename to test/shouldwork/Xilinx/T2549.hs diff --git a/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs b/test/shouldwork/Xilinx/TdpBlockRam.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs rename to test/shouldwork/Xilinx/TdpBlockRam.hs diff --git a/tests/shouldwork/Cores/Xilinx/VIO.hs b/test/shouldwork/Xilinx/VIO.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/VIO.hs rename to test/shouldwork/Xilinx/VIO.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingle.hs b/test/shouldwork/Xilinx/XpmCdcArraySingle.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcArraySingle.hs rename to test/shouldwork/Xilinx/XpmCdcArraySingle.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs b/test/shouldwork/Xilinx/XpmCdcArraySingleTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs rename to test/shouldwork/Xilinx/XpmCdcArraySingleTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcGray.hs b/test/shouldwork/Xilinx/XpmCdcGray.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcGray.hs rename to test/shouldwork/Xilinx/XpmCdcGray.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs b/test/shouldwork/Xilinx/XpmCdcGrayTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs rename to test/shouldwork/Xilinx/XpmCdcGrayTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshake.hs b/test/shouldwork/Xilinx/XpmCdcHandshake.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcHandshake.hs rename to test/shouldwork/Xilinx/XpmCdcHandshake.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs b/test/shouldwork/Xilinx/XpmCdcHandshakeTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs rename to test/shouldwork/Xilinx/XpmCdcHandshakeTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcPulse.hs b/test/shouldwork/Xilinx/XpmCdcPulse.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcPulse.hs rename to test/shouldwork/Xilinx/XpmCdcPulse.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcPulseTypes.hs b/test/shouldwork/Xilinx/XpmCdcPulseTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcPulseTypes.hs rename to test/shouldwork/Xilinx/XpmCdcPulseTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSingle.hs b/test/shouldwork/Xilinx/XpmCdcSingle.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcSingle.hs rename to test/shouldwork/Xilinx/XpmCdcSingle.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs b/test/shouldwork/Xilinx/XpmCdcSingleTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs rename to test/shouldwork/Xilinx/XpmCdcSingleTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRst.hs b/test/shouldwork/Xilinx/XpmCdcSyncRst.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcSyncRst.hs rename to test/shouldwork/Xilinx/XpmCdcSyncRst.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRstTypes.hs b/test/shouldwork/Xilinx/XpmCdcSyncRstTypes.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmCdcSyncRstTypes.hs rename to test/shouldwork/Xilinx/XpmCdcSyncRstTypes.hs diff --git a/tests/shouldwork/Cores/Xilinx/XpmTestCommon.hs b/test/shouldwork/Xilinx/XpmTestCommon.hs similarity index 100% rename from tests/shouldwork/Cores/Xilinx/XpmTestCommon.hs rename to test/shouldwork/Xilinx/XpmTestCommon.hs