[Git][ghc/ghc][wip/T24264] Clean up T24264 test and stderr
Matthew Craven (@clyring)
gitlab at gitlab.haskell.org
Thu Dec 28 23:03:24 UTC 2023
Matthew Craven pushed to branch wip/T24264 at Glasgow Haskell Compiler / GHC
Commits:
8bb2c8bb by Matthew Craven at 2023-12-28T18:02:56-05:00
Clean up T24264 test and stderr
- - - - -
2 changed files:
- testsuite/tests/codeGen/should_compile/T24264.hs
- testsuite/tests/codeGen/should_compile/T24264.stderr
Changes:
=====================================
testsuite/tests/codeGen/should_compile/T24264.hs
=====================================
@@ -1,10 +1,14 @@
+{-# LANGUAGE MagicHash #-}
+
module T24264 where
import Control.Exception (evaluate)
+import GHC.Exts (seq#, noinline)
+import GHC.IO (IO(..))
-fun :: a -> IO a
-{-# OPAQUE fun #-}
-fun x = do
+fun1 :: a -> IO a
+{-# OPAQUE fun1 #-}
+fun1 x = do
pure ()
pure $! x
-- This should not push a continuation to the stack before entering 'x'
@@ -16,13 +20,17 @@ fun2 x = do
evaluate x
-- This should not push a continuation to the stack before entering 'x'
--- We really should have a function that /does/ push a continuation to
--- the stack in this test, to verify that the 'returns to' detection
--- continues to work correctly. But it turns out that on some
--- platforms we don't produce these 'returns to' annotations. And
--- until the reasons for that can be investigated and documented,
--- having this in the test seems to cause more problems than it
--- solves. See <ticket>.
+fun3 :: a -> IO a
+{-# OPAQUE fun3 #-}
+fun3 x = do
+ pure ()
+ -- "evaluate $! x"
+ case x of !x' -> IO (noinline seq# x')
+ -- noinline to work around the bogus seqRule
+ -- This ideally also should not push a continuation to the stack
+ -- before entering 'x'. It currently does, but let's wait for
+ -- !11515 to land before worrying about that.
+
funPair :: a -> IO (a, a)
{-# OPAQUE funPair #-}
funPair x = do
=====================================
testsuite/tests/codeGen/should_compile/T24264.stderr
=====================================
@@ -1,27 +1,27 @@
==================== Cmm produced by codegen ====================
-[T24264.fun_entry() { // [R2]
- { info_tbls: [(cNT,
- label: T24264.fun_info
+[T24264.fun1_entry() { // [R2]
+ { info_tbls: [(cQO,
+ label: T24264.fun1_info
rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cNT: // global
- _sNE::P64 = R2; // CmmAssign
- goto cNR; // CmmBranch
- cNR: // global
- if ((old + 0) - <highSp> < SpLim) (likely: False) goto cNU; else goto cNV; // CmmCondBranch
- cNU: // global
- R2 = _sNE::P64; // CmmAssign
- R1 = T24264.fun_closure; // CmmAssign
+ cQO: // global
+ _sQw::P64 = R2; // CmmAssign
+ goto cQM; // CmmBranch
+ cQM: // global
+ if ((old + 0) - <highSp> < SpLim) (likely: False) goto cQP; else goto cQQ; // CmmCondBranch
+ cQP: // global
+ R2 = _sQw::P64; // CmmAssign
+ R1 = T24264.fun1_closure; // CmmAssign
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
- cNV: // global
- goto cNQ; // CmmBranch
- cNQ: // global
+ cQQ: // global
+ goto cQL; // CmmBranch
+ cQL: // global
// slowCall
- R1 = _sNE::P64; // CmmAssign
+ R1 = _sQw::P64; // CmmAssign
call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; // CmmCall
}
}]
@@ -30,76 +30,111 @@
==================== Cmm produced by codegen ====================
[T24264.fun2_entry() { // [R2]
- { info_tbls: [(cO3,
+ { info_tbls: [(cQY,
label: T24264.fun2_info
rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cO3: // global
- _sNH::P64 = R2; // CmmAssign
- goto cO1; // CmmBranch
- cO1: // global
- if ((old + 0) - <highSp> < SpLim) (likely: False) goto cO4; else goto cO5; // CmmCondBranch
- cO4: // global
- R2 = _sNH::P64; // CmmAssign
+ cQY: // global
+ _sQz::P64 = R2; // CmmAssign
+ goto cQW; // CmmBranch
+ cQW: // global
+ if ((old + 0) - <highSp> < SpLim) (likely: False) goto cQZ; else goto cR0; // CmmCondBranch
+ cQZ: // global
+ R2 = _sQz::P64; // CmmAssign
R1 = T24264.fun2_closure; // CmmAssign
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
- cO5: // global
- goto cO0; // CmmBranch
- cO0: // global
+ cR0: // global
+ goto cQV; // CmmBranch
+ cQV: // global
// slowCall
- R1 = _sNH::P64; // CmmAssign
+ R1 = _sQz::P64; // CmmAssign
call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; // CmmCall
}
}]
+==================== Cmm produced by codegen ====================
+[T24264.fun3_entry() { // [R2]
+ { info_tbls: [(cRb,
+ label: T24264.fun3_info
+ rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
+ srt: Nothing)]
+ stack_info: arg_space: 8
+ }
+ {offset
+ cRb: // global
+ _sQB::P64 = R2; // CmmAssign
+ goto cR6; // CmmBranch
+ cR6: // global
+ if ((old + 0) - <highSp> < SpLim) (likely: False) goto cRc; else goto cRd; // CmmCondBranch
+ cRc: // global
+ R2 = _sQB::P64; // CmmAssign
+ R1 = T24264.fun3_closure; // CmmAssign
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
+ cRd: // global
+ goto cR5; // CmmBranch
+ cR5: // global
+ // slowCall
+ I64[(young<cR8> + 8)] = cR8; // CmmStore
+ R1 = _sQB::P64; // CmmAssign
+ call stg_ap_0_fast(R1) returns to cR8, args: 8, res: 8, upd: 8; // CmmCall
+ cR8: // global
+ _sQD::P64 = R1; // CmmAssign
+ // slow_call for _sQB::P64 with pat stg_ap_0
+ R1 = _sQD::P64; // CmmAssign
+ call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ }
+ }]
+
+
+
==================== Cmm produced by codegen ====================
[T24264.funPair_entry() { // [R2]
- { info_tbls: [(cOg,
+ { info_tbls: [(cRq,
label: T24264.funPair_info
rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cOg: // global
- _sNJ::P64 = R2; // CmmAssign
- goto cOb; // CmmBranch
- cOb: // global
- if ((old + 0) - <highSp> < SpLim) (likely: False) goto cOh; else goto cOi; // CmmCondBranch
- cOh: // global
- R2 = _sNJ::P64; // CmmAssign
+ cRq: // global
+ _sQE::P64 = R2; // CmmAssign
+ goto cRl; // CmmBranch
+ cRl: // global
+ if ((old + 0) - <highSp> < SpLim) (likely: False) goto cRr; else goto cRs; // CmmCondBranch
+ cRr: // global
+ R2 = _sQE::P64; // CmmAssign
R1 = T24264.funPair_closure; // CmmAssign
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
- cOi: // global
- goto cOa; // CmmBranch
- cOa: // global
+ cRs: // global
+ goto cRk; // CmmBranch
+ cRk: // global
// slowCall
- I64[(young<cOd> + 8)] = cOd; // CmmStore
- R1 = _sNJ::P64; // CmmAssign
- call stg_ap_0_fast(R1) returns to cOd, args: 8, res: 8, upd: 8; // CmmCall
- cOd: // global
- _sNL::P64 = R1; // CmmAssign
- // slow_call for _sNJ::P64 with pat stg_ap_0
+ I64[(young<cRn> + 8)] = cRn; // CmmStore
+ R1 = _sQE::P64; // CmmAssign
+ call stg_ap_0_fast(R1) returns to cRn, args: 8, res: 8, upd: 8; // CmmCall
+ cRn: // global
+ _sQG::P64 = R1; // CmmAssign
+ // slow_call for _sQE::P64 with pat stg_ap_0
Hp = Hp + 24; // CmmAssign
- if (Hp > HpLim) (likely: False) goto cOl; else goto cOk; // CmmCondBranch
- cOl: // global
+ if (Hp > HpLim) (likely: False) goto cRv; else goto cRu; // CmmCondBranch
+ cRv: // global
HpAlloc = 24; // CmmAssign
- goto cOj; // CmmBranch
- cOj: // global
- R1 = _sNL::P64; // CmmAssign
- call stg_gc_unpt_r1(R1) returns to cOd, args: 8, res: 8, upd: 8; // CmmCall
- cOk: // global
+ goto cRt; // CmmBranch
+ cRt: // global
+ R1 = _sQG::P64; // CmmAssign
+ call stg_gc_unpt_r1(R1) returns to cRn, args: 8, res: 8, upd: 8; // CmmCall
+ cRu: // global
// allocHeapClosure
I64[Hp - 16] = (,)_con_info; // CmmStore
- P64[Hp - 8] = _sNL::P64; // CmmStore
- P64[Hp] = _sNL::P64; // CmmStore
- _cOf::P64 = Hp - 15; // CmmAssign
- R1 = _cOf::P64; // CmmAssign
+ P64[Hp - 8] = _sQG::P64; // CmmStore
+ P64[Hp] = _sQG::P64; // CmmStore
+ _cRp::P64 = Hp - 15; // CmmAssign
+ R1 = _cRp::P64; // CmmAssign
call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; // CmmCall
}
}]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8bb2c8bbba69a3a59e3f78c84aa7b0b66de2d59e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8bb2c8bbba69a3a59e3f78c84aa7b0b66de2d59e
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/20231228/f14a70af/attachment-0001.html>
More information about the ghc-commits
mailing list