@@ -0,0 +1,90 @@
1+#include "idris_rts.h"
2+#include "idris_gc.h"
3+
4+VAL copy(VM* vm, VAL x) {
5+ int i;
6+ VAL* argptr;
7+ Closure* cl;
8+ if (x==NULL || ISINT(x)) {
9+ return x;
10+ }
11+ switch(x->ty) {
12+ case CON:
13+ cl = allocCon(vm, x->info.c.arity);
14+ cl->info.c.tag = x->info.c.tag;
15+ cl->info.c.arity = x->info.c.arity;
16+
17+ argptr = (VAL*)(cl->info.c.args);
18+ for(i = 0; i < x->info.c.arity; ++i) {
19+// *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
20+ *argptr = *((VAL*)(x->info.c.args)+i);
21+ argptr++;
22+ }
23+ break;
24+ case FLOAT:
25+ cl = MKFLOAT(vm, x->info.f);
26+ break;
27+ case STRING:
28+ cl = MKSTR(vm, x->info.str);
29+ break;
30+ case PTR:
31+ cl = MKPTR(vm, x->info.ptr);
32+ break;
33+ case FWD:
34+ cl = x->info.ptr;
35+ break;
36+ }
37+ x->ty = FWD;
38+ x->info.ptr = cl;
39+ return cl;
40+}
41+
42+void cheney(VM *vm) {
43+ VAL* argptr;
44+ int i;
45+ char* scan = vm->heap;
46+
47+ while(scan < vm->heap_next) {
48+ size_t inc = *((size_t*)scan);
49+ VAL heap_item = (VAL)(scan+sizeof(size_t)*2);
50+ // If it's a CON, copy its arguments
51+ switch(heap_item->ty) {
52+ case CON:
53+ argptr = (VAL*)(heap_item->info.c.args);
54+ for(i = 0; i < heap_item->info.c.arity; ++i) {
55+ *argptr = copy(vm, *argptr);
56+ argptr++;
57+ }
58+ break;
59+ }
60+ scan += inc;
61+ }
62+}
63+
64+void gc(VM* vm) {
65+ char* newheap = malloc(vm -> heap_size);
66+ char* oldheap = vm -> heap;
67+
68+ vm->heap = newheap;
69+ vm->heap_next = newheap;
70+ vm->heap_end = newheap + vm->heap_size;
71+
72+ vm->collections++;
73+
74+ VAL* root;
75+
76+ for(root = vm->valstack; root < vm->valstack_top; ++root) {
77+ *root = copy(vm, *root);
78+ }
79+ vm->ret = copy(vm, vm->ret);
80+ cheney(vm);
81+
82+ // After reallocation, if we've still more than half filled the new heap, grow the heap
83+ // for next time.
84+
85+ if ((vm->heap_next - vm->heap) > vm->heap_size >> 1) {
86+ vm->heap_size += vm->heap_growth;
87+ }
88+
89+ free(oldheap);
90+}