static void get_callstack(value* sp, intnat trap_spoff,
                          struct stack_info* stack,
                          intnat max_frames,
                          code_t** trace, intnat* trace_size)
{
  CAMLnoalloc;
  struct stack_info* parent = Stack_parent(stack);
  value *stack_high = Stack_high(stack);
  value* saved_sp = sp;
  intnat saved_trap_spoff = trap_spoff;

  /* first compute the size of the trace */
  {
    *trace_size = 0;
    while (*trace_size < max_frames) {
      code_t p = caml_next_frame_pointer(stack_high, &sp, &trap_spoff);
      if (p == NULL) {
        if (parent == NULL) break;
        sp = parent->sp;
        trap_spoff = Long_val(sp[0]);
        stack_high = Stack_high(parent);
        parent = Stack_parent(parent);
      } else {
        ++*trace_size;
      }
    }
  }

  *trace = caml_stat_alloc(sizeof(code_t*) * *trace_size);

  sp = saved_sp;
  parent = Stack_parent(stack);
  stack_high = Stack_high(stack);
  trap_spoff = saved_trap_spoff;

  /* then collect the trace */
  {
    uintnat trace_pos = 0;

    while (trace_pos < *trace_size) {
      code_t p = caml_next_frame_pointer(stack_high, &sp, &trap_spoff);
      if (p == NULL) {
        sp = parent->sp;
        trap_spoff = Long_val(sp[0]);
        stack_high = Stack_high(parent);
        parent = Stack_parent(parent);
      } else {
        (*trace)[trace_pos] = p;
        ++trace_pos;
      }
    }
  }
}
Example #2
0
CAMLprim value caml_get_current_callstack(value max_frames_value) {
  CAMLparam1(max_frames_value);
  CAMLlocal1(trace);

  /* we use `intnat` here because, were it only `int`, passing `max_int`
     from the OCaml side would overflow on 64bits machines. */
  intnat max_frames = Long_val(max_frames_value);
  intnat trace_size;

  /* first compute the size of the trace */
  {
    value * sp = caml_extern_sp;
    intnat trap_spoff = caml_trap_sp_off;

    for (trace_size = 0; trace_size < max_frames; trace_size++) {
      code_t p = caml_next_frame_pointer(&sp, &trap_spoff);
      if (p == NULL) break;
    }
  }

  trace = caml_alloc(trace_size, 0);

  /* then collect the trace */
  {
    value * sp = caml_extern_sp;
    intnat trap_spoff = caml_trap_sp_off;
    uintnat trace_pos;

    for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
      code_t p = caml_next_frame_pointer(&sp, &trap_spoff);
      Assert(p != NULL);
      Field(trace, trace_pos) = Val_Codet(p);
    }
  }

  CAMLreturn(trace);
}