git.iko.soy/Idris-dev
on master help sign in
Merge pull request #236 from fmap/stats

RTS stats, opts, some minor improvements.

commitc206136842bec083ef442656091bd68a92b7c452 authorEdwin Brady <edwin.brady@gmail.com> dateSun 17 Mar 2013, 01:48 (14 years ago) parent8b96fc76f8ee96
11 files changed+503−64
compare with master
unifiedsplit
rts/Makefile+3−2 rts/idris_gc.c+21−21 rts/idris_heap.c+125 rts/idris_heap.h+29 rts/idris_main.c+26−5 rts/idris_opts.c+110 rts/idris_opts.h+19 rts/idris_rts.c+35−26 rts/idris_rts.h+9−10 rts/idris_stats.c+53 rts/idris_stats.h+73
rts/Makefile+3−2
@@ -1,8 +1,9 @@
11include ../config.mk
22
3−OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o idris_bitstring.o
4−HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h idris_bitstring.h
3+OBJS = idris_rts.o idris_heap.o idris_gc.o idris_gmp.o idris_stdfgn.o idris_bitstring.o idris_opts.o idris_stats.o
4+HDRS = idris_rts.h idris_heap.h idris_gc.h idris_gmp.h idris_stdfgn.h idris_bitstring.h idris_opts.h idris_stats.h
55CFLAGS = -O2 -Wall
6+
67ifneq ($(GMP_INCLUDE_DIR),)
78 CFLAGS += -isystem $(GMP_INCLUDE_DIR)
89endif
rts/idris_gc.c+21−21
@@ -55,9 +55,9 @@ VAL copy(VM* vm, VAL x) {
5555void cheney(VM *vm) {
5656 int i;
5757 int ar;
58− char* scan = vm->heap;
58+ char* scan = vm->heap.heap;
5959
60− while(scan < vm->heap_next) {
60+ while(scan < vm->heap.next) {
6161 size_t inc = *((size_t*)scan);
6262 VAL heap_item = (VAL)(scan+sizeof(size_t));
6363 // If it's a CON, copy its arguments
@@ -76,21 +76,22 @@ void cheney(VM *vm) {
7676 }
7777 scan += inc;
7878 }
79− assert(scan == vm->heap_next);
79+ assert(scan == vm->heap.next);
8080}
8181
8282void idris_gc(VM* vm) {
83+ HEAP_CHECK(vm)
84+ STATS_ENTER_GC(vm->stats, vm->heap.size)
8385 // printf("Collecting\n");
8486
85− char* newheap = malloc(vm -> heap_size);
86− char* oldheap = vm -> heap;
87− if (vm->oldheap != NULL) free(vm->oldheap);
87+ char* newheap = malloc(vm->heap.size);
88+ char* oldheap = vm->heap.heap;
89+ if (vm->heap.old != NULL)
90+ free(vm->heap.old);
8891
89− vm->heap = newheap;
90− vm->heap_next = newheap;
91− vm->heap_end = newheap + vm->heap_size;
92−
93− vm->collections++;
92+ vm->heap.heap = newheap;
93+ vm->heap.next = newheap;
94+ vm->heap.end = newheap + vm->heap.size;
9495
9596 VAL* root;
9697
@@ -111,20 +112,19 @@ void idris_gc(VM* vm) {
111112 // After reallocation, if we've still more than half filled the new heap, grow the heap
112113 // for next time.
113114
114− if ((vm->heap_next - vm->heap) > vm->heap_size >> 1) {
115− vm->heap_size += vm->heap_growth;
115+ if ((vm->heap.next - vm->heap.heap) > vm->heap.size >> 1) {
116+ vm->heap.size += vm->heap.growth;
116117 }
117− vm->oldheap = oldheap;
118+ vm->heap.old = oldheap;
118119
119− // gcInfo(vm, 0);
120+ STATS_LEAVE_GC(vm->stats, vm->heap.size, vm->heap.next - vm->heap.heap)
121+ HEAP_CHECK(vm)
120122}
121123
122124void idris_gcInfo(VM* vm, int doGC) {
123− printf("\nStack: %p %p\n", vm->valstack, vm->valstack_top);
124− printf("Total allocations: %d\n", vm->allocations);
125− printf("GCs: %d\n", vm->collections);
126− printf("Final heap size %d\n", (int)(vm->heap_size));
127− printf("Final heap use %d\n", (int)(vm->heap_next - vm->heap));
125+ printf("Stack: <BOT %p> <TOP %p>\n", vm->valstack, vm->valstack_top);
126+ printf("Final heap size %d\n", (int)(vm->heap.size));
127+ printf("Final heap use %d\n", (int)(vm->heap.next - vm->heap.heap));
128128 if (doGC) { idris_gc(vm); }
129− printf("Final heap use after GC %d\n", (int)(vm->heap_next - vm->heap));
129+ printf("Final heap use after GC %d\n", (int)(vm->heap.next - vm->heap.heap));
130130}
rts/idris_heap.cnew file+125
@@ -0,0 +1,125 @@
1+#include "idris_heap.h"
2+#include "idris_rts.h"
3+
4+#include <stdlib.h>
5+#include <stddef.h>
6+#include <stdio.h>
7+
8+void alloc_heap(Heap * h, size_t heap_size)
9+{
10+ char * mem = malloc(heap_size);
11+ if (mem == NULL) {
12+ fprintf(stderr,
13+ "RTS ERROR: Unable to allocate heap. Requested %d bytes.\n",
14+ (int)heap_size);
15+ exit(EXIT_FAILURE);
16+ }
17+
18+ h->heap = mem;
19+ h->next = h->heap;
20+ h->end = h->heap + heap_size;
21+
22+ h->size = heap_size;
23+ h->growth = heap_size;
24+
25+ h->old = NULL;
26+}
27+
28+void free_heap(Heap * h) {
29+ free(h->heap);
30+
31+ if (h->old != NULL) {
32+ free(h->old);
33+ }
34+}
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+}
rts/idris_heap.hnew file+29
@@ -0,0 +1,29 @@
1+#ifndef _IDRIS_HEAP_H
2+#define _IDRIS_HEAP_H
3+
4+#include <stddef.h>
5+
6+typedef struct {
7+ char* next; // Next allocated chunk. Should always (heap <= next < end).
8+ char* heap; // Point to bottom of heap
9+ char* end; // Point to top of heap
10+ size_t size; // Size of _next_ heap. Size of current heap is /end - heap/.
11+ size_t growth; // Quantity of heap growth in bytes.
12+
13+ char* old;
14+} Heap;
15+
16+
17+void alloc_heap(Heap * heap, size_t heap_size);
18+void free_heap(Heap * heap);
19+
20+
21+#ifdef IDRIS_DEBUG
22+void heap_check_all(Heap * heap);
23+// Should be used _between_ gc's.
24+#define HEAP_CHECK(vm) heap_check_all(&(vm->heap));
25+#else
26+#define HEAP_CHECK(vm)
27+#endif // IDRIS_DEBUG
28+
29+#endif // _IDRIS_HEAP_H
rts/idris_main.c+26−5
@@ -1,9 +1,30 @@
1+#include "idris_opts.h"
2+#include "idris_stats.h"
3+#include "idris_rts.h"
4+// The default options should give satisfactory results under many circumstances.
5+RTSOpts opts = {
6+ .init_heap_size = 4096000,
7+ .max_stack_size = 4096000,
8+ .show_summary = 0
9+};
10+
111int main(int argc, char* argv[]) {
2− VM* vm = init_vm(4096000, 4096000, 1, argc, argv); // 1024000);
12+ parse_shift_args(&opts, &argc, &argv);
13+
14+ VM* vm = init_vm(opts.max_stack_size, opts.init_heap_size, 1, argc, argv);
315 _idris__123_runMain0_125_(vm, NULL);
4− //_idris_main(vm, NULL);
5−#ifdef IDRIS_TRACE
6− idris_gcInfo(vm, 1);
16+
17+#ifdef IDRIS_DEBUG
18+ if (opts.show_summary) {
19+ idris_gcInfo(vm, 1);
20+ }
721#endif
8− terminate(vm);
22+
23+ Stats stats = terminate(vm);
24+
25+ if (opts.show_summary) {
26+ print_stats(&stats);
27+ }
28+
29+ return EXIT_SUCCESS;
930}
rts/idris_opts.cnew file+110
@@ -0,0 +1,110 @@
1+#include "idris_opts.h"
2+
3+#include <stdlib.h>
4+#include <stddef.h>
5+#include <stdio.h>
6+#include <string.h>
7+
8+
9+char usage[] =
10+ "\n" \
11+ "Usage: <prog> [+RTS <rtsopts> -RTS] <args>\n\n" \
12+ "Options:\n\n" \
13+ " -? Print this message and exits.\n" \
14+ " -s Summary GC statistics.\n" \
15+ " -H Initial heap size. Egs: -H4M, -H500K, -H1G\n" \
16+ " -K Sets the maximum stack size. Egs: -K8M\n" \
17+ "\n";
18+
19+void print_usage(FILE * s) {
20+ fprintf(s, usage);
21+}
22+
23+int read_size(char * str) {
24+ int size = 0;
25+ char mult = ' ';
26+
27+ int r = sscanf(str, "%u%c", &size, &mult);
28+
29+ if (r == 1)
30+ return size;
31+
32+ if (r == 2) {
33+ switch (mult) {
34+ case 'K': size = size << 10; break;
35+ case 'M': size = size << 20; break;
36+ case 'G': size = size << 30; break;
37+ default:
38+ fprintf(stderr,
39+ "RTS Opts: Unable to recognize size suffix `%c'.\n" \
40+ " Possible suffixes are K or M or G.\n",
41+ mult);
42+ print_usage(stderr);
43+ exit(EXIT_FAILURE);
44+ }
45+ return size;
46+ }
47+
48+ fprintf(stderr, "RTS Opts: Unable to parse size. Egs: 1K, 10M, 2G.\n");
49+ print_usage(stderr);
50+ exit(EXIT_FAILURE);
51+}
52+
53+
54+int parse_args(RTSOpts * opts, int argc, char *argv[])
55+{
56+ if (argc == 0)
57+ return 0;
58+
59+ if (strcmp(argv[0], "+RTS") != 0)
60+ return 0;
61+
62+ int i;
63+ for (i = 1; i < argc; i++) {
64+ if (strcmp(argv[i], "-RTS") == 0) {
65+ return i + 1;
66+ }
67+
68+ if (argv[i][0] != '-') {
69+ fprintf(stderr, "RTS options should start with '-'.\n");
70+ print_usage(stderr);
71+ exit(EXIT_FAILURE);
72+ }
73+
74+ switch (argv[i][1])
75+ {
76+ case '?':
77+ print_usage(stdout);
78+ exit(EXIT_SUCCESS);
79+ break;
80+
81+ case 's':
82+ opts->show_summary = 1;
83+ break;
84+
85+ case 'H':
86+ opts->init_heap_size = read_size(argv[i] + 2);
87+ break;
88+
89+ case 'K':
90+ opts->max_stack_size = read_size(argv[i] + 2);
91+ break;
92+
93+ default:
94+ printf("RTS opts: Wrong argument: %s\n", argv[i]);
95+ print_usage(stderr);
96+ exit(EXIT_FAILURE);
97+ }
98+ }
99+
100+ return argc;
101+}
102+
103+void parse_shift_args(RTSOpts * opts, int * argc, char ** argv[]) {
104+ size_t shift = parse_args(opts, (*argc) - 1, (*argv) + 1);
105+
106+ char *prg = (*argv)[0];
107+ *argc = *argc - shift;
108+ *argv = *argv + shift;
109+ (*argv)[0] = prg;
110+}
rts/idris_opts.hnew file+19
@@ -0,0 +1,19 @@
1+#ifndef _IDRIS_OPTS_H
2+#define _IDRIS_OPTS_H
3+
4+#include <stddef.h>
5+#include <stdio.h>
6+
7+typedef struct {
8+ size_t init_heap_size;
9+ size_t max_stack_size;
10+ int show_summary;
11+} RTSOpts;
12+
13+void print_usage(FILE * s);
14+
15+// Parse rts options and shift arguments such that rts options becomes invisible
16+// for main program.
17+void parse_shift_args(RTSOpts * opts, int * argc, char ** argv[]);
18+
19+#endif
rts/idris_rts.c+35−26
@@ -10,14 +10,19 @@
1010#include "idris_gc.h"
1111#include "idris_bitstring.h"
1212
13+
1314VM* init_vm(int stack_size, size_t heap_size,
1415 int max_threads, // not implemented yet
1516 int argc, char* argv[]) {
16− VAL* valstack = malloc(stack_size*sizeof(VAL));
17− int* intstack = malloc(stack_size*sizeof(int));
18− double* floatstack = malloc(stack_size*sizeof(double));
1917
2018 VM* vm = malloc(sizeof(VM));
19+ STATS_INIT_STATS(vm->stats)
20+ STATS_ENTER_INIT(vm->stats)
21+
22+ VAL* valstack = malloc(stack_size * sizeof(VAL));
23+ int* intstack = malloc(stack_size * sizeof(int));
24+ double* floatstack = malloc(stack_size*sizeof(double));
25+
2126 vm->valstack = valstack;
2227 vm->valstack_top = valstack;
2328 vm->valstack_base = valstack;
@@ -26,14 +31,9 @@ VM* init_vm(int stack_size, size_t heap_size,
2631 vm->floatstack = floatstack;
2732 vm->floatstack_ptr = floatstack;
2833 vm->stack_max = valstack + stack_size;
29− vm->heap = malloc(heap_size);
30− vm->oldheap = NULL;
31− vm->heap_next = vm->heap;
32− vm->heap_end = vm->heap + heap_size;
33− vm->heap_size = heap_size;
34− vm->collections = 0;
35− vm->allocations = 0;
36− vm->heap_growth = heap_size;
34+
35+ alloc_heap(&(vm->heap), heap_size);
36+
3737 vm->ret = NULL;
3838 vm->reg1 = NULL;
3939
@@ -60,25 +60,32 @@ VM* init_vm(int stack_size, size_t heap_size,
6060 vm->argv[i] = MKSTR(vm, argv[i]);
6161 }
6262
63+ STATS_LEAVE_INIT(vm->stats)
6364 return vm;
6465}
6566
66−void terminate(VM* vm) {
67+Stats terminate(VM* vm) {
68+ Stats stats = vm->stats;
69+ STATS_ENTER_EXIT(stats)
70+
6771 free(vm->inbox);
6872 free(vm->valstack);
6973 free(vm->intstack);
7074 free(vm->floatstack);
71− free(vm->heap);
75+ free_heap(&(vm->heap));
7276 free(vm->argv);
73− if (vm->oldheap != NULL) { free(vm->oldheap); }
77+
7478 pthread_mutex_destroy(&(vm -> inbox_lock));
7579 pthread_mutex_destroy(&(vm -> inbox_block));
7680 pthread_cond_destroy(&(vm -> inbox_waiting));
7781 free(vm);
82+
83+ STATS_LEAVE_EXIT(stats)
84+ return stats;
7885}
7986
8087void idris_requireAlloc(VM* vm, size_t size) {
81− if (!(vm -> heap_next + size < vm -> heap_end)) {
88+ if (!(vm->heap.next + size < vm->heap.end)) {
8289 idris_gc(vm);
8390 }
8491
@@ -109,13 +116,13 @@ void* allocate(VM* vm, size_t size, int outerlock) {
109116
110117 size_t chunk_size = size + sizeof(size_t);
111118
112− if (vm -> heap_next + chunk_size < vm -> heap_end) {
113− vm->allocations += chunk_size;
114− void* ptr = (void*)(vm->heap_next + sizeof(size_t));
115− *((size_t*)(vm->heap_next)) = chunk_size;
116− vm -> heap_next += chunk_size;
119+ if (vm->heap.next + chunk_size < vm->heap.end) {
120+ STATS_ALLOC(vm->stats, chunk_size)
121+ void* ptr = (void*)(vm->heap.next + sizeof(size_t));
122+ *((size_t*)(vm->heap.next)) = chunk_size;
123+ vm->heap.next += chunk_size;
117124
118− assert(vm->heap_next <= vm->heap_end);
125+ assert(vm->heap.next <= vm->heap.end);
119126
120127 memset(ptr, 0, size);
121128
@@ -215,7 +222,7 @@ void dumpStack(VM* vm) {
215222 for (root = vm->valstack; root < vm->valstack_top; ++root, ++i) {
216223 printf("%d: ", i);
217224 dumpVal(*root);
218− if (*root >= (VAL)(vm->heap) && *root < (VAL)(vm->heap_end)) { printf("OK"); }
225+ if (*root >= (VAL)(vm->heap.heap) && *root < (VAL)(vm->heap.end)) { printf("OK"); }
219226 printf("\n");
220227 }
221228 printf("RET: ");
@@ -408,12 +415,14 @@ void* runThread(void* arg) {
408415 callvm->processes--;
409416
410417 free(td);
411− terminate(vm);
418+
419+ Stats stats = terminate(vm);
420+ // aggregate_stats(&(td->vm->stats), &stats);
412421 return NULL;
413422}
414423
415424void* vmThread(VM* callvm, func f, VAL arg) {
416− VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size,
425+ VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap.size,
417426 callvm->max_threads,
418427 0, NULL);
419428 vm->processes=1; // since it can send and receive messages
@@ -500,12 +509,12 @@ void idris_sendMessage(VM* sender, VM* dest, VAL msg) {
500509 // So: we try to copy, if a collection happens, we do the copy again
501510 // under the assumption there's enough space this time.
502511
503− int gcs = dest->collections;
512+ int gcs = dest->stats.collections;
504513 pthread_mutex_lock(&dest->alloc_lock);
505514 VAL dmsg = copyTo(dest, msg);
506515 pthread_mutex_unlock(&dest->alloc_lock);
507516
508− if (dest->collections>gcs) {
517+ if (dest->stats.collections > gcs) {
509518 // a collection will have invalidated the copy
510519 pthread_mutex_lock(&dest->alloc_lock);
511520 dmsg = copyTo(dest, msg); // try again now there's room...
rts/idris_rts.h+9−10
@@ -9,6 +9,9 @@
99#include <pthread.h>
1010#include <stdint.h>
1111
12+#include "idris_heap.h"
13+#include "idris_stats.h"
14+
1215// Closures
1316
1417typedef enum {
@@ -47,12 +50,10 @@ typedef struct {
4750 VAL* valstack_base;
4851 int* intstack_ptr;
4952 double* floatstack_ptr;
50− char* heap;
51− char* oldheap;
52− char* heap_next;
53− char* heap_end;
5453 VAL* stack_max;
55−
54+
55+ Heap heap;
56+
5657 pthread_mutex_t inbox_lock;
5758 pthread_mutex_t inbox_block;
5859 pthread_mutex_t alloc_lock;
@@ -66,14 +67,12 @@ typedef struct {
6667
6768 int processes; // Number of child processes
6869 int max_threads; // maximum number of threads to run in parallel
70+
71+ Stats stats;
6972
7073 int argc;
7174 VAL* argv; // command line arguments
7275
73− size_t heap_size;
74− size_t heap_growth;
75− int allocations;
76− int collections;
7776 VAL ret;
7877 VAL reg1;
7978} VM;
@@ -83,7 +82,7 @@ VM* init_vm(int stack_size, size_t heap_size,
8382 int max_threads,
8483 int argc, char* argv[]);
8584// Clean up a VM once it's no longer needed
86−void terminate(VM* vm);
85+Stats terminate(VM* vm);
8786
8887// Functions all take a pointer to their VM, and previous stack base,
8988// and return nothing.
rts/idris_stats.cnew file+53
@@ -0,0 +1,53 @@
1+#include "idris_stats.h"
2+
3+#include <stdio.h>
4+#include <locale.h>
5+
6+#ifdef IDRIS_ENABLE_STATS
7+
8+void print_stats(const Stats * stats) {
9+ clock_t total = clock() - stats->start_time;
10+ clock_t mut = total - stats->init_time - stats->gc_time - stats->exit_time;
11+ double mut_sec = (double)mut / CLOCKS_PER_SEC;
12+ int avg_chunk = (int)((double)stats->allocations / (double)stats->alloc_count);
13+ int alloc_rate = (int)((double)(stats->allocations) / mut_sec);
14+
15+ setlocale(LC_NUMERIC, "");
16+ printf("\n");
17+ printf("%'20d bytes allocated in the heap\n", stats->allocations);
18+ printf("%'20d bytes copied during GC\n", stats->copied);
19+ printf("%'20d maximum heap size\n", stats->max_heap_size);
20+ printf("%'20d chunks allocated in the heap\n", stats->alloc_count);
21+ printf("%'20d average chunk size\n\n", avg_chunk);
22+
23+ printf("GC called %d times\n\n", stats->collections);
24+
25+ printf("INIT time: %8.3fs\n", (double)stats->init_time / CLOCKS_PER_SEC);
26+ printf("MUT time: %8.3fs\n", mut_sec);
27+ printf("GC time: %8.3fs\n", (double)stats->gc_time / CLOCKS_PER_SEC);
28+ printf("EXIT time: %8.3fs\n", (double)stats->exit_time / CLOCKS_PER_SEC);
29+ printf("TOTAL time: %8.3fs\n\n", (double)total / CLOCKS_PER_SEC);
30+
31+ printf("%%GC time: %.2f%%\n\n", 100 * (double)stats->gc_time / (double)total);
32+
33+ printf("Alloc rate %'d bytes per MUT sec\n\n", alloc_rate);
34+
35+ printf("Productivity %.2f%%\n", 100 * ((double)mut / (double)total));
36+}
37+
38+void aggregate_stats(Stats * stats1, const Stats * stats2) {
39+ fprintf(stderr, "RTS error: aggregate_stats not implemented");
40+}
41+
42+#else
43+
44+void print_stats(const Stats * stats) {
45+ fprintf(stderr, "RTS ERROR: Stats are disabled.\n" \
46+ "By the way GC called %d times.\n", stats->collections);
47+}
48+
49+void aggregate_stats(Stats * stats1, const Stats * stats2) {
50+ stats1->collections += stats2->collections;
51+}
52+
53+#endif // IDRIS_ENABLE_STATS
rts/idris_stats.hnew file+73
@@ -0,0 +1,73 @@
1+#ifndef _IDRIS_STATS_H
2+#define _IDRIS_STATS_H
3+
4+#include <time.h>
5+
6+// Should not be defined in release.
7+#define IDRIS_ENABLE_STATS
8+
9+// TODO: measure user time, exclusive/inclusive stats
10+typedef struct {
11+#ifdef IDRIS_ENABLE_STATS
12+ int allocations; // Size of allocated space in bytes for all execution time.
13+ int alloc_count; // How many times alloc is called.
14+ int copied; // Size of space copied during GC.
15+ int max_heap_size; // Maximum heap size achieved.
16+
17+ clock_t init_time; // Time spent for vm initialization.
18+ clock_t exit_time; // Time spent for vm termination.
19+ clock_t gc_time; // Time spent for gc for all execution time.
20+ clock_t max_gc_pause; // Time spent for longest gc.
21+ clock_t start_time; // Time of rts entry point.
22+#endif // IDRIS_ENABLE_STATS
23+ int collections; // How many times gc called.
24+} Stats; // without start time it's a monoid, can we remove start_time it somehow?
25+
26+void print_stats(const Stats * stats);
27+void aggregate_stats(Stats * stats1, const Stats * stats2);
28+
29+
30+#ifdef IDRIS_ENABLE_STATS
31+
32+#ifndef MAX
33+#define MAX(a, b) ((a) > (b) ? (a) : (b))
34+#endif
35+
36+#define STATS_INIT_STATS(stats) \
37+ memset(&stats, 0, sizeof(Stats)); \
38+ stats.start_time = clock();
39+
40+#define STATS_ALLOC(stats, size) \
41+ stats.allocations += size; \
42+ stats.alloc_count = stats.alloc_count + 1;
43+
44+#define STATS_ENTER_INIT(stats) clock_t _start_time = clock();
45+#define STATS_LEAVE_INIT(stats) stats.init_time = clock() - _start_time;
46+
47+#define STATS_ENTER_EXIT(stats) clock_t _start_time = clock();
48+#define STATS_LEAVE_EXIT(stats) stats.exit_time = clock() - _start_time;
49+
50+#define STATS_ENTER_GC(stats, heap_size) \
51+ clock_t _start_time = clock(); \
52+ stats.max_heap_size = MAX(stats.max_heap_size, heap_size);
53+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped) \
54+ clock_t _pause = clock() - _start_time; \
55+ stats.gc_time += _pause; \
56+ stats.max_gc_pause = MAX(_pause, stats.max_gc_pause); \
57+ stats.max_heap_size = MAX(stats.max_heap_size, heap_size); \
58+ stats.copied += heap_occuped; \
59+ stats.collections = stats.collections + 1;
60+
61+#else
62+#define STATS_INIT_STATS(stats) memset(&stats, 0, sizeof(Stats));
63+#define STATS_ENTER_INIT(stats)
64+#define STATS_LEAVE_INIT(stats)
65+#define STATS_ENTER_EXIT(stats)
66+#define STATS_LEAVE_EXIT(stats)
67+#define STATS_ALLOC(stats, size)
68+#define STATS_ENTER_GC(stats, heap_size)
69+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped) \
70+ stats.collections = stats.collections + 1;
71+#endif // IDRIS_ENABLE_STATS
72+
73+#endif // _IDRIS_STATS_H