From 8c9e3409cd9222301f1d762a92b3270ec54ac3ea Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 14:40:19 +0100 Subject: [PATCH 01/11] Add hoogle and int commands to Makefile --- Makefile | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 8ed6e72e..2e4fb4ce 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,6 @@ clean: format: stylish-haskell -c ./.stylish-haskell.yaml -r -i src - test: cabal test @@ -52,3 +51,9 @@ prog: ${bitstream} flash: ${bitstream} sudo "PATH=$$PATH" env ecpprog -p -a ${bitstream} + +int: + cabal run -- clashi + +hoogle: + hoogle server --local --port 8080 From be6a4b017e923a007f0f76636af23354c109bb23 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 16:05:00 +0100 Subject: [PATCH 02/11] create initial stream protocol --- src/Clash/Cores/Ethernet/PacketStream.hs | 52 ++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 src/Clash/Cores/Ethernet/PacketStream.hs diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs new file mode 100644 index 00000000..5923ab51 --- /dev/null +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE FlexibleContexts #-} + +module StreamProtocol where + +import Clash.Prelude +import Protocols (Protocol, Fwd, Bwd) +import Protocols.DfConv hiding (pure) +import qualified Data.Maybe as Maybe + +-- Simplified AXI4-Stream (master to slave). +-- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. +-- We removed _tid. +-- No _tvalid, we wrap the Stream into a Maybe where the Stream is Nothing when _tvalid is False. +data StreamM2S (dataWidth :: Nat) (metaType :: Type) + = StreamM2S { + _data :: Vec dataWidth (Unsigned 8), + _byte_enable :: Maybe (Vec dataWidth Bool), + -- ^ If Nothing, the entire byte is enabled by default, otherwise signifies which bytes are enabled + _meta :: metaType, + -- ^ the type of the metaData if necessary + _abort :: Bool + -- ^ If True, the current transfer is aborted and the slave should ignore the current transfer +} deriving (Generic, Show, ShowX, Bundle) + +-- Slave to master: only a simple signal which tells the master whether +-- the slave is ready to receive data +newtype StreamS2M = StreamS2M { + _ready :: Bool + -- ^ If True, the slave is ready to receive data +} deriving (Generic, Show, ShowX, Bundle) + +data Stream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) + +instance Protocol (Stream dom dataWidth metaType) where + type Fwd (Stream dom dataWidth metaType) = Signal dom (Maybe (StreamM2S dataWidth metaType)) + type Bwd (Stream dom dataWidth metaType) = Signal dom StreamS2M + +instance DfConv (Stream dom dataWidth metaType) where + type Dom (Stream dom dataWidth metaType) = dom + type FwdPayload (Stream dom dataWidth metaType) = StreamM2S dataWidth metaType + + toDfCircuit proxy = toDfCircuitHelper proxy s0 blankOtp stateFn where + s0 = () + blankOtp = Nothing + stateFn ack _ optItem + = pure (optItem, Nothing, Maybe.isJust optItem && _ready ack) + + fromDfCircuit proxy = fromDfCircuitHelper proxy s0 blankOtp stateFn where + s0 = () + blankOtp = StreamS2M { _ready = False } + stateFn m2s ack _ + = pure (StreamS2M {_ready = ack }, m2s, False) From 914d157f3354e55de14b9fe2030aab6352e0df0f Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 16:10:15 +0100 Subject: [PATCH 03/11] proper cabal configuration --- clash-eth.cabal | 1 + src/Clash/Cores/Ethernet/PacketStream.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/clash-eth.cabal b/clash-eth.cabal index c10e6999..a3074079 100644 --- a/clash-eth.cabal +++ b/clash-eth.cabal @@ -84,6 +84,7 @@ library exposed-modules: Clash.Lattice.ECP5.Colorlight.TopEntity Clash.Cores.Ethernet.RGMII + Clash.Cores.Ethernet.PacketStream Clash.Lattice.ECP5.Prims Clash.Lattice.ECP5.Colorlight.CRG default-language: Haskell2010 diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 5923ab51..0d5cbb67 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} -module StreamProtocol where +module Clash.Cores.Ethernet.PacketStream where import Clash.Prelude import Protocols (Protocol, Fwd, Bwd) From 6b701b58f2ce7da17aa0c0e479fcadf74cb197b0 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 16:26:38 +0100 Subject: [PATCH 04/11] renamed the Stream types to PacketStream --- src/Clash/Cores/Ethernet/PacketStream.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 0d5cbb67..5358c8cc 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -11,8 +11,8 @@ import qualified Data.Maybe as Maybe -- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. -- We removed _tid. -- No _tvalid, we wrap the Stream into a Maybe where the Stream is Nothing when _tvalid is False. -data StreamM2S (dataWidth :: Nat) (metaType :: Type) - = StreamM2S { +data PacketStreamM2S (dataWidth :: Nat) (metaType :: Type) + = PacketStreamM2S { _data :: Vec dataWidth (Unsigned 8), _byte_enable :: Maybe (Vec dataWidth Bool), -- ^ If Nothing, the entire byte is enabled by default, otherwise signifies which bytes are enabled @@ -24,20 +24,20 @@ data StreamM2S (dataWidth :: Nat) (metaType :: Type) -- Slave to master: only a simple signal which tells the master whether -- the slave is ready to receive data -newtype StreamS2M = StreamS2M { +newtype PacketStreamS2M = PacketStreamS2M { _ready :: Bool -- ^ If True, the slave is ready to receive data } deriving (Generic, Show, ShowX, Bundle) -data Stream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) +data PacketStream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) -instance Protocol (Stream dom dataWidth metaType) where - type Fwd (Stream dom dataWidth metaType) = Signal dom (Maybe (StreamM2S dataWidth metaType)) - type Bwd (Stream dom dataWidth metaType) = Signal dom StreamS2M +instance Protocol (PacketStream dom dataWidth metaType) where + type Fwd (PacketStream dom dataWidth metaType) = Signal dom (Maybe (PacketStreamM2S dataWidth metaType)) + type Bwd (PacketStream dom dataWidth metaType) = Signal dom PacketStreamS2M -instance DfConv (Stream dom dataWidth metaType) where - type Dom (Stream dom dataWidth metaType) = dom - type FwdPayload (Stream dom dataWidth metaType) = StreamM2S dataWidth metaType +instance DfConv (PacketStream dom dataWidth metaType) where + type Dom (PacketStream dom dataWidth metaType) = dom + type FwdPayload (PacketStream dom dataWidth metaType) = PacketStreamM2S dataWidth metaType toDfCircuit proxy = toDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () @@ -47,6 +47,6 @@ instance DfConv (Stream dom dataWidth metaType) where fromDfCircuit proxy = fromDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () - blankOtp = StreamS2M { _ready = False } + blankOtp = PacketStreamS2M { _ready = False } stateFn m2s ack _ - = pure (StreamS2M {_ready = ack }, m2s, False) + = pure (PacketStreamS2M {_ready = ack }, m2s, False) From 3717fcd852c29acc0aeadaa5582ccee191a4beb3 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 16:47:36 +0100 Subject: [PATCH 05/11] started on Simulate instance --- src/Clash/Cores/Ethernet/PacketStream.hs | 25 ++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 5358c8cc..098db618 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -4,8 +4,11 @@ module Clash.Cores.Ethernet.PacketStream where import Clash.Prelude import Protocols (Protocol, Fwd, Bwd) +import Protocols.Internal import Protocols.DfConv hiding (pure) import qualified Data.Maybe as Maybe +import Data.Proxy +import Protocols.Hedgehog.Internal -- Simplified AXI4-Stream (master to slave). -- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. @@ -35,6 +38,9 @@ instance Protocol (PacketStream dom dataWidth metaType) where type Fwd (PacketStream dom dataWidth metaType) = Signal dom (Maybe (PacketStreamM2S dataWidth metaType)) type Bwd (PacketStream dom dataWidth metaType) = Signal dom PacketStreamS2M +instance Backpressure (PacketStream dom dataWidth metaType) where + boolsToBwd _ = fromList_lazy . fmap PacketStreamS2M + instance DfConv (PacketStream dom dataWidth metaType) where type Dom (PacketStream dom dataWidth metaType) = dom type FwdPayload (PacketStream dom dataWidth metaType) = PacketStreamM2S dataWidth metaType @@ -50,3 +56,22 @@ instance DfConv (PacketStream dom dataWidth metaType) where blankOtp = PacketStreamS2M { _ready = False } stateFn m2s ack _ = pure (PacketStreamS2M {_ready = ack }, m2s, False) + +instance (KnownDomain dom) => + Simulate (PacketStream dom dataWidth metaType) where + type SimulateFwdType (PacketStream dom dataWidth metaType) = [Maybe (PacketStreamM2S dataWidth metaType)] + type SimulateBwdType (PacketStream dom dataWidth metaType) = [PacketStreamS2M] + type SimulateChannels (PacketStream dom dataWidth metaType) = 1 + + + simToSigFwd _ = fromList_lazy + simToSigBwd _ = fromList_lazy + sigToSimFwd _ = sample_lazy + sigToSimBwd _ = sample_lazy + + stallC conf (head -> (stallAck, stalls)) + = withClockResetEnable clockGen resetGen enableGen + $ stall Proxy Proxy conf stallAck stalls + + + From 2f4f73021c2f89cf9cf69252c760cd4cb45dbe40 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 17:20:17 +0100 Subject: [PATCH 06/11] finalised Packetstream --- clash-eth.cabal | 4 +- src/Clash/Cores/Ethernet/PacketStream.hs | 59 ++++++++++++++++++++---- 2 files changed, 54 insertions(+), 9 deletions(-) diff --git a/clash-eth.cabal b/clash-eth.cabal index a3074079..e136e730 100644 --- a/clash-eth.cabal +++ b/clash-eth.cabal @@ -90,7 +90,9 @@ library default-language: Haskell2010 build-depends: interpolate, - clash-cores + clash-cores, + deepseq, + hashable test-suite doctests type: exitcode-stdio-1.0 diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 098db618..711cf799 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -2,14 +2,29 @@ module Clash.Cores.Ethernet.PacketStream where -import Clash.Prelude -import Protocols (Protocol, Fwd, Bwd) +import Data.Hashable (Hashable, hashWithSalt) +import Control.DeepSeq (NFData) +import Clash.Prelude hiding (sample) import Protocols.Internal +import qualified Protocols.Df as Df +import qualified Protocols.DfConv as DfConv import Protocols.DfConv hiding (pure) import qualified Data.Maybe as Maybe import Data.Proxy -import Protocols.Hedgehog.Internal +import Protocols.Hedgehog.Internal +import qualified Prelude as P +deriving instance + ( KnownNat dataWidth, NFDataX metaType) + => NFDataX (PacketStreamM2S dataWidth metaType) + +deriving instance + ( KnownNat dataWidth, Eq metaType) + => Eq (PacketStreamM2S dataWidth metaType) + +deriving instance + ( KnownNat dataWidth, Hashable metaType) + => Hashable (PacketStreamM2S dataWidth metaType) -- Simplified AXI4-Stream (master to slave). -- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. -- We removed _tid. @@ -23,14 +38,13 @@ data PacketStreamM2S (dataWidth :: Nat) (metaType :: Type) -- ^ the type of the metaData if necessary _abort :: Bool -- ^ If True, the current transfer is aborted and the slave should ignore the current transfer -} deriving (Generic, Show, ShowX, Bundle) - +} deriving (Generic, ShowX, Show, NFData, Bundle) -- Slave to master: only a simple signal which tells the master whether -- the slave is ready to receive data newtype PacketStreamS2M = PacketStreamS2M { _ready :: Bool -- ^ If True, the slave is ready to receive data -} deriving (Generic, Show, ShowX, Bundle) +} deriving (Generic, ShowX, Show, NFData, Bundle, Eq, NFDataX) data PacketStream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) @@ -66,12 +80,41 @@ instance (KnownDomain dom) => simToSigFwd _ = fromList_lazy simToSigBwd _ = fromList_lazy - sigToSimFwd _ = sample_lazy - sigToSimBwd _ = sample_lazy + sigToSimFwd _ s = sample_lazy s + sigToSimBwd _ s = sample_lazy s stallC conf (head -> (stallAck, stalls)) = withClockResetEnable clockGen resetGen enableGen $ stall Proxy Proxy conf stallAck stalls +instance (KnownDomain dom) => + Drivable (PacketStream dom dataWidth metaType) where + type ExpectType (PacketStream dom dataWidth metaType) = + [PacketStreamM2S dataWidth metaType] + toSimulateType Proxy = fmap Just + fromSimulateType Proxy = Maybe.catMaybes + driveC conf vals + = withClockResetEnable clockGen resetGen enableGen + $ drive Proxy conf vals + sampleC conf ckt + = withClockResetEnable clockGen resetGen enableGen + $ sample Proxy conf ckt + + +instance + ( + KnownNat dataWidth + , NFDataX metaType + , NFData metaType + , ShowX metaType + , Show metaType + , Eq metaType + , KnownDomain dom ) => + Test (PacketStream dom dataWidth metaType) where + + expectToLengths Proxy = pure . P.length + expectN Proxy options nExpected sampled + = expectN (Proxy @(Df.Df dom _)) options nExpected + $ Df.maybeToData <$> sampled From 0efc20698ec8400f8d6cd47ca24b1f154594b715 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Fri, 23 Feb 2024 17:23:32 +0100 Subject: [PATCH 07/11] fix hashable error --- src/Clash/Cores/Ethernet/PacketStream.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 711cf799..1bd8da12 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -1,4 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- Hashable (Unsigned n) module Clash.Cores.Ethernet.PacketStream where @@ -7,13 +13,16 @@ import Control.DeepSeq (NFData) import Clash.Prelude hiding (sample) import Protocols.Internal import qualified Protocols.Df as Df -import qualified Protocols.DfConv as DfConv import Protocols.DfConv hiding (pure) import qualified Data.Maybe as Maybe import Data.Proxy import Protocols.Hedgehog.Internal import qualified Prelude as P +instance (KnownNat n) => Hashable (Unsigned n) +instance (KnownNat n, Hashable a) => Hashable (Vec n a) where + hashWithSalt s v = hashWithSalt s (toList v) + deriving instance ( KnownNat dataWidth, NFDataX metaType) => NFDataX (PacketStreamM2S dataWidth metaType) From 55071d23827b37c8b58eeb6f7c4d8964209f0ae5 Mon Sep 17 00:00:00 2001 From: Jasmijn Bookelmann Date: Wed, 28 Feb 2024 13:37:07 +0100 Subject: [PATCH 08/11] Change _byte_enable to _last of type Index --- src/Clash/Cores/Ethernet/PacketStream.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 1bd8da12..0bb796b6 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -31,6 +31,9 @@ deriving instance ( KnownNat dataWidth, Eq metaType) => Eq (PacketStreamM2S dataWidth metaType) +deriving instance + ( KnownNat n) => Hashable (Index n) + deriving instance ( KnownNat dataWidth, Hashable metaType) => Hashable (PacketStreamM2S dataWidth metaType) @@ -41,10 +44,12 @@ deriving instance data PacketStreamM2S (dataWidth :: Nat) (metaType :: Type) = PacketStreamM2S { _data :: Vec dataWidth (Unsigned 8), - _byte_enable :: Maybe (Vec dataWidth Bool), - -- ^ If Nothing, the entire byte is enabled by default, otherwise signifies which bytes are enabled + -- ^ The data to be transmitted + _last :: Maybe (Index dataWidth), + -- ^ If Nothing, we are not yet at the last byte, otherwise signifies how many bytes of _data are valid _meta :: metaType, - -- ^ the type of the metaData if necessary + -- ^ the metaData of a packet, _meta must be constant during a packet. + _abort :: Bool -- ^ If True, the current transfer is aborted and the slave should ignore the current transfer } deriving (Generic, ShowX, Show, NFData, Bundle) @@ -86,7 +91,6 @@ instance (KnownDomain dom) => type SimulateBwdType (PacketStream dom dataWidth metaType) = [PacketStreamS2M] type SimulateChannels (PacketStream dom dataWidth metaType) = 1 - simToSigFwd _ = fromList_lazy simToSigBwd _ = fromList_lazy sigToSimFwd _ s = sample_lazy s @@ -110,11 +114,9 @@ instance (KnownDomain dom) => sampleC conf ckt = withClockResetEnable clockGen resetGen enableGen $ sample Proxy conf ckt - instance - ( - KnownNat dataWidth + ( KnownNat dataWidth , NFDataX metaType , NFData metaType , ShowX metaType From 5af9bfbbb570680d9017779614440e532d8b9b20 Mon Sep 17 00:00:00 2001 From: Tim Wallet Date: Fri, 23 Feb 2024 17:34:21 +0100 Subject: [PATCH 09/11] added documentation / style changes --- clash-eth.cabal | 1 + src/Clash/Cores/Ethernet/PacketStream.hs | 105 +++++++++--------- src/Clash/Cores/Ethernet/RGMII.hs | 2 +- .../Lattice/ECP5/Colorlight/TopEntity.hs | 2 +- src/Clash/Lattice/ECP5/Prims.hs | 2 +- 5 files changed, 59 insertions(+), 53 deletions(-) diff --git a/clash-eth.cabal b/clash-eth.cabal index e136e730..3c93843c 100644 --- a/clash-eth.cabal +++ b/clash-eth.cabal @@ -33,6 +33,7 @@ common common-options TypeFamilies TypeOperators ViewPatterns + ImportQualifiedPost -- TemplateHaskell is used to support convenience functions such as -- 'listToVecTH' and 'bLit'. diff --git a/src/Clash/Cores/Ethernet/PacketStream.hs b/src/Clash/Cores/Ethernet/PacketStream.hs index 0bb796b6..8f571357 100644 --- a/src/Clash/Cores/Ethernet/PacketStream.hs +++ b/src/Clash/Cores/Ethernet/PacketStream.hs @@ -1,67 +1,72 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- Hashable (Unsigned n) - -module Clash.Cores.Ethernet.PacketStream where - -import Data.Hashable (Hashable, hashWithSalt) -import Control.DeepSeq (NFData) -import Clash.Prelude hiding (sample) -import Protocols.Internal -import qualified Protocols.Df as Df -import Protocols.DfConv hiding (pure) -import qualified Data.Maybe as Maybe -import Data.Proxy -import Protocols.Hedgehog.Internal -import qualified Prelude as P - -instance (KnownNat n) => Hashable (Unsigned n) -instance (KnownNat n, Hashable a) => Hashable (Vec n a) where - hashWithSalt s v = hashWithSalt s (toList v) +{-# language FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- Orphhan Hashable instances -deriving instance - ( KnownNat dataWidth, NFDataX metaType) - => NFDataX (PacketStreamM2S dataWidth metaType) +module Clash.Cores.Ethernet.PacketStream + ( PacketStreamM2S(..) + , PacketStreamS2M(..) + , PacketStream + ) where -deriving instance - ( KnownNat dataWidth, Eq metaType) - => Eq (PacketStreamM2S dataWidth metaType) +import Clash.Prelude hiding ( sample ) +import Prelude qualified as P -deriving instance - ( KnownNat n) => Hashable (Index n) +import Data.Hashable ( Hashable, hashWithSalt ) +import Data.Maybe qualified as Maybe +import Data.Proxy -deriving instance - ( KnownNat dataWidth, Hashable metaType) - => Hashable (PacketStreamM2S dataWidth metaType) --- Simplified AXI4-Stream (master to slave). --- We bundled _tstrb, _tdest and _tuser into one big _tmeta field which holds metadata. --- We removed _tid. --- No _tvalid, we wrap the Stream into a Maybe where the Stream is Nothing when _tvalid is False. +import Control.DeepSeq ( NFData ) + +import Protocols.Df qualified as Df +import Protocols.DfConv hiding ( pure ) +import Protocols.Hedgehog.Internal +import Protocols.Internal + +-- | Data sent from manager to subordinate, a simplified AXI4-Stream like interface +-- with metadata that can only change on packet delineation. +-- We bundled _tdest, _tuser and _tid into one big _meta field which holds metadata. +-- We don't have null or position bytes so _tstrb is replaced by a last indicator +-- that includes how many bytes are valid from the front of the vector. +-- _tvalid is modeled via wrapping this in a `Maybe` data PacketStreamM2S (dataWidth :: Nat) (metaType :: Type) = PacketStreamM2S { - _data :: Vec dataWidth (Unsigned 8), - -- ^ The data to be transmitted + _data :: Vec dataWidth (BitVector 8), + -- ^ The bytes to be transmitted _last :: Maybe (Index dataWidth), -- ^ If Nothing, we are not yet at the last byte, otherwise signifies how many bytes of _data are valid _meta :: metaType, - -- ^ the metaData of a packet, _meta must be constant during a packet. - + -- ^ the metaData of a packet, `_meta` must be constant during a packet. _abort :: Bool -- ^ If True, the current transfer is aborted and the slave should ignore the current transfer } deriving (Generic, ShowX, Show, NFData, Bundle) --- Slave to master: only a simple signal which tells the master whether --- the slave is ready to receive data + +-- | Data sent from the subordinate to the manager +-- The only information transmitted is whether the slave is ready to receive data newtype PacketStreamS2M = PacketStreamS2M { _ready :: Bool - -- ^ If True, the slave is ready to receive data + -- ^ Iff True, the slave is ready to receive data } deriving (Generic, ShowX, Show, NFData, Bundle, Eq, NFDataX) +-- This data type is used for communication between components data PacketStream (dom :: Domain) (dataWidth :: Nat) (metaType :: Type) +deriving instance + ( KnownNat dataWidth, NFDataX metaType) + => NFDataX (PacketStreamM2S dataWidth metaType) + +deriving instance + ( KnownNat dataWidth, Eq metaType) + => Eq (PacketStreamM2S dataWidth metaType) + +-- Orphan hashable instances +deriving instance (KnownNat n) => Hashable (BitVector n) +deriving instance (KnownNat n) => Hashable (Index n) +instance (KnownNat n, Hashable a) => Hashable (Vec n a) where + hashWithSalt s v = hashWithSalt s (toList v) + +deriving instance + (KnownNat dataWidth, Hashable metaType) + => Hashable (PacketStreamM2S dataWidth metaType) + instance Protocol (PacketStream dom dataWidth metaType) where type Fwd (PacketStream dom dataWidth metaType) = Signal dom (Maybe (PacketStreamM2S dataWidth metaType)) type Bwd (PacketStream dom dataWidth metaType) = Signal dom PacketStreamS2M @@ -76,13 +81,13 @@ instance DfConv (PacketStream dom dataWidth metaType) where toDfCircuit proxy = toDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () blankOtp = Nothing - stateFn ack _ optItem + stateFn ack _ optItem = pure (optItem, Nothing, Maybe.isJust optItem && _ready ack) fromDfCircuit proxy = fromDfCircuitHelper proxy s0 blankOtp stateFn where s0 = () blankOtp = PacketStreamS2M { _ready = False } - stateFn m2s ack _ + stateFn m2s ack _ = pure (PacketStreamS2M {_ready = ack }, m2s, False) instance (KnownDomain dom) => @@ -100,9 +105,9 @@ instance (KnownDomain dom) => = withClockResetEnable clockGen resetGen enableGen $ stall Proxy Proxy conf stallAck stalls -instance (KnownDomain dom) => +instance (KnownDomain dom) => Drivable (PacketStream dom dataWidth metaType) where - type ExpectType (PacketStream dom dataWidth metaType) = + type ExpectType (PacketStream dom dataWidth metaType) = [PacketStreamM2S dataWidth metaType] toSimulateType Proxy = fmap Just diff --git a/src/Clash/Cores/Ethernet/RGMII.hs b/src/Clash/Cores/Ethernet/RGMII.hs index 05a75300..b6cb309c 100644 --- a/src/Clash/Cores/Ethernet/RGMII.hs +++ b/src/Clash/Cores/Ethernet/RGMII.hs @@ -118,4 +118,4 @@ rgmiiReceiver channel rxdelay iddr = bundle (ethRxErr, byteStream) rxData = liftA2 (++#) ethRxData1 ethRxData2 byteStream :: Signal dom (Maybe (BitVector 8)) - byteStream = toMaybe <$> ethRxDv <*> rxData \ No newline at end of file + byteStream = toMaybe <$> ethRxDv <*> rxData diff --git a/src/Clash/Lattice/ECP5/Colorlight/TopEntity.hs b/src/Clash/Lattice/ECP5/Colorlight/TopEntity.hs index d9131d9d..9ebc6ecc 100644 --- a/src/Clash/Lattice/ECP5/Colorlight/TopEntity.hs +++ b/src/Clash/Lattice/ECP5/Colorlight/TopEntity.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NumericUnderscores #-} +{-# language NumericUnderscores #-} module Clash.Lattice.ECP5.Colorlight.TopEntity ( topEntity ) where diff --git a/src/Clash/Lattice/ECP5/Prims.hs b/src/Clash/Lattice/ECP5/Prims.hs index 91d021be..6991a629 100644 --- a/src/Clash/Lattice/ECP5/Prims.hs +++ b/src/Clash/Lattice/ECP5/Prims.hs @@ -7,7 +7,7 @@ module Clash.Lattice.ECP5.Prims where import Clash.Annotations.Primitive -import Clash.Explicit.DDR ( ddrOut, ddrIn ) +import Clash.Explicit.DDR ( ddrIn, ddrOut ) import Clash.Explicit.Prelude import Clash.Signal.BiSignal import Data.String.Interpolate ( i ) From 3a094e9f2021c3a69f336b0774e7a176ffeefe37 Mon Sep 17 00:00:00 2001 From: Rowan Goemans Date: Wed, 28 Feb 2024 19:09:10 +0100 Subject: [PATCH 10/11] Add test with example --- clash-eth.cabal | 4 +- tests/Test/Cores/Ethernet/Ethernet.hs | 24 --------- tests/Test/Cores/Ethernet/PacketStream.hs | 65 +++++++++++++++++++++++ tests/unittests.hs | 4 +- 4 files changed, 70 insertions(+), 27 deletions(-) delete mode 100644 tests/Test/Cores/Ethernet/Ethernet.hs create mode 100644 tests/Test/Cores/Ethernet/PacketStream.hs diff --git a/clash-eth.cabal b/clash-eth.cabal index 3c93843c..bd12512a 100644 --- a/clash-eth.cabal +++ b/clash-eth.cabal @@ -114,11 +114,13 @@ test-suite test-library ghc-options: -threaded main-is: unittests.hs other-modules: - Test.Cores.Ethernet.Ethernet + Test.Cores.Ethernet.PacketStream build-depends: clash-eth, QuickCheck, hedgehog, + hashable, + unordered-containers, tasty >= 1.2 && < 1.5, tasty-hedgehog, tasty-th diff --git a/tests/Test/Cores/Ethernet/Ethernet.hs b/tests/Test/Cores/Ethernet/Ethernet.hs deleted file mode 100644 index 7482433c..00000000 --- a/tests/Test/Cores/Ethernet/Ethernet.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Test.Cores.Ethernet.Ethernet where - -import Prelude - -import Test.Tasty -import Test.Tasty.Hedgehog -import Test.Tasty.TH - -import Hedgehog ( (===) ) -import qualified Hedgehog as H -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - -prop_plusIsCommutative :: H.Property -prop_plusIsCommutative = H.property $ do - a <- H.forAll (Gen.integral (Range.linear (minBound :: Int) maxBound)) - b <- H.forAll (Gen.integral (Range.linear (minBound :: Int) maxBound)) - a + b === b + a - -tests :: TestTree -tests = $(testGroupGenerator) - -main :: IO () -main = defaultMain tests diff --git a/tests/Test/Cores/Ethernet/PacketStream.hs b/tests/Test/Cores/Ethernet/PacketStream.hs new file mode 100644 index 00000000..89aea0a0 --- /dev/null +++ b/tests/Test/Cores/Ethernet/PacketStream.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RecordWildCards #-} + +module Test.Cores.Ethernet.PacketStream where + +-- base +import Prelude + +-- clash-prelude +import qualified Clash.Prelude as C +import Clash.Prelude (type (<=)) + +-- hedgehog +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +-- tasty +import Test.Tasty +import Test.Tasty.Hedgehog (HedgehogTestLimit(HedgehogTestLimit)) +import Test.Tasty.Hedgehog.Extra (testProperty) +import Test.Tasty.TH (testGroupGenerator) + +-- clash-protocols +import Protocols +import Protocols.Hedgehog + +-- Me +import Clash.Cores.Ethernet.PacketStream + +genVec :: (C.KnownNat n, 1 <= n) => Gen a -> Gen (C.Vec n a) +genVec gen = sequence (C.repeat gen) + +-- | Test the packet stream instance +-- TODO: Use the fifo given by `DfConv` +prop_packetstream_sometest_id :: Property +prop_packetstream_sometest_id = + propWithModelSingleDomain + @C.System + defExpectOptions + (Gen.list (Range.linear 0 100) genPackets) + (C.exposeClockResetEnable $ error "The model of the circuit: Implement a function here that transform the inputs to the circuit to outputs") + (C.exposeClockResetEnable @C.System ckt) + (\_a _b -> error "Property to test for. Function is given the data produced by the model as a first argument, and the sampled data as a second argument.") + where + ckt :: (C.HiddenClockResetEnable dom) => + Circuit + (PacketStream dom 1 Int) + (PacketStream dom 1 Int) + ckt = error "Insert the circuit to test here" + + -- This is used to generate + genPackets = + PacketStreamM2S <$> + (genVec Gen.enumBounded) <*> + (Gen.maybe Gen.enumBounded) <*> + Gen.enumBounded <*> + Gen.enumBounded + +tests :: TestTree +tests = + localOption (mkTimeout 12_000_000 {- 12 seconds -}) + $ localOption (HedgehogTestLimit (Just 1000)) + $(testGroupGenerator) diff --git a/tests/unittests.hs b/tests/unittests.hs index aede4358..56b8eb2f 100644 --- a/tests/unittests.hs +++ b/tests/unittests.hs @@ -2,9 +2,9 @@ import Prelude import Test.Tasty -import qualified Test.Cores.Ethernet.Ethernet +import qualified Test.Cores.Ethernet.PacketStream main :: IO () main = defaultMain $ testGroup "." - [ Test.Cores.Ethernet.Ethernet.tests + [ Test.Cores.Ethernet.PacketStream.tests ] From c4d4b25e01e715e042292c511a150c6009bad24f Mon Sep 17 00:00:00 2001 From: Rowan Goemans Date: Fri, 1 Mar 2024 14:50:04 +0100 Subject: [PATCH 11/11] Add test together with team --- tests/Test/Cores/Ethernet/PacketStream.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/tests/Test/Cores/Ethernet/PacketStream.hs b/tests/Test/Cores/Ethernet/PacketStream.hs index 89aea0a0..76e7e0e3 100644 --- a/tests/Test/Cores/Ethernet/PacketStream.hs +++ b/tests/Test/Cores/Ethernet/PacketStream.hs @@ -6,6 +6,7 @@ module Test.Cores.Ethernet.PacketStream where -- base import Prelude +import Data.Proxy -- clash-prelude import qualified Clash.Prelude as C @@ -25,6 +26,7 @@ import Test.Tasty.TH (testGroupGenerator) -- clash-protocols import Protocols import Protocols.Hedgehog +import qualified Protocols.DfConv as DfConv -- Me import Clash.Cores.Ethernet.PacketStream @@ -34,21 +36,21 @@ genVec gen = sequence (C.repeat gen) -- | Test the packet stream instance -- TODO: Use the fifo given by `DfConv` -prop_packetstream_sometest_id :: Property -prop_packetstream_sometest_id = +prop_packetstream_fifo_id :: Property +prop_packetstream_fifo_id = propWithModelSingleDomain @C.System defExpectOptions (Gen.list (Range.linear 0 100) genPackets) - (C.exposeClockResetEnable $ error "The model of the circuit: Implement a function here that transform the inputs to the circuit to outputs") + (C.exposeClockResetEnable id) (C.exposeClockResetEnable @C.System ckt) - (\_a _b -> error "Property to test for. Function is given the data produced by the model as a first argument, and the sampled data as a second argument.") + (\a b -> a === b) where ckt :: (C.HiddenClockResetEnable dom) => Circuit (PacketStream dom 1 Int) (PacketStream dom 1 Int) - ckt = error "Insert the circuit to test here" + ckt = DfConv.fifo Proxy Proxy (C.SNat @10) -- This is used to generate genPackets =