{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

-------------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2007
--
-- | Break Arrays
--
-- An array of words, indexed by a breakpoint number (breakpointId in Tickish)
-- containing the ignore count for every breakpopint.
-- There is one of these arrays per module.
--
-- For each word with value n:
--   n > 1  : the corresponding breakpoint is enabled. Next time the bp is hit,
--            GHCi will decrement the ignore count and continue processing.
--   n == 0 : The breakpoint is enabled, GHCi will stop next time it hits
--            this breakpoint.
--   n == -1: This breakpoint is disabled.
--   n < -1 : Not used.
--
-------------------------------------------------------------------------------

module GHCi.BreakArray
    (
      BreakArray
          (BA) -- constructor is exported only for GHC.StgToByteCode
    , newBreakArray
    , getBreak
    , setupBreakpoint
    , breakOn
    , breakOff
    , showBreakArray
    ) where

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

import GHC.Exts
import GHC.IO ( IO(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )

#include "MachDeps.h"

data BreakArray = BA (MutableByteArray# RealWorld)

breakOff, breakOn :: Int
breakOn :: Int
breakOn  = Int
0
breakOff :: Int
breakOff = -Int
1

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

setupBreakpoint :: BreakArray -> Int -> Int -> IO Bool
setupBreakpoint :: BreakArray -> Int -> Int -> IO Bool
setupBreakpoint BreakArray
breakArray Int
ind Int
val
    | BreakArray -> Int -> Bool
safeIndex BreakArray
breakArray Int
ind = do
        BreakArray -> Int -> Int -> IO ()
writeBreakArray BreakArray
breakArray Int
ind Int
val
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

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

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

size :: BreakArray -> Int
size :: BreakArray -> Int
size (BA MutableByteArray# RealWorld
array) = Int
size forall a. Integral a => a -> a -> a
`div` SIZEOF_HSWORD
  where
    -- We want to keep this operation pure. The mutable byte array
    -- is never resized so this is safe.
    size :: Int
size = forall a. IO a -> a
unsafeDupablePerformIO 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 =
        forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case 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 Int#
sz# = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
    case 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 all elements to breakOff.
newBreakArray :: Int -> IO BreakArray
newBreakArray :: Int -> IO BreakArray
newBreakArray (I# Int#
sz#) = do
    BA MutableByteArray# RealWorld
array <- Int# -> IO BreakArray
allocBA (Int#
sz# Int# -> Int# -> Int#
*# SIZEOF_HSWORD#)
    case Int
breakOff of
        I# Int#
off -> do
           let loop :: Int# -> IO ()
loop Int#
n | Int# -> Bool
isTrue# (Int#
n Int# -> Int# -> Int#
>=# Int#
sz#) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      | Bool
otherwise = do MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
n Int#
off; Int# -> IO ()
loop (Int#
n Int# -> Int# -> Int#
+# Int#
1#)
           Int# -> IO ()
loop Int#
0#
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld -> BreakArray
BA MutableByteArray# RealWorld
array

writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
ind Int#
val = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
array Int#
ind Int#
val State# RealWorld
s of { State# RealWorld
s -> (# State# RealWorld
s, () #) }

writeBreakArray :: BreakArray -> Int -> Int -> IO ()
writeBreakArray :: BreakArray -> Int -> Int -> IO ()
writeBreakArray (BA MutableByteArray# RealWorld
array) (I# Int#
i) (I# Int#
val) = MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
i Int#
val

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

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