diff --git a/bittide/src/Bittide/DoubleBufferedRAM.hs b/bittide/src/Bittide/DoubleBufferedRAM.hs index 3c9004d5a..58d4bb812 100644 --- a/bittide/src/Bittide/DoubleBufferedRAM.hs +++ b/bittide/src/Bittide/DoubleBufferedRAM.hs @@ -13,7 +13,7 @@ module Bittide.DoubleBufferedRAM where import Clash.Prelude import Contranomy.Wishbone - +import Data.Maybe import Bittide.SharedTypes -- | The double buffered RAM component is a memory component that internally uses a single -- blockRam, but enables the user to write to one part of the ram and read from another. @@ -99,9 +99,14 @@ blockRamByteAddressable initRAM readAddr newEntry byteSelect = writeBytes = unbundle $ splitWriteInBytes <$> newEntry <*> byteSelect readBytes = bundle $ (`blockRam` readAddr) <$> initBytes <*> writeBytes --- | register with wishbone interface, the third argument determines the source of the --- output signal. If the third argument is Just (Signal dom a), writing from the wishbone --- bus to the register is not possible. +data RegisterWritePriority = CircuitPriority | WishbonePriority + +-- | register with additional wishbone interface, this component has a configurable +-- priority that determines which value gets stored in the register during a write conflict. +-- With 'CircuitPriority', the incoming value in the fourth argument gets stored on a +-- collision and the wishbone bus gets acknowledged, but the value is silently ignored. +-- With 'WishbonePriority', the incoming wishbone write gets accepted and the value in the +-- fourth argument gets ignored. registerWB :: forall dom a bs aw . ( HiddenClockResetEnable dom @@ -111,58 +116,52 @@ registerWB :: , 1 <= bs , KnownNat aw , 2 <= aw) => + -- | Determines the write priority on write collisions + RegisterWritePriority -> + -- | Initial value. a -> + -- | Wishbone bus (master to slave) Signal dom (WishboneM2S bs aw) -> - Maybe (Signal dom a) -> + -- | New circuit value. + Signal dom (Maybe a) -> + -- | + -- 1. Outgoing stored value + -- 2. Outgoing wishbone bus (slave to master) (Signal dom a, Signal dom (WishboneS2M bs)) -registerWB initVal wbIn (Just newVal) = unbundle . mealy go initVal $ bundle (newVal, wbIn) - where - go :: a -> (a, WishboneM2S bs aw) -> (a, (a, WishboneS2M bs)) - go val1 (val0, WishboneM2S{..}) = (val0, (val1, WishboneS2M{acknowledge, err, readData})) - where - (alignedAddress, alignment) = split @_ @(aw - 2) @2 addr - wordAligned = alignment == 0 - addressRange = maxBound :: Index (Regs a (bs * 8)) - - err = (alignedAddress > resize (pack addressRange)) || - not wordAligned || - writeEnable - acknowledge = not err && strobe && busCycle - - wbAddr :: Index (Regs a (bs * 8)) - wbAddr = unpack . resize $ pack alignedAddress - - readData = case paddedToRegisters $ Padded val1 of - RegisterBank vec -> vec !! wbAddr - -registerWB initVal wbIn Nothing = (regOut, wbOut) +registerWB writePriority initVal wbIn sigIn = (regOut, wbOut) where - regOut = andEnable (writeEnable <$> wbIn) $ registerByteAddressable initVal (repeatedBVsAsData <$> wbIn) byteEnables - repeatedBVsAsData = registersToData . RegisterBank . repeat . writeData - (byteEnables, wbOut) = unbundle $ go <$> regOut <*> wbIn - + regOut = registerByteAddressable initVal regIn byteEnables + (byteEnables, wbOut, regIn) = unbundle (go <$> regOut <*> sigIn <*> wbIn) go :: a -> + Maybe a -> WishboneM2S bs aw -> - (BitVector (Regs a 8), WishboneS2M bs) - go val WishboneM2S{..} = (resize $ pack byteEnables0, WishboneS2M{acknowledge, err, readData}) + (BitVector (Regs a 8), WishboneS2M bs, a) + go regOut0 sigIn0 WishboneM2S{..} = (byteEnables0, WishboneS2M{acknowledge, err, readData}, regIn0) where (alignedAddress, alignment) = split @_ @(aw - 2) @2 addr - wordAligned = alignment == 0 addressRange = maxBound :: Index (Regs a (bs * 8)) - - err = (alignedAddress > resize (pack addressRange)) || - not wordAligned || - writeEnable - acknowledge = not err && strobe && busCycle - - wbAddr :: Index (Regs a (bs * 8)) - wbAddr = unpack . resize $ pack alignedAddress - byteEnables0 = reverse $ replace wbAddr busSelect (repeat @(Regs a (bs*8)) 0) - readData = case paddedToRegisters $ Padded val of + invalidAddress = (alignedAddress > resize (pack addressRange)) || not (alignment == 0) + masterActive = strobe && busCycle + err = masterActive && invalidAddress + acknowledge = masterActive && not err + wbWriting = writeEnable && acknowledge + wbAddr = unpack . resize $ pack alignedAddress :: Index (Regs a (bs * 8)) + readData = case paddedToRegisters $ Padded regOut0 of RegisterBank vec -> vec !! wbAddr --- | Register similar to 'register' with the addition that it takes a byte select signal + wbByteEnables = + resize . pack . reverse $ replace wbAddr busSelect (repeat @(Regs a (bs*8)) 0) + sigRegIn = fromMaybe (errorX "registerWB: sigIn is Nothing when Just is expected.") sigIn0 + wbRegIn = registersToData . RegisterBank $ repeat writeData + (byteEnables0, regIn0) = case (writePriority, isJust sigIn0, wbWriting) of + (CircuitPriority , True , _) -> (maxBound, sigRegIn) + (CircuitPriority , False, True) -> (wbByteEnables, wbRegIn) + (WishbonePriority, _ , True) -> (wbByteEnables, wbRegIn) + (WishbonePriority, True , False) -> (maxBound, sigRegIn) + (_ , False, False) -> (0, errorX "registerWB: register input not defined.") + +-- | Registor similar to 'register' with the addition that it takes a byte select signal -- that controls which bytes are updated. registerByteAddressable :: forall dom a . diff --git a/bittide/tests/Tests/DoubleBufferedRAM.hs b/bittide/tests/Tests/DoubleBufferedRAM.hs index a03a22f0d..26b80f270 100644 --- a/bittide/tests/Tests/DoubleBufferedRAM.hs +++ b/bittide/tests/Tests/DoubleBufferedRAM.hs @@ -3,14 +3,15 @@ -- SPDX-License-Identifier: Apache-2.0 {-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} -{-# OPTIONS_GHC -freduction-depth=1000 #-} -{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=7 #-} + {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} module Tests.DoubleBufferedRAM(ramGroup) where import Clash.Prelude @@ -20,6 +21,7 @@ import Clash.Hedgehog.Sized.Unsigned import Data.Maybe +import qualified Clash.Sized.Vector as V import Hedgehog import Hedgehog.Range as Range import Test.Tasty @@ -54,8 +56,15 @@ ramGroup = testGroup "DoubleBufferedRAM group" "doubleBufferedRAMByteAddressable1" doubleBufferedRAMByteAddressable1 , testPropertyNamed "Byte addressable register can be written to and read from with byte enables." "readWriteRegisterByteAddressable" readWriteRegisterByteAddressable - , testPropertyNamed "registerWB can be written to and read from with byte enables." - "registerWBWriteWishbone" registerWBWriteWishbone] + , testPropertyNamed "registerWB function as a normal register." + "registerWBSigToSig" registerWBSigToSig + , testPropertyNamed "registerWB can be written to with wishbone." + "registerWBWBToSig" registerWBWBToSig + , testPropertyNamed "registerWB can be read from with wishbone." + "registerWBSigToWB" registerWBSigToWB + , testPropertyNamed "registerWB write conflict resolution matches set priorities" + "registerWBWriteCollisions" registerWBWriteCollisions + ] genRamContents :: (MonadGen m, Integral i) => i -> m a -> m (SomeVec 1 a) genRamContents depth = genSomeVec (Range.singleton $ fromIntegral (depth - 1)) @@ -267,14 +276,40 @@ readWriteRegisterByteAddressable = property $ do simOut === P.take simLength expectedOut _ -> error "readWriteRegisterByteAddressable: Amount of bytes not equal to registers required." --- | -registerWBWriteWishbone :: Property -registerWBWriteWishbone = property $ do +registerWBSigToSig :: Property +registerWBSigToSig = property $ do + bits <- forAll $ Gen.enum 1 100 + case TN.someNatVal bits of + SomeNat p -> case compareSNat d1 (snatProxy p) of + SNatLE -> go p + _ -> error "registerWBSigToSig: Amount of bits == 0." + where + go :: forall bits m . (KnownNat bits, 1 <= bits, Monad m) => Proxy bits -> PropertyT m () + go Proxy = case compareSNat d1 $ SNat @(Regs (BitVector bits) 32) of + SNatLE -> do + initVal <- forAll $ genDefinedBitVector @_ @bits + writes <- forAll $ Gen.list (Range.constant 1 25) $ genDefinedBitVector @_ @bits + let + simLength = L.length writes + 1 + someReg prio sigIn = fst $ withClockResetEnable clockGen resetGen enableGen $ registerWB @_ @_ @4 @32 prio initVal (pure $ wishboneM2S SNat SNat) sigIn + topEntity sigIn = bundle (someReg CircuitPriority sigIn, someReg WishbonePriority sigIn) + topEntityInput = (Just <$> writes) <> [Nothing] + simOut = simulateN @System simLength topEntity topEntityInput + (fstOut, sndOut) = L.unzip simOut + footnote . fromString $ "simOut: " <> showX simOut + footnote . fromString $ "input:" <> showX topEntityInput + footnote . fromString $ "expected" <> showX writes + fstOut === sndOut + writes === L.tail fstOut + _ -> error "registerWBSigToSig: Registers required to store bitvector == 0." + +registerWBWBToSig :: Property +registerWBWBToSig = property $ do bits <- forAll $ Gen.enum 1 100 case TN.someNatVal bits of SomeNat p -> case compareSNat d1 (snatProxy p) of SNatLE -> go p - _ -> error "registerWBWriteWishbone: Amount of bits == 0." + _ -> error "registerWBWBToSig: Amount of bits == 0." where go :: forall bits m . (KnownNat bits, 1 <= bits, Monad m) => Proxy bits -> PropertyT m () go Proxy = case compareSNat d1 $ SNat @(Regs (BitVector bits) 32) of @@ -283,18 +318,22 @@ registerWBWriteWishbone = property $ do initVal <- forAll $ genDefinedBitVector @_ @bits writes <- forAll $ Gen.list (Range.constant 1 25) $ genDefinedBitVector @_ @bits let - simLength = L.length writes * regs + 1 - topEntity wbIn = fst $ withClockResetEnable clockGen resetGen enableGen $ - registerWB @System @_ @4 @32 initVal wbIn Nothing + simLength = L.length writes * regs + 2 + someReg prio wbIn = fst $ withClockResetEnable clockGen resetGen enableGen $ + registerWB @System @_ @4 @32 prio initVal wbIn (pure Nothing) + topEntity wbIn = bundle (someReg CircuitPriority wbIn, someReg WishbonePriority wbIn) topEntityInput = L.concatMap wbWrite writes <> L.repeat idleM2S - simOut = L.tail $ simulateN simLength topEntity topEntityInput - filteredOut = everyNth regs simOut + simOut = simulateN simLength topEntity topEntityInput + (fstOut, sndOut) = L.unzip simOut + filteredOut = everyNth regs $ L.tail fstOut + footnote . fromString $ "simOut: " <> showX simOut footnote . fromString $ "filteredOut:" <> showX filteredOut footnote . fromString $ "input:" <> showX (L.take simLength topEntityInput) footnote . fromString $ "expected" <> showX writes - writes === filteredOut - _ -> error "registerWBWriteWishbone: Registers required to store bitvector == 0." + fstOut === sndOut + writes === L.take (L.length writes) filteredOut + _ -> error "registerWBWBToSig: Registers required to store bitvector == 0." where wbWrite v = L.zipWith bv2WbWrite (L.reverse [0.. L.length l - 1]) l where @@ -304,6 +343,95 @@ registerWBWriteWishbone = property $ do where (x:xs) = L.drop (n-1) l +registerWBSigToWB :: Property +registerWBSigToWB = property $ do + bits <- forAll $ Gen.enum 1 100 + case TN.someNatVal bits of + SomeNat p -> case compareSNat d1 (snatProxy p) of + SNatLE -> go p + _ -> error "registerWBSigToWB: Amount of bits == 0." + where + go :: forall bits m . (KnownNat bits, 1 <= bits, Monad m) => Proxy bits -> PropertyT m () + go Proxy = case compareSNat d1 $ SNat @(Regs (BitVector bits) 32) of + SNatLE -> do + initVal <- forAll $ genDefinedBitVector @_ @bits + writes <- forAll $ Gen.list (Range.constant 1 25) $ genDefinedBitVector @_ @bits + let + someReg prio sigIn wbIn = snd $ withClockResetEnable clockGen resetGen enableGen $ registerWB @_ @_ @4 @32 prio initVal wbIn sigIn + topEntity (unbundle -> (sigIn, wbIn)) = bundle (someReg CircuitPriority sigIn wbIn, someReg WishbonePriority sigIn wbIn) + padWrites x = L.take (natToNum @(Regs (BitVector bits) 32)) $ Just x : L.repeat Nothing + readOps = idleM2S : cycle (fmap wbRead [(0 :: Int).. (natToNum @(Regs (BitVector bits) 32)-1)]) + topEntityInput = L.zip (L.concatMap padWrites writes <> [Nothing]) readOps + simLength = L.length topEntityInput + simOut = simulateN @System simLength topEntity topEntityInput + (fstOut, sndOut) = L.unzip simOut + footnote . fromString $ "simOut: " <> showX simOut + footnote . fromString $ "input:" <> showX topEntityInput + footnote . fromString $ "expected" <> showX writes + postProcWB fstOut === postProcWB sndOut + writes === wbDecoding (L.tail fstOut) + _ -> error "registerWBSigToWB: Registers required to store bitvector == 0." + where + wbDecoding :: ([WishboneS2M 4] -> [BitVector bits]) + wbDecoding (wbNow:wbRest) + | acknowledge wbNow = entry : wbDecoding rest + | otherwise = wbDecoding wbRest + where + (fmap readData -> entryList, rest) = L.splitAt (natToNum @(Regs (BitVector bits) 32)) (wbNow:wbRest) + entry = case V.fromList entryList of + Just (vec :: Vec (Regs (BitVector bits) 32) (BitVector 32)) -> registersToData @(BitVector bits) @32 (RegisterBank vec) + Nothing -> error $ "wbDecoding: list to vector conversion failed: " <> show entryList <> "from " <> show (wbNow:wbRest) + + wbDecoding [] = [] + wbRead i = (wishboneM2S @4 @32 SNat SNat) + { addr = resize (pack i) ++# (0b00 :: BitVector 2) + , busCycle = True + , strobe = True + } + postProcWB (WishboneS2M{..} : wbRest) + | acknowledge = Just readData : postProcWB wbRest + | err = Nothing : postProcWB wbRest + | otherwise = postProcWB wbRest + postProcWB _ = [] + + +registerWBWriteCollisions :: Property +registerWBWriteCollisions = property $ do + bits <- forAll $ Gen.enum 1 32 + case TN.someNatVal bits of + SomeNat p -> case compareSNat d1 (snatProxy p) of + SNatLE -> go p + _ -> error "registerWBWriteCollisions: Amount of bits == 0." + where + go :: forall bits m . (KnownNat bits, 1 <= bits, Monad m) => Proxy bits -> PropertyT m () + go Proxy = case compareSNat d1 $ SNat @(Regs (BitVector bits) 32) of + SNatLE -> do + initVal <- forAll $ genDefinedBitVector @_ @bits + writeAmount <- forAll $ Gen.enum 1 25 + sigWrites <- forAll $ Gen.list (Range.singleton writeAmount) $ genDefinedBitVector @_ @bits + wbWrites <- forAll $ Gen.list (Range.singleton writeAmount) $ genDefinedBitVector @_ @bits + let + simLength = writeAmount + 1 + someReg prio sigIn wbIn = fst $ withClockResetEnable clockGen resetGen enableGen $ + registerWB @System @_ @4 @32 prio initVal wbIn sigIn + topEntity (unbundle -> (sigIn, wbIn)) = bundle (someReg CircuitPriority sigIn wbIn, someReg WishbonePriority sigIn wbIn) + topEntityInput = L.zip (Just <$> sigWrites) (L.concatMap wbWrite wbWrites <> L.repeat idleM2S) + simOut = simulateN simLength topEntity topEntityInput + (fstOut, sndOut) = L.unzip simOut + + footnote . fromString $ "WishbonePrio out: " <> showX sndOut + footnote . fromString $ "CircuitPrio out: " <> showX fstOut + footnote . fromString $ "input:" <> showX (L.take simLength topEntityInput) + footnote . fromString $ "wbIn" <> showX wbWrites + footnote . fromString $ "sigIn" <> showX sigWrites + sigWrites === L.tail fstOut + wbWrites === L.tail sndOut + _ -> error "registerWBWriteCollisions: Registers required to store bitvector == 0." + where + wbWrite v = L.zipWith bv2WbWrite (L.reverse [0.. L.length l - 1]) l + where + RegisterBank (toList -> l) = paddedToRegisters $ Padded v + bv2WbWrite :: (BitPack a, Enum a) => a -> ("DAT_MOSI" ::: BitVector 32) @@ -313,6 +441,7 @@ bv2WbWrite i v = (wishboneM2S @4 @32 SNat SNat) , writeData = v , writeEnable = True , busCycle = True + , strobe = True , busSelect = maxBound }