bitcoin-hs-0.0.1: Bitcoin/Misc/Endian.hs
-- | Dealing with endianness issues
{-# LANGUAGE BangPatterns #-}
module Bitcoin.Misc.Endian where
--------------------------------------------------------------------------------
import Data.Word
import Foreign
import qualified System.IO.Unsafe as Unsafe
--------------------------------------------------------------------------------
data Endian
= LittleEndian
| BigEndian
deriving (Eq,Show)
isLittleEndian :: Endian -> Bool
isLittleEndian e = case e of
LittleEndian -> True
BigEndian -> False
isBigEndian :: Endian -> Bool
isBigEndian e = case e of
LittleEndian -> False
BigEndian -> True
--------------------------------------------------------------------------------
hostEndian :: Endian
hostEndian = Unsafe.unsafePerformIO detectHostEndian
detectHostEndian :: IO Endian
detectHostEndian = do
let be = 0x12345678 :: Word32
le = 0x78563412 :: Word32
ws = [0x12,0x34,0x56,0x78] :: [Word8]
allocaArray 4 $ \p_word8 -> do
pokeArray p_word8 ws
x <- peek (castPtr p_word8 :: Ptr Word32)
if x == le
then return LittleEndian
else if x == be
then return BigEndian
else error "fatal error: cannot detect endianness of host (neither little-endian nor big-endian)"
--------------------------------------------------------------------------------
class HasByteOrder a where
-- | swaps the byte order
swapByteOrder :: a -> a
toLilEndBytes :: a -> [Word8] -- ^ LE order
toBigEndBytes :: a -> [Word8] -- ^ BE order
fromLilEndBytes :: [Word8] -> a -- ^ LE order
fromBigEndBytes :: [Word8] -> a -- ^ BE order
toBigEndBytes = reverse . toLilEndBytes
toLilEndBytes = reverse . toBigEndBytes
fromBigEndBytes = fromLilEndBytes . reverse
fromLilEndBytes = fromBigEndBytes . reverse
--------------------------------------------------------------------------------
-- | Native memory order
toMachineBytes :: HasByteOrder a => a -> [Word8]
toMachineBytes = case hostEndian of
LittleEndian -> toLilEndBytes
BigEndian -> toBigEndBytes
-- | Native memory order
fromMachineBytes :: HasByteOrder a => [Word8] -> a
fromMachineBytes = case hostEndian of
LittleEndian -> fromLilEndBytes
BigEndian -> fromBigEndBytes
--------------------------------------------------------------------------------
-- | on little-endian hosts, this is identity; on big-endian hosts, it swaps the byte order
swapByteOrderToLE :: HasByteOrder a => a -> a
swapByteOrderToLE = case hostEndian of
LittleEndian -> id
BigEndian -> swapByteOrder
-- | on big-endian hosts, this is identity; on little-endian hosts, it swaps the byte order
swapByteOrderToBE :: HasByteOrder a => a -> a
swapByteOrderToBE = case hostEndian of
LittleEndian -> swapByteOrder
BigEndian -> id
--------------------------------------------------------------------------------
instance HasByteOrder Word16 where
swapByteOrder x = shiftL (x .&. 0x00ff) 8
+ shiftR (x .&. 0xff00) 8
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 ]
toBigEndBytes x = map fromIntegral [ shiftR x 8 , x ]
fromLilEndBytes [a,b] = shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [b,a] = shiftL (fromIntegral b) 8
+ fromIntegral a
instance HasByteOrder Word32 where
swapByteOrder x = shiftL (x .&. 0x000000ff) 24
+ shiftL (x .&. 0x0000ff00) 8
+ shiftR (x .&. 0x00ff0000) 8
+ shiftR (x .&. 0xff000000) 24
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 , shiftR x 16 , shiftR x 24 ]
toBigEndBytes x = map fromIntegral [ shiftR x 24 , shiftR x 16 , shiftR x 8 , x ]
fromLilEndBytes [a,b,c,d] = shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [d,c,b,a] = shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
instance HasByteOrder Word64 where
swapByteOrder x = shiftL (x .&. 0x00000000000000ff) 56
+ shiftL (x .&. 0x000000000000ff00) 40
+ shiftL (x .&. 0x0000000000ff0000) 24
+ shiftL (x .&. 0x00000000ff000000) 8
+ shiftR (x .&. 0x000000ff00000000) 8
+ shiftR (x .&. 0x0000ff0000000000) 24
+ shiftR (x .&. 0x00ff000000000000) 40
+ shiftR (x .&. 0xff00000000000000) 56
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 , shiftR x 16 , shiftR x 24 , shiftR x 32 , shiftR x 40 , shiftR x 48 , shiftR x 56 ]
toBigEndBytes x = map fromIntegral [ shiftR x 56 , shiftR x 48 , shiftR x 40 , shiftR x 32 , shiftR x 24 , shiftR x 16 , shiftR x 8 , x ]
fromLilEndBytes [a,b,c,d,e,f,g,h]
= shiftL (fromIntegral h) 56
+ shiftL (fromIntegral g) 48
+ shiftL (fromIntegral f) 40
+ shiftL (fromIntegral e) 32
+ shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [h,g,f,e,d,c,b,a]
= shiftL (fromIntegral h) 56
+ shiftL (fromIntegral g) 48
+ shiftL (fromIntegral f) 40
+ shiftL (fromIntegral e) 32
+ shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
--------------------------------------------------------------------------------