{- |
Module: Capnp.Pointer
Description: Support for parsing/serializing capnproto pointers

This module provides support for parsing and serializing capnproto pointers.
This is a low-level module; most users will not need to call it directly.
-}
module Capnp.Pointer
    ( Ptr(..)
    , ElementSize(..)
    , EltSpec(..)
    , parsePtr
    , parsePtr'
    , serializePtr
    , serializePtr'
    , parseEltSpec
    , serializeEltSpec
    )
  where

import Data.Bits
import Data.Int
import Data.Word

import Capnp.Bits

-- | A 'Ptr' represents the information in a capnproto pointer.
data Ptr
    = StructPtr !Int32 !Word16 !Word16
        -- ^ @'StructPtr' off dataSz ptrSz@ is a pointer to a struct
        -- at offset @off@ in words from the end of the pointer, with
        -- a data section of size @dataSz@ words, and a pointer section
        -- of size @ptrSz@ words.
        --
        -- Note that the value @'StructPtr' 0 0 0@ is illegal, since
        -- its encoding is reserved for the "null" pointer.
    | ListPtr !Int32 !EltSpec
        -- ^ @'ListPtr' off eltSpec@ is a pointer to a list starting at
        -- offset @off@ in words from the end of the pointer. @eltSpec@
        -- encodes the C and D fields in the encoding spec; see 'EltSpec'
        -- for details
    | FarPtr !Bool !Word32 !Word32
        -- ^ @'FarPtr' twoWords off segment@ is a far pointer, whose landing
        -- pad is:
        --
        -- * two words iff @twoWords@,
        -- * @off@ words from the start of the target segment, and
        -- * in segment id @segment@.
    | CapPtr !Word32
        -- ^ @'CapPtr' id@ is a pointer to the capability with the id @id@.
    deriving(Int -> Ptr -> ShowS
[Ptr] -> ShowS
Ptr -> String
(Int -> Ptr -> ShowS)
-> (Ptr -> String) -> ([Ptr] -> ShowS) -> Show Ptr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ptr] -> ShowS
$cshowList :: [Ptr] -> ShowS
show :: Ptr -> String
$cshow :: Ptr -> String
showsPrec :: Int -> Ptr -> ShowS
$cshowsPrec :: Int -> Ptr -> ShowS
Show, Ptr -> Ptr -> Bool
(Ptr -> Ptr -> Bool) -> (Ptr -> Ptr -> Bool) -> Eq Ptr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ptr -> Ptr -> Bool
$c/= :: Ptr -> Ptr -> Bool
== :: Ptr -> Ptr -> Bool
$c== :: Ptr -> Ptr -> Bool
Eq)


-- | The element size field in a list pointer.
data ElementSize
    = Sz0
    | Sz1
    | Sz8
    | Sz16
    | Sz32
    | Sz64
    | SzPtr
    deriving(Int -> ElementSize -> ShowS
[ElementSize] -> ShowS
ElementSize -> String
(Int -> ElementSize -> ShowS)
-> (ElementSize -> String)
-> ([ElementSize] -> ShowS)
-> Show ElementSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementSize] -> ShowS
$cshowList :: [ElementSize] -> ShowS
show :: ElementSize -> String
$cshow :: ElementSize -> String
showsPrec :: Int -> ElementSize -> ShowS
$cshowsPrec :: Int -> ElementSize -> ShowS
Show, ElementSize -> ElementSize -> Bool
(ElementSize -> ElementSize -> Bool)
-> (ElementSize -> ElementSize -> Bool) -> Eq ElementSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementSize -> ElementSize -> Bool
$c/= :: ElementSize -> ElementSize -> Bool
== :: ElementSize -> ElementSize -> Bool
$c== :: ElementSize -> ElementSize -> Bool
Eq, Int -> ElementSize
ElementSize -> Int
ElementSize -> [ElementSize]
ElementSize -> ElementSize
ElementSize -> ElementSize -> [ElementSize]
ElementSize -> ElementSize -> ElementSize -> [ElementSize]
(ElementSize -> ElementSize)
-> (ElementSize -> ElementSize)
-> (Int -> ElementSize)
-> (ElementSize -> Int)
-> (ElementSize -> [ElementSize])
-> (ElementSize -> ElementSize -> [ElementSize])
-> (ElementSize -> ElementSize -> [ElementSize])
-> (ElementSize -> ElementSize -> ElementSize -> [ElementSize])
-> Enum ElementSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ElementSize -> ElementSize -> ElementSize -> [ElementSize]
$cenumFromThenTo :: ElementSize -> ElementSize -> ElementSize -> [ElementSize]
enumFromTo :: ElementSize -> ElementSize -> [ElementSize]
$cenumFromTo :: ElementSize -> ElementSize -> [ElementSize]
enumFromThen :: ElementSize -> ElementSize -> [ElementSize]
$cenumFromThen :: ElementSize -> ElementSize -> [ElementSize]
enumFrom :: ElementSize -> [ElementSize]
$cenumFrom :: ElementSize -> [ElementSize]
fromEnum :: ElementSize -> Int
$cfromEnum :: ElementSize -> Int
toEnum :: Int -> ElementSize
$ctoEnum :: Int -> ElementSize
pred :: ElementSize -> ElementSize
$cpred :: ElementSize -> ElementSize
succ :: ElementSize -> ElementSize
$csucc :: ElementSize -> ElementSize
Enum)

-- | A combination of the C and D fields in a list pointer, i.e. the element
-- size, and either the number of elements in the list, or the total number
-- of /words/ in the list (if size is composite).
data EltSpec
    = EltNormal !ElementSize !Word32
    -- ^ @'EltNormal' size len@ is a normal (non-composite) element type
    -- (C /= 7). @size@ is the size of the elements, and @len@ is the
    -- number of elements in the list.
    | EltComposite !Int32
    -- ^ @EltComposite len@ is a composite element (C == 7). @len@ is the
    -- length of the list in words.
    deriving(Int -> EltSpec -> ShowS
[EltSpec] -> ShowS
EltSpec -> String
(Int -> EltSpec -> ShowS)
-> (EltSpec -> String) -> ([EltSpec] -> ShowS) -> Show EltSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EltSpec] -> ShowS
$cshowList :: [EltSpec] -> ShowS
show :: EltSpec -> String
$cshow :: EltSpec -> String
showsPrec :: Int -> EltSpec -> ShowS
$cshowsPrec :: Int -> EltSpec -> ShowS
Show, EltSpec -> EltSpec -> Bool
(EltSpec -> EltSpec -> Bool)
-> (EltSpec -> EltSpec -> Bool) -> Eq EltSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EltSpec -> EltSpec -> Bool
$c/= :: EltSpec -> EltSpec -> Bool
== :: EltSpec -> EltSpec -> Bool
$c== :: EltSpec -> EltSpec -> Bool
Eq)

-- | @'parsePtr' word@ parses word as a capnproto pointer. A null pointer is
-- parsed as 'Nothing'.
parsePtr :: Word64 -> Maybe Ptr
parsePtr :: Word64 -> Maybe Ptr
parsePtr Word64
0 = Maybe Ptr
forall a. Maybe a
Nothing
parsePtr Word64
p = Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Word64 -> Ptr
parsePtr' Word64
p)

-- | @'parsePtr'' word@ parses @word@ as a capnproto pointer. It ignores
-- nulls, returning them the same as @(StructPtr 0 0 0)@.
parsePtr' :: Word64 -> Ptr
parsePtr' :: Word64 -> Ptr
parsePtr' Word64
word =
    case Word64 -> Int -> Int -> Word64
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
0 Int
2 :: Word64 of
        Word64
0 -> Int32 -> Word16 -> Word16 -> Ptr
StructPtr
            (Word32 -> Int32
i30 (Word64 -> Word32
lo Word64
word))
            (Word64 -> Int -> Int -> Word16
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
48)
            (Word64 -> Int -> Int -> Word16
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
48 Int
64)
        Word64
1 -> Int32 -> EltSpec -> Ptr
ListPtr
            (Word32 -> Int32
i30 (Word64 -> Word32
lo Word64
word))
            (Word64 -> EltSpec
parseEltSpec Word64
word)
        Word64
2 -> Bool -> Word32 -> Word32 -> Ptr
FarPtr
            (Int -> Bool
forall a. Enum a => Int -> a
toEnum (Word64 -> Int -> Int -> Int
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
2 Int
3))
            (Word64 -> Int -> Int -> Word32
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
3 Int
32)
            (Word64 -> Int -> Int -> Word32
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
64)
        Word64
3 -> Word32 -> Ptr
CapPtr (Word64 -> Int -> Int -> Word32
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
64)
        Word64
_ -> String -> Ptr
forall a. HasCallStack => String -> a
error String
"unreachable"

-- | @'serializePtr' ptr@ serializes the pointer as a 'Word64', translating
-- 'Nothing' to a null pointer.
--
-- This also changes the offset of zero-sized struct pointers to -1, to avoid
-- them being interpreted as null.
serializePtr :: Maybe Ptr -> Word64
serializePtr :: Maybe Ptr -> Word64
serializePtr Maybe Ptr
Nothing  = Word64
0
serializePtr (Just p :: Ptr
p@(StructPtr (-1) Word16
0 Word16
0)) =
    Ptr -> Word64
serializePtr' Ptr
p
serializePtr (Just (StructPtr Int32
_ Word16
0 Word16
0)) =
    -- We need to handle this specially, for two reasons.
    --
    -- First, if the offset is zero, the the normal encoding would be interpreted
    -- as null. We can get around this by changing the offset to -1, which will
    -- point immediately before the pointer, which is always a valid position --
    -- and since the size is zero, we can stick it at any valid position.
    --
    -- Second, the canonicalization algorithm requires that *all* zero size structs
    -- are encoded this way, and doing this for all offsets, rather than only zero
    -- offsets, avoids needing extra logic elsewhere.
    Ptr -> Word64
serializePtr' (Int32 -> Word16 -> Word16 -> Ptr
StructPtr (-Int32
1) Word16
0 Word16
0)
serializePtr (Just Ptr
p) =
    Ptr -> Word64
serializePtr' Ptr
p

-- | @'serializePtr'' ptr@ serializes the pointer as a Word64.
--
-- Unlike 'serializePtr', this results in a null pointer on the input
-- @(StructPtr 0 0 0)@, rather than adjusting the offset.
serializePtr' :: Ptr -> Word64
serializePtr' :: Ptr -> Word64
serializePtr' (StructPtr Int32
off Word16
dataSz Word16
ptrSz) =
    -- 0 .|.
    Word32 -> Word64
fromLo (Int32 -> Word32
fromI30 Int32
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
serializePtr' (ListPtr Int32
off EltSpec
eltSpec) = -- eltSz numElts) =
    Word64
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Word32 -> Word64
fromLo (Int32 -> Word32
fromI30 Int32
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    EltSpec -> Word64
serializeEltSpec EltSpec
eltSpec
serializePtr' (FarPtr Bool
twoWords Word32
off Word32
segId) =
    Word64
2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
twoWords) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segId Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
serializePtr' (CapPtr Word32
index) =
    Word64
3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    -- (fromIntegral 0 `shiftL` 2) .|.
    (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
index Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)

-- | @'parseEltSpec' word@ reads the 'EltSpec' from @word@, which must be the
-- encoding of a list pointer (this is not verified).
parseEltSpec :: Word64 -> EltSpec
parseEltSpec :: Word64 -> EltSpec
parseEltSpec Word64
word = case Word64 -> Int -> Int -> Int
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
35 of
    Int
7  -> Int32 -> EltSpec
EltComposite (Word32 -> Int32
i29 (Word64 -> Word32
hi Word64
word))
    Int
sz -> ElementSize -> Word32 -> EltSpec
EltNormal (Int -> ElementSize
forall a. Enum a => Int -> a
toEnum Int
sz) (Word64 -> Int -> Int -> Word32
forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
35 Int
64)

-- | @'serializeEltSpec' eltSpec@ serializes @eltSpec@ as a 'Word64'. all bits
-- which are not determined by the 'EltSpec' are zero.
serializeEltSpec :: EltSpec -> Word64
serializeEltSpec :: EltSpec -> Word64
serializeEltSpec (EltNormal ElementSize
sz Word32
len) =
    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElementSize -> Int
forall a. Enum a => a -> Int
fromEnum ElementSize
sz) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
35)
serializeEltSpec (EltComposite Int32
words) =
    (Word64
7 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
    Word32 -> Word64
fromHi (Int32 -> Word32
fromI29 Int32
words)