Ajout test mark&sweep GC

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@134 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

5 files changed, 439 insertions, 2 deletions

diff --git a/test/c/binarytrees.c b/test/c/binarytrees.c
index da019af..31cf312 100644
--- a/test/c/binarytrees.c
+++ b/test/c/binarytrees.c
@@ -160,4 +160,5 @@ stretch tree of depth 17	 check: -1
 128	 trees of depth 14	 check: -128
 32	 trees of depth 16	 check: -32
 long lived tree of depth 16	 check: -1
+skinny tree of depth 17          check: 17
 *********/
diff --git a/test/cminor/Makefile b/test/cminor/Makefile
index e498841..29ebf69 100644
--- a/test/cminor/Makefile
+++ b/test/cminor/Makefile
@@ -5,7 +5,8 @@ CFLAGS=-arch ppc -g
 ASFLAGS=-arch ppc
 VPATH=../harness ../lib
 
-PROGS=fib integr qsort fft sha1 aes almabench manyargs lists stopcopy
+PROGS=fib integr qsort fft sha1 aes almabench manyargs lists \
+  stopcopy marksweep
 
 all_s: $(PROGS:%=%.s)
 
@@ -63,6 +64,11 @@ stopcopy: stopcopy.o maingc.o
 clean::
 	rm -f stopcopy
 
+marksweep: marksweep.o maingc.o marksweepcheck.o
+	$(CC) $(CFLAGS) -o marksweep marksweep.o maingc.o marksweepcheck.o
+clean::
+	rm -f stopcopy
+
 .SUFFIXES:
 
 .SUFFIXES: .cmp .cm .s .o .c .S
@@ -83,5 +89,7 @@ clean::
 .S.o:
 	$(AS) $(ASFLAGS) -o $*.o $<
 
+.SECONDARY: $(PROGS:%=%.s)
+
 clean::
 	rm -f *.s *.o *~
diff --git a/test/cminor/marksweep.cmp b/test/cminor/marksweep.cmp
new file mode 100644
index 0000000..b1cd3ab
--- /dev/null
+++ b/test/cminor/marksweep.cmp
@@ -0,0 +1,299 @@
+/* A simple mark-and-sweep garbage collector */
+
+var "heap_start"[4]
+var "heap_end"[4]
+var "freelist_head"[4]
+
+#define GRAY_CACHE_SIZE 65536
+var "gray_cache"[GRAY_CACHE_SIZE]
+var "gray_cache_ptr"[4]
+var "gray_cache_overflow"[4]
+
+/* Format of blocks:
+      - header word: 28 bits size + 2 bits mark + 2 bits kind
+          kind = 0   block contains raw data (no pointers)
+          kind = 1   block contains pointer data
+          kind = 2   block is closure (all pointers except first word)
+          mark = 0   block is white (never reached)
+          mark = 1   block is gray  (reached but contents not scanned)
+          mark = 3   block is black (reached and contents were scanned)
+      - [size] words of data
+
+   Blocks are stored in one big global array and addressed by pointers
+   within this block.  The pointer goes to the first word of data.
+*/
+
+#define KIND_RAWDATA 0
+#define KIND_PTRDATA 1
+#define KIND_CLOSURE 2
+#define KIND_FORWARDED 3
+
+#define COLOR_WHITE 0
+#define COLOR_GRAY 4
+#define COLOR_BLACK 0xC
+
+#define Kind_header(h) ((h) & 3)
+#define Color_header(h) ((h) & 0xC)
+#define Size_header(h) (((h) >>u 2) & 0xFFFFFFFC)
+
+/* Free-list allocation, first-fit */
+
+"freelist_alloc"(req_size) : int -> int
+{
+  var p, b, header, size, newsize;
+
+  p = "freelist_head";
+  {{ {{ loop {
+      b = int32[p];               /* b is current free block */
+      if (b == 0) exit 2;         /* free list exhausted */
+      header = int32[b - 4];
+      size = Size_header(header);
+      if (size >= req_size) exit;
+      p = b;                      /* move to next block */
+    } }}
+    /* Found a free block large enough */
+    if (size == req_size) {
+      /* there is nothing left of the free block, remove it
+         from free list */
+      int32[p] = int32[b];
+      return b;
+    }
+    else if (size == req_size + 4) {
+      /* one word remains free, which is too small to put
+         on free list.  Do as above, but mark remaining word
+         so that it can be coalesced later. */
+      int32[p] = int32[b];
+      int32[b + req_size] = 0;    /* header with size == 0 color = white */
+      return b;
+    } else {
+      /* cut free block in two:
+         - first part remains free --> just reduce its size
+         - second part is returned as the free block */
+      newsize = size - (req_size + 4);
+      int32[b - 4] = newsize << 2;
+      return b + newsize + 4;
+    }
+  }}
+  return 0;                     /* free list exhausted */
+}
+
+/* Allocation */
+
+extern "abort" : void
+extern "gc_alarm" : int -> void
+
+"alloc_block"(root, kind, size): int -> int -> int -> int
+{
+  var r;
+
+  r = "freelist_alloc"(size) : int -> int;
+  if (r == 0) {
+    "gc_mark"(root) : int -> void;
+    "gc_sweep"() : void;
+    "gc_alarm"(-1) : int -> void;
+    r = "freelist_alloc"(size) : int -> int;
+    if (r == 0) { "abort"() : void; }
+  }
+  int32[r - 4] = (size << 2) | kind;
+  return r;
+}
+
+#if 0
+
+/* Marking phase with recursive traversal. */
+
+"gc_mark"(root) : int -> void
+{
+  var numroots, p;
+
+  {{ loop {
+    if (root == 0) exit;
+    numroots = int32[root + 4];
+    p = root + 8;
+    {{ loop {
+      if (numroots == 0) exit;
+      "mark_block"(int32[p]) : int -> void;
+      p = p + 4;
+      numroots = numroots - 1;
+    } }}
+    root = int32[root];
+  } }}
+}
+
+"mark_block"(b) : int -> void
+{
+  var header, kind, size;
+
+  if (b == 0) return;
+  header = int32[b - 4];
+  if (Color_header(header) != COLOR_WHITE) return;
+  int32[b - 4] = header | COLOR_BLACK;
+  kind = Kind_header(header);
+  if (kind == KIND_RAWDATA) return;
+  size = Size_header(header);
+  if (kind == KIND_CLOSURE) { b = b + 4; size = size - 4; }
+  {{ loop {
+    if (size == 0) exit;
+    "mark_block"(int32[b]) : int -> void;
+    b = b + 4;
+    size = size - 4;
+  } }}
+}
+
+#else
+
+/* Marking phase with 3-color marking. */
+
+"mark_block"(b): int -> void
+{
+  var header, cache;
+
+  if (b == 0) return;
+  header = int32[b - 4];
+  if (Color_header(header) != COLOR_WHITE) return;
+  if (Kind_header(header) == KIND_RAWDATA) {
+    /* Set it to black now, as there are no pointers within */
+    int32[b - 4] = header | COLOR_BLACK;
+  } else {
+    int32[b - 4] = header | COLOR_GRAY;
+    /* Is there room in the gray_cache? */
+    cache = int32["gray_cache_ptr"];
+    if (cache == "gray_cache" + GRAY_CACHE_SIZE) {
+      int32["gray_cache_overflow"] = 1;
+    } else {
+      int32[cache] = b;
+      int32["gray_cache_ptr"] = cache + 4;
+    }
+  }
+}
+
+"find_first_gray_block"(): int
+{
+  var p, lastp, header;
+
+  p = int32["heap_start"];
+  lastp = int32["heap_end"];
+  loop {
+    if (p >= lastp) return 0;
+    header = int32[p];
+    if (Color_header(header) == COLOR_GRAY) return p + 4;
+    p = p + 4 + Size_header(header);
+  }
+}
+
+"gc_mark"(root) : int -> void
+{
+  var numroots, p, cache, b, header, firstfield, n;
+
+  int32["gray_cache_ptr"] = "gray_cache";
+  int32["gray_cache_overflow"] = 0;
+
+  {{ loop {
+    if (root == 0) exit;
+    numroots = int32[root + 4];
+    p = root + 8;
+    {{ loop {
+      if (numroots == 0) exit;
+      "mark_block"(int32[p]) : int -> void;
+      p = p + 4;
+      numroots = numroots - 1;
+    } }}
+    root = int32[root];
+  } }}
+
+  {{ loop {
+    /* Find next gray object to work on */
+    cache = int32["gray_cache_ptr"];
+    if (cache > "gray_cache") {
+      cache = cache - 4;
+      b = int32[cache];
+      int32["gray_cache_ptr"] = cache;
+    } else {
+      if (int32["gray_cache_overflow"] == 0) exit;
+      b = "find_first_gray_block"() : int;
+      if (b == 0) exit;
+    }
+    /* b is a gray object of kind PTRDATA or CLOSURE */
+    header = int32[b - 4];
+    int32[b - 4] = header | COLOR_BLACK;
+    /* Call mark_block on all (pointer) fields of b.
+       Process fields from last to first since this results
+       in better gray_cache utilization in case of right-oriented
+       data structures such as lists */
+    firstfield = (Kind_header(header) == KIND_CLOSURE) << 2;
+    n = Size_header(header);
+    {{ loop {
+      if (n == firstfield) exit;
+      n = n - 4;
+      "mark_block"(int32[b + n]) : int -> void;
+    } }}
+  } }}
+}
+
+#endif
+
+/* Sweeping phase. */
+
+"gc_sweep"() : void
+{
+  var scan_ptr, scan_end, last_free_block, end_last_free_block,
+    header, size;
+
+  last_free_block = "freelist_head";
+  end_last_free_block = 0;
+  scan_ptr = int32["heap_start"];
+  scan_end = int32["heap_end"];
+  {{ loop {
+    if (scan_ptr >= scan_end) exit;
+    header = int32[scan_ptr];
+    size = Size_header(header);
+    if (Color_header(header) == COLOR_WHITE) {
+      /* reclaim this block */
+      if (scan_ptr == end_last_free_block) {
+        /* coalesce it with last free block */
+        int32[last_free_block - 4] = 
+          int32[last_free_block - 4] + ((size + 4) << 2);
+        end_last_free_block = end_last_free_block + size + 4;
+      } else {
+        /* insert new free block in free list */
+        int32[scan_ptr] = header & ~0xF;  /* clear mark and kind bits */
+        int32[last_free_block] = scan_ptr + 4;
+        last_free_block = scan_ptr + 4;
+        end_last_free_block = last_free_block + size;
+      }
+    } else {
+      /* clear mark on this block */
+      int32[scan_ptr] = header & ~COLOR_BLACK;
+    }
+    scan_ptr = scan_ptr + 4 + size;
+  } }}
+  int32[last_free_block] = 0; /* terminate free list */
+}
+
+/* Initialize a heap of size [hsize] bytes */
+
+extern "malloc" : int -> int
+
+"init_heap"(hsize) : int -> int
+{
+  var hbase, i;
+
+  hbase = "malloc"(hsize) : int -> int;
+  if (hbase == 0) return -1;
+  int32["heap_start"] = hbase;
+  int32["heap_end"] = hbase + hsize;
+  int32[hbase] = (hsize - 4) << 2;
+  int32[hbase + 4] = 0;
+  int32["freelist_head"] = hbase + 4;
+#ifdef DEBUG
+  /* Fill heap with garbage (for debugging) */
+  i = 8;
+  {{ loop {
+    if (i >= hsize) exit;
+    int32[hbase + i] = 0xDEADBEEF;
+    i = i + 4;
+  } }}
+#endif
+  return 0;
+}
+
diff --git a/test/harness/maingc.c b/test/harness/maingc.c
index 4d5942f..c7a2e8e 100644
--- a/test/harness/maingc.c
+++ b/test/harness/maingc.c
@@ -19,9 +19,19 @@ extern void * alloc_block(struct rootblock * roots,
                           enum block_kind kind,
                           int size);
 
+#ifdef DEBUG
+extern void check_heap(void);
+#endif
+
 void gc_alarm(int live)
 {
-  printf("<GC...%d bytes live>\n", live);
+  if (live == -1)
+    printf("<GC...>\n");
+  else
+    printf("<GC...%d bytes live>\n", live);
+#ifdef DEBUG
+  check_heap();
+#endif
 }
 
 /* Test with binary trees */
diff --git a/test/harness/marksweepcheck.c b/test/harness/marksweepcheck.c
new file mode 100644
index 0000000..92bbfe5
--- /dev/null
+++ b/test/harness/marksweepcheck.c
@@ -0,0 +1,119 @@
+/* Heap checking for the mark-sweep collector */
+
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+
+#ifdef DEBUG
+
+enum block_kind { RAWDATA = 0, PTRDATA = 1, CLOSURE = 2 };
+enum block_color { WHITE = 0, GRAY = 4, BLACK = 0xC };
+
+#define At(p,ty) (*((ty *)(p)))
+#define Kind_header(h) ((h) & 3)
+#define Color_header(h) ((h) & 0xC)
+#define Size_header(h) (((h) >> 2) & 0xFFFFFFFC)
+
+extern char * heap_start, * heap_end, * freelist_head;
+
+char * heap_bitmap = NULL;
+
+static inline void bitmap_set(char * bm, unsigned i)
+{
+  bm[i >> 3] |= 1 << (i & 7);
+}
+
+static inline int bitmap_get(char * bm, unsigned i)
+{
+  return bm[i >> 3] & (1 << (i & 7));
+}
+
+static void check_block(char * p, unsigned s)
+{
+  char * d;
+  for (/**/; s > 0; p += 4, s -= 4) {
+    d = At(p, char *);
+    if (d != NULL) {
+      assert(d >= heap_start + 4);
+      assert(d <= heap_end - 4);
+      assert(((unsigned) d & 3) == 0);
+      assert(bitmap_get(heap_bitmap, (d - heap_start) >> 2));
+    }
+  }
+}
+
+void check_heap(void)
+{
+  char * p, * f, * nextf;
+  unsigned h, s, bitmap_size;
+
+  bitmap_size = ((heap_end - heap_start) + 31) / 32;
+  /* one bit per word -> one byte per 32 bytes in the heap */
+  if (heap_bitmap == NULL) {
+    heap_bitmap = malloc(bitmap_size);
+    assert (heap_bitmap != NULL);
+  }
+  memset(heap_bitmap, 0, bitmap_size);
+
+  /* Superficial check and construction of the bitmap */
+
+  f = freelist_head;
+  assert(f >= heap_start + 4);
+  assert(f <= heap_end - 4);
+
+  for (p = heap_start; p < heap_end; /**/) {
+    h = At(p, unsigned);
+    s = Size_header(h);
+    assert(s >= 4);
+    assert((s & 3) == 0);
+    p = p + 4;
+    assert (p + s <= heap_end);
+    if (p == f) {
+      /* this is a free list block */
+      assert((h & 0xF) == 0);
+      nextf = At(p, char *);
+      if (nextf != NULL) {
+        assert(nextf > f);
+        assert(nextf <= heap_end - 4);
+      }
+      f = nextf;
+    } else {
+      /* this is an allocated block */
+      assert(Color_header(h) == WHITE);
+      bitmap_set(heap_bitmap, (p - heap_start) >> 2);
+    }
+    p = p + s;
+  }
+  assert (p == heap_end);
+  assert (f == NULL);
+
+  /* Check block contents */
+  f = freelist_head;
+  for (p = heap_start; p < heap_end; /**/) {
+    h = At(p, unsigned);
+    s = Size_header(h);
+    p = p + 4;
+    if (p == f) {
+      /* Fill free block with garbage */
+      memset(p + 4, 0xEE, s - 4);
+      f = At(p, char *);
+    } else {
+      /* Check block contents */
+      switch (Kind_header(h)) {
+      case RAWDATA:
+        break;
+      case PTRDATA:
+        check_block(p, s); break;
+      case CLOSURE:
+        check_block(p + 4, s - 4); break;
+      default:
+        assert(0);
+      }
+    }
+    p = p + s;
+  }
+}
+
+#endif