[Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Annotate more instructions
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri Jul 14 22:16:48 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
adf440b1 by Sven Tennie at 2023-07-15T00:15:05+02:00
Annotate more instructions
- - - - -
06eec420 by Sven Tennie at 2023-07-15T00:15:33+02:00
Truncate after left shift
Shifted values may exceed the target Width.
- - - - -
1 changed file:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -668,7 +668,7 @@ getRegister' config plat expr =
code
`appOL` toOL
[ ann
- (text "narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to)
+ (text "MO_SS_Conv: narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to)
(LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))),
-- signed right shift
ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift))
@@ -716,10 +716,18 @@ getRegister' config plat expr =
-- 2. Shifts. x << n, x >> n.
CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+ return $ Any (intFormat w) (\dst ->
+ code_x `snocOL`
+ annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) `appOL`
+ truncateReg w w dst
+ )
CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))))
+ return $ Any (intFormat w) (\dst ->
+ code_x `snocOL`
+ annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) `appOL`
+ truncateReg w w dst
+ )
CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do
(reg_x, format_x, code_x) <- getSomeReg x
@@ -873,64 +881,64 @@ getRegister' config plat expr =
-- N.B. We needn't sign-extend sub-word size (in)equality comparisons
-- since we don't care about ordering.
- MO_Eq w -> bitOp w (\d x y -> toOL [ CSET d x y EQ ])
- MO_Ne w -> bitOp w (\d x y -> toOL [ CSET d x y NE ])
+ MO_Eq w -> bitOp w (\d x y -> unitOL $ annExpr expr (CSET d x y EQ))
+ MO_Ne w -> bitOp w (\d x y -> unitOL $ annExpr expr (CSET d x y NE))
-- Signed multiply/divide
- MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y)
+ MO_Mul w -> intOp True w (\d x y -> unitOL $ annExpr expr (MUL d x y))
MO_S_MulMayOflo w -> do_mul_may_oflo w x y
- MO_S_Quot w -> intOp True w (\d x y -> unitOL $ DIV d x y)
+ MO_S_Quot w -> intOp True w (\d x y -> unitOL $ annExpr expr (DIV d x y))
-- Note the swap in Rx and Ry.
- MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y)
+ MO_S_Rem w -> intOp True w (\d x y -> unitOL $ annExpr expr (REM d x y))
-- Unsigned multiply/divide
- MO_U_Quot w -> intOp False w (\d x y -> unitOL $ DIVU d x y)
- MO_U_Rem w -> intOp False w (\d x y -> unitOL $ REM d x y)
+ MO_U_Quot w -> intOp False w (\d x y -> unitOL $ annExpr expr (DIVU d x y))
+ MO_U_Rem w -> intOp False w (\d x y -> unitOL $ annExpr expr (REM d x y))
- -- Signed comparisons -- see Note [CSET]
- MO_S_Ge w -> intOp True w (\d x y -> toOL [ CSET d x y SGE ])
- MO_S_Le w -> intOp True w (\d x y -> toOL [ CSET d x y SLE ])
- MO_S_Gt w -> intOp True w (\d x y -> toOL [ CSET d x y SGT ])
- MO_S_Lt w -> intOp True w (\d x y -> toOL [ CSET d x y SLT ])
+ -- Signed comparisons -- see Note [CSET)
+ MO_S_Ge w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SGE))
+ MO_S_Le w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SLE))
+ MO_S_Gt w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SGT))
+ MO_S_Lt w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SLT))
-- Unsigned comparisons
- MO_U_Ge w -> intOp False w (\d x y -> toOL [ CSET d x y UGE ])
- MO_U_Le w -> intOp False w (\d x y -> toOL [ CSET d x y ULE ])
- MO_U_Gt w -> intOp False w (\d x y -> toOL [ CSET d x y UGT ])
- MO_U_Lt w -> intOp False w (\d x y -> toOL [ CSET d x y ULT ])
+ MO_U_Ge w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y UGE))
+ MO_U_Le w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y ULE))
+ MO_U_Gt w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y UGT))
+ MO_U_Lt w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y ULT))
-- Floating point arithmetic
- MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y)
- MO_F_Sub w -> floatOp w (\d x y -> unitOL $ SUB d x y)
- MO_F_Mul w -> floatOp w (\d x y -> unitOL $ MUL d x y)
- MO_F_Quot w -> floatOp w (\d x y -> unitOL $ DIV d x y)
+ MO_F_Add w -> floatOp w (\d x y -> unitOL $ annExpr expr (ADD d x y))
+ MO_F_Sub w -> floatOp w (\d x y -> unitOL $ annExpr expr (SUB d x y))
+ MO_F_Mul w -> floatOp w (\d x y -> unitOL $ annExpr expr (MUL d x y))
+ MO_F_Quot w -> floatOp w (\d x y -> unitOL $ annExpr expr (DIV d x y))
-- Floating point comparison
- MO_F_Eq w -> floatCond w (\d x y -> toOL [ CSET d x y EQ ])
- MO_F_Ne w -> floatCond w (\d x y -> toOL [ CSET d x y NE ])
+ MO_F_Eq w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y EQ))
+ MO_F_Ne w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y NE))
-- careful with the floating point operations.
-- SLE is effectively LE or unordered (NaN)
-- SLT is the same. ULE, and ULT will not return true for NaN.
-- This is a bit counter-intuitive. Don't let yourself be fooled by
-- the S/U prefix for floats, it's only meaningful for integers.
- MO_F_Ge w -> floatCond w (\d x y -> toOL [ CSET d x y OGE ])
- MO_F_Le w -> floatCond w (\d x y -> toOL [ CSET d x y OLE ]) -- x <= y <=> y > x
- MO_F_Gt w -> floatCond w (\d x y -> toOL [ CSET d x y OGT ])
- MO_F_Lt w -> floatCond w (\d x y -> toOL [ CSET d x y OLT ]) -- x < y <=> y >= x
+ MO_F_Ge w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OGE))
+ MO_F_Le w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OLE)) -- x <= y <=> y > x
+ MO_F_Gt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OGT))
+ MO_F_Lt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OLT)) -- x < y <=> y >= x
-- Bitwise operations
- MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y)
- MO_Or w -> bitOp w (\d x y -> unitOL $ OR d x y)
- MO_Xor w -> bitOp w (\d x y -> unitOL $ XOR d x y)
- MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y)
- MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y)
- MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y)
+ MO_And w -> bitOp w (\d x y -> unitOL $ annExpr expr (AND d x y))
+ MO_Or w -> bitOp w (\d x y -> unitOL $ annExpr expr (OR d x y))
+ MO_Xor w -> bitOp w (\d x y -> unitOL $ annExpr expr (XOR d x y))
+ MO_Shl w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSL d x y))
+ MO_U_Shr w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSR d x y))
+ MO_S_Shr w -> intOp True w (\d x y -> unitOL $ annExpr expr (ASR d x y))
-- TODO
- op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ (pprMachOp op) <+> text "in" <+> (pdoc plat expr)
+ op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> (pdoc plat expr)
CmmMachOp _op _xs
-> pprPanic "getRegister' (variadic CmmMachOp): " (pdoc plat expr)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b21e0985ea6c354ee6e147d2239dccdf7102241a...06eec420862b1b1399f81f356bfd59e0d173c7db
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b21e0985ea6c354ee6e147d2239dccdf7102241a...06eec420862b1b1399f81f356bfd59e0d173c7db
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/20230714/f2db231a/attachment-0001.html>
More information about the ghc-commits
mailing list