{-# LANGUAGE CPP #-}

module PtrPoker.IO.Prim where

import PtrPoker.Prelude
import qualified PtrPoker.UncheckedShifting as UncheckedShifting

{-# INLINE pokeStorable #-}
pokeStorable :: Storable a => Ptr Word8 -> a -> IO ()
pokeStorable :: Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr a
value =
  {-# SCC "pokeStorable" #-}
  Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) a
value

{-# INLINE pokeWord8 #-}
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 :: Ptr Word8 -> Word8 -> IO ()
pokeWord8 Ptr Word8
ptr Word8
value =
  {-# SCC "pokeWord8" #-}
  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr Word8
value

{-# INLINE pokeWord8Off #-}
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO ()
pokeWord8Off Ptr Word8
ptr Int
off Word8
value =
  {-# SCC "pokeWord8Off" #-}
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
off Word8
value

{-# INLINE pokeBEWord16 #-}
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord16 =
  {-# SCC "pokeBEWord16" #-} 
  pokeStorable
#else
pokeBEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeBEWord16 Ptr Word8
ptr Word16
value =
  {-# SCC "pokeBEWord16" #-} 
  do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
UncheckedShifting.shiftr_w16 Word16
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
value :: Word8)
#endif

{-# INLINE pokeBEWord32 #-}
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord32 =
  {-# SCC "pokeBEWord32" #-} 
  pokeStorable
#else
pokeBEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 Ptr Word8
ptr Word32
value =
  {-# SCC "pokeBEWord32" #-} 
  do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable Ptr Word8
ptr (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
UncheckedShifting.shiftr_w32 Word32
value Int
24) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
1 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
UncheckedShifting.shiftr_w32 Word32
value Int
16) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
2 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
UncheckedShifting.shiftr_w32 Word32
value Int
8) :: Word8)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
3 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
value :: Word8)
#endif

{-# INLINE pokeBEWord64 #-}
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeBEWord64 =
  {-# SCC "pokeBEWord64" #-} 
  pokeStorable
#else
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
pokeBEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeBEWord64 Ptr Word8
ptr Word64
value =
  {-# SCC "pokeBEWord64" #-} 
  do
    Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 Ptr Word8
ptr (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
UncheckedShifting.shiftr_w64 Word64
value Int
32))
    Ptr Word8 -> Word32 -> IO ()
pokeBEWord32 (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
4) (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value)
#else
pokeBEWord64 ptr value =
  {-# SCC "pokeBEWord64" #-} 
  do
    pokeStorable ptr (fromIntegral (UncheckedShifting.shiftr_w64 value 56) :: Word8)
    pokeByteOff ptr 1 (fromIntegral (UncheckedShifting.shiftr_w64 value 48) :: Word8)
    pokeByteOff ptr 2 (fromIntegral (UncheckedShifting.shiftr_w64 value 40) :: Word8)
    pokeByteOff ptr 3 (fromIntegral (UncheckedShifting.shiftr_w64 value 32) :: Word8)
    pokeByteOff ptr 4 (fromIntegral (UncheckedShifting.shiftr_w64 value 24) :: Word8)
    pokeByteOff ptr 5 (fromIntegral (UncheckedShifting.shiftr_w64 value 16) :: Word8)
    pokeByteOff ptr 6 (fromIntegral (UncheckedShifting.shiftr_w64 value  8) :: Word8)
    pokeByteOff ptr 7 (fromIntegral value :: Word8)
#endif
#endif

{-# INLINE pokeLEWord16 #-}
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord16 p w =
  {-# SCC "pokeLEWord16" #-} 
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w16 w 8))
#else
pokeLEWord16 :: Ptr Word8 -> Word16 -> IO ()
pokeLEWord16 =
  {-# SCC "pokeLEWord16" #-} 
  Ptr Word8 -> Word16 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord32 #-}
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
#ifdef WORDS_BIGENDIAN
pokeLEWord32 p w =
  {-# SCC "pokeLEWord32" #-}
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w32 w 8))
    pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w32 w 16))
    pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w32 w 24))
#else
pokeLEWord32 :: Ptr Word8 -> Word32 -> IO ()
pokeLEWord32 =
  {-# SCC "pokeLEWord32" #-} 
  Ptr Word8 -> Word32 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif

{-# INLINE pokeLEWord64 #-}
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
#ifdef WORDS_BIGENDIAN
#if WORD_SIZE_IN_BITS < 64
--
-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to
-- Word32, and write that
--
pokeLEWord64 p w =
  {-# SCC "pokeLEWord64" #-} 
  do
    let b = fromIntegral (UncheckedShifting.shiftr_w64 w 32) :: Word32
        a = fromIntegral w :: Word32
    pokeWord8 p (fromIntegral a)
    pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w32 a 8))
    pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w32 a 16))
    pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w32 a 24))
    pokeWord8Off p 4 (fromIntegral b)
    pokeWord8Off p 5 (fromIntegral (UncheckedShifting.shiftr_w32 b 8))
    pokeWord8Off p 6 (fromIntegral (UncheckedShifting.shiftr_w32 b 16))
    pokeWord8Off p 7 (fromIntegral (UncheckedShifting.shiftr_w32 b 24))
#else
pokeLEWord64 p w =
  {-# SCC "pokeLEWord64" #-} 
  do
    pokeWord8 p (fromIntegral w)
    pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w64 w 8))
    pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w64 w 16))
    pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w64 w 24))
    pokeWord8Off p 4 (fromIntegral (UncheckedShifting.shiftr_w64 w 32))
    pokeWord8Off p 5 (fromIntegral (UncheckedShifting.shiftr_w64 w 40))
    pokeWord8Off p 6 (fromIntegral (UncheckedShifting.shiftr_w64 w 48))
    pokeWord8Off p 7 (fromIntegral (UncheckedShifting.shiftr_w64 w 56))
#endif
#else
pokeLEWord64 :: Ptr Word8 -> Word64 -> IO ()
pokeLEWord64 =
  {-# SCC "pokeLEWord64" #-} 
  Ptr Word8 -> Word64 -> IO ()
forall a. Storable a => Ptr Word8 -> a -> IO ()
pokeStorable
#endif