{-|
Module: Capnp.Address
Description: Utilities for manipulating addresses within capnproto messages.

This module provides facilities for manipulating raw addresses within
Cap'N Proto messages.

This is a low level module that very few users will need to use directly.
-}
{-# LANGUAGE RecordWildCards #-}
module Capnp.Address
    ( WordAddr(..)
    , CapAddr(..)
    , Addr(..)
    , OffsetError(..)
    , computeOffset
    , pointerFrom
    )
  where

import Data.Bits
import Data.Word

import Capnp.Bits (WordCount)

import qualified Capnp.Pointer as P

-- | The address of a word within a message
data WordAddr = WordAt
    { WordAddr -> Int
segIndex  :: !Int -- ^ Segment number
    , WordAddr -> WordCount
wordIndex :: !WordCount -- ^ offset in words from the start of the segment.
    } deriving(Int -> WordAddr -> ShowS
[WordAddr] -> ShowS
WordAddr -> String
(Int -> WordAddr -> ShowS)
-> (WordAddr -> String) -> ([WordAddr] -> ShowS) -> Show WordAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordAddr] -> ShowS
$cshowList :: [WordAddr] -> ShowS
show :: WordAddr -> String
$cshow :: WordAddr -> String
showsPrec :: Int -> WordAddr -> ShowS
$cshowsPrec :: Int -> WordAddr -> ShowS
Show, WordAddr -> WordAddr -> Bool
(WordAddr -> WordAddr -> Bool)
-> (WordAddr -> WordAddr -> Bool) -> Eq WordAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordAddr -> WordAddr -> Bool
$c/= :: WordAddr -> WordAddr -> Bool
== :: WordAddr -> WordAddr -> Bool
$c== :: WordAddr -> WordAddr -> Bool
Eq)

-- | The "address" of a capability
newtype CapAddr = Cap Word32 deriving(Int -> CapAddr -> ShowS
[CapAddr] -> ShowS
CapAddr -> String
(Int -> CapAddr -> ShowS)
-> (CapAddr -> String) -> ([CapAddr] -> ShowS) -> Show CapAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapAddr] -> ShowS
$cshowList :: [CapAddr] -> ShowS
show :: CapAddr -> String
$cshow :: CapAddr -> String
showsPrec :: Int -> CapAddr -> ShowS
$cshowsPrec :: Int -> CapAddr -> ShowS
Show, CapAddr -> CapAddr -> Bool
(CapAddr -> CapAddr -> Bool)
-> (CapAddr -> CapAddr -> Bool) -> Eq CapAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapAddr -> CapAddr -> Bool
$c/= :: CapAddr -> CapAddr -> Bool
== :: CapAddr -> CapAddr -> Bool
$c== :: CapAddr -> CapAddr -> Bool
Eq)

-- | An address, i.e. a location that a pointer may point at.
data Addr
    -- | The address of some data in the message.
    = WordAddr !WordAddr
    -- | The "address" of a capability.
    | CapAddr !CapAddr
    deriving(Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Addr] -> ShowS
$cshowList :: [Addr] -> ShowS
show :: Addr -> String
$cshow :: Addr -> String
showsPrec :: Int -> Addr -> ShowS
$cshowsPrec :: Int -> Addr -> ShowS
Show, Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq)

-- | An error returned by 'computeOffset'; this describes the reason why a
-- value cannot be directly addressed from a given location.
data OffsetError
    -- | The pointer and the value are in different segments.
    = DifferentSegments
    -- | The pointer is in the correct segment, but too far away to encode the
    -- offset. (more than 30 bits would be required). This can only happen with
    -- segments that are > 8 GiB, which this library refuses to either decode
    -- or generate, so this should not come up in practice.
    | OutOfRange

-- | @'computeOffset' ptrAddr valueAddr@ computes the offset that should be
-- stored in a struct or list pointer located at @ptrAddr@, in order to point
-- at a value located at @valueAddr@. If the value cannot be directly addressed
-- by a pointer at @ptrAddr@, then this returns 'Left', with the 'OffsetError'
-- describing the problem.
computeOffset :: WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset :: WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset WordAddr
ptrAddr WordAddr
valueAddr
    | WordAddr -> Int
segIndex WordAddr
ptrAddr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= WordAddr -> Int
segIndex WordAddr
valueAddr = OffsetError -> Either OffsetError WordCount
forall a b. a -> Either a b
Left OffsetError
DifferentSegments
    | Bool
otherwise =
        let offset :: WordCount
offset = WordAddr -> WordCount
wordIndex WordAddr
valueAddr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
- (WordAddr -> WordCount
wordIndex WordAddr
ptrAddr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1)
        in if WordCount
offset WordCount -> WordCount -> Bool
forall a. Ord a => a -> a -> Bool
>= WordCount
1 WordCount -> Int -> WordCount
forall a. Bits a => a -> Int -> a
`shiftL` Int
30
            then OffsetError -> Either OffsetError WordCount
forall a b. a -> Either a b
Left OffsetError
OutOfRange
            else WordCount -> Either OffsetError WordCount
forall a b. b -> Either a b
Right WordCount
offset

-- | @'pointerFrom' ptrAddr targetAddr ptr@ updates @ptr@, such that it is
-- correct to target a value located at @targetAddr@ given that the pointer
-- itself is located at @ptrAddr@. Returns 'Left' if this is not possible.
--
-- It is illegal to call this on a capability pointer.
--
-- For far pointers, @targetAddr@ is taken to be the address of the landing pad,
-- rather than the final value.
pointerFrom :: WordAddr -> WordAddr -> P.Ptr -> Either OffsetError P.Ptr
pointerFrom :: WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
_ WordAddr
_ (P.CapPtr Word32
_) = String -> Either OffsetError Ptr
forall a. HasCallStack => String -> a
error String
"pointerFrom called on a capability pointer."
pointerFrom WordAddr
_ WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
..} (P.FarPtr Bool
twoWords Word32
_ Word32
_) =
    Ptr -> Either OffsetError Ptr
forall a b. b -> Either a b
Right (Ptr -> Either OffsetError Ptr) -> Ptr -> Either OffsetError Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
twoWords (WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
pointerFrom WordAddr
ptrAddr WordAddr
targetAddr (P.StructPtr Int32
_ Word16
dataSz Word16
ptrSz) =
    ((WordCount -> Ptr)
 -> Either OffsetError WordCount -> Either OffsetError Ptr)
-> Either OffsetError WordCount
-> (WordCount -> Ptr)
-> Either OffsetError Ptr
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WordCount -> Ptr)
-> Either OffsetError WordCount -> Either OffsetError Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset WordAddr
ptrAddr WordAddr
targetAddr) ((WordCount -> Ptr) -> Either OffsetError Ptr)
-> (WordCount -> Ptr) -> Either OffsetError Ptr
forall a b. (a -> b) -> a -> b
$
        \WordCount
off -> Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (WordCount -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
off) Word16
dataSz Word16
ptrSz
pointerFrom WordAddr
ptrAddr WordAddr
targetAddr (P.ListPtr Int32
_ EltSpec
eltSpec) =
    ((WordCount -> Ptr)
 -> Either OffsetError WordCount -> Either OffsetError Ptr)
-> Either OffsetError WordCount
-> (WordCount -> Ptr)
-> Either OffsetError Ptr
forall a b c. (a -> b -> c) -> b -> a -> c
flip (WordCount -> Ptr)
-> Either OffsetError WordCount -> Either OffsetError Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset WordAddr
ptrAddr WordAddr
targetAddr) ((WordCount -> Ptr) -> Either OffsetError Ptr)
-> (WordCount -> Ptr) -> Either OffsetError Ptr
forall a b. (a -> b) -> a -> b
$
        \WordCount
off -> Int32 -> EltSpec -> Ptr
P.ListPtr (WordCount -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
off) EltSpec
eltSpec