add byte addressable register

bittide/src/Bittide/DoubleBufferedRAM.hs

@@ -92,6 +92,23 @@ blockRamByteAddressable initRAM readAddr newEntry byteSelect =
    writeBytes = unbundle $ splitWriteInBytes <$> newEntry <*> byteSelect
    readBytes = bundle $ (`blockRam` readAddr) <$> initBytes <*> writeBytes
 
+registerByteAddressable ::
+  forall dom a .
+  (HiddenClockResetEnable dom, Paddable a) =>
+  a ->
+  Signal dom a ->
+  Signal dom (ByteEnable (Regs a 8)) ->
+  Signal dom a
+registerByteAddressable initVal newVal byteEnables =
+  registersToData @_ @8 . RegisterBank <$> bundle regsOut
+ where
+  initBytes = getRegs initVal
+  newBytes = unbundle $ getRegs <$> newVal
+  regsOut = (`andEnable` register) <$> unbundle (unpack <$> byteEnables) <*> initBytes <*> newBytes
+  getRegs x =
+    case paddedToRegisters @8 $ Padded x of
+      RegisterBank vec -> vec
+
 splitWriteInBytes :: forall maxIndex writeData .
   (Paddable writeData) =>
   WriteAny maxIndex writeData ->

bittide/tests/Tests/DoubleBufferedRAM.hs

@@ -10,6 +10,9 @@ Maintainer:          [email protected]
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Tests.DoubleBufferedRAM(ramGroup) where
 
 import Clash.Prelude
@@ -28,15 +31,18 @@ import qualified Data.List as L
 import qualified Data.Set as Set
 import qualified GHC.TypeNats as TN
 import qualified Prelude as P
+import Data.Proxy
+import Data.Type.Equality (type (:~:)(Refl))
 
 deriving instance (Show a) => Show (SomeVec 1 a)
 
 ramGroup :: TestTree
 ramGroup = testGroup "DoubleBufferedRAM group"
   [ testPropertyNamed "Reading the buffer." "readDoubleBufferedRAM" readDoubleBufferedRAM
-  , testPropertyNamed "Wriing and reading back buffers." "readWriteDoubleBufferedRAM" readWriteDoubleBufferedRAM
+  , testPropertyNamed "Writing and reading back buffers." "readWriteDoubleBufferedRAM" readWriteDoubleBufferedRAM
   , testPropertyNamed "Byte addressable blockram matches behavorial model." "readWriteByteAddressableBlockram" readWriteByteAddressableBlockram
-  , testPropertyNamed "Byte addressable double buffered RAM matches behavorial model." "readWriteByteAddressableDoubleBufferedRAM" readWriteByteAddressableDoubleBufferedRAM]
+  , testPropertyNamed "Byte addressable double buffered RAM matches behavorial model." "readWriteByteAddressableDoubleBufferedRAM" readWriteByteAddressableDoubleBufferedRAM
+  , testPropertyNamed "Byte addressable register can be written to and read from with byte enables." "readWriteRegisterByteAddressable" readWriteRegisterByteAddressable]
 
 genRamContents :: (MonadGen m, Integral i) => i -> m a -> m (SomeVec 1 a)
 genRamContents depth = genSomeVec (Range.singleton $ fromIntegral (depth - 1))
@@ -148,6 +154,35 @@ readWriteByteAddressableDoubleBufferedRAM = property $ do
         (_,expectedOut) = L.mapAccumL byteAddressableDoubleBufferedRAMBehaviour (L.head topEntityInput, contents, contents) $ L.tail topEntityInput
       L.drop 2 simOut === L.tail expectedOut
 
+readWriteRegisterByteAddressable :: Property
+readWriteRegisterByteAddressable = property $ do
+  bytes <- forAll $ Gen.enum 1 10
+  case TN.someNatVal bytes of
+    SomeNat p -> case compareSNat d1 (snatProxy p) of
+      SNatLE -> go p
+      _ -> error "readWriteRegisterByteAddressable: Amount of bytes == 0."
+ where
+  go :: forall bytes m . (AtLeastOne bytes, AtLeastOne (bytes*8), Monad m) => Proxy bytes -> PropertyT m ()
+  go Proxy =
+    case sameNat (Proxy @bytes) (Proxy @(Regs (Vec bytes Byte) 8)) of
+      Just Refl -> do
+        simLength <- forAll $ Gen.enum 1 100
+        let
+          writeGen = genNonEmptyVec @_ @bytes $ genDefinedBitVector @_ @8
+        initVal <- forAll writeGen
+        writes <- forAll $ Gen.list (Range.singleton simLength) writeGen
+        byteEnables <- forAll $ Gen.list (Range.singleton simLength) $ genDefinedBitVector @_ @(Regs (Vec bytes Byte) 8)
+        let
+          topEntity (unbundle -> (newVal, byteEnable))=
+            withClockResetEnable @System clockGen resetGen enableGen $
+            registerByteAddressable initVal newVal byteEnable
+          expectedOut = P.scanl simFunc initVal $ P.zip writes byteEnables
+          simFunc olds (news,unpack -> bools) = (\(bool,old,new) -> if bool then new else old) <$> zip3 bools olds news
+          simOut = simulateN simLength topEntity $ P.zip writes byteEnables
+        simOut === P.take simLength expectedOut
+      _ -> error "readWriteRegisterByteAddressable: Amount of bytes not equal to registers required."
+
+
 byteAddressableRAMBehaviour :: forall bits depth bytes .
   (AtLeastOne depth, AtLeastOne bytes, bytes ~ Regs (BitVector bits) 8, AtLeastOne bits) =>
   ((Index depth, WriteBits depth bits, ByteEnable bytes), Vec depth (BitVector bits))->