rts/CloneStack.c

   1 /* ---------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 2020-2021
   4  *
   5  * Stack snapshotting and decoding. (Cloning and unwinding.)
   6  *
   7  *---------------------------------------------------------------------------*/
   8
   9 #include "Rts.h"
  10 #include "RtsFlags.h"
  11 #include "rts/Messages.h"
  12 #include "Messages.h"
  13 #include "rts/Types.h"
  14 #include "rts/storage/TSO.h"
  15 #include "stg/Types.h"
  16 #include "CloneStack.h"
  17 #include "StablePtr.h"
  18 #include "Threads.h"
  19 #include "Prelude.h"
  20
  21 #if defined(DEBUG)
  22 #include "sm/Sanity.h"
  23 #include "Printer.h"
  24 #endif
  25
  26 #include <string.h>
  27
  28
  29 static StgWord getStackFrameCount(StgStack* stack);
  30 static StgWord getStackChunkClosureCount(StgStack* stack);
  31 static StgArrBytes* allocateByteArray(Capability *cap, StgWord bytes);
  32 static void copyPtrsToArray(StgArrBytes* arr, StgStack* stack);
  33
  34 static StgStack* cloneStackChunk(Capability* capability, const StgStack* stack)
  35 {
  36   StgWord spOffset = stack->sp - stack->stack;
  37   StgWord closureSizeBytes = sizeof(StgStack) + (stack->stack_size * sizeof(StgWord));
  38
  39   StgStack* newStackClosure = (StgStack*) allocate(capability, ROUNDUP_BYTES_TO_WDS(closureSizeBytes));
  40
  41   memcpy(newStackClosure, stack, closureSizeBytes);
  42
  43   newStackClosure->sp = newStackClosure->stack + spOffset;
  44   // The new stack is not on the mutable list; clear the dirty flag such that
  45   // we don't claim that it is.
  46   newStackClosure->dirty = 0;
  47
  48 #if defined(DEBUG)
  49   checkClosure((StgClosure*) newStackClosure);
  50 #endif
  51
  52   return newStackClosure;
  53 }
  54
  55 StgStack* cloneStack(Capability* capability, const StgStack* stack)
  56 {
  57   StgStack *top_stack = cloneStackChunk(capability, stack);
  58   StgStack *last_stack = top_stack;
  59   while (true) {
  60     // check whether the stack ends in an underflow frame
  61     StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
  62       + last_stack->stack_size - sizeofW(StgUnderflowFrame));
  63     if (frame->info == &stg_stack_underflow_frame_d_info
  64       ||frame->info == &stg_stack_underflow_frame_v16_info
  65       ||frame->info == &stg_stack_underflow_frame_v32_info
  66       ||frame->info == &stg_stack_underflow_frame_v64_info) {
  67       StgStack *s = cloneStackChunk(capability, frame->next_chunk);
  68       frame->next_chunk = s;
  69       last_stack = s;
  70     } else {
  71       break;
  72     }
  73   }
  74   return top_stack;
  75 }
  76
  77 #if defined(THREADED_RTS)
  78
  79 // ThreadId# in Haskell is a StgTSO* in RTS.
  80 void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) {
  81   Capability *srcCapability = rts_unsafeGetMyCapability();
  82
  83   MessageCloneStack *msg;
  84   msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack));
  85   msg->tso = tso;
  86   msg->result = (StgMVar*)deRefStablePtr(mvar);
  87   SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM);
  88
  89   sendMessage(srcCapability, tso->cap, (Message *)msg);
  90 }
  91
  92 void handleCloneStackMessage(MessageCloneStack *msg){
  93   StgStack* newStackClosure = cloneStack(msg->tso->cap, msg->tso->stackobj);
  94
  95   // Lift StackSnapshot# to StackSnapshot by applying it's constructor.
  96   // This is necessary because performTryPutMVar() puts the closure onto the
  97   // stack for evaluation and stacks can not be evaluated (entered).
  98   HaskellObj result = rts_apply(msg->tso->cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure);
  99
 100   bool putMVarWasSuccessful = performTryPutMVar(msg->tso->cap, msg->result, result);
 101
 102   if(!putMVarWasSuccessful) {
 103     barf("Can't put stack cloning result into MVar.");
 104   }
 105 }
 106
 107 #else // !defined(THREADED_RTS)
 108
 109 STG_NORETURN
 110 void sendCloneStackMessage(StgTSO *tso STG_UNUSED, HsStablePtr mvar STG_UNUSED) {
 111   barf("Sending CloneStackMessages is only available in threaded RTS!");
 112 }
 113
 114 #endif // end !defined(THREADED_RTS)
 115
 116 // Creates a MutableArray# (Haskell representation) that contains a
 117 // InfoProvEnt* for every stack frame on the given stack. Thus, the size of the
 118 // array is the count of stack frames.
 119 // Each InfoProvEnt* is looked up by lookupIPE(). If there's no IPE for a stack
 120 // frame it's represented by null.
 121 StgArrBytes* decodeClonedStack(Capability *cap, StgStack* stack) {
 122   StgWord closureCount = getStackFrameCount(stack);
 123
 124   StgArrBytes* array = allocateByteArray(cap, sizeof(StgInfoTable*) * closureCount);
 125
 126   copyPtrsToArray(array, stack);
 127
 128   return array;
 129 }
 130
 131 // Count the stack frames that are on the given stack.
 132 // This is the sum of all stack frames in all stack chunks of this stack.
 133 StgWord getStackFrameCount(StgStack* stack) {
 134   StgWord closureCount = 0;
 135   StgStack *last_stack = stack;
 136   while (true) {
 137     closureCount += getStackChunkClosureCount(last_stack);
 138
 139     // check whether the stack ends in an underflow frame
 140     StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
 141       + last_stack->stack_size - sizeofW(StgUnderflowFrame));
 142     if (frame->info == &stg_stack_underflow_frame_d_info
 143       ||frame->info == &stg_stack_underflow_frame_v16_info
 144       ||frame->info == &stg_stack_underflow_frame_v32_info
 145       ||frame->info == &stg_stack_underflow_frame_v64_info) {
 146       last_stack = frame->next_chunk;
 147     } else {
 148       break;
 149     }
 150   }
 151   return closureCount;
 152 }
 153
 154 StgWord getStackChunkClosureCount(StgStack* stack) {
 155     StgWord closureCount = 0;
 156     StgPtr sp = stack->sp;
 157     StgPtr spBottom = stack->stack + stack->stack_size;
 158     for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
 159       closureCount++;
 160     }
 161
 162     return closureCount;
 163 }
 164
 165 // Allocate and initialize memory for a ByteArray# (Haskell representation).
 166 StgArrBytes* allocateByteArray(Capability *cap, StgWord bytes) {
 167   // Idea stolen from PrimOps.cmm:stg_newArrayzh()
 168   StgWord words = sizeofW(StgArrBytes) + bytes;
 169
 170   StgArrBytes* array = (StgArrBytes*) allocate(cap, words);
 171
 172   SET_HDR(array, &stg_ARR_WORDS_info, CCS_SYSTEM);
 173   array->bytes  = bytes;
 174   return array;
 175 }
 176
 177 static void copyPtrsToArray(StgArrBytes* arr, StgStack* stack) {
 178   StgWord index = 0;
 179   StgStack *last_stack = stack;
 180   const StgInfoTable **result = (const StgInfoTable **) arr->payload;
 181   while (true) {
 182     StgPtr sp = last_stack->sp;
 183     StgPtr spBottom = last_stack->stack + last_stack->stack_size;
 184     for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
 185       const StgInfoTable* infoTable = ((StgClosure *)sp)->header.info;
 186       result[index] = infoTable;
 187       index++;
 188     }
 189
 190     // Ensure that we didn't overflow the result array
 191     ASSERT(index-1 < arr->bytes / sizeof(StgInfoTable*));
 192
 193     // check whether the stack ends in an underflow frame
 194     StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
 195       + last_stack->stack_size - sizeofW(StgUnderflowFrame));
 196     if (frame->info == &stg_stack_underflow_frame_d_info
 197       ||frame->info == &stg_stack_underflow_frame_v16_info
 198       ||frame->info == &stg_stack_underflow_frame_v32_info
 199       ||frame->info == &stg_stack_underflow_frame_v64_info) {
 200       last_stack = frame->next_chunk;
 201     } else {
 202       break;
 203     }
 204   }
 205 }