{-# 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
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )

data BreakArray = BA (MutableByteArray# RealWorld)

breakOff, breakOn :: Word8
breakOn :: Word8
breakOn  = Word8
1
breakOff :: Word8
breakOff = Word8
0

showBreakArray :: BreakArray -> IO ()
showBreakArray :: BreakArray -> IO ()
showBreakArray BreakArray
array = do
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. (BreakArray -> Int
size BreakArray
array Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Word8
val <- BreakArray -> Int -> IO Word8
readBreakArray BreakArray
array Int
i
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> String
forall a. Show a => a -> String
show Word8
val
    String -> IO ()
putStr String
"\n"

setBreakOn :: BreakArray -> Int -> IO Bool
setBreakOn :: BreakArray -> Int -> IO Bool
setBreakOn BreakArray
array Int
index
    | BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = do
          BreakArray -> Int -> Word8 -> IO ()
writeBreakArray BreakArray
array Int
index Word8
breakOn
          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Bool
otherwise = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

setBreakOff :: BreakArray -> Int -> IO Bool
setBreakOff :: BreakArray -> Int -> IO Bool
setBreakOff BreakArray
array Int
index
    | BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = do
          BreakArray -> Int -> Word8 -> IO ()
writeBreakArray BreakArray
array Int
index Word8
breakOff
          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Bool
otherwise = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

getBreak :: BreakArray -> Int -> IO (Maybe Word8)
getBreak :: BreakArray -> Int -> IO (Maybe Word8)
getBreak BreakArray
array Int
index
    | BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = do
          Word8
val <- BreakArray -> Int -> IO Word8
readBreakArray BreakArray
array Int
index
          Maybe Word8 -> IO (Maybe Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word8 -> IO (Maybe Word8))
-> Maybe Word8 -> IO (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
val
    | Bool
otherwise = Maybe Word8 -> IO (Maybe Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word8
forall a. Maybe a
Nothing

safeIndex :: BreakArray -> Int -> Bool
safeIndex :: BreakArray -> Int -> Bool
safeIndex BreakArray
array Int
index = Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< BreakArray -> Int
size BreakArray
array Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

size :: BreakArray -> Int
size :: BreakArray -> Int
size (BA MutableByteArray# RealWorld
array) = Int
size
  where
    -- We want to keep this operation pure. The mutable byte array
    -- is never resized so this is safe.
    size :: Int
size = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray MutableByteArray# RealWorld
array

    sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
    sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int
sizeofMutableByteArray MutableByteArray# RealWorld
arr =
        (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# RealWorld
arr State# RealWorld
s of
                       (# State# RealWorld
s', Int#
n# #) -> (# State# RealWorld
s', Int# -> Int
I# Int#
n# #)

allocBA :: Int -> IO BreakArray
allocBA :: Int -> IO BreakArray
allocBA (I# Int#
sz) = (State# RealWorld -> (# State# RealWorld, BreakArray #))
-> IO BreakArray
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, BreakArray #))
 -> IO BreakArray)
-> (State# RealWorld -> (# State# RealWorld, BreakArray #))
-> IO BreakArray
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
    case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
sz State# RealWorld
s1 of { (# State# RealWorld
s2, MutableByteArray# RealWorld
array #) -> (# State# RealWorld
s2, MutableByteArray# RealWorld -> BreakArray
BA MutableByteArray# RealWorld
array #) }

-- create a new break array and initialise elements to zero
newBreakArray :: Int -> IO BreakArray
newBreakArray :: Int -> IO BreakArray
newBreakArray entries :: Int
entries@(I# Int#
sz) = do
    BA MutableByteArray# RealWorld
array <- Int -> IO BreakArray
allocBA Int
entries
    case Word8
breakOff of
        W8# Word#
off -> do
           let loop :: Int# -> IO ()
loop Int#
n | Int# -> Bool
isTrue# (Int#
n Int# -> Int# -> Int#
==# Int#
sz) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      | Bool
otherwise = do MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
n Word#
off; Int# -> IO ()
loop (Int#
n Int# -> Int# -> Int#
+# Int#
1#)
           Int# -> IO ()
loop Int#
0#
    BreakArray -> IO BreakArray
forall (m :: * -> *) a. Monad m => a -> m a
return (BreakArray -> IO BreakArray) -> BreakArray -> IO BreakArray
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> BreakArray
BA MutableByteArray# RealWorld
array

writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
i Word#
word = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# RealWorld
array Int#
i Word#
word State# RealWorld
s of { State# RealWorld
s -> (# State# RealWorld
s, () #) }

writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
writeBreakArray (BA MutableByteArray# RealWorld
array) (I# Int#
i) (W8# Word#
word) = MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
i Word#
word

readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
readBA# MutableByteArray# RealWorld
array Int#
i = (State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8)
-> (State# RealWorld -> (# State# RealWorld, Word8 #)) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# RealWorld
array Int#
i State# RealWorld
s of { (# State# RealWorld
s, Word#
c #) -> (# State# RealWorld
s, Word# -> Word8
W8# Word#
c #) }

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