[Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement switch (case) jump tables
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Mar 16 14:28:23 UTC 2024
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
9be2b121 by Sven Tennie at 2024-03-16T15:26:36+01:00
Implement switch (case) jump tables
- - - - -
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
=====================================
@@ -23,10 +23,16 @@ import GHC.CmmToAsm.RV64.Cond
import GHC.CmmToAsm.CPrim
import GHC.Cmm.DebugBlock
import GHC.CmmToAsm.Monad
- ( NatM, getNewRegNat
- , getPicBaseMaybeNat, getPlatform, getConfig
- , getDebugBlock, getFileId
- )
+ ( NatM,
+ getConfig,
+ getDebugBlock,
+ getFileId,
+ getNewLabelNat,
+ getNewRegNat,
+ getPicBaseMaybeNat,
+ getPlatform,
+ )
+
-- import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
@@ -208,42 +214,66 @@ annExpr e {- debugIsOn -} = ANN (text . show $ e)
-- -----------------------------------------------------------------------------
-- Generating a table-branch
--- TODO jump tables would be a lot faster, but we'll use bare bones for now.
--- this is usually done by sticking the jump table ids into an instruction
--- and then have the @generateJumpTableForInstr@ callback produce the jump
--- table as a static.
---
--- See Ticket 19912
---
--- data SwitchTargets =
--- SwitchTargets
--- Bool -- Signed values
--- (Integer, Integer) -- Range
--- (Maybe Label) -- Default value
--- (M.Map Integer Label) -- The branches
+-- | Generate jump to jump table target
--
--- Non Jumptable plan:
--- xE <- expr
+-- The index into the jump table is calulated by evaluating @expr at . The
+-- corresponding table entry contains the address to jump to.
+genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
+genSwitch config expr targets = do
+ (reg, fmt1, e_code) <- getSomeReg indexExpr
+ let fmt = II64
+ tmp <- getNewRegNat fmt
+ lbl <- getNewLabelNat
+ dynRef <- cmmMakeDynamicReference config DataReference lbl
+ (tableReg, fmt2, t_code) <- getSomeReg $ dynRef
+ let code =
+ toOL [ COMMENT (text "indexExpr" <+> (text . show) indexExpr)
+ , COMMENT (text "dynRef" <+> (text . show) dynRef)
+ ]
+ `appOL` e_code
+ `appOL` t_code
+ `appOL` toOL
+ [
+ COMMENT (ftext "Jump table for switch")
+ , annExpr expr (LSL (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3)))
+ , ADD (OpReg W64 tmp) (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt2) tableReg)
+ , LDRU II64 (OpReg W64 tmp) (OpAddr (AddrRegImm tmp (ImmInt 0)))
+ , J_TBL ids (Just lbl) tmp
+ ]
+ return code
+ where
+ -- See Note [Sub-word subtlety during jump-table indexing] in
+ -- GHC.CmmToAsm.X86.CodeGen for why we must first offset, then widen.
+ indexExpr0 = cmmOffset platform expr offset
+ -- We widen to a native-width register to sanitize the high bits
+ indexExpr =
+ CmmMachOp
+ (MO_UU_Conv expr_w (platformWordWidth platform))
+ [indexExpr0]
+ expr_w = cmmExprWidth platform expr
+ (offset, ids) = switchTargetsToTable targets
+ platform = ncgPlatform config
+
+-- | Generate jump table data (if required)
--
-genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
-genSwitch expr targets = do -- pprPanic "genSwitch" (ppr expr)
- (reg, format, code) <- getSomeReg expr
- let w = formatToWidth format
- let mkbranch acc (key, bid) = do
- (keyReg, _format, code) <- getSomeReg (CmmLit (CmmInt key w))
- return $ code `appOL`
- toOL [ BCOND EQ (OpReg w reg) (OpReg w keyReg) (TBlock bid)
- ] `appOL` acc
- def_code = case switchTargetsDefault targets of
- Just bid -> unitOL (B (TBlock bid))
- Nothing -> nilOL
-
- switch_code <- foldM mkbranch nilOL (switchTargetsCases targets)
- return $ code `appOL` switch_code `appOL` def_code
-
--- We don't do jump tables for now, see Ticket 19912
-generateJumpTableForInstr :: NCGConfig -> Instr
- -> Maybe (NatCmmDecl RawCmmStatics Instr)
+-- Relies on PIC relocations. The idea is to emit one table entry per case. The
+-- entry is the label of the block to jump to. This will be relocated to be the
+-- address of the jump target.
+generateJumpTableForInstr ::
+ NCGConfig ->
+ Instr ->
+ Maybe (NatCmmDecl RawCmmStatics Instr)
+generateJumpTableForInstr config (J_TBL ids (Just lbl) _) =
+ let jumpTable =
+ map jumpTableEntryRel ids
+ where
+ jumpTableEntryRel Nothing =
+ CmmStaticLit (CmmInt 0 (ncgWordWidth config))
+ jumpTableEntryRel (Just blockid) =
+ CmmStaticLit (CmmLabel blockLabel)
+ where
+ blockLabel = blockLbl blockid
+ in Just (CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl jumpTable))
generateJumpTableForInstr _ _ = Nothing
-- -----------------------------------------------------------------------------
@@ -275,6 +305,7 @@ stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed
stmtToInstrs bid stmt = do
-- traceM $ "-- -------------------------- stmtToInstrs -------------------------- --\n"
-- ++ showSDocUnsafe (ppr stmt)
+ config <- getConfig
platform <- getPlatform
case stmt of
CmmUnsafeForeignCall target result_regs args
@@ -303,7 +334,7 @@ stmtToInstrs bid stmt = do
CmmCondBranch arg true false _prediction ->
genCondBranch bid true false arg
- CmmSwitch arg ids -> genSwitch arg ids
+ CmmSwitch arg ids -> genSwitch config arg ids
CmmCall { cml_target = arg } -> genJump arg
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -117,6 +117,7 @@ regUsageOfInstr platform instr = case instr of
XORI dst src1 _ -> usage (regOp src1, regOp dst)
-- 4. Branch Instructions ----------------------------------------------------
J t -> usage (regTarget t, [])
+ J_TBL _ _ t -> usage ([t], [])
B t -> usage (regTarget t, [])
B_FAR _t -> usage ([], [])
BCOND _ l r t -> usage (regTarget t ++ regOp l ++ regOp r, [])
@@ -248,6 +249,7 @@ patchRegsOfInstr instr env = case instr of
-- 4. Branch Instructions --------------------------------------------------
J t -> J (patchTarget t)
+ J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t)
B t -> B (patchTarget t)
B_FAR t -> B_FAR t
BL t rs ts -> BL (patchTarget t) rs ts
@@ -296,6 +298,7 @@ isJumpishInstr :: Instr -> Bool
isJumpishInstr instr = case instr of
ANN _ i -> isJumpishInstr i
J {} -> True
+ J_TBL {} -> True
B {} -> True
B_FAR {} -> True
BL {} -> True
@@ -307,6 +310,7 @@ isJumpishInstr instr = case instr of
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (J_TBL ids _mbLbl _r) = [id | Just id <- ids]
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B_FAR t) = [t]
jumpDestsOfInstr (BL t _ _) = [id | TBlock id <- [t]]
@@ -323,6 +327,7 @@ patchJumpInstr instr patchF =
case instr of
ANN d i -> ANN d (patchJumpInstr i patchF)
J (TBlock bid) -> J (TBlock (patchF bid))
+ J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
B (TBlock bid) -> B (TBlock (patchF bid))
B_FAR bid -> B_FAR (patchF bid)
BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs
@@ -510,7 +515,8 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
insert_dealloc insn r = case insn of
J _ -> dealloc ++ (insn : r)
- ANN _ (J _) -> dealloc ++ (insn : r)
+ J_TBL {} -> dealloc ++ (insn : r)
+ ANN _ e -> insert_dealloc e r
_other | jumpDestsOfInstr insn /= []
-> patchJumpInstr insn retarget : r
_other -> insn : r
@@ -659,6 +665,8 @@ data Instr
-- Branching.
-- TODO: Unused
| J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others.
+ -- | A `J` instruction with data for switch jump tables
+ | J_TBL [Maybe BlockId] (Maybe CLabel) Reg
| B Target -- unconditional branching b/br. (To a blockid, label or register)
-- | pseudo-op for far branch targets
| B_FAR BlockId
@@ -721,6 +729,7 @@ instrCon i =
LDRU{} -> "LDRU"
CSET{} -> "CSET"
J{} -> "J"
+ J_TBL{} -> "J_TBL"
B{} -> "B"
B_FAR{} -> "B_FAR"
BL{} -> "BL"
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -531,6 +531,7 @@ pprInstr platform instr = case instr of
-- 4. Branch Instructions ----------------------------------------------------
J t -> pprInstr platform (B t)
+ J_TBL _ _ r -> pprInstr platform (J (TReg r))
-- TODO: This is odd: (B)ranch and branch and link (BL) do the same: branch and link
B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
B (TReg r) -> line $ text "\tjalr" <+> text "x0" <> comma <+> pprReg W64 r <> comma <+> text "0"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9be2b1217a7ba6ca5da5ed157abf4959747bdb95
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9be2b1217a7ba6ca5da5ed157abf4959747bdb95
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/20240316/d59b6082/attachment-0001.html>
More information about the ghc-commits
mailing list