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