[Git][ghc/ghc][wip/T24264] another stupid try
Matthew Craven (@clyring)
gitlab at gitlab.haskell.org
Thu Dec 28 18:21:31 UTC 2023
Matthew Craven pushed to branch wip/T24264 at Glasgow Haskell Compiler / GHC
Commits:
b5ca0b77 by Matthew Craven at 2023-12-28T13:20:49-05:00
another stupid try
- - - - -
3 changed files:
- testsuite/tests/codeGen/should_compile/T24264.hs
- testsuite/tests/codeGen/should_compile/T24264.stderr
- testsuite/tests/codeGen/should_compile/all.T
Changes:
=====================================
testsuite/tests/codeGen/should_compile/T24264.hs
=====================================
@@ -1,5 +1,7 @@
module T24264 where
+import Control.Exception (evaluate)
+
fun :: a -> IO a
{-# OPAQUE fun #-}
fun x = do
@@ -7,6 +9,20 @@ fun x = do
pure $! x
-- This should not push a continuation to the stack before entering 'x'
+fun2 :: a -> IO a
+{-# OPAQUE fun2 #-}
+fun2 x = do
+ pure ()
+ 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>.
funPair :: a -> IO (a, a)
{-# OPAQUE funPair #-}
funPair x = do
=====================================
testsuite/tests/codeGen/should_compile/T24264.stderr
=====================================
@@ -1,70 +1,107 @@
-==================== Output Cmm ====================
+==================== Cmm produced by codegen ====================
[T24264.fun_entry() { // [R2]
- { info_tbls: [(cKd,
+ { info_tbls: [(cNT,
label: T24264.fun_info
rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cKd: // global
+ 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
+ call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
+ cNV: // global
+ goto cNQ; // CmmBranch
+ cNQ: // global
+ // slowCall
+ R1 = _sNE::P64; // CmmAssign
+ call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; // CmmCall
+ }
+ }]
+
+
+
+==================== Cmm produced by codegen ====================
+[T24264.fun2_entry() { // [R2]
+ { info_tbls: [(cO3,
+ 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
+ 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
// slowCall
- R1 = R2; // CmmAssign
+ R1 = _sNH::P64; // CmmAssign
call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; // CmmCall
}
- },
- section ""data" . T24264.fun_closure" {
- T24264.fun_closure:
- const T24264.fun_info;
}]
-==================== Output Cmm ====================
+==================== Cmm produced by codegen ====================
[T24264.funPair_entry() { // [R2]
- { info_tbls: [(cKn,
- label: block_cKn_info
- rep: StackRep []
- srt: Nothing),
- (cKq,
+ { info_tbls: [(cOg,
label: T24264.funPair_info
rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 5} }
srt: Nothing)]
stack_info: arg_space: 8
}
{offset
- cKq: // global
- if ((Sp + -8) < SpLim) (likely: False) goto cKr; else goto cKs; // CmmCondBranch
- cKr: // global
+ 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
R1 = T24264.funPair_closure; // CmmAssign
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall
- cKs: // global
+ cOi: // global
+ goto cOa; // CmmBranch
+ cOa: // global
// slowCall
- I64[Sp - 8] = cKn; // CmmStore
- R1 = R2; // CmmAssign
- Sp = Sp - 8; // CmmAssign
- call stg_ap_0_fast(R1) returns to cKn, args: 8, res: 8, upd: 8; // CmmCall
- cKn: // global
- // slow_call for _sK3::P64 with pat stg_ap_0
+ 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
Hp = Hp + 24; // CmmAssign
- if (Hp > HpLim) (likely: False) goto cKv; else goto cKu; // CmmCondBranch
- cKv: // global
+ if (Hp > HpLim) (likely: False) goto cOl; else goto cOk; // CmmCondBranch
+ cOl: // global
HpAlloc = 24; // CmmAssign
- call stg_gc_unpt_r1(R1) returns to cKn, args: 8, res: 8, upd: 8; // CmmCall
- cKu: // global
+ 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
// allocHeapClosure
I64[Hp - 16] = (,)_con_info; // CmmStore
- P64[Hp - 8] = R1; // CmmStore
- P64[Hp] = R1; // CmmStore
- R1 = Hp - 15; // CmmAssign
- Sp = Sp + 8; // CmmAssign
- call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall
+ P64[Hp - 8] = _sNL::P64; // CmmStore
+ P64[Hp] = _sNL::P64; // CmmStore
+ _cOf::P64 = Hp - 15; // CmmAssign
+ R1 = _cOf::P64; // CmmAssign
+ call (P64[(old + 8)])(R1) args: 8, res: 0, upd: 8; // CmmCall
}
- },
- section ""data" . T24264.funPair_closure" {
- T24264.funPair_closure:
- const T24264.funPair_info;
}]
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -131,4 +131,4 @@ test('T23002', normal, compile, ['-fregs-graph'])
test('T24264', [req_cmm, when(unregisterised(), expect_broken(0)),
# (after this passes full CI, create a real ticket to reference)
grep_errmsg(r'(.*\().*(\) returns to)', [1,2])],
- compile, ['-O -ddump-cmm -dno-typeable-binds'])
+ compile, ['-O -ddump-cmm-from-stg -dno-typeable-binds'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5ca0b77480bd6940f553c56d3a19216c809a5de
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5ca0b77480bd6940f553c56d3a19216c809a5de
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/5b0d81da/attachment-0001.html>
More information about the ghc-commits
mailing list