{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

{- FOURMOLU_DISABLE -}
-- | Primitive operations on machine addresses.
module Data.Primitive.Addr
  ( -- * Types
    Addr(..)
    -- * Address arithmetic
  , nullAddr
  , plusAddr
  , minusAddr
  , remAddr
  -- * Element access
  , indexOffAddr
  , readOffAddr
  , writeOffAddr
  -- * Block operations
  , copyAddr
#if __GLASGOW_HASKELL__ >= 708
  , copyAddrToByteArray
#endif
  , moveAddr
  , setAddr
  -- * Conversion
  , addrToInt
) where
{- FOURMOLU_ENABLE -}

import Control.Monad.Primitive
import Data.Primitive.ByteArray
import Data.Primitive.Types (Prim (..))
import Numeric (showHex)

import Foreign.Marshal.Utils
import GHC.Exts

#if __GLASGOW_HASKELL__ < 708
toBool# :: Bool -> Bool
toBool# = id
#else
toBool# :: Int# -> Bool
toBool# :: Int# -> Bool
toBool# = Int# -> Bool
isTrue#
#endif

-- | A machine address
data Addr = Addr Addr#

instance Show Addr where
  showsPrec :: Int -> Addr -> ShowS
showsPrec Int
_ (Addr Addr#
a) =
    String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> ShowS
forall a. Integral a => a -> ShowS
showHex (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
a)) :: Word)

instance Eq Addr where
  Addr Addr#
a# == :: Addr -> Addr -> Bool
== Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
eqAddr# Addr#
a# Addr#
b#)
  Addr Addr#
a# /= :: Addr -> Addr -> Bool
/= Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
neAddr# Addr#
a# Addr#
b#)

instance Ord Addr where
  Addr Addr#
a# > :: Addr -> Addr -> Bool
> Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
gtAddr# Addr#
a# Addr#
b#)
  Addr Addr#
a# >= :: Addr -> Addr -> Bool
>= Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
geAddr# Addr#
a# Addr#
b#)
  Addr Addr#
a# < :: Addr -> Addr -> Bool
< Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
ltAddr# Addr#
a# Addr#
b#)
  Addr Addr#
a# <= :: Addr -> Addr -> Bool
<= Addr Addr#
b# = Int# -> Bool
toBool# (Addr# -> Addr# -> Int#
leAddr# Addr#
a# Addr#
b#)

-- | The null address
nullAddr :: Addr
nullAddr :: Addr
nullAddr = Addr# -> Addr
Addr Addr#
nullAddr#

infixl 6 `plusAddr`, `minusAddr`
infixl 7 `remAddr`

-- | Offset an address by the given number of bytes
plusAddr :: Addr -> Int -> Addr
plusAddr :: Addr -> Int -> Addr
plusAddr (Addr Addr#
a#) (I# Int#
i#) = Addr# -> Addr
Addr (Addr# -> Int# -> Addr#
plusAddr# Addr#
a# Int#
i#)

{- | Distance in bytes between two addresses. The result is only valid if the
difference fits in an 'Int'.
-}
minusAddr :: Addr -> Addr -> Int
minusAddr :: Addr -> Addr -> Int
minusAddr (Addr Addr#
a#) (Addr Addr#
b#) = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
a# Addr#
b#)

-- | The remainder of the address and the integer.
remAddr :: Addr -> Int -> Int
remAddr :: Addr -> Int -> Int
remAddr (Addr Addr#
a#) (I# Int#
i#) = Int# -> Int
I# (Addr# -> Int# -> Int#
remAddr# Addr#
a# Int#
i#)

{- | Read a value from a memory position given by an address and an offset.
The memory block the address refers to must be immutable. The offset is in
elements of type @a@ rather than in bytes.
-}
indexOffAddr :: (Prim a) => Addr -> Int -> a
{-# INLINE indexOffAddr #-}
indexOffAddr :: forall a. Prim a => Addr -> Int -> a
indexOffAddr (Addr Addr#
addr#) (I# Int#
i#) = Addr# -> Int# -> a
forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
addr# Int#
i#

{- | Read a value from a memory position given by an address and an offset.
The offset is in elements of type @a@ rather than in bytes.
-}
readOffAddr :: (Prim a, PrimMonad m) => Addr -> Int -> m a
{-# INLINE readOffAddr #-}
readOffAddr :: forall a (m :: * -> *). (Prim a, PrimMonad m) => Addr -> Int -> m a
readOffAddr (Addr Addr#
addr#) (I# Int#
i#) = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (Addr#
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall s. Addr# -> Int# -> State# s -> (# State# s, a #)
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
addr# Int#
i#)

{- | Write a value to a memory position given by an address and an offset.
The offset is in elements of type @a@ rather than in bytes.
-}
writeOffAddr :: (Prim a, PrimMonad m) => Addr -> Int -> a -> m ()
{-# INLINE writeOffAddr #-}
writeOffAddr :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
writeOffAddr (Addr Addr#
addr#) (I# Int#
i#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Addr# -> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall s. Addr# -> Int# -> a -> State# s -> State# s
forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# Int#
i# a
x)

{- | Copy the given number of bytes from the second 'Addr' to the first. The
areas may not overlap.
-}
copyAddr ::
  (PrimMonad m) =>
  -- | destination address
  Addr ->
  -- | source address
  Addr ->
  -- | number of bytes
  Int ->
  m ()
{-# INLINE copyAddr #-}
copyAddr :: forall (m :: * -> *). PrimMonad m => Addr -> Addr -> Int -> m ()
copyAddr (Addr Addr#
dst#) (Addr Addr#
src#) Int
n =
  IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst#) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
src#) Int
n

#if __GLASGOW_HASKELL__ >= 708
-- | Copy the given number of bytes from the 'Addr' to the 'MutableByteArray'.
--   The areas may not overlap. This function is only available when compiling
--   with GHC 7.8 or newer.
copyAddrToByteArray :: PrimMonad m
  => MutableByteArray (PrimState m) -- ^ destination
  -> Int -- ^ offset into the destination array
  -> Addr -- ^ source
  -> Int -- ^ number of bytes to copy
  -> m ()
{-# INLINE copyAddrToByteArray #-}
copyAddrToByteArray :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Addr -> Int -> m ()
copyAddrToByteArray (MutableByteArray MutableByteArray# (PrimState m)
marr) (I# Int#
off) (Addr Addr#
addr) (I# Int#
len) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ Addr#
-> MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# (PrimState m)
marr Int#
off Int#
len
#endif

{- | Copy the given number of bytes from the second 'Addr' to the first. The
areas may overlap.
-}
moveAddr ::
  (PrimMonad m) =>
  -- | destination address
  Addr ->
  -- | source address
  Addr ->
  -- | number of bytes
  Int ->
  m ()
{-# INLINE moveAddr #-}
moveAddr :: forall (m :: * -> *). PrimMonad m => Addr -> Addr -> Int -> m ()
moveAddr (Addr Addr#
dst#) (Addr Addr#
src#) Int
n =
  IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst#) (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
src#) Int
n

{- | Fill a memory block of with the given value. The length is in
elements of type @a@ rather than in bytes.
-}
setAddr :: (Prim a, PrimMonad m) => Addr -> Int -> a -> m ()
{-# INLINE setAddr #-}
setAddr :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Addr -> Int -> a -> m ()
setAddr (Addr Addr#
addr#) (I# Int#
n#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Addr#
-> Int#
-> Int#
-> a
-> State# (PrimState m)
-> State# (PrimState m)
forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
setOffAddr# Addr#
addr# Int#
0# Int#
n# a
x)

-- | Convert an 'Addr' to an 'Int'.
addrToInt :: Addr -> Int
{-# INLINE addrToInt #-}
addrToInt :: Addr -> Int
addrToInt (Addr Addr#
addr#) = Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
addr#)