diff options
Diffstat (limited to 'compiler/main/BreakArray.hs')
-rw-r--r-- | compiler/main/BreakArray.hs | 132 |
1 files changed, 0 insertions, 132 deletions
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs deleted file mode 100644 index 447490266c..0000000000 --- a/compiler/main/BreakArray.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# 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 */ - |