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; } } } }
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); }