UDP core topentity

clash-eth.cabal

@@ -102,6 +102,7 @@ library
     Clash.Cores.Ethernet.Arp.ArpTypes
     Clash.Cores.Ethernet.Examples.ArpStack
     Clash.Cores.Ethernet.Examples.FullUdpStack
+    Clash.Cores.Ethernet.Examples.UdpCoreStack
     Clash.Cores.Ethernet.Examples.RxStacks
     Clash.Cores.Ethernet.Examples.TxStacks
     Clash.Cores.Ethernet.IP.EthernetStream
@@ -118,6 +119,7 @@ library
     Clash.Cores.Ethernet.Udp
     Clash.Lattice.ECP5.Colorlight.CRG
     Clash.Lattice.ECP5.Colorlight.TopEntity
+    Clash.Lattice.ECP5.Colorlight.UdpCore
     Clash.Lattice.ECP5.Prims
     Clash.Lattice.ECP5.RGMII
     Protocols.Extra.PacketStream.AsyncFIFO

src/Clash/Cores/Ethernet/Arp.hs

@@ -72,6 +72,6 @@ arpC maxAge maxWait tableDepth ourMacS ourIPv4S =
   circuit $ \(ethStream, lookupIn) -> do
     (entry, replyOut) <- arpReceiverC ourIPv4S -< ethStream
     (lookupOut, requestOut) <- arpManagerC maxWait -< lookupIn
-    () <- arpTable tableDepth maxAge -< (lookupOut, entry)
+    () <- arpTable maxAge -< (lookupOut, entry)
     arpPktOut <- Df.roundrobinCollect Df.Skip -< [replyOut, requestOut]
     arpTransmitterC ourMacS ourIPv4S -< arpPktOut

src/Clash/Cores/Ethernet/Arp/ArpTable.hs

@@ -1,152 +1,55 @@
-{-|
-Module      : Clash.Cores.Arp.ArpTable
-Description : Provides a highly configurable ARP table.
--}
-
 {-# language FlexibleContexts #-}
-{-# language RecordWildCards #-}
 
+{-|
+Module      : Clash.Cores.Ethernet.Arp.ArpTable
+Description : Provides an ARP table which is able to hold one ARP entry.
+-}
 module Clash.Cores.Ethernet.Arp.ArpTable
   ( arpTable
   ) where
 
 import Clash.Prelude
-import Clash.Signal.Extra
 
 import Protocols
 import Protocols.Df qualified as Df
 
 import Clash.Cores.Ethernet.Arp.ArpTypes
-import Clash.Cores.Ethernet.IP.IPv4Types
-
-import Data.Maybe
-
-
-data ArpTableState depth
-  = Active {
-    -- | Whether the output of the blockram contains valid data
-    _bramValid :: Bool
-  }
-  -- ^ The ARP table is handling insertion and lookup requests
-  | Invalidating {
-    -- | The timer of the entry at this address will be decremented
-    _writeAddr :: Unsigned depth
-  }
-  -- ^ The ARP table is decrementing the timers of all entries,
-  --   and therefore cannot currently accept any insertion or lookup requests.
-  deriving (Generic, Show, ShowX, NFDataX)
-
-arpTableT
-  :: forall
-     (depth :: Nat)
-     (maxAgeSeconds :: Nat)
-   . KnownNat depth
-  => KnownNat maxAgeSeconds
-  => 1 <= maxAgeSeconds
-  => 1 <= depth
-  => depth <= 32
-  => ArpTableState depth
-  -> ( Bool
-     , (ArpEntry, Index (maxAgeSeconds + 1))
-     , Maybe (ArpEntry, Unsigned depth)
-     , Maybe (IPv4Address, Unsigned depth)
-     , Bool
-     )
-  -> ( ArpTableState depth
-     , ( Ack
-       , Unsigned depth
-       , Maybe (Unsigned depth, (ArpEntry, Index (maxAgeSeconds + 1)))
-       , Maybe ArpResponse
-       )
-     )
--- If the reset is enabled, go back to the initial state
--- and don't acknowledge or send out data.
-arpTableT _ (True, _, _, _, _) =
-  (Active False, (Ack False, 0, Nothing, Nothing))
 
-arpTableT Active{..} (_, (arpEntry, secsLeft), insertionWithHash, lookupWithHash, secondPassed)
-  = (nextSt, (Ack True, readAddr, writeCmd, arpResponseOut))
-    where
-      writeCmd = (\(entry, hash) -> (hash, (entry, maxBound))) <$> insertionWithHash
-      validLookup = isJust lookupWithHash
 
-      arpResponseOut
-        | _bramValid && validLookup = Just (arpResponse (fst $ fromJustX lookupWithHash))
-        | otherwise = Nothing
-
-      -- It is possible that the IP stored in the entry is not the same as the lookup IP.
-      -- This happens due to hash collisions.
-      arpResponse lookupIP =
-        if secsLeft == 0 || lookupIP /= _arpIP arpEntry
-        then ArpEntryNotFound
-        else ArpEntryFound (_arpMac arpEntry)
-
-      (nextSt, readAddr)
-        | secondPassed = (Invalidating maxBound, maxBound)
-        | otherwise = (Active (validLookup && not _bramValid), maybe 0 snd lookupWithHash)
-
-arpTableT Invalidating{..} (_, (arpEntry, secsLeft), _, _, _)
-  = (nextSt, (Ack False, readAddr, writeCmd, Nothing))
-    where
-      writeCmd = Just (_writeAddr, (arpEntry, satPred SatBound secsLeft))
-      (nextSt, readAddr)
-        | _writeAddr == 0 = (Active False, 0)
-        | otherwise = let addr = pred _writeAddr in (Invalidating addr, addr)
-
--- | ARP table that stores @2^depth@ entries in block ram. `maxAgeSeconds` is the number of seconds before the
---   entry will be removed from the table (lazily). The timeout is inaccurate for up to one second, because
---   the circuit uses a constant counter for efficiency. Every second, the ARP table is unable to handle insertion
---   and lookup requests for @2^depth@ clock cycles, because it needs to decrease the timers of the entries.
---   During this period, the component will assert backpressure. Note that this implies that the component will
---   not work correctly when the size of the ARP table is bigger than the clock frequency.
---
---   An entry may be evicted sooner than expected from the cache due to hash collisions; entries are addressed
---   by taking the last `depth` bits of their corresponding IPv4 address. By increasing the
---   number of entries in the table, the chance of IPv4 addresses colliding is lower.
+-- | ARP table that stores one ARP entry in a register. `maxAgeSeconds` is the number of seconds before the
+--   entry will be removed from the table (lazily). The timeout is inaccurate for up to one second less, because
+--   the circuit uses a constant counter for efficiency reasons. For example, when `maxAgeSeconds` is set to 30,
+--   an entry will expire in 29-30 seconds. The clock frequency must be at least 1 Hz for timeouts to work correctly.
 arpTable
   :: forall
-     (dom :: Domain)
-     (depth :: Nat)
-     (maxAgeSeconds :: Nat)
+    (dom :: Domain)
+    (maxAgeSeconds :: Nat)
    . HiddenClockResetEnable dom
-  => KnownDomain dom
-  => 1 <= DomainPeriod dom
-  => DomainPeriod dom <= 5 * 10^11
   => KnownNat (DomainPeriod dom)
+  => 1 <= DomainPeriod dom
+  => DomainPeriod dom <= 10^12
   => 1 <= maxAgeSeconds
-  => 1 <= depth
-  => depth <= 32
-  => SNat depth
-  -- ^ Determines the number of entries in the ARP table, namely @2^depth@.
-  -> SNat maxAgeSeconds
-  -- ^ Entries are no longer valid after this number of seconds, starting at the time of insertion.
+  => SNat maxAgeSeconds
+  -- ^ The ARP entry will expire after this many seconds
   -> Circuit (ArpLookup dom, Df dom ArpEntry) ()
-  -- ^ First of LHS is a MAC lookup request for that IPv4 address.
-  --   Second of LHS is an insertion request.
-arpTable SNat SNat = Circuit (hideReset ckt)
+  -- ^ First of LHS is a MAC address request for the given IPv4 address. Second of LHS is an insertion request
+arpTable SNat = fromSignals ckt
   where
-    ckt reset ((lookupReq, insertReq), ()) = ((arpResponse, outReady), ())
+    ckt ((lookupReq, insertReq), ()) = ((arpResponse, pure (Ack True)), ())
       where
-        -- The underlying blockram.
-        tableEntry = blockRam1 NoClearOnReset (SNat @(2^depth)) (errorX "", 0) readAddr writeCmd
-
-        -- Hashes of the IPv4 addresses, used to address the blockram.
-        -- We simply take the last `depth` bits of the IPv4 address.
-        lookupWithHash :: Signal dom (Maybe (IPv4Address, Unsigned depth))
-        lookupWithHash = fmap (\ipAddr -> (ipAddr, resize $ bitCoerce ipAddr)) <$> lookupReq
-
-        insertionWithHash :: Signal dom (Maybe (ArpEntry, Unsigned depth))
-        insertionWithHash = fmap (\entry -> (entry, resize $ bitCoerce (_arpIP entry))) <$> fmap Df.dataToMaybe insertReq
-
-        readAddr :: Signal dom (Unsigned depth)
-        writeCmd :: Signal dom (Maybe (Unsigned depth, (ArpEntry, Index (maxAgeSeconds + 1))))
-        (outReady, readAddr, writeCmd, arpResponse) =
-          unbundle (mealy arpTableT (Active False) input)
-
-        input = bundle
-          ( unsafeToActiveHigh reset
-          , tableEntry
-          , insertionWithHash
-          , lookupWithHash
-          , secondTimer
-          )
+        arpEntry :: Signal dom (ArpEntry, Index (maxAgeSeconds + 1))
+        arpEntry = register (errorX "empty initial content", 0) writeCommand
+
+        secondTimer = riseEvery (SNat @(10^12 `Div` DomainPeriod dom))
+        writeCommand = fmap go (bundle (insertReq, arpEntry, secondTimer))
+          where
+            go (req, (entry, secondsLeft), secondPassed) = case req of
+              Df.NoData -> (entry, if secondPassed then satPred SatBound secondsLeft else secondsLeft)
+              Df.Data reqEntry -> (reqEntry, maxBound)
+
+        arpResponse = fmap go (bundle (lookupReq, arpEntry))
+          where
+            go (ip, (entry, timeLeft)) = ip >>= \ipAddr ->
+              if timeLeft == 0 || _arpIP entry /= ipAddr
+              then Just ArpEntryNotFound
+              else Just (ArpEntryFound (_arpMac entry))

src/Clash/Cores/Ethernet/Examples/FullUdpStack.hs

@@ -295,7 +295,7 @@ arpIcmpUdpStackC
   -> Signal dom (IPv4Address, IPv4Address)
   -- ^ My IP address and the subnet
   -> Circuit (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)) (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite))
-  -- ^ UDP handler circuit
+  -- ^ Reversed UDP handler circuit
   -> Circuit (PacketStream dom dataWidth EthernetHeader) (PacketStream dom dataWidth EthernetHeader)
 arpIcmpUdpStackC macAddressS ipS udpCkt = circuit $ \ethIn -> do
   [arpEthIn, ipEthIn] <- packetDispatcherC (routeBy _etherType $ 0x0806 :> 0x0800 :> Nil) -< ethIn

src/Clash/Cores/Ethernet/Examples/UdpCoreStack.hs

@@ -0,0 +1,113 @@
+{-# language FlexibleContexts #-}
+{-# language RecordWildCards #-}
+
+module Clash.Cores.Ethernet.Examples.UdpCoreStack where
+
+-- import prelude
+import Clash.Prelude
+
+-- import ethernet
+import Clash.Cores.Ethernet.Arp
+import Clash.Cores.Ethernet.Examples.RxStacks
+import Clash.Cores.Ethernet.Examples.TxStacks
+import Clash.Cores.Ethernet.IP.IPPacketizers
+import Clash.Cores.Ethernet.Mac.EthernetTypes ( EthernetHeader(..), MacAddress(..) )
+
+import Clash.Cores.Ethernet.IP.EthernetStream
+import Clash.Cores.Ethernet.IP.IPv4Types
+
+-- import protocols
+import Protocols
+import Protocols.Extra.PacketStream
+import Protocols.Extra.PacketStream.PacketBuffer ( packetBufferC )
+import Protocols.Extra.PacketStream.Routing
+
+import Clash.Cores.Crc ( HardwareCrc )
+import Clash.Cores.Crc.Catalog ( Crc32_ethernet )
+
+import Clash.Cores.Ethernet.Icmp ( icmpEchoResponderC )
+import Clash.Cores.Ethernet.Udp
+
+-- | Full stack from ethernet to ethernet.
+fullStackC
+  :: forall
+       (dataWidth :: Nat)
+       (dom :: Domain)
+       (domEthRx :: Domain)
+       (domEthTx :: Domain)
+   . KnownDomain dom
+  => KnownDomain domEthRx
+  => KnownDomain domEthTx
+  => HardwareCrc Crc32_ethernet 8 dataWidth
+  => KnownNat dataWidth
+  => 1 <= dataWidth
+  => 1 <= DomainPeriod dom
+  => DomainPeriod dom <= 5 * 10^11
+  => KnownNat (DomainPeriod dom)
+  => HiddenClockResetEnable dom
+  => Clock domEthRx
+  -> Reset domEthRx
+  -> Enable domEthRx
+  -> Clock domEthTx
+  -> Reset domEthTx
+  -> Enable domEthTx
+  -> Signal dom MacAddress
+  -- ^ My mac address
+  -> Signal dom (IPv4Address, IPv4Address)
+  -- ^ Tuple of my IP and subnet mask
+  -- Input tuple is UDP packets to transmit including destination IP and input from Phy
+  -- Output tuple are the incoming UDP packets including the destination IP and output to Phy
+  -> Circuit
+       (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream domEthRx 1 ())
+       (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream domEthTx 1 ())
+fullStackC rxClk rxRst rxEn txClk txRst txEn macS ipS = circuit $ \(udpOut, phyIn) -> do
+  ethIn <- macRxStack @dataWidth rxClk rxRst rxEn macS -< phyIn
+  udpOutBuffered <- packetBufferC d10 d4 -< udpOut
+  (udpIn, ethOut) <- arpIcmpUdpStackC macS ipS -< (udpOutBuffered, ethIn)
+  udpInBuffered <-packetBufferC d10 d4 -< udpIn
+  phyOut <- macTxStack txClk txRst txEn -< ethOut
+  idC -< (udpInBuffered, phyOut)
+
+arpIcmpUdpStackC
+  :: forall (dataWidth :: Nat) (dom :: Domain)
+   . HiddenClockResetEnable dom
+  => KnownNat dataWidth
+  => 1 <= dataWidth
+  => 1 <= DomainPeriod dom
+  => DomainPeriod dom <= 5 * 10^11
+  => KnownNat (DomainPeriod dom)
+  => Signal dom MacAddress
+  -- ^ My MAC Address
+  -> Signal dom (IPv4Address, IPv4Address)
+  -- ^ My IP address and the subnet
+  -> Circuit
+      (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream dom dataWidth EthernetHeader)
+      (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream dom dataWidth EthernetHeader)
+arpIcmpUdpStackC macAddressS ipS = circuit $ \(udpOut, ethIn) -> do
+  [arpEthIn, ipEthIn] <- packetDispatcherC (routeBy _etherType $ 0x0806 :> 0x0800 :> Nil) -< ethIn
+  ipIn <- filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
+  (udpIn, ipOut) <- icmpUdpStackC ipS -< (udpOut, ipIn)
+  (ipEthOut, arpLookup) <- toEthernetStreamC macAddressS <| ipLitePacketizerC -< ipOut
+  arpEthOut <- arpC d300 d2 d6 macAddressS (fst <$> ipS) -< (arpEthIn, arpLookup)
+  ethOut <- packetArbiterC RoundRobin -< [arpEthOut, ipEthOut]
+  idC -< (udpIn, ethOut)
+  where
+    isForMyIp (ip, subnet) (_ipv4lDestination -> to) = to == ip || to == ipv4Broadcast ip subnet
+
+icmpUdpStackC
+  :: forall (dataWidth :: Nat) (dom :: Domain)
+   . HiddenClockResetEnable dom
+  => KnownNat dataWidth
+  => 1 <= dataWidth
+  => Signal dom (IPv4Address, IPv4Address)
+  -- ^ My IP address and the subnet
+  -> Circuit
+      (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream dom dataWidth IPv4HeaderLite)
+      (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite), PacketStream dom dataWidth IPv4HeaderLite)
+icmpUdpStackC ipS = circuit $ \(udpOut, ipIn) -> do
+  [icmpIn, udpIn] <- packetDispatcherC (routeBy _ipv4lProtocol $ 0x0001 :> 0x0011 :> Nil) -< ipIn
+  icmpOut <- icmpEchoResponderC @dom @dataWidth (fst <$> ipS) -< icmpIn
+  udpInParsed <- udpDepacketizerC -< udpIn
+  udpOutParsed <- udpPacketizerC (fst <$> ipS) -< udpOut
+  ipOut <- packetArbiterC RoundRobin -< [icmpOut, udpOutParsed]
+  idC -< (udpInParsed, ipOut)