Lossy packet interface for PacketQueue.

1 files changed, 17 insertions, 4 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index a617d502..66cf3383 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -20,6 +20,7 @@ data PacketQueue a = PacketQueue
     { pktq    :: TArray Word32 (Maybe a)
     , seqno   :: TVar Word32
     , qsize   :: Word32
+    , buffend :: TVar Word32
     }
 
 -- | Create a new PacketQueue.
@@ -30,12 +31,23 @@ new capacity seqstart = do
     let cap = if capacity `mod` 2 == 0 then capacity else capacity + 1
     q <- newArray (0,cap - 1) Nothing
     seqv <- newTVar seqstart
+    bufe <- newTVar 0
     return PacketQueue
-        { pktq   = q
-        , seqno  = seqv
-        , qsize  = cap
+        { pktq    = q
+        , seqno   = seqv
+        , qsize   = cap
+        , buffend = bufe
         }
 
+observeOutOfBand :: PacketQueue a -> Word32-> STM ()
+observeOutOfBand PacketQueue { seqno, qsize, buffend } no = do
+    low <- readTVar seqno
+    let proj = no - low
+    -- Ignore packet if out of range.
+    when ( proj < qsize) $ do
+    modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be)
+
+
 -- | Retry until the next expected packet is enqueued.  Then return it.
 dequeue :: PacketQueue a -> STM a
 dequeue PacketQueue { pktq, seqno, qsize } = do
@@ -53,13 +65,14 @@ enqueue :: PacketQueue a -- ^ The packet queue.
         -> Word32        -- ^ Sequence number of the packet.
         -> a             -- ^ The packet.
         -> STM ()
-enqueue PacketQueue{ pktq, seqno, qsize } no x = do
+enqueue PacketQueue{ pktq, seqno, qsize, buffend } no x = do
     low <- readTVar seqno
     let proj = no - low
     -- Ignore packet if out of range.
     when ( proj < qsize) $ do
     let i = no `mod` qsize
     writeArray pktq i (Just x)
+    modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be)
 
 -- lookup :: PacketQueue a -> Word32 -> STM (Maybe a)
 -- lookup PacketQueue{ pktq, seqno, qsize } no = _todo