[Git][ghc/ghc][master] Change the C types of hs_{bitrev,bswap}{16,32} to match the Haskell types
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 545fd4fb by ARATA Mizuki at 2026-09-22T15:03:24-04:00 Change the C types of hs_{bitrev,bswap}{16,32} to match the Haskell types bitReverse{16,32}# and byteSwap{16,32}# have the type Word# -> Word#, but their C correspondents took and returned StgWord{16,32}. The mismatch on bitReverse16# led to the problem reported in #27299. Although no similar issue is reported for bitReverse32# and byteSwap{16,32}#, it seemed wise to change them proactively. This commit fixes the mismatch by changing the C type. Fixes #27299 - - - - - 6 changed files: - rts/include/stg/Prim.h - rts/prim/bitrev.c - rts/prim/bswap.c - + testsuite/tests/primops/should_run/T27299.hs - + testsuite/tests/primops/should_run/T27299.stdout - testsuite/tests/primops/should_run/all.T Changes: ===================================== rts/include/stg/Prim.h ===================================== @@ -59,16 +59,16 @@ StgWord hs_xchg32(StgWord x, StgWord val); StgWord64 hs_xchg64(StgWord x, StgWord64 val); /* rts/prim/bswap.c */ -StgWord16 hs_bswap16(StgWord16 x); -StgWord32 hs_bswap32(StgWord32 x); +StgWord hs_bswap16(StgWord x); +StgWord hs_bswap32(StgWord x); StgWord64 hs_bswap64(StgWord64 x); /* rts/prim/bitrev.c This was done as part of issue #16164. See Note [Bit reversal primop] for more details about the implementation.*/ StgWord hs_bitrev8(StgWord x); -StgWord16 hs_bitrev16(StgWord16 x); -StgWord32 hs_bitrev32(StgWord32 x); +StgWord hs_bitrev16(StgWord x); +StgWord hs_bitrev32(StgWord x); StgWord64 hs_bitrev64(StgWord64 x); /* rts/prim/longlong.c */ ===================================== rts/prim/bitrev.c ===================================== @@ -36,8 +36,8 @@ hs_bitrev8(StgWord x) return x; } -StgWord16 -hs_bitrev16(StgWord16 x) +StgWord +hs_bitrev16(StgWord x) { x = ((x >> 1) & 0x5555) | ((x & 0x5555) << 1 ); x = ((x >> 2) & 0x3333) | ((x & 0x3333) << 2 ); @@ -46,14 +46,14 @@ hs_bitrev16(StgWord16 x) return x; } -StgWord32 -hs_bitrev32(StgWord32 x) +StgWord +hs_bitrev32(StgWord x) { - x = ((x >> 1) & 0x55555555) | ((x & 0x55555555) << 1 ); - x = ((x >> 2) & 0x33333333) | ((x & 0x33333333) << 2 ); - x = ((x >> 4) & 0x0F0F0F0F) | ((x & 0x0F0F0F0F) << 4 ); - x = ((x >> 8) & 0x00FF00FF) | ((x & 0x00FF00FF) << 8 ); - x = ( x >> 16 ) | ( x << 16 ); + x = ((x >> 1) & 0x55555555) | ((x & 0x55555555) << 1 ); + x = ((x >> 2) & 0x33333333) | ((x & 0x33333333) << 2 ); + x = ((x >> 4) & 0x0F0F0F0F) | ((x & 0x0F0F0F0F) << 4 ); + x = ((x >> 8) & 0x00FF00FF) | ((x & 0x00FF00FF) << 8 ); + x = ((x >> 16) & 0x0000FFFF) | ((x & 0x0000FFFF) << 16); return x; } ===================================== rts/prim/bswap.c ===================================== @@ -1,16 +1,18 @@ #include "Rts.h" -StgWord16 -hs_bswap16(StgWord16 x) +StgWord +hs_bswap16(StgWord x) { - return ((x >> 8) | (x << 8)); + x = (StgWord16)x; + return (StgWord16)((x >> 8) | (x << 8)); } -StgWord32 -hs_bswap32(StgWord32 x) +StgWord +hs_bswap32(StgWord x) { - return ((x >> 24) | ((x >> 8) & 0xff00) | - (x << 24) | ((x & 0xff00) << 8)); + x = (StgWord32)x; + return (StgWord32)((x >> 24) | ((x >> 8) & 0xff00) | + (x << 24) | ((x & 0xff00) << 8)); } StgWord64 ===================================== testsuite/tests/primops/should_run/T27299.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE MagicHash #-} +import GHC.Exts +import GHC.Word +import Numeric + +main :: IO () +main = do + putStrLn $ showHex (W# (bitReverse8# 0x55##)) "" + putStrLn $ showHex (W# (bitReverse8# 0xAA##)) "" + putStrLn $ showHex (W# (bitReverse16# 0x5555##)) "" + putStrLn $ showHex (W# (bitReverse16# 0xAAAA##)) "" + putStrLn $ showHex (W# (bitReverse32# 0x5555_5555##)) "" + putStrLn $ showHex (W# (bitReverse32# 0xAAAA_AAAA##)) "" + putStrLn $ showHex (W# (byteSwap16# 0xABCD##)) "" + putStrLn $ showHex (W# (byteSwap32# 0xABCD_EF12##)) "" + putStrLn $ showHex (W# (noinline bitReverse8# 0x55##)) "" + putStrLn $ showHex (W# (noinline bitReverse8# 0xAA##)) "" + putStrLn $ showHex (W# (noinline bitReverse16# 0x5555##)) "" + putStrLn $ showHex (W# (noinline bitReverse16# 0xAAAA##)) "" + putStrLn $ showHex (W# (noinline bitReverse32# 0x5555_5555##)) "" + putStrLn $ showHex (W# (noinline bitReverse32# 0xAAAA_AAAA##)) "" + putStrLn $ showHex (W# (noinline byteSwap16# 0xABCD##)) "" + putStrLn $ showHex (W# (noinline byteSwap32# 0xABCD_EF12##)) "" ===================================== testsuite/tests/primops/should_run/T27299.stdout ===================================== @@ -0,0 +1,16 @@ +aa +55 +aaaa +5555 +aaaaaaaa +55555555 +cdab +12efcdab +aa +55 +aaaa +5555 +aaaaaaaa +55555555 +cdab +12efcdab ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -91,3 +91,4 @@ test('T24496' ] , compile_and_run, ['-O']) test('T6026', normal, compile_and_run, ['']) +test('T27299', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/545fd4fb69d7572180f13fe81e65e421... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/545fd4fb69d7572180f13fe81e65e421... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
participants (1)
-
Marge Bot (@marge-bot)