Fix raiseAsync() UNDERFLOW_FRAME handling in profiling runtime

UNDERFLOW_FRAMEs don't have profiling headers so we have to use the
AP_STACK's function's CCS as the new frame's CCS.

Fixes one of the many bugs caught by concprog001 (#15508).

(cherry picked from commit 74cd4ec5d2f9321aad5db3285cb60d78f2562996)

2 files changed, 8 insertions, 8 deletions

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index b08acc4078..ddd6d39ffb 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -93,7 +93,7 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
    throwTo().
 
    Note [Throw to self when masked]
-   
+
    When a StackOverflow occurs when the thread is masked, we want to
    defer the exception to when the thread becomes unmasked/hits an
    interruptible point.  We already have a mechanism for doing this,
@@ -103,26 +103,26 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
    multithreaded nonsense). Morally, a stack overflow should be an
    asynchronous exception sent by a thread to itself, and it should
    have the same semantics.  But there are a few key differences:
-   
+
    - If you actually tried to send an asynchronous exception to
      yourself using throwTo, the exception would actually immediately
      be delivered.  This is because throwTo itself is considered an
      interruptible point, so the exception is always deliverable. Thus,
      ordinarily, we never end up with a message to oneself in the
      blocked_exceptions queue.
-   
+
    - In the case of a StackOverflow, we don't actually care about the
      wakeup semantics; when an exception is delivered, the thread that
      originally threw the exception should be woken up, since throwTo
      blocks until the exception is successfully thrown.  Fortunately,
      it is harmless to wakeup a thread that doesn't actually need waking
      up, e.g. ourselves.
-   
+
    - No synchronization is necessary, because we own the TSO and the
      capability.  You can observe this by tracing through the execution
      of throwTo.  We skip synchronizing the message and inter-capability
      communication.
-   
+
    We think this doesn't break any invariants, but do be careful!
    -------------------------------------------------------------------------- */
 
@@ -921,8 +921,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
                 ap->payload[i] = (StgClosure *)*sp++;
             }
 
-            SET_HDR(ap,&stg_AP_STACK_NOUPD_info,
-                    ((StgClosure *)frame)->header.prof.ccs /* ToDo */);
+            SET_HDR(ap,&stg_AP_STACK_NOUPD_info,stack->header.prof.ccs);
             TICK_ALLOC_SE_THK(WDS(words+1),0);
 
             stack->sp = sp;
diff --git a/testsuite/tests/concurrent/prog001/all.T b/testsuite/tests/concurrent/prog001/all.T
index 1476b4ffef..e3195833a0 100644
--- a/testsuite/tests/concurrent/prog001/all.T
+++ b/testsuite/tests/concurrent/prog001/all.T
@@ -13,5 +13,6 @@
 # right now. --SDM 1/4/2010
 
 test('concprog001', [extra_files(['Arithmetic.hs', 'Converter.hs', 'Mult.hs', 'Stream.hs', 'Thread.hs', 'Trit.hs', 'Utilities.hs']),
-                     when(fast(), skip), only_ways(['threaded2'])],
+                     when(fast(), skip), only_ways(['threaded2']),
+                     run_timeout_multiplier(2)],
      multimod_compile_and_run, ['Mult', ''])