Commit 85daac59 authored by Simon Marlow's avatar Simon Marlow

Fix cost-centre-stack bug when creating new PAP (#5654)

See comment in `AutoApply.h`.  This partly fixes #5654.  New test
added, and renamed the old test to match the ticket number.
parent 5dcae88b
...@@ -37,6 +37,17 @@ ...@@ -37,6 +37,17 @@
Sp_adj(1 + n); \ Sp_adj(1 + n); \
jump %ENTRY_CODE(Sp(0)) [R1]; jump %ENTRY_CODE(Sp(0)) [R1];
// Just like when we enter a PAP, if we're building a new PAP by applying more
// arguments to an existing PAP, we must construct the CCS for the new PAP as if
// we had entered the existing PAP from the current CCS. Otherwise, we lose any
// stack information in the existing PAP. See #5654, and the test T5654b-O0.
#ifdef PROFILING
#define ENTER_FUN_CCS_NEW_PAP(pap) \
ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(pap) "ptr");
#else
#define ENTER_FUN_CCS_NEW_PAP(pap) /* empty */
#endif
// Copy the old PAP, build a new one with the extra arg(s) // Copy the old PAP, build a new one with the extra arg(s)
// ret addr and m arguments taking up n words are on the stack. // ret addr and m arguments taking up n words are on the stack.
// NB. x is a dummy argument attached to the 'for' label so that // NB. x is a dummy argument attached to the 'for' label so that
...@@ -51,6 +62,7 @@ ...@@ -51,6 +62,7 @@
HP_CHK_NP_ASSIGN_SP0(size,f); \ HP_CHK_NP_ASSIGN_SP0(size,f); \
TICK_ALLOC_PAP(size, 0); \ TICK_ALLOC_PAP(size, 0); \
CCCS_ALLOC(size); \ CCCS_ALLOC(size); \
ENTER_FUN_CCS_NEW_PAP(pap); \
new_pap = Hp + WDS(1) - size; \ new_pap = Hp + WDS(1) - size; \
SET_HDR(new_pap, stg_PAP_info, CCCS); \ SET_HDR(new_pap, stg_PAP_info, CCCS); \
StgPAP_arity(new_pap) = HALF_W_(arity - m); \ StgPAP_arity(new_pap) = HALF_W_(arity - m); \
......
-- Tests for a bug in the handling of cost-centre stacks in the
-- runtime, where we lose the current cost-centre stack when
-- evaluating a function.
{-# NOINLINE f #-}
f :: Int -> Int
f = g -- here we should remember the stack under which g was evaluated
{-# NOINLINE g #-}
g :: Int -> Int
g x = x + 1
main = return $! f 3
Wed Jan 27 08:16 2016 Time and Allocation Profiling Report (Final)
T5654b-O0 +RTS -p -RTS
total time = 0.00 secs (0 ticks @ 1000 us, 1 processor)
total alloc = 39,248 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
CAF GHC.IO.Handle.FD 0.0 88.0
CAF GHC.IO.Encoding 0.0 7.3
CAF GHC.Conc.Signal 0.0 1.7
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 105 0 0.0 0.9 0.0 100.0
CAF Main 209 0 0.0 0.9 0.0 1.5
g Main 212 1 0.0 0.1 0.0 0.1
f Main 211 1 0.0 0.1 0.0 0.1
main Main 210 1 0.0 0.2 0.0 0.4
f Main 214 0 0.0 0.0 0.0 0.2
g Main 215 0 0.0 0.0 0.0 0.2
h Main 216 1 0.0 0.2 0.0 0.2
CAF GHC.Conc.Signal 203 0 0.0 1.7 0.0 1.7
CAF GHC.IO.Encoding 193 0 0.0 7.3 0.0 7.3
CAF GHC.IO.Encoding.Iconv 191 0 0.0 0.6 0.0 0.6
CAF GHC.IO.Handle.FD 183 0 0.0 88.0 0.0 88.0
Wed Jan 27 08:16 2016 Time and Allocation Profiling Report (Final)
T5654b-O1 +RTS -p -RTS
total time = 0.00 secs (0 ticks @ 1000 us, 1 processor)
total alloc = 39,016 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
MAIN MAIN 0.0 1.7
CAF GHC.IO.Handle.FD 0.0 88.5
CAF GHC.IO.Encoding 0.0 7.4
CAF GHC.Conc.Signal 0.0 1.7
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 105 0 0.0 1.7 0.0 100.0
CAF Main 209 0 0.0 0.0 0.0 0.1
main Main 210 1 0.0 0.1 0.0 0.1
f Main 211 1 0.0 0.0 0.0 0.0
g Main 212 1 0.0 0.0 0.0 0.0
h Main 213 1 0.0 0.0 0.0 0.0
CAF GHC.Conc.Signal 203 0 0.0 1.7 0.0 1.7
CAF GHC.IO.Encoding 193 0 0.0 7.4 0.0 7.4
CAF GHC.IO.Encoding.Iconv 191 0 0.0 0.6 0.0 0.6
CAF GHC.IO.Handle.FD 183 0 0.0 88.5 0.0 88.5
-- A variant of T5654 where instead of evaluating directly to a
-- funciton, f evaluates to a new PAP. This exposes a slightly
-- different but related bug, where when we create a new PAP by
-- applying arguments to an existing PAP, we should take into account
-- the stack on the original PAP.
-- The stack we should see is main->f->g->h, but if we get this wrong
-- (GHC 7.10) then the stack is main->f->h.
{-# NOINLINE f #-}
f :: Int -> Int
f = g 3
{-# NOINLINE g #-}
g :: Int -> Int -> Int
g = h 4
{-# NOINLINE h #-}
h :: Int -> Int -> Int -> Int
h x y z = x + y + z
main = return $! f 5
...@@ -47,12 +47,22 @@ test('scc003', [req_profiling, ...@@ -47,12 +47,22 @@ test('scc003', [req_profiling,
compile_and_run, compile_and_run,
['-fno-state-hack']) # Note [consistent stacks] ['-fno-state-hack']) # Note [consistent stacks]
test('scc004', [req_profiling, test('T5654', [req_profiling,
extra_ways(['prof']), only_ways(prof_ways), extra_ways(['prof']), only_ways(prof_ways),
expect_broken(5654)], expect_broken(5654)],
compile_and_run, compile_and_run,
['']) [''])
test('T5654b-O0', [req_profiling,
extra_ways(['prof']), only_ways(['prof'])],
compile_and_run,
[''])
test('T5654b-O1', [req_profiling,
only_ways(['profasm'])],
compile_and_run,
[''])
test('scc005', [req_profiling, test('scc005', [req_profiling,
extra_ways(['prof']), only_ways(prof_ways)], extra_ways(['prof']), only_ways(prof_ways)],
compile_and_run, compile_and_run,
......
{-# NOINLINE f #-}
f :: Int -> Int
f = {-# SCC f #-} g
{-# NOINLINE g #-}
g :: Int -> Int
g x = {-# SCC g #-} x + 1
main = {-# SCC main #-} return $! f 3
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment