diff options
author | alexbiehl <alex.biehl@gmail.com> | 2017-02-11 19:25:27 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-11 19:58:35 -0500 |
commit | d3ea38ef0299e9330a105fa59dda38f9ec0712c4 (patch) | |
tree | f73560229845e8d7b0bf0a0e35c2b6459b8e01c2 /compiler/utils/Binary.hs | |
parent | a50082c115bed1891b2e5aac4a21462935f4f0d6 (diff) | |
download | haskell-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.hs | 85 |
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 |