summaryrefslogtreecommitdiff
path: root/compiler/utils/Binary.hs
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-02-11 19:25:27 -0500
committerBen Gamari <ben@smart-cactus.org>2017-02-11 19:58:35 -0500
commitd3ea38ef0299e9330a105fa59dda38f9ec0712c4 (patch)
treef73560229845e8d7b0bf0a0e35c2b6459b8e01c2 /compiler/utils/Binary.hs
parenta50082c115bed1891b2e5aac4a21462935f4f0d6 (diff)
downloadhaskell-d3ea38ef0299e9330a105fa59dda38f9ec0712c4.tar.gz
Binary: Correct endian issue when cross-compiling
Using `WORDS_BIGENDIAN` wasn't such a great idea after all! When cross compiling host and target endianess may differ and `WORDS_BIGENDIAN` refers to host endianess. Reviewers: austin, bgamari, trofi Reviewed By: bgamari, trofi Subscribers: rwbarton, trofi, thomie Differential Revision: https://phabricator.haskell.org/D3122
Diffstat (limited to 'compiler/utils/Binary.hs')
-rw-r--r--compiler/utils/Binary.hs85
1 files changed, 55 insertions, 30 deletions
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 565d162be6..ffd1eb25fa 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -225,30 +225,6 @@ expandBin (BinMem _ _ sz_r arr_r) off = do
-- -----------------------------------------------------------------------------
-- Low-level reading/writing of bytes
-be16 :: Word16 -> Word16
-#ifdef WORDS_BIGENDIAN
-be16 w = w
-#else
-be16 w = byteSwap16 w
-#endif
-{-# INLINE be16 #-}
-
-be32 :: Word32 -> Word32
-#ifdef WORDS_BIGENDIAN
-be32 w = w
-#else
-be32 w = byteSwap32 w
-#endif
-{-# INLINE be32 #-}
-
-be64 :: Word64 -> Word64
-#ifdef WORDS_BIGENDIAN
-be64 w = w
-#else
-be64 w = byteSwap64 w
-#endif
-{-# INLINE be64 #-}
-
putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()
putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do
ix <- readFastMutInt ix_r
@@ -277,22 +253,71 @@ getWord8 :: BinHandle -> IO Word8
getWord8 h = getPrim h 1 peek
putWord16 :: BinHandle -> Word16 -> IO ()
-putWord16 h w = putPrim h 2 (\op -> poke (castPtr op :: Ptr Word16) (be16 w))
+putWord16 h w = putPrim h 2 (\op -> do
+ pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
+ pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
+ )
getWord16 :: BinHandle -> IO Word16
-getWord16 h = getPrim h 2 (\op -> be16 <$> peek (castPtr op :: Ptr Word16))
+getWord16 h = getPrim h 2 (\op -> do
+ w0 <- fromIntegral <$> peekElemOff op 0
+ w1 <- fromIntegral <$> peekElemOff op 1
+ return $! w0 `shiftL` 8 .|. w1
+ )
putWord32 :: BinHandle -> Word32 -> IO ()
-putWord32 h w = putPrim h 4 (\op -> poke (castPtr op :: Ptr Word32) (be32 w))
+putWord32 h w = putPrim h 4 (\op -> do
+ pokeElemOff op 0 (fromIntegral (w `shiftR` 24))
+ pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
+ pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
+ pokeElemOff op 3 (fromIntegral (w .&. 0xFF))
+ )
getWord32 :: BinHandle -> IO Word32
-getWord32 h = getPrim h 4 (\op -> be32 <$> peek (castPtr op :: Ptr Word32))
+getWord32 h = getPrim h 4 (\op -> do
+ w0 <- fromIntegral <$> peekElemOff op 0
+ w1 <- fromIntegral <$> peekElemOff op 1
+ w2 <- fromIntegral <$> peekElemOff op 2
+ w3 <- fromIntegral <$> peekElemOff op 3
+
+ return $! (w0 `shiftL` 24) .|.
+ (w1 `shiftL` 16) .|.
+ (w2 `shiftL` 8) .|.
+ w3
+ )
putWord64 :: BinHandle -> Word64 -> IO ()
-putWord64 h w = putPrim h 8 (\op -> poke (castPtr op :: Ptr Word64) (be64 w))
+putWord64 h w = putPrim h 8 (\op -> do
+ pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
+ pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
+ pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
+ pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
+ pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
+ pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
+ pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
+ pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
+ )
getWord64 :: BinHandle -> IO Word64
-getWord64 h = getPrim h 8 (\op -> be64 <$> peek (castPtr op :: Ptr Word64))
+getWord64 h = getPrim h 8 (\op -> do
+ w0 <- fromIntegral <$> peekElemOff op 0
+ w1 <- fromIntegral <$> peekElemOff op 1
+ w2 <- fromIntegral <$> peekElemOff op 2
+ w3 <- fromIntegral <$> peekElemOff op 3
+ w4 <- fromIntegral <$> peekElemOff op 4
+ w5 <- fromIntegral <$> peekElemOff op 5
+ w6 <- fromIntegral <$> peekElemOff op 6
+ w7 <- fromIntegral <$> peekElemOff op 7
+
+ return $! (w0 `shiftL` 56) .|.
+ (w1 `shiftL` 48) .|.
+ (w2 `shiftL` 40) .|.
+ (w3 `shiftL` 32) .|.
+ (w4 `shiftL` 24) .|.
+ (w5 `shiftL` 16) .|.
+ (w6 `shiftL` 8) .|.
+ w7
+ )
putByte :: BinHandle -> Word8 -> IO ()
putByte bh w = putWord8 bh w