Ajout test mark&sweep GC

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

2 files changed, 308 insertions, 1 deletions

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