64 implement multi entry arp table (#109)

Multi-entry ARP table + fix arpManagerC bug

clash-eth.cabal

@@ -163,7 +163,6 @@ test-suite test-library
   main-is: unittests.hs
   other-modules:
     Test.Cores.Ethernet.Arp.ArpManager
-    Test.Cores.Ethernet.Arp.ArpTable
     Test.Cores.Ethernet.IP.EthernetStream
     Test.Cores.Ethernet.IP.InternetChecksum
     Test.Cores.Ethernet.IP.IPPacketizers

src/Clash/Cores/Ethernet/Arp.hs

@@ -42,6 +42,7 @@ arpC
      (maxAgeSeconds :: Nat)
      (maxWaitSeconds :: Nat)
      (dataWidth :: Nat)
+     (tableDepth :: Nat)
    . HiddenClockResetEnable dom
   => KnownNat dataWidth
   => KnownNat (DomainPeriod dom)
@@ -50,23 +51,27 @@ arpC
   => 1 <= maxAgeSeconds
   => 1 <= maxWaitSeconds
   => 1 <= dataWidth
+  => 1 <= tableDepth
+  => tableDepth <= 32
   => SNat maxAgeSeconds
   -- ^ ARP entries will expire after this many seconds
   -> SNat maxWaitSeconds
   -- ^ The maximum amount of seconds we wait for an incoming ARP reply
   --   if the lookup IPv4 address was not found in our ARP table
+  -> SNat tableDepth
+  -- ^ The ARP table will contain @2^tableDepth@ entries
   -> Signal dom MacAddress
   -- ^ Our MAC address
   -> Signal dom IPv4Address
   -- ^ Our IPv4 address
   -> Circuit (PacketStream dom dataWidth EthernetHeader, ArpLookup dom)
              (PacketStream dom dataWidth EthernetHeader)
-arpC maxAge maxWait ourMacS ourIPv4S =
+arpC maxAge maxWait tableDepth ourMacS ourIPv4S =
   -- TODO waiting for an ARP reply in seconds is too coarse.
   -- Make this timer less coarse, e.g. milliseconds
   circuit $ \(ethStream, lookupIn) -> do
     (entry, replyOut) <- arpReceiverC ourIPv4S -< ethStream
     (lookupOut, requestOut) <- arpManagerC maxWait -< lookupIn
-    () <- arpTable maxAge -< (lookupOut, entry)
+    () <- arpTable tableDepth maxAge -< (lookupOut, entry)
     arpPktOut <- Df.roundrobinCollect Df.Skip -< [replyOut, requestOut]
     arpTransmitterC ourMacS ourIPv4S -< arpPktOut

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

@@ -1,4 +1,3 @@
-{-# language BlockArguments #-}
 {-# language FlexibleContexts #-}
 {-# language RecordWildCards #-}
 
@@ -28,8 +27,13 @@ import Clash.Cores.Ethernet.Mac.EthernetTypes
 
 -- | State of the ARP manager.
 data ArpManagerState maxWaitSeconds
-  = AwaitLookup
+  = AwaitLookup {
+    -- | Whether we need to keep driving the same ARP request to the transmitter,
+    --   because it asserted backpressure.
+    _awaitTransmission :: Bool
+  }
   | AwaitArpReply {
+    -- | The maximum number of seconds to keep waiting for an ARP reply.
     _secondsLeft :: Index (maxWaitSeconds + 1)
   } deriving (Generic, NFDataX, Show, ShowX)
 
@@ -44,24 +48,24 @@ arpManagerT
      , (Maybe ArpResponse, (Maybe IPv4Address, Df.Data ArpLite)))
 -- User issues a lookup request. We don't have a timeout, because the ARP table should
 -- always respond within a reasonable time frame. If not, there is a bug in the ARP table.
-arpManagerT AwaitLookup (Just lookupIPv4, arpResponseIn, Ack readyIn, _) =
+arpManagerT AwaitLookup{..} (Just lookupIPv4, arpResponseIn, Ack readyIn, _) =
   (nextSt, (arpResponseOut, (Just lookupIPv4, arpRequestOut)))
     where
       (arpResponseOut, arpRequestOut, nextSt) = case arpResponseIn of
         Nothing
           -> ( Nothing
-             , Df.NoData
-             , AwaitLookup
+             , if _awaitTransmission then Df.Data (ArpLite broadcastMac lookupIPv4 True) else Df.NoData
+             , if readyIn && _awaitTransmission then AwaitArpReply maxBound else AwaitLookup False
              )
         Just ArpEntryNotFound
           -> ( Nothing
              , Df.Data (ArpLite broadcastMac lookupIPv4 True)
-             , if readyIn then AwaitArpReply maxBound else AwaitLookup
+             , if readyIn then AwaitArpReply maxBound else AwaitLookup True
              )
         Just (ArpEntryFound _)
           -> ( arpResponseIn
              , Df.NoData
-             , AwaitLookup
+             , AwaitLookup False
              )
 
 -- We don't care about incoming backpressure, because we do not send ARP requests in this state.
@@ -75,9 +79,9 @@ arpManagerT AwaitArpReply{..} (Just lookupIPv4, arpResponseIn, _, secondPassed)
       (arpResponseOut, nextSt) =
         case (arpResponseIn, _secondsLeft == 0) of
           (Just (ArpEntryFound _), _)
-            -> (arpResponseIn, AwaitLookup)
+            -> (arpResponseIn, AwaitLookup False)
           (Just ArpEntryNotFound, True)
-            -> (arpResponseIn, AwaitLookup)
+            -> (arpResponseIn, AwaitLookup False)
           -- Note that we keep driving the same lookup request when the ARP table has not acknowledged
           -- our request yet, even if the time is up. If we don't, we violate protocol invariants.
           -- Therefore timer can be slightly inaccurate, depending on the latency of the ARP table.
@@ -108,7 +112,7 @@ arpManagerC SNat = fromSignals ckt
     ckt (lookupIPv4S, (arpResponseInS, ackInS)) = (bwdOut, unbundle fwdOut)
       where
         (bwdOut, fwdOut) =
-          mealyB arpManagerT (AwaitLookup @maxWaitSeconds) (lookupIPv4S, arpResponseInS, ackInS, secondTimer)
+          mealyB arpManagerT (AwaitLookup @maxWaitSeconds False) (lookupIPv4S, arpResponseInS, ackInS, secondTimer)
 
 -- | Transmits ARP packets upon request.
 arpTransmitterC

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

@@ -1,55 +1,152 @@
-{-# language FlexibleContexts #-}
-
 {-|
-Module      : Clash.Cores.Ethernet.Arp.ArpTable
-Description : Provides an ARP table which is able to hold one ARP entry.
+Module      : Clash.Cores.Arp.ArpTable
+Description : Provides a highly configurable ARP table.
 -}
+
+{-# language FlexibleContexts #-}
+{-# language RecordWildCards #-}
+
 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
 
--- | 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.
+      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.
 arpTable
   :: forall
-    (dom :: Domain)
-    (maxAgeSeconds :: Nat)
+     (dom :: Domain)
+     (depth :: Nat)
+     (maxAgeSeconds :: Nat)
    . HiddenClockResetEnable dom
-  => KnownNat (DomainPeriod dom)
+  => KnownDomain dom
   => 1 <= DomainPeriod dom
-  => DomainPeriod dom <= 10^12
+  => DomainPeriod dom <= 5 * 10^11
+  => KnownNat (DomainPeriod dom)
   => 1 <= maxAgeSeconds
-  => SNat maxAgeSeconds
-  -- ^ The ARP entry will expire after this many seconds
+  => 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.
   -> Circuit (ArpLookup dom, Df dom ArpEntry) ()
-  -- ^ First of LHS is a MAC address request for the given IPv4 address. Second of LHS is an insertion request
-arpTable SNat = fromSignals ckt
+  -- ^ 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)
   where
-    ckt ((lookupReq, insertReq), ()) = ((arpResponse, pure (Ack True)), ())
+    ckt reset ((lookupReq, insertReq), ()) = ((arpResponse, outReady), ())
       where
-        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))
+        -- 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
+          )

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

@@ -59,6 +59,6 @@ arpStackC rxClk rxRst rxEn txClk txRst txEn ourMacS ourIPv4S =
     ethStream <- macRxStack @4 rxClk rxRst rxEn ourMacS -< stream
     [arpStream] <- packetDispatcherC (singleton $ \hdr -> _etherType hdr == arpEtherType) -< ethStream
     lookupIn <- constArpLookup -< ()
-    arpOtp <- arpC d10 d5 ourMacS ourIPv4S -< (arpStream, lookupIn)
+    arpOtp <- arpC d300 d2 d6 ourMacS ourIPv4S -< (arpStream, lookupIn)
     ethOtp <- packetArbiterC RoundRobin -< [arpOtp]
     macTxStack txClk txRst txEn -< ethOtp

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

@@ -301,7 +301,7 @@ arpIcmpUdpStackC macAddressS ipS udpCkt = circuit $ \ethIn -> do
   [arpEthIn, ipEthIn] <- packetDispatcherC (routeBy _etherType $ 0x0806 :> 0x0800 :> Nil) -< ethIn
   ipTx <- ipLitePacketizerC <| packetBufferC d10 d4 <| icmpUdpStack <| packetBufferC d10 d4 <| filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
   (ipEthOut, arpLookup) <- toEthernetStreamC macAddressS -< ipTx
-  arpEthOut <- arpC d10 d5 macAddressS (fst <$> ipS) -< (arpEthIn, arpLookup)
+  arpEthOut <- arpC d300 d2 d6 macAddressS (fst <$> ipS) -< (arpEthIn, arpLookup)
   packetArbiterC RoundRobin -< [arpEthOut, ipEthOut]
 
   where