Ajout du mini-GC.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@69 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 135 insertions, 0 deletions

diff --git a/asmrun/debug.c b/asmrun/debug.c
new file mode 100644
index 000000000..ef22b0893
--- /dev/null
+++ b/asmrun/debug.c
@@ -0,0 +1,135 @@
+#include <stdio.h>
+#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);
+  }
+}