[Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix & test MulMayOflo
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri Jun 9 14:39:50 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
93273fdd by Sven Tennie at 2023-06-09T14:39:03+00:00
Fix & test MulMayOflo
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -954,14 +954,14 @@ getRegister' config plat expr
code_x
`appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x
`appOL` code_y
- `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y
+ `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y
`appOL` toOL
[ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)),
MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y),
- ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))),
+ ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))),
ann
(text "Set flag if result of MULH contains more than sign bits.")
- (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)),
+ (XOR (OpReg w hi) (OpReg w hi) (OpReg w lo)),
CSET (OpReg w dst) (OpReg w hi) nonSense NE
]
)
@@ -996,7 +996,7 @@ getRegister' config plat expr
`appOL` code_y
`appOL` signExtend (formatToWidth format_y) W32 reg_y reg_y
`snocOL` annExpr expr (MUL (OpReg W32 dst) (OpReg W32 reg_x) (OpReg W32 reg_y))
- `appOL` signExtend W32 w dst narrowedReg
+ `appOL` signExtendAdjustPrecission W32 w dst narrowedReg
`appOL` toOL
[ ann
(text "Check if the multiplied value fits in the narrowed register")
@@ -1005,6 +1005,7 @@ getRegister' config plat expr
]
)
else do
+ -- TODO: Can this case ever happen? Write a test for it!
-- TODO: Can't we clobber reg_x and reg_y to save registers?
lo <- getNewRegNat II64
hi <- getNewRegNat II64
@@ -1023,7 +1024,7 @@ getRegister' config plat expr
`appOL` toOL
[ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)),
MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y),
- ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))),
+ ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))),
ann
(text "Set flag if result of MULH contains more than sign bits.")
(SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)),
@@ -1077,6 +1078,42 @@ signExtend w w' r r' =
where
shift = 64 - widthInBits w
+-- | Sign extends to 64bit, if needed and reduces the precission to the target `Width` (@w'@)
+--
+-- Source `Reg` @r@ stays untouched, while the conversion happens on destination
+-- `Reg` @r'@.
+signExtendAdjustPrecission :: Width -> Width -> Reg -> Reg -> OrdList Instr
+signExtendAdjustPrecission w w' _r _r' | w > W64 || w' > W64 = pprPanic "Unexpected width (max is 64bit):" $ ppr w <> text "->" <+> ppr w'
+signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 && r == r' = nilOL
+signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r)
+signExtendAdjustPrecission w w' r r'
+ | w == W32 && w' == W64 =
+ unitOL $
+ ann
+ (text "sign-extend register (SEXT.W)" <+> ppr r <+> ppr w <> text "->" <> ppr w')
+ -- `ADDIW r r 0` is the pseudo-op SEXT.W
+ (ADD (OpReg w' r') (OpReg w r) (OpImm (ImmInt 0)))
+signExtendAdjustPrecission w w' r r' | w > w' =
+ toOL
+ [ ann
+ (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w')
+ (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
+ -- signed (arithmetic) right shift
+ ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
+ ]
+ where
+ shift = 64 - widthInBits w'
+signExtendAdjustPrecission w w' r r' =
+ toOL
+ [ ann
+ (text "sign extend register" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w')
+ (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))),
+ -- signed (arithmetic) right shift
+ ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift))
+ ]
+ where
+ shift = 64 - widthInBits w
+
-- | Instructions to truncate the value in the given register from width @w@
-- to width @w'@.
--
=====================================
testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm
=====================================
@@ -1,4 +1,91 @@
+// Suppress empty ASSERT() optimization
+#define USE_ASSERTS_ALL_WAYS 1
+
+#include "Cmm.h"
+
runCmmzh() {
+// BEWARE: Cmm isn't really type checked. I.e. you may construct
+// 256::I8, which is obviously wrong and let's to strange behaviour.
+
+// N.B. the contract of '%mulmayoflo' is a bit weak:
+// "Return non-zero if there is any possibility that the signed multiply
+// of a and b might overflow. Return zero only if you are absolutely sure
+// that it won't overflow. If in doubt, return non-zero." (Stg.h)
+// So, this test might be a bit too strict for some architectures as it
+// expects a perfect implementation.
+
+ // --- I8
+ ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8);
+ ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8);
+ ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8);
+ ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8);
+ ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8);
+ ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8);
+ ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8);
+ ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8);
+ ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8);
+ ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8);
+ ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8);
+ ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8);
+
+ // --- I16
+ ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16);
+ ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16);
+ ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16);
+ ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16);
+ ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16);
+ ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16);
+ ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16);
+ ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16);
+ ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16);
+ ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16);
+ ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16);
+ ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16);
+ ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16);
+ ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16);
+
+ // -- I32
+ ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32);
+ ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32);
+ ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32);
+ ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32);
+ ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32);
+ ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32);
+ ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32);
+ ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32);
+ ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32);
+ ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32);
+ ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32);
+ ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32);
+ ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32);
+ ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32);
+ ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32);
+ ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32);
+
+ // -- I64
+ ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64);
+ ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64);
+ ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64);
+ ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64);
+ ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64);
+ ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64);
+ ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64);
+ ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64);
+ ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64);
+ ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64);
+ ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64);
+ ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64);
+ ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64);
+ ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64);
+ ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64);
+ ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64);
+ // Gives a linter error
+ // ASSERT(%mulmayoflo(1::I64, 1::I8) == 0);
return(0);
}
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -231,6 +231,6 @@ test('T22296',[only_ways(llvm_ways)
test('T22798', normal, compile_and_run, ['-fregs-graph'])
test('MulMayOflo',
- [ omit_ways(['ghci']), js_skip],
+ [ omit_ways(['ghci']), js_skip, ignore_stdout],
multi_compile_and_run,
['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], ''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93273fdd6931c0ba940b9435f46f0dbd5559fff6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93273fdd6931c0ba940b9435f46f0dbd5559fff6
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/20230609/e55862dd/attachment-0001.html>
More information about the ghc-commits
mailing list