summaryrefslogtreecommitdiff
path: root/libraries/ghci/GHCi/BreakArray.hs
blob: 05d13bda67610915e8ad5fe1bbe4e6ac01c9c837 (plain)
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
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# 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 GHCi.BreakArray
    (
      BreakArray
          (BA) -- constructor is exported only for GHC.CoreToByteCode
    , newBreakArray
    , getBreak
    , setBreakOn
    , setBreakOff
    , showBreakArray
    ) where

import Prelude -- See note [Why do we import Prelude here?]
import Control.Monad
import Data.Word
import GHC.Word

import GHC.Exts hiding (extendWord8#, narrowWord8#)
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )

#if MIN_VERSION_base(4,16,0)
import GHC.Base (extendWord8#, narrowWord8#)
#else
narrowWord8#, extendWord8# :: Word# -> Word#
narrowWord8# w = w
extendWord8# w = w
{-# INLINE narrowWord8# #-}
{-# INLINE extendWord8# #-}
#endif

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 (extendWord8# 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 (extendWord8# word)

readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
readBA# array i = IO $ \s ->
    case readWord8Array# array i s of { (# s, c #) -> (# s, W8# (narrowWord8# c) #) }

readBreakArray :: BreakArray -> Int -> IO Word8
readBreakArray (BA array) (I# i) = readBA# array i