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
132
|
{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
-------------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2007
--
-- | Break Arrays
--
-- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)
-- There is one of these arrays per module.
--
-- Each byte is
-- 1 if the corresponding breakpoint is enabled
-- 0 otherwise
--
-------------------------------------------------------------------------------
module BreakArray
(
BreakArray
#ifdef GHCI
(BA) -- constructor is exported only for ByteCodeGen
#endif
, newBreakArray
#ifdef GHCI
, getBreak
, setBreakOn
, setBreakOff
, showBreakArray
#endif
) where
#ifdef GHCI
import Control.Monad
import Data.Word
import GHC.Word
import GHC.Exts
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )
data BreakArray = BA (MutableByteArray# RealWorld)
breakOff, breakOn :: Word8
breakOn = 1
breakOff = 0
showBreakArray :: BreakArray -> IO ()
showBreakArray array = do
forM_ [0 .. (size array - 1)] $ \i -> do
val <- readBreakArray array i
putStr $ ' ' : show val
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 Word8)
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) = size
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 :: Int -> IO BreakArray
newBreakArray entries@(I# sz) = do
BA array <- allocBA entries
case breakOff of
W8# off -> do
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 writeWord8Array# array i word s of { s -> (# s, () #) }
writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
readBA# array i = IO $ \s ->
case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
readBreakArray :: BreakArray -> Int -> IO Word8
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 :: Int -> IO BreakArray
newBreakArray _ = return Unspecified
#endif /* GHCI */
|
