From e76b5bbba2a787d971bfa4e53643d2e191e00169 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:10:30 +0200 Subject: [PATCH 01/30] Add common types and functions --- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 142 ++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/Common.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs new file mode 100644 index 0000000000..1edcadce6f --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -0,0 +1,142 @@ +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Common functions, type definitions and hard-coded settings used in the +-- different modules that are defined for SGMII +module Clash.Cores.Sgmii.Common where + +import Clash.Cores.LineCoding8b10b +import Clash.Prelude + +-- | Format of a single code group, 10-bit +type Cg = BitVector 10 + +-- | Format of @rxConfReg@ and @txConfReg@, size of two data words +type ConfReg = BitVector 16 + +-- | Defines the type of the signal that indicates whether the current received +-- code group is at an even or odd index in the sequence +data Even = Even | Odd + deriving (Generic, NFDataX, Eq, Show) + +-- | Function that makes an Even RxEven Odd, and vice-versa +nextEven :: Even -> Even +nextEven Even = Odd +nextEven Odd = Even + +-- | Link speed that was communicated by the PHY +data LinkSpeed = Speed10 | Speed100 | Speed1000 + deriving (Generic, NFDataX, Eq, Show) + +-- | Get the current link speed from a 'ConfReg' +toLinkSpeed :: ConfReg -> LinkSpeed +toLinkSpeed confReg + | s == 0b10 = Speed1000 + | s == 0b01 = Speed100 + | otherwise = Speed10 + where + s = pack (testBit confReg 11) ++# pack (testBit confReg 10) + +-- | Defines the possible different types of ordered sets that can be generated +-- by the 'Sgmii.PcsTransmit.orderedSet' process +data OrderedSet + = OSetC + | OSetI + | OSetR + | OSetS + | OSetT + | OSetV + | OSetD + deriving (Generic, NFDataX, Eq, Show) + +-- | Defines the possible values for the RUDI output signal of the PCS Receive +-- block as defined in IEEE 802.3 Clause 36 +data Rudi = C | I | Invalid + deriving (Generic, NFDataX, Eq, Show) + +-- | Record that holds the current status of the module, specifically the +-- 'SyncStatus' from 'Sgmii.sync', the 'ConfReg' that has been received by +-- 'Sgmii.pcsReceive', the 'Rudi' that is transmitted by 'Sgmii.pcsReceive' +-- and the 'Xmit' that is transmitted by 'Sgmii.autoNeg'. +data SgmiiStatus = SgmiiStatus + { _cBsOk :: Bool + , _cSyncStatus :: SyncStatus + , _cRxConfReg :: ConfReg + , _cRudi :: Rudi + , _cXmit :: Xmit + } + +-- | Defines the type of the signal that indicates whether the transmission is +-- in sync ('Ok') or not ('Fail') +data SyncStatus = Ok | Fail + deriving (Generic, NFDataX, Eq, Show) + +-- | Signal that is received by the two PCS blocks from the auto-negotiation +-- block to indicate the current state of the auto-negotiation block +data Xmit = Conf | Data | Idle + deriving (Generic, NFDataX, Eq, Show, BitPack) + +-- | Return a 'Just' when the argument is 'True', else return a 'Nothing' +orNothing :: Bool -> a -> Maybe a +orNothing True a = Just a +orNothing False _ = Nothing + +-- | Code group that corresponds to K28.5 with negative disparity +cgK28_5N :: Cg +cgK28_5N = 0b0101111100 + +-- | Code group that corresponds to K28.5 with positive disparity +cgK28_5P :: Cg +cgK28_5P = 0b1010000011 + +-- | Data word corresponding to the decoded version of code group D00.0, used +-- for early-end detection +dwD00_0 :: Symbol8b10b +dwD00_0 = Dw 0b00000000 + +-- | Data word corresponding to the decoded version of code group D02.2, used +-- for alternating configuration transmission +dwD02_2 :: Symbol8b10b +dwD02_2 = Dw 0b01000010 + +-- | Data word corresponding to the decoded version of code group D05.6, used +-- for correcting idle transmission +dwD05_6 :: Symbol8b10b +dwD05_6 = Dw 0b11000101 + +-- | Data word corresponding to the decoded version of code group D16.2, used +-- for preserving idle transmission +dwD16_2 :: Symbol8b10b +dwD16_2 = Dw 0b01010000 + +-- | Data word corresponding to the decoded version of code group D21.5, used +-- for alternating configuration transmission +dwD21_5 :: Symbol8b10b +dwD21_5 = Dw 0b10110101 + +-- | Data word corresponding to the decoded version of code group K28.5, the +-- most commonly used comma value +cwK28_5 :: Symbol8b10b +cwK28_5 = Cw 0b10111100 + +-- | Data word corresponding to the decoded version of code group K23.7, used +-- for encapsulation of @Carrier_Extend@ (/R/) +cwR :: Symbol8b10b +cwR = Cw 0b11110111 + +-- | Data word corresponding to the decoded version of code group K27.7, used +-- for encapsulation of @Start_of_Packet@ (/S/) +cwS :: Symbol8b10b +cwS = Cw 0b11111011 + +-- | Data word corresponding to the decoded version of code group D29.7, used +-- for encapsulation of @End_of_Packet@ (/T/) +cwT :: Symbol8b10b +cwT = Cw 0b11111101 + +-- | Data word corresponding to the decoded version of code group K30.7, used +-- for encapsulation of @Error_Propagation@ (/V/) +cwV :: Symbol8b10b +cwV = Cw 0b11111110 From 1ee777372ec057bb51c67de29d5196d946885771 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:11:43 +0200 Subject: [PATCH 02/30] Add word alignment block --- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 100 +++++++++++++++++++ clash-cores/test/Test/Cores/Sgmii/BitSlip.hs | 93 +++++++++++++++++ 2 files changed, 193 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs create mode 100644 clash-cores/test/Test/Cores/Sgmii/BitSlip.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs new file mode 100644 index 0000000000..0f919b061d --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Bit slip function that word-aligns a stream of bits based on received +-- comma values +module Clash.Cores.Sgmii.BitSlip where + +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (fromJust, isNothing) + +-- | State variable for 'bitSlip', with the two states as described in +-- 'bitSlipT'. Due to timing constraints, not all functions can be executed in +-- the same cycle, which is why intermediate values are saved in the record +-- for 'BSFail'. +data BitSlipState + = BSFail + { _s :: BitVector 20 + , _ns :: Vec 8 (Index 10) + , _hist :: Vec 10 (BitVector 10) + } + | BSOk {_s :: BitVector 20, _n :: Index 10} + deriving (Generic, NFDataX, Eq, Show) + +-- | Reverse the bits of a 'BitVector' +reverseBV :: (KnownNat n) => BitVector n -> BitVector n +reverseBV = v2bv . reverse . bv2v + +-- | State transition function for 'bitSlip', where the initial state is the +-- training state, and after 8 consecutive commas have been detected at the +-- same index in the status register it moves into the 'BSOk' state where the +-- recovered index is used to shift the output 'BitVector' +bitSlipT :: + -- | Current state + BitSlipState -> + -- | New input values + (Cg, SyncStatus) -> + -- | New state + BitSlipState +bitSlipT BSFail{..} (cg, _) + | isNothing n = BSFail s ns hist + | _ns == repeat (fromJust n) = BSOk s (fromJust n) + | otherwise = BSFail s ns hist + where + s = resize $ _s ++# reverseBV cg + ns = maybe _ns (_ns <<+) n + hist = map pack $ take d10 $ windows1d d10 $ bv2v s + + n = elemIndex True $ map f _hist + where + f a = a == reverseBV cgK28_5N || a == reverseBV cgK28_5P +bitSlipT BSOk{..} (cg, syncStatus) + | syncStatus == Fail = BSFail s (repeat _n) (repeat 0) + | otherwise = BSOk s _n + where + s = resize $ _s ++# reverseBV cg + +-- | Output function for 'bitSlip' that takes the calculated index value and +-- rotates the state vector to create the new output value, or outputs the +-- input directly when no such index value has been found yet. +bitSlipO :: + -- | Current state + BitSlipState -> + -- | New output value + (BitSlipState, Cg, Bool) +bitSlipO self = + (self, reverseBV $ resize $ rotateR self._s (10 - fromEnum n), bsOk) + where + (n, bsOk) = case self of + BSFail{} -> (last self._ns, False) + BSOk{} -> (self._n, True) + +-- | Function that takes a code word and returns the same code word, but if a +-- comma is detected the code words is shifted such that the comma is at the +-- beginning of the next code word to achieve word-alignment. +bitSlip :: + forall dom. + (HiddenClockResetEnable dom) => + -- | Input code group + Signal dom Cg -> + -- | Current sync status from 'Sgmii.sync' + Signal dom SyncStatus -> + -- | Output code group + (Signal dom Cg, Signal dom Bool) +bitSlip cg1 syncStatus = (register 0 cg2, register False bsOk) + where + (_, cg2, bsOk) = + mooreB + bitSlipT + bitSlipO + (BSFail 0 (repeat 0) (repeat 0)) + (cg1, syncStatus) + +{-# CLASH_OPAQUE bitSlip #-} diff --git a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs new file mode 100644 index 0000000000..f70503329f --- /dev/null +++ b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs @@ -0,0 +1,93 @@ +module Test.Cores.Sgmii.BitSlip where + +import Clash.Cores.Sgmii.BitSlip +import Clash.Cores.Sgmii.Common +import Clash.Hedgehog.Sized.BitVector +import qualified Clash.Prelude as C +import Data.List (find) +import Data.Maybe (isJust, isNothing) +import qualified Hedgehog as H +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Cores.LineCoding8b10b +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH +import Prelude + +-- | Version of 'bitSlip' that also outputs the current state, used to check +-- if the correct state has been reached +bitSlipSim :: + forall dom. + (C.HiddenClockResetEnable dom) => + C.Signal dom (C.BitVector 10) -> + C.Signal dom (BitSlipState, C.BitVector 10, Bool) +bitSlipSim cg = + C.bundle $ + C.mooreB + bitSlipT + bitSlipO + (BSFail 0 (C.repeat 0) (C.repeat 0)) + (cg, pure Ok) + +-- | Check that if 'bitSlip' moves into 'BSOk', the index is non-zero as it +-- needs to be over code group boundaries due to 'checkBitSequence' +prop_bitSlipNoBSOk :: H.Property +prop_bitSlipNoBSOk = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- + H.forAll + ( Gen.list + (Range.singleton simDuration) + (Gen.filter checkBitSequence genDefinedBitVector) + ) + let simOut = + map f $ + drop 1 $ + C.sampleN + (simDuration + 1) + (bitSlipSim @C.System (C.fromList (0 : inp))) + where + f (s, _, _) = s + + H.assert $ isNothing $ find g simOut + where + g (BSOk _ 0) = True + g _ = False + +-- | Check that with the comma at the third index, the output is equal to a +-- shifted version of the input, and the comma is actually at the third index +prop_bitSlipInOutCorrect :: H.Property +prop_bitSlipInOutCorrect = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp1 <- + H.forAll + ( Gen.list + (Range.singleton simDuration) + ( Gen.filter + (\a -> isValidCodeGroup a && checkBitSequence a) + genDefinedBitVector + ) + ) + let inp2 = concatMap (\a -> [0b0101111100, a]) inp1 + + simOut = + drop 4 $ + C.sampleN + (length inp2 + 1) + (bitSlipSim @C.System (C.fromList (0 : inp2))) + + expected = take (length simOut) $ tail inp2 + + map f simOut H.=== expected + H.assert $ isJust $ find g simOut + where + f (_, cg, _) = cg + + g (BSOk _ 0, _, _) = True + g _ = False + +tests :: TestTree +tests = $(testGroupGenerator) From 7f45f1afa5f3f22832c7d8448e1369dd08647aa5 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:12:47 +0200 Subject: [PATCH 03/30] Add synchronization block --- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 232 ++++++++++++++++++++++ clash-cores/test/Test/Cores/Sgmii/Sync.hs | 97 +++++++++ 2 files changed, 329 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/Sync.hs create mode 100644 clash-cores/test/Test/Cores/Sgmii/Sync.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs new file mode 100644 index 0000000000..3fe4c86241 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -0,0 +1,232 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Synchronization process, as defined in IEEE 802.3 Figure 36-9 +module Clash.Cores.Sgmii.Sync where + +import Clash.Cores.LineCoding8b10b +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (isNothing) + +-- | State type of the output queue for 'sync' +type OutputQueue = Vec 3 (Cg, Bool, Symbol8b10b, Even, SyncStatus) + +-- | State type of 'sync'. This contains all states as they are defined in IEEE +-- 802.3 Clause 36. +data SyncState + = LossOfSync {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | CommaDetect1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} + | AcquireSync1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | CommaDetect2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} + | AcquireSync2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | CommaDetect3 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} + | SyncAcquired1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | SyncAcquired2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | SyncAcquired2A + { _cg :: Cg + , _rd :: Bool + , _dw :: Symbol8b10b + , _rxEven :: Even + , _goodCgs :: Index 4 + } + | SyncAcquired3 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | SyncAcquired3A + { _cg :: Cg + , _rd :: Bool + , _dw :: Symbol8b10b + , _rxEven :: Even + , _goodCgs :: Index 4 + } + | SyncAcquired4 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | SyncAcquired4A + { _cg :: Cg + , _rd :: Bool + , _dw :: Symbol8b10b + , _rxEven :: Even + , _goodCgs :: Index 4 + } + deriving (Generic, NFDataX, Eq, Show) + +-- | Vector containing the two alternative forms (with opposite running +-- disparity) of K28.5. This is the only relevant comma, as the other commas +-- are set as "reserved" in the list of control words. The order of the commas +-- in this is important, as the first comma returns the negative running +-- disparity when it is decoded and the second comma returns the positive +-- running disparity when it is decoded. This is used in 'LossOfSync' to +-- recover the correct running disparity from a received comma. +commas :: Vec 2 Cg +commas = cgK28_5N :> cgK28_5P :> Nil + +-- | State transition function for 'sync'. Takes the state as defined in +-- 'SyncState', a the new incoming code group from the deserialization block +-- and returns the next state as defined in Clause 36 of IEEE 802.3. As is +-- described in the documentation for 'Sgmii.pcsReceive', this function also +-- does the decoding of 10-bit code groups (which is usually done by +-- 'Sgmii.pcsReceive') as it needs the information provided by the decode +-- function to determine whether a code group corresponds to a valid data +-- word. +syncT :: + -- | Current state + SyncState -> + -- | New input codegroup + Cg -> + -- | New state and output tuple + SyncState +syncT LossOfSync{..} cg + | isNothing comma = LossOfSync cg rd dw rxEven + | otherwise = CommaDetect1 cg rd dw + where + -- As written in the documentation for 'commas', this is used to recover the + -- running disparity in case there has been a reset + comma = elemIndex cg commas + rdNew = maybe _rd bitCoerce comma + + (rd, dw) = decode8b10b rdNew cg + rxEven = nextEven _rxEven +syncT CommaDetect1{..} cg + | not (isDw dw) = LossOfSync cg rd dw Even + | otherwise = AcquireSync1 cg rd dw Even + where + (rd, dw) = decode8b10b _rd cg +syncT AcquireSync1{..} cg + | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Odd = CommaDetect2 cg rd dw + | otherwise = AcquireSync1 cg rd dw rxEven + where + (rd, dw) = decode8b10b _rd cg + rxEven = nextEven _rxEven +syncT CommaDetect2{..} cg + | not (isDw dw) = LossOfSync cg rd dw Even + | otherwise = AcquireSync2 cg rd dw Even + where + (rd, dw) = decode8b10b _rd cg +syncT AcquireSync2{..} cg + | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Odd = CommaDetect3 cg rd dw + | otherwise = AcquireSync2 cg rd dw rxEven + where + (rd, dw) = decode8b10b _rd cg + rxEven = nextEven _rxEven +syncT CommaDetect3{..} cg + | not (isDw dw) = LossOfSync cg rd dw Even + | otherwise = SyncAcquired1 cg rd dw Even + where + (rd, dw) = decode8b10b _rd cg +syncT SyncAcquired1{..} cg + | not (isValidSymbol dw) = SyncAcquired2 cg rd dw rxEven + | cg `elem` commas && rxEven == Even = SyncAcquired2 cg rd dw rxEven + | otherwise = SyncAcquired1 cg rd dw rxEven + where + (rd, dw) = decode8b10b _rd cg + rxEven = nextEven _rxEven +syncT self cg + | not (isValidSymbol dw) = s1 cg rd dw rxEven + | cg `elem` commas && rxEven == Even = s1 cg rd dw rxEven + | goodCgs == maxBound = s2 cg rd dw rxEven + | otherwise = s3 cg rd dw rxEven goodCgs + where + (s1, s2, s3, goodCgs) = case self of + SyncAcquired2{} -> (SyncAcquired3, undefined, SyncAcquired2A, 0) + SyncAcquired2A{} -> + (SyncAcquired3, SyncAcquired1, SyncAcquired2A, self._goodCgs + 1) + SyncAcquired3{} -> (SyncAcquired4, undefined, SyncAcquired3A, 0) + SyncAcquired3A{} -> + (SyncAcquired4, SyncAcquired2, SyncAcquired3A, self._goodCgs + 1) + SyncAcquired4{} -> (LossOfSync, undefined, SyncAcquired4A, 0) + SyncAcquired4A{} -> + (LossOfSync, SyncAcquired3, SyncAcquired4A, self._goodCgs + 1) + + (rd, dw) = decode8b10b self._rd cg + rxEven = nextEven self._rxEven + +-- | Output function for 'sync'. Takes the state as defined in 'SyncState' and +-- returns a tuple containing the outputs as defined in Clause 36 of IEEE +-- 802.3 +syncO :: + -- | Current state + SyncState -> + -- | New state and output tuple + (SyncState, Cg, Bool, Symbol8b10b, Even, SyncStatus) +syncO self@LossOfSync{..} = (self, _cg, _rd, _dw, rxEven, Fail) + where + rxEven = nextEven _rxEven +syncO self@CommaDetect1{..} = (self, _cg, _rd, _dw, Even, Fail) +syncO self@AcquireSync1{..} = (self, _cg, _rd, _dw, rxEven, Fail) + where + rxEven = nextEven _rxEven +syncO self@CommaDetect2{..} = (self, _cg, _rd, _dw, Even, Fail) +syncO self@AcquireSync2{..} = (self, _cg, _rd, _dw, rxEven, Fail) + where + rxEven = nextEven _rxEven +syncO self@CommaDetect3{..} = (self, _cg, _rd, _dw, Even, Fail) +syncO self = (self, self._cg, self._rd, self._dw, rxEven, Ok) + where + rxEven = nextEven self._rxEven + +-- | Transition function for the inputs of 'Sgmii.pcsReceive'. This is used to +-- keep a small list of "future" values for 'Symbol8b10b', such that these can +-- be used in 'Sgmii.checkEnd'. +outputQueueT :: + -- | Current state with three values for all inputs + OutputQueue -> + -- | New input values for the code group, running disparity, data word, 'Even' + -- signal and 'SyncStatus; + (Cg, Bool, Symbol8b10b, Even, SyncStatus) -> + -- | New state + OutputQueue +outputQueueT s i = s <<+ i + +-- | Output function for the output queue, where the values are taken from the +-- current state +outputQueueO :: + -- Current state with three values for all inputs + OutputQueue -> + -- | New output with one value for everything except 'Symbol8b10b' for the + -- prescient 'Sgmii.checkEnd' function. + (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus) +outputQueueO s = (cg, rd, dw, rxEven, syncStatus) + where + (head -> cg, head -> rd, dw, head -> rxEven, head -> syncStatus) = unzip5 s + +-- | Takes a code group and runs it through the state machine as defined in +-- IEEE 802.3 Clause 36 to check whether the signal is synchronized. If it is +-- not, output 'SyncStatus' @Fail@ and try to re-aquire synchronization, else +-- simply pass through the new running disparity and 'Symbol8b10b' from the +-- decoded code group as well as the 'Even' signal. The current code word is +-- also propagated as it is required by 'Sgmii.pcsReceive'. This function +-- contains a list of data words as these need to be used by the prescient +-- 'Sgmii.checkEnd' function. +sync :: + (HiddenClockResetEnable dom) => + -- | New code group from the PHY + Signal dom Cg -> + -- | A tuple containing the input code group, running disparity, a new + -- 'Symbol8b10b', the new value for 'Even' and the current synchronization + -- status + ( Signal dom Cg + , Signal dom Bool + , Signal dom (Vec 3 Symbol8b10b) + , Signal dom Even + , Signal dom SyncStatus + ) +sync rxCg = + mooreB + outputQueueT + outputQueueO + (repeat (0, False, Dw 0, Odd, Fail)) + (cg, rd, dw, rxEven, syncStatus) + where + (_, cg, rd, dw, rxEven, syncStatus) = + mooreB syncT syncO (LossOfSync 0 False (Dw 0) Even) rxCg + +{-# CLASH_OPAQUE sync #-} diff --git a/clash-cores/test/Test/Cores/Sgmii/Sync.hs b/clash-cores/test/Test/Cores/Sgmii/Sync.hs new file mode 100644 index 0000000000..8d4fbc74af --- /dev/null +++ b/clash-cores/test/Test/Cores/Sgmii/Sync.hs @@ -0,0 +1,97 @@ +module Test.Cores.Sgmii.Sync where + +import Clash.Cores.LineCoding8b10b +import Clash.Cores.Sgmii.Common +import Clash.Cores.Sgmii.Sync +import Clash.Hedgehog.Sized.BitVector +import qualified Clash.Prelude as C +import Data.Function (on) +import Data.List (group, mapAccumL, maximumBy) +import qualified Hedgehog as H +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Cores.LineCoding8b10b +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH +import Prelude + +-- | Simulation function for 'sync' that provides a bundled output +syncSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom Cg -> + C.Signal dom (Cg, Bool, C.Vec 3 Symbol8b10b, Even, SyncStatus) +syncSim cg = C.bundle $ sync cg + +-- | Run the 'sync' function on a list of values that do not contain any comma +-- code groups and assert that the 'SyncStatus' will never go to 'Ok' +prop_syncNotOk :: H.Property +prop_syncNotOk = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- + H.forAll + ( Gen.list + (Range.singleton simDuration) + (Gen.filter checkBitSequence genDefinedBitVector) + ) + let simOut = + map f $ + C.sampleN (simDuration + 1) (syncSim @C.System (C.fromList (0 : inp))) + where + f (_, _, _, _, syncStatus) = syncStatus + + H.assert (Ok `notElem` simOut) + +-- | Check that for any given input data word, this data word will always be +-- propagated to the output of the 'sync' block +prop_syncPropagateDw :: H.Property +prop_syncPropagateDw = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- + H.forAll + ( Gen.list + (Range.singleton simDuration) + (Gen.filter checkBitSequence genDefinedBitVector) + ) + let delaySamples = 4 + + simOut = + map f $ + drop (1 + delaySamples) $ + C.sampleN + (simDuration + 1) + (syncSim @C.System (C.fromList (0 : inp))) + where + f (_, _, dw, _, _) = C.head dw + + expected = + take (simDuration - delaySamples) $ + snd (mapAccumL decode8b10b False inp) + + simOut H.=== expected + +-- | Assert that 'Even' is never two times 'Odd' in a row, and that 'Even' +-- is never the same more than two times in a row +prop_syncCheckEven :: H.Property +prop_syncCheckEven = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let delaySamples = 4 + + simOut = + map f $ + drop delaySamples $ + C.sampleN + (simDuration + delaySamples) + (syncSim @C.System (C.fromList (replicate delaySamples 0 ++ inp))) + where + f (_, _, _, rxEven, _) = rxEven + + H.assert $ [Odd, Odd] `notElem` group simOut + H.assert $ length (maximumBy (compare `on` length) (group simOut)) < 3 + +tests :: TestTree +tests = $(testGroupGenerator) From f5dbb5b8ae374e72ef1c1ff3f5c219b6d3b6cc10 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:13:36 +0200 Subject: [PATCH 04/30] Add PCS receive block --- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 352 ++++++++++++++++++ 1 file changed, 352 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs new file mode 100644 index 0000000000..39c0522d94 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- PCS receive process, as defined in IEEE 802.3 Figure 36-7a and 36-7b +module Clash.Cores.Sgmii.PcsReceive where + +import Clash.Cores.LineCoding8b10b +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (fromJust, fromMaybe, isJust) + +-- | Defines all possible valid 'checkEnd' results +data CheckEnd + = K28_5DK28_5 + | K28_5D21_5D00_0 + | K28_5D02_2D00_0 + | TRK28_5 + | TRR + | RRR + | RRK28_5 + | RRS + deriving (Eq, Show) + +-- | State type of 'pcsReceive'. This contains all states as they are defined in +-- IEEE 802.3 Clause 36, with with exeception of the states @CARRIER_DETECT@, +-- @RECEIVE@ and @EPD2_CHECK_END@ as these do not act upon a received code +-- group. The transitions of these states are embedded in the states that +-- usually transition to either of these states. +data PcsReceiveState + = WaitForK {_rx :: Bool, _xmit :: Xmit} + | RxK {_rx :: Bool, _xmit :: Xmit} + | RxCB {_rx :: Bool, _xmit :: Xmit} + | RxCC {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} + | RxCD + { _rx :: Bool + , _xmit :: Xmit + , _hist :: Symbol8b10b + , _rxConfReg :: ConfReg + } + | RxInvalid {_rx :: Bool, _xmit :: Xmit} + | IdleD {_rx :: Bool, _xmit :: Xmit} + | FalseCarrier {_rx :: Bool, _xmit :: Xmit} + | StartOfPacket {_rx :: Bool, _xmit :: Xmit} + | EarlyEnd {_rx :: Bool, _xmit :: Xmit} + | TriRri {_rx :: Bool, _xmit :: Xmit} + | TrrExtend {_rx :: Bool, _xmit :: Xmit} + | PacketBurstRrs {_rx :: Bool, _xmit :: Xmit} + | ExtendErr {_rx :: Bool, _xmit :: Xmit} + | EarlyEndExt {_rx :: Bool, _xmit :: Xmit} + | RxData {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} + | RxDataError {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} + | LinkFailed {_rx :: Bool, _xmit :: Xmit} + deriving (Generic, NFDataX, Eq, Show) + +-- | Calculate the number of bits that are different in two code groups. For +-- example: the code groups @0b0000@ and @0b0001@ have a difference of 1. +bitDiff :: + (KnownNat n) => + -- | First code group + BitVector n -> + -- | Second code group + BitVector n -> + -- | Bit difference + Index (n + 1) +bitDiff cg0 cg1 = foldl f 0 $ map bitCoerce $ bv2v $ xor cg0 cg1 + where + f a b = if b then a + 1 else a + +-- | Take the running disparity, the 'Even' signal and the current data word +-- and determine whether there is a 2-bit or more difference between the code +-- group and both alternative representations of the K28.5 control word or a +-- difference of between 2 and 9 bits between the code group and the expected +-- encoding of the K28.5 control word +carrierDetect :: + -- | Code group + Cg -> + -- | Running disparity + Bool -> + -- | 'Even' signal + Even -> + -- | The 'carrierDetect' condition + Bool +carrierDetect cg rd rxEven + | rxEven /= Even = False + | bitDiff cgK28_5N cg >= 2 && bitDiff cgK28_5P cg >= 2 = True + | bitDiff cgK28_5 cg >= 2 && bitDiff cgK28_5 cg <= 9 = True + | otherwise = False + where + cgK28_5 = if rd then cgK28_5P else cgK28_5N + +-- | Function that implements the transitions of the @RECEIVE@ state +receive :: Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState +receive dws rxEven rx xmit + | rxEnd == Just K28_5DK28_5 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just K28_5D21_5D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just K28_5D02_2D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just TRK28_5 && rxEven == Even = Just (TriRri rx xmit) + | rxEnd == Just TRR = Just (TrrExtend rx xmit) + | rxEnd == Just RRR = Just (EarlyEnd rx xmit) + | isDw (head dws) = Just (RxData rx xmit dw) + | otherwise = Nothing + where + rxEnd = checkEnd dws + dw = head dws + +-- | Function that implements the transitions of the @EPD2_CHECK_END@ state +epd2CheckEnd :: + Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState +epd2CheckEnd dws rxEven rx xmit + | rxEnd == Just RRR = Just (TrrExtend rx xmit) + | rxEnd == Just RRK28_5 && rxEven == Even = Just (TriRri rx xmit) + | rxEnd == Just RRS = Just (PacketBurstRrs rx xmit) + | otherwise = Nothing + where + rxEnd = checkEnd dws + +-- | Take the running disparity, the current and next two input data words and +-- check whether they correspond to one of the specified end conditions +checkEnd :: + -- | Current and next 2 data words + Vec 3 Symbol8b10b -> + -- | End condition + Maybe CheckEnd +checkEnd dws + | dws == cwK28_5 :> dws !! (1 :: Index 3) :> cwK28_5 :> Nil = Just K28_5DK28_5 + | dws == cwK28_5 :> dwD21_5 :> dwD00_0 :> Nil = Just K28_5D21_5D00_0 + | dws == cwK28_5 :> dwD02_2 :> dwD00_0 :> Nil = Just K28_5D02_2D00_0 + | dws == cwT :> cwR :> cwK28_5 :> Nil = Just TRK28_5 + | dws == cwT :> Nil ++ repeat cwR = Just TRR + | dws == repeat cwR = Just RRR + | dws == repeat cwR ++ cwK28_5 :> Nil = Just RRK28_5 + | dws == repeat cwR ++ cwS :> Nil = Just RRS + | otherwise = Nothing + +-- | State transition function for 'pcsReceive'. Takes the state as defined in +-- 'PcsReceiveState' and returns the next state as defined in Clause 36 of +-- IEEE 802.3. In contrast to the specification in Clause 36, here +-- 'Sgmii.syncT' is responsible for decoding the code groups instead of this +-- function, to not duplicate any work, but as this function does need to +-- determine the difference in bits ('bitDifference') the code group is set as +-- an input value as well. +-- +-- __N.B.__: This function does not implement the optional EEE +-- (Energy-Efficient Ethernet) capability. +pcsReceiveT :: + -- | Current state + PcsReceiveState -> + -- | Input values, where @Vec 3 CodeGroup@ contains the current and next two + -- | data words + (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus, Maybe Xmit) -> + -- | New state + PcsReceiveState +pcsReceiveT WaitForK{..} (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit' + | head dws == cwK28_5 && rxEven == Even = RxK False xmit' + | otherwise = WaitForK _rx xmit' + where + xmit' = fromMaybe _xmit xmit +pcsReceiveT RxK{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit' + | dw == dwD21_5 = RxCB False xmit' + | dw == dwD02_2 = RxCB False xmit' + | not (isDw dw) && xmit' /= Data = RxInvalid False xmit' + | xmit' /= Data && isDw dw = IdleD False xmit' + | xmit' == Data = IdleD False xmit' + | otherwise = RxK _rx xmit' + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT RxCB{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | isDw dw = RxCC _rx xmit' dw + | otherwise = RxInvalid _rx xmit' + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT RxCC{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | isDw dw = RxCD _rx xmit' dw $ resize $ fromSymbol _hist + | otherwise = RxInvalid _rx xmit' + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT RxCD{..} (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | dw == cwK28_5 && rxEven == Even = RxK _rx xmit' + | dw /= cwK28_5 = RxInvalid _rx xmit' + | rxEven == Odd = RxInvalid _rx xmit' + | otherwise = RxCD _rx xmit' _hist _rxConfReg + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT RxInvalid{..} (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed rx xmit' + | dw == cwK28_5 && rxEven == Even = RxK rx xmit' + | dw /= cwK28_5 && rxEven == Even = WaitForK rx xmit' + | otherwise = RxInvalid _rx xmit' + where + rx = xmit' == Data || _rx + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT IdleD{..} (cg, rd, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit' + | dw /= cwK28_5 && xmit' /= Data = RxInvalid False xmit' + | carrierDetected && xmit' == Data && dw /= cwS = FalseCarrier False xmit' + | carrierDetected && xmit' == Data && dw == cwS = StartOfPacket False xmit' + | otherwise = RxK False xmit' + where + carrierDetected = carrierDetect cg rd rxEven + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT FalseCarrier{..} (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed True xmit' + | dw == cwK28_5 && rxEven == Even = RxK True xmit' + | otherwise = FalseCarrier _rx xmit' + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT EarlyEnd{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | dw == dwD02_2 = RxCB _rx xmit' + | dw == dwD21_5 = RxCB _rx xmit' + | otherwise = IdleD _rx xmit' + where + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT TriRri{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit' + | head dws == cwK28_5 = RxK False xmit' + | otherwise = TriRri _rx xmit' + where + xmit' = fromMaybe _xmit xmit +pcsReceiveT PacketBurstRrs{..} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | head dws == cwS = StartOfPacket _rx xmit' + | otherwise = PacketBurstRrs _rx xmit' + where + xmit' = fromMaybe _xmit xmit +pcsReceiveT ExtendErr{..} (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed _rx xmit' + | dw == cwS = StartOfPacket _rx xmit' + | dw == cwK28_5 && rxEven == Even = RxK _rx xmit' + | isJust s && rxEven == Even = fromJust s + | otherwise = ExtendErr _rx xmit' + where + s = epd2CheckEnd dws rxEven _rx xmit' + xmit' = fromMaybe _xmit xmit + dw = head dws +pcsReceiveT LinkFailed{..} (_, _, _, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit' + | otherwise = WaitForK False xmit' + where + xmit' = fromMaybe _xmit xmit +pcsReceiveT self (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed self._rx xmit' + | isJust s1 = fromJust s1 + | otherwise = s2 + where + (s1, s2) = case self of + TrrExtend{} -> + (epd2CheckEnd dws rxEven self._rx xmit', ExtendErr self._rx xmit') + EarlyEndExt{} -> + (epd2CheckEnd dws rxEven self._rx xmit', ExtendErr self._rx xmit') + _ -> (receive dws rxEven self._rx xmit', RxDataError self._rx xmit' dw) + + xmit' = fromMaybe self._xmit xmit + dw = head dws + +-- | Output function for 'pcsReceive', that sets the outputs as defined in IEEE +-- 802.3 Clause 36. +pcsReceiveO :: + -- | Current state + PcsReceiveState -> + -- | New output values + ( PcsReceiveState + , Maybe Bool + , Maybe Bool + , Maybe Symbol8b10b + , Maybe Rudi + , Maybe ConfReg + ) +pcsReceiveO self = case self of + WaitForK{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) + RxK{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) + RxCB{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) + RxCD{} -> (self, Nothing, Nothing, Nothing, Just C, Just rxConfReg) + RxInvalid{} -> (self, Nothing, Nothing, Nothing, rudi1, Nothing) + IdleD{} -> (self, Just False, Just False, Nothing, Just I, Nothing) + FalseCarrier{} -> + (self, Nothing, Just True, Just (Cw 0b00001110), Nothing, Nothing) + StartOfPacket{} -> + (self, Just True, Just False, Just (Cw 0b01010101), Nothing, Nothing) + EarlyEnd{} -> (self, Nothing, Just True, Nothing, Nothing, Nothing) + TriRri{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) + TrrExtend{} -> + (self, Just False, Just True, Just (Cw 0b00001111), Nothing, Nothing) + PacketBurstRrs{} -> + (self, Just False, Nothing, Just (Cw 0b00001111), Nothing, Nothing) + ExtendErr{} -> + (self, Just False, Nothing, Just (Cw 0b00011111), Nothing, Nothing) + EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing, Nothing) + RxData{} -> (self, Nothing, Just False, Just self._hist, Nothing, Nothing) + RxDataError{} -> (self, Nothing, Just True, Just self._hist, Nothing, Nothing) + LinkFailed{} -> (self, rxDv, Just self._rx, Nothing, rudi2, Nothing) + _ -> (self, Nothing, Nothing, Nothing, Nothing, Nothing) + where + rxConfReg = (fromSymbol self._hist ++# 0) .|. self._rxConfReg + rudi1 = if self._xmit == Conf then Just Invalid else Nothing + rudi2 = if self._xmit /= Data then Just Invalid else Nothing + rxDv = if self._rx then Nothing else Just False + +-- | The 'pcsReceive' block. Takes a tuple with the new input code group, +-- running disparity and data word, 'Even', 'SyncStatus' and 'Xmit' signals +-- and runs the transition function 'pcsReceiveT'. The outputs are a set of +-- 'Maybe' values. +pcsReceive :: + (HiddenClockResetEnable dom) => + -- | Current code group from 'Sgmii.sync' + Signal dom Cg -> + -- | Current running disparity from 'Sgmii.sync' + Signal dom Bool -> + -- | Input 'Symbol8b10b' from 'Sgmii.sync' + Signal dom (Vec 3 Symbol8b10b) -> + -- | The 'Even' value from 'Sgmii.sync' + Signal dom Even -> + -- | The current 'SyncStatus' from 'Sgmii.sync' + Signal dom SyncStatus -> + -- | The 'Xmit' signal from 'Sgmii.autoNeg' + Signal dom (Maybe Xmit) -> + -- | Tuple containing the output values + ( Signal dom (Maybe Bool) + , Signal dom (Maybe Bool) + , Signal dom (Maybe Symbol8b10b) + , Signal dom (Maybe Rudi) + , Signal dom (Maybe ConfReg) + ) +pcsReceive cg rd dw1 rxEven syncStatus xmit = (rxDv, rxEr, dw2, rudi, rxConfReg) + where + (_, rxDv, rxEr, dw2, rudi, rxConfReg) = + mooreB + pcsReceiveT + pcsReceiveO + (WaitForK False Idle) + (cg, rd, dw1, rxEven, syncStatus, xmit) + +{-# CLASH_OPAQUE pcsReceive #-} From 5183c607aa40119fff728a33a1f4f0e338e54e04 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:14:16 +0200 Subject: [PATCH 05/30] Add auto-negotiation block --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 289 +++++++++++++++++++ clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs | 163 +++++++++++ 2 files changed, 452 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs create mode 100644 clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs new file mode 100644 index 0000000000..3812a198a7 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -0,0 +1,289 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Auto-negotiation process, as defined in IEEE 802.3 Figure 37-6 +module Clash.Cores.Sgmii.AutoNeg where + +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (fromJust, isJust) +import Data.Proxy + +-- | List of values for 'ConfReg' +type ConfRegs = Vec 3 ConfReg + +-- | List of values for 'Rudi' +type Rudis = Vec 3 Rudi + +-- | Type that specifies an 'Index' for the timeout of the link timer and the +-- timer used to qualify the 'Fail' status of 'SyncStatus' + +-- TODO: Replace this with @PeriodToCycles dom (Microseconds 1600)@, currently +-- this doesn't work because then I need to specify @1 <= DomainPeriod dom) +-- everywhere. +type Timeout dom = Index (DivRU (Microseconds 1600) (Max 1 (DomainPeriod dom))) + +-- | State type of 'autoNeg'. This contains all states as they are defined in +-- IEEE 802.3 Clause 37, with exception of the @AN_DISABLE_LINK_OK@ state as +-- SGMII always requires auto-negotiation to be available. +data AutoNegState dom + = AnEnable {_rudis :: Rudis, _rxConfRegs :: ConfRegs, _failT :: Timeout dom} + | AnRestart + { _rudis :: Rudis + , _rxConfRegs :: ConfRegs + , _failT :: Timeout dom + , _linkT :: Timeout dom + } + | AbilityDetect + { _rudis :: Rudis + , _rxConfRegs :: ConfRegs + , _failT :: Timeout dom + , _txConfReg :: ConfReg + } + | AcknowledgeDetect + { _rudis :: Rudis + , _rxConfRegs :: ConfRegs + , _failT :: Timeout dom + , _txConfReg :: ConfReg + } + | CompleteAcknowledge + { _rudis :: Rudis + , _rxConfRegs :: ConfRegs + , _failT :: Timeout dom + , _linkT :: Timeout dom + } + | IdleDetect + { _rudis :: Rudis + , _rxConfRegs :: ConfRegs + , _failT :: Timeout dom + , _linkT :: Timeout dom + } + | LinkOk {_rudis :: Rudis, _rxConfRegs :: ConfRegs, _failT :: Timeout dom} + deriving (Generic, NFDataX, Eq, Show) + +-- | The default configuration of the MAC as defined in the SGMII standard +mrAdvAbility :: ConfReg +mrAdvAbility = 0b0100000000000001 + +-- | The duration of @linkT@ is 1.6 ms according to the SGMII reference, +-- which means that it has a frequency of 625 Hz. This is the same as 200000 +-- cycles of the 125 MHz clock: @1.6*10^-3 / (1 / (125*10^6))@. +-- +-- For simulation and testing, this is set to a more reasonable amount of 3 +-- to decrease the amount of test values that are needed to trigger a timeout. +timeout :: (KnownDomain dom) => Proxy dom -> Timeout dom +timeout Proxy = if clashSimulation then 3 else maxBound + +-- | Function that handles the reset to 'AnEnable', this is split out to reduce +-- the amount of state transitions in every state +anEnable :: + forall dom. + (KnownDomain dom) => + -- | Fail timer value + Timeout dom -> + -- | New incoming RUDI value + Maybe Rudi -> + -- | History of RUDI values + Rudis -> + -- | History of configuration registers + ConfRegs -> + -- | Possible state transition + Maybe (AutoNegState dom) +anEnable failT rudi rudis rxConfRegs + | failT >= timeout (Proxy @dom) = + Just $ AnEnable rudis rxConfRegs (timeout (Proxy @dom) - 1) + | rudi == Just Invalid = Just $ AnEnable rudis rxConfRegs failT + | otherwise = Nothing + +-- | General part of the status update of the auto negotiation function, where +-- the new values of 'Rudi', 'ConfReg' and the 'Timeout's are handled. +anUpdate :: + (KnownDomain dom) => + AutoNegState dom -> + SyncStatus -> + Maybe Rudi -> + Maybe ConfReg -> + (Rudis, ConfRegs, Timeout dom, Timeout dom) +anUpdate s syncStatus rudi rxConfReg = (rudis, rxConfRegs, failT, linkT) + where + rudis = maybe s._rudis (s._rudis <<+) rudi + rxConfRegs = maybe s._rxConfRegs (s._rxConfRegs <<+) rxConfReg + failT = if syncStatus == Fail then s._failT + 1 else 0 + linkT = s._linkT + 1 + +-- | Check if the the last three received values of @rxConfReg@ are the same +-- (with the exception for bit 14, the acknowledge bit, which is discarded). +-- If there has been 'Rudi' value of 'I' in the same set of values, then +-- return 'False'. +abilityMatch :: + -- | Last three values for 'Rudi' + Rudis -> + -- | Last three values for 'ConfReg' + ConfRegs -> + -- | Whether they satisfy the 'abilityMatch' condition + Bool +abilityMatch rudis rxConfRegs = + repeat (head rxConfRegs') == rxConfRegs' && I `notElem` rudis + where + rxConfRegs' = map (replaceBit (14 :: Index 16) 0) rxConfRegs + +-- | Check if the last three values for 'ConfReg' are all the same, and also +-- check whether bit 14 (the acknowledge bit) has been asserted +acknowledgeMatch :: + -- | Last three values for 'ConfReg' + ConfRegs -> + -- | Whether they satisfy the 'acknowledgeMatch' condition + Bool +acknowledgeMatch rxConfRegs = + repeat (head rxConfRegs) == rxConfRegs && testBit (head rxConfRegs) 14 + +-- | Check if both 'abilityMatch' and 'acknowledgeMatch' are true for the same +-- set of 'Rudi' and 'ConfReg' values. +consistencyMatch :: + -- | Last three values for 'Rudi' + Rudis -> + -- | Last three values for 'ConfReg' + ConfRegs -> + -- | Whether they satisfy the 'consistencyMatch' condition + Bool +consistencyMatch rudis rxConfigRegs = + abilityMatch rudis rxConfigRegs && acknowledgeMatch rxConfigRegs + +-- | Function that checks that the last three values of 'Rudi' have been 'I' +idleMatch :: Rudis -> Bool +idleMatch = (==) (repeat I) + +-- | State transition function for 'autoNeg' as defined in IEEE 802.3 Clause 37. +-- It takes the current 'SyncStatus' from 'Sgmii.sync' as well as the 'Rudi' +-- and 'ConfReg' signals from 'Sgmii.pcsReceive'. +autoNegT :: + forall dom. + (KnownDomain dom) => + -- | Current state + AutoNegState dom -> + -- | New input values + (SyncStatus, Maybe Rudi, Maybe ConfReg) -> + -- | New state + AutoNegState dom +autoNegT self@AnEnable{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | otherwise = AnRestart rudis rxConfRegs failT 0 + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg +autoNegT self@AnRestart{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | linkT >= timeout (Proxy @dom) = + AbilityDetect rudis rxConfRegs failT mrAdvAbility + | otherwise = AnRestart rudis rxConfRegs failT linkT + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg +autoNegT self@AbilityDetect{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | abilityMatch rudis rxConfRegs && last rxConfRegs /= 0 = + AcknowledgeDetect rudis rxConfRegs failT txConfReg + | otherwise = AbilityDetect rudis rxConfRegs failT mrAdvAbility + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg + txConfReg = replaceBit (14 :: Index 16) 0 mrAdvAbility +autoNegT self@AcknowledgeDetect{..} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | acknowledgeMatch rxConfRegs && not (consistencyMatch rudis rxConfRegs) = + AnEnable rudis rxConfRegs failT + | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = + AnEnable rudis rxConfRegs failT + | acknowledgeMatch rxConfRegs && consistencyMatch rudis rxConfRegs = + CompleteAcknowledge rudis rxConfRegs failT 0 + | otherwise = AcknowledgeDetect rudis rxConfRegs failT txConfReg + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg + txConfReg = replaceBit (14 :: Index 16) 1 _txConfReg +autoNegT self@CompleteAcknowledge{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = + AnEnable rudis rxConfRegs failT + | linkT >= timeout (Proxy @dom) && not (abilityMatch rudis rxConfRegs) = + IdleDetect rudis rxConfRegs failT 0 + | linkT >= timeout (Proxy @dom) && last rxConfRegs /= 0 = + IdleDetect rudis rxConfRegs failT 0 + | otherwise = CompleteAcknowledge rudis rxConfRegs failT linkT + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg +autoNegT self@IdleDetect{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = + AnEnable rudis rxConfRegs failT + | linkT >= timeout (Proxy @dom) && idleMatch rudis = + LinkOk rudis rxConfRegs failT + | otherwise = IdleDetect rudis rxConfRegs failT linkT + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg +autoNegT self@LinkOk{} (syncStatus, rudi, rxConfReg) + | isJust s = fromJust s + | abilityMatch rudis rxConfRegs = AnEnable rudis rxConfRegs failT + | otherwise = LinkOk rudis rxConfRegs failT + where + s = anEnable failT rudi rudis rxConfRegs + (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg + +-- | Output function for 'autoNeg' as defined in IEEE 802.3 Clause 37. Returns +-- the new value for 'Xmit' and 'ConfReg' for 'Sgmii.pcsTransmit'. +autoNegO :: + forall dom. + (KnownDomain dom) => + -- | Current state + AutoNegState dom -> + -- | New outputs + (AutoNegState dom, Maybe Xmit, Maybe ConfReg) +autoNegO self@AnEnable{} = (self, Just Conf, Just 0) +autoNegO self@AnRestart{} = (self, Nothing, Just 0) +autoNegO self@AbilityDetect{..} = (self, Nothing, Just txConfReg) + where + txConfReg = replaceBit (14 :: Index 16) 0 _txConfReg +autoNegO self@AcknowledgeDetect{..} = (self, Nothing, Just txConfReg) + where + txConfReg = replaceBit (14 :: Index 16) 1 _txConfReg +autoNegO self@CompleteAcknowledge{} = (self, Nothing, Nothing) +autoNegO self@IdleDetect{} = (self, Just Idle, Nothing) +autoNegO self@LinkOk{} = (self, Just Data, Nothing) + +-- | Function that implements the auto-negotiation block as defined in IEEE +-- 802.3 Clause 37, but modified to comply to the SGMII standard. This +-- modification is the decrease of 'Timeout' from 10 ms to 1.6 ms. SGMII also +-- uses a different layout of the configuration register, but this does not +-- affect the state machine as the acknowledge bit is in the same location. +-- +-- __N.B.__: This function does not implement the optional Next Page function. +autoNeg :: + forall dom. + (HiddenClockResetEnable dom) => + -- | Current 'SyncStatus' from 'Sgmii.sync' + Signal dom SyncStatus -> + -- | A new value of 'Rudi' from 'Sgmii.pcsReceive' + Signal dom (Maybe Rudi) -> + -- | A new value of 'ConfReg' from 'Sgmii.pcsReceive' + Signal dom (Maybe ConfReg) -> + -- | Tuple containing the new value for 'Xmit' and a new 'ConfReg' + (Signal dom (Maybe Xmit), Signal dom (Maybe ConfReg)) +autoNeg syncStatus rudi rxConfReg = (xmit, txConfReg) + where + (_, xmit, txConfReg) = + mooreB + (autoNegT @dom) + (autoNegO @dom) + (AnEnable (repeat Invalid) (repeat 0) 0) + (syncStatus, rudi, rxConfReg) + +{-# CLASH_OPAQUE autoNeg #-} diff --git a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs new file mode 100644 index 0000000000..935558cf92 --- /dev/null +++ b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} + +module Test.Cores.Sgmii.AutoNeg where + +import Clash.Cores.Sgmii.AutoNeg +import Clash.Cores.Sgmii.Common +import Clash.Hedgehog.Sized.BitVector +import qualified Clash.Prelude as C +import Data.List (find) +import Data.Maybe (isJust, isNothing) +import qualified Hedgehog as H +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH +import Prelude + +-- | Generate a BitVector with its two most significant bits (15 and 14) set to +-- zero. Future improvement: also make bit 15 a random value. +genConfRegNoAck :: H.Gen ConfReg +genConfRegNoAck = (C.++#) (0b00 :: C.BitVector 2) <$> genDefinedBitVector + +-- | Generate a BitVector with its most significant bit (15) set to zero and the +-- acknowledge bit set to one. Future improvement: also make bit 15 a random +-- value. +genConfRegAck :: H.Gen ConfReg +genConfRegAck = (C.++#) (0b01 :: C.BitVector 2) <$> genDefinedBitVector + +-- | Generate a list of 'ConfReg's without bit 14 asserted +genConfRegsNoAck :: H.Range Int -> H.Gen [ConfReg] +genConfRegsNoAck range = do + confReg <- Gen.filter (/= 0) genConfRegNoAck + n <- Gen.int range + pure $ take n $ concat $ replicate n (replicate 3 confReg) + +-- | Generate a list of 'ConfReg's with bit 14 asserted where every value is +-- repeated 3 times in a row +genConfRegsAck :: H.Range Int -> H.Gen [ConfReg] +genConfRegsAck range = do + confReg <- Gen.filter (/= 0) genConfRegAck + n <- Gen.int range + pure $ take n $ concat $ replicate n (replicate 3 confReg) + +-- | Version of 'autoNeg' that does not return any actual values, but only the +-- entered state for debugging purposes. +autoNegSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom (SyncStatus, Maybe Rudi, Maybe ConfReg) -> + C.Signal dom (AutoNegState dom) +autoNegSim i = s + where + (s, _, _) = + C.unbundle $ + C.moore autoNegT autoNegO (AnEnable (C.repeat Invalid) (C.repeat 0) 0) i + +-- | Generate a list of values that do not contain the acknowledge bit, and +-- assert that the @ACKNOWLEDGE_DETECT@ state is entered but not the +-- @COMPLETE_ACKNOWLEDGE@ state +prop_autoNegNoAcknowledgeComplete :: H.Property +prop_autoNegNoAcknowledgeComplete = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp <- H.forAll (genConfRegsNoAck (Range.singleton simDuration)) + let simOut = + C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) + where + f i = (Ok, Nothing, Just i) + + H.assert $ isNothing (find g simOut) + H.assert $ isJust (find h simOut) + where + g (CompleteAcknowledge{}) = True + g _ = False + + h (AcknowledgeDetect{}) = True + h _ = False + +-- | Generate a list of values that do contain the acknowledge bit, and assert +-- that the @COMPLETE_ACKNOWLEDGE@ state is entered +prop_autoNegAcknowledgeComplete :: H.Property +prop_autoNegAcknowledgeComplete = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp <- H.forAll (genConfRegsAck (Range.singleton simDuration)) + let simOut = + C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) + where + f i = (Ok, Nothing, Just i) + + H.assert $ isJust (find g simOut) + where + g (CompleteAcknowledge{}) = True + g _ = False + +-- | Assert that in a simulation, the number of times a given state that uses +-- the link timer as a transition predicate is entered is exactly equal to 3 +prop_autoNegLinkTimer :: H.Property +prop_autoNegLinkTimer = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp <- H.forAll (genConfRegsNoAck (Range.singleton simDuration)) + let simOut = + C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) + where + f i = (Ok, Nothing, Just i) + + (length . filter g) simOut H.=== 3 + where + g (AnRestart{}) = True + g _ = False + +-- | Assert that if 'SyncStatus' is set to 'Fail', 'autoNeg' will never leave +-- the 'AnEnable' state (except at initialization, hence the first 10 outputs +-- are dropped from the comparision) +prop_autoNegFail :: H.Property +prop_autoNegFail = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp <- H.forAll (genConfRegsAck (Range.singleton simDuration)) + let simOut = + C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) + where + f i = (Fail, Nothing, Just i) + + (length . filter g) (drop 10 simOut) H.=== simDuration - 10 + where + g (AnEnable{}) = True + g _ = False + +-- | Assert that if values with ack set and ack not set are inputted +-- interchangeably the system will never trigger 'acknowledgeMatch' and thus +-- not reach 'CompleteAcknowledge'. +prop_autoNegNoThreeInARow :: H.Property +prop_autoNegNoThreeInARow = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp1 <- H.forAll (genConfRegsAck (Range.singleton simDuration)) + inp2 <- H.forAll (genConfRegsNoAck (Range.singleton simDuration)) + let inp = take simDuration $ concat $ zipWith (\a b -> [a, b]) inp1 inp2 + simOut = + C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) + where + f i = (Ok, Nothing, Just i) + + H.assert $ isNothing (find g simOut) + where + g (CompleteAcknowledge{}) = True + g _ = False + +C.createDomain C.vSystem{C.vName = "TimeoutDom", C.vPeriod = C.hzToPeriod 125e6} + +-- | Assert that for a domain frequency of 125 MHz the maximul value for timeout +-- is equal to the maxBound of an 'Index'. +prop_autoNegTimeoutLength :: H.Property +prop_autoNegTimeoutLength = H.withTests 1 $ H.property $ do + maxBound @(Clash.Cores.Sgmii.AutoNeg.Timeout TimeoutDom) + H.=== maxBound @(C.Index 200000) + +tests :: TestTree +tests = $(testGroupGenerator) From 8051e30f8fda95952bfac8305edf46cb0e8f7654 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:15:12 +0200 Subject: [PATCH 06/30] Add PCS transmit block --- .../src/Clash/Cores/Sgmii/PcsTransmit.hs | 49 ++++ .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 128 ++++++++++ .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 230 ++++++++++++++++++ 3 files changed, 407 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs create mode 100644 clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs create mode 100644 clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs new file mode 100644 index 0000000000..3dcf68eb62 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Top level module for the PCS transmit block, that combines the processes +-- that are defined in the two submodules @CodeGroup@ and @OrderedSet@. +module Clash.Cores.Sgmii.PcsTransmit where + +import Clash.Cores.Sgmii.Common +import Clash.Cores.Sgmii.PcsTransmit.CodeGroup +import Clash.Cores.Sgmii.PcsTransmit.OrderedSet +import Clash.Prelude + +-- | Takes the signals that are defined in IEEE 802.3 Clause 36 and runs them +-- through the state machines as defined for the PCS transmit block. These are +-- implemented in 'codeGroupT', 'codeGroupO' and 'orderedSetT'. +pcsTransmit :: + (HiddenClockResetEnable dom) => + -- | The @TX_EN@ signal + Signal dom Bool -> + -- | The @TX_ER@ signal + Signal dom Bool -> + -- | The new data word that needs to be transmitted + Signal dom (BitVector 8) -> + -- | The 'Xmit' signal from 'Sgmii.autoNeg' + Signal dom (Maybe Xmit) -> + -- | The 'ConfReg' from 'Sgmii.autoNeg' + Signal dom (Maybe ConfReg) -> + -- | The 8b/10b encoded output value + Signal dom Cg +pcsTransmit txEn txEr dw xmit txConfReg = cg + where + (_, cg, txEven, cgSent) = + mooreB + codeGroupT + codeGroupO + (IdleDisparityOk False 0 0) + (txOSet, dw, txConfReg) + + (_, txOSet) = + mealyB + orderedSetT + (IdleS Idle False) + (txEn, txEr, dw, xmit, txEven, cgSent) + +{-# CLASH_OPAQUE pcsTransmit #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs new file mode 100644 index 0000000000..10a5d9e82a --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Code group process of the PCS transmit block, as defined in IEEE 802.3 +-- Figure 36-6 +module Clash.Cores.Sgmii.PcsTransmit.CodeGroup where + +import Clash.Cores.LineCoding8b10b +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (fromMaybe) + +-- | State type of the code group process as defined in IEEE 802.3 Clause 36, +-- with the exception of @GENERATE_CODE_GROUPS@ and @IDLE_DISPARITY_TEST@ as +-- these states does not act upon the 125 MHz @cg_timer@ timer +data CodeGroupState + = SpecialGo + { _rd :: Bool + , _cg :: Cg + , _txConfReg :: ConfReg + , _txEven :: Even + , _txOSet :: OrderedSet + } + | DataGo {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _txEven :: Even} + | IdleDisparityWrong {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | IdleI1B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | IdleDisparityOk {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | IdleI2B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC1A {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC1B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC1C {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC1D {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC2A {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC2B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC2C {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | ConfigurationC2D {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + deriving (Generic, NFDataX, Eq, Show) + +-- | State transitions from @GENERATE_CODE_GROUP@ from Figure 36-6, which need +-- to be set in all parent states of @GENERATE_CODE_GROUP@ as this state +-- itself is not implemented as it does not transmit a code group +generateCg :: + OrderedSet -> Bool -> Cg -> ConfReg -> Even -> CodeGroupState +generateCg txOSet rd cg txConfReg txEven + | txOSet == OSetD = DataGo rd cg txConfReg txEven + | txOSet == OSetI && rd = IdleDisparityWrong rd cg txConfReg + | txOSet == OSetI && not rd = IdleDisparityOk rd cg txConfReg + | txOSet == OSetC = ConfigurationC1A rd cg txConfReg + | otherwise = SpecialGo rd cg txConfReg txEven txOSet + +-- | State transition function for the states as defined in IEEE 802.3 Clause +-- 36, specifically Figure 36-6. This function receives an ordered set from +-- the ordered set state machine, a @TXD@ value from the outside world and +-- then sends out the correct code group based on the given ordered set. +codeGroupT :: + -- | State variable + CodeGroupState -> + -- | Input data word from the ordered set, new input value and the config + -- register + (OrderedSet, BitVector 8, Maybe ConfReg) -> + -- | The new state + CodeGroupState +codeGroupT SpecialGo{..} (txOSet, _, txConfReg) = + generateCg txOSet rd cg txConfReg' txEven + where + dw = case _txOSet of + OSetS -> cwS + OSetT -> cwT + OSetR -> cwR + _ -> cwV + + txConfReg' = fromMaybe _txConfReg txConfReg + (rd, cg) = encode8b10b _rd dw + txEven = nextEven _txEven +codeGroupT self (txOSet, dw, txConfReg) = nextState + where + generateCg' = generateCg txOSet rd cg txConfReg' + + (dw', nextState) = case self of + DataGo{} -> (Dw dw, generateCg' txEven) + IdleDisparityWrong{} -> (cwK28_5, IdleI1B rd cg txConfReg') + IdleI1B{} -> (dwD05_6, generateCg' Odd) + IdleDisparityOk{} -> (cwK28_5, IdleI2B rd cg txConfReg') + IdleI2B{} -> (dwD16_2, generateCg' Odd) + ConfigurationC1A{} -> (cwK28_5, ConfigurationC1B rd cg txConfReg') + ConfigurationC1B{} -> (dwD21_5, ConfigurationC1C rd cg txConfReg') + ConfigurationC1C{} -> + (Dw (resize txConfReg'), ConfigurationC1D rd cg txConfReg') + ConfigurationC2A{} -> (cwK28_5, ConfigurationC2B rd cg txConfReg') + ConfigurationC2B{} -> (dwD02_2, ConfigurationC2C rd cg txConfReg') + ConfigurationC2C{} -> + (Dw (resize txConfReg'), ConfigurationC2D rd cg txConfReg') + _ -> (Dw (resize $ rotateR self._txConfReg 8), generateCg' Odd) + + txConfReg' = fromMaybe self._txConfReg txConfReg + (rd, cg) = encode8b10b self._rd dw' + txEven = nextEven self._txEven + +{-# CLASH_OPAQUE codeGroupT #-} + +-- | Output transition function for the states as defined in IEEE 802.3 Clause +-- 36, specifically Figure 36-6. This function takes the state values that +-- have been determined in 'codeGroupT' and sets the correct outputs. +codeGroupO :: + -- | Current state + CodeGroupState -> + -- | New output values + (CodeGroupState, Cg, Even, Bool) +codeGroupO self = case self of + SpecialGo{} -> (self, self._cg, txEven, True) + DataGo{} -> (self, self._cg, txEven, True) + IdleI1B{} -> (self, self._cg, Odd, True) + IdleI2B{} -> (self, self._cg, Odd, True) + ConfigurationC1B{} -> (self, self._cg, Odd, False) + ConfigurationC1D{} -> (self, self._cg, Odd, True) + ConfigurationC2B{} -> (self, self._cg, Odd, False) + ConfigurationC2D{} -> (self, self._cg, Odd, True) + _ -> (self, self._cg, Even, False) + where + txEven = nextEven self._txEven + +{-# CLASH_OPAQUE codeGroupO #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs new file mode 100644 index 0000000000..101d6aa75e --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Ordered set process of the PCS transmit block, as defined in IEEE 802.3 +-- Figure 36-5 +module Clash.Cores.Sgmii.PcsTransmit.OrderedSet where + +import Clash.Cores.Sgmii.Common +import Clash.Prelude +import Data.Maybe (fromJust, fromMaybe, isJust) + +-- | State type of 'orderedSetT' as defined in IEEE 802.3 Clause 36, with the +-- exeception of @TX_TEST_XMIT@, @TX_PACKET@ and @ALIGN_ERR_START@ as these +-- states do not transmit an ordered set to the code group process +data OrderedSetState + = Configuration {_xmit :: Xmit, _xmitChange :: Bool} + | IdleS {_xmit :: Xmit, _xmitChange :: Bool} + | XmitData {_xmit :: Xmit, _xmitChange :: Bool} + | StartOfPacket {_xmit :: Xmit, _xmitChange :: Bool} + | TxData {_xmit :: Xmit, _xmitChange :: Bool} + | EndOfPacketNoExt {_xmit :: Xmit, _xmitChange :: Bool} + | Epd2NoExt {_xmit :: Xmit, _xmitChange :: Bool} + | Epd3 {_xmit :: Xmit, _xmitChange :: Bool} + | EndOfPacketExt {_xmit :: Xmit, _xmitChange :: Bool} + | ExtendBy1 {_xmit :: Xmit, _xmitChange :: Bool} + | CarrierExtend {_xmit :: Xmit, _xmitChange :: Bool} + | StartError {_xmit :: Xmit, _xmitChange :: Bool} + | TxDataError {_xmit :: Xmit, _xmitChange :: Bool} + deriving (Generic, NFDataX, Eq, Show) + +-- | State transitions from @TX_TEST_XMIT@ from Figure 36-5, which need to be +-- set in all parent states of @TX_TEST_XMIT@ as this state itself is not +-- implemented as it does not transmit a code group +txTestXmit :: + Bool -> Bool -> Xmit -> Even -> Bool -> Bool -> Maybe OrderedSetState +txTestXmit txEn txEr xmit txEven tx xmitChange + | not (xmitChange && tx && txEven == Odd) = Nothing + | xmit == Conf = Just (Configuration xmit False) + | xmit == Idle = Just (IdleS xmit False) + | xmit == Data && txEn = Just (IdleS xmit False) + | xmit == Data && txEr = Just (IdleS xmit False) + | otherwise = Just (XmitData xmit False) + +-- | Function to update the current values for 'Xmit' and @xmitChange@ +xmitUpdate :: OrderedSetState -> Maybe Xmit -> (Xmit, Bool) +xmitUpdate s xmit = (xmit', xmitChange) + where + xmit' = fromMaybe s._xmit xmit + xmitChange = (xmit' /= s._xmit) || s._xmitChange + +-- | Void function that is used to check whether @/V/@ needs to be propagated +-- based on the values of the input pins +void :: OrderedSet -> Bool -> Bool -> BitVector 8 -> OrderedSet +void txOSet txEn txEr dw + | not txEn && txEr && dw /= 0b00001111 = OSetV + | txEn && txEr = OSetV + | otherwise = txOSet + +-- | State transition function for the states as defined in IEEE 802.3 Clause +-- 36, specifically Figure 36-5. This function receives the input values and +-- generates an ordered set to be transmitted by the code group process. +-- +-- __N.B.__: This function does not implement the optional EEE +-- (Energy-Efficient Ethernet) capability. +orderedSetT :: + -- | State variable + OrderedSetState -> + -- | The new input values, partly from the outside world, and partly from + -- 'Sgmii.autoNeg' and 'PcsTransmit.codeGroupT' + (Bool, Bool, BitVector 8, Maybe Xmit, Even, Bool) -> + -- | The new state and the new output values + (OrderedSetState, (OrderedSetState, OrderedSet)) +orderedSetT self@Configuration{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState = fromMaybe (Configuration xmit' xmitChange) s + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetC) +orderedSetT self@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + where + nextState + | isJust s = fromJust s + | xmit' == Data && tx && not txEn && not txEr = + XmitData xmit' xmitChange + | otherwise = IdleS xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetI) +orderedSetT self@XmitData{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + where + nextState + | isJust s = fromJust s + | txEn && not txEr && tx = StartOfPacket xmit' xmitChange + | txEn && txEr && tx = StartError xmit' xmitChange + | otherwise = XmitData xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetI) +orderedSetT self@StartOfPacket{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | txEn && tx = TxData xmit' xmitChange + | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange + | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange + | otherwise = StartOfPacket xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetS) +orderedSetT self@TxData{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) + where + nextState + | isJust s = fromJust s + | txEn && tx = TxData xmit' xmitChange + | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange + | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange + | otherwise = TxData xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + txOSet = void OSetD txEn txEr dw + out = (self, txOSet) +orderedSetT self@EndOfPacketNoExt{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | tx = Epd2NoExt xmit' xmitChange + | otherwise = EndOfPacketNoExt xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetT) +orderedSetT self@Epd2NoExt{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | txEven == Odd && tx = XmitData xmit' xmitChange + | txEven == Even && tx = Epd3 xmit' xmitChange + | otherwise = Epd2NoExt xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetR) +orderedSetT self@Epd3{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + where + nextState + | isJust s = fromJust s + | tx = XmitData xmit' xmitChange + | otherwise = Epd3 xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetR) +orderedSetT self@EndOfPacketExt{} (txEn, txEr, dw, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | not txEr && tx = ExtendBy1 xmit' xmitChange + | txEr && tx = CarrierExtend xmit' xmitChange + | otherwise = EndOfPacketExt xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + txOSet = void OSetT txEn txEr dw + out = (self, txOSet) +orderedSetT self@ExtendBy1{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | tx = Epd2NoExt xmit' xmitChange + | otherwise = ExtendBy1 xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetR) +orderedSetT self@CarrierExtend{} (txEn, txEr, dw, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | not txEn && not txEr && tx = ExtendBy1 xmit' xmitChange + | txEn && txEr && tx = StartError xmit' xmitChange + | txEn && not txEr && tx = StartOfPacket xmit' xmitChange + | otherwise = CarrierExtend xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + txOSet = void OSetR txEn txEr dw + out = (self, txOSet) +orderedSetT self@StartError{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | tx = TxDataError xmit' xmitChange + | otherwise = StartError xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetS) +orderedSetT self@TxDataError{} (txEn, txEr, _, xmit, txEven, tx) = + (nextState, out) + where + nextState + | isJust s = fromJust s + | txEn && tx = TxData xmit' xmitChange + | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange + | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange + | otherwise = TxDataError xmit' xmitChange + + (xmit', xmitChange) = xmitUpdate self xmit + s = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (self, OSetV) + +{-# CLASH_OPAQUE orderedSetT #-} From 3c19861535411cb451c5b9371d701eb3630e08c4 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:16:17 +0200 Subject: [PATCH 07/30] Add rate adaptation block --- .../src/Clash/Cores/Sgmii/RateAdapt.hs | 84 ++++++++ .../test/Test/Cores/Sgmii/RateAdapt.hs | 182 ++++++++++++++++++ 2 files changed, 266 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs create mode 100644 clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs new file mode 100644 index 0000000000..1d00c54b1c --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Functions for the rate adaptation blocks that are required for lower bit +-- rates than 1000 Mbps +module Clash.Cores.Sgmii.RateAdapt where + +import Clash.Cores.Sgmii.Common +import Clash.Prelude + +-- | State transition function for the receive rate adaption function +rateAdaptRxT :: + -- | Current state + Index 100 -> + -- | Input value + (LinkSpeed, Maybe a) -> + -- | New state and output value + (Index 100, Maybe a) +rateAdaptRxT n (linkSpeed, a) + | n == 0 = (n', a) + | otherwise = (n', Nothing) + where + n' = if ready then 0 else n + 1 + + ready = n == repeatN + repeatN = case linkSpeed of + Speed1000 -> 0 + Speed100 -> 9 + Speed10 -> 99 + +-- | Rate adaption function that takes an input and only outputs this input once +-- per N cycles based on the current link speed +rateAdaptRx :: + (HiddenClockResetEnable dom) => + -- | Link speed reported by the PHY + Signal dom LinkSpeed -> + -- | Input value + Signal dom (Maybe a) -> + -- | Output value + Signal dom (Maybe a) +rateAdaptRx linkSpeed a = mealyB rateAdaptRxT 0 (linkSpeed, a) + +{-# CLASH_OPAQUE rateAdaptRx #-} + +-- | State transition function for the transmit rate adaption function +rateAdaptTxT :: + -- | Current state + Index 100 -> + -- | Input value + (LinkSpeed, Maybe a) -> + -- | New state and output value + (Index 100, (Bool, Maybe a)) +rateAdaptTxT n (linkSpeed, a) = (n', (ready, a)) + where + n' = if ready then 0 else n + 1 + + ready = n == repeatN + repeatN = case linkSpeed of + Speed1000 -> 0 + Speed100 -> 9 + Speed10 -> 99 + +-- | Rate adaption function that passes an input to the output, and accepts new +-- inputs based on the link speed reported by the PHY. + +-- Remarks: +-- - The input is __only__ allowed to be changed the sample after the first +-- element in the output tuple, @READY@, has been asserted. +rateAdaptTx :: + (HiddenClockResetEnable dom) => + -- | Link speed reported by the PHY + Signal dom LinkSpeed -> + -- | Input value from the outside world + Signal dom (Maybe a) -> + -- | Output tuple containing the request for a new value ('Bool') and the + -- (possibly replicated) output value + (Signal dom Bool, Signal dom (Maybe a)) +rateAdaptTx linkSpeed bv = mealyB rateAdaptTxT 0 (linkSpeed, bv) + +{-# CLASH_OPAQUE rateAdaptTx #-} diff --git a/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs new file mode 100644 index 0000000000..49214e912e --- /dev/null +++ b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE ViewPatterns #-} + +module Test.Cores.Sgmii.RateAdapt where + +import Clash.Cores.Sgmii.Common +import Clash.Cores.Sgmii.RateAdapt +import Clash.Hedgehog.Sized.BitVector +import qualified Clash.Prelude as C +import Data.Maybe (catMaybes, fromJust) +import qualified Hedgehog as H +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH +import Prelude + +-- | Version of 'rateAdaptRx' that takes an input tuple instead of separate +-- variables +rateAdaptRxSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom (LinkSpeed, Maybe (C.BitVector 8)) -> + C.Signal dom (Maybe (C.BitVector 8)) +rateAdaptRxSim (C.unbundle -> (linkSpeed, rxDw)) = rateAdaptRx linkSpeed rxDw + +-- | Version of 'rateAdaptTx' that takes an input tuple instead of separate +-- variables +rateAdaptTxSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom (LinkSpeed, Maybe (C.BitVector 8)) -> + C.Signal dom (Bool, Maybe (C.BitVector 8)) +rateAdaptTxSim (C.unbundle -> (linkSpeed, txDw)) = + C.bundle $ rateAdaptTx linkSpeed txDw + +-- | Function to take the n'th elements of a list +everyNth :: Int -> [a] -> [a] +everyNth n (drop (n - 1) -> l) + | null l = [] + | otherwise = head l : everyNth n (tail l) + +-- | Function that tests the rate adaptation function with a link speed of 1000 +-- Mbps, which means that every input value should be propagated to the output +prop_rateAdaptRx1000 :: H.Property +prop_rateAdaptRx1000 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let simOut = + drop 1 $ + C.sampleN + (simDuration + 1) + ( rateAdaptRxSim @C.System + (C.fromList ((Speed1000, Nothing) : map f inp)) + ) + where + f a = (Speed1000, Just a) + + expected = inp + + catMaybes simOut H.=== expected + +-- | Function that tests the rate adaptation function with a link speed of 100 +-- Mbps, which means that every 10th input value (starting at 0) should be +-- propagated to the output +prop_rateAdaptRx100 :: H.Property +prop_rateAdaptRx100 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let simOut = + drop 1 $ + C.sampleN + (simDuration + 1) + ( rateAdaptRxSim @C.System + (C.fromList ((Speed100, Nothing) : map f inp)) + ) + where + f a = (Speed100, Just a) + + expected = head inp : everyNth 10 (tail inp) + + catMaybes simOut H.=== expected + +-- | Function that tests the rate adaptation function with a link speed of 10 +-- Mbps, which means that every 100th input value (starting at 0) should be +-- propagated to the output +prop_rateAdaptRx10 :: H.Property +prop_rateAdaptRx10 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let simOut = + drop 1 $ + C.sampleN + (simDuration + 1) + ( rateAdaptRxSim @C.System + (C.fromList ((Speed10, Nothing) : map f inp)) + ) + where + f a = (Speed10, Just a) + + expected = head inp : everyNth 100 (tail inp) + + catMaybes simOut H.=== expected + +-- | Function that tests the rate adaptation function with a link speed of 1000 +-- Mbps, which means that every input value should be propagated to the output +prop_rateAdaptTx1000 :: H.Property +prop_rateAdaptTx1000 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let simOut = + map g $ + drop 1 $ + C.sampleN + (simDuration + 1) + ( rateAdaptTxSim @C.System + (C.fromList ((Speed1000, Nothing) : map f inp)) + ) + where + f a = (Speed1000, Just a) + g (_, a) = fromJust a + + expected = inp + + simOut H.=== expected + +-- | Function that tests the rate adaptation function with a link speed of 100 +-- Mbps, which means that every 10th input value (starting at 0) should be +-- propagated to the output +prop_rateAdaptTx100 :: H.Property +prop_rateAdaptTx100 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let inp2 = concatMap (replicate 10) inp1 + + simOut = + map g $ + drop 1 $ + C.sampleN + (length inp2 + 1) + ( rateAdaptTxSim @C.System + (C.fromList ((Speed100, Nothing) : map f inp2)) + ) + where + f a = (Speed100, Just a) + g (_, a) = fromJust a + + expected = take (length simOut) inp2 + + simOut H.=== expected + +-- | Function that tests the rate adaptation function with a link speed of 10 +-- Mbps, which means that every 100th input value (starting at 0) should be +-- propagated to the output +prop_rateAdaptTx10 :: H.Property +prop_rateAdaptTx10 = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let inp2 = concatMap (replicate 100) inp1 + + simOut = + map g $ + drop 1 $ + C.sampleN + (length inp2 + 1) + ( rateAdaptTxSim @C.System + (C.fromList ((Speed10, Nothing) : map f inp2)) + ) + where + f a = (Speed10, Just a) + g (_, a) = fromJust a + + expected = take (length simOut) inp2 + + simOut H.=== expected + +tests :: TestTree +tests = $(testGroupGenerator) From ee8f95918da607b6245bf8ed6a6ed1a1385af207 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:17:01 +0200 Subject: [PATCH 08/30] Add top-level SGMII block --- clash-cores/src/Clash/Cores/Sgmii.hs | 312 +++++++++++++++++++++ clash-cores/test/Test/Cores/Sgmii/Sgmii.hs | 206 ++++++++++++++ 2 files changed, 518 insertions(+) create mode 100644 clash-cores/src/Clash/Cores/Sgmii.hs create mode 100644 clash-cores/test/Test/Cores/Sgmii/Sgmii.hs diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs new file mode 100644 index 0000000000..dba6565084 --- /dev/null +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Copyright : (C) 2024, QBayLogic B.V. +-- License : BSD2 (see the file LICENSE) +-- Maintainer : QBayLogic B.V. +-- +-- Top-level SGMII module that combines all the blocks that are defined in the +-- sub-modules to one function that can be used in different projects. +-- +-- Example usage: +-- +-- @ +-- topEntity :: +-- Clock Dom0 -> +-- Clock Dom1 -> +-- Reset Dom0 -> +-- Reset Dom1 -> +-- Signal Dom1 Bool -> +-- Signal Dom1 Bool -> +-- Signal Dom1 (BitVector 8) -> +-- Signal Dom0 (BitVector 10) -> +-- ( Signal rxDom SgmiiStatus +-- , Signal rxDom Bool +-- , Signal rxDom Bool +-- , Signal rxDom (BitVector 8) +-- , Signal txDom (BitVector 10) +-- ) +-- topEntity = sgmii rxTxCdc +-- @ +-- Here, the type of @rxTxCdc@, which is the function that handles the +-- clock domain crossing between the transmit and receive domain between the +-- auto-negotiation block and transmission block, needs to be the following: +-- +-- @ +-- rxTxCdc :: +-- forall dom0 dom1. +-- (KnownDomain dom0, KnownDomain dom1) => +-- Clock rxDom -> +-- Clock txDom -> +-- Signal rxDom (Maybe Xmit) -> +-- Signal rxDom (Maybe ConfReg) -> +-- Signal rxDom (Maybe ConfReg) -> +-- ( Signal txDom (Maybe Xmit) +-- , Signal txDom (Maybe ConfReg) +-- , Signal txDom (Maybe ConfReg) +-- ) +-- @ +-- +-- For Xilinx boards, this could be implemented by using, for example, the +-- function 'Clash.Cores.Xilinx.Xpm.Cdc.Handshake.xpmCdcHandshake', but +-- vendor-neutral implementations could make use of other word-synchronizers. +-- +-- As the decoding of incoming 10-bit code groups is done on a best-effort +-- basis and they are always transmitted to @TXD@, this port should only be +-- read when @RX_DV@ is asserted as invalid data might be provided when it is +-- not. +module Clash.Cores.Sgmii where + +import Clash.Cores.LineCoding8b10b +import Clash.Cores.Sgmii.AutoNeg +import Clash.Cores.Sgmii.BitSlip +import Clash.Cores.Sgmii.Common +import Clash.Cores.Sgmii.PcsReceive +import Clash.Cores.Sgmii.PcsTransmit +import Clash.Cores.Sgmii.RateAdapt +import Clash.Cores.Sgmii.Sync +import Clash.Prelude +import Data.Maybe (fromMaybe, isJust) + +-- | Receive side of the SGMII block, that combines all the functions that are +-- in the receive domain +sgmiiRx :: + (HiddenClockResetEnable dom) => + -- | Input code group + Signal dom Cg -> + -- | Output tuple + ( Signal dom SgmiiStatus + , Signal dom Bool + , Signal dom Bool + , Signal dom (BitVector 8) + , Signal dom (Maybe Xmit) + , Signal dom (Maybe ConfReg) + , Signal dom (Maybe ConfReg) + , Signal dom Cg + ) +sgmiiRx rxCg = + ( rxStatus + , regMaybe False rxDv + , regMaybe False rxEr + , regMaybe 0 ((fmap . fmap) fromSymbol rxDw) + , xmit + , txConfReg + , rxConfReg + , bsCg + ) + where + rxStatus = + SgmiiStatus + <$> bsOk + <*> syncStatus + <*> regMaybe 0 rxConfReg + <*> regMaybe Invalid rudi + <*> regMaybe Conf xmit + + (xmit, txConfReg) = autoNeg syncStatus rudi rxConfReg + (rxDv, rxEr, rxDw, rudi, rxConfReg) = + pcsReceive cg rd dw rxEven syncStatus xmit + (cg, rd, dw, rxEven, syncStatus) = sync bsCg + (bsCg, bsOk) = bitSlip rxCg syncStatus + +-- | Transmit side of the SGMII block, that combines all the functions that are +-- in the transmit domain +sgmiiTx :: + (HiddenClockResetEnable dom) => + -- | @TX_EN@ signal + Signal dom Bool -> + -- | @TX_ER@ signal + Signal dom Bool -> + -- | Input data word + Signal dom (BitVector 8) -> + -- | 'Xmit' signal + Signal dom (Maybe Xmit) -> + -- | Configuration register from MAC + Signal dom (Maybe ConfReg) -> + -- | Configuration register from PHY + Signal dom (Maybe ConfReg) -> + -- | Output code group + Signal dom Cg +sgmiiTx txEn txEr txDw xmit txConfReg _ = + pcsTransmit txEn txEr txDw xmit txConfReg + +-- | Top-level SGMII function that takes as its second argument a function that +-- implements a clock domain crossing between the auto-negotiation and +-- transmission blocks. This block does not implement the serialization and +-- deserialization of the 10-bit code groups, but leaves this to be +-- implemented externally. These 10-bit code groups do not have to be word +-- aligned as this is implemented internally in the 'bitSlip' block. +-- +-- This function implements SGMII as described +-- [here](https://archive.org/download/sgmii/SGMII.pdf), without the optional +-- EEE (Energy-Efficient Ethernet) capability. +-- +-- This function reports its internal status by using 'SgmiiStatus', this +-- reports the synchronization status of the line in the first bit, the +-- configuration register in the following 16 bits, and the values of 'Rudi' +-- and 'Xmit' in the following 2-bit groups. +sgmii :: + forall rxDom txDom. + (KnownDomain rxDom, KnownDomain txDom) => + -- | Function used for the clock domain crossing between 'autoNeg' and + -- 'pcsTransmit', for the values of 'Xmit' and 'ConfReg' + ( Clock rxDom -> + Clock txDom -> + Signal rxDom (Maybe Xmit) -> + Signal rxDom (Maybe ConfReg) -> + Signal rxDom (Maybe ConfReg) -> + ( Signal txDom (Maybe Xmit) + , Signal txDom (Maybe ConfReg) + , Signal txDom (Maybe ConfReg) + ) + ) -> + -- | Clock of the receive domain, which is a 125 MHz clock that is derived + -- from the 625 MHz clock that is received from the PHY + Clock rxDom -> + -- | Clock of the transmit domain, which can be an internal clock of the FPGA + Clock txDom -> + -- | Reset of the receive domain + Reset rxDom -> + -- | Reset of the transmit domain + Reset txDom -> + -- | Input signal @TX_EN@, which enables data transmission when 'Xmit' from + -- 'autoNeg' is set to 'Data' + Signal txDom Bool -> + -- | Input signal @TX_ER@, which is used to propagate error values to the PHY + Signal txDom Bool -> + -- | Data octet @TXD@ to be transmitted to the PHY + Signal txDom (BitVector 8) -> + -- | Input code group from the PHY + Signal rxDom Cg -> + -- | Tuple that contains the output signals from the SGMII block which are the + -- current status of the receive block 'SgmiiStatus', the @RX_DV@ signal + -- that indicates an incoming data packet, @RX_ER@ which indicates a receive + -- error, @RXD@ which is the incoming data octet from the PHY, and a 10-bit + -- code word that can be serialized and transmitted to the PHY. + ( Signal rxDom SgmiiStatus + , Signal rxDom Bool + , Signal rxDom Bool + , Signal rxDom (BitVector 8) + , Signal rxDom Cg + , Signal txDom Cg + ) +sgmii rxTxCdc rxClk txClk rxRst txRst txEn txEr txDw rxCg = + (rxStatus, rxDv, rxEr, rxDw, bsCg, txCg) + where + txCg = sgmiiTx' txEn txEr txDw xmit2 txConfReg2 rxConfReg2 + where + sgmiiTx' = exposeClockResetEnable sgmiiTx txClk txRst enableGen + + (xmit2, txConfReg2, rxConfReg2) = + rxTxCdc rxClk txClk xmit1 txConfReg1 rxConfReg1 + + (rxStatus, rxDv, rxEr, rxDw, xmit1, txConfReg1, rxConfReg1, bsCg) = + sgmiiRx' rxCg + where + sgmiiRx' = exposeClockResetEnable sgmiiRx rxClk rxRst enableGen + +{-# CLASH_OPAQUE sgmii #-} + +-- | Receive side of the SGMII block, that combines all the functions that are +-- in the receive domain, rate-adapted +sgmiiRxRA :: + (HiddenClockResetEnable dom) => + -- | Input code group + Signal dom Cg -> + -- | Output tuple + ( Signal dom SgmiiStatus + , Signal dom Bool + , Signal dom (Maybe (BitVector 8)) + , Signal dom (Maybe Xmit) + , Signal dom (Maybe ConfReg) + , Signal dom (Maybe ConfReg) + , Signal dom Cg + ) +sgmiiRxRA rxCg = (rxStatus, rxEr, out, xmit, txConfReg, rxConfReg, bsCg) + where + out = rateAdaptRx linkSpeed $ orNothing <$> rxDv <*> rxDw + linkSpeed = toLinkSpeed <$> regMaybe 0 rxConfReg + (rxStatus, rxDv, rxEr, rxDw, xmit, txConfReg, rxConfReg, bsCg) = sgmiiRx rxCg + +-- | Transmit side of the SGMII block, that combines all the functions that are +-- in the transmit domain, rate-adapted +sgmiiTxRA :: + (HiddenClockResetEnable dom) => + -- | @TX_ER@ signal + Signal dom Bool -> + -- | Input data word + Signal dom (Maybe (BitVector 8)) -> + -- | 'Xmit' signal + Signal dom (Maybe Xmit) -> + -- | Configuration register from MAC + Signal dom (Maybe ConfReg) -> + -- | Configuration register from PHY + Signal dom (Maybe ConfReg) -> + -- | Ready signal and output code group + (Signal dom Bool, Signal dom Cg) +sgmiiTxRA txEr txDw xmit txConfReg rxConfReg = (txReady, txCg) + where + linkSpeed = toLinkSpeed <$> regMaybe 0 rxConfReg + txCg = + sgmiiTx (isJust <$> out) txEr (fromMaybe 0 <$> out) xmit txConfReg rxConfReg + (txReady, out) = rateAdaptTx linkSpeed txDw + +-- | Rate-adapted version of 'sgmii' +sgmiiRA :: + forall rxDom txDom. + (KnownDomain rxDom, KnownDomain txDom) => + -- | Function used for the clock domain crossing between 'autoNeg' and + -- 'pcsTransmit', for the values of 'Xmit' and 'ConfReg' + ( Clock rxDom -> + Clock txDom -> + Signal rxDom (Maybe Xmit) -> + Signal rxDom (Maybe ConfReg) -> + Signal rxDom (Maybe ConfReg) -> + ( Signal txDom (Maybe Xmit) + , Signal txDom (Maybe ConfReg) + , Signal txDom (Maybe ConfReg) + ) + ) -> + -- | Clock of the receive domain, which is a 125 MHz clock that is derived + -- from the 625 MHz clock that is received from the PHY + Clock rxDom -> + -- | Clock of the transmit domain, which can be an internal clock of the FPGA + Clock txDom -> + -- | Reset of the receive domain + Reset rxDom -> + -- | Reset of the transmit domain + Reset txDom -> + -- | @TX_ER@ signal + Signal txDom Bool -> + -- | Data octet @TXD@ to be transmitted to the PHY + Signal txDom (Maybe (BitVector 8)) -> + -- | Input code group from the PHY + Signal rxDom Cg -> + -- | Tuple that contains the output signals from the SGMII block which are the + -- current status of the receive block 'SgmiiStatus', @RX_ER@ which + -- indicates a receive error, @RXD@ which is the incoming data octet from + -- the PHY, and a 10-bit code word that can be serialized and transmitted to + -- the PHY. For debugging purposes, also a word-aligned version of the input + -- word is outputted. + ( Signal rxDom SgmiiStatus + , Signal rxDom Bool + , Signal rxDom (Maybe (BitVector 8)) + , Signal rxDom Cg + , Signal txDom Cg + , Signal txDom Bool + ) +sgmiiRA rxTxCdc rxClk txClk rxRst txRst txEr txDw rxCg = + (rxStatus, rxEr, rxDw, bsCg, txCg, txReady) + where + (txReady, txCg) = sgmiiTx' txEr txDw xmit2 txConfReg2 rxConfReg2 + where + sgmiiTx' = exposeClockResetEnable sgmiiTxRA txClk txRst enableGen + + (xmit2, txConfReg2, rxConfReg2) = + rxTxCdc rxClk txClk xmit1 txConfReg1 rxConfReg1 + + (rxStatus, rxEr, rxDw, xmit1, txConfReg1, rxConfReg1, bsCg) = sgmiiRx' rxCg + where + sgmiiRx' = exposeClockResetEnable sgmiiRxRA rxClk rxRst enableGen + +{-# CLASH_OPAQUE sgmiiRA #-} diff --git a/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs b/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs new file mode 100644 index 0000000000..02cf502225 --- /dev/null +++ b/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE ViewPatterns #-} + +module Test.Cores.Sgmii.Sgmii where + +import Clash.Cores.Sgmii +import Clash.Cores.Sgmii.Common +import Clash.Hedgehog.Sized.BitVector +import qualified Clash.Prelude as C +import Data.Maybe (fromMaybe) +import Data.Tuple (swap) +import qualified Hedgehog as H +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Cores.Sgmii.AutoNeg +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.TH +import Prelude + +-- | Placeholder integration function for all different parts of SGMII +sgmiiSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom Bool -> + C.Signal dom Bool -> + C.Signal dom (C.BitVector 8) -> + C.Signal dom (C.BitVector 10) -> + ( C.Signal dom Bool + , C.Signal dom Bool + , C.Signal dom (C.BitVector 8) + , C.Signal dom (C.BitVector 10) + ) +sgmiiSim txEn txEr txDw rxCg = (rxDv, rxEr, rxDw, txCg) + where + txCg = sgmiiTx txEn txEr txDw xmit txConfReg (pure Nothing) + (_, rxDv, rxEr, rxDw, xmit, txConfReg, _, _) = sgmiiRx rxCg + +-- | Loopback function that combines two full SGMII systems, with one in +-- loopback configuration, to check whether the full system including +-- auto-negotiation works +loopbackSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom (Bool, Bool, C.BitVector 8) -> + C.Signal dom (C.BitVector 8) +loopbackSim (C.unbundle -> (txEn, txEr, txDw)) = rxDw + where + (_, _, rxDw, txCg) = sgmiiSim txEn txEr txDw rxCg + (dv, er, dw, rxCg) = sgmiiSim dv er dw txCg + +-- | Function that runs two versions of 'sgmii' at the same time +duplexTransmissionSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom (Bool, Bool, C.BitVector 8, C.BitVector 8) -> + C.Signal dom (C.BitVector 8, C.BitVector 8) +duplexTransmissionSim (C.unbundle -> (txEn, txEr, txDw1, txDw2)) = + C.bundle (rxDw1, rxDw2) + where + (_, _, rxDw1, cg1) = sgmiiSim txEn txEr txDw1 cg2 + (_, _, rxDw2, cg2) = sgmiiSim txEn txEr txDw2 cg1 + +-- | Function that is used to propagate the config register via 'pcsTransmit' +-- 'pcsReceive' +confRegSim :: + (C.HiddenClockResetEnable dom) => + C.Signal dom ConfReg -> + C.Signal dom ConfReg +confRegSim txConfReg = fromMaybe 0 <$> rxConfReg + where + (_, _, _, _, _, _, rxConfReg, _) = sgmiiRx txCg + txCg = + sgmiiTx + (pure False) + (pure False) + (pure 0) + (pure (Just Conf)) + (Just <$> txConfReg) + (pure Nothing) + +-- | Test that the completely integrated system works in a loopback mode, where +-- the output of the second 'sgmii' instance is connected to its own input. +-- The system starts in configuration mode, so the first 76 samples are used +-- to set it up fully, after which it is ready for data transmission. During +-- data transmission, the first several packages are replaced with control +-- packages, these are dropped from the output comparision. Then, the output +-- is shifted to deal with the delay that is introduced along the way due to +-- registers. +prop_loopbackTest :: H.Property +prop_loopbackTest = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let setupSamples = 77 + delaySamples = 20 + controlCount = 9 + + simOut = + drop (setupSamples + delaySamples + controlCount) $ + C.sampleN + (simDuration + setupSamples + delaySamples) + ( loopbackSim @C.System + ( C.fromList + ( replicate setupSamples (False, False, 0) + ++ map f inp + ++ replicate delaySamples (False, False, 0) + ) + ) + ) + where + f dw = (True, False, dw) + + expected = drop controlCount inp + + simOut H.=== expected + +-- | Similar to 'prop_loopbackTest', however this time there is no loopback but +-- different signals are sent from left to right and right to left +prop_duplexTransmission :: H.Property +prop_duplexTransmission = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) + + inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + inp2 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let setupSamples = 77 + delaySamples = 10 + controlCount = 9 + + inp = zip inp1 inp2 + + simOut = + drop (setupSamples + delaySamples + controlCount) $ + C.sampleN + (simDuration + setupSamples + delaySamples) + ( duplexTransmissionSim @C.System + ( C.fromList + ( replicate setupSamples (False, False, 0, 0) + ++ map f inp + ++ replicate delaySamples (False, False, 0, 0) + ) + ) + ) + where + f (dw1, dw2) = (True, False, dw1, dw2) + + expected = map swap $ drop controlCount inp + + simOut H.=== expected + +-- | Similar to 'prop_duplexTransmission', however this time the system enters +-- carrier extend and starts retransmission +prop_duplexTransmissionCarrierExtend :: H.Property +prop_duplexTransmissionCarrierExtend = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) + + inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + inp2 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + inp3 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + inp4 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) + let setupSamples = 77 + delaySamples = 10 + controlCount = 9 + extendCount = 2 + + inpA = zip inp1 inp2 + inpB = zip inp3 inp4 + + simOut = + drop (setupSamples + delaySamples + controlCount) $ + C.sampleN + (2 * simDuration + setupSamples + delaySamples + extendCount) + ( duplexTransmissionSim @C.System + ( C.fromList + ( replicate setupSamples (False, False, 0, 0) + ++ map f inpA + ++ [(False, True, 0, 0), (False, True, 0, 0)] + ++ map f inpB + ++ replicate delaySamples (False, False, 0, 0) + ) + ) + ) + where + f (dw1, dw2) = (True, False, dw1, dw2) + + expected1 = map swap $ drop controlCount inpA + simOut1 = take (simDuration - controlCount) simOut + + expected2 = map swap $ drop controlCount inpB + simOut2 = + take (simDuration - controlCount) $ + drop (simDuration + extendCount) simOut + + simOut1 H.=== expected1 + simOut2 H.=== expected2 + +-- | Assert that the configuration register will be propagated from the transmit +-- block to the receive block in exactly 25 cycles +prop_confRegPropagated :: H.Property +prop_confRegPropagated = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.singleton 25)) + + inp <- H.forAll genConfRegNoAck + let simOut = + drop 1 $ C.sampleN (simDuration + 1) (confRegSim @C.System (pure inp)) + + H.assert $ inp `elem` simOut + +tests :: TestTree +tests = $(testGroupGenerator) From 622d99936e9a8a2f0c30f3c549f584a1f86d8f69 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:17:55 +0200 Subject: [PATCH 09/30] Include modules in project --- clash-cores/clash-cores.cabal | 15 +++++++++++++++ clash-cores/test/unittests.hs | 10 ++++++++++ 2 files changed, 25 insertions(+) diff --git a/clash-cores/clash-cores.cabal b/clash-cores/clash-cores.cabal index b8440b5851..9207f21cb5 100644 --- a/clash-cores/clash-cores.cabal +++ b/clash-cores/clash-cores.cabal @@ -133,6 +133,16 @@ library Clash.Cores.LineCoding8b10b Clash.Cores.LineCoding8b10b.Decoder Clash.Cores.LineCoding8b10b.Encoder + Clash.Cores.Sgmii + Clash.Cores.Sgmii.AutoNeg + Clash.Cores.Sgmii.BitSlip + Clash.Cores.Sgmii.Common + Clash.Cores.Sgmii.PcsReceive + Clash.Cores.Sgmii.PcsTransmit + Clash.Cores.Sgmii.PcsTransmit.CodeGroup + Clash.Cores.Sgmii.PcsTransmit.OrderedSet + Clash.Cores.Sgmii.RateAdapt + Clash.Cores.Sgmii.Sync Clash.Cores.SPI Clash.Cores.UART Clash.Cores.Xilinx.BlockRam @@ -202,6 +212,11 @@ test-suite unittests Test.Cores.Internal.SampleSPI Test.Cores.LineCoding8b10b Test.Cores.Internal.Signals + Test.Cores.Sgmii.AutoNeg + Test.Cores.Sgmii.BitSlip + Test.Cores.Sgmii.RateAdapt + Test.Cores.Sgmii.Sgmii + Test.Cores.Sgmii.Sync Test.Cores.SPI Test.Cores.SPI.MultiSlave Test.Cores.UART diff --git a/clash-cores/test/unittests.hs b/clash-cores/test/unittests.hs index c23e43c096..8c69d857a5 100644 --- a/clash-cores/test/unittests.hs +++ b/clash-cores/test/unittests.hs @@ -12,6 +12,11 @@ import Test.Tasty import qualified Test.Cores.Crc import qualified Test.Cores.LineCoding8b10b +import qualified Test.Cores.Sgmii.AutoNeg +import qualified Test.Cores.Sgmii.BitSlip +import qualified Test.Cores.Sgmii.RateAdapt +import qualified Test.Cores.Sgmii.Sgmii +import qualified Test.Cores.Sgmii.Sync import qualified Test.Cores.SPI import qualified Test.Cores.SPI.MultiSlave import qualified Test.Cores.UART @@ -24,6 +29,11 @@ tests :: TestTree tests = testGroup "Unittests" [ Test.Cores.Crc.tests , Test.Cores.LineCoding8b10b.tests + , Test.Cores.Sgmii.AutoNeg.tests + , Test.Cores.Sgmii.BitSlip.tests + , Test.Cores.Sgmii.RateAdapt.tests + , Test.Cores.Sgmii.Sgmii.tests + , Test.Cores.Sgmii.Sync.tests , Test.Cores.SPI.tests , Test.Cores.SPI.MultiSlave.tests , Test.Cores.UART.tests From 647320c988d1e6bd3f814d63521e4567fa7fbaf4 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 17 Jul 2024 20:18:16 +0200 Subject: [PATCH 10/30] Ignore .tix files from HPC --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 84924c9987..cb27622d69 100644 --- a/.gitignore +++ b/.gitignore @@ -32,6 +32,7 @@ cabal.config *.bin *.log *.tar.gz +*.tix *~ *.DS_Store From 803be7551eea4be5634c8f23ec3e4986049848ab Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Tue, 23 Jul 2024 14:09:29 +0200 Subject: [PATCH 11/30] Reorganize function definitions --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 32 ++++++------ .../src/Clash/Cores/Sgmii/PcsReceive.hs | 52 +++++++++---------- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 14 ++--- 3 files changed, 49 insertions(+), 49 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index 3812a198a7..bfa06b358e 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -102,22 +102,6 @@ anEnable failT rudi rudis rxConfRegs | rudi == Just Invalid = Just $ AnEnable rudis rxConfRegs failT | otherwise = Nothing --- | General part of the status update of the auto negotiation function, where --- the new values of 'Rudi', 'ConfReg' and the 'Timeout's are handled. -anUpdate :: - (KnownDomain dom) => - AutoNegState dom -> - SyncStatus -> - Maybe Rudi -> - Maybe ConfReg -> - (Rudis, ConfRegs, Timeout dom, Timeout dom) -anUpdate s syncStatus rudi rxConfReg = (rudis, rxConfRegs, failT, linkT) - where - rudis = maybe s._rudis (s._rudis <<+) rudi - rxConfRegs = maybe s._rxConfRegs (s._rxConfRegs <<+) rxConfReg - failT = if syncStatus == Fail then s._failT + 1 else 0 - linkT = s._linkT + 1 - -- | Check if the the last three received values of @rxConfReg@ are the same -- (with the exception for bit 14, the acknowledge bit, which is discarded). -- If there has been 'Rudi' value of 'I' in the same set of values, then @@ -160,6 +144,22 @@ consistencyMatch rudis rxConfigRegs = idleMatch :: Rudis -> Bool idleMatch = (==) (repeat I) +-- | General part of the status update of the auto negotiation function, where +-- the new values of 'Rudi', 'ConfReg' and the 'Timeout's are handled. +anUpdate :: + (KnownDomain dom) => + AutoNegState dom -> + SyncStatus -> + Maybe Rudi -> + Maybe ConfReg -> + (Rudis, ConfRegs, Timeout dom, Timeout dom) +anUpdate s syncStatus rudi rxConfReg = (rudis, rxConfRegs, failT, linkT) + where + rudis = maybe s._rudis (s._rudis <<+) rudi + rxConfRegs = maybe s._rxConfRegs (s._rxConfRegs <<+) rxConfReg + failT = if syncStatus == Fail then s._failT + 1 else 0 + linkT = s._linkT + 1 + -- | State transition function for 'autoNeg' as defined in IEEE 802.3 Clause 37. -- It takes the current 'SyncStatus' from 'Sgmii.sync' as well as the 'Rudi' -- and 'ConfReg' signals from 'Sgmii.pcsReceive'. diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 39c0522d94..7ec9e674ca 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -94,32 +94,6 @@ carrierDetect cg rd rxEven where cgK28_5 = if rd then cgK28_5P else cgK28_5N --- | Function that implements the transitions of the @RECEIVE@ state -receive :: Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState -receive dws rxEven rx xmit - | rxEnd == Just K28_5DK28_5 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just K28_5D21_5D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just K28_5D02_2D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just TRK28_5 && rxEven == Even = Just (TriRri rx xmit) - | rxEnd == Just TRR = Just (TrrExtend rx xmit) - | rxEnd == Just RRR = Just (EarlyEnd rx xmit) - | isDw (head dws) = Just (RxData rx xmit dw) - | otherwise = Nothing - where - rxEnd = checkEnd dws - dw = head dws - --- | Function that implements the transitions of the @EPD2_CHECK_END@ state -epd2CheckEnd :: - Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState -epd2CheckEnd dws rxEven rx xmit - | rxEnd == Just RRR = Just (TrrExtend rx xmit) - | rxEnd == Just RRK28_5 && rxEven == Even = Just (TriRri rx xmit) - | rxEnd == Just RRS = Just (PacketBurstRrs rx xmit) - | otherwise = Nothing - where - rxEnd = checkEnd dws - -- | Take the running disparity, the current and next two input data words and -- check whether they correspond to one of the specified end conditions checkEnd :: @@ -138,6 +112,32 @@ checkEnd dws | dws == repeat cwR ++ cwS :> Nil = Just RRS | otherwise = Nothing +-- | Function that implements the transitions of the @EPD2_CHECK_END@ state +epd2CheckEnd :: + Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState +epd2CheckEnd dws rxEven rx xmit + | rxEnd == Just RRR = Just (TrrExtend rx xmit) + | rxEnd == Just RRK28_5 && rxEven == Even = Just (TriRri rx xmit) + | rxEnd == Just RRS = Just (PacketBurstRrs rx xmit) + | otherwise = Nothing + where + rxEnd = checkEnd dws + +-- | Function that implements the transitions of the @RECEIVE@ state +receive :: Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState +receive dws rxEven rx xmit + | rxEnd == Just K28_5DK28_5 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just K28_5D21_5D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just K28_5D02_2D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) + | rxEnd == Just TRK28_5 && rxEven == Even = Just (TriRri rx xmit) + | rxEnd == Just TRR = Just (TrrExtend rx xmit) + | rxEnd == Just RRR = Just (EarlyEnd rx xmit) + | isDw (head dws) = Just (RxData rx xmit dw) + | otherwise = Nothing + where + rxEnd = checkEnd dws + dw = head dws + -- | State transition function for 'pcsReceive'. Takes the state as defined in -- 'PcsReceiveState' and returns the next state as defined in Clause 36 of -- IEEE 802.3. In contrast to the specification in Clause 36, here diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index 101d6aa75e..922e73498a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -46,13 +46,6 @@ txTestXmit txEn txEr xmit txEven tx xmitChange | xmit == Data && txEr = Just (IdleS xmit False) | otherwise = Just (XmitData xmit False) --- | Function to update the current values for 'Xmit' and @xmitChange@ -xmitUpdate :: OrderedSetState -> Maybe Xmit -> (Xmit, Bool) -xmitUpdate s xmit = (xmit', xmitChange) - where - xmit' = fromMaybe s._xmit xmit - xmitChange = (xmit' /= s._xmit) || s._xmitChange - -- | Void function that is used to check whether @/V/@ needs to be propagated -- based on the values of the input pins void :: OrderedSet -> Bool -> Bool -> BitVector 8 -> OrderedSet @@ -61,6 +54,13 @@ void txOSet txEn txEr dw | txEn && txEr = OSetV | otherwise = txOSet +-- | Function to update the current values for 'Xmit' and @xmitChange@ +xmitUpdate :: OrderedSetState -> Maybe Xmit -> (Xmit, Bool) +xmitUpdate s xmit = (xmit', xmitChange) + where + xmit' = fromMaybe s._xmit xmit + xmitChange = (xmit' /= s._xmit) || s._xmitChange + -- | State transition function for the states as defined in IEEE 802.3 Clause -- 36, specifically Figure 36-5. This function receives the input values and -- generates an ordered set to be transmitted by the code group process. From 35914b604b675b15c1944d8b628602e3256ce879 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Tue, 23 Jul 2024 17:38:57 +0200 Subject: [PATCH 12/30] Improve auto-negotiation block --- clash-cores/src/Clash/Cores/Sgmii.hs | 8 +- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 282 +++++++----------- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 16 +- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 46 ++- clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs | 40 ++- 5 files changed, 167 insertions(+), 225 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index dba6565084..3002c5fb8a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -100,12 +100,12 @@ sgmiiRx rxCg = <$> bsOk <*> syncStatus <*> regMaybe 0 rxConfReg - <*> regMaybe Invalid rudi + <*> (toStatus <$> regMaybe Invalid rudi) <*> regMaybe Conf xmit - (xmit, txConfReg) = autoNeg syncStatus rudi rxConfReg - (rxDv, rxEr, rxDw, rudi, rxConfReg) = - pcsReceive cg rd dw rxEven syncStatus xmit + rxConfReg = toConfReg <$> regMaybe (C 0) rudi + (xmit, txConfReg) = autoNeg syncStatus rudi + (rxDv, rxEr, rxDw, rudi) = pcsReceive cg rd dw rxEven syncStatus xmit (cg, rd, dw, rxEven, syncStatus) = sync bsCg (bsCg, bsOk) = bitSlip rxCg syncStatus diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index bfa06b358e..b8ed7c162a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} -- | @@ -13,12 +12,9 @@ module Clash.Cores.Sgmii.AutoNeg where import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromMaybe) import Data.Proxy --- | List of values for 'ConfReg' -type ConfRegs = Vec 3 ConfReg - -- | List of values for 'Rudi' type Rudis = Vec 3 Rudi @@ -34,43 +30,41 @@ type Timeout dom = Index (DivRU (Microseconds 1600) (Max 1 (DomainPeriod dom))) -- IEEE 802.3 Clause 37, with exception of the @AN_DISABLE_LINK_OK@ state as -- SGMII always requires auto-negotiation to be available. data AutoNegState dom - = AnEnable {_rudis :: Rudis, _rxConfRegs :: ConfRegs, _failT :: Timeout dom} + = AnEnable + {_rudis :: Maybe Rudis, _rxConfReg :: ConfReg, _failT :: Timeout dom} | AnRestart - { _rudis :: Rudis - , _rxConfRegs :: ConfRegs + { _rudis :: Maybe Rudis + , _rxConfReg :: ConfReg , _failT :: Timeout dom , _linkT :: Timeout dom } | AbilityDetect - { _rudis :: Rudis - , _rxConfRegs :: ConfRegs - , _failT :: Timeout dom - , _txConfReg :: ConfReg - } - | AcknowledgeDetect - { _rudis :: Rudis - , _rxConfRegs :: ConfRegs + {_rudis :: Maybe Rudis, _rxConfReg :: ConfReg, _failT :: Timeout dom} + | AckDetect + { _rudis :: Maybe Rudis + , _rxConfReg :: ConfReg , _failT :: Timeout dom - , _txConfReg :: ConfReg + , _hist :: ConfReg } - | CompleteAcknowledge - { _rudis :: Rudis - , _rxConfRegs :: ConfRegs + | CompleteAck + { _rudis :: Maybe Rudis + , _rxConfReg :: ConfReg , _failT :: Timeout dom , _linkT :: Timeout dom } | IdleDetect - { _rudis :: Rudis - , _rxConfRegs :: ConfRegs + { _rudis :: Maybe Rudis + , _rxConfReg :: ConfReg , _failT :: Timeout dom , _linkT :: Timeout dom } - | LinkOk {_rudis :: Rudis, _rxConfRegs :: ConfRegs, _failT :: Timeout dom} + | LinkOk + {_rudis :: Maybe Rudis, _rxConfReg :: ConfReg, _failT :: Timeout dom} deriving (Generic, NFDataX, Eq, Show) --- | The default configuration of the MAC as defined in the SGMII standard -mrAdvAbility :: ConfReg -mrAdvAbility = 0b0100000000000001 +-- | Set the acknowledge bit of a 'ConfReg' to zero +noAckBit :: ConfReg -> ConfReg +noAckBit = replaceBit (14 :: Index 16) 0 -- | The duration of @linkT@ is 1.6 ms according to the SGMII reference, -- which means that it has a frequency of 625 Hz. This is the same as 200000 @@ -81,85 +75,34 @@ mrAdvAbility = 0b0100000000000001 timeout :: (KnownDomain dom) => Proxy dom -> Timeout dom timeout Proxy = if clashSimulation then 3 else maxBound --- | Function that handles the reset to 'AnEnable', this is split out to reduce --- the amount of state transitions in every state -anEnable :: - forall dom. - (KnownDomain dom) => - -- | Fail timer value - Timeout dom -> - -- | New incoming RUDI value - Maybe Rudi -> - -- | History of RUDI values - Rudis -> - -- | History of configuration registers - ConfRegs -> - -- | Possible state transition - Maybe (AutoNegState dom) -anEnable failT rudi rudis rxConfRegs - | failT >= timeout (Proxy @dom) = - Just $ AnEnable rudis rxConfRegs (timeout (Proxy @dom) - 1) - | rudi == Just Invalid = Just $ AnEnable rudis rxConfRegs failT - | otherwise = Nothing - -- | Check if the the last three received values of @rxConfReg@ are the same -- (with the exception for bit 14, the acknowledge bit, which is discarded). -- If there has been 'Rudi' value of 'I' in the same set of values, then -- return 'False'. -abilityMatch :: - -- | Last three values for 'Rudi' - Rudis -> - -- | Last three values for 'ConfReg' - ConfRegs -> - -- | Whether they satisfy the 'abilityMatch' condition - Bool -abilityMatch rudis rxConfRegs = - repeat (head rxConfRegs') == rxConfRegs' && I `notElem` rudis +abilityMatch :: Rudis -> Bool +abilityMatch rudis = repeat (head rxConfRegs) == rxConfRegs && I `notElem` rudis where - rxConfRegs' = map (replaceBit (14 :: Index 16) 0) rxConfRegs + rxConfRegs = map (noAckBit . fromMaybe 0 . toConfReg) rudis -- | Check if the last three values for 'ConfReg' are all the same, and also -- check whether bit 14 (the acknowledge bit) has been asserted -acknowledgeMatch :: - -- | Last three values for 'ConfReg' - ConfRegs -> - -- | Whether they satisfy the 'acknowledgeMatch' condition - Bool -acknowledgeMatch rxConfRegs = +ackMatch :: Rudis -> Bool +ackMatch rudis = repeat (head rxConfRegs) == rxConfRegs && testBit (head rxConfRegs) 14 + where + rxConfRegs = map (fromMaybe 0 . toConfReg) rudis --- | Check if both 'abilityMatch' and 'acknowledgeMatch' are true for the same +-- | Check if both 'abilityMatch' and 'ackMatch' are true for the same -- set of 'Rudi' and 'ConfReg' values. -consistencyMatch :: - -- | Last three values for 'Rudi' - Rudis -> - -- | Last three values for 'ConfReg' - ConfRegs -> - -- | Whether they satisfy the 'consistencyMatch' condition - Bool -consistencyMatch rudis rxConfigRegs = - abilityMatch rudis rxConfigRegs && acknowledgeMatch rxConfigRegs +consistencyMatch :: ConfReg -> Rudis -> Bool +consistencyMatch rxConfReg rudis = noAckBit rxConfReg == head rxConfRegs' + where + rxConfRegs' = map (noAckBit . fromMaybe 0 . toConfReg) rudis -- | Function that checks that the last three values of 'Rudi' have been 'I' idleMatch :: Rudis -> Bool idleMatch = (==) (repeat I) --- | General part of the status update of the auto negotiation function, where --- the new values of 'Rudi', 'ConfReg' and the 'Timeout's are handled. -anUpdate :: - (KnownDomain dom) => - AutoNegState dom -> - SyncStatus -> - Maybe Rudi -> - Maybe ConfReg -> - (Rudis, ConfRegs, Timeout dom, Timeout dom) -anUpdate s syncStatus rudi rxConfReg = (rudis, rxConfRegs, failT, linkT) - where - rudis = maybe s._rudis (s._rudis <<+) rudi - rxConfRegs = maybe s._rxConfRegs (s._rxConfRegs <<+) rxConfReg - failT = if syncStatus == Fail then s._failT + 1 else 0 - linkT = s._linkT + 1 - -- | State transition function for 'autoNeg' as defined in IEEE 802.3 Clause 37. -- It takes the current 'SyncStatus' from 'Sgmii.sync' as well as the 'Rudi' -- and 'ConfReg' signals from 'Sgmii.pcsReceive'. @@ -169,77 +112,71 @@ autoNegT :: -- | Current state AutoNegState dom -> -- | New input values - (SyncStatus, Maybe Rudi, Maybe ConfReg) -> + (SyncStatus, Maybe Rudi) -> -- | New state AutoNegState dom -autoNegT self@AnEnable{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | otherwise = AnRestart rudis rxConfRegs failT 0 - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg -autoNegT self@AnRestart{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | linkT >= timeout (Proxy @dom) = - AbilityDetect rudis rxConfRegs failT mrAdvAbility - | otherwise = AnRestart rudis rxConfRegs failT linkT - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg -autoNegT self@AbilityDetect{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | abilityMatch rudis rxConfRegs && last rxConfRegs /= 0 = - AcknowledgeDetect rudis rxConfRegs failT txConfReg - | otherwise = AbilityDetect rudis rxConfRegs failT mrAdvAbility - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg - txConfReg = replaceBit (14 :: Index 16) 0 mrAdvAbility -autoNegT self@AcknowledgeDetect{..} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | acknowledgeMatch rxConfRegs && not (consistencyMatch rudis rxConfRegs) = - AnEnable rudis rxConfRegs failT - | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = - AnEnable rudis rxConfRegs failT - | acknowledgeMatch rxConfRegs && consistencyMatch rudis rxConfRegs = - CompleteAcknowledge rudis rxConfRegs failT 0 - | otherwise = AcknowledgeDetect rudis rxConfRegs failT txConfReg - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg - txConfReg = replaceBit (14 :: Index 16) 1 _txConfReg -autoNegT self@CompleteAcknowledge{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = - AnEnable rudis rxConfRegs failT - | linkT >= timeout (Proxy @dom) && not (abilityMatch rudis rxConfRegs) = - IdleDetect rudis rxConfRegs failT 0 - | linkT >= timeout (Proxy @dom) && last rxConfRegs /= 0 = - IdleDetect rudis rxConfRegs failT 0 - | otherwise = CompleteAcknowledge rudis rxConfRegs failT linkT - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg -autoNegT self@IdleDetect{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | abilityMatch rudis rxConfRegs && last rxConfRegs == 0 = - AnEnable rudis rxConfRegs failT - | linkT >= timeout (Proxy @dom) && idleMatch rudis = - LinkOk rudis rxConfRegs failT - | otherwise = IdleDetect rudis rxConfRegs failT linkT - where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, linkT) = anUpdate self syncStatus rudi rxConfReg -autoNegT self@LinkOk{} (syncStatus, rudi, rxConfReg) - | isJust s = fromJust s - | abilityMatch rudis rxConfRegs = AnEnable rudis rxConfRegs failT - | otherwise = LinkOk rudis rxConfRegs failT +autoNegT self (syncStatus, rudi) + | failT >= timeout (Proxy @dom) = + AnEnable (Just rudis) rxConfReg (timeout (Proxy @dom) - 1) + | rudi == Just Invalid = AnEnable (Just rudis) rxConfReg failT + | otherwise = case self of + AnEnable{} + | otherwise -> AnRestart Nothing rxConfReg failT 0 + AnRestart{} + | linkT >= timeout (Proxy @dom) -> AbilityDetect Nothing rxConfReg failT + | otherwise -> AnRestart (Just rudis) rxConfReg failT linkT + AbilityDetect{} + | abilityMatch rudis && rxConfReg /= 0 -> + AckDetect Nothing rxConfReg failT rxConfReg + | otherwise -> AbilityDetect (Just rudis) rxConfReg failT + AckDetect{} + | ackMatch rudis && not (consistencyMatch self._rxConfReg rudis) -> + AnEnable Nothing rxConfReg failT + | abilityMatch rudis && rxConfReg == 0 -> + AnEnable Nothing rxConfReg failT + | ackMatch rudis && consistencyMatch self._rxConfReg rudis -> + CompleteAck Nothing rxConfReg failT 0 + | otherwise -> AckDetect (Just rudis) rxConfReg failT self._hist + CompleteAck{} + | abilityMatch rudis && rxConfReg == 0 -> + AnEnable Nothing rxConfReg failT + | linkT >= timeout (Proxy @dom) && not (abilityMatch rudis) -> + IdleDetect Nothing rxConfReg failT 0 + | linkT >= timeout (Proxy @dom) && rxConfReg /= 0 -> + IdleDetect Nothing rxConfReg failT 0 + | otherwise -> CompleteAck (Just rudis) rxConfReg failT linkT + IdleDetect{} + | abilityMatch rudis && rxConfReg == 0 -> + AnEnable Nothing rxConfReg failT + | linkT >= timeout (Proxy @dom) && idleMatch rudis -> + LinkOk Nothing rxConfReg failT + | otherwise -> IdleDetect (Just rudis) rxConfReg failT linkT + LinkOk{} + | abilityMatch rudis -> AnEnable Nothing rxConfReg failT + | otherwise -> LinkOk (Just rudis) rxConfReg failT where - s = anEnable failT rudi rudis rxConfRegs - (rudis, rxConfRegs, failT, _) = anUpdate self syncStatus rudi rxConfReg + rudis = maybe rudis' (rudis' <<+) rudi + where + rudis' = fromMaybe (repeat I) self._rudis + rxConfReg = fromMaybe self._rxConfReg (toConfReg =<< rudi) + failT = if syncStatus == Fail then self._failT + 1 else 0 + linkT = self._linkT + 1 -- | Output function for 'autoNeg' as defined in IEEE 802.3 Clause 37. Returns -- the new value for 'Xmit' and 'ConfReg' for 'Sgmii.pcsTransmit'. +-- +-- __TODO__: The state diagram shows that in the state @ABILITY_DETECT@ the +-- acknowledge bit should be set to zero. However, if this is done, the PHY +-- does not always (~50% of the time) exit auto-negotiation mode, which means +-- that no data can be transmitted. This can be resolved by resetting the PCS +-- receive. The documentation for SGMII, specifically Table 1, shows that the +-- acknowledge bit of the configuration register is always asserted, that is +-- why here the decision has been made to remove this deassertion to zero in +-- @ABILITY_DETECT@. Now the PHY does correctly exit auto-negotiation mode, +-- and the configuration register will be transmitted correctly. However, due +-- to the lack of a description of specific changes in the documentation, it +-- is not clear whether this is indeed the correct solution, and it should be +-- investigated further. autoNegO :: forall dom. (KnownDomain dom) => @@ -247,23 +184,26 @@ autoNegO :: AutoNegState dom -> -- | New outputs (AutoNegState dom, Maybe Xmit, Maybe ConfReg) -autoNegO self@AnEnable{} = (self, Just Conf, Just 0) -autoNegO self@AnRestart{} = (self, Nothing, Just 0) -autoNegO self@AbilityDetect{..} = (self, Nothing, Just txConfReg) - where - txConfReg = replaceBit (14 :: Index 16) 0 _txConfReg -autoNegO self@AcknowledgeDetect{..} = (self, Nothing, Just txConfReg) +autoNegO self = case self of + AnEnable{} -> (self, Just Conf, Just 0) + AnRestart{} -> (self, Nothing, Just 0) + -- According to IEEE 802.3 this should have the acknowledge bit deasserted, + -- but for SGMII the acknowledge bit is always asserted + AbilityDetect{} -> (self, Nothing, Just txConfReg) + AckDetect{} -> (self, Nothing, Just txConfReg) + CompleteAck{} -> (self, Nothing, Nothing) + IdleDetect{} -> (self, Just Idle, Nothing) + LinkOk{} -> (self, Just Data, Nothing) where - txConfReg = replaceBit (14 :: Index 16) 1 _txConfReg -autoNegO self@CompleteAcknowledge{} = (self, Nothing, Nothing) -autoNegO self@IdleDetect{} = (self, Just Idle, Nothing) -autoNegO self@LinkOk{} = (self, Just Data, Nothing) + txConfReg = 0b0100000000000001 -- | Function that implements the auto-negotiation block as defined in IEEE -- 802.3 Clause 37, but modified to comply to the SGMII standard. This --- modification is the decrease of 'Timeout' from 10 ms to 1.6 ms. SGMII also --- uses a different layout of the configuration register, but this does not --- affect the state machine as the acknowledge bit is in the same location. +-- modification is the decrease of 'Timeout' from 10 ms to 1.6 ms, and the +-- fact that SGMII always requires the acknowledge bit to be asserted. SGMII +-- also uses a different layout of the configuration register, but this does +-- not affect the state machine as the acknowledge bit is in the same +-- location. -- -- __N.B.__: This function does not implement the optional Next Page function. autoNeg :: @@ -273,17 +213,15 @@ autoNeg :: Signal dom SyncStatus -> -- | A new value of 'Rudi' from 'Sgmii.pcsReceive' Signal dom (Maybe Rudi) -> - -- | A new value of 'ConfReg' from 'Sgmii.pcsReceive' - Signal dom (Maybe ConfReg) -> -- | Tuple containing the new value for 'Xmit' and a new 'ConfReg' (Signal dom (Maybe Xmit), Signal dom (Maybe ConfReg)) -autoNeg syncStatus rudi rxConfReg = (xmit, txConfReg) +autoNeg syncStatus rudi = (xmit, txConfReg) where (_, xmit, txConfReg) = mooreB (autoNegT @dom) (autoNegO @dom) - (AnEnable (repeat Invalid) (repeat 0) 0) - (syncStatus, rudi, rxConfReg) + (AnEnable Nothing 0 0) + (syncStatus, rudi) {-# CLASH_OPAQUE autoNeg #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 1edcadce6f..a116176cfc 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -53,9 +53,21 @@ data OrderedSet -- | Defines the possible values for the RUDI output signal of the PCS Receive -- block as defined in IEEE 802.3 Clause 36 -data Rudi = C | I | Invalid +data Rudi = C ConfReg | I | Invalid deriving (Generic, NFDataX, Eq, Show) +-- | Convert a 'Rudi' to a 'ConfReg' +toConfReg :: Rudi -> Maybe ConfReg +toConfReg (C confReg) = Just confReg +toConfReg _ = Nothing + +-- | Convert a 'Rudi' to just the first bits +toStatus :: Rudi -> BitVector 2 +toStatus rudi = case rudi of + C _ -> 0b00 + I -> 0b01 + Invalid -> 0b10 + -- | Record that holds the current status of the module, specifically the -- 'SyncStatus' from 'Sgmii.sync', the 'ConfReg' that has been received by -- 'Sgmii.pcsReceive', the 'Rudi' that is transmitted by 'Sgmii.pcsReceive' @@ -64,7 +76,7 @@ data SgmiiStatus = SgmiiStatus { _cBsOk :: Bool , _cSyncStatus :: SyncStatus , _cRxConfReg :: ConfReg - , _cRudi :: Rudi + , _cRudi :: BitVector 2 , _cXmit :: Xmit } diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 7ec9e674ca..3d6fd27cd6 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -283,32 +283,27 @@ pcsReceiveO :: , Maybe Bool , Maybe Symbol8b10b , Maybe Rudi - , Maybe ConfReg ) pcsReceiveO self = case self of - WaitForK{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) - RxK{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) - RxCB{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) - RxCD{} -> (self, Nothing, Nothing, Nothing, Just C, Just rxConfReg) - RxInvalid{} -> (self, Nothing, Nothing, Nothing, rudi1, Nothing) - IdleD{} -> (self, Just False, Just False, Nothing, Just I, Nothing) - FalseCarrier{} -> - (self, Nothing, Just True, Just (Cw 0b00001110), Nothing, Nothing) + WaitForK{} -> (self, Just False, Just False, Nothing, Nothing) + RxK{} -> (self, Just False, Just False, Nothing, Nothing) + RxCB{} -> (self, Just False, Just False, Nothing, Nothing) + RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C rxConfReg)) + RxInvalid{} -> (self, Nothing, Nothing, Nothing, rudi1) + IdleD{} -> (self, Just False, Just False, Nothing, Just I) + FalseCarrier{} -> (self, Nothing, Just True, Just (Cw 0b00001110), Nothing) StartOfPacket{} -> - (self, Just True, Just False, Just (Cw 0b01010101), Nothing, Nothing) - EarlyEnd{} -> (self, Nothing, Just True, Nothing, Nothing, Nothing) - TriRri{} -> (self, Just False, Just False, Nothing, Nothing, Nothing) - TrrExtend{} -> - (self, Just False, Just True, Just (Cw 0b00001111), Nothing, Nothing) - PacketBurstRrs{} -> - (self, Just False, Nothing, Just (Cw 0b00001111), Nothing, Nothing) - ExtendErr{} -> - (self, Just False, Nothing, Just (Cw 0b00011111), Nothing, Nothing) - EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing, Nothing) - RxData{} -> (self, Nothing, Just False, Just self._hist, Nothing, Nothing) - RxDataError{} -> (self, Nothing, Just True, Just self._hist, Nothing, Nothing) - LinkFailed{} -> (self, rxDv, Just self._rx, Nothing, rudi2, Nothing) - _ -> (self, Nothing, Nothing, Nothing, Nothing, Nothing) + (self, Just True, Just False, Just (Cw 0b01010101), Nothing) + EarlyEnd{} -> (self, Nothing, Just True, Nothing, Nothing) + TriRri{} -> (self, Just False, Just False, Nothing, Nothing) + TrrExtend{} -> (self, Just False, Just True, Just (Cw 0b00001111), Nothing) + PacketBurstRrs{} -> (self, Just False, Nothing, Just (Cw 0b00001111), Nothing) + ExtendErr{} -> (self, Just False, Nothing, Just (Cw 0b00011111), Nothing) + EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing) + RxData{} -> (self, Nothing, Just False, Just self._hist, Nothing) + RxDataError{} -> (self, Nothing, Just True, Just self._hist, Nothing) + LinkFailed{} -> (self, rxDv, Just self._rx, Nothing, rudi2) + _ -> (self, Nothing, Nothing, Nothing, Nothing) where rxConfReg = (fromSymbol self._hist ++# 0) .|. self._rxConfReg rudi1 = if self._xmit == Conf then Just Invalid else Nothing @@ -338,11 +333,10 @@ pcsReceive :: , Signal dom (Maybe Bool) , Signal dom (Maybe Symbol8b10b) , Signal dom (Maybe Rudi) - , Signal dom (Maybe ConfReg) ) -pcsReceive cg rd dw1 rxEven syncStatus xmit = (rxDv, rxEr, dw2, rudi, rxConfReg) +pcsReceive cg rd dw1 rxEven syncStatus xmit = (rxDv, rxEr, dw2, rudi) where - (_, rxDv, rxEr, dw2, rudi, rxConfReg) = + (_, rxDv, rxEr, dw2, rudi) = mooreB pcsReceiveT pcsReceiveO diff --git a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs index 935558cf92..3729e88250 100644 --- a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs @@ -48,51 +48,49 @@ genConfRegsAck range = do -- entered state for debugging purposes. autoNegSim :: (C.HiddenClockResetEnable dom) => - C.Signal dom (SyncStatus, Maybe Rudi, Maybe ConfReg) -> + C.Signal dom (SyncStatus, Maybe Rudi) -> C.Signal dom (AutoNegState dom) -autoNegSim i = s +autoNegSim (C.unbundle -> i) = s where - (s, _, _) = - C.unbundle $ - C.moore autoNegT autoNegO (AnEnable (C.repeat Invalid) (C.repeat 0) 0) i + (s, _, _) = C.mooreB autoNegT autoNegO (AnEnable Nothing 0 0) i -- | Generate a list of values that do not contain the acknowledge bit, and -- assert that the @ACKNOWLEDGE_DETECT@ state is entered but not the -- @COMPLETE_ACKNOWLEDGE@ state -prop_autoNegNoAcknowledgeComplete :: H.Property -prop_autoNegNoAcknowledgeComplete = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) +prop_autoNegNoAckComplete :: H.Property +prop_autoNegNoAckComplete = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 9 100)) inp <- H.forAll (genConfRegsNoAck (Range.singleton simDuration)) let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f i = (Ok, Nothing, Just i) + f a = (Ok, Just (C a)) H.assert $ isNothing (find g simOut) H.assert $ isJust (find h simOut) where - g (CompleteAcknowledge{}) = True + g (CompleteAck{}) = True g _ = False - h (AcknowledgeDetect{}) = True + h (AckDetect{}) = True h _ = False -- | Generate a list of values that do contain the acknowledge bit, and assert -- that the @COMPLETE_ACKNOWLEDGE@ state is entered -prop_autoNegAcknowledgeComplete :: H.Property -prop_autoNegAcknowledgeComplete = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) +prop_autoNegAckComplete :: H.Property +prop_autoNegAckComplete = H.property $ do + simDuration <- H.forAll (Gen.integral (Range.linear 12 100)) inp <- H.forAll (genConfRegsAck (Range.singleton simDuration)) let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f i = (Ok, Nothing, Just i) + f a = (Ok, Just (C a)) H.assert $ isJust (find g simOut) where - g (CompleteAcknowledge{}) = True + g (CompleteAck{}) = True g _ = False -- | Assert that in a simulation, the number of times a given state that uses @@ -105,7 +103,7 @@ prop_autoNegLinkTimer = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f i = (Ok, Nothing, Just i) + f a = (Ok, Just (C a)) (length . filter g) simOut H.=== 3 where @@ -123,7 +121,7 @@ prop_autoNegFail = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f i = (Fail, Nothing, Just i) + f a = (Fail, Just (C a)) (length . filter g) (drop 10 simOut) H.=== simDuration - 10 where @@ -132,7 +130,7 @@ prop_autoNegFail = H.property $ do -- | Assert that if values with ack set and ack not set are inputted -- interchangeably the system will never trigger 'acknowledgeMatch' and thus --- not reach 'CompleteAcknowledge'. +-- not reach 'CompleteAck'. prop_autoNegNoThreeInARow :: H.Property prop_autoNegNoThreeInARow = H.property $ do simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) @@ -143,11 +141,11 @@ prop_autoNegNoThreeInARow = H.property $ do simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f i = (Ok, Nothing, Just i) + f a = (Ok, Just (C a)) H.assert $ isNothing (find g simOut) where - g (CompleteAcknowledge{}) = True + g (CompleteAck{}) = True g _ = False C.createDomain C.vSystem{C.vName = "TimeoutDom", C.vPeriod = C.hzToPeriod 125e6} From 8663b083c870b858b7f0a28f88a4cc4787368cda Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Thu, 25 Jul 2024 09:56:12 +0200 Subject: [PATCH 13/30] Improve PCS receive block --- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 263 +++++++----------- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 57 ++-- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 3 +- 3 files changed, 132 insertions(+), 191 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 3d6fd27cd6..2b58ce1181 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -13,18 +13,10 @@ module Clash.Cores.Sgmii.PcsReceive where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust, fromMaybe, isJust) +import Data.Maybe (fromJust, isJust) -- | Defines all possible valid 'checkEnd' results -data CheckEnd - = K28_5DK28_5 - | K28_5D21_5D00_0 - | K28_5D02_2D00_0 - | TRK28_5 - | TRR - | RRR - | RRK28_5 - | RRS +data CheckEnd = KDK | KDD | TRK | TRR | RRR | RRK | RRS deriving (Eq, Show) -- | State type of 'pcsReceive'. This contains all states as they are defined in @@ -33,28 +25,23 @@ data CheckEnd -- group. The transitions of these states are embedded in the states that -- usually transition to either of these states. data PcsReceiveState - = WaitForK {_rx :: Bool, _xmit :: Xmit} - | RxK {_rx :: Bool, _xmit :: Xmit} - | RxCB {_rx :: Bool, _xmit :: Xmit} - | RxCC {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} - | RxCD - { _rx :: Bool - , _xmit :: Xmit - , _hist :: Symbol8b10b - , _rxConfReg :: ConfReg - } + = WaitForK {_rx :: Bool} + | RxK {_rx :: Bool} + | RxCB {_rx :: Bool} + | RxCC {_rx :: Bool, _hist :: Symbol8b10b} + | RxCD {_rx :: Bool, _rxConfReg :: ConfReg} | RxInvalid {_rx :: Bool, _xmit :: Xmit} - | IdleD {_rx :: Bool, _xmit :: Xmit} - | FalseCarrier {_rx :: Bool, _xmit :: Xmit} - | StartOfPacket {_rx :: Bool, _xmit :: Xmit} - | EarlyEnd {_rx :: Bool, _xmit :: Xmit} - | TriRri {_rx :: Bool, _xmit :: Xmit} - | TrrExtend {_rx :: Bool, _xmit :: Xmit} - | PacketBurstRrs {_rx :: Bool, _xmit :: Xmit} - | ExtendErr {_rx :: Bool, _xmit :: Xmit} - | EarlyEndExt {_rx :: Bool, _xmit :: Xmit} - | RxData {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} - | RxDataError {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} + | IdleD {_rx :: Bool} + | FalseCarrier {_rx :: Bool} + | StartOfPacket {_rx :: Bool} + | EarlyEnd {_rx :: Bool} + | TriRri {_rx :: Bool} + | TrrExtend {_rx :: Bool} + | PacketBurstRrs {_rx :: Bool} + | ExtendErr {_rx :: Bool} + | EarlyEndExt {_rx :: Bool} + | RxData {_rx :: Bool, _hist :: Symbol8b10b} + | RxDataError {_rx :: Bool, _hist :: Symbol8b10b} | LinkFailed {_rx :: Bool, _xmit :: Xmit} deriving (Generic, NFDataX, Eq, Show) @@ -102,49 +89,46 @@ checkEnd :: -- | End condition Maybe CheckEnd checkEnd dws - | dws == cwK28_5 :> dws !! (1 :: Index 3) :> cwK28_5 :> Nil = Just K28_5DK28_5 - | dws == cwK28_5 :> dwD21_5 :> dwD00_0 :> Nil = Just K28_5D21_5D00_0 - | dws == cwK28_5 :> dwD02_2 :> dwD00_0 :> Nil = Just K28_5D02_2D00_0 - | dws == cwT :> cwR :> cwK28_5 :> Nil = Just TRK28_5 + | dws == cwK28_5 :> dws !! (1 :: Index 3) :> cwK28_5 :> Nil = Just KDK + | dws == cwK28_5 :> dwD21_5 :> dwD00_0 :> Nil = Just KDD + | dws == cwK28_5 :> dwD02_2 :> dwD00_0 :> Nil = Just KDD + | dws == cwT :> cwR :> cwK28_5 :> Nil = Just TRK | dws == cwT :> Nil ++ repeat cwR = Just TRR | dws == repeat cwR = Just RRR - | dws == repeat cwR ++ cwK28_5 :> Nil = Just RRK28_5 + | dws == repeat cwR ++ cwK28_5 :> Nil = Just RRK | dws == repeat cwR ++ cwS :> Nil = Just RRS | otherwise = Nothing -- | Function that implements the transitions of the @EPD2_CHECK_END@ state -epd2CheckEnd :: - Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState -epd2CheckEnd dws rxEven rx xmit - | rxEnd == Just RRR = Just (TrrExtend rx xmit) - | rxEnd == Just RRK28_5 && rxEven == Even = Just (TriRri rx xmit) - | rxEnd == Just RRS = Just (PacketBurstRrs rx xmit) +epd2CheckEnd :: Vec 3 Symbol8b10b -> Even -> Bool -> Maybe PcsReceiveState +epd2CheckEnd dws rxEven rx + | rxEnd == Just RRR = Just (TrrExtend rx) + | rxEnd == Just RRK && rxEven == Even = Just (TriRri rx) + | rxEnd == Just RRS = Just (PacketBurstRrs rx) | otherwise = Nothing where rxEnd = checkEnd dws -- | Function that implements the transitions of the @RECEIVE@ state -receive :: Vec 3 Symbol8b10b -> Even -> Bool -> Xmit -> Maybe PcsReceiveState -receive dws rxEven rx xmit - | rxEnd == Just K28_5DK28_5 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just K28_5D21_5D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just K28_5D02_2D00_0 && rxEven == Even = Just (EarlyEnd rx xmit) - | rxEnd == Just TRK28_5 && rxEven == Even = Just (TriRri rx xmit) - | rxEnd == Just TRR = Just (TrrExtend rx xmit) - | rxEnd == Just RRR = Just (EarlyEnd rx xmit) - | isDw (head dws) = Just (RxData rx xmit dw) +receive :: Vec 3 Symbol8b10b -> Even -> Bool -> Maybe PcsReceiveState +receive dws rxEven rx + | rxEnd == Just KDK && rxEven == Even = Just (EarlyEnd rx) + | rxEnd == Just KDD && rxEven == Even = Just (EarlyEnd rx) + | rxEnd == Just TRK && rxEven == Even = Just (TriRri rx) + | rxEnd == Just TRR = Just (TrrExtend rx) + | rxEnd == Just RRR = Just (EarlyEnd rx) + | isDw (head dws) = Just (RxData rx (head dws)) | otherwise = Nothing where rxEnd = checkEnd dws - dw = head dws -- | State transition function for 'pcsReceive'. Takes the state as defined in -- 'PcsReceiveState' and returns the next state as defined in Clause 36 of -- IEEE 802.3. In contrast to the specification in Clause 36, here -- 'Sgmii.syncT' is responsible for decoding the code groups instead of this -- function, to not duplicate any work, but as this function does need to --- determine the difference in bits ('bitDifference') the code group is set as --- an input value as well. +-- determine the difference in bits the code group is set as an input value as +-- well. -- -- __N.B.__: This function does not implement the optional EEE -- (Energy-Efficient Ethernet) capability. @@ -153,124 +137,85 @@ pcsReceiveT :: PcsReceiveState -> -- | Input values, where @Vec 3 CodeGroup@ contains the current and next two -- | data words - (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus, Maybe Xmit) -> + (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus, Xmit) -> -- | New state PcsReceiveState pcsReceiveT WaitForK{..} (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed False xmit' - | head dws == cwK28_5 && rxEven == Even = RxK False xmit' - | otherwise = WaitForK _rx xmit' - where - xmit' = fromMaybe _xmit xmit -pcsReceiveT RxK{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed False xmit' - | dw == dwD21_5 = RxCB False xmit' - | dw == dwD02_2 = RxCB False xmit' - | not (isDw dw) && xmit' /= Data = RxInvalid False xmit' - | xmit' /= Data && isDw dw = IdleD False xmit' - | xmit' == Data = IdleD False xmit' - | otherwise = RxK _rx xmit' - where - xmit' = fromMaybe _xmit xmit - dw = head dws + | syncStatus == Fail = LinkFailed False xmit + | head dws == cwK28_5 && rxEven == Even = RxK False + | otherwise = WaitForK _rx +pcsReceiveT RxK{} (_, _, dws, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit + | head dws == dwD21_5 || head dws == dwD02_2 = RxCB False + | xmit == Data || isDw (head dws) = IdleD False + | otherwise = RxInvalid False xmit pcsReceiveT RxCB{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | isDw dw = RxCC _rx xmit' dw - | otherwise = RxInvalid _rx xmit' - where - xmit' = fromMaybe _xmit xmit - dw = head dws + | syncStatus == Fail = LinkFailed _rx xmit + | isDw (head dws) = RxCC _rx (head dws) + | otherwise = RxInvalid _rx xmit pcsReceiveT RxCC{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | isDw dw = RxCD _rx xmit' dw $ resize $ fromSymbol _hist - | otherwise = RxInvalid _rx xmit' + | syncStatus == Fail = LinkFailed _rx xmit + | isDw (head dws) = RxCD _rx rxConfReg + | otherwise = RxInvalid _rx xmit where - xmit' = fromMaybe _xmit xmit - dw = head dws + rxConfReg = pack $ map fromSymbol $ head dws :> _hist :> Nil pcsReceiveT RxCD{..} (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | dw == cwK28_5 && rxEven == Even = RxK _rx xmit' - | dw /= cwK28_5 = RxInvalid _rx xmit' - | rxEven == Odd = RxInvalid _rx xmit' - | otherwise = RxCD _rx xmit' _hist _rxConfReg - where - xmit' = fromMaybe _xmit xmit - dw = head dws + | syncStatus == Fail = LinkFailed _rx xmit + | head dws == cwK28_5 && rxEven == Even = RxK _rx + | otherwise = RxInvalid _rx xmit pcsReceiveT RxInvalid{..} (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed rx xmit' - | dw == cwK28_5 && rxEven == Even = RxK rx xmit' - | dw /= cwK28_5 && rxEven == Even = WaitForK rx xmit' - | otherwise = RxInvalid _rx xmit' + | syncStatus == Fail = LinkFailed rx xmit + | rxEven == Odd = RxInvalid rx xmit + | head dws == cwK28_5 = RxK rx + | otherwise = WaitForK rx where - rx = xmit' == Data || _rx - xmit' = fromMaybe _xmit xmit - dw = head dws -pcsReceiveT IdleD{..} (cg, rd, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed False xmit' - | dw /= cwK28_5 && xmit' /= Data = RxInvalid False xmit' - | carrierDetected && xmit' == Data && dw /= cwS = FalseCarrier False xmit' - | carrierDetected && xmit' == Data && dw == cwS = StartOfPacket False xmit' - | otherwise = RxK False xmit' + rx = xmit == Data || _rx +pcsReceiveT IdleD{} (cg, rd, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit + | head dws /= cwK28_5 && xmit /= Data = RxInvalid False xmit + | carrierDetected && xmit == Data && head dws /= cwS = FalseCarrier False + | carrierDetected && xmit == Data && head dws == cwS = StartOfPacket False + | otherwise = RxK False where carrierDetected = carrierDetect cg rd rxEven - xmit' = fromMaybe _xmit xmit - dw = head dws pcsReceiveT FalseCarrier{..} (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed True xmit' - | dw == cwK28_5 && rxEven == Even = RxK True xmit' - | otherwise = FalseCarrier _rx xmit' - where - xmit' = fromMaybe _xmit xmit - dw = head dws + | syncStatus == Fail = LinkFailed True xmit + | head dws == cwK28_5 && rxEven == Even = RxK True + | otherwise = FalseCarrier _rx pcsReceiveT EarlyEnd{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | dw == dwD02_2 = RxCB _rx xmit' - | dw == dwD21_5 = RxCB _rx xmit' - | otherwise = IdleD _rx xmit' - where - xmit' = fromMaybe _xmit xmit - dw = head dws + | syncStatus == Fail = LinkFailed _rx xmit + | head dws == dwD21_5 || head dws == dwD02_2 = RxCB False + | otherwise = IdleD _rx pcsReceiveT TriRri{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed False xmit' - | head dws == cwK28_5 = RxK False xmit' - | otherwise = TriRri _rx xmit' - where - xmit' = fromMaybe _xmit xmit + | syncStatus == Fail = LinkFailed False xmit + | head dws == cwK28_5 = RxK False + | otherwise = TriRri _rx pcsReceiveT PacketBurstRrs{..} (_, _, dws, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | head dws == cwS = StartOfPacket _rx xmit' - | otherwise = PacketBurstRrs _rx xmit' - where - xmit' = fromMaybe _xmit xmit + | syncStatus == Fail = LinkFailed _rx xmit + | head dws == cwS = StartOfPacket _rx + | otherwise = PacketBurstRrs _rx pcsReceiveT ExtendErr{..} (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed _rx xmit' - | dw == cwS = StartOfPacket _rx xmit' - | dw == cwK28_5 && rxEven == Even = RxK _rx xmit' + | syncStatus == Fail = LinkFailed _rx xmit + | head dws == cwS = StartOfPacket _rx + | head dws == cwK28_5 && rxEven == Even = RxK _rx | isJust s && rxEven == Even = fromJust s - | otherwise = ExtendErr _rx xmit' - where - s = epd2CheckEnd dws rxEven _rx xmit' - xmit' = fromMaybe _xmit xmit - dw = head dws -pcsReceiveT LinkFailed{..} (_, _, _, _, syncStatus, xmit) - | syncStatus == Fail = LinkFailed False xmit' - | otherwise = WaitForK False xmit' + | otherwise = ExtendErr _rx where - xmit' = fromMaybe _xmit xmit + s = epd2CheckEnd dws rxEven _rx +pcsReceiveT LinkFailed{} (_, _, _, _, syncStatus, xmit) + | syncStatus == Fail = LinkFailed False xmit + | otherwise = WaitForK False pcsReceiveT self (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed self._rx xmit' + | syncStatus == Fail = LinkFailed self._rx xmit | isJust s1 = fromJust s1 | otherwise = s2 where (s1, s2) = case self of TrrExtend{} -> - (epd2CheckEnd dws rxEven self._rx xmit', ExtendErr self._rx xmit') + (epd2CheckEnd dws rxEven self._rx, ExtendErr self._rx) EarlyEndExt{} -> - (epd2CheckEnd dws rxEven self._rx xmit', ExtendErr self._rx xmit') - _ -> (receive dws rxEven self._rx xmit', RxDataError self._rx xmit' dw) - - xmit' = fromMaybe self._xmit xmit - dw = head dws + (epd2CheckEnd dws rxEven self._rx, ExtendErr self._rx) + _ -> (receive dws rxEven self._rx, RxDataError self._rx (head dws)) -- | Output function for 'pcsReceive', that sets the outputs as defined in IEEE -- 802.3 Clause 36. @@ -288,8 +233,9 @@ pcsReceiveO self = case self of WaitForK{} -> (self, Just False, Just False, Nothing, Nothing) RxK{} -> (self, Just False, Just False, Nothing, Nothing) RxCB{} -> (self, Just False, Just False, Nothing, Nothing) - RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C rxConfReg)) - RxInvalid{} -> (self, Nothing, Nothing, Nothing, rudi1) + RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C self._rxConfReg)) + RxInvalid{} -> + (self, Nothing, Nothing, Nothing, orNothing (self._xmit == Conf) Invalid) IdleD{} -> (self, Just False, Just False, Nothing, Just I) FalseCarrier{} -> (self, Nothing, Just True, Just (Cw 0b00001110), Nothing) StartOfPacket{} -> @@ -302,13 +248,14 @@ pcsReceiveO self = case self of EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing) RxData{} -> (self, Nothing, Just False, Just self._hist, Nothing) RxDataError{} -> (self, Nothing, Just True, Just self._hist, Nothing) - LinkFailed{} -> (self, rxDv, Just self._rx, Nothing, rudi2) + LinkFailed{} -> + ( self + , orNothing self._rx False + , Just self._rx + , Nothing + , orNothing (self._xmit /= Data) Invalid + ) _ -> (self, Nothing, Nothing, Nothing, Nothing) - where - rxConfReg = (fromSymbol self._hist ++# 0) .|. self._rxConfReg - rudi1 = if self._xmit == Conf then Just Invalid else Nothing - rudi2 = if self._xmit /= Data then Just Invalid else Nothing - rxDv = if self._rx then Nothing else Just False -- | The 'pcsReceive' block. Takes a tuple with the new input code group, -- running disparity and data word, 'Even', 'SyncStatus' and 'Xmit' signals @@ -340,7 +287,9 @@ pcsReceive cg rd dw1 rxEven syncStatus xmit = (rxDv, rxEr, dw2, rudi) mooreB pcsReceiveT pcsReceiveO - (WaitForK False Idle) - (cg, rd, dw1, rxEven, syncStatus, xmit) + (WaitForK False) + (cg, rd, dw1, rxEven, syncStatus, xmit') + + xmit' = regMaybe Idle xmit {-# CLASH_OPAQUE pcsReceive #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index 10a5d9e82a..36e807ae28 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -29,17 +29,12 @@ data CodeGroupState } | DataGo {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _txEven :: Even} | IdleDisparityWrong {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | IdleI1B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} | IdleDisparityOk {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | IdleI2B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC1A {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC1B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC1C {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC1D {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC2A {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC2B {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC2C {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | ConfigurationC2D {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} + | IdleIB {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCA {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCB {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCC {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCD {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} deriving (Generic, NFDataX, Eq, Show) -- | State transitions from @GENERATE_CODE_GROUP@ from Figure 36-6, which need @@ -51,7 +46,7 @@ generateCg txOSet rd cg txConfReg txEven | txOSet == OSetD = DataGo rd cg txConfReg txEven | txOSet == OSetI && rd = IdleDisparityWrong rd cg txConfReg | txOSet == OSetI && not rd = IdleDisparityOk rd cg txConfReg - | txOSet == OSetC = ConfigurationC1A rd cg txConfReg + | txOSet == OSetC = ConfCA rd cg txConfReg 0 | otherwise = SpecialGo rd cg txConfReg txEven txOSet -- | State transition function for the states as defined in IEEE 802.3 Clause @@ -80,24 +75,25 @@ codeGroupT SpecialGo{..} (txOSet, _, txConfReg) = txEven = nextEven _txEven codeGroupT self (txOSet, dw, txConfReg) = nextState where - generateCg' = generateCg txOSet rd cg txConfReg' - (dw', nextState) = case self of DataGo{} -> (Dw dw, generateCg' txEven) - IdleDisparityWrong{} -> (cwK28_5, IdleI1B rd cg txConfReg') - IdleI1B{} -> (dwD05_6, generateCg' Odd) - IdleDisparityOk{} -> (cwK28_5, IdleI2B rd cg txConfReg') - IdleI2B{} -> (dwD16_2, generateCg' Odd) - ConfigurationC1A{} -> (cwK28_5, ConfigurationC1B rd cg txConfReg') - ConfigurationC1B{} -> (dwD21_5, ConfigurationC1C rd cg txConfReg') - ConfigurationC1C{} -> - (Dw (resize txConfReg'), ConfigurationC1D rd cg txConfReg') - ConfigurationC2A{} -> (cwK28_5, ConfigurationC2B rd cg txConfReg') - ConfigurationC2B{} -> (dwD02_2, ConfigurationC2C rd cg txConfReg') - ConfigurationC2C{} -> - (Dw (resize txConfReg'), ConfigurationC2D rd cg txConfReg') - _ -> (Dw (resize $ rotateR self._txConfReg 8), generateCg' Odd) + IdleDisparityWrong{} -> (cwK28_5, IdleIB rd cg txConfReg' 0) + IdleDisparityOk{} -> (cwK28_5, IdleIB rd cg txConfReg' 1) + IdleIB{} -> (if self._i == 0 then dwD05_6 else dwD16_2, generateCg' Odd) + ConfCA{} -> (cwK28_5, ConfCB rd cg txConfReg' self._i) + ConfCB{} -> + ( if self._i == 0 then dwD21_5 else dwD02_2 + , ConfCC rd cg txConfReg' self._i + ) + ConfCC{} -> (Dw (resize txConfReg'), ConfCD rd cg txConfReg' self._i) + ConfCD{} -> + ( Dw (resize $ rotateR self._txConfReg 8) + , if self._i == 0 && txOSet == OSetC + then ConfCA rd cg txConfReg' 1 + else generateCg' Odd + ) + generateCg' = generateCg txOSet rd cg txConfReg' txConfReg' = fromMaybe self._txConfReg txConfReg (rd, cg) = encode8b10b self._rd dw' txEven = nextEven self._txEven @@ -115,12 +111,9 @@ codeGroupO :: codeGroupO self = case self of SpecialGo{} -> (self, self._cg, txEven, True) DataGo{} -> (self, self._cg, txEven, True) - IdleI1B{} -> (self, self._cg, Odd, True) - IdleI2B{} -> (self, self._cg, Odd, True) - ConfigurationC1B{} -> (self, self._cg, Odd, False) - ConfigurationC1D{} -> (self, self._cg, Odd, True) - ConfigurationC2B{} -> (self, self._cg, Odd, False) - ConfigurationC2D{} -> (self, self._cg, Odd, True) + IdleIB{} -> (self, self._cg, Odd, True) + ConfCB{} -> (self, self._cg, Odd, False) + ConfCD{} -> (self, self._cg, Odd, True) _ -> (self, self._cg, Even, False) where txEven = nextEven self._txEven diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index 922e73498a..d7351b4213 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -87,8 +87,7 @@ orderedSetT self@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState | isJust s = fromJust s - | xmit' == Data && tx && not txEn && not txEr = - XmitData xmit' xmitChange + | xmit' == Data && not txEn && not txEr && tx = XmitData xmit' xmitChange | otherwise = IdleS xmit' xmitChange (xmit', xmitChange) = xmitUpdate self xmit From b7ef75a8a1dd867f3b2d9db9701945a3e3629cae Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Thu, 25 Jul 2024 11:56:34 +0200 Subject: [PATCH 14/30] Improve synchronization block --- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 146 ++++++++-------------- 1 file changed, 52 insertions(+), 94 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 3fe4c86241..863f2714c4 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -- | @@ -23,35 +22,28 @@ type OutputQueue = Vec 3 (Cg, Bool, Symbol8b10b, Even, SyncStatus) -- 802.3 Clause 36. data SyncState = LossOfSync {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | CommaDetect1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} - | AcquireSync1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | CommaDetect2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} - | AcquireSync2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | CommaDetect3 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b} - | SyncAcquired1 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | SyncAcquired2 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | SyncAcquired2A + | CommaDetect {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _i :: Index 3} + | AcquireSync { _cg :: Cg , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even - , _goodCgs :: Index 4 + , _i :: Index 3 } - | SyncAcquired3 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | SyncAcquired3A + | SyncAcquired { _cg :: Cg , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even - , _goodCgs :: Index 4 + , _i :: Index 3 } - | SyncAcquired4 {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | SyncAcquired4A + | SyncAcquiredA { _cg :: Cg , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even , _goodCgs :: Index 4 + , _i :: Index 3 } deriving (Generic, NFDataX, Eq, Show) @@ -80,74 +72,48 @@ syncT :: Cg -> -- | New state and output tuple SyncState -syncT LossOfSync{..} cg - | isNothing comma = LossOfSync cg rd dw rxEven - | otherwise = CommaDetect1 cg rd dw +syncT s cg = case s of + LossOfSync{} + | isNothing comma -> LossOfSync cg rd dw rxEven + | otherwise -> CommaDetect cg rd dw 0 + CommaDetect{} + | not (isDw dw) -> LossOfSync cg rd dw Even + | s._i == 0 -> AcquireSync cg rd dw Even s._i + | otherwise -> SyncAcquired cg rd dw Even 0 + AcquireSync{} + | not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Even -> LossOfSync cg rd dw rxEven + | cg `elem` commas && rxEven == Odd -> CommaDetect cg rd dw 1 + | otherwise -> AcquireSync cg rd dw rxEven 0 + SyncAcquired{} + | s._i == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven + | s._i == maxBound && cg `elem` commas && rxEven == Even -> + LossOfSync cg rd dw rxEven + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (s._i + 1) + | cg `elem` commas && rxEven == Even -> + SyncAcquired cg rd dw rxEven (s._i + 1) + | s._i == 0 -> SyncAcquired cg rd dw rxEven 0 + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs s._i + SyncAcquiredA{} + | s._i == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven + | s._i == maxBound && cg `elem` commas && rxEven == Even -> + LossOfSync cg rd dw rxEven + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (s._i + 1) + | cg `elem` commas && rxEven == Even -> + SyncAcquired cg rd dw rxEven (s._i + 1) + | s._i == 0 && goodCgs == maxBound -> SyncAcquired cg rd dw rxEven 0 + | goodCgs == maxBound -> SyncAcquired cg rd dw rxEven (s._i - 1) + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs s._i where - -- As written in the documentation for 'commas', this is used to recover the - -- running disparity in case there has been a reset comma = elemIndex cg commas - rdNew = maybe _rd bitCoerce comma - + rdNew = case s of + LossOfSync{} -> maybe s._rd bitCoerce comma + _ -> s._rd (rd, dw) = decode8b10b rdNew cg - rxEven = nextEven _rxEven -syncT CommaDetect1{..} cg - | not (isDw dw) = LossOfSync cg rd dw Even - | otherwise = AcquireSync1 cg rd dw Even - where - (rd, dw) = decode8b10b _rd cg -syncT AcquireSync1{..} cg - | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven - | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven - | cg `elem` commas && rxEven == Odd = CommaDetect2 cg rd dw - | otherwise = AcquireSync1 cg rd dw rxEven - where - (rd, dw) = decode8b10b _rd cg - rxEven = nextEven _rxEven -syncT CommaDetect2{..} cg - | not (isDw dw) = LossOfSync cg rd dw Even - | otherwise = AcquireSync2 cg rd dw Even - where - (rd, dw) = decode8b10b _rd cg -syncT AcquireSync2{..} cg - | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven - | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven - | cg `elem` commas && rxEven == Odd = CommaDetect3 cg rd dw - | otherwise = AcquireSync2 cg rd dw rxEven - where - (rd, dw) = decode8b10b _rd cg - rxEven = nextEven _rxEven -syncT CommaDetect3{..} cg - | not (isDw dw) = LossOfSync cg rd dw Even - | otherwise = SyncAcquired1 cg rd dw Even - where - (rd, dw) = decode8b10b _rd cg -syncT SyncAcquired1{..} cg - | not (isValidSymbol dw) = SyncAcquired2 cg rd dw rxEven - | cg `elem` commas && rxEven == Even = SyncAcquired2 cg rd dw rxEven - | otherwise = SyncAcquired1 cg rd dw rxEven - where - (rd, dw) = decode8b10b _rd cg - rxEven = nextEven _rxEven -syncT self cg - | not (isValidSymbol dw) = s1 cg rd dw rxEven - | cg `elem` commas && rxEven == Even = s1 cg rd dw rxEven - | goodCgs == maxBound = s2 cg rd dw rxEven - | otherwise = s3 cg rd dw rxEven goodCgs - where - (s1, s2, s3, goodCgs) = case self of - SyncAcquired2{} -> (SyncAcquired3, undefined, SyncAcquired2A, 0) - SyncAcquired2A{} -> - (SyncAcquired3, SyncAcquired1, SyncAcquired2A, self._goodCgs + 1) - SyncAcquired3{} -> (SyncAcquired4, undefined, SyncAcquired3A, 0) - SyncAcquired3A{} -> - (SyncAcquired4, SyncAcquired2, SyncAcquired3A, self._goodCgs + 1) - SyncAcquired4{} -> (LossOfSync, undefined, SyncAcquired4A, 0) - SyncAcquired4A{} -> - (LossOfSync, SyncAcquired3, SyncAcquired4A, self._goodCgs + 1) - - (rd, dw) = decode8b10b self._rd cg - rxEven = nextEven self._rxEven + rxEven = nextEven s._rxEven + goodCgs = case s of + SyncAcquiredA{} -> s._goodCgs + 1 + _ -> 0 -- | Output function for 'sync'. Takes the state as defined in 'SyncState' and -- returns a tuple containing the outputs as defined in Clause 36 of IEEE @@ -157,21 +123,13 @@ syncO :: SyncState -> -- | New state and output tuple (SyncState, Cg, Bool, Symbol8b10b, Even, SyncStatus) -syncO self@LossOfSync{..} = (self, _cg, _rd, _dw, rxEven, Fail) - where - rxEven = nextEven _rxEven -syncO self@CommaDetect1{..} = (self, _cg, _rd, _dw, Even, Fail) -syncO self@AcquireSync1{..} = (self, _cg, _rd, _dw, rxEven, Fail) - where - rxEven = nextEven _rxEven -syncO self@CommaDetect2{..} = (self, _cg, _rd, _dw, Even, Fail) -syncO self@AcquireSync2{..} = (self, _cg, _rd, _dw, rxEven, Fail) - where - rxEven = nextEven _rxEven -syncO self@CommaDetect3{..} = (self, _cg, _rd, _dw, Even, Fail) -syncO self = (self, self._cg, self._rd, self._dw, rxEven, Ok) +syncO s = case s of + LossOfSync{} -> (s, s._cg, s._rd, s._dw, rxEven, Fail) + CommaDetect{} -> (s, s._cg, s._rd, s._dw, Even, Fail) + AcquireSync{} -> (s, s._cg, s._rd, s._dw, rxEven, Fail) + _ -> (s, s._cg, s._rd, s._dw, rxEven, Ok) where - rxEven = nextEven self._rxEven + rxEven = nextEven s._rxEven -- | Transition function for the inputs of 'Sgmii.pcsReceive'. This is used to -- keep a small list of "future" values for 'Symbol8b10b', such that these can From bb67331ae8223ae47757d22c9cb29718ee4dedda Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 24 Jul 2024 13:16:34 +0200 Subject: [PATCH 15/30] Explicitly export functions --- clash-cores/src/Clash/Cores/Sgmii.hs | 8 +++++++- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 10 +++++++++- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 12 +++++++----- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 4 ++++ clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs | 8 +++++++- clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs | 2 +- .../src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs | 7 ++++++- .../src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs | 6 +++++- clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs | 6 +++++- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 11 ++++++++++- 10 files changed, 61 insertions(+), 13 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index 3002c5fb8a..a7c1b480cd 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -55,7 +55,13 @@ -- basis and they are always transmitted to @TXD@, this port should only be -- read when @RX_DV@ is asserted as invalid data might be provided when it is -- not. -module Clash.Cores.Sgmii where +module Clash.Cores.Sgmii + ( sgmii + , sgmiiRA + , sgmiiRx + , sgmiiTx + ) +where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.AutoNeg diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index b8ed7c162a..b6c94b7d7d 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -8,7 +8,15 @@ -- Maintainer : QBayLogic B.V. -- -- Auto-negotiation process, as defined in IEEE 802.3 Figure 37-6 -module Clash.Cores.Sgmii.AutoNeg where +module Clash.Cores.Sgmii.AutoNeg + ( AutoNegState (..) + , Rudis + , Timeout + , autoNeg + , autoNegO + , autoNegT + ) +where import Clash.Cores.Sgmii.Common import Clash.Prelude diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 0f919b061d..0c31d633bd 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -9,7 +9,13 @@ -- -- Bit slip function that word-aligns a stream of bits based on received -- comma values -module Clash.Cores.Sgmii.BitSlip where +module Clash.Cores.Sgmii.BitSlip + ( BitSlipState (..) + , bitSlip + , bitSlipO + , bitSlipT + ) +where import Clash.Cores.Sgmii.Common import Clash.Prelude @@ -28,10 +34,6 @@ data BitSlipState | BSOk {_s :: BitVector 20, _n :: Index 10} deriving (Generic, NFDataX, Eq, Show) --- | Reverse the bits of a 'BitVector' -reverseBV :: (KnownNat n) => BitVector n -> BitVector n -reverseBV = v2bv . reverse . bv2v - -- | State transition function for 'bitSlip', where the initial state is the -- training state, and after 8 consecutive commas have been detected at the -- same index in the status register it moves into the 'BSOk' state where the diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index a116176cfc..74c903869c 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -95,6 +95,10 @@ orNothing :: Bool -> a -> Maybe a orNothing True a = Just a orNothing False _ = Nothing +-- | Reverse the bits of a 'BitVector' +reverseBV :: (KnownNat n) => BitVector n -> BitVector n +reverseBV = v2bv . reverse . bv2v + -- | Code group that corresponds to K28.5 with negative disparity cgK28_5N :: Cg cgK28_5N = 0b0101111100 diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 2b58ce1181..a5f460a81f 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -8,7 +8,13 @@ -- Maintainer : QBayLogic B.V. -- -- PCS receive process, as defined in IEEE 802.3 Figure 36-7a and 36-7b -module Clash.Cores.Sgmii.PcsReceive where +module Clash.Cores.Sgmii.PcsReceive + ( PcsReceiveState (..) + , pcsReceive + , pcsReceiveO + , pcsReceiveT + ) +where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.Common diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs index 3dcf68eb62..8c876a978b 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs @@ -7,7 +7,7 @@ -- -- Top level module for the PCS transmit block, that combines the processes -- that are defined in the two submodules @CodeGroup@ and @OrderedSet@. -module Clash.Cores.Sgmii.PcsTransmit where +module Clash.Cores.Sgmii.PcsTransmit (pcsTransmit) where import Clash.Cores.Sgmii.Common import Clash.Cores.Sgmii.PcsTransmit.CodeGroup diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index 36e807ae28..b56a7ad07a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -9,7 +9,12 @@ -- -- Code group process of the PCS transmit block, as defined in IEEE 802.3 -- Figure 36-6 -module Clash.Cores.Sgmii.PcsTransmit.CodeGroup where +module Clash.Cores.Sgmii.PcsTransmit.CodeGroup + ( CodeGroupState (..) + , codeGroupO + , codeGroupT + ) +where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.Common diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index d7351b4213..f419fc47c1 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -8,7 +8,11 @@ -- -- Ordered set process of the PCS transmit block, as defined in IEEE 802.3 -- Figure 36-5 -module Clash.Cores.Sgmii.PcsTransmit.OrderedSet where +module Clash.Cores.Sgmii.PcsTransmit.OrderedSet + ( OrderedSetState (..) + , orderedSetT + ) +where import Clash.Cores.Sgmii.Common import Clash.Prelude diff --git a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs index 1d00c54b1c..8dc6cbc7b6 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs @@ -7,7 +7,11 @@ -- -- Functions for the rate adaptation blocks that are required for lower bit -- rates than 1000 Mbps -module Clash.Cores.Sgmii.RateAdapt where +module Clash.Cores.Sgmii.RateAdapt + ( rateAdaptRx + , rateAdaptTx + ) +where import Clash.Cores.Sgmii.Common import Clash.Prelude diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 863f2714c4..a09c4033e2 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -8,7 +8,16 @@ -- Maintainer : QBayLogic B.V. -- -- Synchronization process, as defined in IEEE 802.3 Figure 36-9 -module Clash.Cores.Sgmii.Sync where +module Clash.Cores.Sgmii.Sync + ( OutputQueue + , SyncState (..) + , outputQueueO + , outputQueueT + , sync + , syncO + , syncT + ) +where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.Common From fc8a77030a8a5e8ced46c045b140a45f68c661bf Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 29 Jul 2024 17:22:46 +0200 Subject: [PATCH 16/30] Remove OverloadedRecordDot --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 15 +++-- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 7 +-- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 23 ++++---- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 35 ++++++------ .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 5 +- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 57 ++++++++++--------- 6 files changed, 69 insertions(+), 73 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index b6c94b7d7d..c8b73c8a84 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} -- | @@ -138,13 +137,13 @@ autoNegT self (syncStatus, rudi) AckDetect Nothing rxConfReg failT rxConfReg | otherwise -> AbilityDetect (Just rudis) rxConfReg failT AckDetect{} - | ackMatch rudis && not (consistencyMatch self._rxConfReg rudis) -> + | ackMatch rudis && not (consistencyMatch (_rxConfReg self) rudis) -> AnEnable Nothing rxConfReg failT | abilityMatch rudis && rxConfReg == 0 -> AnEnable Nothing rxConfReg failT - | ackMatch rudis && consistencyMatch self._rxConfReg rudis -> + | ackMatch rudis && consistencyMatch (_rxConfReg self) rudis -> CompleteAck Nothing rxConfReg failT 0 - | otherwise -> AckDetect (Just rudis) rxConfReg failT self._hist + | otherwise -> AckDetect (Just rudis) rxConfReg failT (_hist self) CompleteAck{} | abilityMatch rudis && rxConfReg == 0 -> AnEnable Nothing rxConfReg failT @@ -165,10 +164,10 @@ autoNegT self (syncStatus, rudi) where rudis = maybe rudis' (rudis' <<+) rudi where - rudis' = fromMaybe (repeat I) self._rudis - rxConfReg = fromMaybe self._rxConfReg (toConfReg =<< rudi) - failT = if syncStatus == Fail then self._failT + 1 else 0 - linkT = self._linkT + 1 + rudis' = fromMaybe (repeat I) (_rudis self) + rxConfReg = fromMaybe (_rxConfReg self) (toConfReg =<< rudi) + failT = if syncStatus == Fail then _failT self + 1 else 0 + linkT = _linkT self + 1 -- | Output function for 'autoNeg' as defined in IEEE 802.3 Clause 37. Returns -- the new value for 'Xmit' and 'ConfReg' for 'Sgmii.pcsTransmit'. diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 0c31d633bd..96c771944d 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -72,11 +71,11 @@ bitSlipO :: -- | New output value (BitSlipState, Cg, Bool) bitSlipO self = - (self, reverseBV $ resize $ rotateR self._s (10 - fromEnum n), bsOk) + (self, reverseBV $ resize $ rotateR (_s self) (10 - fromEnum n), bsOk) where (n, bsOk) = case self of - BSFail{} -> (last self._ns, False) - BSOk{} -> (self._n, True) + BSFail{} -> (last (_ns self), False) + BSOk{} -> (_n self, True) -- | Function that takes a code word and returns the same code word, but if a -- comma is detected the code words is shifted such that the comma is at the diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index a5f460a81f..09b1063076 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -212,16 +211,16 @@ pcsReceiveT LinkFailed{} (_, _, _, _, syncStatus, xmit) | syncStatus == Fail = LinkFailed False xmit | otherwise = WaitForK False pcsReceiveT self (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed self._rx xmit + | syncStatus == Fail = LinkFailed (_rx self) xmit | isJust s1 = fromJust s1 | otherwise = s2 where (s1, s2) = case self of TrrExtend{} -> - (epd2CheckEnd dws rxEven self._rx, ExtendErr self._rx) + (epd2CheckEnd dws rxEven (_rx self), ExtendErr (_rx self)) EarlyEndExt{} -> - (epd2CheckEnd dws rxEven self._rx, ExtendErr self._rx) - _ -> (receive dws rxEven self._rx, RxDataError self._rx (head dws)) + (epd2CheckEnd dws rxEven (_rx self), ExtendErr (_rx self)) + _ -> (receive dws rxEven (_rx self), RxDataError (_rx self) (head dws)) -- | Output function for 'pcsReceive', that sets the outputs as defined in IEEE -- 802.3 Clause 36. @@ -239,9 +238,9 @@ pcsReceiveO self = case self of WaitForK{} -> (self, Just False, Just False, Nothing, Nothing) RxK{} -> (self, Just False, Just False, Nothing, Nothing) RxCB{} -> (self, Just False, Just False, Nothing, Nothing) - RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C self._rxConfReg)) + RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C (_rxConfReg self))) RxInvalid{} -> - (self, Nothing, Nothing, Nothing, orNothing (self._xmit == Conf) Invalid) + (self, Nothing, Nothing, Nothing, orNothing (_xmit self == Conf) Invalid) IdleD{} -> (self, Just False, Just False, Nothing, Just I) FalseCarrier{} -> (self, Nothing, Just True, Just (Cw 0b00001110), Nothing) StartOfPacket{} -> @@ -252,14 +251,14 @@ pcsReceiveO self = case self of PacketBurstRrs{} -> (self, Just False, Nothing, Just (Cw 0b00001111), Nothing) ExtendErr{} -> (self, Just False, Nothing, Just (Cw 0b00011111), Nothing) EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing) - RxData{} -> (self, Nothing, Just False, Just self._hist, Nothing) - RxDataError{} -> (self, Nothing, Just True, Just self._hist, Nothing) + RxData{} -> (self, Nothing, Just False, Just (_hist self), Nothing) + RxDataError{} -> (self, Nothing, Just True, Just (_hist self), Nothing) LinkFailed{} -> ( self - , orNothing self._rx False - , Just self._rx + , orNothing (_rx self) False + , Just (_rx self) , Nothing - , orNothing (self._xmit /= Data) Invalid + , orNothing (_xmit self /= Data) Invalid ) _ -> (self, Nothing, Nothing, Nothing, Nothing) diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index b56a7ad07a..bd1e0b2f81 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -84,24 +83,24 @@ codeGroupT self (txOSet, dw, txConfReg) = nextState DataGo{} -> (Dw dw, generateCg' txEven) IdleDisparityWrong{} -> (cwK28_5, IdleIB rd cg txConfReg' 0) IdleDisparityOk{} -> (cwK28_5, IdleIB rd cg txConfReg' 1) - IdleIB{} -> (if self._i == 0 then dwD05_6 else dwD16_2, generateCg' Odd) - ConfCA{} -> (cwK28_5, ConfCB rd cg txConfReg' self._i) + IdleIB{} -> (if _i self == 0 then dwD05_6 else dwD16_2, generateCg' Odd) + ConfCA{} -> (cwK28_5, ConfCB rd cg txConfReg' (_i self)) ConfCB{} -> - ( if self._i == 0 then dwD21_5 else dwD02_2 - , ConfCC rd cg txConfReg' self._i + ( if _i self == 0 then dwD21_5 else dwD02_2 + , ConfCC rd cg txConfReg' (_i self) ) - ConfCC{} -> (Dw (resize txConfReg'), ConfCD rd cg txConfReg' self._i) + ConfCC{} -> (Dw (resize txConfReg'), ConfCD rd cg txConfReg' (_i self)) ConfCD{} -> - ( Dw (resize $ rotateR self._txConfReg 8) - , if self._i == 0 && txOSet == OSetC + ( Dw (resize $ rotateR (_txConfReg self) 8) + , if _i self == 0 && txOSet == OSetC then ConfCA rd cg txConfReg' 1 else generateCg' Odd ) generateCg' = generateCg txOSet rd cg txConfReg' - txConfReg' = fromMaybe self._txConfReg txConfReg - (rd, cg) = encode8b10b self._rd dw' - txEven = nextEven self._txEven + txConfReg' = fromMaybe (_txConfReg self) txConfReg + (rd, cg) = encode8b10b (_rd self) dw' + txEven = nextEven (_txEven self) {-# CLASH_OPAQUE codeGroupT #-} @@ -114,13 +113,13 @@ codeGroupO :: -- | New output values (CodeGroupState, Cg, Even, Bool) codeGroupO self = case self of - SpecialGo{} -> (self, self._cg, txEven, True) - DataGo{} -> (self, self._cg, txEven, True) - IdleIB{} -> (self, self._cg, Odd, True) - ConfCB{} -> (self, self._cg, Odd, False) - ConfCD{} -> (self, self._cg, Odd, True) - _ -> (self, self._cg, Even, False) + SpecialGo{} -> (self, _cg self, txEven, True) + DataGo{} -> (self, _cg self, txEven, True) + IdleIB{} -> (self, _cg self, Odd, True) + ConfCB{} -> (self, _cg self, Odd, False) + ConfCD{} -> (self, _cg self, Odd, True) + _ -> (self, _cg self, Even, False) where - txEven = nextEven self._txEven + txEven = nextEven (_txEven self) {-# CLASH_OPAQUE codeGroupO #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index f419fc47c1..f17affcf2a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} -- | -- Copyright : (C) 2024, QBayLogic B.V. @@ -62,8 +61,8 @@ void txOSet txEn txEr dw xmitUpdate :: OrderedSetState -> Maybe Xmit -> (Xmit, Bool) xmitUpdate s xmit = (xmit', xmitChange) where - xmit' = fromMaybe s._xmit xmit - xmitChange = (xmit' /= s._xmit) || s._xmitChange + xmit' = fromMaybe (_xmit s) xmit + xmitChange = (xmit' /= _xmit s) || _xmitChange s -- | State transition function for the states as defined in IEEE 802.3 Clause -- 36, specifically Figure 36-5. This function receives the input values and diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index a09c4033e2..7daa8cfd7a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE ViewPatterns #-} -- | @@ -81,13 +80,13 @@ syncT :: Cg -> -- | New state and output tuple SyncState -syncT s cg = case s of +syncT self cg = case self of LossOfSync{} | isNothing comma -> LossOfSync cg rd dw rxEven | otherwise -> CommaDetect cg rd dw 0 CommaDetect{} | not (isDw dw) -> LossOfSync cg rd dw Even - | s._i == 0 -> AcquireSync cg rd dw Even s._i + | _i self == 0 -> AcquireSync cg rd dw Even (_i self) | otherwise -> SyncAcquired cg rd dw Even 0 AcquireSync{} | not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven @@ -95,33 +94,35 @@ syncT s cg = case s of | cg `elem` commas && rxEven == Odd -> CommaDetect cg rd dw 1 | otherwise -> AcquireSync cg rd dw rxEven 0 SyncAcquired{} - | s._i == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven - | s._i == maxBound && cg `elem` commas && rxEven == Even -> + | _i self == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven - | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (s._i + 1) + | _i self == maxBound && cg `elem` commas && rxEven == Even -> + LossOfSync cg rd dw rxEven + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i self + 1) | cg `elem` commas && rxEven == Even -> - SyncAcquired cg rd dw rxEven (s._i + 1) - | s._i == 0 -> SyncAcquired cg rd dw rxEven 0 - | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs s._i + SyncAcquired cg rd dw rxEven (_i self + 1) + | _i self == 0 -> SyncAcquired cg rd dw rxEven 0 + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i self) SyncAcquiredA{} - | s._i == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven - | s._i == maxBound && cg `elem` commas && rxEven == Even -> + | _i self == maxBound && not (isValidSymbol dw) -> + LossOfSync cg rd dw rxEven + | _i self == maxBound && cg `elem` commas && rxEven == Even -> LossOfSync cg rd dw rxEven - | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (s._i + 1) + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i self + 1) | cg `elem` commas && rxEven == Even -> - SyncAcquired cg rd dw rxEven (s._i + 1) - | s._i == 0 && goodCgs == maxBound -> SyncAcquired cg rd dw rxEven 0 - | goodCgs == maxBound -> SyncAcquired cg rd dw rxEven (s._i - 1) - | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs s._i + SyncAcquired cg rd dw rxEven (_i self + 1) + | _i self == 0 && goodCgs == maxBound -> SyncAcquired cg rd dw rxEven 0 + | goodCgs == maxBound -> SyncAcquired cg rd dw rxEven (_i self - 1) + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i self) where comma = elemIndex cg commas - rdNew = case s of - LossOfSync{} -> maybe s._rd bitCoerce comma - _ -> s._rd + rdNew = case self of + LossOfSync{} -> maybe (_rd self) bitCoerce comma + _ -> _rd self (rd, dw) = decode8b10b rdNew cg - rxEven = nextEven s._rxEven - goodCgs = case s of - SyncAcquiredA{} -> s._goodCgs + 1 + rxEven = nextEven (_rxEven self) + goodCgs = case self of + SyncAcquiredA{} -> _goodCgs self + 1 _ -> 0 -- | Output function for 'sync'. Takes the state as defined in 'SyncState' and @@ -132,13 +133,13 @@ syncO :: SyncState -> -- | New state and output tuple (SyncState, Cg, Bool, Symbol8b10b, Even, SyncStatus) -syncO s = case s of - LossOfSync{} -> (s, s._cg, s._rd, s._dw, rxEven, Fail) - CommaDetect{} -> (s, s._cg, s._rd, s._dw, Even, Fail) - AcquireSync{} -> (s, s._cg, s._rd, s._dw, rxEven, Fail) - _ -> (s, s._cg, s._rd, s._dw, rxEven, Ok) +syncO self = case self of + LossOfSync{} -> (self, _cg self, _rd self, _dw self, rxEven, Fail) + CommaDetect{} -> (self, _cg self, _rd self, _dw self, Even, Fail) + AcquireSync{} -> (self, _cg self, _rd self, _dw self, rxEven, Fail) + _ -> (self, _cg self, _rd self, _dw self, rxEven, Ok) where - rxEven = nextEven s._rxEven + rxEven = nextEven (_rxEven self) -- | Transition function for the inputs of 'Sgmii.pcsReceive'. This is used to -- keep a small list of "future" values for 'Symbol8b10b', such that these can From 93a8e9fcb6c2a17ae237ad15218255287e3f0a48 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Tue, 30 Jul 2024 10:05:00 +0200 Subject: [PATCH 17/30] CI fixes for 8.10 and 9.8 --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 4 ++-- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 4 ++-- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 24 +++++++------------ clash-cores/test/Test/Cores/Sgmii/BitSlip.hs | 2 +- .../test/Test/Cores/Sgmii/RateAdapt.hs | 16 +++++++++---- 5 files changed, 25 insertions(+), 25 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index c8b73c8a84..e28998c5bf 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -99,8 +99,8 @@ ackMatch rudis = where rxConfRegs = map (fromMaybe 0 . toConfReg) rudis --- | Check if both 'abilityMatch' and 'ackMatch' are true for the same --- set of 'Rudi' and 'ConfReg' values. +-- | Check if ability match and acknowledge match are set for the same value of +-- 'ConfReg' consistencyMatch :: ConfReg -> Rudis -> Bool consistencyMatch rxConfReg rudis = noAckBit rxConfReg == head rxConfRegs' where diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 09b1063076..3540d85582 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -20,7 +20,7 @@ import Clash.Cores.Sgmii.Common import Clash.Prelude import Data.Maybe (fromJust, isJust) --- | Defines all possible valid 'checkEnd' results +-- | Defines all possible valid termination values data CheckEnd = KDK | KDD | TRK | TRR | RRR | RRK | RRS deriving (Eq, Show) @@ -76,7 +76,7 @@ carrierDetect :: Bool -> -- | 'Even' signal Even -> - -- | The 'carrierDetect' condition + -- | The carrier detection condition Bool carrierDetect cg rd rxEven | rxEven /= Even = False diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index bd1e0b2f81..9e813cf91c 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -- | -- Copyright : (C) 2024, QBayLogic B.V. @@ -44,8 +43,7 @@ data CodeGroupState -- | State transitions from @GENERATE_CODE_GROUP@ from Figure 36-6, which need -- to be set in all parent states of @GENERATE_CODE_GROUP@ as this state -- itself is not implemented as it does not transmit a code group -generateCg :: - OrderedSet -> Bool -> Cg -> ConfReg -> Even -> CodeGroupState +generateCg :: OrderedSet -> Bool -> Cg -> ConfReg -> Even -> CodeGroupState generateCg txOSet rd cg txConfReg txEven | txOSet == OSetD = DataGo rd cg txConfReg txEven | txOSet == OSetI && rd = IdleDisparityWrong rd cg txConfReg @@ -65,21 +63,17 @@ codeGroupT :: (OrderedSet, BitVector 8, Maybe ConfReg) -> -- | The new state CodeGroupState -codeGroupT SpecialGo{..} (txOSet, _, txConfReg) = - generateCg txOSet rd cg txConfReg' txEven - where - dw = case _txOSet of - OSetS -> cwS - OSetT -> cwT - OSetR -> cwR - _ -> cwV - - txConfReg' = fromMaybe _txConfReg txConfReg - (rd, cg) = encode8b10b _rd dw - txEven = nextEven _txEven codeGroupT self (txOSet, dw, txConfReg) = nextState where (dw', nextState) = case self of + SpecialGo{} -> + ( case _txOSet self of + OSetS -> cwS + OSetT -> cwT + OSetR -> cwR + _ -> cwV + , generateCg' txEven + ) DataGo{} -> (Dw dw, generateCg' txEven) IdleDisparityWrong{} -> (cwK28_5, IdleIB rd cg txConfReg' 0) IdleDisparityOk{} -> (cwK28_5, IdleIB rd cg txConfReg' 1) diff --git a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs index f70503329f..026ce58bb7 100644 --- a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs @@ -79,7 +79,7 @@ prop_bitSlipInOutCorrect = H.property $ do (length inp2 + 1) (bitSlipSim @C.System (C.fromList (0 : inp2))) - expected = take (length simOut) $ tail inp2 + expected = take (length simOut) $ drop 1 inp2 map f simOut H.=== expected H.assert $ isJust $ find g simOut diff --git a/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs index 49214e912e..fbb1a80a63 100644 --- a/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs @@ -6,7 +6,8 @@ import Clash.Cores.Sgmii.Common import Clash.Cores.Sgmii.RateAdapt import Clash.Hedgehog.Sized.BitVector import qualified Clash.Prelude as C -import Data.Maybe (catMaybes, fromJust) +import Data.List (uncons) +import Data.Maybe (catMaybes, fromJust, fromMaybe) import qualified Hedgehog as H import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range @@ -33,10 +34,15 @@ rateAdaptTxSim (C.unbundle -> (linkSpeed, txDw)) = C.bundle $ rateAdaptTx linkSpeed txDw -- | Function to take the n'th elements of a list -everyNth :: Int -> [a] -> [a] +everyNth :: (Num a) => Int -> [a] -> [a] everyNth n (drop (n - 1) -> l) | null l = [] - | otherwise = head l : everyNth n (tail l) + | otherwise = head' 0 l : everyNth n (drop 1 l) + +-- | Function to safely take the first element of a list and replace it with a +-- default value if the list is empty +head' :: a -> [a] -> a +head' a l = fst $ fromMaybe (a, []) $ uncons l -- | Function that tests the rate adaptation function with a link speed of 1000 -- Mbps, which means that every input value should be propagated to the output @@ -77,7 +83,7 @@ prop_rateAdaptRx100 = H.property $ do where f a = (Speed100, Just a) - expected = head inp : everyNth 10 (tail inp) + expected = head' 0 inp : everyNth 10 (drop 1 inp) catMaybes simOut H.=== expected @@ -99,7 +105,7 @@ prop_rateAdaptRx10 = H.property $ do where f a = (Speed10, Just a) - expected = head inp : everyNth 100 (tail inp) + expected = head' 0 inp : everyNth 100 (drop 1 inp) catMaybes simOut H.=== expected From 933411b049252a877a9ac84f75963a451bfa8f86 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Thu, 1 Aug 2024 12:01:58 +0200 Subject: [PATCH 18/30] Change layout of status --- clash-cores/src/Clash/Cores/Sgmii.hs | 8 ++-- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 12 +++--- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 22 +++++----- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 40 +++++-------------- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 12 +++--- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 2 +- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 2 +- .../src/Clash/Cores/Sgmii/RateAdapt.hs | 5 +-- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 16 ++++---- clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs | 8 ++-- clash-cores/test/Test/Cores/Sgmii/BitSlip.hs | 2 +- clash-cores/test/Test/Cores/Sgmii/Sync.hs | 2 +- 12 files changed, 55 insertions(+), 76 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index a7c1b480cd..0a722b4dd8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -103,17 +103,17 @@ sgmiiRx rxCg = where rxStatus = SgmiiStatus - <$> bsOk + <$> bsStatus <*> syncStatus - <*> regMaybe 0 rxConfReg - <*> (toStatus <$> regMaybe Invalid rudi) + <*> (toLinkSpeed <$> regMaybe 0 rxConfReg) <*> regMaybe Conf xmit + <*> regMaybe Invalid rudi rxConfReg = toConfReg <$> regMaybe (C 0) rudi (xmit, txConfReg) = autoNeg syncStatus rudi (rxDv, rxEr, rxDw, rudi) = pcsReceive cg rd dw rxEven syncStatus xmit (cg, rd, dw, rxEven, syncStatus) = sync bsCg - (bsCg, bsOk) = bitSlip rxCg syncStatus + (bsCg, bsStatus) = bitSlip rxCg syncStatus -- | Transmit side of the SGMII block, that combines all the functions that are -- in the transmit domain diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index e28998c5bf..c8c5028bb8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -26,7 +26,7 @@ import Data.Proxy type Rudis = Vec 3 Rudi -- | Type that specifies an 'Index' for the timeout of the link timer and the --- timer used to qualify the 'Fail' status of 'SyncStatus' +-- timer used to qualify the 'Fail' status of 'Status' -- TODO: Replace this with @PeriodToCycles dom (Microseconds 1600)@, currently -- this doesn't work because then I need to specify @1 <= DomainPeriod dom) @@ -67,7 +67,7 @@ data AutoNegState dom } | LinkOk {_rudis :: Maybe Rudis, _rxConfReg :: ConfReg, _failT :: Timeout dom} - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | Set the acknowledge bit of a 'ConfReg' to zero noAckBit :: ConfReg -> ConfReg @@ -111,7 +111,7 @@ idleMatch :: Rudis -> Bool idleMatch = (==) (repeat I) -- | State transition function for 'autoNeg' as defined in IEEE 802.3 Clause 37. --- It takes the current 'SyncStatus' from 'Sgmii.sync' as well as the 'Rudi' +-- It takes the current 'Status' from 'Sgmii.sync' as well as the 'Rudi' -- and 'ConfReg' signals from 'Sgmii.pcsReceive'. autoNegT :: forall dom. @@ -119,7 +119,7 @@ autoNegT :: -- | Current state AutoNegState dom -> -- | New input values - (SyncStatus, Maybe Rudi) -> + (Status, Maybe Rudi) -> -- | New state AutoNegState dom autoNegT self (syncStatus, rudi) @@ -216,8 +216,8 @@ autoNegO self = case self of autoNeg :: forall dom. (HiddenClockResetEnable dom) => - -- | Current 'SyncStatus' from 'Sgmii.sync' - Signal dom SyncStatus -> + -- | Current 'Status' from 'Sgmii.sync' + Signal dom Status -> -- | A new value of 'Rudi' from 'Sgmii.pcsReceive' Signal dom (Maybe Rudi) -> -- | Tuple containing the new value for 'Xmit' and a new 'ConfReg' diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 96c771944d..ddb9b07bd5 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -31,7 +31,7 @@ data BitSlipState , _hist :: Vec 10 (BitVector 10) } | BSOk {_s :: BitVector 20, _n :: Index 10} - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | State transition function for 'bitSlip', where the initial state is the -- training state, and after 8 consecutive commas have been detected at the @@ -41,7 +41,7 @@ bitSlipT :: -- | Current state BitSlipState -> -- | New input values - (Cg, SyncStatus) -> + (Cg, Status) -> -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) @@ -69,13 +69,13 @@ bitSlipO :: -- | Current state BitSlipState -> -- | New output value - (BitSlipState, Cg, Bool) + (BitSlipState, Cg, Status) bitSlipO self = - (self, reverseBV $ resize $ rotateR (_s self) (10 - fromEnum n), bsOk) + (self, reverseBV $ resize $ rotateR (_s self) (10 - fromEnum n), bsStatus) where - (n, bsOk) = case self of - BSFail{} -> (last (_ns self), False) - BSOk{} -> (_n self, True) + (n, bsStatus) = case self of + BSFail{} -> (last (_ns self), Fail) + BSOk{} -> (_n self, Ok) -- | Function that takes a code word and returns the same code word, but if a -- comma is detected the code words is shifted such that the comma is at the @@ -86,12 +86,12 @@ bitSlip :: -- | Input code group Signal dom Cg -> -- | Current sync status from 'Sgmii.sync' - Signal dom SyncStatus -> + Signal dom Status -> -- | Output code group - (Signal dom Cg, Signal dom Bool) -bitSlip cg1 syncStatus = (register 0 cg2, register False bsOk) + (Signal dom Cg, Signal dom Status) +bitSlip cg1 syncStatus = (register 0 cg2, register Fail bsStatus) where - (_, cg2, bsOk) = + (_, cg2, bsStatus) = mooreB bitSlipT bitSlipO diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 74c903869c..5d4d76fbdc 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -28,27 +28,16 @@ nextEven Odd = Even -- | Link speed that was communicated by the PHY data LinkSpeed = Speed10 | Speed100 | Speed1000 - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, BitPack) -- | Get the current link speed from a 'ConfReg' toLinkSpeed :: ConfReg -> LinkSpeed -toLinkSpeed confReg - | s == 0b10 = Speed1000 - | s == 0b01 = Speed100 - | otherwise = Speed10 - where - s = pack (testBit confReg 11) ++# pack (testBit confReg 10) +toLinkSpeed confReg = + unpack $ pack (testBit confReg 11) ++# pack (testBit confReg 10) -- | Defines the possible different types of ordered sets that can be generated -- by the 'Sgmii.PcsTransmit.orderedSet' process -data OrderedSet - = OSetC - | OSetI - | OSetR - | OSetS - | OSetT - | OSetV - | OSetD +data OrderedSet = OSetC | OSetI | OSetR | OSetS | OSetT | OSetV | OSetD deriving (Generic, NFDataX, Eq, Show) -- | Defines the possible values for the RUDI output signal of the PCS Receive @@ -61,34 +50,27 @@ toConfReg :: Rudi -> Maybe ConfReg toConfReg (C confReg) = Just confReg toConfReg _ = Nothing --- | Convert a 'Rudi' to just the first bits -toStatus :: Rudi -> BitVector 2 -toStatus rudi = case rudi of - C _ -> 0b00 - I -> 0b01 - Invalid -> 0b10 - -- | Record that holds the current status of the module, specifically the --- 'SyncStatus' from 'Sgmii.sync', the 'ConfReg' that has been received by +-- 'Status' from 'Sgmii.sync', the 'ConfReg' that has been received by -- 'Sgmii.pcsReceive', the 'Rudi' that is transmitted by 'Sgmii.pcsReceive' -- and the 'Xmit' that is transmitted by 'Sgmii.autoNeg'. data SgmiiStatus = SgmiiStatus - { _cBsOk :: Bool - , _cSyncStatus :: SyncStatus - , _cRxConfReg :: ConfReg - , _cRudi :: BitVector 2 + { _cBsStatus :: Status + , _cSyncStatus :: Status + , _cLinkSpeed :: LinkSpeed , _cXmit :: Xmit + , _cRudi :: Rudi } -- | Defines the type of the signal that indicates whether the transmission is -- in sync ('Ok') or not ('Fail') -data SyncStatus = Ok | Fail +data Status = Fail | Ok deriving (Generic, NFDataX, Eq, Show) -- | Signal that is received by the two PCS blocks from the auto-negotiation -- block to indicate the current state of the auto-negotiation block data Xmit = Conf | Data | Idle - deriving (Generic, NFDataX, Eq, Show, BitPack) + deriving (Generic, NFDataX, BitPack, Eq, Show) -- | Return a 'Just' when the argument is 'True', else return a 'Nothing' orNothing :: Bool -> a -> Maybe a diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 3540d85582..4c3cae7676 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -22,7 +22,7 @@ import Data.Maybe (fromJust, isJust) -- | Defines all possible valid termination values data CheckEnd = KDK | KDD | TRK | TRR | RRR | RRK | RRS - deriving (Eq, Show) + deriving (Eq) -- | State type of 'pcsReceive'. This contains all states as they are defined in -- IEEE 802.3 Clause 36, with with exeception of the states @CARRIER_DETECT@, @@ -48,7 +48,7 @@ data PcsReceiveState | RxData {_rx :: Bool, _hist :: Symbol8b10b} | RxDataError {_rx :: Bool, _hist :: Symbol8b10b} | LinkFailed {_rx :: Bool, _xmit :: Xmit} - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | Calculate the number of bits that are different in two code groups. For -- example: the code groups @0b0000@ and @0b0001@ have a difference of 1. @@ -142,7 +142,7 @@ pcsReceiveT :: PcsReceiveState -> -- | Input values, where @Vec 3 CodeGroup@ contains the current and next two -- | data words - (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus, Xmit) -> + (Cg, Bool, Vec 3 Symbol8b10b, Even, Status, Xmit) -> -- | New state PcsReceiveState pcsReceiveT WaitForK{..} (_, _, dws, rxEven, syncStatus, xmit) @@ -263,7 +263,7 @@ pcsReceiveO self = case self of _ -> (self, Nothing, Nothing, Nothing, Nothing) -- | The 'pcsReceive' block. Takes a tuple with the new input code group, --- running disparity and data word, 'Even', 'SyncStatus' and 'Xmit' signals +-- running disparity and data word, 'Even', 'Status' and 'Xmit' signals -- and runs the transition function 'pcsReceiveT'. The outputs are a set of -- 'Maybe' values. pcsReceive :: @@ -276,8 +276,8 @@ pcsReceive :: Signal dom (Vec 3 Symbol8b10b) -> -- | The 'Even' value from 'Sgmii.sync' Signal dom Even -> - -- | The current 'SyncStatus' from 'Sgmii.sync' - Signal dom SyncStatus -> + -- | The current 'Status' from 'Sgmii.sync' + Signal dom Status -> -- | The 'Xmit' signal from 'Sgmii.autoNeg' Signal dom (Maybe Xmit) -> -- | Tuple containing the output values diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index 9e813cf91c..0c1f7e1c1c 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -38,7 +38,7 @@ data CodeGroupState | ConfCB {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} | ConfCC {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} | ConfCD {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | State transitions from @GENERATE_CODE_GROUP@ from Figure 36-6, which need -- to be set in all parent states of @GENERATE_CODE_GROUP@ as this state diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index f17affcf2a..fdd4e91c15 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -34,7 +34,7 @@ data OrderedSetState | CarrierExtend {_xmit :: Xmit, _xmitChange :: Bool} | StartError {_xmit :: Xmit, _xmitChange :: Bool} | TxDataError {_xmit :: Xmit, _xmitChange :: Bool} - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | State transitions from @TX_TEST_XMIT@ from Figure 36-5, which need to be -- set in all parent states of @TX_TEST_XMIT@ as this state itself is not diff --git a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs index 8dc6cbc7b6..17df0c56b6 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs @@ -28,9 +28,7 @@ rateAdaptRxT n (linkSpeed, a) | n == 0 = (n', a) | otherwise = (n', Nothing) where - n' = if ready then 0 else n + 1 - - ready = n == repeatN + n' = if n == repeatN then 0 else n + 1 repeatN = case linkSpeed of Speed1000 -> 0 Speed100 -> 9 @@ -61,7 +59,6 @@ rateAdaptTxT :: rateAdaptTxT n (linkSpeed, a) = (n', (ready, a)) where n' = if ready then 0 else n + 1 - ready = n == repeatN repeatN = case linkSpeed of Speed1000 -> 0 diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 7daa8cfd7a..219041d922 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -24,7 +24,7 @@ import Clash.Prelude import Data.Maybe (isNothing) -- | State type of the output queue for 'sync' -type OutputQueue = Vec 3 (Cg, Bool, Symbol8b10b, Even, SyncStatus) +type OutputQueue = Vec 3 (Cg, Bool, Symbol8b10b, Even, Status) -- | State type of 'sync'. This contains all states as they are defined in IEEE -- 802.3 Clause 36. @@ -53,7 +53,7 @@ data SyncState , _goodCgs :: Index 4 , _i :: Index 3 } - deriving (Generic, NFDataX, Eq, Show) + deriving (Generic, NFDataX, Show) -- | Vector containing the two alternative forms (with opposite running -- disparity) of K28.5. This is the only relevant comma, as the other commas @@ -132,7 +132,7 @@ syncO :: -- | Current state SyncState -> -- | New state and output tuple - (SyncState, Cg, Bool, Symbol8b10b, Even, SyncStatus) + (SyncState, Cg, Bool, Symbol8b10b, Even, Status) syncO self = case self of LossOfSync{} -> (self, _cg self, _rd self, _dw self, rxEven, Fail) CommaDetect{} -> (self, _cg self, _rd self, _dw self, Even, Fail) @@ -148,8 +148,8 @@ outputQueueT :: -- | Current state with three values for all inputs OutputQueue -> -- | New input values for the code group, running disparity, data word, 'Even' - -- signal and 'SyncStatus; - (Cg, Bool, Symbol8b10b, Even, SyncStatus) -> + -- signal and 'Status; + (Cg, Bool, Symbol8b10b, Even, Status) -> -- | New state OutputQueue outputQueueT s i = s <<+ i @@ -161,14 +161,14 @@ outputQueueO :: OutputQueue -> -- | New output with one value for everything except 'Symbol8b10b' for the -- prescient 'Sgmii.checkEnd' function. - (Cg, Bool, Vec 3 Symbol8b10b, Even, SyncStatus) + (Cg, Bool, Vec 3 Symbol8b10b, Even, Status) outputQueueO s = (cg, rd, dw, rxEven, syncStatus) where (head -> cg, head -> rd, dw, head -> rxEven, head -> syncStatus) = unzip5 s -- | Takes a code group and runs it through the state machine as defined in -- IEEE 802.3 Clause 36 to check whether the signal is synchronized. If it is --- not, output 'SyncStatus' @Fail@ and try to re-aquire synchronization, else +-- not, output 'Status' @Fail@ and try to re-aquire synchronization, else -- simply pass through the new running disparity and 'Symbol8b10b' from the -- decoded code group as well as the 'Even' signal. The current code word is -- also propagated as it is required by 'Sgmii.pcsReceive'. This function @@ -185,7 +185,7 @@ sync :: , Signal dom Bool , Signal dom (Vec 3 Symbol8b10b) , Signal dom Even - , Signal dom SyncStatus + , Signal dom Status ) sync rxCg = mooreB diff --git a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs index 3729e88250..6f2469386d 100644 --- a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs @@ -48,7 +48,7 @@ genConfRegsAck range = do -- entered state for debugging purposes. autoNegSim :: (C.HiddenClockResetEnable dom) => - C.Signal dom (SyncStatus, Maybe Rudi) -> + C.Signal dom (Status, Maybe Rudi) -> C.Signal dom (AutoNegState dom) autoNegSim (C.unbundle -> i) = s where @@ -110,9 +110,9 @@ prop_autoNegLinkTimer = H.property $ do g (AnRestart{}) = True g _ = False --- | Assert that if 'SyncStatus' is set to 'Fail', 'autoNeg' will never leave --- the 'AnEnable' state (except at initialization, hence the first 10 outputs --- are dropped from the comparision) +-- | Assert that if 'Status' is set to 'Fail', 'autoNeg' will never leave the +-- 'AnEnable' state (except at initialization, hence the first 10 outputs are +-- dropped from the comparision) prop_autoNegFail :: H.Property prop_autoNegFail = H.property $ do simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) diff --git a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs index 026ce58bb7..6ee19f0d06 100644 --- a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs @@ -21,7 +21,7 @@ bitSlipSim :: forall dom. (C.HiddenClockResetEnable dom) => C.Signal dom (C.BitVector 10) -> - C.Signal dom (BitSlipState, C.BitVector 10, Bool) + C.Signal dom (BitSlipState, C.BitVector 10, Status) bitSlipSim cg = C.bundle $ C.mooreB diff --git a/clash-cores/test/Test/Cores/Sgmii/Sync.hs b/clash-cores/test/Test/Cores/Sgmii/Sync.hs index 8d4fbc74af..9bdb2aa6b8 100644 --- a/clash-cores/test/Test/Cores/Sgmii/Sync.hs +++ b/clash-cores/test/Test/Cores/Sgmii/Sync.hs @@ -20,7 +20,7 @@ import Prelude syncSim :: (C.HiddenClockResetEnable dom) => C.Signal dom Cg -> - C.Signal dom (Cg, Bool, C.Vec 3 Symbol8b10b, Even, SyncStatus) + C.Signal dom (Cg, Bool, C.Vec 3 Symbol8b10b, Even, Status) syncSim cg = C.bundle $ sync cg -- | Run the 'sync' function on a list of values that do not contain any comma From 0448ca2250380d54657e602427e575acb95dfef9 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Thu, 1 Aug 2024 14:05:14 +0200 Subject: [PATCH 19/30] Rename self to s for brevity --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 37 +++-- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 10 +- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 57 ++++---- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 45 +++--- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 134 +++++++++--------- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 56 ++++---- 6 files changed, 162 insertions(+), 177 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index c8c5028bb8..246a11baca 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -122,13 +122,12 @@ autoNegT :: (Status, Maybe Rudi) -> -- | New state AutoNegState dom -autoNegT self (syncStatus, rudi) +autoNegT s (syncStatus, rudi) | failT >= timeout (Proxy @dom) = AnEnable (Just rudis) rxConfReg (timeout (Proxy @dom) - 1) | rudi == Just Invalid = AnEnable (Just rudis) rxConfReg failT - | otherwise = case self of - AnEnable{} - | otherwise -> AnRestart Nothing rxConfReg failT 0 + | otherwise = case s of + AnEnable{} -> AnRestart Nothing rxConfReg failT 0 AnRestart{} | linkT >= timeout (Proxy @dom) -> AbilityDetect Nothing rxConfReg failT | otherwise -> AnRestart (Just rudis) rxConfReg failT linkT @@ -137,13 +136,13 @@ autoNegT self (syncStatus, rudi) AckDetect Nothing rxConfReg failT rxConfReg | otherwise -> AbilityDetect (Just rudis) rxConfReg failT AckDetect{} - | ackMatch rudis && not (consistencyMatch (_rxConfReg self) rudis) -> + | ackMatch rudis && not (consistencyMatch (_rxConfReg s) rudis) -> AnEnable Nothing rxConfReg failT | abilityMatch rudis && rxConfReg == 0 -> AnEnable Nothing rxConfReg failT - | ackMatch rudis && consistencyMatch (_rxConfReg self) rudis -> + | ackMatch rudis && consistencyMatch (_rxConfReg s) rudis -> CompleteAck Nothing rxConfReg failT 0 - | otherwise -> AckDetect (Just rudis) rxConfReg failT (_hist self) + | otherwise -> AckDetect (Just rudis) rxConfReg failT (_hist s) CompleteAck{} | abilityMatch rudis && rxConfReg == 0 -> AnEnable Nothing rxConfReg failT @@ -164,10 +163,10 @@ autoNegT self (syncStatus, rudi) where rudis = maybe rudis' (rudis' <<+) rudi where - rudis' = fromMaybe (repeat I) (_rudis self) - rxConfReg = fromMaybe (_rxConfReg self) (toConfReg =<< rudi) - failT = if syncStatus == Fail then _failT self + 1 else 0 - linkT = _linkT self + 1 + rudis' = fromMaybe (repeat I) (_rudis s) + rxConfReg = fromMaybe (_rxConfReg s) (toConfReg =<< rudi) + failT = if syncStatus == Fail then _failT s + 1 else 0 + linkT = _linkT s + 1 -- | Output function for 'autoNeg' as defined in IEEE 802.3 Clause 37. Returns -- the new value for 'Xmit' and 'ConfReg' for 'Sgmii.pcsTransmit'. @@ -191,16 +190,16 @@ autoNegO :: AutoNegState dom -> -- | New outputs (AutoNegState dom, Maybe Xmit, Maybe ConfReg) -autoNegO self = case self of - AnEnable{} -> (self, Just Conf, Just 0) - AnRestart{} -> (self, Nothing, Just 0) +autoNegO s = case s of + AnEnable{} -> (s, Just Conf, Just 0) + AnRestart{} -> (s, Nothing, Just 0) -- According to IEEE 802.3 this should have the acknowledge bit deasserted, -- but for SGMII the acknowledge bit is always asserted - AbilityDetect{} -> (self, Nothing, Just txConfReg) - AckDetect{} -> (self, Nothing, Just txConfReg) - CompleteAck{} -> (self, Nothing, Nothing) - IdleDetect{} -> (self, Just Idle, Nothing) - LinkOk{} -> (self, Just Data, Nothing) + AbilityDetect{} -> (s, Nothing, Just txConfReg) + AckDetect{} -> (s, Nothing, Just txConfReg) + CompleteAck{} -> (s, Nothing, Nothing) + IdleDetect{} -> (s, Just Idle, Nothing) + LinkOk{} -> (s, Just Data, Nothing) where txConfReg = 0b0100000000000001 diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index ddb9b07bd5..044d64c5f8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -52,7 +52,6 @@ bitSlipT BSFail{..} (cg, _) s = resize $ _s ++# reverseBV cg ns = maybe _ns (_ns <<+) n hist = map pack $ take d10 $ windows1d d10 $ bv2v s - n = elemIndex True $ map f _hist where f a = a == reverseBV cgK28_5N || a == reverseBV cgK28_5P @@ -70,12 +69,11 @@ bitSlipO :: BitSlipState -> -- | New output value (BitSlipState, Cg, Status) -bitSlipO self = - (self, reverseBV $ resize $ rotateR (_s self) (10 - fromEnum n), bsStatus) +bitSlipO s = (s, reverseBV $ resize $ rotateR (_s s) (10 - n), bsStatus) where - (n, bsStatus) = case self of - BSFail{} -> (last (_ns self), Fail) - BSOk{} -> (_n self, Ok) + (n, bsStatus) = case s of + BSFail{} -> (fromEnum $ last (_ns s), Fail) + BSOk{} -> (fromEnum $ _n s, Ok) -- | Function that takes a code word and returns the same code word, but if a -- comma is detected the code words is shifted such that the comma is at the diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 4c3cae7676..d7625b47bd 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -210,17 +210,17 @@ pcsReceiveT ExtendErr{..} (_, _, dws, rxEven, syncStatus, xmit) pcsReceiveT LinkFailed{} (_, _, _, _, syncStatus, xmit) | syncStatus == Fail = LinkFailed False xmit | otherwise = WaitForK False -pcsReceiveT self (_, _, dws, rxEven, syncStatus, xmit) - | syncStatus == Fail = LinkFailed (_rx self) xmit +pcsReceiveT s (_, _, dws, rxEven, syncStatus, xmit) + | syncStatus == Fail = LinkFailed (_rx s) xmit | isJust s1 = fromJust s1 | otherwise = s2 where - (s1, s2) = case self of + (s1, s2) = case s of TrrExtend{} -> - (epd2CheckEnd dws rxEven (_rx self), ExtendErr (_rx self)) + (epd2CheckEnd dws rxEven (_rx s), ExtendErr (_rx s)) EarlyEndExt{} -> - (epd2CheckEnd dws rxEven (_rx self), ExtendErr (_rx self)) - _ -> (receive dws rxEven (_rx self), RxDataError (_rx self) (head dws)) + (epd2CheckEnd dws rxEven (_rx s), ExtendErr (_rx s)) + _ -> (receive dws rxEven (_rx s), RxDataError (_rx s) (head dws)) -- | Output function for 'pcsReceive', that sets the outputs as defined in IEEE -- 802.3 Clause 36. @@ -234,33 +234,32 @@ pcsReceiveO :: , Maybe Symbol8b10b , Maybe Rudi ) -pcsReceiveO self = case self of - WaitForK{} -> (self, Just False, Just False, Nothing, Nothing) - RxK{} -> (self, Just False, Just False, Nothing, Nothing) - RxCB{} -> (self, Just False, Just False, Nothing, Nothing) - RxCD{} -> (self, Nothing, Nothing, Nothing, Just (C (_rxConfReg self))) +pcsReceiveO s = case s of + WaitForK{} -> (s, Just False, Just False, Nothing, Nothing) + RxK{} -> (s, Just False, Just False, Nothing, Nothing) + RxCB{} -> (s, Just False, Just False, Nothing, Nothing) + RxCD{} -> (s, Nothing, Nothing, Nothing, Just (C (_rxConfReg s))) RxInvalid{} -> - (self, Nothing, Nothing, Nothing, orNothing (_xmit self == Conf) Invalid) - IdleD{} -> (self, Just False, Just False, Nothing, Just I) - FalseCarrier{} -> (self, Nothing, Just True, Just (Cw 0b00001110), Nothing) - StartOfPacket{} -> - (self, Just True, Just False, Just (Cw 0b01010101), Nothing) - EarlyEnd{} -> (self, Nothing, Just True, Nothing, Nothing) - TriRri{} -> (self, Just False, Just False, Nothing, Nothing) - TrrExtend{} -> (self, Just False, Just True, Just (Cw 0b00001111), Nothing) - PacketBurstRrs{} -> (self, Just False, Nothing, Just (Cw 0b00001111), Nothing) - ExtendErr{} -> (self, Just False, Nothing, Just (Cw 0b00011111), Nothing) - EarlyEndExt{} -> (self, Nothing, Just True, Nothing, Nothing) - RxData{} -> (self, Nothing, Just False, Just (_hist self), Nothing) - RxDataError{} -> (self, Nothing, Just True, Just (_hist self), Nothing) + (s, Nothing, Nothing, Nothing, orNothing (_xmit s == Conf) Invalid) + IdleD{} -> (s, Just False, Just False, Nothing, Just I) + FalseCarrier{} -> (s, Nothing, Just True, Just (Cw 0b00001110), Nothing) + StartOfPacket{} -> (s, Just True, Just False, Just (Cw 0b01010101), Nothing) + EarlyEnd{} -> (s, Nothing, Just True, Nothing, Nothing) + TriRri{} -> (s, Just False, Just False, Nothing, Nothing) + TrrExtend{} -> (s, Just False, Just True, Just (Cw 0b00001111), Nothing) + PacketBurstRrs{} -> (s, Just False, Nothing, Just (Cw 0b00001111), Nothing) + ExtendErr{} -> (s, Just False, Nothing, Just (Cw 0b00011111), Nothing) + EarlyEndExt{} -> (s, Nothing, Just True, Nothing, Nothing) + RxData{} -> (s, Nothing, Just False, Just (_hist s), Nothing) + RxDataError{} -> (s, Nothing, Just True, Just (_hist s), Nothing) LinkFailed{} -> - ( self - , orNothing (_rx self) False - , Just (_rx self) + ( s + , orNothing (_rx s) False + , Just (_rx s) , Nothing - , orNothing (_xmit self /= Data) Invalid + , orNothing (_xmit s /= Data) Invalid ) - _ -> (self, Nothing, Nothing, Nothing, Nothing) + _ -> (s, Nothing, Nothing, Nothing, Nothing) -- | The 'pcsReceive' block. Takes a tuple with the new input code group, -- running disparity and data word, 'Even', 'Status' and 'Xmit' signals diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index 0c1f7e1c1c..3c02d5ae75 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -63,38 +63,35 @@ codeGroupT :: (OrderedSet, BitVector 8, Maybe ConfReg) -> -- | The new state CodeGroupState -codeGroupT self (txOSet, dw, txConfReg) = nextState +codeGroupT s (txOSet, dw, txConfReg) = nextState where - (dw', nextState) = case self of + (dw', nextState) = case s of SpecialGo{} -> - ( case _txOSet self of + ( case _txOSet s of OSetS -> cwS OSetT -> cwT OSetR -> cwR _ -> cwV - , generateCg' txEven + , generateCg' (nextEven (_txEven s)) ) - DataGo{} -> (Dw dw, generateCg' txEven) + DataGo{} -> (Dw dw, generateCg' (nextEven (_txEven s))) IdleDisparityWrong{} -> (cwK28_5, IdleIB rd cg txConfReg' 0) IdleDisparityOk{} -> (cwK28_5, IdleIB rd cg txConfReg' 1) - IdleIB{} -> (if _i self == 0 then dwD05_6 else dwD16_2, generateCg' Odd) - ConfCA{} -> (cwK28_5, ConfCB rd cg txConfReg' (_i self)) + IdleIB{} -> (if _i s == 0 then dwD05_6 else dwD16_2, generateCg' Odd) + ConfCA{} -> (cwK28_5, ConfCB rd cg txConfReg' (_i s)) ConfCB{} -> - ( if _i self == 0 then dwD21_5 else dwD02_2 - , ConfCC rd cg txConfReg' (_i self) - ) - ConfCC{} -> (Dw (resize txConfReg'), ConfCD rd cg txConfReg' (_i self)) + (if _i s == 0 then dwD21_5 else dwD02_2, ConfCC rd cg txConfReg' (_i s)) + ConfCC{} -> (Dw (resize txConfReg'), ConfCD rd cg txConfReg' (_i s)) ConfCD{} -> - ( Dw (resize $ rotateR (_txConfReg self) 8) - , if _i self == 0 && txOSet == OSetC + ( Dw (resize $ rotateR (_txConfReg s) 8) + , if _i s == 0 && txOSet == OSetC then ConfCA rd cg txConfReg' 1 else generateCg' Odd ) generateCg' = generateCg txOSet rd cg txConfReg' - txConfReg' = fromMaybe (_txConfReg self) txConfReg - (rd, cg) = encode8b10b (_rd self) dw' - txEven = nextEven (_txEven self) + txConfReg' = fromMaybe (_txConfReg s) txConfReg + (rd, cg) = encode8b10b (_rd s) dw' {-# CLASH_OPAQUE codeGroupT #-} @@ -106,14 +103,12 @@ codeGroupO :: CodeGroupState -> -- | New output values (CodeGroupState, Cg, Even, Bool) -codeGroupO self = case self of - SpecialGo{} -> (self, _cg self, txEven, True) - DataGo{} -> (self, _cg self, txEven, True) - IdleIB{} -> (self, _cg self, Odd, True) - ConfCB{} -> (self, _cg self, Odd, False) - ConfCD{} -> (self, _cg self, Odd, True) - _ -> (self, _cg self, Even, False) - where - txEven = nextEven (_txEven self) +codeGroupO s = case s of + SpecialGo{} -> (s, _cg s, nextEven (_txEven s), True) + DataGo{} -> (s, _cg s, nextEven (_txEven s), True) + IdleIB{} -> (s, _cg s, Odd, True) + ConfCB{} -> (s, _cg s, Odd, False) + ConfCD{} -> (s, _cg s, Odd, True) + _ -> (s, _cg s, Even, False) {-# CLASH_OPAQUE codeGroupO #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index fdd4e91c15..bcc8f7ac2d 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -78,155 +78,151 @@ orderedSetT :: (Bool, Bool, BitVector 8, Maybe Xmit, Even, Bool) -> -- | The new state and the new output values (OrderedSetState, (OrderedSetState, OrderedSet)) -orderedSetT self@Configuration{} (txEn, txEr, _, xmit, txEven, tx) = +orderedSetT s@Configuration{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where - nextState = fromMaybe (Configuration xmit' xmitChange) s + nextState = fromMaybe (Configuration xmit' xmitChange) s' - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetC) -orderedSetT self@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetC) +orderedSetT s@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | xmit' == Data && not txEn && not txEr && tx = XmitData xmit' xmitChange | otherwise = IdleS xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetI) -orderedSetT self@XmitData{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetI) +orderedSetT s@XmitData{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | txEn && not txEr && tx = StartOfPacket xmit' xmitChange | txEn && txEr && tx = StartError xmit' xmitChange | otherwise = XmitData xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetI) -orderedSetT self@StartOfPacket{} (txEn, txEr, _, xmit, txEven, tx) = + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetI) +orderedSetT s@StartOfPacket{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange | otherwise = StartOfPacket xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetS) -orderedSetT self@TxData{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetS) +orderedSetT s@TxData{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange | otherwise = TxData xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange txOSet = void OSetD txEn txEr dw - out = (self, txOSet) -orderedSetT self@EndOfPacketNoExt{} (txEn, txEr, _, xmit, txEven, tx) = + out = (s, txOSet) +orderedSetT s@EndOfPacketNoExt{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | tx = Epd2NoExt xmit' xmitChange | otherwise = EndOfPacketNoExt xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetT) -orderedSetT self@Epd2NoExt{} (txEn, txEr, _, xmit, txEven, tx) = - (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetT) +orderedSetT s@Epd2NoExt{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | txEven == Odd && tx = XmitData xmit' xmitChange | txEven == Even && tx = Epd3 xmit' xmitChange | otherwise = Epd2NoExt xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetR) -orderedSetT self@Epd3{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetR) +orderedSetT s@Epd3{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | tx = XmitData xmit' xmitChange | otherwise = Epd3 xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetR) -orderedSetT self@EndOfPacketExt{} (txEn, txEr, dw, xmit, txEven, tx) = + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetR) +orderedSetT s@EndOfPacketExt{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | not txEr && tx = ExtendBy1 xmit' xmitChange | txEr && tx = CarrierExtend xmit' xmitChange | otherwise = EndOfPacketExt xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange txOSet = void OSetT txEn txEr dw - out = (self, txOSet) -orderedSetT self@ExtendBy1{} (txEn, txEr, _, xmit, txEven, tx) = - (nextState, out) + out = (s, txOSet) +orderedSetT s@ExtendBy1{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | tx = Epd2NoExt xmit' xmitChange | otherwise = ExtendBy1 xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetR) -orderedSetT self@CarrierExtend{} (txEn, txEr, dw, xmit, txEven, tx) = + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetR) +orderedSetT s@CarrierExtend{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | not txEn && not txEr && tx = ExtendBy1 xmit' xmitChange | txEn && txEr && tx = StartError xmit' xmitChange | txEn && not txEr && tx = StartOfPacket xmit' xmitChange | otherwise = CarrierExtend xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange txOSet = void OSetR txEn txEr dw - out = (self, txOSet) -orderedSetT self@StartError{} (txEn, txEr, _, xmit, txEven, tx) = - (nextState, out) + out = (s, txOSet) +orderedSetT s@StartError{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | tx = TxDataError xmit' xmitChange | otherwise = StartError xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetS) -orderedSetT self@TxDataError{} (txEn, txEr, _, xmit, txEven, tx) = - (nextState, out) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetS) +orderedSetT s@TxDataError{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s = fromJust s + | isJust s' = fromJust s' | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange | otherwise = TxDataError xmit' xmitChange - (xmit', xmitChange) = xmitUpdate self xmit - s = txTestXmit txEn txEr xmit' txEven tx xmitChange - out = (self, OSetV) + (xmit', xmitChange) = xmitUpdate s xmit + s' = txTestXmit txEn txEr xmit' txEven tx xmitChange + out = (s, OSetV) {-# CLASH_OPAQUE orderedSetT #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 219041d922..17ac3700e8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -80,13 +80,13 @@ syncT :: Cg -> -- | New state and output tuple SyncState -syncT self cg = case self of +syncT s cg = case s of LossOfSync{} | isNothing comma -> LossOfSync cg rd dw rxEven | otherwise -> CommaDetect cg rd dw 0 CommaDetect{} | not (isDw dw) -> LossOfSync cg rd dw Even - | _i self == 0 -> AcquireSync cg rd dw Even (_i self) + | _i s == 0 -> AcquireSync cg rd dw Even (_i s) | otherwise -> SyncAcquired cg rd dw Even 0 AcquireSync{} | not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven @@ -94,35 +94,33 @@ syncT self cg = case self of | cg `elem` commas && rxEven == Odd -> CommaDetect cg rd dw 1 | otherwise -> AcquireSync cg rd dw rxEven 0 SyncAcquired{} - | _i self == maxBound && not (isValidSymbol dw) -> + | _i s == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven + | _i s == maxBound && cg `elem` commas && rxEven == Even -> LossOfSync cg rd dw rxEven - | _i self == maxBound && cg `elem` commas && rxEven == Even -> - LossOfSync cg rd dw rxEven - | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i self + 1) + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i s + 1) | cg `elem` commas && rxEven == Even -> - SyncAcquired cg rd dw rxEven (_i self + 1) - | _i self == 0 -> SyncAcquired cg rd dw rxEven 0 - | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i self) + SyncAcquired cg rd dw rxEven (_i s + 1) + | _i s == 0 -> SyncAcquired cg rd dw rxEven 0 + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i s) SyncAcquiredA{} - | _i self == maxBound && not (isValidSymbol dw) -> - LossOfSync cg rd dw rxEven - | _i self == maxBound && cg `elem` commas && rxEven == Even -> + | _i s == maxBound && not (isValidSymbol dw) -> LossOfSync cg rd dw rxEven + | _i s == maxBound && cg `elem` commas && rxEven == Even -> LossOfSync cg rd dw rxEven - | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i self + 1) + | not (isValidSymbol dw) -> SyncAcquired cg rd dw rxEven (_i s + 1) | cg `elem` commas && rxEven == Even -> - SyncAcquired cg rd dw rxEven (_i self + 1) - | _i self == 0 && goodCgs == maxBound -> SyncAcquired cg rd dw rxEven 0 - | goodCgs == maxBound -> SyncAcquired cg rd dw rxEven (_i self - 1) - | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i self) + SyncAcquired cg rd dw rxEven (_i s + 1) + | _i s == 0 && goodCgs == maxBound -> SyncAcquired cg rd dw rxEven 0 + | goodCgs == maxBound -> SyncAcquired cg rd dw rxEven (_i s - 1) + | otherwise -> SyncAcquiredA cg rd dw rxEven goodCgs (_i s) where comma = elemIndex cg commas - rdNew = case self of - LossOfSync{} -> maybe (_rd self) bitCoerce comma - _ -> _rd self + rdNew = case s of + LossOfSync{} -> maybe (_rd s) bitCoerce comma + _ -> _rd s (rd, dw) = decode8b10b rdNew cg - rxEven = nextEven (_rxEven self) - goodCgs = case self of - SyncAcquiredA{} -> _goodCgs self + 1 + rxEven = nextEven (_rxEven s) + goodCgs = case s of + SyncAcquiredA{} -> _goodCgs s + 1 _ -> 0 -- | Output function for 'sync'. Takes the state as defined in 'SyncState' and @@ -133,13 +131,13 @@ syncO :: SyncState -> -- | New state and output tuple (SyncState, Cg, Bool, Symbol8b10b, Even, Status) -syncO self = case self of - LossOfSync{} -> (self, _cg self, _rd self, _dw self, rxEven, Fail) - CommaDetect{} -> (self, _cg self, _rd self, _dw self, Even, Fail) - AcquireSync{} -> (self, _cg self, _rd self, _dw self, rxEven, Fail) - _ -> (self, _cg self, _rd self, _dw self, rxEven, Ok) +syncO s = case s of + LossOfSync{} -> (s, _cg s, _rd s, _dw s, rxEven, Fail) + CommaDetect{} -> (s, _cg s, _rd s, _dw s, Even, Fail) + AcquireSync{} -> (s, _cg s, _rd s, _dw s, rxEven, Fail) + _ -> (s, _cg s, _rd s, _dw s, rxEven, Ok) where - rxEven = nextEven (_rxEven self) + rxEven = nextEven (_rxEven s) -- | Transition function for the inputs of 'Sgmii.pcsReceive'. This is used to -- keep a small list of "future" values for 'Symbol8b10b', such that these can From 7af088831d1930ab6cfe8eae7f687e5f60941e56 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Thu, 1 Aug 2024 14:05:34 +0200 Subject: [PATCH 20/30] Refactor rate adaptation tests --- .../test/Test/Cores/Sgmii/RateAdapt.hs | 130 ++++-------------- 1 file changed, 30 insertions(+), 100 deletions(-) diff --git a/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs index fbb1a80a63..b89d252dc9 100644 --- a/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/test/Test/Cores/Sgmii/RateAdapt.hs @@ -33,6 +33,13 @@ rateAdaptTxSim :: rateAdaptTxSim (C.unbundle -> (linkSpeed, txDw)) = C.bundle $ rateAdaptTx linkSpeed txDw +-- | Convert a speed to a symbol duplication factor +duplicationFactor :: LinkSpeed -> Int +duplicationFactor linkSpeed = case linkSpeed of + Speed10 -> 100 + Speed100 -> 10 + Speed1000 -> 1 + -- | Function to take the n'th elements of a list everyNth :: (Num a) => Int -> [a] -> [a] everyNth n (drop (n - 1) -> l) @@ -44,32 +51,9 @@ everyNth n (drop (n - 1) -> l) head' :: a -> [a] -> a head' a l = fst $ fromMaybe (a, []) $ uncons l --- | Function that tests the rate adaptation function with a link speed of 1000 --- Mbps, which means that every input value should be propagated to the output -prop_rateAdaptRx1000 :: H.Property -prop_rateAdaptRx1000 = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) - - inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) - let simOut = - drop 1 $ - C.sampleN - (simDuration + 1) - ( rateAdaptRxSim @C.System - (C.fromList ((Speed1000, Nothing) : map f inp)) - ) - where - f a = (Speed1000, Just a) - - expected = inp - - catMaybes simOut H.=== expected - --- | Function that tests the rate adaptation function with a link speed of 100 --- Mbps, which means that every 10th input value (starting at 0) should be --- propagated to the output -prop_rateAdaptRx100 :: H.Property -prop_rateAdaptRx100 = H.property $ do +-- | Test whether the receive rate adaptation works as intended +rateAdaptRxTest :: LinkSpeed -> H.Property +rateAdaptRxTest linkSpeed = H.property $ do simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) @@ -78,69 +62,32 @@ prop_rateAdaptRx100 = H.property $ do C.sampleN (simDuration + 1) ( rateAdaptRxSim @C.System - (C.fromList ((Speed100, Nothing) : map f inp)) + (C.fromList ((linkSpeed, Nothing) : map f inp)) ) where - f a = (Speed100, Just a) + f a = (linkSpeed, Just a) - expected = head' 0 inp : everyNth 10 (drop 1 inp) + expected = + head' 0 inp : everyNth (duplicationFactor linkSpeed) (drop 1 inp) catMaybes simOut H.=== expected --- | Function that tests the rate adaptation function with a link speed of 10 --- Mbps, which means that every 100th input value (starting at 0) should be --- propagated to the output prop_rateAdaptRx10 :: H.Property -prop_rateAdaptRx10 = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 1 1000)) - - inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) - let simOut = - drop 1 $ - C.sampleN - (simDuration + 1) - ( rateAdaptRxSim @C.System - (C.fromList ((Speed10, Nothing) : map f inp)) - ) - where - f a = (Speed10, Just a) - - expected = head' 0 inp : everyNth 100 (drop 1 inp) - - catMaybes simOut H.=== expected - --- | Function that tests the rate adaptation function with a link speed of 1000 --- Mbps, which means that every input value should be propagated to the output -prop_rateAdaptTx1000 :: H.Property -prop_rateAdaptTx1000 = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) - - inp <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) - let simOut = - map g $ - drop 1 $ - C.sampleN - (simDuration + 1) - ( rateAdaptTxSim @C.System - (C.fromList ((Speed1000, Nothing) : map f inp)) - ) - where - f a = (Speed1000, Just a) - g (_, a) = fromJust a +prop_rateAdaptRx10 = rateAdaptRxTest Speed10 - expected = inp +prop_rateAdaptRx100 :: H.Property +prop_rateAdaptRx100 = rateAdaptRxTest Speed100 - simOut H.=== expected +prop_rateAdaptRx1000 :: H.Property +prop_rateAdaptRx1000 = rateAdaptRxTest Speed1000 --- | Function that tests the rate adaptation function with a link speed of 100 --- Mbps, which means that every 10th input value (starting at 0) should be --- propagated to the output -prop_rateAdaptTx100 :: H.Property -prop_rateAdaptTx100 = H.property $ do +-- | Test whether the transmit rate adaptation works as intended +rateAdaptTxTest :: LinkSpeed -> H.Property +rateAdaptTxTest linkSpeed = H.property $ do simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) - let inp2 = concatMap (replicate 10) inp1 + let inp2 = concatMap (replicate (duplicationFactor linkSpeed)) inp1 simOut = map g $ @@ -148,41 +95,24 @@ prop_rateAdaptTx100 = H.property $ do C.sampleN (length inp2 + 1) ( rateAdaptTxSim @C.System - (C.fromList ((Speed100, Nothing) : map f inp2)) + (C.fromList ((linkSpeed, Nothing) : map f inp2)) ) where - f a = (Speed100, Just a) + f a = (linkSpeed, Just a) g (_, a) = fromJust a expected = take (length simOut) inp2 simOut H.=== expected --- | Function that tests the rate adaptation function with a link speed of 10 --- Mbps, which means that every 100th input value (starting at 0) should be --- propagated to the output prop_rateAdaptTx10 :: H.Property -prop_rateAdaptTx10 = H.property $ do - simDuration <- H.forAll (Gen.integral (Range.linear 1 100)) +prop_rateAdaptTx10 = rateAdaptTxTest Speed10 - inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector) - let inp2 = concatMap (replicate 100) inp1 - - simOut = - map g $ - drop 1 $ - C.sampleN - (length inp2 + 1) - ( rateAdaptTxSim @C.System - (C.fromList ((Speed10, Nothing) : map f inp2)) - ) - where - f a = (Speed10, Just a) - g (_, a) = fromJust a - - expected = take (length simOut) inp2 +prop_rateAdaptTx100 :: H.Property +prop_rateAdaptTx100 = rateAdaptTxTest Speed100 - simOut H.=== expected +prop_rateAdaptTx1000 :: H.Property +prop_rateAdaptTx1000 = rateAdaptTxTest Speed1000 tests :: TestTree tests = $(testGroupGenerator) From e071b53a2ee90e3661b74fa1323a892fa59827a6 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 14 Aug 2024 10:27:10 +0200 Subject: [PATCH 21/30] Expand Cg to CodeGroup --- clash-cores/src/Clash/Cores/Sgmii.hs | 24 ++++++++-------- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 8 +++--- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 6 ++-- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 6 ++-- .../src/Clash/Cores/Sgmii/PcsTransmit.hs | 2 +- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 24 ++++++++-------- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 28 ++++++++++--------- clash-cores/test/Test/Cores/Sgmii/Sync.hs | 4 +-- 8 files changed, 53 insertions(+), 49 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index 0a722b4dd8..d7f4133482 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -79,7 +79,7 @@ import Data.Maybe (fromMaybe, isJust) sgmiiRx :: (HiddenClockResetEnable dom) => -- | Input code group - Signal dom Cg -> + Signal dom CodeGroup -> -- | Output tuple ( Signal dom SgmiiStatus , Signal dom Bool @@ -88,7 +88,7 @@ sgmiiRx :: , Signal dom (Maybe Xmit) , Signal dom (Maybe ConfReg) , Signal dom (Maybe ConfReg) - , Signal dom Cg + , Signal dom CodeGroup ) sgmiiRx rxCg = ( rxStatus @@ -132,7 +132,7 @@ sgmiiTx :: -- | Configuration register from PHY Signal dom (Maybe ConfReg) -> -- | Output code group - Signal dom Cg + Signal dom CodeGroup sgmiiTx txEn txEr txDw xmit txConfReg _ = pcsTransmit txEn txEr txDw xmit txConfReg @@ -183,7 +183,7 @@ sgmii :: -- | Data octet @TXD@ to be transmitted to the PHY Signal txDom (BitVector 8) -> -- | Input code group from the PHY - Signal rxDom Cg -> + Signal rxDom CodeGroup -> -- | Tuple that contains the output signals from the SGMII block which are the -- current status of the receive block 'SgmiiStatus', the @RX_DV@ signal -- that indicates an incoming data packet, @RX_ER@ which indicates a receive @@ -193,8 +193,8 @@ sgmii :: , Signal rxDom Bool , Signal rxDom Bool , Signal rxDom (BitVector 8) - , Signal rxDom Cg - , Signal txDom Cg + , Signal rxDom CodeGroup + , Signal txDom CodeGroup ) sgmii rxTxCdc rxClk txClk rxRst txRst txEn txEr txDw rxCg = (rxStatus, rxDv, rxEr, rxDw, bsCg, txCg) @@ -218,7 +218,7 @@ sgmii rxTxCdc rxClk txClk rxRst txRst txEn txEr txDw rxCg = sgmiiRxRA :: (HiddenClockResetEnable dom) => -- | Input code group - Signal dom Cg -> + Signal dom CodeGroup -> -- | Output tuple ( Signal dom SgmiiStatus , Signal dom Bool @@ -226,7 +226,7 @@ sgmiiRxRA :: , Signal dom (Maybe Xmit) , Signal dom (Maybe ConfReg) , Signal dom (Maybe ConfReg) - , Signal dom Cg + , Signal dom CodeGroup ) sgmiiRxRA rxCg = (rxStatus, rxEr, out, xmit, txConfReg, rxConfReg, bsCg) where @@ -249,7 +249,7 @@ sgmiiTxRA :: -- | Configuration register from PHY Signal dom (Maybe ConfReg) -> -- | Ready signal and output code group - (Signal dom Bool, Signal dom Cg) + (Signal dom Bool, Signal dom CodeGroup) sgmiiTxRA txEr txDw xmit txConfReg rxConfReg = (txReady, txCg) where linkSpeed = toLinkSpeed <$> regMaybe 0 rxConfReg @@ -287,7 +287,7 @@ sgmiiRA :: -- | Data octet @TXD@ to be transmitted to the PHY Signal txDom (Maybe (BitVector 8)) -> -- | Input code group from the PHY - Signal rxDom Cg -> + Signal rxDom CodeGroup -> -- | Tuple that contains the output signals from the SGMII block which are the -- current status of the receive block 'SgmiiStatus', @RX_ER@ which -- indicates a receive error, @RXD@ which is the incoming data octet from @@ -297,8 +297,8 @@ sgmiiRA :: ( Signal rxDom SgmiiStatus , Signal rxDom Bool , Signal rxDom (Maybe (BitVector 8)) - , Signal rxDom Cg - , Signal txDom Cg + , Signal rxDom CodeGroup + , Signal txDom CodeGroup , Signal txDom Bool ) sgmiiRA rxTxCdc rxClk txClk rxRst txRst txEr txDw rxCg = diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 044d64c5f8..fae17ae684 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -41,7 +41,7 @@ bitSlipT :: -- | Current state BitSlipState -> -- | New input values - (Cg, Status) -> + (BitVector 10, Status) -> -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) @@ -68,7 +68,7 @@ bitSlipO :: -- | Current state BitSlipState -> -- | New output value - (BitSlipState, Cg, Status) + (BitSlipState, BitVector 10, Status) bitSlipO s = (s, reverseBV $ resize $ rotateR (_s s) (10 - n), bsStatus) where (n, bsStatus) = case s of @@ -82,11 +82,11 @@ bitSlip :: forall dom. (HiddenClockResetEnable dom) => -- | Input code group - Signal dom Cg -> + Signal dom (BitVector 10) -> -- | Current sync status from 'Sgmii.sync' Signal dom Status -> -- | Output code group - (Signal dom Cg, Signal dom Status) + (Signal dom (BitVector 10), Signal dom Status) bitSlip cg1 syncStatus = (register 0 cg2, register Fail bsStatus) where (_, cg2, bsStatus) = diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 5d4d76fbdc..6ca5a072e0 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -11,7 +11,7 @@ import Clash.Cores.LineCoding8b10b import Clash.Prelude -- | Format of a single code group, 10-bit -type Cg = BitVector 10 +type CodeGroup = BitVector 10 -- | Format of @rxConfReg@ and @txConfReg@, size of two data words type ConfReg = BitVector 16 @@ -82,11 +82,11 @@ reverseBV :: (KnownNat n) => BitVector n -> BitVector n reverseBV = v2bv . reverse . bv2v -- | Code group that corresponds to K28.5 with negative disparity -cgK28_5N :: Cg +cgK28_5N :: CodeGroup cgK28_5N = 0b0101111100 -- | Code group that corresponds to K28.5 with positive disparity -cgK28_5P :: Cg +cgK28_5P :: CodeGroup cgK28_5P = 0b1010000011 -- | Data word corresponding to the decoded version of code group D00.0, used diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index d7625b47bd..1f603f7e88 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -71,7 +71,7 @@ bitDiff cg0 cg1 = foldl f 0 $ map bitCoerce $ bv2v $ xor cg0 cg1 -- encoding of the K28.5 control word carrierDetect :: -- | Code group - Cg -> + CodeGroup -> -- | Running disparity Bool -> -- | 'Even' signal @@ -142,7 +142,7 @@ pcsReceiveT :: PcsReceiveState -> -- | Input values, where @Vec 3 CodeGroup@ contains the current and next two -- | data words - (Cg, Bool, Vec 3 Symbol8b10b, Even, Status, Xmit) -> + (CodeGroup, Bool, Vec 3 Symbol8b10b, Even, Status, Xmit) -> -- | New state PcsReceiveState pcsReceiveT WaitForK{..} (_, _, dws, rxEven, syncStatus, xmit) @@ -268,7 +268,7 @@ pcsReceiveO s = case s of pcsReceive :: (HiddenClockResetEnable dom) => -- | Current code group from 'Sgmii.sync' - Signal dom Cg -> + Signal dom CodeGroup -> -- | Current running disparity from 'Sgmii.sync' Signal dom Bool -> -- | Input 'Symbol8b10b' from 'Sgmii.sync' diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs index 8c876a978b..aff7c0547d 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs @@ -30,7 +30,7 @@ pcsTransmit :: -- | The 'ConfReg' from 'Sgmii.autoNeg' Signal dom (Maybe ConfReg) -> -- | The 8b/10b encoded output value - Signal dom Cg + Signal dom CodeGroup pcsTransmit txEn txEr dw xmit txConfReg = cg where (_, cg, txEven, cgSent) = diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index 3c02d5ae75..f593047503 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -25,25 +25,27 @@ import Data.Maybe (fromMaybe) data CodeGroupState = SpecialGo { _rd :: Bool - , _cg :: Cg + , _cg :: CodeGroup , _txConfReg :: ConfReg , _txEven :: Even , _txOSet :: OrderedSet } - | DataGo {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _txEven :: Even} - | IdleDisparityWrong {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | IdleDisparityOk {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg} - | IdleIB {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} - | ConfCA {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} - | ConfCB {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} - | ConfCC {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} - | ConfCD {_rd :: Bool, _cg :: Cg, _txConfReg :: ConfReg, _i :: Index 2} + | DataGo + {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _txEven :: Even} + | IdleDisparityWrong {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg} + | IdleDisparityOk {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg} + | IdleIB {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCA {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCB {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCC {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _i :: Index 2} + | ConfCD {_rd :: Bool, _cg :: CodeGroup, _txConfReg :: ConfReg, _i :: Index 2} deriving (Generic, NFDataX, Show) -- | State transitions from @GENERATE_CODE_GROUP@ from Figure 36-6, which need -- to be set in all parent states of @GENERATE_CODE_GROUP@ as this state -- itself is not implemented as it does not transmit a code group -generateCg :: OrderedSet -> Bool -> Cg -> ConfReg -> Even -> CodeGroupState +generateCg :: + OrderedSet -> Bool -> CodeGroup -> ConfReg -> Even -> CodeGroupState generateCg txOSet rd cg txConfReg txEven | txOSet == OSetD = DataGo rd cg txConfReg txEven | txOSet == OSetI && rd = IdleDisparityWrong rd cg txConfReg @@ -102,7 +104,7 @@ codeGroupO :: -- | Current state CodeGroupState -> -- | New output values - (CodeGroupState, Cg, Even, Bool) + (CodeGroupState, CodeGroup, Even, Bool) codeGroupO s = case s of SpecialGo{} -> (s, _cg s, nextEven (_txEven s), True) DataGo{} -> (s, _cg s, nextEven (_txEven s), True) diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 17ac3700e8..98bc0288f1 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -24,29 +24,31 @@ import Clash.Prelude import Data.Maybe (isNothing) -- | State type of the output queue for 'sync' -type OutputQueue = Vec 3 (Cg, Bool, Symbol8b10b, Even, Status) +type OutputQueue = Vec 3 (CodeGroup, Bool, Symbol8b10b, Even, Status) -- | State type of 'sync'. This contains all states as they are defined in IEEE -- 802.3 Clause 36. data SyncState - = LossOfSync {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} - | CommaDetect {_cg :: Cg, _rd :: Bool, _dw :: Symbol8b10b, _i :: Index 3} + = LossOfSync + {_cg :: CodeGroup, _rd :: Bool, _dw :: Symbol8b10b, _rxEven :: Even} + | CommaDetect + {_cg :: CodeGroup, _rd :: Bool, _dw :: Symbol8b10b, _i :: Index 3} | AcquireSync - { _cg :: Cg + { _cg :: CodeGroup , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even , _i :: Index 3 } | SyncAcquired - { _cg :: Cg + { _cg :: CodeGroup , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even , _i :: Index 3 } | SyncAcquiredA - { _cg :: Cg + { _cg :: CodeGroup , _rd :: Bool , _dw :: Symbol8b10b , _rxEven :: Even @@ -62,7 +64,7 @@ data SyncState -- disparity when it is decoded and the second comma returns the positive -- running disparity when it is decoded. This is used in 'LossOfSync' to -- recover the correct running disparity from a received comma. -commas :: Vec 2 Cg +commas :: Vec 2 CodeGroup commas = cgK28_5N :> cgK28_5P :> Nil -- | State transition function for 'sync'. Takes the state as defined in @@ -77,7 +79,7 @@ syncT :: -- | Current state SyncState -> -- | New input codegroup - Cg -> + CodeGroup -> -- | New state and output tuple SyncState syncT s cg = case s of @@ -130,7 +132,7 @@ syncO :: -- | Current state SyncState -> -- | New state and output tuple - (SyncState, Cg, Bool, Symbol8b10b, Even, Status) + (SyncState, CodeGroup, Bool, Symbol8b10b, Even, Status) syncO s = case s of LossOfSync{} -> (s, _cg s, _rd s, _dw s, rxEven, Fail) CommaDetect{} -> (s, _cg s, _rd s, _dw s, Even, Fail) @@ -147,7 +149,7 @@ outputQueueT :: OutputQueue -> -- | New input values for the code group, running disparity, data word, 'Even' -- signal and 'Status; - (Cg, Bool, Symbol8b10b, Even, Status) -> + (CodeGroup, Bool, Symbol8b10b, Even, Status) -> -- | New state OutputQueue outputQueueT s i = s <<+ i @@ -159,7 +161,7 @@ outputQueueO :: OutputQueue -> -- | New output with one value for everything except 'Symbol8b10b' for the -- prescient 'Sgmii.checkEnd' function. - (Cg, Bool, Vec 3 Symbol8b10b, Even, Status) + (CodeGroup, Bool, Vec 3 Symbol8b10b, Even, Status) outputQueueO s = (cg, rd, dw, rxEven, syncStatus) where (head -> cg, head -> rd, dw, head -> rxEven, head -> syncStatus) = unzip5 s @@ -175,11 +177,11 @@ outputQueueO s = (cg, rd, dw, rxEven, syncStatus) sync :: (HiddenClockResetEnable dom) => -- | New code group from the PHY - Signal dom Cg -> + Signal dom CodeGroup -> -- | A tuple containing the input code group, running disparity, a new -- 'Symbol8b10b', the new value for 'Even' and the current synchronization -- status - ( Signal dom Cg + ( Signal dom CodeGroup , Signal dom Bool , Signal dom (Vec 3 Symbol8b10b) , Signal dom Even diff --git a/clash-cores/test/Test/Cores/Sgmii/Sync.hs b/clash-cores/test/Test/Cores/Sgmii/Sync.hs index 9bdb2aa6b8..329b8d7a7f 100644 --- a/clash-cores/test/Test/Cores/Sgmii/Sync.hs +++ b/clash-cores/test/Test/Cores/Sgmii/Sync.hs @@ -19,8 +19,8 @@ import Prelude -- | Simulation function for 'sync' that provides a bundled output syncSim :: (C.HiddenClockResetEnable dom) => - C.Signal dom Cg -> - C.Signal dom (Cg, Bool, C.Vec 3 Symbol8b10b, Even, Status) + C.Signal dom CodeGroup -> + C.Signal dom (CodeGroup, Bool, C.Vec 3 Symbol8b10b, Even, Status) syncSim cg = C.bundle $ sync cg -- | Run the 'sync' function on a list of values that do not contain any comma From c3322d3f6b1fffdd0ef022a972be6e1e4d81c99a Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Wed, 14 Aug 2024 10:32:06 +0200 Subject: [PATCH 22/30] Prefix C, I and Invalid with Rudi --- clash-cores/src/Clash/Cores/Sgmii.hs | 4 ++-- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 9 +++++---- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 4 ++-- clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs | 8 ++++---- clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs | 10 +++++----- 5 files changed, 18 insertions(+), 17 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index d7f4133482..5aec5b914e 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -107,9 +107,9 @@ sgmiiRx rxCg = <*> syncStatus <*> (toLinkSpeed <$> regMaybe 0 rxConfReg) <*> regMaybe Conf xmit - <*> regMaybe Invalid rudi + <*> regMaybe RudiInvalid rudi - rxConfReg = toConfReg <$> regMaybe (C 0) rudi + rxConfReg = toConfReg <$> regMaybe (RudiC 0) rudi (xmit, txConfReg) = autoNeg syncStatus rudi (rxDv, rxEr, rxDw, rudi) = pcsReceive cg rd dw rxEven syncStatus xmit (cg, rd, dw, rxEven, syncStatus) = sync bsCg diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index 246a11baca..7a9c27c0b3 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -87,7 +87,8 @@ timeout Proxy = if clashSimulation then 3 else maxBound -- If there has been 'Rudi' value of 'I' in the same set of values, then -- return 'False'. abilityMatch :: Rudis -> Bool -abilityMatch rudis = repeat (head rxConfRegs) == rxConfRegs && I `notElem` rudis +abilityMatch rudis = + repeat (head rxConfRegs) == rxConfRegs && RudiI `notElem` rudis where rxConfRegs = map (noAckBit . fromMaybe 0 . toConfReg) rudis @@ -108,7 +109,7 @@ consistencyMatch rxConfReg rudis = noAckBit rxConfReg == head rxConfRegs' -- | Function that checks that the last three values of 'Rudi' have been 'I' idleMatch :: Rudis -> Bool -idleMatch = (==) (repeat I) +idleMatch = (==) (repeat RudiI) -- | State transition function for 'autoNeg' as defined in IEEE 802.3 Clause 37. -- It takes the current 'Status' from 'Sgmii.sync' as well as the 'Rudi' @@ -125,7 +126,7 @@ autoNegT :: autoNegT s (syncStatus, rudi) | failT >= timeout (Proxy @dom) = AnEnable (Just rudis) rxConfReg (timeout (Proxy @dom) - 1) - | rudi == Just Invalid = AnEnable (Just rudis) rxConfReg failT + | rudi == Just RudiInvalid = AnEnable (Just rudis) rxConfReg failT | otherwise = case s of AnEnable{} -> AnRestart Nothing rxConfReg failT 0 AnRestart{} @@ -163,7 +164,7 @@ autoNegT s (syncStatus, rudi) where rudis = maybe rudis' (rudis' <<+) rudi where - rudis' = fromMaybe (repeat I) (_rudis s) + rudis' = fromMaybe (repeat RudiI) (_rudis s) rxConfReg = fromMaybe (_rxConfReg s) (toConfReg =<< rudi) failT = if syncStatus == Fail then _failT s + 1 else 0 linkT = _linkT s + 1 diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 6ca5a072e0..9a2668cb64 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -42,12 +42,12 @@ data OrderedSet = OSetC | OSetI | OSetR | OSetS | OSetT | OSetV | OSetD -- | Defines the possible values for the RUDI output signal of the PCS Receive -- block as defined in IEEE 802.3 Clause 36 -data Rudi = C ConfReg | I | Invalid +data Rudi = RudiC ConfReg | RudiI | RudiInvalid deriving (Generic, NFDataX, Eq, Show) -- | Convert a 'Rudi' to a 'ConfReg' toConfReg :: Rudi -> Maybe ConfReg -toConfReg (C confReg) = Just confReg +toConfReg (RudiC confReg) = Just confReg toConfReg _ = Nothing -- | Record that holds the current status of the module, specifically the diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 1f603f7e88..aac79b1315 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -238,10 +238,10 @@ pcsReceiveO s = case s of WaitForK{} -> (s, Just False, Just False, Nothing, Nothing) RxK{} -> (s, Just False, Just False, Nothing, Nothing) RxCB{} -> (s, Just False, Just False, Nothing, Nothing) - RxCD{} -> (s, Nothing, Nothing, Nothing, Just (C (_rxConfReg s))) + RxCD{} -> (s, Nothing, Nothing, Nothing, Just (RudiC (_rxConfReg s))) RxInvalid{} -> - (s, Nothing, Nothing, Nothing, orNothing (_xmit s == Conf) Invalid) - IdleD{} -> (s, Just False, Just False, Nothing, Just I) + (s, Nothing, Nothing, Nothing, orNothing (_xmit s == Conf) RudiInvalid) + IdleD{} -> (s, Just False, Just False, Nothing, Just RudiI) FalseCarrier{} -> (s, Nothing, Just True, Just (Cw 0b00001110), Nothing) StartOfPacket{} -> (s, Just True, Just False, Just (Cw 0b01010101), Nothing) EarlyEnd{} -> (s, Nothing, Just True, Nothing, Nothing) @@ -257,7 +257,7 @@ pcsReceiveO s = case s of , orNothing (_rx s) False , Just (_rx s) , Nothing - , orNothing (_xmit s /= Data) Invalid + , orNothing (_xmit s /= Data) RudiInvalid ) _ -> (s, Nothing, Nothing, Nothing, Nothing) diff --git a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs index 6f2469386d..712ec4f482 100644 --- a/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/test/Test/Cores/Sgmii/AutoNeg.hs @@ -65,7 +65,7 @@ prop_autoNegNoAckComplete = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f a = (Ok, Just (C a)) + f a = (Ok, Just (RudiC a)) H.assert $ isNothing (find g simOut) H.assert $ isJust (find h simOut) @@ -86,7 +86,7 @@ prop_autoNegAckComplete = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f a = (Ok, Just (C a)) + f a = (Ok, Just (RudiC a)) H.assert $ isJust (find g simOut) where @@ -103,7 +103,7 @@ prop_autoNegLinkTimer = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f a = (Ok, Just (C a)) + f a = (Ok, Just (RudiC a)) (length . filter g) simOut H.=== 3 where @@ -121,7 +121,7 @@ prop_autoNegFail = H.property $ do let simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f a = (Fail, Just (C a)) + f a = (Fail, Just (RudiC a)) (length . filter g) (drop 10 simOut) H.=== simDuration - 10 where @@ -141,7 +141,7 @@ prop_autoNegNoThreeInARow = H.property $ do simOut = C.sampleN simDuration (autoNegSim @C.System (C.fromList (map f inp))) where - f a = (Ok, Just (C a)) + f a = (Ok, Just (RudiC a)) H.assert $ isNothing (find g simOut) where From 70cdaf8f99ba7e59b8b5420a4fe84906f27430c0 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Fri, 16 Aug 2024 17:08:56 +0200 Subject: [PATCH 23/30] Haddock changes and fixes --- clash-cores/src/Clash/Cores/Sgmii.hs | 28 ++++++++++++-------- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 2 +- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index 5aec5b914e..20abbc3799 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -184,11 +184,14 @@ sgmii :: Signal txDom (BitVector 8) -> -- | Input code group from the PHY Signal rxDom CodeGroup -> - -- | Tuple that contains the output signals from the SGMII block which are the - -- current status of the receive block 'SgmiiStatus', the @RX_DV@ signal - -- that indicates an incoming data packet, @RX_ER@ which indicates a receive - -- error, @RXD@ which is the incoming data octet from the PHY, and a 10-bit - -- code word that can be serialized and transmitted to the PHY. + -- | Tuple that contains the output signals from the SGMII block which are: + -- + -- - The current status of the receive block, + -- - The @RX_DV@ signal that indicates an incoming data packet, + -- - The @RX_ER@ signal that indicates a receive error, + -- - The @RXD@ signal which is the incoming data octet from the PHY, + -- - The word-aligned version of the received code group from the PHY, + -- - A 10-bit code group that can be serialized and transmitted to the PHY. ( Signal rxDom SgmiiStatus , Signal rxDom Bool , Signal rxDom Bool @@ -288,12 +291,15 @@ sgmiiRA :: Signal txDom (Maybe (BitVector 8)) -> -- | Input code group from the PHY Signal rxDom CodeGroup -> - -- | Tuple that contains the output signals from the SGMII block which are the - -- current status of the receive block 'SgmiiStatus', @RX_ER@ which - -- indicates a receive error, @RXD@ which is the incoming data octet from - -- the PHY, and a 10-bit code word that can be serialized and transmitted to - -- the PHY. For debugging purposes, also a word-aligned version of the input - -- word is outputted. + -- | Tuple that contains the output signals from the SGMII block which are: + -- + -- - The current status of the receive block, + -- - The @RX_ER@ signal that indicates a receive error, + -- - The incoming data octet from the PHY or 'Nothing' when no data word is + -- received, + -- - The word-aligned version of the received code group from the PHY, + -- - A 10-bit code group that can be serialized and transmitted to the PHY, + -- - A boolean that indicates if a new data word can be provided. ( Signal rxDom SgmiiStatus , Signal rxDom Bool , Signal rxDom (Maybe (BitVector 8)) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index 7a9c27c0b3..f318443197 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -84,7 +84,7 @@ timeout Proxy = if clashSimulation then 3 else maxBound -- | Check if the the last three received values of @rxConfReg@ are the same -- (with the exception for bit 14, the acknowledge bit, which is discarded). --- If there has been 'Rudi' value of 'I' in the same set of values, then +-- If there has been 'Rudi' value of 'RudiI' in the same set of values, then -- return 'False'. abilityMatch :: Rudis -> Bool abilityMatch rudis = From 8c424fa8cd240b27fe534f8612e7e15bcf5c69a6 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 19 Aug 2024 13:57:30 +0200 Subject: [PATCH 24/30] Multi-line module haddock --- clash-cores/src/Clash/Cores/Sgmii.hs | 111 +++++++++--------- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 13 +- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 15 +-- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 15 +-- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 13 +- .../src/Clash/Cores/Sgmii/PcsTransmit.hs | 15 +-- .../Cores/Sgmii/PcsTransmit/CodeGroup.hs | 15 +-- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 15 +-- .../src/Clash/Cores/Sgmii/RateAdapt.hs | 15 +-- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 13 +- 10 files changed, 125 insertions(+), 115 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index 20abbc3799..fb1a129d3b 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -1,60 +1,61 @@ {-# LANGUAGE CPP #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Top-level SGMII module that combines all the blocks that are defined in the --- sub-modules to one function that can be used in different projects. --- --- Example usage: --- --- @ --- topEntity :: --- Clock Dom0 -> --- Clock Dom1 -> --- Reset Dom0 -> --- Reset Dom1 -> --- Signal Dom1 Bool -> --- Signal Dom1 Bool -> --- Signal Dom1 (BitVector 8) -> --- Signal Dom0 (BitVector 10) -> --- ( Signal rxDom SgmiiStatus --- , Signal rxDom Bool --- , Signal rxDom Bool --- , Signal rxDom (BitVector 8) --- , Signal txDom (BitVector 10) --- ) --- topEntity = sgmii rxTxCdc --- @ --- Here, the type of @rxTxCdc@, which is the function that handles the --- clock domain crossing between the transmit and receive domain between the --- auto-negotiation block and transmission block, needs to be the following: --- --- @ --- rxTxCdc :: --- forall dom0 dom1. --- (KnownDomain dom0, KnownDomain dom1) => --- Clock rxDom -> --- Clock txDom -> --- Signal rxDom (Maybe Xmit) -> --- Signal rxDom (Maybe ConfReg) -> --- Signal rxDom (Maybe ConfReg) -> --- ( Signal txDom (Maybe Xmit) --- , Signal txDom (Maybe ConfReg) --- , Signal txDom (Maybe ConfReg) --- ) --- @ --- --- For Xilinx boards, this could be implemented by using, for example, the --- function 'Clash.Cores.Xilinx.Xpm.Cdc.Handshake.xpmCdcHandshake', but --- vendor-neutral implementations could make use of other word-synchronizers. --- --- As the decoding of incoming 10-bit code groups is done on a best-effort --- basis and they are always transmitted to @TXD@, this port should only be --- read when @RX_DV@ is asserted as invalid data might be provided when it is --- not. +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Top-level SGMII module that combines all the blocks that are defined in the + sub-modules to one function that can be used in different projects. + + Example usage: + +@ +topEntity :: + Clock Dom0 -> + Clock Dom1 -> + Reset Dom0 -> + Reset Dom1 -> + Signal Dom1 Bool -> + Signal Dom1 Bool -> + Signal Dom1 (BitVector 8) -> + Signal Dom0 (BitVector 10) -> + ( Signal rxDom SgmiiStatus + , Signal rxDom Bool + , Signal rxDom Bool + , Signal rxDom (BitVector 8) + , Signal txDom (BitVector 10) + ) +topEntity = sgmii rxTxCdc +@ + Here, the type of @rxTxCdc@, which is the function that handles the + clock domain crossing between the transmit and receive domain between the + auto-negotiation block and transmission block, needs to be the following: + +@ +rxTxCdc :: + forall dom0 dom1. + (KnownDomain dom0, KnownDomain dom1) => + Clock rxDom -> + Clock txDom -> + Signal rxDom (Maybe Xmit) -> + Signal rxDom (Maybe ConfReg) -> + Signal rxDom (Maybe ConfReg) -> + ( Signal txDom (Maybe Xmit) + , Signal txDom (Maybe ConfReg) + , Signal txDom (Maybe ConfReg) + ) +@ + + For Xilinx boards, this could be implemented by using, for example, the + function 'Clash.Cores.Xilinx.Xpm.Cdc.Handshake.xpmCdcHandshake', but + vendor-neutral implementations could make use of other word-synchronizers. + + As the decoding of incoming 10-bit code groups is done on a best-effort + basis and they are always transmitted to @TXD@, this port should only be + read when @RX_DV@ is asserted as invalid data might be provided when it is + not. +-} module Clash.Cores.Sgmii ( sgmii , sgmiiRA diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index f318443197..733aa08a12 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Auto-negotiation process, as defined in IEEE 802.3 Figure 37-6 +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Auto-negotiation process, as defined in IEEE 802.3 Figure 37-6 +-} module Clash.Cores.Sgmii.AutoNeg ( AutoNegState (..) , Rudis diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index fae17ae684..836367e020 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -1,13 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Bit slip function that word-aligns a stream of bits based on received --- comma values +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Bit slip function that word-aligns a stream of bits based on received + comma values +-} module Clash.Cores.Sgmii.BitSlip ( BitSlipState (..) , bitSlip diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 9a2668cb64..00786f6f16 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -1,10 +1,11 @@ --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Common functions, type definitions and hard-coded settings used in the --- different modules that are defined for SGMII +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Common functions, type definitions and hard-coded settings used in the + different modules that are defined for SGMII +-} module Clash.Cores.Sgmii.Common where import Clash.Cores.LineCoding8b10b diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index aac79b1315..bebd30328a 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- PCS receive process, as defined in IEEE 802.3 Figure 36-7a and 36-7b +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + PCS receive process, as defined in IEEE 802.3 Figure 36-7a and 36-7b +-} module Clash.Cores.Sgmii.PcsReceive ( PcsReceiveState (..) , pcsReceive diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs index aff7c0547d..257307554f 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Top level module for the PCS transmit block, that combines the processes --- that are defined in the two submodules @CodeGroup@ and @OrderedSet@. +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Top level module for the PCS transmit block, that combines the processes + that are defined in the two submodules @CodeGroup@ and @OrderedSet@. +-} module Clash.Cores.Sgmii.PcsTransmit (pcsTransmit) where import Clash.Cores.Sgmii.Common diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs index f593047503..b9327de995 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Code group process of the PCS transmit block, as defined in IEEE 802.3 --- Figure 36-6 +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Code group process of the PCS transmit block, as defined in IEEE 802.3 + Figure 36-6 +-} module Clash.Cores.Sgmii.PcsTransmit.CodeGroup ( CodeGroupState (..) , codeGroupO diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index bcc8f7ac2d..97e98a0369 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Ordered set process of the PCS transmit block, as defined in IEEE 802.3 --- Figure 36-5 +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Ordered set process of the PCS transmit block, as defined in IEEE 802.3 + Figure 36-5 +-} module Clash.Cores.Sgmii.PcsTransmit.OrderedSet ( OrderedSetState (..) , orderedSetT diff --git a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs index 17df0c56b6..ab92c3d208 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Functions for the rate adaptation blocks that are required for lower bit --- rates than 1000 Mbps +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Functions for the rate adaptation blocks that are required for lower bit + rates than 1000 Mbps +-} module Clash.Cores.Sgmii.RateAdapt ( rateAdaptRx , rateAdaptTx diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 98bc0288f1..d4f57671e4 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} --- | --- Copyright : (C) 2024, QBayLogic B.V. --- License : BSD2 (see the file LICENSE) --- Maintainer : QBayLogic B.V. --- --- Synchronization process, as defined in IEEE 802.3 Figure 36-9 +{- | + Copyright : (C) 2024, QBayLogic B.V. + License : BSD2 (see the file LICENSE) + Maintainer : QBayLogic B.V. + + Synchronization process, as defined in IEEE 802.3 Figure 36-9 +-} module Clash.Cores.Sgmii.Sync ( OutputQueue , SyncState (..) From b03b99e276a89c8c379e824dd396e7a5dfa5620f Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 19 Aug 2024 14:13:12 +0200 Subject: [PATCH 25/30] Handle Invalid in abilityMatch --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index 733aa08a12..bdb8469cd8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -88,10 +88,11 @@ timeout Proxy = if clashSimulation then 3 else maxBound -- If there has been 'Rudi' value of 'RudiI' in the same set of values, then -- return 'False'. abilityMatch :: Rudis -> Bool -abilityMatch rudis = - repeat (head rxConfRegs) == rxConfRegs && RudiI `notElem` rudis +abilityMatch rudis = all (match (head rudis)) rudis where - rxConfRegs = map (noAckBit . fromMaybe 0 . toConfReg) rudis + match x y = + fromMaybe False (liftA2 (==) (toConfRegNoAck x) (toConfRegNoAck y)) + toConfRegNoAck = fmap noAckBit . toConfReg -- | Check if the last three values for 'ConfReg' are all the same, and also -- check whether bit 14 (the acknowledge bit) has been asserted From 75895bd5dc973681c9ec069f650e8dbfaf546a85 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 19 Aug 2024 15:47:11 +0200 Subject: [PATCH 26/30] Remove fromJust pattern --- clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs | 2 +- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 5 ++-- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 5 ++-- .../Cores/Sgmii/PcsTransmit/OrderedSet.hs | 26 +++++++++---------- 4 files changed, 18 insertions(+), 20 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs index bdb8469cd8..ae073007fd 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/AutoNeg.hs @@ -109,7 +109,7 @@ consistencyMatch rxConfReg rudis = noAckBit rxConfReg == head rxConfRegs' where rxConfRegs' = map (noAckBit . fromMaybe 0 . toConfReg) rudis --- | Function that checks that the last three values of 'Rudi' have been 'I' +-- | Function that checks that the last three values of 'Rudi' have been 'RudiI' idleMatch :: Rudis -> Bool idleMatch = (==) (repeat RudiI) diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 836367e020..90e1213020 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -19,7 +19,7 @@ where import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust, isNothing) +import Data.Maybe (fromJust) -- | State variable for 'bitSlip', with the two states as described in -- 'bitSlipT'. Due to timing constraints, not all functions can be executed in @@ -46,8 +46,7 @@ bitSlipT :: -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) - | isNothing n = BSFail s ns hist - | _ns == repeat (fromJust n) = BSOk s (fromJust n) + | Just i <- n, _ns == repeat (fromJust n) = BSOk s i | otherwise = BSFail s ns hist where s = resize $ _s ++# reverseBV cg diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index bebd30328a..8a78b83bb7 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -19,7 +19,6 @@ where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust, isJust) -- | Defines all possible valid termination values data CheckEnd = KDK | KDD | TRK | TRR | RRR | RRK | RRS @@ -204,7 +203,7 @@ pcsReceiveT ExtendErr{..} (_, _, dws, rxEven, syncStatus, xmit) | syncStatus == Fail = LinkFailed _rx xmit | head dws == cwS = StartOfPacket _rx | head dws == cwK28_5 && rxEven == Even = RxK _rx - | isJust s && rxEven == Even = fromJust s + | Just x <- s, rxEven == Even = x | otherwise = ExtendErr _rx where s = epd2CheckEnd dws rxEven _rx @@ -213,7 +212,7 @@ pcsReceiveT LinkFailed{} (_, _, _, _, syncStatus, xmit) | otherwise = WaitForK False pcsReceiveT s (_, _, dws, rxEven, syncStatus, xmit) | syncStatus == Fail = LinkFailed (_rx s) xmit - | isJust s1 = fromJust s1 + | Just x <- s1 = x | otherwise = s2 where (s1, s2) = case s of diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs index 97e98a0369..0b5769f31f 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/OrderedSet.hs @@ -16,7 +16,7 @@ where import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust, fromMaybe, isJust) +import Data.Maybe (fromMaybe) -- | State type of 'orderedSetT' as defined in IEEE 802.3 Clause 36, with the -- exeception of @TX_TEST_XMIT@, @TX_PACKET@ and @ALIGN_ERR_START@ as these @@ -90,7 +90,7 @@ orderedSetT s@Configuration{} (txEn, txEr, _, xmit, txEven, tx) = orderedSetT s@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | xmit' == Data && not txEn && not txEr && tx = XmitData xmit' xmitChange | otherwise = IdleS xmit' xmitChange @@ -100,7 +100,7 @@ orderedSetT s@IdleS{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) orderedSetT s@XmitData{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | txEn && not txEr && tx = StartOfPacket xmit' xmitChange | txEn && txEr && tx = StartError xmit' xmitChange | otherwise = XmitData xmit' xmitChange @@ -112,7 +112,7 @@ orderedSetT s@StartOfPacket{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange @@ -124,7 +124,7 @@ orderedSetT s@StartOfPacket{} (txEn, txEr, _, xmit, txEven, tx) = orderedSetT s@TxData{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange @@ -138,7 +138,7 @@ orderedSetT s@EndOfPacketNoExt{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | tx = Epd2NoExt xmit' xmitChange | otherwise = EndOfPacketNoExt xmit' xmitChange @@ -148,7 +148,7 @@ orderedSetT s@EndOfPacketNoExt{} (txEn, txEr, _, xmit, txEven, tx) = orderedSetT s@Epd2NoExt{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | txEven == Odd && tx = XmitData xmit' xmitChange | txEven == Even && tx = Epd3 xmit' xmitChange | otherwise = Epd2NoExt xmit' xmitChange @@ -159,7 +159,7 @@ orderedSetT s@Epd2NoExt{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) orderedSetT s@Epd3{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | tx = XmitData xmit' xmitChange | otherwise = Epd3 xmit' xmitChange @@ -170,7 +170,7 @@ orderedSetT s@EndOfPacketExt{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | not txEr && tx = ExtendBy1 xmit' xmitChange | txEr && tx = CarrierExtend xmit' xmitChange | otherwise = EndOfPacketExt xmit' xmitChange @@ -182,7 +182,7 @@ orderedSetT s@EndOfPacketExt{} (txEn, txEr, dw, xmit, txEven, tx) = orderedSetT s@ExtendBy1{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | tx = Epd2NoExt xmit' xmitChange | otherwise = ExtendBy1 xmit' xmitChange @@ -193,7 +193,7 @@ orderedSetT s@CarrierExtend{} (txEn, txEr, dw, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | not txEn && not txEr && tx = ExtendBy1 xmit' xmitChange | txEn && txEr && tx = StartError xmit' xmitChange | txEn && not txEr && tx = StartOfPacket xmit' xmitChange @@ -206,7 +206,7 @@ orderedSetT s@CarrierExtend{} (txEn, txEr, dw, xmit, txEven, tx) = orderedSetT s@StartError{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | tx = TxDataError xmit' xmitChange | otherwise = StartError xmit' xmitChange @@ -216,7 +216,7 @@ orderedSetT s@StartError{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) orderedSetT s@TxDataError{} (txEn, txEr, _, xmit, txEven, tx) = (nextState, out) where nextState - | isJust s' = fromJust s' + | Just x <- s' = x | txEn && tx = TxData xmit' xmitChange | not txEn && not txEr && tx = EndOfPacketNoExt xmit' xmitChange | not txEn && txEr && tx = EndOfPacketExt xmit' xmitChange From 1346c876f26ed995b9f79779cdb80886ae46a90a Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 26 Aug 2024 15:32:50 +0200 Subject: [PATCH 27/30] More descriptive names in BitSlipState --- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 28 ++++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 90e1213020..ddaf07bba8 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -27,11 +27,11 @@ import Data.Maybe (fromJust) -- for 'BSFail'. data BitSlipState = BSFail - { _s :: BitVector 20 - , _ns :: Vec 8 (Index 10) + { _rx :: BitVector 20 + , _commaLocs :: Vec 8 (Index 10) , _hist :: Vec 10 (BitVector 10) } - | BSOk {_s :: BitVector 20, _n :: Index 10} + | BSOk {_rx :: BitVector 20, _commaLoc :: Index 10} deriving (Generic, NFDataX, Show) -- | State transition function for 'bitSlip', where the initial state is the @@ -46,20 +46,20 @@ bitSlipT :: -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) - | Just i <- n, _ns == repeat (fromJust n) = BSOk s i - | otherwise = BSFail s ns hist + | Just i <- n, _commaLocs == repeat (fromJust n) = BSOk rx i + | otherwise = BSFail rx ns hist where - s = resize $ _s ++# reverseBV cg - ns = maybe _ns (_ns <<+) n - hist = map pack $ take d10 $ windows1d d10 $ bv2v s + rx = resize $ _rx ++# reverseBV cg + ns = maybe _commaLocs (_commaLocs <<+) n + hist = map pack $ take d10 $ windows1d d10 $ bv2v rx n = elemIndex True $ map f _hist where f a = a == reverseBV cgK28_5N || a == reverseBV cgK28_5P bitSlipT BSOk{..} (cg, syncStatus) - | syncStatus == Fail = BSFail s (repeat _n) (repeat 0) - | otherwise = BSOk s _n + | syncStatus == Fail = BSFail rx (repeat _commaLoc) (repeat 0) + | otherwise = BSOk rx _commaLoc where - s = resize $ _s ++# reverseBV cg + rx = resize $ _rx ++# reverseBV cg -- | Output function for 'bitSlip' that takes the calculated index value and -- rotates the state vector to create the new output value, or outputs the @@ -69,11 +69,11 @@ bitSlipO :: BitSlipState -> -- | New output value (BitSlipState, BitVector 10, Status) -bitSlipO s = (s, reverseBV $ resize $ rotateR (_s s) (10 - n), bsStatus) +bitSlipO s = (s, reverseBV $ resize $ rotateR (_rx s) (10 - n), bsStatus) where (n, bsStatus) = case s of - BSFail{} -> (fromEnum $ last (_ns s), Fail) - BSOk{} -> (fromEnum $ _n s, Ok) + BSFail{} -> (fromEnum $ last (_commaLocs s), Fail) + BSOk{} -> (fromEnum $ _commaLoc s, Ok) -- | Function that takes a code word and returns the same code word, but if a -- comma is detected the code words is shifted such that the comma is at the From 228b7a602ebde30f258781facee919f0b56d0eab Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 26 Aug 2024 15:35:57 +0200 Subject: [PATCH 28/30] Only reset count when Just is received --- clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs index ab92c3d208..a7e2029efe 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/RateAdapt.hs @@ -25,8 +25,9 @@ rateAdaptRxT :: (LinkSpeed, Maybe a) -> -- | New state and output value (Index 100, Maybe a) -rateAdaptRxT n (linkSpeed, a) - | n == 0 = (n', a) +rateAdaptRxT n (_, Nothing) = (n, Nothing) +rateAdaptRxT n (linkSpeed, Just a) + | n == 0 = (n', Just a) | otherwise = (n', Nothing) where n' = if n == repeatN then 0 else n + 1 From 107535e39111e736fc1b290c6d1721366e7b38ea Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 26 Aug 2024 16:13:45 +0200 Subject: [PATCH 29/30] Remove reverseBV from BitSlip --- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 30 +++++++++++--------- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 14 ++++++--- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 10 ------- clash-cores/test/Test/Cores/Sgmii/BitSlip.hs | 2 +- 4 files changed, 27 insertions(+), 29 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index ddaf07bba8..63d62a6190 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -27,11 +27,11 @@ import Data.Maybe (fromJust) -- for 'BSFail'. data BitSlipState = BSFail - { _rx :: BitVector 20 + { _rx :: (CodeGroup, CodeGroup) , _commaLocs :: Vec 8 (Index 10) - , _hist :: Vec 10 (BitVector 10) + , _hist :: Vec 10 CodeGroup } - | BSOk {_rx :: BitVector 20, _commaLoc :: Index 10} + | BSOk {_rx :: (CodeGroup, CodeGroup), _commaLoc :: Index 10} deriving (Generic, NFDataX, Show) -- | State transition function for 'bitSlip', where the initial state is the @@ -46,20 +46,22 @@ bitSlipT :: -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) - | Just i <- n, _commaLocs == repeat (fromJust n) = BSOk rx i - | otherwise = BSFail rx ns hist + | Just i <- commaLoc, _commaLocs == repeat (fromJust commaLoc) = BSOk rx i + | otherwise = BSFail rx commaLocs hist where - rx = resize $ _rx ++# reverseBV cg - ns = maybe _commaLocs (_commaLocs <<+) n - hist = map pack $ take d10 $ windows1d d10 $ bv2v rx - n = elemIndex True $ map f _hist + rx = (snd _rx, cg) + commaLocs = maybe _commaLocs (_commaLocs <<+) commaLoc + + hist = map pack b where - f a = a == reverseBV cgK28_5N || a == reverseBV cgK28_5P + b = take d10 (windows1d d10 (bitCoerce rx)) :: (Vec 10 (Vec 10 Bit)) + + commaLoc = elemIndex True $ map (`elem` commas) _hist bitSlipT BSOk{..} (cg, syncStatus) | syncStatus == Fail = BSFail rx (repeat _commaLoc) (repeat 0) | otherwise = BSOk rx _commaLoc where - rx = resize $ _rx ++# reverseBV cg + rx = (snd _rx, cg) -- | Output function for 'bitSlip' that takes the calculated index value and -- rotates the state vector to create the new output value, or outputs the @@ -69,9 +71,9 @@ bitSlipO :: BitSlipState -> -- | New output value (BitSlipState, BitVector 10, Status) -bitSlipO s = (s, reverseBV $ resize $ rotateR (_rx s) (10 - n), bsStatus) +bitSlipO s = (s, resize (rotateR (pack (_rx s)) (10 - commaLoc)), bsStatus) where - (n, bsStatus) = case s of + (commaLoc, bsStatus) = case s of BSFail{} -> (fromEnum $ last (_commaLocs s), Fail) BSOk{} -> (fromEnum $ _commaLoc s, Ok) @@ -93,7 +95,7 @@ bitSlip cg1 syncStatus = (register 0 cg2, register Fail bsStatus) mooreB bitSlipT bitSlipO - (BSFail 0 (repeat 0) (repeat 0)) + (BSFail (0, 0) (repeat 0) (repeat 0)) (cg1, syncStatus) {-# CLASH_OPAQUE bitSlip #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index 00786f6f16..2d66748cb6 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -78,10 +78,6 @@ orNothing :: Bool -> a -> Maybe a orNothing True a = Just a orNothing False _ = Nothing --- | Reverse the bits of a 'BitVector' -reverseBV :: (KnownNat n) => BitVector n -> BitVector n -reverseBV = v2bv . reverse . bv2v - -- | Code group that corresponds to K28.5 with negative disparity cgK28_5N :: CodeGroup cgK28_5N = 0b0101111100 @@ -90,6 +86,16 @@ cgK28_5N = 0b0101111100 cgK28_5P :: CodeGroup cgK28_5P = 0b1010000011 +-- | Vector containing the two alternative forms (with opposite running +-- disparity) of K28.5. This is the only relevant comma, as the other commas +-- are set as "reserved" in the list of control words. The order of the commas +-- in this is important, as the first comma returns the negative running +-- disparity when it is decoded and the second comma returns the positive +-- running disparity when it is decoded. This is used in 'Sync.LossOfSync' to +-- recover the correct running disparity from a received comma. +commas :: Vec 2 CodeGroup +commas = cgK28_5N :> cgK28_5P :> Nil + -- | Data word corresponding to the decoded version of code group D00.0, used -- for early-end detection dwD00_0 :: Symbol8b10b diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index d4f57671e4..a1aad9dc5b 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -58,16 +58,6 @@ data SyncState } deriving (Generic, NFDataX, Show) --- | Vector containing the two alternative forms (with opposite running --- disparity) of K28.5. This is the only relevant comma, as the other commas --- are set as "reserved" in the list of control words. The order of the commas --- in this is important, as the first comma returns the negative running --- disparity when it is decoded and the second comma returns the positive --- running disparity when it is decoded. This is used in 'LossOfSync' to --- recover the correct running disparity from a received comma. -commas :: Vec 2 CodeGroup -commas = cgK28_5N :> cgK28_5P :> Nil - -- | State transition function for 'sync'. Takes the state as defined in -- 'SyncState', a the new incoming code group from the deserialization block -- and returns the next state as defined in Clause 36 of IEEE 802.3. As is diff --git a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs index 6ee19f0d06..484e24bcfd 100644 --- a/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/test/Test/Cores/Sgmii/BitSlip.hs @@ -27,7 +27,7 @@ bitSlipSim cg = C.mooreB bitSlipT bitSlipO - (BSFail 0 (C.repeat 0) (C.repeat 0)) + (BSFail (0, 0) (C.repeat 0) (C.repeat 0)) (cg, pure Ok) -- | Check that if 'bitSlip' moves into 'BSOk', the index is non-zero as it From b93942c8098ce00bf0f69ce45357d6b582a7b564 Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Tue, 27 Aug 2024 13:57:40 +0200 Subject: [PATCH 30/30] Remove fromJust from BitSlip --- clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs index 63d62a6190..1f22c24a01 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/BitSlip.hs @@ -19,7 +19,6 @@ where import Clash.Cores.Sgmii.Common import Clash.Prelude -import Data.Maybe (fromJust) -- | State variable for 'bitSlip', with the two states as described in -- 'bitSlipT'. Due to timing constraints, not all functions can be executed in @@ -46,7 +45,7 @@ bitSlipT :: -- | New state BitSlipState bitSlipT BSFail{..} (cg, _) - | Just i <- commaLoc, _commaLocs == repeat (fromJust commaLoc) = BSOk rx i + | Just i <- commaLoc, _commaLocs == repeat i = BSOk rx i | otherwise = BSFail rx commaLocs hist where rx = (snd _rx, cg)