From 270e5826d83a6cb58bbed7920d82a6fcf18d3de8 Mon Sep 17 00:00:00 2001 From: t-wallet Date: Sat, 14 Sep 2024 15:49:34 +0200 Subject: [PATCH] Simplify fcs validator and strip fcs --- nix/sources.json | 6 +- src/Clash/Cores/Ethernet/Examples/RxStacks.hs | 3 +- .../Cores/Ethernet/Mac/FrameCheckSequence.hs | 196 ++++++++++-------- .../Cores/Ethernet/Mac/FrameCheckSequence.hs | 18 +- test/unittests.hs | 18 +- 5 files changed, 137 insertions(+), 104 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 64e6874..bf5f6da 100644 --- a/nix/sources.json +++ b/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///archive/.tar.gz" }, "doctest-parallel": { diff --git a/src/Clash/Cores/Ethernet/Examples/RxStacks.hs b/src/Clash/Cores/Ethernet/Examples/RxStacks.hs index cb1ec7f..4328506 100644 --- a/src/Clash/Cores/Ethernet/Examples/RxStacks.hs +++ b/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 diff --git a/src/Clash/Cores/Ethernet/Mac/FrameCheckSequence.hs b/src/Clash/Cores/Ethernet/Mac/FrameCheckSequence.hs index ce3c495..96fc6d0 100644 --- a/src/Clash/Cores/Ethernet/Mac/FrameCheckSequence.hs +++ b/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 diff --git a/test/Test/Cores/Ethernet/Mac/FrameCheckSequence.hs b/test/Test/Cores/Ethernet/Mac/FrameCheckSequence.hs index 3d7593d..4e6b1e7 100644 --- a/test/Test/Cores/Ethernet/Mac/FrameCheckSequence.hs +++ b/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 = diff --git a/test/unittests.hs b/test/unittests.hs index 9414ca1..9576069 100644 --- a/test/unittests.hs +++ b/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 ()