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
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
-------------------------------------------------------------------------------
--
-- | 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 GHC.Exts
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )
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) = size `div` wORD_SIZE dflags
where
-- We want to keep this operation pure. The mutable byte array
-- is never resized so this is safe.
size = unsafeDupablePerformIO $ sizeofMutableByteArray array
sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray arr =
IO $ \s -> case getSizeofMutableByteArray# arr s of
(# s', n# #) -> (# s', I# n# #)
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 | isTrue# (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 */
|
