[Git][ghc/ghc][wip/andreask/shortcut_bug] NCG: Fix a bug in jump shortcutting.

Andreas Klebinger (@AndreasK) gitlab at gitlab.haskell.org
Mon Mar 18 17:54:27 UTC 2024



Andreas Klebinger pushed to branch wip/andreask/shortcut_bug at Glasgow Haskell Compiler / GHC


Commits:
0134d5aa by Andreas Klebinger at 2024-03-18T18:40:10+01:00
NCG: Fix a bug in jump shortcutting.

When checking if a jump has more than one destination account for the
possibility of some jumps not being representable by a BlockId.

We do so by having isJumpishInstr return a `Maybe BlockId` where Nothing
represents non-BlockId jump destinations.

Fixes #24507

- - - - -


8 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


Changes:

=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -301,14 +301,14 @@ 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 -> [BlockId]
+jumpDestsOfInstr :: Instr -> [Maybe BlockId]
 jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
-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 (CBZ _ t) = [ Just id | TBlock id <- [t]]
+jumpDestsOfInstr (CBNZ _ t) = [ Just id | TBlock id <- [t]]
+jumpDestsOfInstr (J t) = [Just id | TBlock id <- [t]]
+jumpDestsOfInstr (B t) = [Just id | TBlock id <- [t]]
+jumpDestsOfInstr (BL t _ _) = [ Just id | TBlock id <- [t]]
+jumpDestsOfInstr (BCOND _ t) = [ Just id | TBlock id <- [t]]
 jumpDestsOfInstr _ = []
 
 -- | Change the destination of this jump instruction.


=====================================
compiler/GHC/CmmToAsm/BlockLayout.hs
=====================================
@@ -771,7 +771,7 @@ 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)
+    , [Just dest] <- jumpDestsOfInstr (NE.last ins)
     , BasicBlock nextLbl _ : _ <- todo
     , not (mapMember dest info)
     , nextLbl == dest
@@ -870,7 +870,7 @@ mkNode edgeWeights block@(BasicBlock id instrs) =
               | length successors > 2 || edgeWeight info <= 0 -> []
               | otherwise -> [target]
           | Just instr <- lastMaybe instrs
-          , [one] <- jumpDestsOfInstr instr
+          , [one] <- jumpBlockDestsOfInstr instr
           = [one]
           | otherwise = []
 


=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -17,6 +17,8 @@ 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.
 --
@@ -73,9 +75,17 @@ class Instruction instr where
 
         -- | Give the possible 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
+
 
         -- | Change the destination of this jump instruction.
         --      Used in the linear allocator when adding fixup blocks for join


=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -513,12 +513,12 @@ isJumpishInstr instr
 -- | 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 -> [BlockId]
+jumpDestsOfInstr :: Instr -> [Maybe BlockId]
 jumpDestsOfInstr insn
   = case insn of
-        BCC _ id _       -> [id]
-        BCCFAR _ id _    -> [id]
-        BCTR targets _ _ -> [id | Just id <- targets]
+        BCC _ id _       -> [Just id]
+        BCCFAR _ id _    -> [Just id]
+        BCTR targets _ _ -> [Just 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               <- jumpDestsOfInstr instr
+        , targets               <- jumpBlockDestsOfInstr 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               <- jumpDestsOfInstr instr
+        , targets               <- jumpBlockDestsOfInstr 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 (jumpDestsOfInstr instr)
+        = joinToTargets' block_live [] id instr (jumpBlockDestsOfInstr instr)
 
 -----
 joinToTargets'


=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -468,7 +468,7 @@ slurpReloadCoalesce live
 
                 -- if we hit a jump, remember the current slotMap
                 | LiveInstr (Instr instr) _     <- li
-                , targets                       <- jumpDestsOfInstr instr
+                , targets                       <- jumpBlockDestsOfInstr instr
                 , not $ null targets
                 = do    mapM_   (accSlotMap slotMap) targets
                         return  (slotMap, Nothing)
@@ -760,7 +760,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
         sccs = stronglyConnCompG g2
 
         getOutEdges :: Instruction instr => [instr] -> [BlockId]
-        getOutEdges instrs = concatMap jumpDestsOfInstr instrs
+        getOutEdges instrs = concatMap jumpBlockDestsOfInstr instrs
 
         -- This is truly ugly, but I don't see a good alternative.
         -- Digraph just has the wrong API.  We want to identify nodes
@@ -837,7 +837,7 @@ checkIsReverseDependent sccs'
 
         slurpJumpDestsOfBlock (BasicBlock _ instrs)
                 = unionManyUniqSets
-                $ map (mkUniqSet . jumpDestsOfInstr)
+                $ map (mkUniqSet . jumpBlockDestsOfInstr)
                         [ i | LiveInstr i _ <- instrs]
 
 
@@ -1047,7 +1047,7 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
 
             -- union in the live regs from all the jump destinations of this
             -- instruction.
-            targets      = jumpDestsOfInstr instr -- where we go from here
+            targets      = jumpBlockDestsOfInstr instr -- where we go from here
             not_a_branch = null targets
 
             targetLiveRegs target


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -672,12 +672,12 @@ isJumpishInstr instr
 
 jumpDestsOfInstr
         :: Instr
-        -> [BlockId]
+        -> [Maybe BlockId]
 
 jumpDestsOfInstr insn
   = case insn of
-        JXX _ id        -> [id]
-        JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
+        JXX _ id        -> [Just id]
+        JMP_TBL _ ids _ _ -> [Just id | Just (DestBlockId id) <- ids]
         _               -> []
 
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0134d5aa841287d8ee3813ee07cefdeb1dafe6cc

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0134d5aa841287d8ee3813ee07cefdeb1dafe6cc
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/20240318/d755a104/attachment-0001.html>


More information about the ghc-commits mailing list