@@ -1,4 +1,5 @@
11#include "idris_heap.h"
2+#include "idris_rts.h"
23
34#include <stdlib.h>
45#include <stddef.h>
@@ -8,7 +9,9 @@ void alloc_heap(Heap * h, size_t heap_size)
89{
910 char * mem = malloc(heap_size);
1011 if (mem == NULL) {
11− fprintf(stderr, "Unable to allocate heap. Requested %d bytes.\n", heap_size);
12+ fprintf(stderr,
13+ "RTS ERROR: Unable to allocate heap. Requested %d bytes.\n",
14+ (int)heap_size);
1215 exit(EXIT_FAILURE);
1316 }
1417
@@ -29,3 +32,94 @@ void free_heap(Heap * h) {
2932 free(h->old);
3033 }
3134}
35+
36+// TODO: more testing
37+/******************** Heap testing ********************************************/
38+void heap_check_underflow(Heap * heap) {
39+ if (!(heap->heap <= heap->next)) {
40+ fprintf(stderr, "RTS ERROR: HEAP UNDERFLOW <bot %p> <cur %p>\n",
41+ heap->heap, heap->next);
42+ exit(EXIT_FAILURE);
43+ }
44+}
45+
46+void heap_check_overflow(Heap * heap) {
47+ if (!(heap->next <= heap->end)) {
48+ fprintf(stderr, "RTS ERROR: HEAP OVERFLOW <cur %p> <end %p>\n",
49+ heap->next, heap->end);
50+ exit(EXIT_FAILURE);
51+ }
52+}
53+
54+int is_valid_ref(VAL v) {
55+ return (v != NULL) && !(ISINT(v));
56+}
57+
58+int ref_in_heap(Heap * heap, VAL v) {
59+ return ((VAL)heap->heap <= v) && (v < (VAL)heap->next);
60+}
61+
62+// Checks three important properties:
63+// 1. Closure.
64+// Check if all pointers in the _heap_ points only to heap.
65+// 2. Unidirectionality. (if compact gc)
66+// All references in the heap should be are unidirectional. In other words,
67+// more recently allocated closure can point only to earlier allocated one.
68+// 3. After gc there should be no forward references.
69+//
70+void heap_check_pointers(Heap * heap) {
71+ char* scan = NULL;
72+
73+ size_t item_size = 0;
74+ for(scan = heap->heap; scan < heap->next; scan += item_size) {
75+ item_size = *((size_t*)scan);
76+ VAL heap_item = (VAL)(scan + sizeof(size_t));
77+
78+ switch(GETTY(heap_item)) {
79+ case CON:
80+ {
81+ int ar = ARITY(heap_item);
82+ int i = 0;
83+ for(i = 0; i < ar; ++i) {
84+ VAL ptr = heap_item->info.c.args[i];
85+
86+ if (is_valid_ref(ptr)) {
87+ // Check for closure.
88+ if (!ref_in_heap(heap, ptr)) {
89+ fprintf(stderr,
90+ "RTS ERROR: heap closure broken. "\
91+ "<HEAP %p %p %p> <REF %p>\n",
92+ heap->heap, heap->next, heap->end, ptr);
93+ exit(EXIT_FAILURE);
94+ }
95+#if 0 // TODO macro
96+ // Check for unidirectionality.
97+ if (!(ptr < heap_item)) {
98+ fprintf(stderr,
99+ "RTS ERROR: heap unidirectionality broken:" \
100+ "<CON %p> <FIELD %p>\n",
101+ heap_item, ptr);
102+ exit(EXIT_FAILURE);
103+ }
104+#endif
105+ }
106+ }
107+ break;
108+ }
109+ case FWD:
110+ // Check for artifacts after cheney gc.
111+ fprintf(stderr, "RTS ERROR: FWD in working heap.\n");
112+ exit(EXIT_FAILURE);
113+ break;
114+ default:
115+ break;
116+ }
117+ }
118+}
119+
120+void heap_check_all(Heap * heap)
121+{
122+ heap_check_underflow(heap);
123+ heap_check_overflow(heap);
124+ heap_check_pointers(heap);
125+}