Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: ac157837 by Andreas Klebinger at 2026-08-25T12:53:43+02:00 Add some test cases covering bugs in the arm ncg. * Test for #27430 (subword ffi results) * #27537 - subword conversions * #27538 - subwords used in conditional * #27533 - single byte read - - - - - 189a37c2 by Andreas Klebinger at 2026-08-25T12:53:55+02:00 cmmLint: Lint against MO_FS_Truncate subword use. - - - - - 12 changed files: - compiler/GHC/Cmm/MachOp.hs - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr - − testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/codeGen/should_run/T27430.stdout - + testsuite/tests/codeGen/should_run/T27430_c.c - + testsuite/tests/codeGen/should_run/T27533_cmm.cmm - + testsuite/tests/codeGen/should_run/T27537.hs - + testsuite/tests/codeGen/should_run/T27537.stdout - + testsuite/tests/codeGen/should_run/T27538.stdout - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -623,7 +623,9 @@ machOpArgReps platform op = MO_XX_Conv from _ -> Just [from] -- Only supports W32/W64 MO_SF_Round from _w -> onlyW32W64 from - MO_FS_Truncate from _ -> onlyW32W64 from + MO_FS_Truncate from to + | to `notElem` [W32, W64] -> Nothing + | otherwise -> onlyW32W64 from MO_FF_Conv from _ -> onlyW32W64 from MO_WF_Bitcast w -> onlyW32W64 w MO_FW_Bitcast w -> onlyW32W64 w ===================================== testsuite/tests/cmm/should_compile/Makefile ===================================== @@ -16,16 +16,3 @@ T16930: T23610: '$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S - -# The three seds below, in order: -# 1. Keep only the "Parsed Cmm" dump, since that is the one stage where the -# unreachable block still exists. -# 2. Rewrite goto targets: their label uniques survive -dsuppress-uniques -# (#21310). -# 3. Drop the "// CmmAssign"-style node annotations, which pprNode emits -# only on DEBUG compilers. -T27368-ppr-debug: - '$(TEST_HC)' $(TEST_HC_OPTS) -c -no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug -dsuppress-uniques -dsuppress-ticks T27368-ppr-debug.cmm 2>&1 \ - | sed -n '/^==* Parsed Cmm/,/^ \}\]/p' \ - | sed 's/goto c[0-9A-Za-z]*/goto _lbl_/g' \ - | sed 's| *// Cmm[A-Za-z]*$$||' ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr ===================================== @@ -0,0 +1,191 @@ + +==================== Parsed Cmm ==================== +[testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + goto c6; + c6: // global + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + goto c3; + c3: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + // unreachable blocks: + c5: // global + //tick src<T27368-ppr-debug.cmm:13:5-13> + _c1::I64 = _c1::I64 (+[W64]) 42; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + } + }] + + + +==================== Post control-flow optimisations (1) ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== Post switch plan ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== ThreadSanitizer instrumentation ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== Layout Stack ==================== +testUnreachable +{offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; +} + + + +==================== CAFEnv ==================== +[(c2, {}), (c4, {}), (c7, {})] + + + +==================== after setInfoTableStackMap ==================== +testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } +} + + + +==================== Post control-flow optimisations (2) ==================== +testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } +} + + + +==================== Post CPS Cmm ==================== +[testUnreachable() { // [R1] + { info_tbls: [] + stack_info: arg_space: 8 + } + {offset + c7: // global + _c1::I64 = R1; + //tick src<T27368-ppr-debug.cmm:(6,1)-(19,1)> + if (_c1::I64 (>[W64]) 0) goto c2; else goto c4; + c2: // global + //tick src<T27368-ppr-debug.cmm:(7,14)-(9,3)> + //tick src<T27368-ppr-debug.cmm:17:5-12> + _c1::I64 = _c1::I64 (-[W64]) 1; + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + c4: // global + R1 = _c1::I64; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }] + + ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout deleted ===================================== @@ -1,27 +0,0 @@ -==================== Parsed Cmm ==================== -[testUnreachable() { // [R1] - { info_tbls: [] - stack_info: arg_space: 8 - } - {offset - _lbl_: - __locVar_::I64 = R1; - if (__locVar_::I64 (>[W64]) 0) goto _lbl_; else goto _lbl_; - _lbl_: - goto _lbl_; - _lbl_: - __locVar_::I64 = __locVar_::I64 (-[W64]) 1; - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - _lbl_: - goto _lbl_; - _lbl_: - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - // unreachable blocks: - _lbl_: - __locVar_::I64 = __locVar_::I64 (+[W64]) 42; - R1 = __locVar_::I64; - call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; - } - }] ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -13,11 +13,9 @@ test('T20725', normal, compile, ['-package ghc']) test('T23610', normal, makefile_test, ['T23610']) test('T24224', [cmm_src, grep_errmsg(r'(F64.*);', [1]), only_ways(['normal'])], compile, ['-no-hs-main -ddump-cmm -dsuppress-all -dsuppress-uniques']) test('T24474', cmm_src, compile, ['-optc-g3']) -# -dppr-debug makes stored-but-unreachable blocks visible in Cmm dumps (#27368). -# Skipped on wordsize(32) targets, where the dump would say I32/P32, and on -# unregisterised builds, which print call targets with an extra load. -test('T27368-ppr-debug', [when(wordsize(32), skip), when(unregisterised(), skip)], - makefile_test, ['T27368-ppr-debug']) +# Grep for a `... = + .. 42 ..;` occurence from within the dead code block in the cmm dump output. +test('T27368-ppr-debug', [cmm_src, only_ways(['normal']), grep_errmsg(r'\=.*\+.*(42;)', [1])], + compile, ['-no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug']) test('T24474-cmm-gets-c-opts', cmm_src, compile, ['-optc-DFOO']) test('T24474-cmm-opt-order', cmm_src, compile, ['-optc-DFOO ' '-optCmmP-UFOO ' ===================================== testsuite/tests/codeGen/should_run/T27430.stdout ===================================== @@ -0,0 +1,6 @@ +1 +1 +1 +1 +1 +1 ===================================== testsuite/tests/codeGen/should_run/T27430_c.c ===================================== @@ -0,0 +1,5 @@ +#include <stdint.h> + +uint8_t u64_to_u8(uint64_t v) { return (uint8_t)v; } +uint16_t u64_to_u16(uint64_t v) { return (uint16_t)v; } +uint32_t u64_to_u32(uint64_t v) { return (uint32_t)v; } ===================================== testsuite/tests/codeGen/should_run/T27533_cmm.cmm ===================================== @@ -0,0 +1,14 @@ +#include "Cmm.h" + +// Release-store one byte at p. Must touch exactly 1 byte. +store8 (W_ p) { + %release I8[p] = 67 :: I8; + return (0); +} + +// Acquire-load one byte from p. +load8 (W_ p) { + I8 v; + v = %acquire I8[p]; + return (TO_ZXW_(v)); +} ===================================== testsuite/tests/codeGen/should_run/T27537.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Exts + +{-# NOINLINE lt8 #-} +lt8 :: Int -> Word -> Int -- ltWord8# 254 255: must be 1 +lt8 (I# m) (W# n) = I# (ltWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n)) + +{-# NOINLINE eq8 #-} +eq8 :: Int -> Word -> Int -- eqWord8# 254 254: must be 1 +eq8 (I# m) (W# n) = I# (eqWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n)) + +{-# NOINLINE eqi16 #-} +eqi16 :: Int -> Int -> Int -- eqInt16# (-2) (-2): must be 1 +eqi16 (I# m) (I# n) = I# (eqInt16# (intToInt16# m) (word16ToInt16# (wordToWord16# (int2Word# n)))) + +{-# NOINLINE rem8 #-} +rem8 :: Int -> Word -> Word -- remWord8# 254 100: must be 54 +rem8 (I# m) (W# n) = W# (word8ToWord# (remWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n))) + +main :: IO () +main = do + print (lt8 (-2) 255) + print (eq8 (-2) 254) + print (eqi16 (-2) 65534) + print (rem8 (-2) 100) ===================================== testsuite/tests/codeGen/should_run/T27537.stdout ===================================== @@ -0,0 +1,4 @@ +1 +1 +1 +54 ===================================== testsuite/tests/codeGen/should_run/T27538.stdout ===================================== @@ -0,0 +1 @@ +f(0x80) = 0 ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -295,3 +295,12 @@ test('aarch64-sxtw-run', when(unregisterised(), skip)], multi_compile_and_run, ['aarch64-sxtw-run', [('aarch64-sxtw-cmm.cmm', '')], '-O']) + +test('T27430', [req_c, extra_ways(['optasm'])], compile_and_run, ['T27430_c.c']) + +test('T27533', [req_cmm, extra_ways(['optasm'])], multi_compile_and_run, + ['T27533', [('T27533_cmm.cmm', '')], '-O']) + +test('T27537', normal, compile_and_run, ['-O']) + +test('T27538', normal, compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/293cfa2ec57063f55134f5981be8352... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/293cfa2ec57063f55134f5981be8352... 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