377 lines
11 KiB
C
377 lines
11 KiB
C
/**************************************************************************/
|
|
/* */
|
|
/* OCaml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 2000 Institut National de Recherche en Informatique et */
|
|
/* en Automatique. */
|
|
/* */
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
/* special exception on linking described in the file LICENSE. */
|
|
/* */
|
|
/**************************************************************************/
|
|
|
|
#define CAML_INTERNALS
|
|
|
|
/* Stack backtrace for uncaught exceptions */
|
|
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
|
|
#include "caml/alloc.h"
|
|
#include "caml/memory.h"
|
|
#include "caml/backtrace.h"
|
|
#include "caml/backtrace_prim.h"
|
|
#include "caml/fail.h"
|
|
#include "caml/debugger.h"
|
|
#include "caml/startup.h"
|
|
|
|
void caml_init_backtrace(void)
|
|
{
|
|
caml_register_global_root(&Caml_state->backtrace_last_exn);
|
|
}
|
|
|
|
/* Start or stop the backtrace machinery */
|
|
CAMLprim value caml_record_backtrace(value vflag)
|
|
{
|
|
int flag = Int_val(vflag);
|
|
|
|
if (flag != Caml_state->backtrace_active) {
|
|
Caml_state->backtrace_active = flag;
|
|
Caml_state->backtrace_pos = 0;
|
|
Caml_state->backtrace_last_exn = Val_unit;
|
|
/* Note: We do lazy initialization of Caml_state->backtrace_buffer when
|
|
needed in order to simplify the interface with the thread
|
|
library (thread creation doesn't need to allocate
|
|
Caml_state->backtrace_buffer). So we don't have to allocate it here.
|
|
*/
|
|
}
|
|
return Val_unit;
|
|
}
|
|
|
|
/* Return the status of the backtrace machinery */
|
|
CAMLprim value caml_backtrace_status(value vunit)
|
|
{
|
|
return Val_bool(Caml_state->backtrace_active);
|
|
}
|
|
|
|
/* Print location information -- same behavior as in Printexc
|
|
|
|
note that the test for compiler-inserted raises is slightly redundant:
|
|
(!li->loc_valid && li->loc_is_raise)
|
|
caml_debuginfo_location guarantees that when li->loc_valid is
|
|
0, then li->loc_is_raise is always 1, so the latter test is
|
|
useless. We kept it to keep code identical to the runtime/
|
|
implementation. */
|
|
static void print_location(struct caml_loc_info * li, int index)
|
|
{
|
|
char * info;
|
|
char * inlined;
|
|
|
|
/* Ignore compiler-inserted raise */
|
|
if (!li->loc_valid && li->loc_is_raise) return;
|
|
|
|
if (li->loc_is_raise) {
|
|
/* Initial raise if index == 0, re-raise otherwise */
|
|
if (index == 0)
|
|
info = "Raised at";
|
|
else
|
|
info = "Re-raised at";
|
|
} else {
|
|
if (index == 0)
|
|
info = "Raised by primitive operation at";
|
|
else
|
|
info = "Called from";
|
|
}
|
|
if (li->loc_is_inlined) {
|
|
inlined = " (inlined)";
|
|
} else {
|
|
inlined = "";
|
|
}
|
|
if (! li->loc_valid) {
|
|
fprintf(stderr, "%s unknown location%s\n", info, inlined);
|
|
} else {
|
|
fprintf (stderr, "%s %s in file \"%s\"%s, line %d, characters %d-%d\n",
|
|
info, li->loc_defname, li->loc_filename, inlined, li->loc_lnum,
|
|
li->loc_startchr, li->loc_endchr);
|
|
}
|
|
}
|
|
|
|
/* Print a backtrace */
|
|
CAMLexport void caml_print_exception_backtrace(void)
|
|
{
|
|
int i;
|
|
struct caml_loc_info li;
|
|
debuginfo dbg;
|
|
|
|
if (!caml_debug_info_available()) {
|
|
fprintf(stderr, "(Cannot print stack backtrace: "
|
|
"no debug information available)\n");
|
|
return;
|
|
}
|
|
|
|
for (i = 0; i < Caml_state->backtrace_pos; i++) {
|
|
for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]);
|
|
dbg != NULL;
|
|
dbg = caml_debuginfo_next(dbg))
|
|
{
|
|
caml_debuginfo_location(dbg, &li);
|
|
print_location(&li, i);
|
|
}
|
|
}
|
|
|
|
/* See also printexc.ml */
|
|
switch (caml_debug_info_status()) {
|
|
case FILE_NOT_FOUND:
|
|
fprintf(stderr,
|
|
"(Cannot print locations:\n "
|
|
"bytecode executable program file not found)\n");
|
|
break;
|
|
case BAD_BYTECODE:
|
|
fprintf(stderr,
|
|
"(Cannot print locations:\n "
|
|
"bytecode executable program file appears to be corrupt)\n");
|
|
break;
|
|
case WRONG_MAGIC:
|
|
fprintf(stderr,
|
|
"(Cannot print locations:\n "
|
|
"bytecode executable program file has wrong magic number)\n");
|
|
break;
|
|
case NO_FDS:
|
|
fprintf(stderr,
|
|
"(Cannot print locations:\n "
|
|
"bytecode executable program file cannot be opened;\n "
|
|
"-- too many open files. Try running with OCAMLRUNPARAM=b=2)\n");
|
|
break;
|
|
}
|
|
}
|
|
|
|
/* Return the status of loading backtrace information (error reporting in
|
|
bytecode) */
|
|
CAMLprim value caml_ml_debug_info_status(value unit)
|
|
{
|
|
return Val_int(caml_debug_info_status());
|
|
}
|
|
|
|
/* Get a copy of the latest backtrace */
|
|
CAMLprim value caml_get_exception_raw_backtrace(value unit)
|
|
{
|
|
CAMLparam0();
|
|
CAMLlocal1(res);
|
|
|
|
if (!Caml_state->backtrace_active ||
|
|
Caml_state->backtrace_buffer == NULL ||
|
|
Caml_state->backtrace_pos == 0) {
|
|
res = caml_alloc(0, 0);
|
|
}
|
|
else {
|
|
intnat i, len = Caml_state->backtrace_pos;
|
|
|
|
res = caml_alloc(len, 0);
|
|
for (i = 0; i < len; i++)
|
|
Field(res, i) = Val_backtrace_slot(Caml_state->backtrace_buffer[i]);
|
|
}
|
|
|
|
CAMLreturn(res);
|
|
}
|
|
|
|
/* Copy back a backtrace and exception to the global state.
|
|
This function should be used only with Printexc.raw_backtrace */
|
|
/* noalloc (caml value): so no CAMLparam* CAMLreturn* */
|
|
CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
|
|
{
|
|
intnat i;
|
|
mlsize_t bt_size;
|
|
|
|
Caml_state->backtrace_last_exn = exn;
|
|
|
|
bt_size = Wosize_val(backtrace);
|
|
if(bt_size > BACKTRACE_BUFFER_SIZE){
|
|
bt_size = BACKTRACE_BUFFER_SIZE;
|
|
}
|
|
|
|
/* We don't allocate if the backtrace is empty (no -g or backtrace
|
|
not activated) */
|
|
if(bt_size == 0){
|
|
Caml_state->backtrace_pos = 0;
|
|
return Val_unit;
|
|
}
|
|
|
|
/* Allocate if needed and copy the backtrace buffer */
|
|
if (Caml_state->backtrace_buffer == NULL &&
|
|
caml_alloc_backtrace_buffer() == -1) {
|
|
return Val_unit;
|
|
}
|
|
|
|
Caml_state->backtrace_pos = bt_size;
|
|
for(i=0; i < Caml_state->backtrace_pos; i++){
|
|
Caml_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
|
|
}
|
|
|
|
return Val_unit;
|
|
}
|
|
|
|
#define Val_debuginfo(bslot) (Val_long((uintnat)(bslot)>>1))
|
|
#define Debuginfo_val(vslot) ((debuginfo)(Long_val(vslot) << 1))
|
|
|
|
/* Convert the raw backtrace to a data structure usable from OCaml */
|
|
static value caml_convert_debuginfo(debuginfo dbg)
|
|
{
|
|
CAMLparam0();
|
|
CAMLlocal3(p, fname, dname);
|
|
struct caml_loc_info li;
|
|
|
|
caml_debuginfo_location(dbg, &li);
|
|
|
|
if (li.loc_valid) {
|
|
fname = caml_copy_string(li.loc_filename);
|
|
dname = caml_copy_string(li.loc_defname);
|
|
p = caml_alloc_small(7, 0);
|
|
Field(p, 0) = Val_bool(li.loc_is_raise);
|
|
Field(p, 1) = fname;
|
|
Field(p, 2) = Val_int(li.loc_lnum);
|
|
Field(p, 3) = Val_int(li.loc_startchr);
|
|
Field(p, 4) = Val_int(li.loc_endchr);
|
|
Field(p, 5) = Val_bool(li.loc_is_inlined);
|
|
Field(p, 6) = dname;
|
|
} else {
|
|
p = caml_alloc_small(1, 1);
|
|
Field(p, 0) = Val_bool(li.loc_is_raise);
|
|
}
|
|
|
|
CAMLreturn(p);
|
|
}
|
|
|
|
CAMLprim value caml_convert_raw_backtrace_slot(value slot)
|
|
{
|
|
if (!caml_debug_info_available())
|
|
caml_failwith("No debug information available");
|
|
|
|
return (caml_convert_debuginfo(Debuginfo_val(slot)));
|
|
}
|
|
|
|
/* Convert the raw backtrace to a data structure usable from OCaml */
|
|
CAMLprim value caml_convert_raw_backtrace(value bt)
|
|
{
|
|
CAMLparam1(bt);
|
|
CAMLlocal1(array);
|
|
intnat i, index;
|
|
|
|
if (!caml_debug_info_available())
|
|
caml_failwith("No debug information available");
|
|
|
|
for (i = 0, index = 0; i < Wosize_val(bt); ++i)
|
|
{
|
|
debuginfo dbg;
|
|
for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
|
|
dbg != NULL;
|
|
dbg = caml_debuginfo_next(dbg))
|
|
index++;
|
|
}
|
|
|
|
array = caml_alloc(index, 0);
|
|
|
|
for (i = 0, index = 0; i < Wosize_val(bt); ++i)
|
|
{
|
|
debuginfo dbg;
|
|
for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
|
|
dbg != NULL;
|
|
dbg = caml_debuginfo_next(dbg))
|
|
{
|
|
Store_field(array, index, caml_convert_debuginfo(dbg));
|
|
index++;
|
|
}
|
|
}
|
|
|
|
CAMLreturn(array);
|
|
}
|
|
|
|
CAMLprim value caml_raw_backtrace_length(value bt)
|
|
{
|
|
return Val_int(Wosize_val(bt));
|
|
}
|
|
|
|
CAMLprim value caml_raw_backtrace_slot(value bt, value index)
|
|
{
|
|
uintnat i;
|
|
debuginfo dbg;
|
|
|
|
i = Long_val(index);
|
|
if (i >= Wosize_val(bt))
|
|
caml_invalid_argument("Printexc.get_raw_backtrace_slot: "
|
|
"index out of bounds");
|
|
dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
|
|
return Val_debuginfo(dbg);
|
|
}
|
|
|
|
CAMLprim value caml_raw_backtrace_next_slot(value slot)
|
|
{
|
|
debuginfo dbg;
|
|
|
|
CAMLparam1(slot);
|
|
CAMLlocal1(v);
|
|
|
|
dbg = Debuginfo_val(slot);
|
|
dbg = caml_debuginfo_next(dbg);
|
|
|
|
if (dbg == NULL)
|
|
v = Val_int(0); /* None */
|
|
else
|
|
{
|
|
v = caml_alloc(1, 0);
|
|
Field(v, 0) = Val_debuginfo(dbg);
|
|
}
|
|
|
|
CAMLreturn(v);
|
|
}
|
|
|
|
/* the function below is deprecated: we previously returned directly
|
|
the OCaml-usable representation, instead of the raw backtrace as an
|
|
abstract type, but this has a large performance overhead if you
|
|
store a lot of backtraces and print only some of them.
|
|
|
|
It is not used by the Printexc library anymore, or anywhere else in
|
|
the compiler, but we have kept it in case some user still depends
|
|
on it as an external. */
|
|
CAMLprim value caml_get_exception_backtrace(value unit)
|
|
{
|
|
CAMLparam0();
|
|
CAMLlocal3(arr, res, backtrace);
|
|
intnat i;
|
|
|
|
if (!caml_debug_info_available()) {
|
|
res = Val_int(0); /* None */
|
|
} else {
|
|
backtrace = caml_get_exception_raw_backtrace(Val_unit);
|
|
|
|
arr = caml_alloc(Wosize_val(backtrace), 0);
|
|
for (i = 0; i < Wosize_val(backtrace); i++) {
|
|
backtrace_slot slot = Backtrace_slot_val(Field(backtrace, i));
|
|
debuginfo dbg = caml_debuginfo_extract(slot);
|
|
Store_field(arr, i, caml_convert_debuginfo(dbg));
|
|
}
|
|
|
|
res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
|
|
}
|
|
|
|
CAMLreturn(res);
|
|
}
|
|
|
|
CAMLprim value caml_get_current_callstack(value max_frames_value)
|
|
{
|
|
CAMLparam1(max_frames_value);
|
|
CAMLlocal1(res);
|
|
value* callstack = NULL;
|
|
intnat callstack_alloc_len = 0;
|
|
intnat callstack_len =
|
|
caml_collect_current_callstack(&callstack, &callstack_alloc_len,
|
|
Long_val(max_frames_value), -1);
|
|
res = caml_alloc(callstack_len, 0);
|
|
memcpy(Op_val(res), callstack, sizeof(value) * callstack_len);
|
|
caml_stat_free(callstack);
|
|
CAMLreturn(res);
|
|
}
|