Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bfa6b70f by ARATA Mizuki at 2025-06-06T05:49:24-04:00 x86 NCG: Fix code generation of bswap64 on i386 Co-authored-by: sheaf <sam.derbyshire@gmail.com> Fix #25601 - - - - - 5 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - + testsuite/tests/cmm/should_run/T25601.hs - + testsuite/tests/cmm/should_run/T25601.stdout - + testsuite/tests/cmm/should_run/T25601a.cmm - testsuite/tests/cmm/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -6067,10 +6067,23 @@ genByteSwap width dst src = do W64 | is32Bit -> do let Reg64 dst_hi dst_lo = localReg64 dst RegCode64 vcode rhi rlo <- iselExpr64 src - return $ vcode `appOL` - toOL [ MOV II32 (OpReg rlo) (OpReg dst_hi), - MOV II32 (OpReg rhi) (OpReg dst_lo), - BSWAP II32 dst_hi, + tmp <- getNewRegNat II32 + -- Swap the low and high halves of the register. + -- + -- NB: if dst_hi == rhi, we must make sure to preserve the contents + -- of rhi before writing to dst_hi (#25601). + let shuffle = if dst_hi == rhi && dst_lo == rlo then + toOL [ MOV II32 (OpReg rhi) (OpReg tmp), + MOV II32 (OpReg rlo) (OpReg dst_hi), + MOV II32 (OpReg tmp) (OpReg dst_lo) ] + else if dst_hi == rhi then + toOL [ MOV II32 (OpReg rhi) (OpReg dst_lo), + MOV II32 (OpReg rlo) (OpReg dst_hi) ] + else + toOL [ MOV II32 (OpReg rlo) (OpReg dst_hi), + MOV II32 (OpReg rhi) (OpReg dst_lo) ] + return $ vcode `appOL` shuffle `appOL` + toOL [ BSWAP II32 dst_hi, BSWAP II32 dst_lo ] W16 -> do let dst_r = getLocalRegReg dst ===================================== testsuite/tests/cmm/should_run/T25601.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Numeric +import GHC.Prim +import GHC.Word +import GHC.IO +import GHC.Ptr +import Data.List +import qualified Data.ByteString as BS + +foreign import prim "test" c_test :: Addr# -> State# RealWorld -> (# State# RealWorld, Word64# #) + +main :: IO () +main = do + let bs = BS.pack $ take 100000 [ fromIntegral i | i <- [(1 :: Int) ..] ] + n <- BS.useAsCString bs $ \(Ptr addr) -> IO $ \s -> + case c_test addr s of (# s', n #) -> (# s', W64# n #) + print $ showHex n "" ===================================== testsuite/tests/cmm/should_run/T25601.stdout ===================================== @@ -0,0 +1 @@ +"f3f1ffffffffffff" ===================================== testsuite/tests/cmm/should_run/T25601a.cmm ===================================== @@ -0,0 +1,7 @@ +#include "Cmm.h" + +test ( W_ buffer ) { + bits64 ret; + (ret) = prim %bswap64(%neg(%zx64(bits16[buffer + (12 :: W_)]))); + return (ret); +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -47,3 +47,8 @@ test('AtomicFetch', ], multi_compile_and_run, ['AtomicFetch', [('AtomicFetch_cmm.cmm', '')], '']) + +test('T25601', + [req_cmm], + multi_compile_and_run, + ['T25601', [('T25601a.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfa6b70f27dc2ce7fc890ec71103c40f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfa6b70f27dc2ce7fc890ec71103c40f... You're receiving this email because of your account on gitlab.haskell.org.