Explicitly make codeGroup a moore machine

clash-lang · Jul 1, 2024 · 3606764 · 3606764
1 parent ab37cf1
commit 3606764
Show file tree

Hide file tree

Showing 3 changed files with 112 additions and 113 deletions.
diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit.hs
@@ -27,7 +27,11 @@ pcsTransmit ::
 pcsTransmit txEn txEr dw xmit txConfReg = cg
  where
   (_, cg, txEven, cgSent) =
-    mealyB codeGroupT (SpecialGo False 0 Even OSetC) (txOSet, dw, txConfReg)
+    mooreB
+      codeGroupT
+      codeGroupO
+      (SpecialGo False 0 0 Even OSetC)
+      (txOSet, dw, txConfReg)
 
   (_, txOSet) =
     mealyB

diff --git a/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs b/clash-cores/src/Clash/Cores/Sgmii/PcsTransmit/CodeGroup.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Clash.Cores.Sgmii.PcsTransmit.CodeGroup where
@@ -8,29 +9,35 @@ import Clash.Cores.Sgmii.Common
 import Clash.Prelude
 import Data.Maybe (fromMaybe)
 
--- | State type of 'codeGroupT' 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
+-- | 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 :: BitVector 10
       , _txConfReg :: ConfReg
       , _txEven :: Even
       , _txOSet :: OrderedSet
       }
-  | DataGo {_rd :: Bool, _txConfReg :: ConfReg, _txEven :: Even}
-  | IdleDisparityWrong {_rd :: Bool, _txConfReg :: ConfReg}
-  | IdleI1B {_rd :: Bool, _txConfReg :: ConfReg}
-  | IdleDisparityOk {_rd :: Bool, _txConfReg :: ConfReg}
-  | IdleI2B {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC1A {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC1B {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC1C {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC1D {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC2A {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC2B {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC2C {_rd :: Bool, _txConfReg :: ConfReg}
-  | ConfigurationC2D {_rd :: Bool, _txConfReg :: ConfReg}
+  | DataGo
+      { _rd :: Bool
+      , _cg :: BitVector 10
+      , _txConfReg :: ConfReg
+      , _txEven :: Even
+      }
+  | IdleDisparityWrong {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | IdleI1B {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | IdleDisparityOk {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | IdleI2B {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC1A {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC1B {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC1C {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC1D {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC2A {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC2B {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC2C {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
+  | ConfigurationC2D {_rd :: Bool, _cg :: BitVector 10, _txConfReg :: ConfReg}
   deriving (Generic, NFDataX, Eq, Show)
 
 -- | State transition function for the states as defined in IEEE 802.3 Clause
@@ -43,16 +50,16 @@ codeGroupT ::
   -- | Input 'DataWord' from the ordered set, new input value and the config
   --   register
   (OrderedSet, BitVector 8, Maybe ConfReg) ->
-  -- | The new state and the new output values
-  (CodeGroupState, (CodeGroupState, BitVector 10, Even, Bool))
-codeGroupT self@SpecialGo{..} (txOSet, _, txConfReg) = (nextState, out)
+  -- | The new state
+  CodeGroupState
+codeGroupT SpecialGo{..} (txOSet, _, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC1A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | 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
 
   dw
     | _txOSet == OSetS = cwS
@@ -64,150 +71,138 @@ codeGroupT self@SpecialGo{..} (txOSet, _, txConfReg) = (nextState, out)
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd dw
   txEven = nextEven _txEven
-
-  out = (self, cg, txEven, True)
-codeGroupT self@DataGo{..} (txOSet, dw, txConfReg) = (nextState, out)
+codeGroupT DataGo{..} (txOSet, dw, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC1A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | 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
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd (Dw dw)
   txEven = nextEven _txEven
-
-  out = (self, cg, txEven, True)
-codeGroupT self@IdleDisparityWrong{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT IdleDisparityWrong{..} (_, _, txConfReg) = nextState
  where
-  nextState = IdleI1B rd txConfReg'
+  nextState = IdleI1B rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd cwK28_5
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@IdleI1B{..} (txOSet, _, txConfReg) = (nextState, out)
+codeGroupT IdleI1B{..} (txOSet, _, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC1A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | 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
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd dwD05_6
   txEven = Odd
-
-  out = (self, cg, txEven, True)
-codeGroupT self@IdleDisparityOk{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT IdleDisparityOk{..} (_, _, txConfReg) = nextState
  where
-  nextState = IdleI2B rd txConfReg'
+  nextState = IdleI2B rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd cwK28_5
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@IdleI2B{..} (txOSet, _, txConfReg) = (nextState, out)
+codeGroupT IdleI2B{..} (txOSet, _, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC1A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | 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
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd dwD16_2
   txEven = Odd
-
-  out = (self, cg, txEven, True)
-codeGroupT self@ConfigurationC1A{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC1A{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC1B rd txConfReg'
+  nextState = ConfigurationC1B rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd cwK28_5
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC1B{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC1B{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC1C rd txConfReg'
+  nextState = ConfigurationC1C rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd dwD21_5
-  txEven = Odd
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC1C{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC1C{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC1D rd txConfReg'
+  nextState = ConfigurationC1D rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd (Dw (resize txConfReg'))
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC1D{..} (txOSet, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC1D{..} (txOSet, _, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC2A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | txOSet == OSetD = DataGo rd cg txConfReg' txEven
+    | txOSet == OSetI && rd = IdleDisparityWrong rd cg txConfReg'
+    | txOSet == OSetI && not rd = IdleDisparityOk rd cg txConfReg'
+    | txOSet == OSetC = ConfigurationC2A rd cg txConfReg'
+    | otherwise = SpecialGo rd cg txConfReg' txEven txOSet
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd (Dw (resize $ rotateR _txConfReg 8))
   txEven = Odd
-
-  out = (self, cg, txEven, True)
-codeGroupT self@ConfigurationC2A{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC2A{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC2B rd txConfReg'
+  nextState = ConfigurationC2B rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd cwK28_5
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC2B{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC2B{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC2C rd txConfReg'
+  nextState = ConfigurationC2C rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd dwD02_2
-  txEven = Odd
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC2C{..} (_, _, txConfReg) = (nextState, out)
+codeGroupT ConfigurationC2C{..} (_, _, txConfReg) = nextState
  where
-  nextState = ConfigurationC2D rd txConfReg'
+  nextState = ConfigurationC2D rd cg txConfReg'
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd (Dw (resize txConfReg'))
-  txEven = Even
-
-  out = (self, cg, txEven, False)
-codeGroupT self@ConfigurationC2D{..} (txOSet, _, txConfReg) =
-  (nextState, out)
+codeGroupT ConfigurationC2D{..} (txOSet, _, txConfReg) = nextState
  where
   nextState
-    | txOSet == OSetD = DataGo rd txConfReg' txEven
-    | txOSet == OSetI && rd = IdleDisparityWrong rd txConfReg'
-    | txOSet == OSetI && not rd = IdleDisparityOk rd txConfReg'
-    | txOSet == OSetC = ConfigurationC1A rd txConfReg'
-    | otherwise = SpecialGo rd txConfReg' txEven txOSet
+    | 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
 
   txConfReg' = fromMaybe _txConfReg txConfReg
   (rd, cg) = encode8b10b _rd (Dw (resize $ rotateR _txConfReg 8))
   txEven = Odd
 
-  out = (self, cg, txEven, True)
-
 {-# CLASH_OPAQUE codeGroupT #-}
+
+-- | Output 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 encodes it.
+codeGroupO ::
+  -- | Current state
+  CodeGroupState ->
+  -- | New output values
+  (CodeGroupState, BitVector 10, Even, Bool)
+codeGroupO self@SpecialGo{..} = (self, _cg, txEven, True)
+ where
+  txEven = nextEven _txEven
+codeGroupO self@DataGo{..} = (self, _cg, txEven, True)
+ where
+  txEven = nextEven _txEven
+codeGroupO self@IdleI1B{..} = (self, _cg, Odd, True)
+codeGroupO self@IdleI2B{..} = (self, _cg, Odd, True)
+codeGroupO self@ConfigurationC1B{..} = (self, _cg, Odd, False)
+codeGroupO self@ConfigurationC1D{..} = (self, _cg, Odd, True)
+codeGroupO self@ConfigurationC2B{..} = (self, _cg, Odd, False)
+codeGroupO self@ConfigurationC2D{..} = (self, _cg, Odd, True)
+codeGroupO self = (self, self._cg, Even, False)
+
+{-# CLASH_OPAQUE codeGroupO #-}
diff --git a/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs b/clash-cores/test/Test/Cores/Sgmii/Sgmii.hs
@@ -149,8 +149,8 @@ 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 = 86
-      delaySamples = 17
+  let setupSamples = 91
+      delaySamples = 19
       controlCount = 9
 
       simOut =
@@ -180,8 +180,8 @@ prop_duplexTransmission = H.property $ do
 
   inp1 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector)
   inp2 <- H.forAll (Gen.list (Range.singleton simDuration) genDefinedBitVector)
-  let setupSamples = 86
-      delaySamples = 9
+  let setupSamples = 91
+      delaySamples = 10
       controlCount = 9
 
       inp = zip inp1 inp2
@@ -209,7 +209,7 @@ prop_duplexTransmission = H.property $ do
 --   block to the receive block in exactly 22 cycles
 prop_confRegPropagated :: H.Property
 prop_confRegPropagated = H.property $ do
-  simDuration <- H.forAll (Gen.integral (Range.singleton 23))
+  simDuration <- H.forAll (Gen.integral (Range.singleton 24))
 
   inp <- H.forAll genDefinedBitVector
   let simOut =