{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Data types for representing different pointers and raw information
-- All pointers are stored in little-endian to make arithmetic easier.
--
-- We have to send and recieve the pointers in big endian though. This
-- conversion is dealt with in the Binary instance for ClosurePtr and
-- then the other pointers are derived from this instance using DerivingVia
module GHC.Debug.Types.Ptr( -- * InfoTables
                            InfoTablePtr(..)
                          , RawInfoTable(..)
                          -- UntaggedClosurePtr constructor not exported so
                          -- we can maintain the invariant that all
                          -- ClosurePtr are untagged
                          -- * Closures
                          , ClosurePtr(..,ClosurePtr)
                          , mkClosurePtr
                          , RawClosure(..)
                          , rawClosureSize
                          , getInfoTblPtr
                          -- * Operations on 'ClosurePtr'
                          , applyBlockMask
                          , applyMBlockMask
                          , subtractBlockPtr
                          , heapAlloced

                          , getBlockOffset
                          -- * Blocks
                          , BlockPtr(..)
                          , RawBlock(..)
                          , isLargeBlock
                          , isPinnedBlock
                          , rawBlockAddr
                          , extractFromBlock
                          , blockMBlock
                          , rawBlockSize
                          -- * Stacks
                          , StackPtr(..)
                          , RawStack(..)

                          , subtractStackPtr
                          , calculateStackLen
                          , addStackPtr
                          , rawStackSize
                          , printStack
                          -- * Bitmaps
                          , PtrBitmap(..)
                          , traversePtrBitmap
                          -- * Constants
                          , blockMask
                          , mblockMask
                          , mblockMaxSize
                          , blockMaxSize
                          , profiling
                          , tablesNextToCode

                          -- * Other utility
                          , arrWordsBS
                          , prettyPrint
                          , printBS
                          )  where

import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS
import Data.Hashable
import Data.Word

import GHC.Debug.Utils

import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import System.Endian

import Numeric (showHex)
import Data.Coerce
import Data.Bits
import GHC.Stack
import Control.Applicative
import qualified Data.Array.Unboxed as A
import Control.Monad
import qualified Data.Foldable as F

prettyPrint :: BS.ByteString -> String
prettyPrint :: ByteString -> String
prettyPrint = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Word8 -> String -> String) -> String -> Word8 -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex String
"") ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

-- TODO: Fetch this from debuggee
tablesNextToCode :: Bool
tablesNextToCode :: Bool
tablesNextToCode = Bool
True

-- TODO: Fetch this from debuggee
profiling :: Bool
profiling :: Bool
profiling = Bool
False

newtype InfoTablePtr = InfoTablePtr Word64
                     deriving (InfoTablePtr -> InfoTablePtr -> Bool
(InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool) -> Eq InfoTablePtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoTablePtr -> InfoTablePtr -> Bool
$c/= :: InfoTablePtr -> InfoTablePtr -> Bool
== :: InfoTablePtr -> InfoTablePtr -> Bool
$c== :: InfoTablePtr -> InfoTablePtr -> Bool
Eq, Eq InfoTablePtr
Eq InfoTablePtr
-> (InfoTablePtr -> InfoTablePtr -> Ordering)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> Bool)
-> (InfoTablePtr -> InfoTablePtr -> InfoTablePtr)
-> (InfoTablePtr -> InfoTablePtr -> InfoTablePtr)
-> Ord InfoTablePtr
InfoTablePtr -> InfoTablePtr -> Bool
InfoTablePtr -> InfoTablePtr -> Ordering
InfoTablePtr -> InfoTablePtr -> InfoTablePtr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
$cmin :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
max :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
$cmax :: InfoTablePtr -> InfoTablePtr -> InfoTablePtr
>= :: InfoTablePtr -> InfoTablePtr -> Bool
$c>= :: InfoTablePtr -> InfoTablePtr -> Bool
> :: InfoTablePtr -> InfoTablePtr -> Bool
$c> :: InfoTablePtr -> InfoTablePtr -> Bool
<= :: InfoTablePtr -> InfoTablePtr -> Bool
$c<= :: InfoTablePtr -> InfoTablePtr -> Bool
< :: InfoTablePtr -> InfoTablePtr -> Bool
$c< :: InfoTablePtr -> InfoTablePtr -> Bool
compare :: InfoTablePtr -> InfoTablePtr -> Ordering
$ccompare :: InfoTablePtr -> InfoTablePtr -> Ordering
Ord)
                     deriving newtype (Eq InfoTablePtr
Eq InfoTablePtr
-> (Int -> InfoTablePtr -> Int)
-> (InfoTablePtr -> Int)
-> Hashable InfoTablePtr
Int -> InfoTablePtr -> Int
InfoTablePtr -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InfoTablePtr -> Int
$chash :: InfoTablePtr -> Int
hashWithSalt :: Int -> InfoTablePtr -> Int
$chashWithSalt :: Int -> InfoTablePtr -> Int
Hashable)
                     deriving (Int -> InfoTablePtr -> String -> String
[InfoTablePtr] -> String -> String
InfoTablePtr -> String
(Int -> InfoTablePtr -> String -> String)
-> (InfoTablePtr -> String)
-> ([InfoTablePtr] -> String -> String)
-> Show InfoTablePtr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InfoTablePtr] -> String -> String
$cshowList :: [InfoTablePtr] -> String -> String
show :: InfoTablePtr -> String
$cshow :: InfoTablePtr -> String
showsPrec :: Int -> InfoTablePtr -> String -> String
$cshowsPrec :: Int -> InfoTablePtr -> String -> String
Show, Get InfoTablePtr
[InfoTablePtr] -> Put
InfoTablePtr -> Put
(InfoTablePtr -> Put)
-> Get InfoTablePtr
-> ([InfoTablePtr] -> Put)
-> Binary InfoTablePtr
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [InfoTablePtr] -> Put
$cputList :: [InfoTablePtr] -> Put
get :: Get InfoTablePtr
$cget :: Get InfoTablePtr
put :: InfoTablePtr -> Put
$cput :: InfoTablePtr -> Put
Binary) via ClosurePtr

-- Invariant, ClosurePtrs are *always* untagged, we take some care to
-- untag them when making a ClosurePtr so we don't have to do it on every
-- call to decodeClosure
newtype ClosurePtr = UntaggedClosurePtr Word64
                   deriving (ClosurePtr -> ClosurePtr -> Bool
(ClosurePtr -> ClosurePtr -> Bool)
-> (ClosurePtr -> ClosurePtr -> Bool) -> Eq ClosurePtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosurePtr -> ClosurePtr -> Bool
$c/= :: ClosurePtr -> ClosurePtr -> Bool
== :: ClosurePtr -> ClosurePtr -> Bool
$c== :: ClosurePtr -> ClosurePtr -> Bool
Eq)
                   deriving newtype (Eq ClosurePtr
Eq ClosurePtr
-> (Int -> ClosurePtr -> Int)
-> (ClosurePtr -> Int)
-> Hashable ClosurePtr
Int -> ClosurePtr -> Int
ClosurePtr -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ClosurePtr -> Int
$chash :: ClosurePtr -> Int
hashWithSalt :: Int -> ClosurePtr -> Int
$chashWithSalt :: Int -> ClosurePtr -> Int
Hashable)

pattern ClosurePtr :: Word64 -> ClosurePtr
pattern $mClosurePtr :: forall {r}. ClosurePtr -> (Word64 -> r) -> ((# #) -> r) -> r
ClosurePtr p <- UntaggedClosurePtr p

{-# COMPLETE ClosurePtr #-}

mkClosurePtr :: Word64 -> ClosurePtr
mkClosurePtr :: Word64 -> ClosurePtr
mkClosurePtr = ClosurePtr -> ClosurePtr
untagClosurePtr (ClosurePtr -> ClosurePtr)
-> (Word64 -> ClosurePtr) -> Word64 -> ClosurePtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ClosurePtr
UntaggedClosurePtr

instance Binary ClosurePtr where
  put :: ClosurePtr -> Put
put (ClosurePtr Word64
p) = Word64 -> Put
putWord64be (Word64 -> Word64
toBE64 Word64
p)
  get :: Get ClosurePtr
get = Word64 -> ClosurePtr
mkClosurePtr (Word64 -> ClosurePtr)
-> (Word64 -> Word64) -> Word64 -> ClosurePtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
fromBE64 (Word64 -> ClosurePtr) -> Get Word64 -> Get ClosurePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be

instance Ord ClosurePtr where
  (ClosurePtr Word64
x) compare :: ClosurePtr -> ClosurePtr -> Ordering
`compare` (ClosurePtr Word64
y) = Word64
x Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word64
y

instance Show ClosurePtr where
  show :: ClosurePtr -> String
show (ClosurePtr Word64
0) = String
"null"
  show (ClosurePtr Word64
p) =  String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word64
p String
""


newtype StackPtr = StackPtr Word64
                   deriving (StackPtr -> StackPtr -> Bool
(StackPtr -> StackPtr -> Bool)
-> (StackPtr -> StackPtr -> Bool) -> Eq StackPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackPtr -> StackPtr -> Bool
$c/= :: StackPtr -> StackPtr -> Bool
== :: StackPtr -> StackPtr -> Bool
$c== :: StackPtr -> StackPtr -> Bool
Eq, Eq StackPtr
Eq StackPtr
-> (StackPtr -> StackPtr -> Ordering)
-> (StackPtr -> StackPtr -> Bool)
-> (StackPtr -> StackPtr -> Bool)
-> (StackPtr -> StackPtr -> Bool)
-> (StackPtr -> StackPtr -> Bool)
-> (StackPtr -> StackPtr -> StackPtr)
-> (StackPtr -> StackPtr -> StackPtr)
-> Ord StackPtr
StackPtr -> StackPtr -> Bool
StackPtr -> StackPtr -> Ordering
StackPtr -> StackPtr -> StackPtr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StackPtr -> StackPtr -> StackPtr
$cmin :: StackPtr -> StackPtr -> StackPtr
max :: StackPtr -> StackPtr -> StackPtr
$cmax :: StackPtr -> StackPtr -> StackPtr
>= :: StackPtr -> StackPtr -> Bool
$c>= :: StackPtr -> StackPtr -> Bool
> :: StackPtr -> StackPtr -> Bool
$c> :: StackPtr -> StackPtr -> Bool
<= :: StackPtr -> StackPtr -> Bool
$c<= :: StackPtr -> StackPtr -> Bool
< :: StackPtr -> StackPtr -> Bool
$c< :: StackPtr -> StackPtr -> Bool
compare :: StackPtr -> StackPtr -> Ordering
$ccompare :: StackPtr -> StackPtr -> Ordering
Ord)
                   deriving newtype (Eq StackPtr
Eq StackPtr
-> (Int -> StackPtr -> Int)
-> (StackPtr -> Int)
-> Hashable StackPtr
Int -> StackPtr -> Int
StackPtr -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StackPtr -> Int
$chash :: StackPtr -> Int
hashWithSalt :: Int -> StackPtr -> Int
$chashWithSalt :: Int -> StackPtr -> Int
Hashable)
                   deriving (Int -> StackPtr -> String -> String
[StackPtr] -> String -> String
StackPtr -> String
(Int -> StackPtr -> String -> String)
-> (StackPtr -> String)
-> ([StackPtr] -> String -> String)
-> Show StackPtr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StackPtr] -> String -> String
$cshowList :: [StackPtr] -> String -> String
show :: StackPtr -> String
$cshow :: StackPtr -> String
showsPrec :: Int -> StackPtr -> String -> String
$cshowsPrec :: Int -> StackPtr -> String -> String
Show, Get StackPtr
[StackPtr] -> Put
StackPtr -> Put
(StackPtr -> Put)
-> Get StackPtr -> ([StackPtr] -> Put) -> Binary StackPtr
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [StackPtr] -> Put
$cputList :: [StackPtr] -> Put
get :: Get StackPtr
$cget :: Get StackPtr
put :: StackPtr -> Put
$cput :: StackPtr -> Put
Binary) via ClosurePtr

newtype StringPtr = StringPtr Word64
  deriving Int -> StringPtr -> String -> String
[StringPtr] -> String -> String
StringPtr -> String
(Int -> StringPtr -> String -> String)
-> (StringPtr -> String)
-> ([StringPtr] -> String -> String)
-> Show StringPtr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StringPtr] -> String -> String
$cshowList :: [StringPtr] -> String -> String
show :: StringPtr -> String
$cshow :: StringPtr -> String
showsPrec :: Int -> StringPtr -> String -> String
$cshowsPrec :: Int -> StringPtr -> String -> String
Show via StackPtr


subtractBlockPtr :: ClosurePtr -> BlockPtr -> Word64
subtractBlockPtr :: ClosurePtr -> BlockPtr -> Word64
subtractBlockPtr ClosurePtr
cp BlockPtr
bp = StackPtr -> ClosurePtr -> Word64
subtractStackPtr (ClosurePtr -> StackPtr
coerce ClosurePtr
cp) (BlockPtr -> ClosurePtr
coerce BlockPtr
bp)

subtractStackPtr :: StackPtr -> ClosurePtr -> Word64
subtractStackPtr :: StackPtr -> ClosurePtr -> Word64
subtractStackPtr (StackPtr Word64
c) (ClosurePtr Word64
c2) =
  Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
c2

addStackPtr :: StackPtr -> Word64 -> StackPtr
addStackPtr :: StackPtr -> Word64 -> StackPtr
addStackPtr (StackPtr Word64
c) Word64
o = Word64 -> StackPtr
StackPtr (Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
o)

rawClosureSize :: RawClosure -> Int
rawClosureSize :: RawClosure -> Int
rawClosureSize (RawClosure ByteString
s) = ByteString -> Int
BS.length ByteString
s

calculateStackLen :: Word32 -> Word64 -> ClosurePtr -> StackPtr -> Word64
calculateStackLen :: Word32 -> Word64 -> ClosurePtr -> StackPtr -> Word64
calculateStackLen Word32
siz Word64
offset (ClosurePtr Word64
p) (StackPtr Word64
sp) =
  (Word64
p  -- Pointer to start of StgStack closure
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
offset       -- Offset to end of closure
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
siz Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
8) -- Stack_Size (in words)
    )
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
sp -- Minus current Sp

printBS :: HasCallStack => BS.ByteString -> String
-- Not technically all ClosurePtr but good for the show instance
printBS :: HasCallStack => ByteString -> String
printBS ByteString
bs = [ClosurePtr] -> String
forall a. Show a => a -> String
show (Get [ClosurePtr] -> ByteString -> [ClosurePtr]
forall a. HasCallStack => Get a -> ByteString -> a
runGet_ (Get ClosurePtr -> Get [ClosurePtr]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. Binary t => Get t
get @ClosurePtr)) (ByteString -> ByteString
BSL.fromStrict ByteString
bs))

printStack :: RawStack -> String
printStack :: RawStack -> String
printStack (RawStack ByteString
s) = HasCallStack => ByteString -> String
ByteString -> String
printBS ByteString
s

arrWordsBS :: [Word] -> BSL.ByteString
arrWordsBS :: [Word] -> ByteString
arrWordsBS = Put -> ByteString
runPut (Put -> ByteString) -> ([Word] -> Put) -> [Word] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Put) -> [Word] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word -> Put
putWordhost

-- | Check if the ClosurePtr is block allocated or not
-- TODO: MP: These numbers are hard-coded from what
-- mblock_address_space.begin and mblock_address_space.end were when
-- I inspected them in gdb. I don't know if they are always the same of
-- should be queried from the debuggee
heapAlloced :: ClosurePtr -> Bool
heapAlloced :: ClosurePtr -> Bool
heapAlloced (ClosurePtr Word64
w) = (Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x4200000000 Bool -> Bool -> Bool
&& Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0x14200000000)

newtype RawInfoTable = RawInfoTable BS.ByteString
                     deriving (RawInfoTable -> RawInfoTable -> Bool
(RawInfoTable -> RawInfoTable -> Bool)
-> (RawInfoTable -> RawInfoTable -> Bool) -> Eq RawInfoTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawInfoTable -> RawInfoTable -> Bool
$c/= :: RawInfoTable -> RawInfoTable -> Bool
== :: RawInfoTable -> RawInfoTable -> Bool
$c== :: RawInfoTable -> RawInfoTable -> Bool
Eq, Eq RawInfoTable
Eq RawInfoTable
-> (RawInfoTable -> RawInfoTable -> Ordering)
-> (RawInfoTable -> RawInfoTable -> Bool)
-> (RawInfoTable -> RawInfoTable -> Bool)
-> (RawInfoTable -> RawInfoTable -> Bool)
-> (RawInfoTable -> RawInfoTable -> Bool)
-> (RawInfoTable -> RawInfoTable -> RawInfoTable)
-> (RawInfoTable -> RawInfoTable -> RawInfoTable)
-> Ord RawInfoTable
RawInfoTable -> RawInfoTable -> Bool
RawInfoTable -> RawInfoTable -> Ordering
RawInfoTable -> RawInfoTable -> RawInfoTable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawInfoTable -> RawInfoTable -> RawInfoTable
$cmin :: RawInfoTable -> RawInfoTable -> RawInfoTable
max :: RawInfoTable -> RawInfoTable -> RawInfoTable
$cmax :: RawInfoTable -> RawInfoTable -> RawInfoTable
>= :: RawInfoTable -> RawInfoTable -> Bool
$c>= :: RawInfoTable -> RawInfoTable -> Bool
> :: RawInfoTable -> RawInfoTable -> Bool
$c> :: RawInfoTable -> RawInfoTable -> Bool
<= :: RawInfoTable -> RawInfoTable -> Bool
$c<= :: RawInfoTable -> RawInfoTable -> Bool
< :: RawInfoTable -> RawInfoTable -> Bool
$c< :: RawInfoTable -> RawInfoTable -> Bool
compare :: RawInfoTable -> RawInfoTable -> Ordering
$ccompare :: RawInfoTable -> RawInfoTable -> Ordering
Ord, Int -> RawInfoTable -> String -> String
[RawInfoTable] -> String -> String
RawInfoTable -> String
(Int -> RawInfoTable -> String -> String)
-> (RawInfoTable -> String)
-> ([RawInfoTable] -> String -> String)
-> Show RawInfoTable
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawInfoTable] -> String -> String
$cshowList :: [RawInfoTable] -> String -> String
show :: RawInfoTable -> String
$cshow :: RawInfoTable -> String
showsPrec :: Int -> RawInfoTable -> String -> String
$cshowsPrec :: Int -> RawInfoTable -> String -> String
Show)
                     deriving newtype (Get RawInfoTable
[RawInfoTable] -> Put
RawInfoTable -> Put
(RawInfoTable -> Put)
-> Get RawInfoTable
-> ([RawInfoTable] -> Put)
-> Binary RawInfoTable
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [RawInfoTable] -> Put
$cputList :: [RawInfoTable] -> Put
get :: Get RawInfoTable
$cget :: Get RawInfoTable
put :: RawInfoTable -> Put
$cput :: RawInfoTable -> Put
Binary)

newtype RawClosure = RawClosure BS.ByteString
                   deriving (RawClosure -> RawClosure -> Bool
(RawClosure -> RawClosure -> Bool)
-> (RawClosure -> RawClosure -> Bool) -> Eq RawClosure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawClosure -> RawClosure -> Bool
$c/= :: RawClosure -> RawClosure -> Bool
== :: RawClosure -> RawClosure -> Bool
$c== :: RawClosure -> RawClosure -> Bool
Eq, Eq RawClosure
Eq RawClosure
-> (RawClosure -> RawClosure -> Ordering)
-> (RawClosure -> RawClosure -> Bool)
-> (RawClosure -> RawClosure -> Bool)
-> (RawClosure -> RawClosure -> Bool)
-> (RawClosure -> RawClosure -> Bool)
-> (RawClosure -> RawClosure -> RawClosure)
-> (RawClosure -> RawClosure -> RawClosure)
-> Ord RawClosure
RawClosure -> RawClosure -> Bool
RawClosure -> RawClosure -> Ordering
RawClosure -> RawClosure -> RawClosure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawClosure -> RawClosure -> RawClosure
$cmin :: RawClosure -> RawClosure -> RawClosure
max :: RawClosure -> RawClosure -> RawClosure
$cmax :: RawClosure -> RawClosure -> RawClosure
>= :: RawClosure -> RawClosure -> Bool
$c>= :: RawClosure -> RawClosure -> Bool
> :: RawClosure -> RawClosure -> Bool
$c> :: RawClosure -> RawClosure -> Bool
<= :: RawClosure -> RawClosure -> Bool
$c<= :: RawClosure -> RawClosure -> Bool
< :: RawClosure -> RawClosure -> Bool
$c< :: RawClosure -> RawClosure -> Bool
compare :: RawClosure -> RawClosure -> Ordering
$ccompare :: RawClosure -> RawClosure -> Ordering
Ord, Int -> RawClosure -> String -> String
[RawClosure] -> String -> String
RawClosure -> String
(Int -> RawClosure -> String -> String)
-> (RawClosure -> String)
-> ([RawClosure] -> String -> String)
-> Show RawClosure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawClosure] -> String -> String
$cshowList :: [RawClosure] -> String -> String
show :: RawClosure -> String
$cshow :: RawClosure -> String
showsPrec :: Int -> RawClosure -> String -> String
$cshowsPrec :: Int -> RawClosure -> String -> String
Show)

getRawClosure :: Get RawClosure
getRawClosure :: Get RawClosure
getRawClosure = do
  Word32
len <- Get Word32
getWord32be
  ByteString -> RawClosure
RawClosure (ByteString -> RawClosure) -> Get ByteString -> Get RawClosure
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)

putRawClosure :: RawClosure -> Put
putRawClosure :: RawClosure -> Put
putRawClosure (RawClosure ByteString
rc) = do
  let n :: Int
n = ByteString -> Int
BS.length ByteString
rc
  Word32 -> Put
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  ByteString -> Put
putByteString ByteString
rc

instance Binary RawClosure where
  get :: Get RawClosure
get = Get RawClosure
getRawClosure
  put :: RawClosure -> Put
put = RawClosure -> Put
putRawClosure

newtype RawStack = RawStack BS.ByteString
                   deriving (RawStack -> RawStack -> Bool
(RawStack -> RawStack -> Bool)
-> (RawStack -> RawStack -> Bool) -> Eq RawStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawStack -> RawStack -> Bool
$c/= :: RawStack -> RawStack -> Bool
== :: RawStack -> RawStack -> Bool
$c== :: RawStack -> RawStack -> Bool
Eq, Eq RawStack
Eq RawStack
-> (RawStack -> RawStack -> Ordering)
-> (RawStack -> RawStack -> Bool)
-> (RawStack -> RawStack -> Bool)
-> (RawStack -> RawStack -> Bool)
-> (RawStack -> RawStack -> Bool)
-> (RawStack -> RawStack -> RawStack)
-> (RawStack -> RawStack -> RawStack)
-> Ord RawStack
RawStack -> RawStack -> Bool
RawStack -> RawStack -> Ordering
RawStack -> RawStack -> RawStack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawStack -> RawStack -> RawStack
$cmin :: RawStack -> RawStack -> RawStack
max :: RawStack -> RawStack -> RawStack
$cmax :: RawStack -> RawStack -> RawStack
>= :: RawStack -> RawStack -> Bool
$c>= :: RawStack -> RawStack -> Bool
> :: RawStack -> RawStack -> Bool
$c> :: RawStack -> RawStack -> Bool
<= :: RawStack -> RawStack -> Bool
$c<= :: RawStack -> RawStack -> Bool
< :: RawStack -> RawStack -> Bool
$c< :: RawStack -> RawStack -> Bool
compare :: RawStack -> RawStack -> Ordering
$ccompare :: RawStack -> RawStack -> Ordering
Ord, Int -> RawStack -> String -> String
[RawStack] -> String -> String
RawStack -> String
(Int -> RawStack -> String -> String)
-> (RawStack -> String)
-> ([RawStack] -> String -> String)
-> Show RawStack
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawStack] -> String -> String
$cshowList :: [RawStack] -> String -> String
show :: RawStack -> String
$cshow :: RawStack -> String
showsPrec :: Int -> RawStack -> String -> String
$cshowsPrec :: Int -> RawStack -> String -> String
Show)

newtype RawPayload = RawPayload BS.ByteString
                   deriving (RawPayload -> RawPayload -> Bool
(RawPayload -> RawPayload -> Bool)
-> (RawPayload -> RawPayload -> Bool) -> Eq RawPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawPayload -> RawPayload -> Bool
$c/= :: RawPayload -> RawPayload -> Bool
== :: RawPayload -> RawPayload -> Bool
$c== :: RawPayload -> RawPayload -> Bool
Eq, Eq RawPayload
Eq RawPayload
-> (RawPayload -> RawPayload -> Ordering)
-> (RawPayload -> RawPayload -> Bool)
-> (RawPayload -> RawPayload -> Bool)
-> (RawPayload -> RawPayload -> Bool)
-> (RawPayload -> RawPayload -> Bool)
-> (RawPayload -> RawPayload -> RawPayload)
-> (RawPayload -> RawPayload -> RawPayload)
-> Ord RawPayload
RawPayload -> RawPayload -> Bool
RawPayload -> RawPayload -> Ordering
RawPayload -> RawPayload -> RawPayload
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawPayload -> RawPayload -> RawPayload
$cmin :: RawPayload -> RawPayload -> RawPayload
max :: RawPayload -> RawPayload -> RawPayload
$cmax :: RawPayload -> RawPayload -> RawPayload
>= :: RawPayload -> RawPayload -> Bool
$c>= :: RawPayload -> RawPayload -> Bool
> :: RawPayload -> RawPayload -> Bool
$c> :: RawPayload -> RawPayload -> Bool
<= :: RawPayload -> RawPayload -> Bool
$c<= :: RawPayload -> RawPayload -> Bool
< :: RawPayload -> RawPayload -> Bool
$c< :: RawPayload -> RawPayload -> Bool
compare :: RawPayload -> RawPayload -> Ordering
$ccompare :: RawPayload -> RawPayload -> Ordering
Ord, Int -> RawPayload -> String -> String
[RawPayload] -> String -> String
RawPayload -> String
(Int -> RawPayload -> String -> String)
-> (RawPayload -> String)
-> ([RawPayload] -> String -> String)
-> Show RawPayload
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawPayload] -> String -> String
$cshowList :: [RawPayload] -> String -> String
show :: RawPayload -> String
$cshow :: RawPayload -> String
showsPrec :: Int -> RawPayload -> String -> String
$cshowsPrec :: Int -> RawPayload -> String -> String
Show)

rawStackSize :: RawStack -> Int
rawStackSize :: RawStack -> Int
rawStackSize (RawStack ByteString
bs) = ByteString -> Int
BS.length ByteString
bs


newtype BlockPtr = BlockPtr Word64
                   deriving (BlockPtr -> BlockPtr -> Bool
(BlockPtr -> BlockPtr -> Bool)
-> (BlockPtr -> BlockPtr -> Bool) -> Eq BlockPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockPtr -> BlockPtr -> Bool
$c/= :: BlockPtr -> BlockPtr -> Bool
== :: BlockPtr -> BlockPtr -> Bool
$c== :: BlockPtr -> BlockPtr -> Bool
Eq, Eq BlockPtr
Eq BlockPtr
-> (BlockPtr -> BlockPtr -> Ordering)
-> (BlockPtr -> BlockPtr -> Bool)
-> (BlockPtr -> BlockPtr -> Bool)
-> (BlockPtr -> BlockPtr -> Bool)
-> (BlockPtr -> BlockPtr -> Bool)
-> (BlockPtr -> BlockPtr -> BlockPtr)
-> (BlockPtr -> BlockPtr -> BlockPtr)
-> Ord BlockPtr
BlockPtr -> BlockPtr -> Bool
BlockPtr -> BlockPtr -> Ordering
BlockPtr -> BlockPtr -> BlockPtr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockPtr -> BlockPtr -> BlockPtr
$cmin :: BlockPtr -> BlockPtr -> BlockPtr
max :: BlockPtr -> BlockPtr -> BlockPtr
$cmax :: BlockPtr -> BlockPtr -> BlockPtr
>= :: BlockPtr -> BlockPtr -> Bool
$c>= :: BlockPtr -> BlockPtr -> Bool
> :: BlockPtr -> BlockPtr -> Bool
$c> :: BlockPtr -> BlockPtr -> Bool
<= :: BlockPtr -> BlockPtr -> Bool
$c<= :: BlockPtr -> BlockPtr -> Bool
< :: BlockPtr -> BlockPtr -> Bool
$c< :: BlockPtr -> BlockPtr -> Bool
compare :: BlockPtr -> BlockPtr -> Ordering
$ccompare :: BlockPtr -> BlockPtr -> Ordering
Ord)
                   deriving newtype (Eq BlockPtr
Eq BlockPtr
-> (Int -> BlockPtr -> Int)
-> (BlockPtr -> Int)
-> Hashable BlockPtr
Int -> BlockPtr -> Int
BlockPtr -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockPtr -> Int
$chash :: BlockPtr -> Int
hashWithSalt :: Int -> BlockPtr -> Int
$chashWithSalt :: Int -> BlockPtr -> Int
Hashable)
                   deriving (Get BlockPtr
[BlockPtr] -> Put
BlockPtr -> Put
(BlockPtr -> Put)
-> Get BlockPtr -> ([BlockPtr] -> Put) -> Binary BlockPtr
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [BlockPtr] -> Put
$cputList :: [BlockPtr] -> Put
get :: Get BlockPtr
$cget :: Get BlockPtr
put :: BlockPtr -> Put
$cput :: BlockPtr -> Put
Binary, Int -> BlockPtr -> String -> String
[BlockPtr] -> String -> String
BlockPtr -> String
(Int -> BlockPtr -> String -> String)
-> (BlockPtr -> String)
-> ([BlockPtr] -> String -> String)
-> Show BlockPtr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BlockPtr] -> String -> String
$cshowList :: [BlockPtr] -> String -> String
show :: BlockPtr -> String
$cshow :: BlockPtr -> String
showsPrec :: Int -> BlockPtr -> String -> String
$cshowsPrec :: Int -> BlockPtr -> String -> String
Show) via StackPtr

blockMBlock :: BlockPtr -> Word64
blockMBlock :: BlockPtr -> Word64
blockMBlock (BlockPtr Word64
p) = Word64
p Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
mblockMask)

applyMBlockMask :: ClosurePtr -> BlockPtr
applyMBlockMask :: ClosurePtr -> BlockPtr
applyMBlockMask (ClosurePtr Word64
p) = Word64 -> BlockPtr
BlockPtr (Word64
p Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
mblockMask)

applyBlockMask :: ClosurePtr -> BlockPtr
applyBlockMask :: ClosurePtr -> BlockPtr
applyBlockMask (ClosurePtr Word64
p) = Word64 -> BlockPtr
BlockPtr (Word64
p Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
blockMask)

getBlockOffset :: ClosurePtr -> Word64
getBlockOffset :: ClosurePtr -> Word64
getBlockOffset (ClosurePtr Word64
p) = Word64
p Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
blockMask

mblockMaxSize, blockMaxSize :: Word64
mblockMaxSize :: Word64
mblockMaxSize = Word64
mblockMask Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
blockMaxSize :: Word64
blockMaxSize = Word64
blockMask Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1

mblockMask :: Word64
mblockMask :: Word64
mblockMask = Word64
0b11111111111111111111 -- 20 bits

blockMask :: Word64
blockMask :: Word64
blockMask = Word64
0b111111111111 -- 12 bits

isPinnedBlock :: RawBlock -> Bool
isPinnedBlock :: RawBlock -> Bool
isPinnedBlock (RawBlock BlockPtr
_ Word16
flags ByteString
_) = (Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b100) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0

isLargeBlock :: RawBlock -> Bool
isLargeBlock :: RawBlock -> Bool
isLargeBlock (RawBlock BlockPtr
_ Word16
flags ByteString
_) = (Word16
flags Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b10) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0

data RawBlock = RawBlock BlockPtr Word16 BS.ByteString
                    deriving (Int -> RawBlock -> String -> String
[RawBlock] -> String -> String
RawBlock -> String
(Int -> RawBlock -> String -> String)
-> (RawBlock -> String)
-> ([RawBlock] -> String -> String)
-> Show RawBlock
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawBlock] -> String -> String
$cshowList :: [RawBlock] -> String -> String
show :: RawBlock -> String
$cshow :: RawBlock -> String
showsPrec :: Int -> RawBlock -> String -> String
$cshowsPrec :: Int -> RawBlock -> String -> String
Show)

-- flags, Ptr, size then raw block
getBlock :: Get RawBlock
getBlock :: Get RawBlock
getBlock = do
  Word16
bflags <- Get Word16
getWord16le
  BlockPtr
bptr <- Get BlockPtr
forall t. Binary t => Get t
get
  Int32
len <- Get Int32
getInt32be
  ByteString
rb <- Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
  return (BlockPtr -> Word16 -> ByteString -> RawBlock
RawBlock BlockPtr
bptr Word16
bflags ByteString
rb)

putBlock :: RawBlock -> Put
putBlock :: RawBlock -> Put
putBlock (RawBlock BlockPtr
bptr Word16
bflags ByteString
rb) = do
  Word16 -> Put
putWord16le Word16
bflags
  BlockPtr -> Put
forall t. Binary t => t -> Put
put BlockPtr
bptr
  Int32 -> Put
putInt32be (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
rb)
  ByteString -> Put
putByteString ByteString
rb

instance Binary RawBlock where
  get :: Get RawBlock
get = Get RawBlock
getBlock
  put :: RawBlock -> Put
put = RawBlock -> Put
putBlock

rawBlockSize :: RawBlock -> Int
rawBlockSize :: RawBlock -> Int
rawBlockSize (RawBlock BlockPtr
_ Word16
_ ByteString
bs) = ByteString -> Int
BS.length ByteString
bs

rawBlockAddr :: RawBlock -> BlockPtr
rawBlockAddr :: RawBlock -> BlockPtr
rawBlockAddr (RawBlock BlockPtr
addr Word16
_ ByteString
_) = BlockPtr
addr

-- | Invariant: ClosurePtr is within the range of the block
-- The 'RawClosure' this returns is actually the tail of the whole block,
-- this is fine because the memory for each block is only allocated once
-- due to how BS.drop is implemented via pointer arithmetic.
extractFromBlock :: ClosurePtr
                -> RawBlock
                -> RawClosure
extractFromBlock :: ClosurePtr -> RawBlock -> RawClosure
extractFromBlock ClosurePtr
cp (RawBlock BlockPtr
bp Word16
_ ByteString
b) =
--  Calling closureSize doesn't work as the info table addresses are bogus
--  clos_size_w <- withForeignPtr fp' (\p -> return $ closureSize (ptrToBox p))
--  let clos_size = clos_size_w * 8
    --traceShow (fp, offset, cp, bp,o, l)
    --traceShow ("FP", fp `plusForeignPtr` offset)
    ByteString -> RawClosure
RawClosure (Int -> ByteString -> ByteString
BS.drop Int
offset ByteString
b)
    where
      offset :: Int
offset = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ClosurePtr -> BlockPtr -> Word64
subtractBlockPtr ClosurePtr
cp BlockPtr
bp)

tAG_MASK :: Word64
tAG_MASK :: Word64
tAG_MASK = Word64
0b111

untagClosurePtr :: ClosurePtr -> ClosurePtr
untagClosurePtr :: ClosurePtr -> ClosurePtr
untagClosurePtr (ClosurePtr Word64
w) = Word64 -> ClosurePtr
UntaggedClosurePtr (Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
tAG_MASK)

getInfoTblPtr :: HasCallStack => RawClosure -> InfoTablePtr
getInfoTblPtr :: HasCallStack => RawClosure -> InfoTablePtr
getInfoTblPtr (RawClosure ByteString
bs) = Get InfoTablePtr -> ByteString -> InfoTablePtr
forall a. HasCallStack => Get a -> ByteString -> a
runGet_ (Int -> Get InfoTablePtr -> Get InfoTablePtr
forall a. Int -> Get a -> Get a
isolate Int
8 Get InfoTablePtr
forall t. Binary t => Get t
get) (ByteString -> ByteString
BSL.fromStrict ByteString
bs)

-- | A bitmap that records whether each field of a stack frame is a pointer.
newtype PtrBitmap = PtrBitmap (A.Array Int Bool) deriving (Int -> PtrBitmap -> String -> String
[PtrBitmap] -> String -> String
PtrBitmap -> String
(Int -> PtrBitmap -> String -> String)
-> (PtrBitmap -> String)
-> ([PtrBitmap] -> String -> String)
-> Show PtrBitmap
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PtrBitmap] -> String -> String
$cshowList :: [PtrBitmap] -> String -> String
show :: PtrBitmap -> String
$cshow :: PtrBitmap -> String
showsPrec :: Int -> PtrBitmap -> String -> String
$cshowsPrec :: Int -> PtrBitmap -> String -> String
Show)

traversePtrBitmap :: Monad m => (Bool -> m a) -> PtrBitmap -> m [a]
traversePtrBitmap :: forall (m :: * -> *) a.
Monad m =>
(Bool -> m a) -> PtrBitmap -> m [a]
traversePtrBitmap Bool -> m a
f (PtrBitmap Array Int Bool
arr) = (Bool -> m a) -> [Bool] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Bool -> m a
f (Array Int Bool -> [Bool]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array Int Bool
arr)

getPtrBitmap :: Get PtrBitmap
getPtrBitmap :: Get PtrBitmap
getPtrBitmap = do
  Word32
len <- Get Word32
getWord32be
  [Word8]
bits <- Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len) Get Word8
getWord8
  let arr :: Array Int Bool
arr = (Int, Int) -> [Bool] -> Array Int Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int
0, Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((Word8 -> Bool) -> [Word8] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
1) [Word8]
bits)
  PtrBitmap -> Get PtrBitmap
forall (m :: * -> *) a. Monad m => a -> m a
return (PtrBitmap -> Get PtrBitmap) -> PtrBitmap -> Get PtrBitmap
forall a b. (a -> b) -> a -> b
$ Array Int Bool -> PtrBitmap
PtrBitmap Array Int Bool
arr

putPtrBitmap :: PtrBitmap -> Put
putPtrBitmap :: PtrBitmap -> Put
putPtrBitmap (PtrBitmap Array Int Bool
pbm) = do
  let n :: Int
n = Array Int Bool -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length Array Int Bool
pbm
  Word32 -> Put
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  (Bool -> Put) -> Array Int Bool -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
F.traverse_ (\Bool
b -> if Bool
b then Word8 -> Put
putWord8 Word8
1 else Word8 -> Put
putWord8 Word8
0) Array Int Bool
pbm

instance Binary PtrBitmap where
  get :: Get PtrBitmap
get = Get PtrBitmap
getPtrBitmap
  put :: PtrBitmap -> Put
put = PtrBitmap -> Put
putPtrBitmap