PacketStream: support zero-byte transfers. (#122)

* Support zero-byte transfers
* Add utility that merges trailing zero-byte transfers
* Make PacketStream test framework more flexible
Now allows users to:
- Set the distribution of abort generation themselves;
- Choose whether to generate zero-byte packets;
- Choose whether to generate trailing zero-byte transfers.
* Converters: remove expensive operations
`mod` and `*` are removed.

clash-protocols/clash-protocols.cabal

@@ -202,6 +202,7 @@ test-suite unittests
     Tests.Protocols.Wishbone
     Tests.Protocols.PacketStream
     Tests.Protocols.PacketStream.AsyncFifo
+    Tests.Protocols.PacketStream.Base
     Tests.Protocols.PacketStream.Converters
     Tests.Protocols.PacketStream.Delay
     Tests.Protocols.PacketStream.Depacketizers

clash-protocols/src/Protocols/PacketStream/Base.hs

@@ -24,6 +24,7 @@ module Protocols.PacketStream.Base (
   fanout,
   forceResetSanity,
   zeroOutInvalidBytesC,
+  stripTrailingEmptyC,
   unsafeAbortOnBackpressureC,
 
   -- * Skid buffers
@@ -82,9 +83,11 @@ Heavily inspired by the M2S data of AMBA AXI4-Stream, but simplified:
 data PacketStreamM2S (dataWidth :: Nat) (meta :: Type) = PacketStreamM2S
   { _data :: Vec dataWidth (BitVector 8)
   -- ^ The bytes to be transmitted.
-  , _last :: Maybe (Index dataWidth)
-  -- ^ If this is @Just@ then it signals that this transfer
-  --   is the end of a packet and contains the index of the last valid byte in `_data`.
+  , _last :: Maybe (Index (dataWidth + 1))
+  -- ^ If this is @Just@ then it signals that this transfer is the end of a
+  --   packet and contains the number of valid bytes in '_data', starting from
+  --   index @0@.
+  --
   --   If it is @Nothing@ then this transfer is not yet the end of a packet and all
   --   bytes are valid. This implies that no null bytes are allowed in the middle of
   --   a packet, only after a packet.
@@ -94,7 +97,7 @@ data PacketStreamM2S (dataWidth :: Nat) (meta :: Type) = PacketStreamM2S
   -- ^ Iff true, the packet corresponding to this transfer is invalid. The subordinate
   --   must either drop the packet or forward the `_abort`.
   }
-  deriving (Bundle, Eq, Functor, Generic, NFData, Show, ShowX)
+  deriving (Eq, Generic, ShowX, Show, NFData, Bundle, Functor)
 
 deriving instance
   (KnownNat dataWidth, NFDataX meta) =>
@@ -134,6 +137,11 @@ Invariants:
 4. A subordinate which receives a transfer with `_abort` asserted must either forward this `_abort` or drop the packet.
 5. A packet may not be interrupted by another packet.
 6. All bytes in `_data` which are not enabled must be 0x00.
+
+This protocol allows the last transfer of a packet to have zero valid bytes in
+'_data', so it also allows 0-byte packets. Note that concrete implementations
+of the protocol are free to disallow 0-byte packets or packets with a trailing
+zero-byte transfer for whatever reason.
 -}
 data PacketStream (dom :: Domain) (dataWidth :: Nat) (meta :: Type)
 
@@ -278,6 +286,53 @@ forceResetSanity ::
   Circuit (PacketStream dom dataWidth meta) (PacketStream dom dataWidth meta)
 forceResetSanity = forceResetSanityGeneric
 
+{- |
+Strips trailing zero-byte transfers from packets in the stream. That is,
+if a packet consists of more than one transfer and '_last' of the last
+transfer in that packet is @Just 0@, the last transfer of that packet will
+be dropped and '_last' of the transfer before that will be set to @maxBound@.
+If such a trailing zero-byte transfer had '_abort' asserted, it will be
+preserved.
+
+Has one clock cycle latency, but runs at full throughput.
+-}
+stripTrailingEmptyC ::
+  forall (dataWidth :: Nat) (meta :: Type) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (NFDataX meta) =>
+  Circuit
+    (PacketStream dom dataWidth meta)
+    (PacketStream dom dataWidth meta)
+stripTrailingEmptyC = forceResetSanity |> fromSignals (mealyB go (False, False, Nothing))
+ where
+  go (notFirst, flush, cache) (Nothing, bwdIn) =
+    ((notFirst, flush', cache'), (PacketStreamS2M True, fwdOut))
+   where
+    fwdOut = if flush then cache else Nothing
+    (flush', cache')
+      | flush && _ready bwdIn = (False, Nothing)
+      | otherwise = (flush, cache)
+  go (notFirst, flush, cache) (Just transferIn, bwdIn) = (nextStOut, (bwdOut, fwdOut))
+   where
+    (notFirst', flush', cache', fwdOut) = case _last transferIn of
+      Nothing -> (True, False, Just transferIn, cache)
+      Just i ->
+        let trailing = i == 0 && notFirst
+         in ( False
+            , not trailing
+            , if trailing then Nothing else Just transferIn
+            , if trailing
+                then (\x -> x{_last = Just maxBound, _abort = _abort x || _abort transferIn}) <$> cache
+                else cache
+            )
+
+    bwdOut = PacketStreamS2M (Maybe.isNothing cache || _ready bwdIn)
+
+    nextStOut
+      | Maybe.isNothing cache || _ready bwdIn = (notFirst', flush', cache')
+      | otherwise = (notFirst, flush, cache)
+
 -- | Sets data bytes that are not enabled in a @PacketStream@ to @0x00@.
 zeroOutInvalidBytesC ::
   forall (dom :: Domain) (dataWidth :: Nat) (meta :: Type).
@@ -292,11 +347,10 @@ zeroOutInvalidBytesC = Circuit $ \(fwdIn, bwdIn) -> (bwdIn, fmap (go <$>) fwdIn)
    where
     dataOut = case _last transferIn of
       Nothing -> _data transferIn
-      Just i -> a ++ b
-       where
-        -- The first byte is always valid, so we only map over the rest.
-        (a, b') = splitAt d1 (_data transferIn)
-        b = imap (\(j :: Index (dataWidth - 1)) byte -> if resize j < i then byte else 0x00) b'
+      Just i ->
+        imap
+          (\(j :: Index dataWidth) byte -> if resize j < i then byte else 0x00)
+          (_data transferIn)
 
 {- |
 Copy data of a single `PacketStream` to multiple. LHS will only receive

clash-protocols/src/Protocols/PacketStream/Converters.hs

@@ -13,30 +13,34 @@ module Protocols.PacketStream.Converters (
 
 import Clash.Prelude
 
-import Protocols (CSignal, Circuit (..), fromSignals, idC, (|>))
-import Protocols.PacketStream.Base
-
-import Data.Data ((:~:) (Refl))
 import Data.Maybe (isJust)
 import Data.Maybe.Extra
+import Data.Type.Equality ((:~:) (Refl))
+
+import Protocols (CSignal, Circuit (..), fromSignals, idC, (|>))
+import Protocols.PacketStream.Base
 
 -- | Upconverter state, consisting of at most p `BitVector 8`s and a vector indicating which bytes are valid
 data UpConverterState (dwOut :: Nat) (n :: Nat) (meta :: Type) = UpConverterState
   { _ucBuf :: Vec dwOut (BitVector 8)
   -- ^ The buffer we are filling
   , _ucIdx :: Index n
   -- ^ Where in the buffer we need to write the next element
+  , _ucIdx2 :: Index (dwOut + 1)
+  -- ^ Used when @dwIn@ is not a power of two to determine the adjusted '_last',
+  --   to avoid multiplication (infers an expensive DSP slice).
+  --   If @dwIn@ is a power of two then we can multiply by shifting left.
   , _ucFlush :: Bool
   -- ^ If this is true the current state can presented as packetstream word
   , _ucFreshBuf :: Bool
   -- ^ If this is true we need to start a fresh buffer
   , _ucAborted :: Bool
   -- ^ Current packet is aborted
-  , _ucLastIdx :: Maybe (Index dwOut)
+  , _ucLastIdx :: Maybe (Index (dwOut + 1))
   -- ^ If true the current buffer contains the last byte of the current packet
   , _ucMeta :: meta
   }
-  deriving (Generic, NFDataX)
+  deriving (Generic, NFDataX, Show, ShowX)
 
 toPacketStream :: UpConverterState dwOut n meta -> Maybe (PacketStreamM2S dwOut meta)
 toPacketStream UpConverterState{..} = toMaybe _ucFlush (PacketStreamM2S _ucBuf _ucLastIdx _ucMeta _ucAborted)
@@ -89,14 +93,28 @@ nextState st@(UpConverterState{..}) (Just PacketStreamM2S{..}) (PacketStreamS2M
   nextFlush = isJust _last || bufFull
   nextIdx = if nextFlush then 0 else _ucIdx + 1
 
+  -- If @dwIn@ is not a power of two, we need to do some extra bookkeeping to
+  -- avoid multiplication. If not, _ucIdx2 stays at 0 and is never used, and
+  -- should therefore be optimized out by synthesis tools.
+  (nextIdx2, nextLastIdx) = case sameNat (SNat @(FLog 2 dwIn)) (SNat @(CLog 2 dwIn)) of
+    Just Refl ->
+      ( 0
+      , (\i -> shiftL (resize _ucIdx) (natToNum @(Log 2 dwIn)) + resize i) <$> _last
+      )
+    Nothing ->
+      ( if nextFlush then 0 else _ucIdx2 + natToNum @dwIn
+      , (\i -> _ucIdx2 + resize i) <$> _last
+      )
+
   nextStRaw =
     UpConverterState
       { _ucBuf = nextBuf
       , _ucIdx = nextIdx
+      , _ucIdx2 = nextIdx2
       , _ucFlush = nextFlush
       , _ucFreshBuf = nextFlush
       , _ucAborted = nextAbort
-      , _ucLastIdx = (\i -> resize _ucIdx * natToNum @dwIn + resize i) <$> _last
+      , _ucLastIdx = nextLastIdx
       , _ucMeta = _meta
       }
   nextSt = if outReady then nextStRaw else st
@@ -120,7 +138,17 @@ upConverter ::
   )
 upConverter = mealyB go s0
  where
-  s0 = UpConverterState (repeat undefined) 0 False True False Nothing undefined
+  s0 =
+    UpConverterState
+      { _ucBuf = deepErrorX "upConverterC: undefined initial buffer"
+      , _ucIdx = 0
+      , _ucIdx2 = 0
+      , _ucFlush = False
+      , _ucFreshBuf = True
+      , _ucAborted = False
+      , _ucLastIdx = Nothing
+      , _ucMeta = deepErrorX "upConverterC: undefined initial metadata"
+      }
   go st@(UpConverterState{..}) (fwdIn, bwdIn) =
     (nextState st fwdIn bwdIn, (PacketStreamS2M outReady, toPacketStream st))
    where
@@ -206,7 +234,7 @@ downConverterT st@DownConverterState{..} (Just inPkt, bwdIn) = (nextSt, (PacketS
   -- its corresponding _data. Else, we should use our stored buffer.
   (nextSize, buf) = case (_dcSize == 0, _last inPkt) of
     (True, Nothing) -> (maxBound - natToNum @dwOut, _data inPkt)
-    (True, Just i) -> (satSub SatBound (resize i + 1) (natToNum @dwOut), _data inPkt)
+    (True, Just i) -> (satSub SatBound i (natToNum @dwOut), _data inPkt)
     (False, _) -> (satSub SatBound _dcSize (natToNum @dwOut), _dcBuf)
 
   (newBuf, dataOut) = leToPlus @dwOut @dwIn shiftOutFrom0 (SNat @dwOut) buf
@@ -221,7 +249,10 @@ downConverterT st@DownConverterState{..} (Just inPkt, bwdIn) = (nextSt, (PacketS
 
   (outReady, outLast)
     | nextSize == 0 =
-        (_ready bwdIn, resize . (\i -> i `mod` natToNum @dwOut) <$> _last inPkt)
+        ( _ready bwdIn
+        , (\i -> resize $ if _dcSize == 0 then i else _dcSize)
+            <$> _last inPkt
+        )
     | otherwise = (False, Nothing)
 
   -- Keep the buffer in the state and rotate it once the byte is acknowledged to avoid
@@ -256,6 +287,6 @@ downConverterC = case sameNat (SNat @dwIn) (SNat @dwOut) of
    where
     s0 =
       DownConverterState
-        { _dcBuf = errorX "downConverterC: undefined initial value"
+        { _dcBuf = deepErrorX "downConverterC: undefined initial buffer"
         , _dcSize = 0
         }

clash-protocols/src/Protocols/PacketStream/Delay.hs

@@ -18,7 +18,7 @@ import Data.Constraint.Deferrable ((:~:) (Refl))
 import Data.Maybe
 
 type M2SNoMeta dataWidth =
-  (Vec dataWidth (BitVector 8), Maybe (Index dataWidth), Bool)
+  (Vec dataWidth (BitVector 8), Maybe (Index (dataWidth + 1)), Bool)
 
 toPacketstreamM2S :: M2SNoMeta dataWidth -> meta -> PacketStreamM2S dataWidth meta
 toPacketstreamM2S (a, b, c) d = PacketStreamM2S a b d c

clash-protocols/src/Protocols/PacketStream/Depacketizers.hs

@@ -121,7 +121,7 @@ depacketizerT _ Parse{..} (Just PacketStreamM2S{..}, _) = (nextStOut, (PacketStr
   nextParseBuf = fst (shiftInAtN _buf _data)
 
   prematureEnd idx = case sameNat d0 (SNat @(headerBytes `Mod` dataWidth)) of
-    Just Refl -> True
+    Just Refl -> idx /= maxBound
     _ -> idx < natToNum @(headerBytes `Mod` dataWidth)
 
   -- Upon seeing _last being set, move back to the initial state if the
@@ -150,16 +150,22 @@ depacketizerT toMetaOut st@Forward{..} (Just pkt@PacketStreamM2S{..}, bwdIn) = (
   (dataOut, nextFwdBytes) = splitAt (SNat @dataWidth) (fwdBytes ++ _data)
 
   -- Only use if headerBytes `Mod` dataWidth > 0.
-  adjustLast :: Index dataWidth -> Either (Index dataWidth) (Index dataWidth)
-  adjustLast idx = if idx < x then Left (idx + y) else Right (idx - x)
+  adjustLast ::
+    Index (dataWidth + 1) -> Either (Index (dataWidth + 1)) (Index (dataWidth + 1))
+  adjustLast idx
+    | _lastFwd = Right (idx - x)
+    | idx <= x = Left (idx + y)
+    | otherwise = Right (idx - x)
    where
     x = natToNum @(headerBytes `Mod` dataWidth)
     y = natToNum @(ForwardBytes headerBytes dataWidth)
 
   outPkt = case sameNat d0 (SNat @(headerBytes `Mod` dataWidth)) of
     Just Refl ->
       pkt
-        { _meta = toMetaOut (bitCoerce header) _meta
+        { _data = if _lastFwd then repeat 0x00 else _data
+        , _last = if _lastFwd then Just 0 else _last
+        , _meta = toMetaOut (bitCoerce header) _meta
         , _abort = nextAborted
         }
     Nothing ->
@@ -289,8 +295,8 @@ depacketizeToDfT _ DfParse{..} (Just (PacketStreamM2S{..}), _) = (nextStOut, (Pa
 
   prematureEnd idx =
     case compareSNat (SNat @(headerBytes `Mod` dataWidth)) d0 of
-      SNatGT -> idx < (natToNum @(headerBytes `Mod` dataWidth - 1))
-      _ -> idx < (natToNum @(dataWidth - 1))
+      SNatGT -> idx < (natToNum @(headerBytes `Mod` dataWidth))
+      _ -> idx < (natToNum @dataWidth)
 
   (nextStOut, readyOut) =
     case (_dfCounter == 0, _last) of
@@ -361,7 +367,7 @@ depacketizeToDfC toOut = forceResetSanity |> fromSignals ckt
 data DropTailInfo dataWidth delay = DropTailInfo
   { _dtAborted :: Bool
   -- ^ Whether any fragment of the packet was aborted
-  , _newIdx :: Index dataWidth
+  , _newIdx :: Index (dataWidth + 1)
   -- ^ The adjusted byte enable
   , _drops :: Index (delay + 1)
   -- ^ The amount of transfers to drop from the tail
@@ -395,27 +401,28 @@ transmitDropInfoC SNat = forceResetSanity |> fromSignals (mealyB go False)
     toDropTailInfo i =
       DropTailInfo
         { _dtAborted = aborted || _abort
-        , _newIdx = satSub SatWrap i (natToNum @(n `Mod` dataWidth))
+        , _newIdx = newIdx
         , _drops = drops
         , _wait = wait
         }
      where
-      (drops, wait) = case ( compareSNat (SNat @dataWidth) (SNat @n)
-                           , sameNat d0 (SNat @(n `Mod` dataWidth))
-                           ) of
+      (newIdx, drops, wait) = case ( compareSNat (SNat @dataWidth) (SNat @n)
+                                   , sameNat d0 (SNat @(n `Mod` dataWidth))
+                                   ) of
         (SNatLE, Nothing) ->
-          let smaller = (resize i :: Index n) < natToNum @(n - dataWidth)
-           in ( if smaller
+          let smaller = (resize i :: Index n) <= natToNum @(n - dataWidth)
+           in ( satSub SatWrap i (natToNum @(n `Mod` dataWidth) + (if smaller then 1 else 0))
+              , if smaller
                   then natToNum @(n `DivRU` dataWidth)
                   else natToNum @(n `Div` dataWidth)
               , not smaller
               )
         (SNatLE, Just Refl) ->
-          (natToNum @(n `Div` dataWidth), False)
+          (i, natToNum @(n `Div` dataWidth), False)
         (SNatGT, _) ->
-          if i >= natToNum @n
-            then (0, True)
-            else (1, False)
+          if i > natToNum @n
+            then (i - natToNum @n, 0, True)
+            else (maxBound - (natToNum @n - i), 1, False)
 
 {- |
 Gets a delayed packet stream as input together with non-delayed