From cae250522d2a36b22f5f1eccf4c969a11f4fd55d Mon Sep 17 00:00:00 2001 From: Jasper Vinkenvleugel Date: Mon, 1 Jul 2024 15:29:38 +0200 Subject: [PATCH] Fixes for changed names in 8b10b --- clash-cores/src/Clash/Cores/Sgmii.hs | 13 ++- clash-cores/src/Clash/Cores/Sgmii/Common.hs | 20 ++--- .../src/Clash/Cores/Sgmii/PcsReceive.hs | 32 ++++--- clash-cores/src/Clash/Cores/Sgmii/Sync.hs | 88 +++++++++---------- .../test/Test/Cores/Sgmii/PcsReceive.hs | 34 +++---- clash-cores/test/Test/Cores/Sgmii/Sgmii.hs | 2 +- 6 files changed, 100 insertions(+), 89 deletions(-) diff --git a/clash-cores/src/Clash/Cores/Sgmii.hs b/clash-cores/src/Clash/Cores/Sgmii.hs index 32fb6ddfdb..8b22f3b283 100644 --- a/clash-cores/src/Clash/Cores/Sgmii.hs +++ b/clash-cores/src/Clash/Cores/Sgmii.hs @@ -4,7 +4,7 @@ module Clash.Cores.Sgmii where import Clash.Cores.LineCoding8b10b import Clash.Cores.Sgmii.AutoNeg -import Clash.Cores.Sgmii.BitSlip +-- import Clash.Cores.Sgmii.BitSlip import Clash.Cores.Sgmii.Common import Clash.Cores.Sgmii.PcsReceive import Clash.Cores.Sgmii.PcsTransmit @@ -28,7 +28,7 @@ sgmiiCdc :: Signal txDom Bool -> Signal txDom (BitVector 8) -> Signal rxDom (BitVector 10) -> - ( Signal rxDom (Bool, Bool, BitVector 8, BitVector 10) + ( Signal rxDom (Bool, Bool, BitVector 8) , Signal txDom (BitVector 10) ) sgmiiCdc autoNegCdc rxClk txClk rxRst txRst txEn txEr dw1 cg1 = @@ -36,7 +36,6 @@ sgmiiCdc autoNegCdc rxClk txClk rxRst txRst txEn txEr dw1 cg1 = ( exposeClockResetEnable regMaybe rxClk rxRst enableGen False rxDv , exposeClockResetEnable regMaybe rxClk rxRst enableGen False rxEr , exposeClockResetEnable regMaybe rxClk rxRst enableGen 0 dw4 - , cg2 ) , cg4 ) @@ -64,12 +63,12 @@ sgmiiCdc autoNegCdc rxClk txClk rxRst txRst txEn txEr dw1 cg1 = pcsReceive' = exposeClockResetEnable pcsReceive (cg3, rd, dw2, rxEven, syncStatus) = - unbundle $ sync' rxClk rxRst enableGen cg2 + unbundle $ sync' rxClk rxRst enableGen cg1 where sync' = exposeClockResetEnable sync - (cg2, _) = unbundle $ bitSlip' rxClk rxRst enableGen cg1 - where - bitSlip' = exposeClockResetEnable bitSlip +-- (cg2, _) = unbundle $ bitSlip' rxClk rxRst enableGen cg1 +-- where +-- bitSlip' = exposeClockResetEnable bitSlip {-# CLASH_OPAQUE sgmiiCdc #-} diff --git a/clash-cores/src/Clash/Cores/Sgmii/Common.hs b/clash-cores/src/Clash/Cores/Sgmii/Common.hs index f4eac8f556..824ea6fc82 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Common.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Common.hs @@ -47,50 +47,50 @@ data Xmit = Conf | Data | Idle -- | Data word corresponding to the decoded version of code group D00.0, used -- for early-end detection -dwD00_0 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +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 :: DataWord +cwV :: Symbol8b10b cwV = Cw 0b11111110 diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs index 31e9f4e465..9067dc7e06 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/PcsReceive.hs @@ -33,8 +33,13 @@ data PcsReceiveState | WaitForK {_rx :: Bool, _xmit :: Xmit} | RxK {_rx :: Bool, _xmit :: Xmit} | RxCB {_rx :: Bool, _xmit :: Xmit} - | RxCC {_rx :: Bool, _xmit :: Xmit, _hist :: DataWord} - | RxCD {_rx :: Bool, _xmit :: Xmit, _hist :: DataWord, _rxConfReg :: ConfReg} + | 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} @@ -45,8 +50,8 @@ data PcsReceiveState | PacketBurstRrs {_rx :: Bool, _xmit :: Xmit} | ExtendErr {_rx :: Bool, _xmit :: Xmit} | EarlyEndExt {_rx :: Bool, _xmit :: Xmit} - | RxData {_rx :: Bool, _xmit :: Xmit, _hist :: DataWord} - | RxDataError {_rx :: Bool, _xmit :: Xmit, _hist :: DataWord} + | RxData {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} + | RxDataError {_rx :: Bool, _xmit :: Xmit, _hist :: Symbol8b10b} | LinkFailed {_rx :: Bool, _xmit :: Xmit} deriving (Generic, NFDataX, Eq, Show) @@ -103,7 +108,7 @@ carrierDetect cg rd rxEven -- check whether they correspond to one of the specified end conditions checkEnd :: -- | Current and next 2 data words - Vec 3 DataWord -> + Vec 3 Symbol8b10b -> -- | End condition Maybe CheckEnd checkEnd dws @@ -128,13 +133,13 @@ pcsReceiveT :: PcsReceiveState -> -- | Input values, where @Vec 3 CodeGroup@ contains the current and next two -- | data words - (BitVector 10, Bool, Vec 3 DataWord, Even, SyncStatus, Maybe Xmit) -> + (BitVector 10, Bool, Vec 3 Symbol8b10b, Even, SyncStatus, Maybe Xmit) -> -- | Tuple with the new state and the output values ( PcsReceiveState , ( PcsReceiveState , Maybe Bool , Maybe Bool - , Maybe DataWord + , Maybe Symbol8b10b , Maybe Rudi , Maybe ConfReg ) @@ -460,8 +465,8 @@ pcsReceive :: Signal dom (BitVector 10) -> -- | Current running disparity from 'Sgmii.sync' Signal dom Bool -> - -- | Input 'DataWord' from 'Sgmii.sync' - Signal dom (Vec 3 DataWord) -> + -- | 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' @@ -469,7 +474,14 @@ pcsReceive :: -- | The 'Xmit' signal from 'Sgmii.autoNeg' Signal dom (Maybe Xmit) -> -- | Tuple containing the output values - Signal dom (Maybe Bool, Maybe Bool, Maybe DataWord, Maybe Rudi, Maybe ConfReg) + Signal + dom + ( Maybe Bool + , Maybe Bool + , Maybe Symbol8b10b + , Maybe Rudi + , Maybe ConfReg + ) pcsReceive cg rd dw1 rxEven syncStatus xmit = bundle (rxDv, rxEr, dw2, rudi, rxConfReg) where diff --git a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs index 02af537448..4f09cbf439 100644 --- a/clash-cores/src/Clash/Cores/Sgmii/Sync.hs +++ b/clash-cores/src/Clash/Cores/Sgmii/Sync.hs @@ -10,7 +10,7 @@ import Clash.Cores.Sgmii.Common import Clash.Prelude -- | State type of the output queue for 'sync' -type OutputQueue = Vec 3 (BitVector 10, Bool, DataWord, Even, SyncStatus) +type OutputQueue = Vec 3 (BitVector 10, Bool, Symbol8b10b, Even, SyncStatus) -- | State type of 'sync'. This contains all states as they are defined in IEEE -- 802.3 Clause 36. @@ -18,66 +18,66 @@ data SyncState = LossOfSync { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } - | CommaDetect1 {_cg :: BitVector 10, _rd :: Bool, _dw :: DataWord} + | CommaDetect1 {_cg :: BitVector 10, _rd :: Bool, _dw :: Symbol8b10b} | AcquireSync1 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } - | CommaDetect2 {_cg :: BitVector 10, _rd :: Bool, _dw :: DataWord} + | CommaDetect2 {_cg :: BitVector 10, _rd :: Bool, _dw :: Symbol8b10b} | AcquireSync2 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } - | CommaDetect3 {_cg :: BitVector 10, _rd :: Bool, _dw :: DataWord} + | CommaDetect3 {_cg :: BitVector 10, _rd :: Bool, _dw :: Symbol8b10b} | SyncAcquired1 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } | SyncAcquired2 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } | SyncAcquired2A { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even , _goodCgs :: Index 4 } | SyncAcquired3 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } | SyncAcquired3A { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even , _goodCgs :: Index 4 } | SyncAcquired4 { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even } | SyncAcquired4A { _cg :: BitVector 10 , _rd :: Bool - , _dw :: DataWord + , _dw :: Symbol8b10b , _rxEven :: Even , _goodCgs :: Index 4 } @@ -119,10 +119,10 @@ syncT CommaDetect1{..} cg = nextState syncT AcquireSync1{..} cg = nextState where nextState - | not (isValidDw dw) = LossOfSync cg rd dw rxEven + | 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 - | cg `notElem` commas && isValidDw dw = AcquireSync1 cg rd dw rxEven + | cg `notElem` commas && isValidSymbol dw = AcquireSync1 cg rd dw rxEven | otherwise = AcquireSync1 cg rd dw rxEven (rd, dw) = decode8b10b _rd cg @@ -139,10 +139,10 @@ syncT CommaDetect2{..} cg = nextState syncT AcquireSync2{..} cg = nextState where nextState - | not (isValidDw dw) = LossOfSync cg rd dw rxEven + | 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 - | cg `notElem` commas && isValidDw dw = AcquireSync2 cg rd dw rxEven + | cg `notElem` commas && isValidSymbol dw = AcquireSync2 cg rd dw rxEven | otherwise = AcquireSync2 cg rd dw rxEven (rd, dw) = decode8b10b _rd cg @@ -159,9 +159,9 @@ syncT CommaDetect3{..} cg = nextState syncT SyncAcquired1{..} cg = nextState where nextState - | not (isValidDw dw) = SyncAcquired2 cg rd dw rxEven + | not (isValidSymbol dw) = SyncAcquired2 cg rd dw rxEven | cg `elem` commas && rxEven == Even = SyncAcquired2 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired1 cg rd dw rxEven | otherwise = SyncAcquired1 cg rd dw rxEven @@ -170,9 +170,9 @@ syncT SyncAcquired1{..} cg = nextState syncT SyncAcquired2{..} cg = nextState where nextState - | not (isValidDw dw) = SyncAcquired3 cg rd dw rxEven + | not (isValidSymbol dw) = SyncAcquired3 cg rd dw rxEven | cg `elem` commas && rxEven == Even = SyncAcquired3 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired2A cg rd dw rxEven goodCgs | otherwise = SyncAcquired2 cg rd dw rxEven @@ -182,13 +182,13 @@ syncT SyncAcquired2{..} cg = nextState syncT SyncAcquired2A{..} cg = nextState where nextState - | not (isValidDw dw) = SyncAcquired3 cg rd dw rxEven + | not (isValidSymbol dw) = SyncAcquired3 cg rd dw rxEven | cg `elem` commas && rxEven == Even = SyncAcquired3 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) && goodCgs == 3 = SyncAcquired1 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired2A cg rd dw rxEven goodCgs | otherwise = SyncAcquired2A cg rd dw rxEven goodCgs @@ -198,9 +198,9 @@ syncT SyncAcquired2A{..} cg = nextState syncT SyncAcquired3{..} cg = nextState where nextState - | not (isValidDw dw) = SyncAcquired4 cg rd dw rxEven + | not (isValidSymbol dw) = SyncAcquired4 cg rd dw rxEven | cg `elem` commas && rxEven == Even = SyncAcquired4 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired3A cg rd dw rxEven goodCgs | otherwise = SyncAcquired3 cg rd dw rxEven @@ -210,13 +210,13 @@ syncT SyncAcquired3{..} cg = nextState syncT SyncAcquired3A{..} cg = nextState where nextState - | not (isValidDw dw) = SyncAcquired4 cg rd dw rxEven + | not (isValidSymbol dw) = SyncAcquired4 cg rd dw rxEven | cg `elem` commas && rxEven == Even = SyncAcquired4 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) && goodCgs == 3 = SyncAcquired2 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired3A cg rd dw rxEven goodCgs | otherwise = SyncAcquired3A cg rd dw rxEven goodCgs @@ -226,9 +226,9 @@ syncT SyncAcquired3A{..} cg = nextState syncT SyncAcquired4{..} cg = nextState where nextState - | not (isValidDw dw) = LossOfSync cg rd dw rxEven + | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired4A cg rd dw rxEven goodCgs | otherwise = SyncAcquired4 cg rd dw rxEven @@ -238,13 +238,13 @@ syncT SyncAcquired4{..} cg = nextState syncT SyncAcquired4A{..} cg = nextState where nextState - | not (isValidDw dw) = LossOfSync cg rd dw rxEven + | not (isValidSymbol dw) = LossOfSync cg rd dw rxEven | cg `elem` commas && rxEven == Even = LossOfSync cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) && goodCgs == 3 = SyncAcquired3 cg rd dw rxEven - | not (not (isValidDw dw) || cg `elem` commas && rxEven == Even) = + | not (not (isValidSymbol dw) || cg `elem` commas && rxEven == Even) = SyncAcquired4A cg rd dw rxEven goodCgs | otherwise = SyncAcquired4A cg rd dw rxEven goodCgs @@ -259,7 +259,7 @@ syncO :: -- | Current state SyncState -> -- | New state and output tuple - (SyncState, BitVector 10, Bool, DataWord, Even, SyncStatus) + (SyncState, BitVector 10, Bool, Symbol8b10b, Even, SyncStatus) syncO self@LossOfSync{..} = (self, _cg, _rd, _dw, rxEven, Fail) where rxEven = nextEven _rxEven @@ -277,14 +277,14 @@ syncO self = (self, self._cg, self._rd, self._dw, rxEven, Ok) rxEven = nextEven self._rxEven -- | Transition function for the inputs of 'Sgmii.pcsReceive'. This is used to --- keep a small list of "future" values for 'DataWord', such that these can +-- 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; - (BitVector 10, Bool, DataWord, Even, SyncStatus) -> + (BitVector 10, Bool, Symbol8b10b, Even, SyncStatus) -> -- | New state OutputQueue outputQueueT s i = s <<+ i @@ -294,9 +294,9 @@ outputQueueT s i = s <<+ i outputQueueO :: -- Current state with three values for all inputs OutputQueue -> - -- | New output with one value for everything except 'DataWord' for the + -- | New output with one value for everything except 'Symbol8b10b' for the -- prescient 'Sgmii.checkEnd' function. - (BitVector 10, Bool, Vec 3 DataWord, Even, SyncStatus) + (BitVector 10, 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 @@ -304,16 +304,16 @@ outputQueueO s = (cg, rd, dw, rxEven, syncStatus) -- | 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 'DataWord' from the +-- 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'. sync :: (HiddenClockResetEnable dom) => -- | New code group from the PHY Signal dom (BitVector 10) -> - -- | A tuple containing the running disparity, a new 'DataWord', the new value - -- for 'Even' and the current synchronization status - Signal dom (BitVector 10, Bool, Vec 3 DataWord, Even, SyncStatus) + -- | A tuple containing the running disparity, a new 'Symbol8b10b', the new + -- value for 'Even' and the current synchronization status + Signal dom (BitVector 10, Bool, Vec 3 Symbol8b10b, Even, SyncStatus) sync cg1 = out where out = diff --git a/clash-cores/test/Test/Cores/Sgmii/PcsReceive.hs b/clash-cores/test/Test/Cores/Sgmii/PcsReceive.hs index a8ecf334ce..a175a8e864 100644 --- a/clash-cores/test/Test/Cores/Sgmii/PcsReceive.hs +++ b/clash-cores/test/Test/Cores/Sgmii/PcsReceive.hs @@ -18,24 +18,24 @@ import Test.Tasty.TH import Prelude -- | Function that creates a list with a given range that contains a list of --- running disparities and 'DataWord's -genDataWords :: H.Range Int -> H.Gen [(Bool, DataWord)] -genDataWords range = do +-- running disparities and 'Symbol8b10b's +genSymbol8b10bs :: H.Range Int -> H.Gen [(Bool, Symbol8b10b)] +genSymbol8b10bs range = do n <- Gen.int range - genDataWords1 n False + genSymbol8b10bs1 n False --- | Recursive function to generate a list of 'DataWord's with the correct +-- | Recursive function to generate a list of 'Symbol8b10b's with the correct -- running disparity -genDataWords1 :: Int -> Bool -> H.Gen [(Bool, DataWord)] -genDataWords1 0 _ = pure [] -genDataWords1 n rd = do - (rdNew, dw) <- genDataWord rd - ((rdNew, dw) :) <$> genDataWords1 (pred n) rdNew +genSymbol8b10bs1 :: Int -> Bool -> H.Gen [(Bool, Symbol8b10b)] +genSymbol8b10bs1 0 _ = pure [] +genSymbol8b10bs1 n rd = do + (rdNew, dw) <- genSymbol8b10b rd + ((rdNew, dw) :) <$> genSymbol8b10bs1 (pred n) rdNew --- | Generate a 'DataWord' by creating a 'BitVector' of length 10 and decoding --- it with the 'decode8b10b' function -genDataWord :: Bool -> H.Gen (Bool, DataWord) -genDataWord rd = Gen.filter f $ decode8b10b rd <$> genDefinedBitVector +-- | Generate a 'Symbol8b10b' by creating a 'BitVector' of length 10 and +-- decoding it with the 'decode8b10b' function +genSymbol8b10b :: Bool -> H.Gen (Bool, Symbol8b10b) +genSymbol8b10b rd = Gen.filter f $ decode8b10b rd <$> genDefinedBitVector where f (_, dw) = isDw dw @@ -48,7 +48,7 @@ pcsReceiveSim :: dom ( C.BitVector 10 , Bool - , C.Vec 3 DataWord + , C.Vec 3 Symbol8b10b , Even , SyncStatus , Maybe Xmit @@ -59,13 +59,13 @@ pcsReceiveSim s i = s' (s', _, _, _, _, _) = C.unbundle $ C.mealy pcsReceiveT s i --- | Test that for an arbitrary list of inputs 'DataWord's, the state machine +-- | Test that for an arbitrary list of inputs 'Symbol8b10b's, the state machine -- will move from @START_OF_PACKET@ to @RX_DATA@ prop_pcsReceiveStartOfPacket :: H.Property prop_pcsReceiveStartOfPacket = H.property $ do simDuration <- H.forAll (Gen.integral (Range.linear 10 100)) - inp <- H.forAll (genDataWords (Range.singleton simDuration)) + inp <- H.forAll (genSymbol8b10bs (Range.singleton simDuration)) let simOut = C.sampleN diff --git a/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs b/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs index de787a520c..09fbea42cb 100644 --- a/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs +++ b/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs @@ -31,7 +31,7 @@ sgmiiCommon :: dom ( Maybe Bool , Maybe Bool - , Maybe DataWord + , Maybe Symbol8b10b , Maybe Xmit , Maybe ConfReg )