summaryrefslogtreecommitdiff
path: root/compiler/main/BreakArray.hs
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2007-04-17 14:24:58 +0000
committerSimon Marlow <simonmar@microsoft.com>2007-04-17 14:24:58 +0000
commitcdce647711c0f46f5799b24de087622cb77e647f (patch)
treead89c87c0ac9afba4338346a01eb5492b47f3e20 /compiler/main/BreakArray.hs
parentdc8ffcb9797ade3e3a68e6ec0a89fe2e7444e0ef (diff)
downloadhaskell-cdce647711c0f46f5799b24de087622cb77e647f.tar.gz
Re-working of the breakpoint support
This is the result of Bernie Pope's internship work at MSR Cambridge, with some subsequent improvements by me. The main plan was to (a) Reduce the overhead for breakpoints, so we could enable the feature by default without incurrent a significant penalty (b) Scatter more breakpoint sites throughout the code Currently we can set a breakpoint on almost any subexpression, and the overhead is around 1.5x slower than normal GHCi. I hope to be able to get this down further and/or allow breakpoints to be turned off. This patch also fixes up :print following the recent changes to constructor info tables. (most of the :print tests now pass) We now support single-stepping, which just enables all breakpoints. :step <expr> executes <expr> with single-stepping turned on :step single-steps from the current breakpoint The mechanism is quite different to the previous implementation. We share code with the HPC (haskell program coverage) implementation now. The coverage pass annotates source code with "tick" locations which are tracked by the coverage tool. In GHCi, each "tick" becomes a potential breakpoint location. Previously breakpoints were compiled into code that magically invoked a nested instance of GHCi. Now, a breakpoint causes the current thread to block and control is returned to GHCi. See the wiki page for more details and the current ToDo list: http://hackage.haskell.org/trac/ghc/wiki/NewGhciDebugger
Diffstat (limited to 'compiler/main/BreakArray.hs')
-rw-r--r--compiler/main/BreakArray.hs96
1 files changed, 96 insertions, 0 deletions
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
new file mode 100644
index 0000000000..788adf200c
--- /dev/null
+++ b/compiler/main/BreakArray.hs
@@ -0,0 +1,96 @@
+--
+-- Break Arrays in the IO monad
+-- Entries in the array are Word sized
+--
+
+module BreakArray
+ ( BreakArray (BA)
+ , newBreakArray
+ , getBreak
+ , setBreakOn
+ , setBreakOff
+ , showBreakArray
+ ) where
+
+import GHC.Exts
+import GHC.IOBase
+import GHC.Prim
+import GHC.Word
+import Constants
+
+data BreakArray = BA (MutableByteArray# RealWorld)
+
+breakOff, breakOn :: Word
+breakOn = fromIntegral 1
+breakOff = fromIntegral 0
+
+-- XXX crude
+showBreakArray :: BreakArray -> IO ()
+showBreakArray array = do
+ let loop count sz
+ | count == sz = return ()
+ | otherwise = do
+ val <- readBreakArray array count
+ putStr $ " " ++ show val
+ loop (count + 1) sz
+ loop 0 (size array)
+ putStr "\n"
+
+setBreakOn :: BreakArray -> Int -> IO Bool
+setBreakOn array index
+ | safeIndex array index = do
+ writeBreakArray array index breakOn
+ return True
+ | otherwise = return False
+
+setBreakOff :: BreakArray -> Int -> IO Bool
+setBreakOff array index
+ | safeIndex array index = do
+ writeBreakArray array index breakOff
+ return True
+ | otherwise = return False
+
+getBreak :: BreakArray -> Int -> IO (Maybe Word)
+getBreak array index
+ | safeIndex array index = do
+ val <- readBreakArray array index
+ return $ Just val
+ | otherwise = return Nothing
+
+safeIndex :: BreakArray -> Int -> Bool
+safeIndex array index = index < size array && index >= 0
+
+size :: BreakArray -> Int
+size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
+
+allocBA :: Int -> IO BreakArray
+allocBA (I# sz) = IO $ \s1 ->
+ case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
+
+-- create a new break array and initialise elements to zero
+newBreakArray :: Int -> IO BreakArray
+newBreakArray entries@(I# sz) = do
+ BA array <- allocBA (entries * wORD_SIZE)
+ case breakOff of
+ W# off -> do -- Todo: there must be a better way to write zero as a Word!
+ let loop n
+ | n ==# sz = return ()
+ | otherwise = do
+ writeBA# array n off
+ loop (n +# 1#)
+ loop 0#
+ return $ BA array
+
+writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
+writeBA# array i word = IO $ \s ->
+ case writeWordArray# array i word s of { s -> (# s, () #) }
+
+writeBreakArray :: BreakArray -> Int -> Word -> IO ()
+writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
+
+readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
+readBA# array i = IO $ \s ->
+ case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
+
+readBreakArray :: BreakArray -> Int -> IO Word
+readBreakArray (BA array) (I# i) = readBA# array i