diff options
Diffstat (limited to 'src/Data/PacketQueue.hs')
-rw-r--r-- | src/Data/PacketQueue.hs | 21 |
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 | |||
20 | { pktq :: TArray Word32 (Maybe a) | 20 | { pktq :: TArray Word32 (Maybe a) |
21 | , seqno :: TVar Word32 | 21 | , seqno :: TVar Word32 |
22 | , qsize :: Word32 | 22 | , qsize :: Word32 |
23 | , buffend :: TVar Word32 | ||
23 | } | 24 | } |
24 | 25 | ||
25 | -- | Create a new PacketQueue. | 26 | -- | Create a new PacketQueue. |
@@ -30,12 +31,23 @@ new capacity seqstart = do | |||
30 | let cap = if capacity `mod` 2 == 0 then capacity else capacity + 1 | 31 | let cap = if capacity `mod` 2 == 0 then capacity else capacity + 1 |
31 | q <- newArray (0,cap - 1) Nothing | 32 | q <- newArray (0,cap - 1) Nothing |
32 | seqv <- newTVar seqstart | 33 | seqv <- newTVar seqstart |
34 | bufe <- newTVar 0 | ||
33 | return PacketQueue | 35 | return PacketQueue |
34 | { pktq = q | 36 | { pktq = q |
35 | , seqno = seqv | 37 | , seqno = seqv |
36 | , qsize = cap | 38 | , qsize = cap |
39 | , buffend = bufe | ||
37 | } | 40 | } |
38 | 41 | ||
42 | observeOutOfBand :: PacketQueue a -> Word32-> STM () | ||
43 | observeOutOfBand PacketQueue { seqno, qsize, buffend } no = do | ||
44 | low <- readTVar seqno | ||
45 | let proj = no - low | ||
46 | -- Ignore packet if out of range. | ||
47 | when ( proj < qsize) $ do | ||
48 | modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be) | ||
49 | |||
50 | |||
39 | -- | Retry until the next expected packet is enqueued. Then return it. | 51 | -- | Retry until the next expected packet is enqueued. Then return it. |
40 | dequeue :: PacketQueue a -> STM a | 52 | dequeue :: PacketQueue a -> STM a |
41 | dequeue PacketQueue { pktq, seqno, qsize } = do | 53 | dequeue PacketQueue { pktq, seqno, qsize } = do |
@@ -53,13 +65,14 @@ enqueue :: PacketQueue a -- ^ The packet queue. | |||
53 | -> Word32 -- ^ Sequence number of the packet. | 65 | -> Word32 -- ^ Sequence number of the packet. |
54 | -> a -- ^ The packet. | 66 | -> a -- ^ The packet. |
55 | -> STM () | 67 | -> STM () |
56 | enqueue PacketQueue{ pktq, seqno, qsize } no x = do | 68 | enqueue PacketQueue{ pktq, seqno, qsize, buffend } no x = do |
57 | low <- readTVar seqno | 69 | low <- readTVar seqno |
58 | let proj = no - low | 70 | let proj = no - low |
59 | -- Ignore packet if out of range. | 71 | -- Ignore packet if out of range. |
60 | when ( proj < qsize) $ do | 72 | when ( proj < qsize) $ do |
61 | let i = no `mod` qsize | 73 | let i = no `mod` qsize |
62 | writeArray pktq i (Just x) | 74 | writeArray pktq i (Just x) |
75 | modifyTVar' buffend (\be -> if be - low <= proj then no + 1 else be) | ||
63 | 76 | ||
64 | -- lookup :: PacketQueue a -> Word32 -> STM (Maybe a) | 77 | -- lookup :: PacketQueue a -> Word32 -> STM (Maybe a) |
65 | -- lookup PacketQueue{ pktq, seqno, qsize } no = _todo | 78 | -- lookup PacketQueue{ pktq, seqno, qsize } no = _todo |