4d3145fb3aeb1961e46e678494da33511c9e05b8
[ghc.git] / compiler / main / BreakArray.hs
1 -------------------------------------------------------------------------------
2 --
3 -- | Break Arrays in the IO monad
4 --
5 -- Entries in the array are Word sized Conceptually, a zero-indexed IOArray of
6 -- Bools, initially False. They're represented as Words with 0==False, 1==True.
7 -- They're used to determine whether GHCI breakpoints are on or off.
8 --
9 -- (c) The University of Glasgow 2007
10 --
11 -------------------------------------------------------------------------------
12
13 module BreakArray
14 (
15 BreakArray
16 #ifdef GHCI
17 (BA) -- constructor is exported only for ByteCodeGen
18 #endif
19 , newBreakArray
20 #ifdef GHCI
21 , getBreak
22 , setBreakOn
23 , setBreakOff
24 , showBreakArray
25 #endif
26 ) where
27
28 import DynFlags
29
30 #ifdef GHCI
31 import Control.Monad
32
33 import GHC.Exts
34 import GHC.IO ( IO(..) )
35
36 data BreakArray = BA (MutableByteArray# RealWorld)
37
38 breakOff, breakOn :: Word
39 breakOn = 1
40 breakOff = 0
41
42 showBreakArray :: DynFlags -> BreakArray -> IO ()
43 showBreakArray dflags array = do
44 forM_ [0 .. (size dflags array - 1)] $ \i -> do
45 val <- readBreakArray array i
46 putStr $ ' ' : show val
47 putStr "\n"
48
49 setBreakOn :: DynFlags -> BreakArray -> Int -> IO Bool
50 setBreakOn dflags array index
51 | safeIndex dflags array index = do
52 writeBreakArray array index breakOn
53 return True
54 | otherwise = return False
55
56 setBreakOff :: DynFlags -> BreakArray -> Int -> IO Bool
57 setBreakOff dflags array index
58 | safeIndex dflags array index = do
59 writeBreakArray array index breakOff
60 return True
61 | otherwise = return False
62
63 getBreak :: DynFlags -> BreakArray -> Int -> IO (Maybe Word)
64 getBreak dflags array index
65 | safeIndex dflags array index = do
66 val <- readBreakArray array index
67 return $ Just val
68 | otherwise = return Nothing
69
70 safeIndex :: DynFlags -> BreakArray -> Int -> Bool
71 safeIndex dflags array index = index < size dflags array && index >= 0
72
73 size :: DynFlags -> BreakArray -> Int
74 size dflags (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE dflags
75
76 allocBA :: Int -> IO BreakArray
77 allocBA (I# sz) = IO $ \s1 ->
78 case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
79
80 -- create a new break array and initialise elements to zero
81 newBreakArray :: DynFlags -> Int -> IO BreakArray
82 newBreakArray dflags entries@(I# sz) = do
83 BA array <- allocBA (entries * wORD_SIZE dflags)
84 case breakOff of
85 W# off -> do -- Todo: there must be a better way to write zero as a Word!
86 let loop n | n ==# sz = return ()
87 | otherwise = do
88 writeBA# array n off
89 loop (n +# 1#)
90 loop 0#
91 return $ BA array
92
93 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
94 writeBA# array i word = IO $ \s ->
95 case writeWordArray# array i word s of { s -> (# s, () #) }
96
97 writeBreakArray :: BreakArray -> Int -> Word -> IO ()
98 writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
99
100 readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
101 readBA# array i = IO $ \s ->
102 case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
103
104 readBreakArray :: BreakArray -> Int -> IO Word
105 readBreakArray (BA array) (I# i) = readBA# array i
106
107 #else /* !GHCI */
108
109 -- stub implementation to make main/, etc., code happier.
110 -- IOArray and IOUArray are increasingly non-portable,
111 -- still don't have quite the same interface, and (for GHCI)
112 -- presumably have a different representation.
113 data BreakArray = Unspecified
114
115 newBreakArray :: DynFlags -> Int -> IO BreakArray
116 newBreakArray _ _ = return Unspecified
117
118 #endif /* GHCI */
119