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