[Git][ghc/ghc][wip/supersven/riscv-fix-switch-jump-tables] RV64: Introduce J instruction (non-local jumps) and don't deallocate stack slots for J_TBL (#25738)

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/supersven/riscv-fix-switch-jump-tables at Glasgow Haskell Compiler / GHC


Commits:
abcac361 by Sven Tennie at 2025-02-15T11:00:12+01:00
RV64: Introduce J instruction (non-local jumps) and don't deallocate stack slots for J_TBL (#25738)

J_TBL result in local jumps, there should not deallocate stack slots
(see Note [extra spill slots].)

J is for non-local jumps, these may need to deallocate stack slots.

- - - - -


3 changed files:

- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1481,7 +1481,7 @@ assignReg_FltCode = assignReg_IntCode
 genJump :: CmmExpr {-the branch target-} -> NatM InstrBlock
 genJump expr = do
   (target, _format, code) <- getSomeReg expr
-  return (code `appOL` unitOL (annExpr expr (B (TReg target))))
+  return (code `appOL` unitOL (annExpr expr (J (TReg target))))
 
 -- -----------------------------------------------------------------------------
 --  Unconditional branches
@@ -2217,6 +2217,7 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
       -- jumps to registers have size 1
       BCOND {} -> long_bc_jump_size
       B (TBlock _) -> long_b_jump_size
+      J _ -> 1
       B (TReg _) -> 1
       BL _ _ -> 1
       J_TBL {} -> 1


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -97,6 +97,7 @@ regUsageOfInstr platform instr = case instr of
   ORI dst src1 _ -> usage (regOp src1, regOp dst)
   XORI dst src1 _ -> usage (regOp src1, regOp dst)
   J_TBL _ _ t -> usage ([t], [])
+  J t -> usage (regTarget t, [])
   B t -> usage (regTarget t, [])
   BCOND _ l r t -> usage (regTarget t ++ regOp l ++ regOp r, [])
   BL t ps -> usage (t : ps, callerSavedRegisters)
@@ -195,6 +196,7 @@ patchRegsOfInstr instr env = case instr of
   ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3)
   XORI o1 o2 o3 -> XORI (patchOp o1) (patchOp o2) (patchOp o3)
   J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t)
+  J t -> J (patchTarget t)
   B t -> B (patchTarget t)
   BL t ps -> BL (patchReg t) ps
   BCOND c o1 o2 t -> BCOND c (patchOp o1) (patchOp o2) (patchTarget t)
@@ -235,6 +237,7 @@ isJumpishInstr :: Instr -> Bool
 isJumpishInstr instr = case instr of
   ANN _ i -> isJumpishInstr i
   J_TBL {} -> True
+  J {} -> True
   B {} -> True
   BL {} -> True
   BCOND {} -> True
@@ -243,6 +246,7 @@ isJumpishInstr instr = case instr of
 canFallthroughTo :: Instr -> BlockId -> Bool
 canFallthroughTo insn bid =
   case insn of
+    J (TBlock target) -> bid == target
     B (TBlock target) -> bid == target
     BCOND _ _ _ (TBlock target) -> bid == target
     J_TBL targets _ _ -> all isTargetBid targets
@@ -256,6 +260,7 @@ canFallthroughTo insn bid =
 jumpDestsOfInstr :: Instr -> [BlockId]
 jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
 jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
 jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
 jumpDestsOfInstr (BCOND _ _ _ t) = [id | TBlock id <- [t]]
 jumpDestsOfInstr _ = []
@@ -269,6 +274,7 @@ patchJumpInstr instr patchF =
   case instr of
     ANN d i -> ANN d (patchJumpInstr i patchF)
     J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
+    J (TBlock bid) -> J (TBlock (patchF bid))
     B (TBlock bid) -> B (TBlock (patchF bid))
     BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid))
     _ -> panic $ "patchJumpInstr: " ++ instrCon instr
@@ -475,7 +481,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
           block' = foldr insert_dealloc [] insns
 
       insert_dealloc insn r = case insn of
-        J_TBL {} -> dealloc ++ (insn : r)
+        J {} -> dealloc ++ (insn : r)
         ANN _ e -> insert_dealloc e r
         _other
           | jumpDestsOfInstr insn /= [] ->
@@ -591,6 +597,8 @@ data Instr
     --
     -- @if(o2 cond o3) op <- 1 else op <- 0@
     CSET Operand Operand Operand Cond
+    -- | like B, but only generated from genJump. Used to distinguish genJumps from others.
+  | J Target             
   | -- | A jump instruction with data for switch/jump tables
     J_TBL [Maybe BlockId] (Maybe CLabel) Reg
   | -- | Unconditional jump (no linking)
@@ -663,6 +671,7 @@ instrCon i =
     LDRU {} -> "LDRU"
     CSET {} -> "CSET"
     J_TBL {} -> "J_TBL"
+    J {} -> "J"
     B {} -> "B"
     BL {} -> "BL"
     BCOND {} -> "BCOND"


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -543,6 +543,7 @@ pprInstr platform instr = case instr of
     | otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0))
   ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3
   XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3
+  J o1 -> pprInstr platform (B o1)
   J_TBL _ _ r -> pprInstr platform (B (TReg r))
   B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
   B (TReg r) -> line $ text "\tjalr" <+> pprOp platform x0 <> comma <+> pprReg W64 r <> comma <+> text "0"



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abcac361262d9f5ddc677645ace255b0ed704ad6
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/20250215/e1ed2c95/attachment-0001.html>