[Git][ghc/ghc][wip/backports-9.8] Revert "NCG: Fix a bug in jump shortcutting."
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Oct 14 16:18:24 UTC 2024
Ben Gamari pushed to branch wip/backports-9.8 at Glasgow Haskell Compiler / GHC
Commits:
a5ce5c45 by Ben Gamari at 2024-10-14T12:18:06-04:00
Revert "NCG: Fix a bug in jump shortcutting."
This commit was wrong, as noted in the `master` revert cfeb70d3fed9c135295359296208bd800bab418f.
It appears to have ultimately been superceded by 0fe2b410ac0d8951f07ffcc9f3c6c97bc312df48
which is already present in `ghc-9.8`.
This reverts commit 44e119c9b7622f76b1b7e8d22548376b2591402d.
- - - - -
9 changed files:
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/BlockLayout.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -322,20 +322,15 @@ isJumpishInstr instr = case instr of
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
-jumpDestsOfInstr :: Instr -> [Maybe BlockId]
+jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
-jumpDestsOfInstr i = case i of
- (CBZ _ t) -> [ mkDest t ]
- (CBNZ _ t) -> [ mkDest t ]
- (J t) -> [ mkDest t ]
- (B t) -> [ mkDest t ]
- (BL t _ _) -> [ mkDest t ]
- (BCOND _ t) -> [ mkDest t ]
- _ -> []
- where
- mkDest (TBlock id) = Just id
- mkDest TLabel{} = Nothing
- mkDest TReg{} = Nothing
+jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
+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
=====================================
compiler/GHC/CmmToAsm/BlockLayout.hs
=====================================
@@ -777,7 +777,6 @@ 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
- , [Just _dest] <- jumpDestsOfInstr (NE.last ins)
, BasicBlock nextLbl _ : _ <- todo
, canFallthroughTo (NE.last ins) nextLbl
, not (mapMember nextLbl info)
@@ -876,7 +875,7 @@ mkNode edgeWeights block@(BasicBlock id instrs) =
| length successors > 2 || edgeWeight info <= 0 -> []
| otherwise -> [target]
| Just instr <- lastMaybe instrs
- , [one] <- jumpBlockDestsOfInstr instr
+ , [one] <- jumpDestsOfInstr instr
= [one]
| otherwise = []
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -17,8 +17,6 @@ import GHC.Cmm.BlockId
import GHC.CmmToAsm.Config
import GHC.Data.FastString
-import Data.Maybe (catMaybes)
-
-- | Holds a list of source and destination registers used by a
-- particular instruction.
--
@@ -75,18 +73,9 @@ class Instruction instr where
-- | Give the possible *local block* destinations of this jump instruction.
-- Must be defined for all jumpish instructions.
- -- Returns Nothing for non BlockId destinations.
jumpDestsOfInstr
- :: instr -> [Maybe BlockId]
-
- -- | Give the possible block destinations of this jump instruction.
- -- Must be defined for all jumpish instructions.
- jumpBlockDestsOfInstr
:: instr -> [BlockId]
- jumpBlockDestsOfInstr = catMaybes . jumpDestsOfInstr
-
-
-- | 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.
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -522,15 +522,12 @@ canFallthroughTo instr bid
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
-jumpDestsOfInstr :: Instr -> [Maybe BlockId]
+jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr insn
= case insn of
- BCC _ id _ -> [Just id]
- BCCFAR _ id _ -> [Just id]
- BCTR targets _ _ -> targets
- BCTRL{} -> [Nothing]
- BL{} -> [Nothing]
- JMP{} -> [Nothing]
+ BCC _ id _ -> [id]
+ BCCFAR _ id _ -> [id]
+ BCTR targets _ _ -> [id | Just id <- targets]
_ -> []
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -207,7 +207,7 @@ cleanForward platform blockId assoc acc (li : instrs)
-- Remember the association over a jump.
| LiveInstr instr _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
, not $ null targets
= do mapM_ (accJumpValid assoc) targets
cleanForward platform blockId assoc (li : acc) instrs
@@ -386,7 +386,7 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
-- it always does, but if those reloads are cleaned the slot
-- liveness map doesn't get updated.
| LiveInstr instr _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
= do
let slotsReloadedByTargets
= IntSet.unions
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -57,7 +57,7 @@ joinToTargets block_live id instr
= return ([], instr)
| otherwise
- = joinToTargets' block_live [] id instr (jumpBlockDestsOfInstr instr)
+ = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
-----
joinToTargets'
=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -480,7 +480,7 @@ slurpReloadCoalesce live
-- if we hit a jump, remember the current slotMap
| LiveInstr (Instr instr) _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
, not $ null targets
= do mapM_ (accSlotMap slotMap) targets
return (slotMap, Nothing)
@@ -772,7 +772,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
sccs = stronglyConnCompG g2
getOutEdges :: Instruction instr => [instr] -> [BlockId]
- getOutEdges instrs = concatMap jumpBlockDestsOfInstr instrs
+ getOutEdges instrs = concatMap jumpDestsOfInstr instrs
-- This is truly ugly, but I don't see a good alternative.
-- Digraph just has the wrong API. We want to identify nodes
@@ -849,7 +849,7 @@ checkIsReverseDependent sccs'
slurpJumpDestsOfBlock (BasicBlock _ instrs)
= unionManyUniqSets
- $ map (mkUniqSet . jumpBlockDestsOfInstr)
+ $ map (mkUniqSet . jumpDestsOfInstr)
[ i | LiveInstr i _ <- instrs]
@@ -1057,7 +1057,7 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
-- union in the live regs from all the jump destinations of this
-- instruction.
- targets = jumpBlockDestsOfInstr instr -- where we go from here
+ targets = jumpDestsOfInstr instr -- where we go from here
not_a_branch = null targets
targetLiveRegs target
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -679,16 +679,13 @@ canFallthroughTo insn bid
jumpDestsOfInstr
:: Instr
- -> [Maybe BlockId]
+ -> [BlockId]
jumpDestsOfInstr insn
= case insn of
- JXX _ id -> [Just id]
- JMP_TBL _ ids _ _ -> [(mkDest dest) | Just dest <- ids]
+ JXX _ id -> [id]
+ JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
_ -> []
- where
- mkDest (DestBlockId id) = Just id
- mkDest _ = Nothing
patchJumpInstr
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -247,5 +247,3 @@ test('T23034', req_c, compile_and_run, ['-O2 T23034_c.c'])
test('T24664a', normal, compile_and_run, ['-O'])
test('T24664b', normal, compile_and_run, ['-O'])
-test('T24507', [req_cmm], multi_compile_and_run,
- ['T24507', [('T24507_cmm.cmm', '')], '-O2'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5ce5c4502d550da54b1e3a07d00385826238995
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5ce5c4502d550da54b1e3a07d00385826238995
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/20241014/abc923e8/attachment-0001.html>
More information about the ghc-commits
mailing list