Use Info Table Provenances to decode cloned stack (#18163)wip/stack-unwinding

Emit an Info Table Provenance Entry (IPE) for every stack represeted info table
if -finfo-table-map is turned on.

To decode a cloned stack, lookupIPE() is used. It provides a mapping between
info tables and their source location.

Please see these notes for details:

- [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
- [Mapping Info Tables to Source Positions]

Metric Increase:
    T12545

7 files changed, 137 insertions, 24 deletions

diff --git a/rts/CloneStack.c b/rts/CloneStack.c
index a8e826eec1..d9f5fd8725 100644
--- a/rts/CloneStack.c
+++ b/rts/CloneStack.c
@@ -1,23 +1,27 @@
 /* ---------------------------------------------------------------------------
  *
- * (c) The GHC Team, 2001-2021
+ * (c) The GHC Team, 2020-2021
  *
- * Stack snapshotting.
- */
+ * Stack snapshotting and decoding. (Cloning and unwinding.)
+ *
+ *---------------------------------------------------------------------------*/
 
 #include <string.h>
 
 #include "Rts.h"
 #include "rts/Messages.h"
 #include "Messages.h"
+#include "rts/Types.h"
 #include "rts/storage/TSO.h"
 #include "stg/Types.h"
 #include "CloneStack.h"
 #include "StablePtr.h"
 #include "Threads.h"
+#include "Prelude.h"
 
 #if defined(DEBUG)
 #include "sm/Sanity.h"
+#include "Printer.h"
 #endif
 
 static StgStack* cloneStackChunk(Capability* capability, const StgStack* stack)
@@ -47,9 +51,8 @@ StgStack* cloneStack(Capability* capability, const StgStack* stack)
   StgStack *last_stack = top_stack;
   while (true) {
     // check whether the stack ends in an underflow frame
-    StgPtr top = last_stack->stack + last_stack->stack_size;
-    StgUnderflowFrame *underFlowFrame = ((StgUnderflowFrame *) top);
-    StgUnderflowFrame *frame = underFlowFrame--;
+    StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
+      + last_stack->stack_size - sizeofW(StgUnderflowFrame));
     if (frame->info == &stg_stack_underflow_frame_info) {
       StgStack *s = cloneStackChunk(capability, frame->next_chunk);
       frame->next_chunk = s;
@@ -101,3 +104,115 @@ void sendCloneStackMessage(StgTSO *tso STG_UNUSED, HsStablePtr mvar STG_UNUSED)
 }
 
 #endif // end !defined(THREADED_RTS)
+
+// Creates a MutableArray# (Haskell representation) that contains a
+// InfoProvEnt* for every stack frame on the given stack. Thus, the size of the
+// array is the count of stack frames.
+// Each InfoProvEnt* is looked up by lookupIPE(). If there's no IPE for a stack
+// frame it's represented by null.
+StgMutArrPtrs* decodeClonedStack(Capability *cap, StgStack* stack) {
+  StgWord closureCount = getStackFrameCount(stack);
+
+  StgMutArrPtrs* array = allocateMutableArray(closureCount);
+
+  copyPtrsToArray(cap, array, stack);
+
+  return array;
+}
+
+// Count the stack frames that are on the given stack.
+// This is the sum of all stack frames in all stack chunks of this stack.
+StgWord getStackFrameCount(StgStack* stack) {
+  StgWord closureCount = 0;
+  StgStack *last_stack = stack;
+  while (true) {
+    closureCount += getStackChunkClosureCount(last_stack);
+
+    // check whether the stack ends in an underflow frame
+    StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
+      + last_stack->stack_size - sizeofW(StgUnderflowFrame));
+    if (frame->info == &stg_stack_underflow_frame_info) {
+      last_stack = frame->next_chunk;
+    } else {
+      break;
+    }
+  }
+  return closureCount;
+}
+
+StgWord getStackChunkClosureCount(StgStack* stack) {
+    StgWord closureCount = 0;
+    StgPtr sp = stack->sp;
+    StgPtr spBottom = stack->stack + stack->stack_size;
+    for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
+      closureCount++;
+    }
+
+    return closureCount;
+}
+
+// Allocate and initialize memory for a MutableArray# (Haskell representation).
+StgMutArrPtrs* allocateMutableArray(StgWord closureCount) {
+  // Idea stolen from PrimOps.cmm:stg_newArrayzh()
+  StgWord size = closureCount + mutArrPtrsCardTableSize(closureCount);
+  StgWord words = sizeofW(StgMutArrPtrs) + size;
+
+  StgMutArrPtrs* array = (StgMutArrPtrs*) allocate(myTask()->cap, words);
+
+  SET_HDR(array, &stg_MUT_ARR_PTRS_DIRTY_info, CCS_SYSTEM);
+  array->ptrs  = closureCount;
+  array->size = size;
+
+  return array;
+}
+
+
+void copyPtrsToArray(Capability *cap, StgMutArrPtrs* arr, StgStack* stack) {
+  StgWord index = 0;
+  StgStack *last_stack = stack;
+  while (true) {
+    StgPtr sp = last_stack->sp;
+    StgPtr spBottom = last_stack->stack + last_stack->stack_size;
+    for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
+      const StgInfoTable* infoTable = get_itbl((StgClosure *)sp);
+
+      // Add the IPE that was looked up by lookupIPE() to the MutableArray#.
+      // The "Info Table Provernance Entry Map" (IPE) idea is to use a pointer
+      // (address) to the info table to lookup entries, this is fulfilled in
+      // non-"Tables Next to Code" builds.
+      // When "Tables Next to Code" is used, the assembly label of the info table
+      // is between the info table and it's code. There's no other label in the
+      // assembly code which could be used instead, thus lookupIPE() is actually
+      // called with the code pointer of the info table.
+      // (As long as it's used consistently, this doesn't really matter - IPE uses
+      // the pointer only to connect an info table to it's provenance entry in the
+      // IPE map.)
+#if defined(TABLES_NEXT_TO_CODE)
+      InfoProvEnt* ipe = lookupIPE((StgInfoTable*) infoTable->code);
+#else
+      InfoProvEnt* ipe = lookupIPE(infoTable);
+#endif
+      arr->payload[index] = createPtrClosure(cap, ipe);
+
+      index++;
+    }
+
+    // check whether the stack ends in an underflow frame
+    StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
+      + last_stack->stack_size - sizeofW(StgUnderflowFrame));
+    if (frame->info == &stg_stack_underflow_frame_info) {
+      last_stack = frame->next_chunk;
+    } else {
+      break;
+    }
+  }
+}
+
+// Create a GHC.Ptr (Haskell constructor: `Ptr InfoProvEnt`) pointing to the
+// IPE.
+StgClosure* createPtrClosure(Capability *cap, InfoProvEnt* ipe) {
+  StgClosure *p = (StgClosure *) allocate(cap, CONSTR_sizeW(0,1));
+  SET_HDR(p, &base_GHCziPtr_Ptr_con_info, CCS_SYSTEM);
+  p->payload[0] = (StgClosure*) ipe;
+  return TAG_CLOSURE(1, p);
+}
diff --git a/rts/CloneStack.h b/rts/CloneStack.h
index 5f1c22039d..7e43d090d1 100644
--- a/rts/CloneStack.h
+++ b/rts/CloneStack.h
@@ -1,9 +1,10 @@
 /* ---------------------------------------------------------------------------
  *
- * (c) The GHC Team, 2001-2021
+ * (c) The GHC Team, 2020-2021
  *
- * Stack snapshotting.
- */
+ * Stack snapshotting and decoding. (Cloning and unwinding.)
+ *
+ *---------------------------------------------------------------------------*/
 
 #pragma once
 
@@ -14,10 +15,18 @@ StgStack* cloneStack(Capability* capability, const StgStack* stack);
 
 void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar);
 
+StgMutArrPtrs* decodeClonedStack(Capability *cap, StgStack* stack);
+
 #include "BeginPrivate.h"
 
 #if defined(THREADED_RTS)
 void handleCloneStackMessage(MessageCloneStack *msg);
 #endif
 
+StgWord getStackFrameCount(StgStack* stack);
+StgWord getStackChunkClosureCount(StgStack* stack);
+void copyPtrsToArray(Capability *cap, StgMutArrPtrs* arr, StgStack* stack);
+StgClosure* createPtrClosure(Capability* cap, InfoProvEnt* ipe);
+StgMutArrPtrs* allocateMutableArray(StgWord size);
+
 #include "EndPrivate.h"
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 122bac4e08..8f99105b18 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2927,14 +2927,3 @@ stg_setThreadAllocationCounterzh ( I64 counter )
     StgTSO_alloc_limit(CurrentTSO) = counter + TO_I64(offset);
     return ();
 }
-
-stg_cloneMyStackzh () {
-    W_ stgStack;
-    W_ clonedStack;
-    stgStack = StgTSO_stackobj(CurrentTSO);
-    StgStack_sp(stgStack) = Sp;
-
-    ("ptr" clonedStack) = ccall cloneStack(MyCapability() "ptr", stgStack "ptr");
-
-    return (clonedStack);
-}
diff --git a/rts/Printer.c b/rts/Printer.c
index d2a5c67ca4..ef9394f24e 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -678,7 +678,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
     }
 }
 
-static void printStack( StgStack *stack )
+void printStack( StgStack *stack )
 {
     printStackChunk( stack->sp, stack->stack + stack->stack_size );
 }
diff --git a/rts/Printer.h b/rts/Printer.h
index 44c55de3d6..959b5f0256 100644
--- a/rts/Printer.h
+++ b/rts/Printer.h
@@ -22,6 +22,7 @@ const char  *      info_update_frame ( const StgClosure *closure );
 
 #if defined(DEBUG)
 extern void        printClosure    ( const StgClosure *obj );
+extern void        printStack ( StgStack *stack );
 extern void        printStackChunk ( StgPtr sp, StgPtr spLim );
 extern void        printTSO        ( StgTSO *tso );
 extern void        printMutableList( bdescr *bd );
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 56d94ee7d2..2782d3632f 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -989,7 +989,6 @@
       SymI_HasProto(stg_traceBinaryEventzh)                             \
       SymI_HasProto(stg_getThreadAllocationCounterzh)                   \
       SymI_HasProto(stg_setThreadAllocationCounterzh)                   \
-      SymI_HasProto(stg_cloneMyStackzh)                                 \
       SymI_HasProto(getMonotonicNSec)                                   \
       SymI_HasProto(lockFile)                                           \
       SymI_HasProto(unlockFile)                                         \
@@ -1015,6 +1014,8 @@
       SymI_HasProto(registerInfoProvList)                               \
       SymI_HasProto(lookupIPE)                                          \
       SymI_HasProto(sendCloneStackMessage)                              \
+      SymI_HasProto(cloneStack)                                         \
+      SymI_HasProto(decodeClonedStack)                                  \
       RTS_USER_SIGNALS_SYMBOLS                                          \
       RTS_INTCHAR_SYMBOLS
 
diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h
index 1eed441eae..8c6b863d0a 100644
--- a/rts/include/stg/MiscClosures.h
+++ b/rts/include/stg/MiscClosures.h
@@ -571,8 +571,6 @@ RTS_FUN_DECL(stg_traceBinaryEventzh);
 RTS_FUN_DECL(stg_traceMarkerzh);
 RTS_FUN_DECL(stg_getThreadAllocationCounterzh);
 RTS_FUN_DECL(stg_setThreadAllocationCounterzh);
-RTS_FUN_DECL(stg_cloneMyStackzh);
-
 
 /* Other misc stuff */
 // See wiki:commentary/compiler/backends/ppr-c#prototypes