Skip to content

Commit

Permalink
Simplify fcs validator and strip fcs
Browse files Browse the repository at this point in the history
  • Loading branch information
t-wallet committed Sep 14, 2024
1 parent 60cd05b commit 270e582
Show file tree
Hide file tree
Showing 5 changed files with 137 additions and 104 deletions.
6 changes: 3 additions & 3 deletions nix/sources.json
Original file line number Diff line number Diff line change
Expand Up @@ -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": {
Expand Down
3 changes: 2 additions & 1 deletion src/Clash/Cores/Ethernet/Examples/RxStacks.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )

Expand All @@ -44,6 +44,7 @@ macRxStack ethClk ethRst ethEn macAddressS =
|> upConverterC'
|> asyncFifoC'
|> fcsValidatorC
|> fcsStripperC
|> macDepacketizerC
|> filterMetaS (isForMyMac <$> macAddressS)
where
Expand Down
196 changes: 112 additions & 84 deletions src/Clash/Cores/Ethernet/Mac/FrameCheckSequence.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
18 changes: 11 additions & 7 deletions test/Test/Cores/Ethernet/Mac/FrameCheckSequence.hs
Original file line number Diff line number Diff line change
@@ -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,
Expand Down Expand Up @@ -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 ::
Expand Down Expand Up @@ -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)

Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 =
Expand Down
18 changes: 9 additions & 9 deletions test/unittests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand Down

0 comments on commit 270e582

Please sign in to comment.