debug traces, remember to remove later

1 files changed, 19 insertions, 9 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index 4770d4a9..cb308bce 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -31,6 +31,7 @@ import Control.Applicative
 import Data.Word
 import Data.Array.MArray
 import Data.Maybe
+import Debug.Trace
 
 data PacketQueue a = PacketQueue
     { pktq    :: TArray Word32 (Maybe a)
@@ -190,28 +191,37 @@ readyOutGoing (PacketOutQueue {pktoToWireIO }) = pktoToWireIO
 --   used for outgoing messages. (Note that ‘front‛ usually means the higher
 --   index in this implementation.)
 tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM OutGoingResult
-tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg = do
+tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg
+  = trace "(tryAppendQueueOutgoing)" $ do
     be <- readTVar (buffend pktoOutPQ)
     let i = be `mod` (qsize pktoOutPQ)
-    let arrayEmpty ar = do (lowB,highB) <- getBounds ar
-                           return (lowB > highB )
+    let arrayEmpty :: MArray a e m => a Word32 e -> m Bool
+        arrayEmpty ar = do (lowB,highB) <- getBounds ar
+                           let result= lowB > highB
+                           return $ trace ("arrayEmpty result=" ++ show result
+                                        ++ " lowB="    ++ show lowB
+                                        ++ " highB = " ++ show highB
+                                        ++ " i = " ++ show i) result
     mbPkt <- do emp <- arrayEmpty (pktq pktoOutPQ)
-                if emp then return Nothing
-                       else readArray (pktq pktoOutPQ) i
+                if emp then trace "(tryAppendQueueOutgoing empty)"    $ return Nothing
+                       else trace "(tryAppendQueueOutgoing nonempty)" $ do
+                                result <- readArray (pktq pktoOutPQ) i
+                                return $ trace ("readArray (isJust result)=="  ++ show (isJust result)) result
     pktno <- readTVar pktoPacketNo
     nextno <- readTVar (seqno pktoInPQ)
     mbWire <- pktoToWire getExtra nextno be pktno msg
-    case mbWire of
+    case trace "(tryAppendQueueOutgoing mbWire)" mbWire of
         Just (pkt,pktno')
-            -> case mbPkt of
+            -> trace "(tryAppendQueueOutgoing A)"
+             $ case mbPkt of
                     -- slot is free, insert element
-                    Nothing -> do
+                    Nothing -> trace "(tryAppendQueueOutgoing Nothing case)" $ do
                         modifyTVar' (buffend pktoOutPQ) (+1)
                         writeTVar pktoPacketNo $! pktno'
                         writeArray (pktq pktoOutPQ) i (Just (pktno,pkt))
                         return OGSuccess
                     -- queue is full
-                    Just (n,_) -> do
+                    Just (n,_) -> trace "tryAppendQueueOutgoing Just case)" $ do
                         nn <- getHighestHandledPacketPlus1 q
                         if (n < nn)
                           -- but we can overwrite an old packet