[Git][ghc/ghc][master] 3 commits: Cmm: Add surface syntax for Word/Float bitcast ops
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Mar 6 23:12:40 UTC 2025
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1d4c9824 by Matthew Craven at 2025-03-06T18:11:59-05:00
Cmm: Add surface syntax for Word/Float bitcast ops
- - - - -
25c4a2a2 by Matthew Craven at 2025-03-06T18:11:59-05:00
Cmm: Add constant-folding for Word->Float bitcasts
- - - - -
30bdea67 by Matthew Craven at 2025-03-06T18:11:59-05:00
Add tests for #25771
- - - - -
6 changed files:
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Parser.y
- + testsuite/tests/cmm/opt/T25771.cmm
- + testsuite/tests/cmm/opt/T25771.stderr
- testsuite/tests/cmm/opt/all.T
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -19,9 +19,11 @@ import GHC.Cmm
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Outputable
import GHC.Platform
import Data.Maybe
+import GHC.Float
constantFoldNode :: Platform -> CmmNode e x -> CmmNode e x
@@ -63,24 +65,51 @@ cmmMachOpFoldM _ (MO_VF_Broadcast lg _w) exprs =
[CmmLit l] -> Just $! CmmLit (CmmVec $ replicate lg l)
_ -> Nothing
cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
- = case op of
- MO_S_Neg _ -> Just $! CmmLit (CmmInt (narrowS rep (-x)) rep)
- MO_Not _ -> Just $! CmmLit (CmmInt (complement x) rep)
+ | MO_WF_Bitcast width <- op = case width of
+ W32 | res <- castWord32ToFloat (fromInteger x)
+ -- Since we store float literals as Rationals
+ -- we must check for the usual tricky cases first
+ , not (isNegativeZero res || isNaN res || isInfinite res)
+ -- (round-tripping subnormals is not a problem)
+ , !res_rat <- toRational res
+ -> Just (CmmLit (CmmFloat res_rat W32))
+
+ W64 | res <- castWord64ToDouble (fromInteger x)
+ -- Since we store float literals as Rationals
+ -- we must check for the usual tricky cases first
+ , not (isNegativeZero res || isNaN res || isInfinite res)
+ -- (round-tripping subnormals is not a problem)
+ , !res_rat <- toRational res
+ -> Just (CmmLit (CmmFloat res_rat W64))
+
+ _ -> Nothing
+ | otherwise
+ = Just $! case op of
+ MO_S_Neg _ -> CmmLit (CmmInt (narrowS rep (-x)) rep)
+ MO_Not _ -> CmmLit (CmmInt (complement x) rep)
-- these are interesting: we must first narrow to the
-- "from" type, in order to truncate to the correct size.
-- The final narrow/widen to the destination type
-- is implicit in the CmmLit.
- MO_SF_Round _frm to -> Just $! CmmLit (CmmFloat (fromInteger x) to)
- MO_SS_Conv from to -> Just $! CmmLit (CmmInt (narrowS from x) to)
- MO_UU_Conv from to -> Just $! CmmLit (CmmInt (narrowU from x) to)
- MO_XX_Conv from to -> Just $! CmmLit (CmmInt (narrowS from x) to)
-
- -- Not as simply as it seems, since CmmFloat uses Rational, so skipping those
- -- for now ...
- MO_WF_Bitcast _w -> Nothing
- MO_FW_Bitcast _w -> Nothing
+ MO_SF_Round _frm to -> CmmLit (CmmFloat (fromInteger x) to)
+ MO_SS_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
+ MO_UU_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
+ MO_XX_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
+
+ MO_F_Neg{} -> invalidArgPanic
+ MO_FS_Truncate{} -> invalidArgPanic
+ MO_FF_Conv{} -> invalidArgPanic
+ MO_FW_Bitcast{} -> invalidArgPanic
+ MO_VS_Neg{} -> invalidArgPanic
+ MO_VF_Neg{} -> invalidArgPanic
+ MO_RelaxedRead{} -> invalidArgPanic
+ MO_AlignmentCheck{} -> invalidArgPanic
+
_ -> panic $ "cmmMachOpFoldM: unknown unary op: " ++ show op
+ where invalidArgPanic = pprPanic "cmmMachOpFoldM" $
+ text "Found" <+> pprMachOp op
+ <+> text "illegally applied to an int literal"
-- Eliminate shifts that are wider than the shiftee
cmmMachOpFoldM _ op [_shiftee, CmmLit (CmmInt shift _)]
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -1109,7 +1109,10 @@ machOps = listToUFM $
( "f2i32", flip MO_FS_Truncate W32 ),
( "f2i64", flip MO_FS_Truncate W64 ),
( "i2f32", flip MO_SF_Round W32 ),
- ( "i2f64", flip MO_SF_Round W64 )
+ ( "i2f64", flip MO_SF_Round W64 ),
+
+ ( "w2f_bitcast", MO_WF_Bitcast ),
+ ( "f2w_bitcast", MO_FW_Bitcast )
]
callishMachOps :: Platform -> UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
=====================================
testsuite/tests/cmm/opt/T25771.cmm
=====================================
@@ -0,0 +1,8 @@
+// The point of this test is that the bitcast operations
+// should be successfully constant-folded, without panicking.
+
+func (float64 x) {
+ x = %fadd(x, %w2f_bitcast(0x4028b0a3d70a3d71 :: bits64));
+ x = %fadd(x, %f2f64(%w2f_bitcast(0x3f2a0000 :: bits32)));
+ return (x);
+}
=====================================
testsuite/tests/cmm/opt/T25771.stderr
=====================================
@@ -0,0 +1,20 @@
+
+==================== Output Cmm ====================
+[func() { // [D1]
+ { info_tbls: []
+ stack_info: arg_space: 8
+ }
+ {offset
+ c2: // global
+ //tick src<T25771.cmm:(4,18)-(8,1)>
+ //tick src<T25771.cmm:5:5-59>
+ //tick src<T25771.cmm:6:5-59>
+ _c1::F64 = D1; // CmmAssign
+ _c1::F64 = %MO_F_Add_W64(D1, 12.345 :: W64); // CmmAssign
+ D1 = %MO_F_Add_W64(_c1::F64,
+ %MO_FF_Conv_W32_W64(0.6640625 :: W32)); // CmmAssign
+ call (P64[Sp])(D1) args: 8, res: 0, upd: 8; // CmmCall
+ }
+ }]
+
+
=====================================
testsuite/tests/cmm/opt/all.T
=====================================
@@ -8,3 +8,7 @@ test('T20142', normal, compile, [''])
# We check this by telling the assembler to exit on warnings.
test('T24556', [only_ways('optasm'), cmm_src], compile, ['-O -opta -Xassembler -opta --fatal-warnings'])
+test('T25771', [cmm_src, only_ways(['optasm']),
+ grep_errmsg(r'(12\.345|0\.6640625)',[1]),
+ ],
+ compile, ['-ddump-cmm'])
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -210,7 +210,9 @@ test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
test('T17920', [cmm_src], compile_and_run, [''])
test('T18527', req_c, compile_and_run, ['T18527FFI.c'])
test('T19149', [req_c,only_ways('sanity')], compile_and_run, ['T19149_c.c'])
-test('T20275', normal, compile_and_run, [''])
+test('T20275', [unless(js_arch(),extra_ways(['optasm']))], compile_and_run, [''])
+ # Also tested with optimizations because
+ # that's the original reproducer for #25771
test('CallConv', [when(unregisterised(), skip),
unless(arch('x86_64') or arch('aarch64'), skip),
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b05c27bf186e66edc4fbf4a54943c8bd04f5024...30bdea67fcd9755619b1f513d199f2122591b28e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b05c27bf186e66edc4fbf4a54943c8bd04f5024...30bdea67fcd9755619b1f513d199f2122591b28e
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/20250306/568839fe/attachment-0001.html>
More information about the ghc-commits
mailing list