Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 265d0024 by ARATA Mizuki at 2025-06-06T05:47:48-04:00 AArch64 NCG: Fix sub-word arithmetic right shift As noted in Note [Signed arithmetic on AArch64], we should zero-extend sub-word values. Fixes #26061 - - - - - 4 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - + testsuite/tests/codeGen/should_run/T26061.hs - + testsuite/tests/codeGen/should_run/T26061.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -928,21 +928,25 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n)))) + `snocOL` (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` - (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) `snocOL` + (UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n)))) + `snocOL` (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` - (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) `snocOL` + (UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64] CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32 || w == W64 ===================================== testsuite/tests/codeGen/should_run/T26061.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ExtendedLiterals #-} +import GHC.Word +import GHC.Exts + +f :: Int16# -> Word16# +f x = let !w = int16ToWord16# (x `uncheckedShiftRAInt16#` 1#) + in w `remWord16#` 13#Word16 +{-# NOINLINE f #-} + +g :: Int8# -> Word8# +g x = let !w = int8ToWord8# (x `uncheckedShiftRAInt8#` 1#) + in w `remWord8#` 19#Word8 +{-# NOINLINE g #-} + +h :: Int16# -> Int# -> Word16# +h x y = let !w = int16ToWord16# (x `uncheckedShiftRAInt16#` y) + in w `remWord16#` 13#Word16 +{-# NOINLINE h #-} + +i :: Int8# -> Int# -> Word8# +i x y = let !w = int8ToWord8# (x `uncheckedShiftRAInt8#` y) + in w `remWord8#` 19#Word8 +{-# NOINLINE i #-} + +main :: IO () +main = do + print (W16# (f (-100#Int16))) + print (W8# (g (-100#Int8))) + print (W16# (h (-100#Int16) 1#)) + print (W8# (i (-100#Int8) 1#)) + +-- int16ToWord16 (-100 `shiftR` 1) `rem` 13 +-- = int16ToWord16 (-50) `rem` 13 +-- = 65486 `rem` 13 +-- = 5 + +-- int8ToWord8 (-100 `shiftR` 1) `rem` 19 +-- = int8ToWord8 (-50) `rem` 19 +-- = 206 `rem` 19 +-- = 16 ===================================== testsuite/tests/codeGen/should_run/T26061.stdout ===================================== @@ -0,0 +1,4 @@ +5 +16 +5 +16 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -255,3 +255,4 @@ test('T24893', normal, compile_and_run, ['-O']) test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c']) test('T25364', normal, compile_and_run, ['']) +test('T26061', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265d0024abc95be941f8e4769f24af12... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265d0024abc95be941f8e4769f24af12... You're receiving this email because of your account on gitlab.haskell.org.