From 01db8c87be13d4f1cbb2b60ecfa534301078df9f Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 13 Nov 2017 07:21:18 -0500 Subject: Lossy packet interface for PacketQueue. --- src/Data/PacketQueue.hs | 21 +++++++++++++++++---- 1 file 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 -- cgit v1.2.3