[Git][ghc/ghc][wip/supersven/riscv64-ncg] Add DIV and REM
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri May 19 08:26:20 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
4e60ab12 by Sven Tennie at 2023-05-19T10:24:07+02:00
Add DIV and REM
REM calculates the remainder and replaces the more complex logic copied
from AARCH64.
- - - - -
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
=====================================
@@ -881,22 +881,14 @@ getRegister' config plat expr
-- Signed multiply/divide
MO_Mul w -> intOp True w (\d x y -> unitOL $ 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 $ SDIV d x y)
-
- -- No native rem instruction. So we'll compute the following
- -- Rd <- Rx / Ry | 2 <- 7 / 3 -- SDIV Rd Rx Ry
- -- Rd' <- Rx - Rd * Ry | 1 <- 7 - 2 * 3 -- MSUB Rd' Rd Ry Rx
- -- | '---|----------------|---' |
- -- | '----------------|-------'
- -- '--------------------------'
+ MO_S_Quot w -> intOp True w (\d x y -> unitOL $ DIV d x y)
+
-- Note the swap in Rx and Ry.
- MO_S_Rem w -> withTempIntReg w $ \t ->
- intOp True w (\d x y -> toOL [ SDIV t x y, MSUB d t y x ])
+ MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y)
-- Unsigned multiply/divide
MO_U_Quot w -> intOp False w (\d x y -> unitOL $ UDIV d x y)
- MO_U_Rem w -> withTempIntReg w $ \t ->
- intOp False w (\d x y -> toOL [ UDIV t x y, MSUB d t y x ])
+ MO_U_Rem w -> intOp False w (\d x y -> unitOL $ 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 ])
@@ -914,7 +906,7 @@ getRegister' config plat expr
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 $ SDIV d x y)
+ MO_F_Quot w -> floatOp w (\d x y -> unitOL $ DIV d x y)
-- Floating point comparison
MO_F_Eq w -> floatCond w (\d x y -> toOL [ CSET d x y EQ ])
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -82,12 +82,12 @@ regUsageOfInstr platform instr = case instr of
ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
-- CMN l r -> usage (regOp l ++ regOp r, [])
-- CMP l r -> usage (regOp l ++ regOp r, [])
- MSUB dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
NEG dst src -> usage (regOp src, regOp dst)
SMULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
SMULL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- SDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+ DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
+ REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
UDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -222,12 +222,12 @@ patchRegsOfInstr instr env = case instr of
ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
-- CMN o1 o2 -> CMN (patchOp o1) (patchOp o2)
-- CMP o1 o2 -> CMP (patchOp o1) (patchOp o2)
- MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
NEG o1 o2 -> NEG (patchOp o1) (patchOp o2)
SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2) (patchOp o3)
SMULL o1 o2 o3 -> SMULL (patchOp o1) (patchOp o2) (patchOp o3)
- SDIV o1 o2 o3 -> SDIV (patchOp o1) (patchOp o2) (patchOp o3)
+ DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3)
+ REM o1 o2 o3 -> REM (patchOp o1) (patchOp o2) (patchOp o3)
SUB o1 o2 o3 -> SUB (patchOp o1) (patchOp o2) (patchOp o3)
UDIV o1 o2 o3 -> UDIV (patchOp o1) (patchOp o2) (patchOp o3)
@@ -607,7 +607,6 @@ data Instr
-- | CMN Operand Operand -- rd + op2
-- | CMP Operand Operand -- rd - op2
- | MSUB Operand Operand Operand Operand -- rd = ra - rn × rm
| MUL Operand Operand Operand -- rd = rn × rm
@@ -616,7 +615,8 @@ data Instr
-- NOT = XOR -1, x
| NEG Operand Operand -- rd = -op2
- | SDIV Operand Operand Operand -- rd = rn ÷ rm
+ | DIV Operand Operand Operand -- rd = rn ÷ rm
+ | REM Operand Operand Operand -- rd = rn % rm
| SMULH Operand Operand Operand
| SMULL Operand Operand Operand
@@ -707,10 +707,10 @@ instrCon i =
OR{} -> "OR"
-- CMN{} -> "CMN"
-- CMP{} -> "CMP"
- MSUB{} -> "MSUB"
MUL{} -> "MUL"
NEG{} -> "NEG"
- SDIV{} -> "SDIV"
+ DIV{} -> "DIV"
+ REM{} -> "REM"
SMULH{} -> "SMULH"
SMULL{} -> "SMULL"
SUB{} -> "SUB"
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -461,7 +461,6 @@ pprInstr platform instr = case instr of
-- CMP o1 o2
-- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2
-- | otherwise -> op2 (text "\tcmp") o1 o2
- MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4
MUL o1 o2 o3
| isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3
| otherwise -> op3 (text "\tmul") o1 o2 o3
@@ -470,9 +469,13 @@ pprInstr platform instr = case instr of
NEG o1 o2
| isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2
| otherwise -> op2 (text "\tneg") o1 o2
- SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
+ DIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
+ -- TODO: This must (likely) be refined regarding width
-> op3 (text "\tfdiv") o1 o2 o3
- SDIV o1 o2 o3 -> op3 (text "\tsdiv") o1 o2 o3
+ DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3
+ REM o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
+ -> panic $ "pprInstr - REM not implemented for floats (yet)"
+ REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3
SUB o1 o2 o3
| isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e60ab12f1125af5f1c97efd916c12a5ff1be7f2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e60ab12f1125af5f1c97efd916c12a5ff1be7f2
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/20230519/f5c9469e/attachment-0001.html>
More information about the ghc-commits
mailing list