#include #include "misc.h" #include "mlvalues.h" char * young_start, * young_ptr, * young_end; char * old_start, * old_ptr, * old_end; value ** remembered_start, ** remembered_ptr, ** remembered_end; void failed_assert(file, line) char * file; int line; { fprintf(stderr, "Failed assertion, file %s, line %d\n", file, line); exit(2); } extern unsigned long _etext; long current_break; /* Check that an object is (reasonably) well-formed */ #define MAX_SIZE 63 #define MAX_TAG 1 void check_field(v) value v; { if (Is_int(v)) return; Assert((v & (sizeof(value) - 1)) == 0); Assert(v >= (long) &_etext && v <= (long) current_break); if ((char *)v > young_start && (char *)v <= young_end) { Assert((char *)v > young_ptr); } } void check_value(v) value v; { header_t hdr, sz; int i; if (Is_int(v)) return; check_field(v); hdr = Header_val(v); sz = Size_val(v); Assert((hdr & 0x300) == 0); switch(Tag_header(hdr)) { case Double_tag: Assert(sz == sizeof(double) / sizeof(value)); break; case String_tag: i = ((char *)v)[sz * sizeof(value) - 1]; Assert(i >= 0 && i < sizeof(value)); Assert(((char *)v)[sz * sizeof(value) - 1 - i] == 0); break; case Abstract_tag: case Finalized_tag: Assert(0); break; case Infix_tag: v -= sz * sizeof(value); Assert(Header_val(v) == Closure_tag); check_value(v); break; case Closure_tag: Assert(Field(v, 0) < (long)&_etext); if (Field(v, 1) == Val_int(1)) { i = 2; } else { Assert(Is_int(Field(v, 1))); Assert(Field(v, 2) < (long)&_etext); i = 3; } while(1) { hdr = (header_t) Field(v, i); if (Tag_header(hdr) != Infix_tag) break; i++; Assert(Size_header(hdr) == i); Assert(Field(v, i) < (long)&_etext); i++; if (Field(v, i) == Val_int(1)) { i++; } else { Assert(Is_int(Field(v, i))); i++; Assert(Field(v, i) < (long)&_etext); i++; } } for (/*nothing*/; i < sz; i++) check_field(Field(v, i)); break; default: #ifdef MAX_SIZE Assert(sz <= MAX_SIZE); #endif #ifdef MAX_TAG Assert(Tag_header(hdr) <= MAX_TAG); #endif for (i = 0; i < sz; i++) check_field(Field(v, i)); break; } } /* Check that a heap chunk is well-formed */ void check_heap(start, end) char * start; char * end; { char * p; value v; current_break = sbrk(0); p = start; while (p < end) { v = (value)(p + sizeof(header_t)); check_value(v); p += sizeof(header_t) + Size_val(v) * sizeof(value); } Assert(p == end); } /* Check the globals */ extern value * caml_globals[]; void check_globals() { int i; current_break = sbrk(0); for (i = 0; caml_globals[i] != 0; i++) { value v = *(caml_globals[i]); if (v != 0) check_value(v); } }