diff --git a/binary.cabal b/binary.cabal index 5f305ed..ff93dbb 100644 --- a/binary.cabal +++ b/binary.cabal @@ -53,7 +53,7 @@ library Data.Binary.Internal, Data.Binary.Generic, Data.Binary.FloatCast - + c-sources: cbits/unaligned_read.c ghc-options: -O2 -Wall -fliberate-case-threshold=1000 if impl(ghc >= 8.0) diff --git a/cbits/unaligned_read.c b/cbits/unaligned_read.c new file mode 100644 index 0000000..3437c67 --- /dev/null +++ b/cbits/unaligned_read.c @@ -0,0 +1,16 @@ +#include + +#include "HsFFI.h" + +#define UNALIGNED_READ(TYPE) Hs##TYPE _hs_binary_unaligned_read_##TYPE(HsWord8 *ptr) { Hs##TYPE result; memcpy(&result, ptr, sizeof(Hs##TYPE)); return result; } + +UNALIGNED_READ(Word) +UNALIGNED_READ(Word16) +UNALIGNED_READ(Word32) +UNALIGNED_READ(Word64) +UNALIGNED_READ(Int) +UNALIGNED_READ(Int16) +UNALIGNED_READ(Int32) +UNALIGNED_READ(Int64) +UNALIGNED_READ(Float) +UNALIGNED_READ(Double) diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs index a0b57da..d20a7e9 100644 --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -446,15 +446,6 @@ getShortByteString = fmap toShort . getByteString ------------------------------------------------------------------------ -- Primitives --- helper, get a raw Ptr onto a strict ByteString copied out of the --- underlying lazy byteString. - -#if !defined(HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE) -getPtr :: Storable a => Int -> Get a -getPtr n = readNWith n peek -{-# INLINE getPtr #-} -#endif - -- | Read a Word8 from the monad state getWord8 :: Get Word8 getWord8 = readN 1 B.unsafeHead @@ -594,7 +585,9 @@ getWordhost = readNWith SIZEOF_HSWORD $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsWord# p# 0# s of (# s', w# #) -> (# s', W# w# #) #else -getWordhost = getPtr (sizeOf (undefined :: Word)) +getWordhost = readNWith (sizeOf (0 :: Word)) unalignedReadWord + +foreign import ccall unsafe "_hs_binary_unaligned_read_Word" unalignedReadWord :: Ptr Word -> IO Word #endif {-# INLINE getWordhost #-} @@ -605,7 +598,9 @@ getWord16host = readNWith 2 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsWord16# p# 0# s of (# s', w16# #) -> (# s', W16# w16# #) #else -getWord16host = getPtr (sizeOf (undefined :: Word16)) +getWord16host = readNWith (sizeOf (0 :: Word16)) unalignedReadWord16 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Word16" unalignedReadWord16 :: Ptr Word16 -> IO Word16 #endif {-# INLINE getWord16host #-} @@ -616,7 +611,9 @@ getWord32host = readNWith 4 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsWord32# p# 0# s of (# s', w32# #) -> (# s', W32# w32# #) #else -getWord32host = getPtr (sizeOf (undefined :: Word32)) +getWord32host = readNWith (sizeOf (0 :: Word32)) unalignedReadWord32 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Word32" unalignedReadWord32 :: Ptr Word32 -> IO Word32 #endif {-# INLINE getWord32host #-} @@ -627,7 +624,9 @@ getWord64host = readNWith 8 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsWord64# p# 0# s of (# s', w64# #) -> (# s', W64# w64# #) #else -getWord64host = getPtr (sizeOf (undefined :: Word64)) +getWord64host = readNWith (sizeOf (0 :: Word64)) unalignedReadWord64 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Word64" unalignedReadWord64 :: Ptr Word64 -> IO Word64 #endif {-# INLINE getWord64host #-} @@ -639,7 +638,9 @@ getInthost = readNWith SIZEOF_HSINT $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsInt# p# 0# s of (# s', i# #) -> (# s', I# i# #) #else -getInthost = getPtr (sizeOf (undefined :: Int)) +getInthost = readNWith (sizeOf (0 :: Int)) unalignedReadInt + +foreign import ccall unsafe "_hs_binary_unaligned_read_Int" unalignedReadInt :: Ptr Int -> IO Int #endif {-# INLINE getInthost #-} @@ -650,7 +651,9 @@ getInt16host = readNWith 2 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsInt16# p# 0# s of (# s', i16# #) -> (# s', I16# i16# #) #else -getInt16host = getPtr (sizeOf (undefined :: Int16)) +getInt16host = readNWith (sizeOf (0 :: Int16)) unalignedReadInt16 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Int16" unalignedReadInt16 :: Ptr Int16 -> IO Int16 #endif {-# INLINE getInt16host #-} @@ -661,7 +664,9 @@ getInt32host = readNWith 4 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsInt32# p# 0# s of (# s', i32# #) -> (# s', I32# i32# #) #else -getInt32host = getPtr (sizeOf (undefined :: Int32)) +getInt32host = readNWith (sizeOf (0 :: Int32)) unalignedReadInt32 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Int32" unalignedReadInt32 :: Ptr Int32 -> IO Int32 #endif {-# INLINE getInt32host #-} @@ -672,7 +677,9 @@ getInt64host = readNWith 8 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsInt64# p# 0# s of (# s', i64# #) -> (# s', I64# i64# #) #else -getInt64host = getPtr (sizeOf (undefined :: Int64)) +getInt64host = readNWith (sizeOf (0 :: Int64)) unalignedReadInt64 + +foreign import ccall unsafe "_hs_binary_unaligned_read_Int64" unalignedReadInt64 :: Ptr Int64 -> IO Int64 #endif {-# INLINE getInt64host #-} @@ -705,7 +712,9 @@ getFloathost = readNWith 4 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsFloat# p# 0# s of (# s', f# #) -> (# s', F# f# #) #else -getFloathost = wordToFloat <$> getWord32host +getFloathost = readNWith (sizeOf (0 :: Float)) unalignedReadFloat + +foreign import ccall unsafe "_hs_binary_unaligned_read_Float" unalignedReadFloat :: Ptr Float -> IO Float #endif {-# INLINE getFloathost #-} @@ -734,6 +743,8 @@ getDoublehost = readNWith 8 $ \(Ptr p#) -> IO $ \s -> case readWord8OffAddrAsDouble# p# 0# s of (# s', d# #) -> (# s', D# d# #) #else -getDoublehost = wordToDouble <$> getWord64host +getDoublehost = readNWith (sizeOf (0 :: Double)) unalignedReadDouble + +foreign import ccall unsafe "_hs_binary_unaligned_read_Double" unalignedReadDouble :: Ptr Double -> IO Double #endif {-# INLINE getDoublehost #-}