[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