{-# 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
    [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
        Int
val <- BreakArray -> Int -> IO Int
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]
: Int -> String
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
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    | Bool
otherwise = Bool -> IO Bool
forall a. a -> IO a
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
          Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
val
    | Bool
otherwise = Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
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 Int -> Int -> Int
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 = 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 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 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#) = () -> IO ()
forall a. a -> IO a
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#
    BreakArray -> IO BreakArray
forall a. a -> IO a
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# -> Int# -> IO ()
writeBA# :: MutableByteArray# RealWorld -> Int# -> Int# -> IO ()
writeBA# MutableByteArray# RealWorld
array Int#
ind Int#
val = (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# -> Int# -> State# RealWorld -> State# RealWorld
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 = (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
-> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
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#