Fix PacketFifo bug

Now correctly drops packets that are too big to fit in the content FIFO in 'Backpressure' mode.

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -7,7 +8,7 @@ Copyright  :  (C) 2024, QBayLogic B.V.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  QBayLogic B.V. <[email protected]>
 
-Optimized Store and forward FIFO circuit for packet streams.
+Optimized store and forward FIFO circuit for packet streams.
 -}
 module Protocols.PacketStream.PacketFifo (
   packetFifoC,
@@ -16,23 +17,154 @@ module Protocols.PacketStream.PacketFifo (
 
 import Clash.Prelude
 
+import Data.Maybe
+import Data.Maybe.Extra (toMaybe)
+
 import Protocols
 import Protocols.PacketStream.Base
 
-import Data.Maybe
-import Data.Maybe.Extra
-
 type PacketStreamContent (dataWidth :: Nat) (meta :: Type) =
   (Vec dataWidth (BitVector 8), Maybe (Index (dataWidth + 1)))
 
+-- | Specifies the behaviour of `packetFifoC` when it is full.
+data FullMode
+  = -- | Assert backpressure when the FIFO is full.
+    Backpressure
+  | -- | Drop new packets when the FIFO is full.
+    --   The FIFO never asserts backpressure.
+    Drop
+
 toPacketStreamContent ::
   PacketStreamM2S dataWidth meta -> PacketStreamContent dataWidth meta
-toPacketStreamContent PacketStreamM2S{_data = d, _last = l, _meta = _, _abort = _} = (d, l)
+toPacketStreamContent PacketStreamM2S{..} = (_data, _last)
 
 toPacketStreamM2S ::
   PacketStreamContent dataWidth meta -> meta -> PacketStreamM2S dataWidth meta
 toPacketStreamM2S (d, l) m = PacketStreamM2S d l m False
 
+data PacketFifoState contentDepth metaDepth = PacketFifoState
+  { _canRead :: Bool
+  -- ^ We need this to avoid read-write conflicts.
+  , _dropping :: Bool
+  -- ^ Whether we are dropping the current packet.
+  , _basePtr :: Unsigned contentDepth
+  -- ^ Points to the base address of the current packet, i.e. the address of
+  --   the first transfer.
+  , _cReadPtr :: Unsigned contentDepth
+  -- ^ Read pointer in the content block ram.
+  , _cWritePtr :: Unsigned contentDepth
+  -- ^ Write pointer in the content block ram.
+  , _mReadPtr :: Unsigned metaDepth
+  -- ^ Read pointer in the metadata block ram.
+  , _mWritePtr :: Unsigned metaDepth
+  -- ^ Write pointer in the metadata block ram.
+  }
+  deriving (Generic, NFDataX, Show, ShowX)
+
+-- | State transition function of 'packetFifoC', mode @Backpressure@.
+packetFifoT ::
+  forall
+    (dataWidth :: Nat)
+    (meta :: Type)
+    (contentDepth :: Nat)
+    (metaDepth :: Nat).
+  (KnownNat dataWidth) =>
+  (KnownNat contentDepth) =>
+  (KnownNat metaDepth) =>
+  (1 <= contentDepth) =>
+  (1 <= metaDepth) =>
+  (NFDataX meta) =>
+  PacketFifoState contentDepth metaDepth ->
+  ( Maybe (PacketStreamM2S dataWidth meta)
+  , PacketStreamS2M
+  , PacketStreamContent dataWidth meta
+  , meta
+  ) ->
+  ( PacketFifoState contentDepth metaDepth
+  , ( Unsigned contentDepth
+    , Unsigned metaDepth
+    , Maybe (Unsigned contentDepth, PacketStreamContent dataWidth meta)
+    , Maybe (Unsigned metaDepth, meta)
+    , PacketStreamS2M
+    , Maybe (PacketStreamM2S dataWidth meta)
+    )
+  )
+packetFifoT st@PacketFifoState{..} (fwdIn, bwdIn, cRam, mRam) =
+  (nextSt, (cReadPtr', mReadPtr', cWriteCmd, mWriteCmd, bwdOut, fwdOut))
+ where
+  -- Status signals
+  pktTooBig = _cWritePtr + 1 == _cReadPtr && fifoEmpty
+  (lastPkt, dropping) = case fwdIn of
+    Nothing -> (False, _dropping || pktTooBig)
+    Just PacketStreamM2S{..} -> (isJust _last, _dropping || pktTooBig || _abort)
+
+  fifoEmpty = _mReadPtr == _mWritePtr
+  fifoSinglePacket = _mReadPtr + 1 == _mWritePtr
+  fifoFull =
+    (_cWritePtr + 1 == _cReadPtr)
+      || (_mWritePtr + 1 == _mReadPtr && lastPkt)
+
+  -- Enables
+  readEn = _canRead && not fifoEmpty
+  cReadEn = readEn && _ready bwdIn
+  mReadEn = readEn && _ready bwdIn && isJust (snd cRam)
+
+  -- Output
+  bwdOut = PacketStreamS2M (not fifoFull || dropping)
+  fwdOut =
+    if readEn
+      then Just (toPacketStreamM2S cRam mRam)
+      else Nothing
+
+  -- New state
+
+  -- Our block RAM is read-before-write, so we cannot use the read value next
+  -- clock cycle if there is a read-write conflict. Such a conflict might happen
+  -- when we finish writing a packet into the FIFO while:
+  -- 1. The FIFO is empty.
+  -- 2. The FIFO has one packet inside and we finish outputting it this clock cycle.
+  canRead' = not (lastPkt && (fifoEmpty || (mReadEn && fifoSinglePacket)))
+  dropping' = dropping && not lastPkt
+
+  basePtr' = if lastPkt && _ready bwdOut then cWritePtr' else _basePtr
+  cReadPtr' = if cReadEn then _cReadPtr + 1 else _cReadPtr
+  mReadPtr' = if mReadEn then _mReadPtr + 1 else _mReadPtr
+
+  (cWriteCmd, cWritePtr') =
+    if not dropping && not fifoFull
+      then
+        ( (\t -> (_cWritePtr, toPacketStreamContent t)) <$> fwdIn
+        , _cWritePtr + 1
+        )
+      else
+        ( Nothing
+        , if dropping then _basePtr else _cWritePtr
+        )
+
+  -- Write the metadata into RAM upon the last transfer of a packet, and
+  -- advance the write pointer. This allows us to write the data of a packet
+  -- into RAM even if the metadata RAM is currently full (hoping that it will
+  -- free up before we read the end of the packet). It also prevents unnecessary
+  -- writes in case a packet is aborted or too big.
+  (mWriteCmd, mWritePtr') =
+    if not dropping && not fifoFull && lastPkt
+      then ((\t -> (_mWritePtr, _meta t)) <$> fwdIn, _mWritePtr + 1)
+      else (Nothing, _mWritePtr)
+
+  nextSt = case fwdIn of
+    Nothing -> st{_canRead = True, _cReadPtr = cReadPtr', _mReadPtr = mReadPtr'}
+    Just _ ->
+      PacketFifoState
+        { _canRead = canRead'
+        , _dropping = dropping'
+        , _basePtr = basePtr'
+        , _cReadPtr = cReadPtr'
+        , _cWritePtr = cWritePtr'
+        , _mReadPtr = mReadPtr'
+        , _mWritePtr = mWritePtr'
+        }
+
+-- | Implementation of 'packetFifoC', mode @Drop@.
 packetFifoImpl ::
   forall
     (dom :: Domain)
@@ -123,46 +255,75 @@ packetFifoImpl SNat SNat (fwdIn, bwdIn) = (PacketStreamS2M . not <$> fullBuffer,
   nextPacketIn = lastWordIn .&&. writeEnable
 
 {- |
-Packet buffer, a circuit which stores words in a buffer until the packet is complete.
-Once a packet is complete it will send the entire packet out at once without stalls.
-If a transfer in a packet has `_abort` set to true, the packetBuffer will drop the entire packet.
+FIFO circuit optimized for the PacketStream protocol. Contains two FIFOs, one
+for packet data ('_data', '_last') and one for packet metadata ('_meta').
+Because metadata is constant per packet, the metadata FIFO can be signficantly
+shallower, saving resources.
+
+Moreover, the output of the FIFO has some other properties:
+
+- All packets which contain a transfer with '_abort' set are dropped.
+- All packets that are bigger than or equal to @2^contentDepth - 1@ transfers are dropped.
+- There are no gaps in output packets, i.e. @Nothing@ in between valid transfers of a packet.
 
-__UNSAFE__: if `FullMode` is set to @Backpressure@ and a packet containing
-@>= 2^contentSizeBits-1@ transfers is loaded into the FIFO, it will deadlock.
+The circuit is able to satisfy these properties because it first loads an entire
+packet before it may transmit it. That is also why packets bigger than the
+content FIFO need to be dropped.
+
+Two modes can be selected:
+
+- @Backpressure@: assert backpressure like normal when the FIFO is full.
+- @Drop@: never give backpressure, instead drop the current packet we are loading.
 -}
 packetFifoC ::
   forall
     (dom :: Domain)
     (dataWidth :: Nat)
     (meta :: Type)
-    (contentSizeBits :: Nat)
-    (metaSizeBits :: Nat).
+    (contentDepth :: Nat)
+    (metaDepth :: Nat).
   (HiddenClockResetEnable dom) =>
   (KnownNat dataWidth) =>
-  (1 <= contentSizeBits) =>
-  (1 <= metaSizeBits) =>
+  (1 <= contentDepth) =>
+  (1 <= metaDepth) =>
   (NFDataX meta) =>
-  -- | The FIFO can store @2^contentSizeBits@ transfers
-  SNat contentSizeBits ->
-  -- | The FIFO can store @2^metaSizeBits@ packets
-  SNat metaSizeBits ->
-  -- | Specifies the behaviour of the FIFO when it is full
+  -- |  The content FIFO will contain @2^contentDepth@ entries.
+  SNat contentDepth ->
+  -- | The metadata FIFO will contain @2^metaDepth@ entries.
+  SNat metaDepth ->
+  -- | The backpressure behaviour of the FIFO when it is full.
   FullMode ->
   Circuit (PacketStream dom dataWidth meta) (PacketStream dom dataWidth meta)
-packetFifoC cSizeBits mSizeBits mode = case mode of
-  Backpressure ->
-    forceResetSanity
-      |> fromSignals (packetFifoImpl cSizeBits mSizeBits)
-  Drop ->
-    toCSignal
-      |> unsafeAbortOnBackpressureC
-      |> forceResetSanity
-      |> fromSignals (packetFifoImpl cSizeBits mSizeBits)
+packetFifoC cSize@SNat mSize@SNat fullMode =
+  let
+    ckt (fwdIn, bwdIn) = (bwdOut, fwdOut)
+     where
+      ramContent =
+        blockRam1
+          NoClearOnReset
+          (SNat @(2 ^ contentDepth))
+          (deepErrorX "initial block ram content")
+          cReadPtr
+          cWriteCommand
+      ramMeta =
+        blockRam1
+          NoClearOnReset
+          (SNat @(2 ^ metaDepth))
+          (deepErrorX "initial block ram meta content")
+          mReadPtr
+          mWriteCommand
 
--- | Specifies the behaviour of `packetFifoC` when it is full.
-data FullMode
-  = -- | Assert backpressure when the FIFO is full.
-    Backpressure
-  | -- | Drop new packets when the FIFO is full.
-    --   The FIFO never asserts backpressure.
-    Drop
+      (cReadPtr, mReadPtr, cWriteCommand, mWriteCommand, bwdOut, fwdOut) =
+        mealyB
+          (packetFifoT @dataWidth @meta @contentDepth @metaDepth)
+          (PacketFifoState False False 0 0 0 0 0)
+          (fwdIn, bwdIn, ramContent, ramMeta)
+   in
+    case fullMode of
+      Backpressure ->
+        forceResetSanity |> fromSignals ckt
+      Drop ->
+        toCSignal
+          |> unsafeAbortOnBackpressureC
+          |> forceResetSanity
+          |> fromSignals (packetFifoImpl cSize mSize)