[Git][ghc/ghc][master] NCG: Fix a bug where we errounously removed a required jump instruction.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Apr 17 00:10:07 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0fe2b410 by Andreas Klebinger at 2024-04-16T20:08:27-04:00
NCG: Fix a bug where we errounously removed a required jump instruction.
Add a new method to the Instruction class to check if we can eliminate a
jump in favour of fallthrough control flow.
Fixes #24507
- - - - -
13 changed files:
- compiler/GHC/CmmToAsm/AArch64.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/BlockLayout.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/Monad.hs
- compiler/GHC/CmmToAsm/PPC.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- + testsuite/tests/codeGen/should_run/T24507.hs
- + testsuite/tests/codeGen/should_run/T24507.stdout
- + testsuite/tests/codeGen/should_run/T24507_cmm.cmm
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64.hs
=====================================
@@ -47,6 +47,7 @@ instance Instruction AArch64.Instr where
patchRegsOfInstr = AArch64.patchRegsOfInstr
isJumpishInstr = AArch64.isJumpishInstr
jumpDestsOfInstr = AArch64.jumpDestsOfInstr
+ canFallthroughTo = AArch64.canFallthroughTo
patchJumpInstr = AArch64.patchJumpInstr
mkSpillInstr = AArch64.mkSpillInstr
mkLoadInstr = AArch64.mkLoadInstr
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -317,6 +317,12 @@ jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr _ = []
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid
+canFallthroughTo (J (TBlock target)) bid = bid == target
+canFallthroughTo (B (TBlock target)) bid = bid == target
+canFallthroughTo _ _ = False
+
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
-- points.
=====================================
compiler/GHC/CmmToAsm/BlockLayout.hs
=====================================
@@ -771,10 +771,9 @@ dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i]
dropJumps _ [] = []
dropJumps info (BasicBlock lbl ins:todo)
| Just ins <- nonEmpty ins --This can happen because of shortcutting
- , [dest] <- jumpDestsOfInstr (NE.last ins)
, BasicBlock nextLbl _ : _ <- todo
- , not (mapMember dest info)
- , nextLbl == dest
+ , canFallthroughTo (NE.last ins) nextLbl
+ , not (mapMember nextLbl info)
= BasicBlock lbl (NE.init ins) : dropJumps info todo
| otherwise
= BasicBlock lbl ins : dropJumps info todo
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -71,11 +71,17 @@ class Instruction instr where
:: instr -> Bool
- -- | Give the possible destinations of this jump instruction.
+ -- | Give the possible *local block* destinations of this jump instruction.
-- Must be defined for all jumpish instructions.
jumpDestsOfInstr
:: instr -> [BlockId]
+ -- | Check if the instr always transfers control flow
+ -- to the given block. Used by code layout to eliminate
+ -- jumps that can be replaced by fall through.
+ canFallthroughTo
+ :: instr -> BlockId -> Bool
+
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
=====================================
compiler/GHC/CmmToAsm/Monad.hs
=====================================
@@ -78,8 +78,15 @@ data NcgImpl statics instr jumpDest = NcgImpl {
cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
getJumpDestBlockId :: jumpDest -> Maybe BlockId,
+ -- | Does this jump always jump to a single destination and is shortcutable?
+ --
+ -- We use this to determine shortcutable instructions - See Note [What is shortcutting]
+ -- Note that if we return a destination here we *most* support the relevant shortcutting in
+ -- shortcutStatics for jump tables and shortcutJump for the instructions itself.
canShortcut :: instr -> Maybe jumpDest,
+ -- | Replace references to blockIds with other destinations - used to update jump tables.
shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
+ -- | Change the jump destination(s) of an instruction.
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
-- | 'Module' is only for printing internal labels. See Note [Internal proc
-- labels] in CLabel.
@@ -105,6 +112,25 @@ data NcgImpl statics instr jumpDest = NcgImpl {
-- when possible.
}
+{- Note [supporting shortcutting]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For the concept of shortcutting see Note [What is shortcutting].
+
+In order to support shortcutting across multiple backends uniformly we
+use canShortcut, shortcutStatics and shortcutJump.
+
+canShortcut tells us if the backend support shortcutting of a instruction
+and if so what destination we should retarget instruction to instead.
+
+shortcutStatics exists to allow us to update jump destinations in jump tables.
+
+shortcutJump updates the instructions itself.
+
+A backend can opt out of those by always returning Nothing for canShortcut
+and implementing shortcutStatics/shortcutJump as \_ x -> x
+
+-}
+
{- Note [pprNatCmmDeclS and pprNatCmmDeclH]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Each NcgImpl provides two implementations of its CmmDecl printer, pprNatCmmDeclS
=====================================
compiler/GHC/CmmToAsm/PPC.hs
=====================================
@@ -46,6 +46,7 @@ instance Instruction PPC.Instr where
patchRegsOfInstr = PPC.patchRegsOfInstr
isJumpishInstr = PPC.isJumpishInstr
jumpDestsOfInstr = PPC.jumpDestsOfInstr
+ canFallthroughTo = PPC.canFallthroughTo
patchJumpInstr = PPC.patchJumpInstr
mkSpillInstr = PPC.mkSpillInstr
mkLoadInstr = PPC.mkLoadInstr
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -22,6 +22,7 @@ module GHC.CmmToAsm.PPC.Instr
, patchJumpInstr
, patchRegsOfInstr
, jumpDestsOfInstr
+ , canFallthroughTo
, takeRegRegMoveInstr
, takeDeltaInstr
, mkRegRegMoveInstr
@@ -509,6 +510,13 @@ isJumpishInstr instr
JMP{} -> True
_ -> False
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo instr bid
+ = case instr of
+ BCC _ target _ -> target == bid
+ BCCFAR _ target _ -> target == bid
+ _ -> False
+
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -126,6 +126,11 @@ instance Instruction instr => Instruction (InstrSR instr) where
Instr instr -> isJumpishInstr instr
_ -> False
+ canFallthroughTo i bid
+ = case i of
+ Instr instr -> canFallthroughTo instr bid
+ _ -> False
+
jumpDestsOfInstr i
= case i of
Instr instr -> jumpDestsOfInstr instr
=====================================
compiler/GHC/CmmToAsm/X86.hs
=====================================
@@ -51,6 +51,7 @@ instance Instruction X86.Instr where
patchRegsOfInstr = X86.patchRegsOfInstr
isJumpishInstr = X86.isJumpishInstr
jumpDestsOfInstr = X86.jumpDestsOfInstr
+ canFallthroughTo = X86.canFallthroughTo
patchJumpInstr = X86.patchJumpInstr
mkSpillInstr = X86.mkSpillInstr
mkLoadInstr = X86.mkLoadInstr
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -31,6 +31,7 @@ module GHC.CmmToAsm.X86.Instr
, mkSpillInstr
, mkRegRegMoveInstr
, jumpDestsOfInstr
+ , canFallthroughTo
, patchRegsOfInstr
, patchJumpInstr
, isMetaInstr
@@ -669,6 +670,17 @@ isJumpishInstr instr
CALL{} -> True
_ -> False
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo insn bid
+ = case insn of
+ JXX _ target -> bid == target
+ JMP_TBL _ targets _ _ -> all isTargetBid targets
+ _ -> False
+ where
+ isTargetBid target = case target of
+ Nothing -> True
+ Just (DestBlockId target) -> target == bid
+ _ -> False
jumpDestsOfInstr
:: Instr
=====================================
testsuite/tests/codeGen/should_run/T24507.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module Main where
+
+import GHC.Exts
+
+foreign import prim "foo" foo :: Int# -> Int#
+
+main = do
+
+ let f x = case x of I# x' -> case foo x' of x -> print (I# x)
+ mapM_ f [1..7]
\ No newline at end of file
=====================================
testsuite/tests/codeGen/should_run/T24507.stdout
=====================================
@@ -0,0 +1,7 @@
+1
+2
+2
+2
+2
+2
+2
=====================================
testsuite/tests/codeGen/should_run/T24507_cmm.cmm
=====================================
@@ -0,0 +1,35 @@
+#include "Cmm.h"
+
+bar() {
+ return (2);
+}
+
+foo(W_ x) {
+
+ switch(x) {
+ case 1: goto a;
+ case 2: goto b;
+ case 3: goto c;
+ case 4: goto d;
+ case 5: goto e;
+ case 6: goto f;
+ case 7: goto g;
+ }
+ return (1);
+
+ a:
+ return (1);
+ b:
+ jump bar();
+ c:
+ jump bar();
+ d:
+ jump bar();
+ e:
+ jump bar();
+ f:
+ jump bar();
+ g:
+ jump bar();
+
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fe2b410ac0d8951f07ffcc9f3c6c97bc312df48
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fe2b410ac0d8951f07ffcc9f3c6c97bc312df48
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240416/aa5d4584/attachment-0001.html>
More information about the ghc-commits
mailing list