Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: d5e68fa2 by Andreas Klebinger at 2026-07-03T10:43:04+02:00 cmm: Add machop width info with -dppr-debug for infix ops. - - - - - bfe529ea by Andreas Klebinger at 2026-07-03T10:47:32+02:00 Add test for #27430. - - - - - 5 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430_c.c - testsuite/tests/ffi/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -443,6 +443,11 @@ pprExpr platform e CmmLit lit -> pprLit platform lit _other -> pprExpr1 platform e +-- `exp` usually, but (expr[width]) with -dppr-debug +withDebugWidth :: Width -> SDoc -> SDoc +withDebugWidth w exp = + ifPprDebug (parens (exp <> brackets (ppr w))) exp + -- Here's the precedence table from GHC.Cmm.Parser: -- %nonassoc '>=' '>' '<=' '<' '!=' '==' -- %left '|' @@ -465,15 +470,17 @@ pprExpr1 platform e = pprExpr7 platform e infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc -infixMachOp1 (MO_Eq _) = Just (text "==") -infixMachOp1 (MO_Ne _) = Just (text "!=") -infixMachOp1 (MO_Shl _) = Just (text "<<") -infixMachOp1 (MO_U_Shr _) = Just (text ">>") -infixMachOp1 (MO_U_Ge _) = Just (text ">=") -infixMachOp1 (MO_U_Le _) = Just (text "<=") -infixMachOp1 (MO_U_Gt _) = Just (char '>') -infixMachOp1 (MO_U_Lt _) = Just (char '<') -infixMachOp1 _ = Nothing +infixMachOp1 mop = case mop of + (MO_Eq w) -> Just $ withDebugWidth w (text "==") + (MO_Ne w) -> Just $ withDebugWidth w (text "!=") + (MO_Shl w) -> Just $ withDebugWidth w (text "<<") + (MO_U_Shr w) -> Just $ withDebugWidth w (text ">>") + (MO_U_Ge w) -> Just $ withDebugWidth w (text ">=") + (MO_U_Le w) -> Just $ withDebugWidth w (text "<=") + (MO_U_Gt w) -> Just $ withDebugWidth w (char '>') + (MO_U_Lt w) -> Just $ withDebugWidth w (char '<') + _ -> Nothing + where -- %left '-' '+' pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0 @@ -483,8 +490,8 @@ pprExpr7 platform (CmmMachOp op [x,y]) = pprExpr7 platform x <+> doc <+> pprExpr8 platform y pprExpr7 platform e = pprExpr8 platform e -infixMachOp7 (MO_Add _) = Just (char '+') -infixMachOp7 (MO_Sub _) = Just (char '-') +infixMachOp7 (MO_Add w) = Just $ withDebugWidth w (char '+') +infixMachOp7 (MO_Sub w) = Just $ withDebugWidth w (char '-') infixMachOp7 _ = Nothing -- %left '/' '*' '%' @@ -493,9 +500,9 @@ pprExpr8 platform (CmmMachOp op [x,y]) = pprExpr8 platform x <+> doc <+> pprExpr9 platform y pprExpr8 platform e = pprExpr9 platform e -infixMachOp8 (MO_U_Quot _) = Just (char '/') -infixMachOp8 (MO_Mul _) = Just (char '*') -infixMachOp8 (MO_U_Rem _) = Just (char '%') +infixMachOp8 (MO_U_Quot w) = Just $ withDebugWidth w (char '/') +infixMachOp8 (MO_Mul w) = Just $ withDebugWidth w (char '*') +infixMachOp8 (MO_U_Rem w) = Just $ withDebugWidth w (char '%') infixMachOp8 _ = Nothing pprExpr9 :: Platform -> CmmExpr -> SDoc ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -2898,6 +2898,7 @@ genCCall target dest_regs arg_regs = do passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + -- | readResults gpArgs fpArgs dest_regs reg_acc code_acc readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock) readResults _ _ [] _ accumCode = return accumCode readResults [] _ _ _ _ = do ===================================== testsuite/tests/codeGen/should_run/T27430.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -dno-typeable-binds -ddump-to-file -dsuppress-ticks -dsuppress-timestamps -ddump-stg-from-core -ddump-stg-final -ddump-cmm -ddump-cmm-raw -ddump-asm #-} + +import GHC.Exts +import Data.Word (Word64) +import GHC.Word (Word8(..)) +import System.Environment (getArgs) + +foreign import ccall unsafe "u64_to_u8" u64_to_u8 :: Word64 -> Word8 +foreign import ccall unsafe "u64_to_u16" u64_to_u16 :: Word64 -> Word8 +foreign import ccall unsafe "u64_to_u32" u64_to_u32 :: Word64 -> Word8 + +x :: Word64 +x = 5 + +y :: Word64 +y = 65541 + +eq8 :: Word8 -> Word8 -> Int +eq8 (W8# a) (W8# b) = I# (eqWord8# a b) + +main :: IO () +main = print (eq8 (u64_to_u8 x) (u64_to_u8 y)) ===================================== testsuite/tests/codeGen/should_run/T27430_c.c ===================================== @@ -0,0 +1,5 @@ +#include + +uint8_t u64_to_u8(uint64_t v) { return (uint8_t)v; } +uint8_t u64_to_u16(uint64_t v) { return (uint16_t)v; } +uint8_t u64_to_u32(uint64_t v) { return (uint32_t)v; } ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -264,3 +264,5 @@ test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm']) test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm']) test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm']) test('T24818', [req_cmm, req_c], compile_and_run, ['-XUnliftedFFITypes T24818_cmm.cmm T24818_c.c']) + +test('T27430', [req_c], compile_and_run, ['T27430_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98fa02eb0e652dee1eb9bbd670a2f2c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98fa02eb0e652dee1eb9bbd670a2f2c... You're receiving this email because of your account on gitlab.haskell.org.