CAMLexport char * caml_format_exception(value exn)
{
#ifndef NATIVE_CODE
if( bytecode_compatibility == Caml1999X008){
return Caml1999X008_caml_format_exception(exn);
} else
#endif
{
mlsize_t start, i;
value bucket, v;
struct stringbuf buf;
char intbuf[64];
char * res;
buf.ptr = buf.data;
buf.end = buf.data + sizeof(buf.data) - 1;
if (Tag_val(exn) == 0) {
add_string(&buf, String_val(Field(Field(exn, 0), 0)));
/* Check for exceptions in the style of Match_failure and Assert_failure */
if (Wosize_val(exn) == 2 &&
Is_block(Field(exn, 1)) &&
Tag_val(Field(exn, 1)) == 0 &&
caml_is_special_exception(Field(exn, 0))) {
bucket = Field(exn, 1);
start = 0;
} else {
bucket = exn;
start = 1;
}
add_char(&buf, '(');
for (i = start; i < Wosize_val(bucket); i++) {
if (i > start) add_string(&buf, ", ");
v = Field(bucket, i);
if (Is_long(v)) {
snprintf(intbuf, sizeof(intbuf),
"%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');
add_string(&buf, String_val(v));
add_char(&buf, '"');
} else {
add_char(&buf, '_');
}
}
add_char(&buf, ')');
} else
add_string(&buf, String_val(Field(exn, 0)));
*buf.ptr = 0; /* Terminate string */
i = buf.ptr - buf.data + 1;
res = malloc(i);
if (res == NULL) return NULL;
memmove(res, buf.data, i);
return res;
}
}
CAMLexport char * caml_format_exception(value exn)
{
mlsize_t start, i;
value bucket, v;
struct stringbuf buf;
char intbuf[64];
char * res;
buf.ptr = buf.data;
buf.end = buf.data + sizeof(buf.data) - 1;
add_string(&buf, String_val(Field(Field(exn, 0), 0)));
if (Wosize_val(exn) >= 2) {
/* Check for exceptions in the style of Match_failure and Assert_failure */
if (Wosize_val(exn) == 2 &&
Is_block(Field(exn, 1)) &&
Tag_val(Field(exn, 1)) == 0 &&
caml_is_special_exception(Field(exn, 0))) {
bucket = Field(exn, 1);
start = 0;
} else {
bucket = exn;
start = 1;
}
add_char(&buf, '(');
for (i = start; i < Wosize_val(bucket); i++) {
if (i > start) add_string(&buf, ", ");
v = Field(bucket, i);
if (Is_long(v)) {
sprintf(intbuf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');
add_string(&buf, String_val(v));
add_char(&buf, '"');
} else {
add_char(&buf, '_');
}
}
add_char(&buf, ')');
}
*buf.ptr = 0; /* Terminate string */
i = buf.ptr - buf.data + 1;
/* OCamlCC: fix g++ warning */
res = (char *) malloc(i);
if (res == NULL) return NULL;
memmove(res, buf.data, i);
return res;
}
CAMLexport char * caml_format_exception(value exn)
{
mlsize_t start, i;
struct stringbuf buf;
char intbuf[64];
char * res;
CAMLparam1(exn);
CAMLlocal4(bucket, v, exnclass, field1);
buf.ptr = buf.data;
buf.end = buf.data + sizeof(buf.data) - 1;
/* An exception class is a value with tag Object_tag, whose first
field is a string naming the exception.
Exceptions that take parameters (e.g. Invalid_argument) are blocks
with tag 0, where the first field is the exception class.
Exceptions without parameters (e.g. Not_found) are just the exception
class. */
if (Tag_val(exn) == 0) {
/* Field 0 of exn is the exception class, which is immutable */
exnclass = Field_imm(exn, 0);
add_string(&buf, String_val(Field_imm(exnclass, 0)));
/* Check for exceptions in the style of Match_failure and Assert_failure */
if (Wosize_val(exn) == 2) {
caml_read_field(exn, 1, &field1);
} else {
field1 = Val_unit;
}
if (Is_block(field1) &&
Tag_val(field1) == 0 &&
caml_is_special_exception(exnclass)) {
bucket = field1;
start = 0;
} else {
bucket = exn;
start = 1;
}
add_char(&buf, '(');
for (i = start; i < Wosize_val(bucket); i++) {
if (i > start) add_string(&buf, ", ");
caml_read_field(bucket, i, &v);
if (Is_long(v)) {
snprintf(intbuf, sizeof(intbuf),
"%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');
add_string(&buf, String_val(v));
add_char(&buf, '"');
} else {
add_char(&buf, '_');
}
}
add_char(&buf, ')');
} else {
/* Exception without parameters */
exnclass = exn;
add_string(&buf, String_val(Field_imm(exnclass, 0)));
}
*buf.ptr = 0; /* Terminate string */
i = buf.ptr - buf.data + 1;
res = malloc(i);
if (res == NULL) CAMLreturnT (char*, NULL);
memmove(res, buf.data, i);
CAMLreturnT (char*, res);
}