{-# LANGUAGE RecordWildCards #-}

-- |
-- 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.
module Capnp.Address
  ( WordAddr (..),
    CapAddr (..),
    Addr (..),
    OffsetError (..),
    computeOffset,
    pointerFrom,
    resolveOffset,
  )
where

import Capnp.Bits (WordCount)
import qualified Capnp.Pointer as P
import Data.Bits
import Data.Int
import Data.Word

-- | The address of a word within a message
data WordAddr = WordAt
  { -- | Segment number
    WordAddr -> Int
segIndex :: !Int,
    -- | offset in words from the start of the segment.
    WordAddr -> WordCount
wordIndex :: !WordCount
  }
  deriving (Int -> WordAddr -> ShowS
[WordAddr] -> ShowS
WordAddr -> String
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
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
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
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
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
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 forall a. Eq a => a -> a -> Bool
/= WordAddr -> Int
segIndex WordAddr
valueAddr = forall a b. a -> Either a b
Left OffsetError
DifferentSegments
  | Bool
otherwise =
      let offset :: WordCount
offset = WordAddr -> WordCount
wordIndex WordAddr
valueAddr forall a. Num a => a -> a -> a
- (WordAddr -> WordCount
wordIndex WordAddr
ptrAddr forall a. Num a => a -> a -> a
+ WordCount
1)
       in if WordCount
offset forall a. Ord a => a -> a -> Bool
>= WordCount
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
30
            then forall a b. a -> Either a b
Left OffsetError
OutOfRange
            else 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
_) = 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
_) =
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
twoWords (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
pointerFrom WordAddr
ptrAddr WordAddr
targetAddr (P.StructPtr Int32
_ Word16
dataSz Word16
ptrSz) =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset WordAddr
ptrAddr WordAddr
targetAddr) forall a b. (a -> b) -> a -> b
$
    \WordCount
off -> Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (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) =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WordAddr -> WordAddr -> Either OffsetError WordCount
computeOffset WordAddr
ptrAddr WordAddr
targetAddr) forall a b. (a -> b) -> a -> b
$
    \WordCount
off -> Int32 -> EltSpec -> Ptr
P.ListPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
off) EltSpec
eltSpec

-- | Add an offset to a WordAddr.
resolveOffset :: WordAddr -> Int32 -> WordAddr
resolveOffset :: WordAddr -> Int32 -> WordAddr
resolveOffset addr :: WordAddr
addr@WordAt {Int
WordCount
wordIndex :: WordCount
segIndex :: Int
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
..} Int32
off =
  WordAddr
addr {wordIndex :: WordCount
wordIndex = WordCount
wordIndex forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
off forall a. Num a => a -> a -> a
+ WordCount
1}