[Git][ghc/ghc][wip/supersven/riscv-ncg] Unconditional jumps
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Tue Apr 18 16:07:09 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv-ncg at Glasgow Haskell Compiler / GHC
Commits:
c425f153 by Sven Tennie at 2023-04-18T16:06:40+00:00
Unconditional jumps
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/RISCV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RISCV64/Instr.hs
- compiler/GHC/CmmToAsm/RISCV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RISCV64/CodeGen.hs
=====================================
@@ -103,6 +103,7 @@ stmtToInstrs stmt = do
where ty = cmmRegType reg
format = cmmTypeFormat ty
CmmBranch id -> genBranch id
+ CmmCall { cml_target = arg } -> genJump arg
a -> error $ "TODO: stmtToInstrs " ++ (showSDocUnsafe . pdoc platform) a
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
@@ -147,6 +148,13 @@ getRegister' config plat expr
e -> error ("TODO: getRegister' other " ++ show e)
e -> error ("TODO: getRegister'" ++ show e)
+-- -----------------------------------------------------------------------------
+-- Jumps
+genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
+genJump expr@(CmmLit (CmmLabel lbl))
+ = return $ unitOL (annExpr expr (J (TLabel lbl)))
+genJump expr = error $ "TODO: genJump " ++ show expr
+
-- -----------------------------------------------------------------------------
-- Unconditional branches
genBranch :: BlockId -> NatM InstrBlock
=====================================
compiler/GHC/CmmToAsm/RISCV64/Instr.hs
=====================================
@@ -13,6 +13,7 @@ import GHC.Types.Unique.Supply
import GHC.Utils.Outputable
import Prelude
import GHC.Platform.Regs (freeReg)
+import GHC.Cmm.CLabel
data Instr
= -- comment pseudo-op
@@ -36,7 +37,11 @@ data Instr
| -- load immediate pseudo-instruction
LI Reg Integer
| -- jump pseudo-instruction
- J BlockId
+ J Target
+
+data Target
+ = TBlock BlockId
+ | TLabel CLabel
allocMoreStack ::
Int ->
@@ -136,7 +141,7 @@ isJumpishInstr J {} = True
-- register allocator needs to worry about.
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
-jumpDestsOfInstr (J t) = [t]
+jumpDestsOfInstr (J (TBlock t)) = [t]
jumpDestsOfInstr _ = []
-- | Change the destination of this jump instruction.
@@ -231,7 +236,7 @@ takeRegRegMoveInstr J {} = Nothing
mkJumpInstr ::
BlockId ->
[Instr]
-mkJumpInstr id = [J id]
+mkJumpInstr id = [J (TBlock id)]
-- Subtract an amount from the C stack pointer
mkStackAllocInstr ::
=====================================
compiler/GHC/CmmToAsm/RISCV64/Ppr.hs
=====================================
@@ -137,8 +137,9 @@ pprInstr platform instr = case instr of
pprReg (RegReal (RealRegSingle r)) = text "x" <> (text.show) r
pprReg (RegVirtual r) = panic $ "RISCV64.Ppr.ppr: Unexpected virtual register " ++ show r
- pprJ :: IsLine doc => BlockId -> doc
- pprJ label = text "\tj" <+> pprBlockId label
+ pprJ :: IsLine doc => Target -> doc
+ pprJ (TBlock label) = text "\tj" <+> pprBlockId label
+ pprJ (TLabel label) = text "\tj" <+> pprAsmLabel platform label
pprBlockId:: IsLine doc => BlockId -> doc
pprBlockId blockId = pprAsmLabel platform (mkLocalBlockLabel (getUnique blockId))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c425f15324cbf92f423176bb5eb50c7c9e5bc43e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c425f15324cbf92f423176bb5eb50c7c9e5bc43e
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/20230418/bb2c1931/attachment-0001.html>
More information about the ghc-commits
mailing list