[Git][ghc/ghc][wip/supersven/riscv64-ncg] Float conditional jumps
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Aug 20 12:04:10 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
1c103206 by Sven Tennie at 2023-08-20T14:03:45+02:00
Float conditional jumps
- - - - -
2 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1283,7 +1283,12 @@ genCondJump bid expr = do
-- ensure we get float regs
(reg_fx, _format_fx, code_fx) <- getFloatReg x
(reg_fy, _format_fy, code_fy) <- getFloatReg y
- return $ code_fx `appOL` code_fy `snocOL` (annExpr expr (BCOND cmp (OpReg w reg_fx) (OpReg w reg_fy) (TBlock bid)))
+ oneReg <- getNewRegNat II64
+ return $ code_fx `appOL`
+ code_fy `snocOL`
+ annExpr expr (CSET ip (OpReg w reg_fx) (OpReg w reg_fy) cmp) `snocOL`
+ MOV (OpReg W64 oneReg) (OpImm (ImmInt 1)) `snocOL`
+ BCOND EQ ip (OpReg w oneReg) (TBlock bid)
case mop of
MO_F_Eq w -> fbcond w EQ
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -579,12 +579,12 @@ pprInstr platform instr = case instr of
CSET o l r c -> case c of
EQ | isIntOp l && isIntOp r -> lines_ [ subFor l r
, text "\tseqz" <+> pprOp platform o <> comma <+> pprOp platform o]
- EQ | isFloatOp l && isFloatOp r -> line $ floatOp "\tfeq.s"
+ EQ | isFloatOp l && isFloatOp r -> line $ binOp "\tfeq.s"
NE | isIntOp l && isIntOp r -> lines_ [ subFor l r
, text "\tsnez" <+> pprOp platform o <> comma <+> pprOp platform o]
-- feq.s a0,fa0,fa1
-- xori a0,a0,1
- NE | isFloatOp l && isFloatOp r -> lines_ [floatOp "\tfeq.s", text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"]
+ NE | isFloatOp l && isFloatOp r -> lines_ [binOp "\tfeq.s", text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"]
SLT -> lines_ [ sltFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r ]
SLE -> lines_ [ sltFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l
, text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1" ]
@@ -597,10 +597,10 @@ pprInstr platform instr = case instr of
UGE -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
, text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1" ]
UGT -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l ]
- OLT | isFloatOp l && isFloatOp r -> line $ floatOp "\tflt.s"
- OLE | isFloatOp l && isFloatOp r -> line $ floatOp "\tfle.s"
- OGT | isFloatOp l && isFloatOp r -> line $ floatOp "\tfgt.s"
- OGE | isFloatOp l && isFloatOp r -> line $ floatOp "\tfge.s"
+ OLT | isFloatOp l && isFloatOp r -> line $ binOp "\tflt.s"
+ OLE | isFloatOp l && isFloatOp r -> line $ binOp "\tfle.s"
+ OGT | isFloatOp l && isFloatOp r -> line $ binOp "\tfgt.s"
+ OGE | isFloatOp l && isFloatOp r -> line $ binOp "\tfge.s"
_ -> pprPanic "RV64.ppr: unhandled CSET conditional" (pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l)
where
subFor l r | (OpImm _) <- r = text "\taddi" <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform (negOp r)
@@ -612,7 +612,7 @@ pprInstr platform instr = case instr of
sltuFor l r| (OpImm _) <- r = text "\tsltui"
| (OpImm _) <- l = panic "PV64.ppr: Cannot SLTU IMM _"
| otherwise = text "\tsltu"
- floatOp op = text op <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
+ binOp op = text op <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
CBZ o (TBlock bid) -> line $ text "\tbeq x0, " <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
CBZ o (TLabel lbl) -> line $ text "\tbeq x0, " <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
@@ -683,16 +683,16 @@ pprInstr platform instr = case instr of
-- 9. Floating Point Instructions --------------------------------------------
FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2
SCVTF o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.w") o1 o2
+ SCVTF o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.w") o1 o2
SCVTF o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.l") o1 o2
- SCVTF o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.w") o1 o2
- SCVTF o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.l") o1 o2
+ SCVTF o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.l") o1 o2
SCVTF o1 o2 -> pprPanic "RV64.pprInstr - impossible integer to float conversion" $
line (pprOp platform o1 <> text "->" <> pprOp platform o2)
- FCVTZS o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\fcvt.w.s") o1 o2
- FCVTZS o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\fcvt.l.s") o1 o2
- FCVTZS o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\fcvt.w.d") o1 o2
- FCVTZS o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\fcvt.l.d") o1 o2
+ FCVTZS o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.w.s") o1 o2
+ FCVTZS o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.w.s") o1 o2
+ FCVTZS o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.l.s") o1 o2
+ FCVTZS o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.l.s") o1 o2
FCVTZS o1 o2 -> pprPanic "RV64.pprInstr - impossible float to integer conversion" $
line (pprOp platform o1 <> text "->" <> pprOp platform o2)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c103206664a73d85b61b0cc7768e135eb63dc3c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c103206664a73d85b61b0cc7768e135eb63dc3c
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/20230820/fb3128fc/attachment-0001.html>
More information about the ghc-commits
mailing list