Added registerWB tests and documentation

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 .

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
   }