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