-- |
-- 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 Capnp.Bits
import Data.Bits
import Data.Int
import Data.Word

-- | A 'Ptr' represents the information in a capnproto pointer.
data Ptr
  = -- | @'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.
    StructPtr !Int32 !Word16 !Word16
  | -- | @'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
    ListPtr !Int32 !EltSpec
  | -- | @'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@.
    FarPtr !Bool !Word32 !Word32
  | -- | @'CapPtr' id@ is a pointer to the capability with the id @id@.
    CapPtr !Word32
  deriving (Int -> Ptr -> ShowS
[Ptr] -> ShowS
Ptr -> String
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
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
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
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]
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' 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.
    EltNormal !ElementSize !Word32
  | -- | @EltComposite len@ is a composite element (C == 7). @len@ is the
    -- length of the list in words.
    EltComposite !Int32
  deriving (Int -> EltSpec -> ShowS
[EltSpec] -> ShowS
EltSpec -> String
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
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 = forall a. Maybe a
Nothing
parsePtr Word64
p = 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 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))
        (forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
48)
        (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
        (forall a. Enum a => Int -> a
toEnum (forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
2 Int
3))
        (forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
3 Int
32)
        (forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
64)
    Word64
3 -> Word32 -> Ptr
CapPtr (forall a. Integral a => Word64 -> Int -> Int -> a
bitRange Word64
word Int
32 Int
64)
    Word64
_ -> 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)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
serializePtr' (ListPtr Int32
off EltSpec
eltSpec) =
  -- eltSz numElts) =
  Word64
1
    forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
fromLo (Int32 -> Word32
fromI30 Int32
off)
    forall a. Bits a => a -> a -> a
.|. EltSpec -> Word64
serializeEltSpec EltSpec
eltSpec
serializePtr' (FarPtr Bool
twoWords Word32
off Word32
segId) =
  Word64
2
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum Bool
twoWords) forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off forall a. Bits a => a -> Int -> a
`shiftL` Int
3)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segId forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
serializePtr' (CapPtr Word32
index) =
  Word64
3
    forall a. Bits a => a -> a -> a
.|.
    -- (fromIntegral 0 `shiftL` 2) .|.
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
index 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 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 (forall a. Enum a => Int -> a
toEnum Int
sz) (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) =
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ElementSize
sz) forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
    forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len forall a. Bits a => a -> Int -> a
`shiftL` Int
35)
serializeEltSpec (EltComposite Int32
words) =
  (Word64
7 forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
    forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
fromHi (Int32 -> Word32
fromI29 Int32
words)