41a2ab498fe3418899e5af3c17293053b3c4a462
[ghc.git] / libraries / ghci / GHCi / BreakArray.hs
1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
2 {-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
3
4 -------------------------------------------------------------------------------
5 --
6 -- (c) The University of Glasgow 2007
7 --
8 -- | Break Arrays
9 --
10 -- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)
11 -- There is one of these arrays per module.
12 --
13 -- Each byte is
14 -- 1 if the corresponding breakpoint is enabled
15 -- 0 otherwise
16 --
17 -------------------------------------------------------------------------------
18
19 module GHCi.BreakArray
20 (
21 BreakArray
22 #if defined(HAVE_INTERPRETER)
23 (BA) -- constructor is exported only for ByteCodeGen
24 , newBreakArray
25 , getBreak
26 , setBreakOn
27 , setBreakOff
28 , showBreakArray
29 #endif
30 ) where
31
32 #if defined(HAVE_INTERPRETER)
33 import Prelude -- See note [Why do we import Prelude here?]
34 import Control.Monad
35 import Data.Word
36 import GHC.Word
37
38 import GHC.Exts
39 import GHC.IO ( IO(..) )
40 import System.IO.Unsafe ( unsafeDupablePerformIO )
41
42 data BreakArray = BA (MutableByteArray# RealWorld)
43
44 breakOff, breakOn :: Word8
45 breakOn = 1
46 breakOff = 0
47
48 showBreakArray :: BreakArray -> IO ()
49 showBreakArray array = do
50 forM_ [0 .. (size array - 1)] $ \i -> do
51 val <- readBreakArray array i
52 putStr $ ' ' : show val
53 putStr "\n"
54
55 setBreakOn :: BreakArray -> Int -> IO Bool
56 setBreakOn array index
57 | safeIndex array index = do
58 writeBreakArray array index breakOn
59 return True
60 | otherwise = return False
61
62 setBreakOff :: BreakArray -> Int -> IO Bool
63 setBreakOff array index
64 | safeIndex array index = do
65 writeBreakArray array index breakOff
66 return True
67 | otherwise = return False
68
69 getBreak :: BreakArray -> Int -> IO (Maybe Word8)
70 getBreak array index
71 | safeIndex array index = do
72 val <- readBreakArray array index
73 return $ Just val
74 | otherwise = return Nothing
75
76 safeIndex :: BreakArray -> Int -> Bool
77 safeIndex array index = index < size array && index >= 0
78
79 size :: BreakArray -> Int
80 size (BA array) = size
81 where
82 -- We want to keep this operation pure. The mutable byte array
83 -- is never resized so this is safe.
84 size = unsafeDupablePerformIO $ sizeofMutableByteArray array
85
86 sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
87 sizeofMutableByteArray arr =
88 IO $ \s -> case getSizeofMutableByteArray# arr s of
89 (# s', n# #) -> (# s', I# n# #)
90
91 allocBA :: Int -> IO BreakArray
92 allocBA (I# sz) = IO $ \s1 ->
93 case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
94
95 -- create a new break array and initialise elements to zero
96 newBreakArray :: Int -> IO BreakArray
97 newBreakArray entries@(I# sz) = do
98 BA array <- allocBA entries
99 case breakOff of
100 W8# off -> do
101 let loop n | isTrue# (n ==# sz) = return ()
102 | otherwise = do writeBA# array n off; loop (n +# 1#)
103 loop 0#
104 return $ BA array
105
106 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
107 writeBA# array i word = IO $ \s ->
108 case writeWord8Array# array i word s of { s -> (# s, () #) }
109
110 writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
111 writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
112
113 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
114 readBA# array i = IO $ \s ->
115 case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
116
117 readBreakArray :: BreakArray -> Int -> IO Word8
118 readBreakArray (BA array) (I# i) = readBA# array i
119 #else
120 data BreakArray
121 #endif