Cheng Shao pushed to branch wip/fast-binary at Glasgow Haskell Compiler / GHC
Commits:
0deceee0 by Cheng Shao at 2025-10-12T21:13:45+02:00
compiler: implement fast get/put for Word16/Word32/Word64
Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.
This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.
- - - - -
1 changed file:
- compiler/GHC/Utils/Binary.hs
Changes:
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -9,6 +10,8 @@
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
+#include
+
--
-- (c) The University of Glasgow 2002-2006
--
@@ -162,7 +165,6 @@ import qualified Data.Set as Set
import Data.Time
import Data.List (unfoldr)
import System.IO as IO
-import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import Type.Reflection ( Typeable, SomeTypeRep(..) )
import qualified Type.Reflection as Refl
@@ -170,6 +172,9 @@ import GHC.Real ( Ratio(..) )
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import GHC.ForeignPtr ( unsafeWithForeignPtr )
+import GHC.Exts
+import GHC.IO
+import GHC.Word
import Unsafe.Coerce (unsafeCoerce)
@@ -653,71 +658,64 @@ getWord8 :: ReadBinHandle -> IO Word8
getWord8 h = getPrim h 1 peek
putWord16 :: WriteBinHandle -> Word16 -> IO ()
-putWord16 h w = putPrim h 2 (\op -> do
- pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
- pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
- )
+putWord16 h w = putPrim h 2 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord16# p# 0# x# s, () #)
+ where
+#if defined(WORDS_BIGENDIAN)
+ !(W16# x#) = w
+#else
+ !(W16# x#) = byteSwap16 w
+#endif
getWord16 :: ReadBinHandle -> IO Word16
-getWord16 h = getPrim h 2 (\op -> do
- w0 <- fromIntegral <$> peekElemOff op 0
- w1 <- fromIntegral <$> peekElemOff op 1
- return $! w0 `shiftL` 8 .|. w1
- )
+getWord16 h = getPrim h 2 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord16# p# 0# s of
+ (# s', w16# #) ->
+#if defined(WORDS_BIGENDIAN)
+ (# s', W16# w16# #)
+#else
+ (# s', byteSwap16 $ W16# w16# #)
+#endif
putWord32 :: WriteBinHandle -> Word32 -> IO ()
-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))
- )
+putWord32 h w = putPrim h 4 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord32# p# 0# x# s, () #)
+ where
+#if defined(WORDS_BIGENDIAN)
+ !(W32# x#) = w
+#else
+ !(W32# x#) = byteSwap32 w
+#endif
getWord32 :: ReadBinHandle -> IO 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
- )
+getWord32 h = getPrim h 4 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord32# p# 0# s of
+ (# s', w32# #) ->
+#if defined(WORDS_BIGENDIAN)
+ (# s', W32# w32# #)
+#else
+ (# s', byteSwap32 $ W32# w32# #)
+#endif
putWord64 :: WriteBinHandle -> Word64 -> IO ()
-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))
- )
+putWord64 h w = putPrim h 8 $ \(Ptr p#) ->
+ IO $ \s -> (# writeWord8OffAddrAsWord64# p# 0# x# s, () #)
+ where
+#if defined(WORDS_BIGENDIAN)
+ !(W64# x#) = w
+#else
+ !(W64# x#) = byteSwap64 w
+#endif
getWord64 :: ReadBinHandle -> IO 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
- )
+getWord64 h = getPrim h 8 $ \(Ptr p#) ->
+ IO $ \s -> case readWord8OffAddrAsWord64# p# 0# s of
+ (# s', w64# #) ->
+#if defined(WORDS_BIGENDIAN)
+ (# s', W64# w64# #)
+#else
+ (# s', byteSwap64 $ W64# w64# #)
+#endif
putByte :: WriteBinHandle -> Word8 -> IO ()
putByte bh !w = putWord8 bh w
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0deceee0755bc340cf9fc77c95e69baa...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0deceee0755bc340cf9fc77c95e69baa...
You're receiving this email because of your account on gitlab.haskell.org.
