Simplify fcs validator and strip fcs

nix/sources.json

@@ -18,10 +18,10 @@
         "homepage": null,
         "owner": "clash-lang",
         "repo": "clash-protocols",
-        "rev": "a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4",
-        "sha256": "0b219y7nxaxcr3xrk6dq5qj5hl9ggaxqpysk8rwmjh9nmkvzxifa",
+        "rev": "e5e25e76cf79dd30a3551c4e32e1b792e15d9711",
+        "sha256": "0a103gcl91bzfjklcci974faw11cqvriacx774lg4p09dg0cpplx",
         "type": "tarball",
-        "url": "https://github.com/clash-lang/clash-protocols/archive/a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4.tar.gz",
+        "url": "https://github.com/clash-lang/clash-protocols/archive/e5e25e76cf79dd30a3551c4e32e1b792e15d9711.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "doctest-parallel": {

src/Clash/Cores/Ethernet/Examples/RxStacks.hs

@@ -21,7 +21,7 @@ import Protocols.PacketStream
 import Clash.Cores.Ethernet.IP.IPPacketizers
 import Clash.Cores.Ethernet.IP.IPv4Types
 import Clash.Cores.Ethernet.Mac.EthernetTypes
-import Clash.Cores.Ethernet.Mac.FrameCheckSequence ( fcsValidatorC )
+import Clash.Cores.Ethernet.Mac.FrameCheckSequence ( fcsValidatorC, fcsStripperC )
 import Clash.Cores.Ethernet.Mac.MacPacketizers ( macDepacketizerC )
 import Clash.Cores.Ethernet.Mac.Preamble ( preambleStripperC )
 
@@ -44,6 +44,7 @@ macRxStack ethClk ethRst ethEn macAddressS =
     |> upConverterC'
     |> asyncFifoC'
     |> fcsValidatorC
+    |> fcsStripperC
     |> macDepacketizerC
     |> filterMetaS (isForMyMac <$> macAddressS)
   where

src/Clash/Cores/Ethernet/Mac/FrameCheckSequence.hs

@@ -1,45 +1,46 @@
-{-# language DuplicateRecordFields #-}
-{-# language FlexibleContexts #-}
-{-# language MultiParamTypeClasses #-}
-{-# language RecordWildCards #-}
-{-# language ScopedTypeVariables #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 {-|
 Module      : Clash.Cores.Ethernet.Mac.FrameCheckSequence
-Description : Provides circuits to insert and validate the FCS of an ethernet frame.
+Description : Provides circuits to insert, validate and strip the FCS of an Ethernet frame.
 -}
-module Clash.Cores.Ethernet.Mac.FrameCheckSequence
-  ( fcsInserterC
-  , fcsValidatorC
-  ) where
+module Clash.Cores.Ethernet.Mac.FrameCheckSequence (
+  fcsInserterC,
+  fcsValidatorC,
+  fcsStripperC,
+) where
 
 -- crc
-import Clash.Cores.Crc
-import Clash.Cores.Crc.Catalog
+import Clash.Cores.Crc (crcEngine, crcValidator, HardwareCrc)
+import Clash.Cores.Crc.Catalog (Crc32_ethernet(..))
+
+-- vector
+import Clash.Sized.Vector.Extra (appendVec)
 
 -- prelude
 import Clash.Prelude
 
 -- maybe
 import Data.Maybe
-
--- vector
-import Clash.Sized.Vector.Extra
+import Data.Maybe.Extra
 
 -- protocols
 import Protocols
 import Protocols.PacketStream
 
-import Data.Maybe.Extra
-
-
-toCRCInput
-  :: KnownNat dataWidth
-  => Bool
-  -> PacketStreamM2S dataWidth ()
-  -> (Bool, Index dataWidth, Vec dataWidth (BitVector 8))
-toCRCInput isFirst (PacketStreamM2S{..}) = (isFirst, fromMaybe maxBound _last, _data)
+toCrcInput ::
+  (KnownNat dataWidth) =>
+  -- | Enable
+  Bool ->
+  -- | Start of new CRC
+  Bool ->
+  -- | Transaction to feed
+  PacketStreamM2S dataWidth () ->
+  Maybe (Bool, Index dataWidth, Vec dataWidth (BitVector 8))
+toCrcInput en isFirst PacketStreamM2S{..} =
+  toMaybe en (isFirst, fromMaybe maxBound _last, _data)
 
 fcsInserterT
   :: forall dataWidth
@@ -127,7 +128,7 @@ data FcsInserterState dataWidth
 
 -- | fcsInserter
 fcsInserter
-  :: forall (dom :: Domain) (dataWidth :: Nat)
+  :: forall (dataWidth :: Nat) (dom :: Domain)
   .  HiddenClockResetEnable dom
   => KnownNat dataWidth
   => HardwareCrc Crc32_ethernet 8 dataWidth
@@ -141,7 +142,7 @@ fcsInserter (fwdIn, bwdIn) = (bwdOut, fwdOut)
   where
     fwdInX = fromJustX <$> fwdIn
     transferOccured = ready .&&. isJust <$> fwdIn
-    crcIn = toMaybe <$> transferOccured <*> liftA2 toCRCInput isFirst fwdInX
+    crcIn = liftA3 toCrcInput transferOccured isFirst fwdInX
 
     isFirst = regEn True transferOccured $ isJust . _last <$> fwdInX
     ethCrc = crcEngine Crc32_ethernet crcIn
@@ -151,13 +152,12 @@ fcsInserter (fwdIn, bwdIn) = (bwdOut, fwdOut)
 
     (fwdOut, ready) = mealyB fcsInserterT (FcsCopy Nothing) (ethCrcBytes, fwdIn, bwdIn)
 
-
 {- |
 Computes the Ethernet CRC (4 bytes) of each packet in the input stream and
 appends this CRC to the corresponding packet in the output stream.
 -}
 fcsInserterC
-  :: forall (dom :: Domain) (dataWidth :: Nat)
+  :: forall (dataWidth :: Nat) (dom :: Domain)
   .  KnownDomain dom
   => KnownNat dataWidth
   => HiddenClockResetEnable dom
@@ -167,67 +167,95 @@ fcsInserterC
     (PacketStream dom dataWidth ())
 fcsInserterC = forceResetSanity |> fromSignals fcsInserter
 
-fcsValidatorT
-  :: forall dataWidth
-  . KnownNat dataWidth
-  => FcsValidatorState dataWidth
-  -> ( Bool
-     , Maybe (PacketStreamM2S dataWidth ())
-     , PacketStreamS2M)
-  -> ( FcsValidatorState dataWidth
-     , ( Maybe (PacketStreamM2S dataWidth ())
-       , Bool))
-fcsValidatorT (FcsValidatorState Nothing validated) ( _, fwdIn, _) = (FcsValidatorState fwdIn validated, (Nothing, True))
-
-fcsValidatorT st@(FcsValidatorState (Just cache) validated) (valid, fwdIn, PacketStreamS2M readyIn)
-  = (nextSt, (Just fwdOut, readyIn))
-  where
-    outValid = if isJust (_last cache) then valid || validated else valid
-    fwdOut = if isJust (_last cache) then cache { _abort = _abort cache|| not outValid } else cache
-    nextStIfReady = FcsValidatorState fwdIn False
-    nextSt = if readyIn then nextStIfReady else st {_validated = outValid}
-
-data FcsValidatorState dataWidth =
-    FcsValidatorState
-    { _cachedFwd :: Maybe (PacketStreamM2S dataWidth ())
-    , _validated :: Bool
-    }
+-- | State of 'fcsValidatorT'.
+newtype FcsValidatorState dataWidth = FcsValidatorState
+  { _cachedFwd :: Maybe (PacketStreamM2S dataWidth ())
+  }
   deriving (Show, Generic, NFDataX)
 
+-- | State transition function of 'fcsValidator'.
+fcsValidatorT ::
+  forall (dataWidth :: Nat).
+  FcsValidatorState dataWidth ->
+  ( Bool
+  , Maybe (PacketStreamM2S dataWidth ())
+  , PacketStreamS2M
+  ) ->
+  ( FcsValidatorState dataWidth
+  , (Bool, Maybe (PacketStreamM2S dataWidth ()))
+  )
+fcsValidatorT st@FcsValidatorState{..} (valid, fwdIn, bwdIn) =
+  (nextSt, (readyOut, fwdOut))
+ where
+  fwdOut =
+    ( \pkt ->
+        if isJust (_last pkt)
+          then pkt{_abort = _abort pkt || not valid}
+          else pkt
+    )
+      <$> _cachedFwd
+
+  readyOut = isNothing _cachedFwd || _ready bwdIn
+
+  nextSt
+    | isNothing fwdOut || _ready bwdIn = FcsValidatorState fwdIn
+    | otherwise = st
+
+fcsValidator ::
+  forall (dataWidth :: Nat) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (HardwareCrc Crc32_ethernet 8 dataWidth) =>
+  ( Signal dom (Maybe (PacketStreamM2S dataWidth ()))
+  , Signal dom PacketStreamS2M
+  ) ->
+  ( Signal dom PacketStreamS2M
+  , Signal dom (Maybe (PacketStreamM2S dataWidth ()))
+  )
+fcsValidator (fwdIn, bwdIn) = (PacketStreamS2M <$> ready, fwdOut)
+ where
+  fwdInX = fromJustX <$> fwdIn
+  crcEnable = isJust <$> fwdIn .&&. ready
+  valid = crcValidator Crc32_ethernet crcIn
+  crcIn = liftA3 toCrcInput crcEnable isFirst fwdInX
+  isFirst = regEn True crcEnable (isJust . _last <$> fwdInX)
+
+  (ready, fwdOut) =
+    mealyB
+      fcsValidatorT
+      (FcsValidatorState Nothing)
+      (valid, fwdIn, bwdIn)
 
-fcsValidator
-  :: forall (dom :: Domain) (dataWidth :: Nat)
-  .  HiddenClockResetEnable dom
-  => KnownNat dataWidth
-  => HardwareCrc Crc32_ethernet 8 dataWidth
-  => ( Signal dom (Maybe (PacketStreamM2S dataWidth ()))
-     , Signal dom PacketStreamS2M
-     )
-  -> ( Signal dom PacketStreamS2M
-     , Signal dom (Maybe (PacketStreamM2S dataWidth ()))
-     )
-fcsValidator (fwdIn, bwdIn) = (bwdOut, fwdOut)
-  where
-    fwdInX = fromJustX <$> fwdIn
-    transferOccured = ready .&&. isJust <$> fwdIn
-    crcIn = toMaybe <$> transferOccured <*> liftA2 toCRCInput isFirst fwdInX
-
-    isFirst = regEn True transferOccured $ isJust . _last <$> fwdInX
-    valid = crcValidator Crc32_ethernet crcIn
+{- |
+Computes the Ethernet CRC ('Crc32_ethernet') over each packet in the stream
+and asserts '_abort' on the last transfer of the packet if the computed CRC
+did not match the last 4 bytes of the stream.
 
-    bwdOut = PacketStreamS2M <$> ready
+__NB__: does not remove the FCS field (last 4 bytes of the stream).
+Use 'fcsStripperC' for that.
+-}
+fcsValidatorC ::
+  forall (dataWidth :: Nat) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (HardwareCrc Crc32_ethernet 8 dataWidth) =>
+  Circuit
+    (PacketStream dom dataWidth ())
+    (PacketStream dom dataWidth ())
+fcsValidatorC = forceResetSanity |> fromSignals fcsValidator
 
-    (fwdOut, ready) = mealyB fcsValidatorT (FcsValidatorState Nothing False) (valid, fwdIn, bwdIn)
+{- |
+Removes the last 4 bytes of each packet in the stream, the width of the
+Ethernet FCS field. This is just a specialized version of 'dropTailC'.
 
--- | Validates a packet which contains the Crc-32 in its final four (4) bytes. Asserts abort signal
--- in the last fragment of this packet if invalid, else it does not change the abort.
-fcsValidatorC
-  :: forall (dom :: Domain) (dataWidth :: Nat)
-  .  KnownDomain dom
-  => KnownNat dataWidth
-  => HiddenClockResetEnable dom
-  => HardwareCrc Crc32_ethernet 8 dataWidth
-  => Circuit
+__NB__: does not validate the FCS field. Use 'fcsValidatorC' for that.
+-}
+fcsStripperC ::
+  forall (dataWidth :: Nat) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (1 <= dataWidth) =>
+  Circuit
     (PacketStream dom dataWidth ())
     (PacketStream dom dataWidth ())
-fcsValidatorC = forceResetSanity |> fromSignals fcsValidator
+fcsStripperC = dropTailC d4

test/Test/Cores/Ethernet/Mac/FrameCheckSequence.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
 
 module Test.Cores.Ethernet.Mac.FrameCheckSequence (
   tests,
@@ -30,7 +32,9 @@ import Test.Tasty.TH (testGroupGenerator)
 
 $(deriveHardwareCrc Crc32_ethernet d8 d1)
 $(deriveHardwareCrc Crc32_ethernet d8 d2)
+$(deriveHardwareCrc Crc32_ethernet d8 d3)
 $(deriveHardwareCrc Crc32_ethernet d8 d4)
+$(deriveHardwareCrc Crc32_ethernet d8 d7)
 $(deriveHardwareCrc Crc32_ethernet d8 d8)
 
 packetToCrcInp ::
@@ -94,7 +98,7 @@ fcsinserterTest SNat =
     defExpectOptions
     (genPackets (Range.linear 1 4) Abort (genValidPacket (pure ()) (Range.linear 0 20)))
     (exposeClockResetEnable modelInsert)
-    (exposeClockResetEnable (fcsInserterC @_ @dataWidth))
+    (exposeClockResetEnable (fcsInserterC @dataWidth))
  where
   modelInsert packets = L.concatMap insertCrc (chunkByPacket packets)
 
@@ -111,7 +115,7 @@ fcsvalidatorTest SNat =
     defExpectOptions
     (genPackets (Range.linear 1 4) Abort genPkt)
     (exposeClockResetEnable modelValidate)
-    (exposeClockResetEnable (fcsValidatorC @_ @dataWidth))
+    (exposeClockResetEnable (fcsValidatorC @dataWidth))
  where
   genPkt am =
     Gen.choice
@@ -120,7 +124,7 @@ fcsvalidatorTest SNat =
       , -- Packet with valid CRC
         insertCrc <$> genValidPacket (pure ()) (Range.linear 0 20) am
       ]
-  
+
   modelValidate packets = validateCrc =<< chunkByPacket packets
 
 prop_fcsinserter_d1 :: Property
@@ -138,14 +142,14 @@ prop_fcsinserter_d8 = fcsinserterTest d8
 prop_fcsvalidator_d1 :: Property
 prop_fcsvalidator_d1 = fcsvalidatorTest d1
 
-prop_fcsvalidator_d2 :: Property
-prop_fcsvalidator_d2 = fcsvalidatorTest d2
+prop_fcsvalidator_d3 :: Property
+prop_fcsvalidator_d3 = fcsvalidatorTest d3
 
 prop_fcsvalidator_d4 :: Property
 prop_fcsvalidator_d4 = fcsvalidatorTest d4
 
-prop_fcsvalidator_d8 :: Property
-prop_fcsvalidator_d8 = fcsvalidatorTest d8
+prop_fcsvalidator_d7 :: Property
+prop_fcsvalidator_d7 = fcsvalidatorTest d7
 
 tests :: TestTree
 tests =

test/unittests.hs

@@ -22,15 +22,15 @@ import qualified Test.Cores.Xilinx.DnaPortE2
 
 tests :: TestTree
 tests = testGroup "Unittests"
-  [ --Test.Cores.Crc.tests
-   Test.Cores.Ethernet.tests
-  --, Test.Cores.LineCoding8b10b.tests
-  --, Test.Cores.SPI.tests
-  --, Test.Cores.SPI.MultiSlave.tests
-  --, Test.Cores.UART.tests
-  --, Test.Cores.Xilinx.BlockRam.tests
-  --, Test.Cores.Xilinx.DcFifo.tests
-  --, Test.Cores.Xilinx.DnaPortE2.tests
+  [ Test.Cores.Crc.tests
+  , Test.Cores.Ethernet.tests
+  , Test.Cores.LineCoding8b10b.tests
+  , Test.Cores.SPI.tests
+  , Test.Cores.SPI.MultiSlave.tests
+  , Test.Cores.UART.tests
+  , Test.Cores.Xilinx.BlockRam.tests
+  , Test.Cores.Xilinx.DcFifo.tests
+  , Test.Cores.Xilinx.DnaPortE2.tests
   ]
 
 main :: IO ()