-- |
-- Module      : Data.ByteString.Utils.UnalignedAccess
-- Copyright   : (c) Matthew Craven 2023-2024
-- License     : BSD-style
-- Maintainer  : clyring@gmail.com
-- Stability   : internal
-- Portability : non-portable
--
-- Primitives for reading and writing at potentially-unaligned memory locations

{-# LANGUAGE CPP #-}

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

#include "bytestring-cpp-macros.h"

module Data.ByteString.Utils.UnalignedAccess
  ( unalignedWriteU16
  , unalignedWriteU32
  , unalignedWriteU64
  , unalignedWriteFloat
  , unalignedWriteDouble
  , unalignedReadU64
  ) where

import Foreign.Ptr
import Data.Word


#if HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE
import GHC.IO (IO(..))
import GHC.Word (Word16(..), Word32(..), Word64(..))
import GHC.Exts

unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()
unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()
unalignedWriteU16 = (Word16
 -> Ptr (ZonkAny 5)
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Word16 -> Ptr Word8 -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Word16
  -> Ptr (ZonkAny 5)
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Word16 -> Ptr Word8 -> IO ())
-> (Word16
    -> Ptr (ZonkAny 5)
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Word16
-> Ptr Word8
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(W16# Word16#
x#) (Ptr Addr#
p#) State# RealWorld
s
  -> (# Addr# -> Int# -> Word16# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word16# -> State# d -> State# d
writeWord8OffAddrAsWord16# Addr#
p# Int#
0# Word16#
x# State# RealWorld
s, () #)

unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()
unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()
unalignedWriteU32 = (Word32
 -> Ptr (ZonkAny 4)
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Word32 -> Ptr Word8 -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Word32
  -> Ptr (ZonkAny 4)
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Word32 -> Ptr Word8 -> IO ())
-> (Word32
    -> Ptr (ZonkAny 4)
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Word32
-> Ptr Word8
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(W32# Word32#
x#) (Ptr Addr#
p#) State# RealWorld
s
  -> (# Addr# -> Int# -> Word32# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word32# -> State# d -> State# d
writeWord8OffAddrAsWord32# Addr#
p# Int#
0# Word32#
x# State# RealWorld
s, () #)

unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()
unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()
unalignedWriteU64 = (Word64
 -> Ptr (ZonkAny 3)
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Word64 -> Ptr Word8 -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Word64
  -> Ptr (ZonkAny 3)
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Word64 -> Ptr Word8 -> IO ())
-> (Word64
    -> Ptr (ZonkAny 3)
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Word64
-> Ptr Word8
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(W64# Word64#
x#) (Ptr Addr#
p#) State# RealWorld
s
  -> (# Addr# -> Int# -> Word64# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word64# -> State# d -> State# d
writeWord8OffAddrAsWord64# Addr#
p# Int#
0# Word64#
x# State# RealWorld
s, () #)

unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()
unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()
unalignedWriteFloat = (Float
 -> Ptr (ZonkAny 2)
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Float -> Ptr Word8 -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Float
  -> Ptr (ZonkAny 2)
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Float -> Ptr Word8 -> IO ())
-> (Float
    -> Ptr (ZonkAny 2)
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Float
-> Ptr Word8
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(F# Float#
x#) (Ptr Addr#
p#) State# RealWorld
s
  -> (# Addr# -> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Float# -> State# d -> State# d
writeWord8OffAddrAsFloat# Addr#
p# Int#
0# Float#
x# State# RealWorld
s, () #)

unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()
unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()
unalignedWriteDouble = (Double
 -> Ptr (ZonkAny 1)
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Double -> Ptr Word8 -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Double
  -> Ptr (ZonkAny 1)
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Double -> Ptr Word8 -> IO ())
-> (Double
    -> Ptr (ZonkAny 1)
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Double
-> Ptr Word8
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(D# Double#
x#) (Ptr Addr#
p#) State# RealWorld
s
  -> (# Addr# -> Int# -> Double# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Double# -> State# d -> State# d
writeWord8OffAddrAsDouble# Addr#
p# Int#
0# Double#
x# State# RealWorld
s, () #)

unalignedReadU64 :: Ptr Word8 -> IO Word64
unalignedReadU64 :: Ptr Word8 -> IO Word64
unalignedReadU64 = (Ptr (ZonkAny 0)
 -> State# RealWorld -> (# State# RealWorld, Word64 #))
-> Ptr Word8 -> IO Word64
forall a b. Coercible a b => a -> b
coerce ((Ptr (ZonkAny 0)
  -> State# RealWorld -> (# State# RealWorld, Word64 #))
 -> Ptr Word8 -> IO Word64)
-> (Ptr (ZonkAny 0)
    -> State# RealWorld -> (# State# RealWorld, Word64 #))
-> Ptr Word8
-> IO Word64
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
p#) State# RealWorld
s
  -> case Addr#
-> Int# -> State# RealWorld -> (# State# RealWorld, Word64# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word64# #)
readWord8OffAddrAsWord64# Addr#
p# Int#
0# State# RealWorld
s of
       (# State# RealWorld
s', Word64#
w64# #) -> (# State# RealWorld
s', Word64# -> Word64
W64# Word64#
w64# #)

#elif HS_UNALIGNED_POKES_OK
import Foreign.Storable

unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()
unalignedWriteU16 x p = poke (castPtr p) x

unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()
unalignedWriteU32 x p = poke (castPtr p) x

unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()
unalignedWriteU64 x p = poke (castPtr p) x

unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()
unalignedWriteFloat x p = poke (castPtr p) x

unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()
unalignedWriteDouble x p = poke (castPtr p) x

unalignedReadU64 :: Ptr Word8 -> IO Word64
unalignedReadU64 p = peek (castPtr p)

#else
foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u16"
  unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u32"
  unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u64"
  unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsFloat"
  unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsDouble"
  unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static fpstring.h fps_unaligned_read_u64"
  unalignedReadU64 :: Ptr Word8 -> IO Word64
#endif