git.iko.soy/Idris-dev
on master help sign in
Heap allocations no longer preceded by allocation size field
commit5ff335060bdb53a226b778bbaa1f8e8658e3d827 authorJorge Acereda <jacereda@gmail.com> dateMon 19 Mar 2018, 18:36 (9 years ago) parent9904389
5 files changed+204−331
compare with master
unifiedsplit
rts/idris_gc.c+18−20 rts/idris_gmp.c+53−180 rts/idris_heap.c+4−4 rts/idris_rts.c+80−93 rts/idris_rts.h+49−34
rts/idris_gc.c+18−20
@@ -17,22 +17,22 @@ VAL copy(VM* vm, VAL x) {
1717 return x;
1818 } else {
1919 allocCon(cl, vm, CTAG(x), ar, 1);
20− memcpy(cl->info.cargs, x->info.cargs, sizeof(VAL)*ar);
20+ memcpy(cl->extra.cargs, x->extra.cargs, sizeof(VAL)*ar);
2121 }
2222 break;
2323 case CT_ARRAY:
24− len = x->sz;
24+ len = CELEM(x);
2525 allocArray(cl, vm, len, 1);
26− memcpy(cl->info.array, x->info.array, sizeof(VAL)*len);
26+ memcpy(cl->extra.array, x->extra.array, len * sizeof(VAL));
2727 break;
2828 case CT_FLOAT:
2929 cl = MKFLOATc(vm, GETFLOAT(x));
3030 break;
3131 case CT_STRING:
32− cl = MKSTRclen(vm, x->info.str, x->sz);
32+ cl = MKSTRclen(vm, getstr(x), getstrlen(x));
3333 break;
3434 case CT_STROFFSET:
35− cl = MKSTROFFc(vm, x->info.str_offset);
35+ cl = MKSTROFFc(vm, x->extra.basestr[0]);
3636 break;
3737 case CT_BIGINT:
3838 cl = MKBIGMc(vm, GETPTR(x));
@@ -41,7 +41,7 @@ VAL copy(VM* vm, VAL x) {
4141 cl = MKPTRc(vm, GETPTR(x));
4242 break;
4343 case CT_MANAGEDPTR:
44− cl = MKMPTRc(vm, x->info.mptr, x->sz);
44+ cl = MKMPTRc(vm, x->extra.mptr, x->extrasz);
4545 break;
4646 case CT_BITS8:
4747 cl = idris_b8CopyForGC(vm, x);
@@ -62,7 +62,7 @@ VAL copy(VM* vm, VAL x) {
6262 return GETPTR(x);
6363 case CT_RAWDATA:
6464 {
65− size_t size = x->sz + sizeof(Closure);
65+ size_t size = sizeof(Closure) + x->extrasz;
6666 cl = allocate(size, 1);
6767 memcpy(cl, x, size);
6868 }
@@ -80,39 +80,37 @@ VAL copy(VM* vm, VAL x) {
8080}
8181
8282void cheney(VM *vm) {
83− int i;
84− int ar, len;
83+ size_t i, len;
8584 char* scan = aligned_heap_pointer(vm->heap.heap);
8685
8786 while(scan < vm->heap.next) {
88− size_t inc = *((size_t*)scan);
89− VAL heap_item = (VAL)(scan+sizeof(size_t));
87+ VAL heap_item = (VAL)scan;
9088 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
9189 switch(GETTY(heap_item)) {
9290 case CT_CON:
93− ar = ARITY(heap_item);
94− for(i = 0; i < ar; ++i) {
95− VAL newptr = copy(vm, heap_item->info.cargs[i]);
96− heap_item->info.cargs[i] = newptr;
91+ len = CARITY(heap_item);
92+ for(i = 0; i < len; ++i) {
93+ VAL newptr = copy(vm, heap_item->extra.cargs[i]);
94+ heap_item->extra.cargs[i] = newptr;
9795 }
9896 break;
9997 case CT_ARRAY:
100− len = heap_item->sz;
98+ len = CELEM(heap_item);
10199 for(i = 0; i < len; ++i) {
102− VAL newptr = copy(vm, heap_item->info.array[i]);
103− heap_item->info.array[i] = newptr;
100+ VAL newptr = copy(vm, heap_item->extra.array[i]);
101+ heap_item->extra.array[i] = newptr;
104102 }
105103 break;
106104 case CT_REF:
107105 heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
108106 break;
109107 case CT_STROFFSET:
110− heap_item->info.str_offset = copy(vm, heap_item->info.str_offset);
108+ heap_item->extra.basestr[0] = copy(vm, heap_item->extra.basestr[0]);
111109 break;
112110 default: // Nothing to copy
113111 break;
114112 }
115− scan += inc;
113+ scan += aligned(valSize(heap_item));
116114 }
117115 assert(scan == vm->heap.next);
118116}
rts/idris_gmp.c+53−180
@@ -22,111 +22,62 @@ VAL MKBIGI(int val) {
2222 return MKINT((i_int)val);
2323}
2424
25+static mpz_t * big(VAL v) {
26+ return (mpz_t*)(v->info.ptr);
27+}
28+
29+static VAL allocBig() {
30+ idris_requireAlloc(IDRIS_MAXGMP);
31+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
32+ idris_doneAlloc();
33+ SETTY(cl, CT_BIGINT);
34+ cl->info.ptr = (void*)(cl+1);
35+ cl->extrasz = sizeof(mpz_t);
36+ mpz_init(*big(cl));
37+ return cl;
38+}
39+
2540VAL MKBIGC(VM* vm, char* val) {
2641 if (*val == '\0') {
2742 return MKBIGI(0);
2843 }
2944 else {
30− idris_requireAlloc(IDRIS_MAXGMP);
31− mpz_t* bigint;
32−
33− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
34− idris_doneAlloc();
35− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
36−
37− mpz_init(*bigint);
38− mpz_set_str(*bigint, val, 10);
39−
40− SETTY(cl, CT_BIGINT);
41− cl -> info.ptr = (void*)bigint;
42−
45+ VAL cl = allocBig();
46+ mpz_set_str(*big(cl), val, 10);
4347 return cl;
4448 }
4549}
4650
47−VAL MKBIGM(VM* vm, void* big) {
48− idris_requireAlloc(IDRIS_MAXGMP);
49−
50− mpz_t* bigint;
51− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
52− idris_doneAlloc();
53− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
54−
55− mpz_init(*bigint);
56− mpz_set(*bigint, *((mpz_t*)big));
57−
58− SETTY(cl, CT_BIGINT);
59− cl -> info.ptr = (void*)bigint;
60−
51+VAL MKBIGM(VM* vm, void* ibig) {
52+ VAL cl = allocBig();
53+ mpz_set(*big(cl), *((mpz_t*)ibig));
6154 return cl;
6255}
6356
64−VAL MKBIGMc(VM* vm, void* big) {
65− idris_requireAlloc(IDRIS_MAXGMP);
66−
67− mpz_t* bigint;
68− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
69− idris_doneAlloc();
70− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
71−
72− mpz_init_set(*bigint, *((mpz_t*)big));
73−
74− SETTY(cl, CT_BIGINT);
75− cl -> info.ptr = (void*)bigint;
76−
57+VAL MKBIGMc(VM* vm, void* ibig) {
58+ VAL cl = allocBig();
59+ mpz_init_set(*big(cl), *((mpz_t*)ibig));
7760 return cl;
7861}
7962
8063VAL MKBIGUI(VM* vm, unsigned long val) {
81− idris_requireAlloc(IDRIS_MAXGMP);
82−
83− mpz_t* bigint;
84− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
85− idris_doneAlloc();
86− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
87−
88− mpz_init_set_ui(*bigint, val);
89−
90− SETTY(cl, CT_BIGINT);
91− cl -> info.ptr = (void*)bigint;
92−
64+ VAL cl = allocBig();
65+ mpz_init_set_ui(*big(cl), val);
9366 return cl;
9467}
9568
9669VAL MKBIGSI(VM* vm, signed long val) {
97− idris_requireAlloc(IDRIS_MAXGMP);
98−
99− mpz_t* bigint;
100− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
101− idris_doneAlloc();
102− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
103−
104− mpz_init_set_si(*bigint, val);
105−
106− SETTY(cl, CT_BIGINT);
107− cl -> info.ptr = (void*)bigint;
108−
70+ VAL cl = allocBig();
71+ mpz_init_set_si(*big(cl), val);
10972 return cl;
11073}
11174
11275VAL GETBIG(VM * vm, VAL x) {
113− idris_requireAlloc(IDRIS_MAXGMP);
114−
11576 if (ISINT(x)) {
116− mpz_t* bigint;
117− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
118− idris_doneAlloc();
119− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
120−
121− mpz_init(*bigint);
122− mpz_set_si(*bigint, GETINT(x));
123−
124− SETTY(cl, CT_BIGINT);
125− cl -> info.ptr = (void*)bigint;
126−
77+ VAL cl = allocBig();
78+ mpz_set_si(*big(cl), GETINT(x));
12779 return cl;
12880 } else {
129− idris_doneAlloc();
13081 switch(GETTY(x)) {
13182 case CT_FWD:
13283 return GETBIG(vm, x->info.ptr);
@@ -137,133 +88,63 @@ VAL GETBIG(VM * vm, VAL x) {
13788}
13889
13990VAL bigAdd(VM* vm, VAL x, VAL y) {
140− idris_requireAlloc(IDRIS_MAXGMP);
141−
142− mpz_t* bigint;
143− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
144− idris_doneAlloc();
145− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
146− mpz_add(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
147− SETTY(cl, CT_BIGINT);
148− cl -> info.ptr = (void*)bigint;
91+ VAL cl = allocBig();
92+ mpz_add(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
14993 return cl;
15094}
15195
15296VAL bigSub(VM* vm, VAL x, VAL y) {
153− idris_requireAlloc(IDRIS_MAXGMP);
154−
155− mpz_t* bigint;
156− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
157− idris_doneAlloc();
158− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
159− mpz_sub(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
160− SETTY(cl, CT_BIGINT);
161− cl -> info.ptr = (void*)bigint;
97+ VAL cl = allocBig();
98+ mpz_sub(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
16299 return cl;
163100}
164101
165102VAL bigMul(VM* vm, VAL x, VAL y) {
166− idris_requireAlloc(IDRIS_MAXGMP);
167−
168− mpz_t* bigint;
169− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
170− idris_doneAlloc();
171− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
172− mpz_mul(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
173− SETTY(cl, CT_BIGINT);
174− cl -> info.ptr = (void*)bigint;
103+ VAL cl = allocBig();
104+ mpz_mul(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
175105 return cl;
176106}
177107
178108VAL bigDiv(VM* vm, VAL x, VAL y) {
179− idris_requireAlloc(IDRIS_MAXGMP);
180−
181− mpz_t* bigint;
182− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
183− idris_doneAlloc();
184− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
185− mpz_tdiv_q(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
186− SETTY(cl, CT_BIGINT);
187− cl -> info.ptr = (void*)bigint;
109+ VAL cl = allocBig();
110+ mpz_tdiv_q(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
188111 return cl;
189112}
190113
191114VAL bigMod(VM* vm, VAL x, VAL y) {
192− idris_requireAlloc(IDRIS_MAXGMP);
193−
194− mpz_t* bigint;
195− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
196− idris_doneAlloc();
197− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
198− mpz_tdiv_r(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
199− SETTY(cl, CT_BIGINT);
200− cl -> info.ptr = (void*)bigint;
115+ VAL cl = allocBig();
116+ mpz_tdiv_r(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
201117 return cl;
202118}
203119
204120VAL bigAnd(VM* vm, VAL x, VAL y) {
205− idris_requireAlloc(IDRIS_MAXGMP);
206−
207− mpz_t* bigint;
208− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
209− idris_doneAlloc();
210− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
211− mpz_and(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
212− SETTY(cl, CT_BIGINT);
213− cl -> info.ptr = (void*)bigint;
121+ VAL cl = allocBig();
122+ mpz_and(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
214123 return cl;
215124}
216125
217126VAL bigOr(VM* vm, VAL x, VAL y) {
218− idris_requireAlloc(IDRIS_MAXGMP);
219−
220− mpz_t* bigint;
221− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
222− idris_doneAlloc();
223− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
224− mpz_ior(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
225− SETTY(cl, CT_BIGINT);
226− cl -> info.ptr = (void*)bigint;
127+ VAL cl = allocBig();
128+ mpz_ior(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
227129 return cl;
228130}
229131
230132VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
231− idris_requireAlloc(IDRIS_MAXGMP);
232−
233− mpz_t* bigint;
234− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
235− idris_doneAlloc();
236− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
237− mpz_mul_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));
238− SETTY(cl, CT_BIGINT);
239− cl -> info.ptr = (void*)bigint;
133+ VAL cl = allocBig();
134+ mpz_mul_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
240135 return cl;
241136}
242137
243138
244139VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
245− idris_requireAlloc(IDRIS_MAXGMP);
246−
247− mpz_t* bigint;
248− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
249− idris_doneAlloc();
250− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
251− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));
252− SETTY(cl, CT_BIGINT);
253− cl -> info.ptr = (void*)bigint;
140+ VAL cl = allocBig();
141+ mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
254142 return cl;
255143}
256144
257145VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
258− idris_requireAlloc(IDRIS_MAXGMP);
259−
260− mpz_t* bigint;
261− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
262− idris_doneAlloc();
263− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
264− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));
265− SETTY(cl, CT_BIGINT);
266− cl -> info.ptr = (void*)bigint;
146+ VAL cl = allocBig();
147+ mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
267148 return cl;
268149}
269150
@@ -382,8 +263,8 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {
382263
383264int bigEqConst(VAL x, int c) {
384265 if (ISINT(x)) { return (GETINT(x) == c); }
385− else {
386− int rv = mpz_cmp_si(GETMPZ(x), c);
266+ else {
267+ int rv = mpz_cmp_si(GETMPZ(x), c);
387268 return (rv == 0);
388269 }
389270}
@@ -471,16 +352,8 @@ VAL idris_castBigFloat(VM* vm, VAL i) {
471352
472353VAL idris_castFloatBig(VM* vm, VAL f) {
473354 double val = GETFLOAT(f);
474−
475− mpz_t* bigint;
476− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
477− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
478−
479− mpz_init_set_d(*bigint, val);
480−
481− SETTY(cl, CT_BIGINT);
482− cl -> info.ptr = (void*)bigint;
483−
355+ VAL cl = allocBig();
356+ mpz_init_set_d(*big(cl), val);
484357 return cl;
485358}
486359
rts/idris_heap.c+4−4
@@ -186,16 +186,16 @@ void heap_check_pointers(Heap * heap) {
186186
187187 size_t item_size = 0;
188188 for(scan = heap->heap; scan < heap->next; scan += item_size) {
189− item_size = *((size_t*)scan);
190− VAL heap_item = (VAL)(scan + sizeof(size_t));
189+ VAL heap_item = (VAL)scan;
190+ item_size = aligned(valSize(heap_item));
191191
192192 switch(GETTY(heap_item)) {
193193 case CT_CON:
194194 {
195− int ar = ARITY(heap_item);
195+ int ar = CARITY(heap_item);
196196 int i = 0;
197197 for(i = 0; i < ar; ++i) {
198− VAL ptr = heap_item->info.cargs[i];
198+ VAL ptr = heap_item->extra.cargs[i];
199199
200200 if (is_valid_ref(ptr)) {
201201 // Check for closure.
rts/idris_rts.c+80−93
@@ -189,13 +189,13 @@ void idris_doneAlloc(void) {
189189}
190190
191191int space(VM* vm, size_t size) {
192− return (vm->heap.next + size + sizeof(size_t) < vm->heap.end);
192+ return (vm->heap.next + size) < vm->heap.end;
193193}
194194
195195void* idris_alloc(size_t size) {
196196 Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);
197197 SETTY(cl, CT_RAWDATA);
198− cl->sz = size;
198+ cl->extrasz = size;
199199 return (void*)(cl+1);
200200}
201201
@@ -208,8 +208,9 @@ void* idris_realloc(void* old, size_t old_size, size_t size) {
208208void idris_free(void* ptr, size_t size) {
209209}
210210
211−void* allocate(size_t size, int outerlock) {
211+void* allocate(size_t isize, int outerlock) {
212212// return malloc(size);
213+ size_t size = aligned(isize);
213214
214215#ifdef HAS_PTHREAD
215216 VM* vm = pthread_getspecific(vm_key);
@@ -222,16 +223,10 @@ void* allocate(size_t size, int outerlock) {
222223 VM* vm = global_vm;
223224#endif
224225
225− size += 7;
226− size &= ~7;
227−
228− size_t chunk_size = size + sizeof(size_t);
229−
230− if (vm->heap.next + chunk_size < vm->heap.end) {
231− STATS_ALLOC(vm->stats, chunk_size)
232− void* ptr = (void*)(vm->heap.next + sizeof(size_t));
233− *((size_t*)(vm->heap.next)) = chunk_size;
234− vm->heap.next += chunk_size;
226+ if (vm->heap.next + size < vm->heap.end) {
227+ STATS_ALLOC(vm->stats, size)
228+ char* ptr = vm->heap.next;
229+ vm->heap.next += size;
235230
236231 assert(vm->heap.next <= vm->heap.end);
237232
@@ -241,7 +236,7 @@ void* allocate(size_t size, int outerlock) {
241236 pthread_mutex_unlock(&vm->alloc_lock);
242237 }
243238#endif
244− return ptr;
239+ return (void*)ptr;
245240 } else {
246241 // If we're trying to allocate something bigger than the heap,
247242 // grow the heap here so that the new heap is big enough.
@@ -259,16 +254,12 @@ void* allocate(size_t size, int outerlock) {
259254
260255}
261256
262−static size_t szMax(ssize_t a, ssize_t b) {
263− return a > b? a : b;
264−}
265−
266257static Closure * allocStr(size_t len, int outer) {
267− size_t sz = szMax(len + 1 - 8, 0);
268− Closure * cl = allocate(sizeof(*cl) + sz, outer);
269− SETTY(cl, CT_STRING);
270− cl->sz = len;
271− return cl;
258+ Closure * cl = allocate(sizeof(Closure) + len + 1, outer);
259+ SETTY(cl, CT_STRING);
260+ cl->extrasz = len + 1;
261+ cl->info.slen = len;
262+ return cl;
272263}
273264
274265/* Now a macro
@@ -293,8 +284,9 @@ VAL MKFLOAT(VM* vm, double val) {
293284
294285VAL MKSTRlen(VM* vm, const char * str, size_t len) {
295286 Closure* cl = allocStr(len, 0);
296− memcpy(cl->info.str, str, len);
297− cl->flag = str == NULL;
287+ memcpy(cl->extra.str, str, len);
288+ if (str == NULL)
289+ cl->info.slen = ~0;
298290 return cl;
299291}
300292
@@ -304,13 +296,13 @@ VAL MKSTR(VM* vm, const char* str) {
304296
305297char* GETSTROFF(VAL stroff) {
306298 // Assume STROFF
307− return stroff->info.str_offset->info.str + stroff->sz;
299+ return stroff->extra.basestr[0]->extra.str + stroff->info.soffset;
308300}
309301
310302size_t GETSTROFFLEN(VAL stroff) {
311303 // Assume STROFF
312304 // we're working in char* here so no worries about utf8 char length
313− return stroff->info.str_offset->sz - stroff->sz;
305+ return stroff->extra.basestr[0]->info.slen - stroff->info.soffset;
314306}
315307
316308VAL MKCDATA(VM* vm, CHeapItem * item) {
@@ -339,8 +331,8 @@ VAL MKPTR(VM* vm, void* ptr) {
339331VAL MKMPTR(VM* vm, void* ptr, size_t size) {
340332 Closure* cl = allocate(sizeof(Closure) + size, 0);
341333 SETTY(cl, CT_MANAGEDPTR);
342− memcpy(cl->info.mptr, ptr, size);
343− cl->sz = size;
334+ memcpy(cl->extra.mptr, ptr, size);
335+ cl->extrasz = size;
344336 return cl;
345337}
346338
@@ -353,7 +345,7 @@ VAL MKFLOATc(VM* vm, double val) {
353345
354346VAL MKSTRclen(VM* vm, char* str, size_t len) {
355347 Closure* cl = allocStr(len, 1);
356− memcpy(cl->info.str, str, len);
348+ memcpy(cl->extra.str, str, len);
357349 return cl;
358350}
359351
@@ -371,8 +363,8 @@ VAL MKPTRc(VM* vm, void* ptr) {
371363VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
372364 Closure* cl = allocate(sizeof(Closure) + size, 1);
373365 SETTY(cl, CT_MANAGEDPTR);
374− memcpy(cl->info.mptr, ptr, size);
375− cl->sz = size;
366+ memcpy(cl->extra.mptr, ptr, size);
367+ cl->extrasz = size;
376368 return cl;
377369}
378370
@@ -437,17 +429,17 @@ void dumpVal(VAL v) {
437429 switch(GETTY(v)) {
438430 case CT_CON:
439431 printf("%d[", (int)TAG(v));
440− for(i = 0; i < ARITY(v); ++i) {
441− dumpVal(v->info.cargs[i]);
432+ for(i = 0; i < CARITY(v); ++i) {
433+ dumpVal(v->extra.cargs[i]);
442434 }
443435 printf("] ");
444436 break;
445437 case CT_STRING:
446− printf("STR[%s]", v->info.str);
438+ printf("STR[%s]", v->extra.str);
447439 break;
448440 case CT_STROFFSET:
449441 printf("OFFSET[");
450− dumpVal((VAL)(v->info.str_offset));
442+ dumpVal((VAL)(v->extra.basestr[0]));
451443 printf("]");
452444 break;
453445 case CT_FWD:
@@ -509,7 +501,7 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i
509501VAL idris_castIntStr(VM* vm, VAL i) {
510502 int x = (int) GETINT(i);
511503 Closure* cl = allocStr(16, 0);
512− cl->sz = sprintf(cl->info.str, "%d", x);
504+ cl->info.slen = sprintf(cl->extra.str, "%d", x);
513505 return cl;
514506}
515507
@@ -521,22 +513,22 @@ VAL idris_castBitsStr(VM* vm, VAL i) {
521513 case CT_BITS8:
522514 // max length 8 bit unsigned int str 3 chars (256)
523515 cl = allocStr(4, 0);
524− cl->sz = sprintf(cl->info.str, "%" PRIu8, GETBITS8(i));
516+ cl->info.slen = sprintf(cl->extra.str, "%" PRIu8, GETBITS8(i));
525517 break;
526518 case CT_BITS16:
527519 // max length 16 bit unsigned int str 5 chars (65,535)
528520 cl = allocStr(6, 0);
529− cl->sz = sprintf(cl->info.str, "%" PRIu16, GETBITS16(i));
521+ cl->info.slen = sprintf(cl->extra.str, "%" PRIu16, GETBITS16(i));
530522 break;
531523 case CT_BITS32:
532524 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
533525 cl = allocStr(11, 0);
534− cl->sz = sprintf(cl->info.str, "%" PRIu32, GETBITS32(i));
526+ cl->info.slen = sprintf(cl->extra.str, "%" PRIu32, GETBITS32(i));
535527 break;
536528 case CT_BITS64:
537529 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
538530 cl = allocStr(21, 0);
539− cl->sz = sprintf(cl->info.str, "%" PRIu64, GETBITS64(i));
531+ cl->info.slen = sprintf(cl->extra.str, "%" PRIu64, GETBITS64(i));
540532 break;
541533 default:
542534 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
@@ -556,7 +548,7 @@ VAL idris_castStrInt(VM* vm, VAL i) {
556548
557549VAL idris_castFloatStr(VM* vm, VAL i) {
558550 Closure* cl = allocStr(32, 0);
559− cl->sz = snprintf(cl->info.str, 32, "%.16g", GETFLOAT(i));
551+ cl->info.slen = snprintf(cl->extra.str, 32, "%.16g", GETFLOAT(i));
560552 return cl;
561553}
562554
@@ -571,8 +563,8 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
571563 size_t rlen = GETSTRLEN(r);
572564
573565 Closure* cl = allocStr(llen + rlen, 0);
574− memcpy(cl->info.str, ls, llen);
575− memcpy(cl->info.str + llen, rs, rlen);
566+ memcpy(cl->extra.str, ls, llen);
567+ memcpy(cl->extra.str + llen, rs, rlen);
576568 return cl;
577569}
578570
@@ -634,12 +626,11 @@ VAL idris_strHead(VM* vm, VAL str) {
634626 return idris_strIndex(vm, str, 0);
635627}
636628
637−VAL MKSTROFFc(VM* vm, VAL off) {
638− Closure* cl = allocate(sizeof(Closure), 1);
629+VAL MKSTROFFc(VM* vm, VAL basestr) {
630+ Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 1);
639631 SETTY(cl, CT_STROFFSET);
640− cl->info.str_offset = off->info.str_offset;
641− cl->sz = off->sz;
642−
632+ cl->extrasz = sizeof(VAL);
633+ cl->extra.basestr[0] = basestr;
643634 return cl;
644635}
645636
@@ -647,22 +638,20 @@ VAL idris_strShift(VM* vm, VAL str, int num) {
647638 // If there's no room, just copy the string, or we'll have a problem after
648639 // gc moves str
649640 if (space(vm, sizeof(Closure))) {
650− Closure* cl = allocate(sizeof(Closure), 0);
651− SETTY(cl, CT_STROFFSET);
652− cl->info.str_offset = cl->info.str_offset;
653−
654641 int offset = 0;
655642 VAL root = str;
643+ Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 0);
644+ SETTY(cl, CT_STROFFSET);
645+ cl->extrasz = sizeof(VAL);
656646
657647 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
658648 // In theory, at most one step here!
659− offset += root->sz;
660− root = root->info.str_offset;
649+ offset += root->info.soffset;
650+ root = root->extra.basestr[0];
661651 }
662652
663− cl->info.str_offset = root;
664− cl->sz = offset+idris_utf8_findOffset(GETSTR(str), num);
665−
653+ cl->extra.basestr[0] = root;
654+ cl->info.soffset = offset+idris_utf8_findOffset(GETSTR(str), num);
666655 return cl;
667656 } else {
668657 char* nstr = GETSTR(str);
@@ -681,16 +670,16 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {
681670
682671 if (xval < 0x80) { // ASCII char
683672 Closure* cl = allocStr(xlen + 1, 0);
684− cl->info.str[0] = (char)(GETINT(x));
685− memcpy(cl->info.str+1, xstr, xlen);
673+ cl->extra.str[0] = (char)(GETINT(x));
674+ memcpy(cl->extra.str+1, xstr, xlen);
686675 return cl;
687676 } else {
688677 char *init = idris_utf8_fromChar(xval);
689678 size_t ilen = strlen(init);
690679 int newlen = ilen + xlen;
691680 Closure* cl = allocStr(newlen, 0);
692− memcpy(cl->info.str, init, ilen);
693− memcpy(cl->info.str + ilen, xstr, xlen);
681+ memcpy(cl->extra.str, init, ilen);
682+ memcpy(cl->extra.str + ilen, xstr, xlen);
694683 free(init);
695684 return cl;
696685 }
@@ -715,8 +704,8 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {
715704 char *end = idris_utf8_advance(start, length_val);
716705 size_t sz = end - start;
717706 Closure* newstr = allocStr(sz, 0);
718− memcpy(newstr->info.str, start, sz);
719− newstr->info.str[sz] = '\0';
707+ memcpy(newstr->extra.str, start, sz);
708+ newstr->extra.str[sz] = '\0';
720709 return newstr;
721710 }
722711}
@@ -726,7 +715,7 @@ VAL idris_strRev(VM* vm, VAL str) {
726715 size_t xlen = GETSTRLEN(str);
727716
728717 Closure* cl = allocStr(xlen, 0);
729− idris_utf8_rev(xstr, cl->info.str);
718+ idris_utf8_rev(xstr, cl->extra.str);
730719 return cl;
731720}
732721
@@ -755,17 +744,17 @@ VAL idris_newArray(VM* vm, int size, VAL def) {
755744 int i;
756745 allocArray(cl, vm, size, 0);
757746 for(i=0; i<size; ++i) {
758− cl->info.array[i] = def;
747+ cl->extra.array[i] = def;
759748 }
760749 return cl;
761750}
762751
763752void idris_arraySet(VAL arr, int index, VAL newval) {
764− arr->info.array[index] = newval;
753+ arr->extra.array[index] = newval;
765754}
766755
767756VAL idris_arrayGet(VAL arr, int index) {
768− return arr->info.array[index];
757+ return arr->extra.array[index];
769758}
770759
771760VAL idris_systemInfo(VM* vm, VAL index) {
@@ -846,11 +835,19 @@ void* idris_stopThread(VM* vm) {
846835 return NULL;
847836}
848837
838+static VAL doCopyTo(VM* vm, VAL x);
839+
840+static void copyArray(VM* vm, VAL * dst, VAL * src, size_t len) {
841+ size_t i;
842+ for(i = 0; i < len; ++i)
843+ dst[i] = doCopyTo(vm, src[i]);
844+}
845+
846+
849847// VM is assumed to be a different vm from the one x lives on
850848
851−VAL doCopyTo(VM* vm, VAL x) {
852− int i, ar, len;
853− VAL* argptr;
849+static VAL doCopyTo(VM* vm, VAL x) {
850+ int ar, len;
854851 Closure* cl;
855852 if (x==NULL || ISINT(x)) {
856853 return x;
@@ -862,41 +859,31 @@ VAL doCopyTo(VM* vm, VAL x) {
862859 cl = x;
863860 } else {
864861 allocCon(cl, vm, CTAG(x), ar, 1);
865−
866− argptr = cl->info.cargs;
867− for(i = 0; i < ar; ++i) {
868− *argptr = doCopyTo(vm, x->info.cargs[i]); // recursive version
869− argptr++;
870− }
862+ copyArray(vm, cl->extra.cargs, x->extra.cargs, ar);
871863 }
872864 break;
873865 case CT_ARRAY:
874− len = x->sz;
866+ len = CELEM(x);
875867 allocArray(cl, vm, len, 1);
876−
877− argptr = cl->info.array;
878− for(i = 0; i < len; ++i) {
879− *argptr = doCopyTo(vm, x->info.array[i]); // recursive version
880− argptr++;
881− }
868+ copyArray(vm, cl->extra.array, x->extra.array, len);
882869 break;
883870 case CT_FLOAT:
884− cl = MKFLOATc(vm, x->info.f);
871+ cl = MKFLOATc(vm, GETFLOAT(x));
885872 break;
886873 case CT_STRING:
887− cl = MKSTRc(vm, x->info.str);
874+ cl = MKSTRclen(vm, x->extra.str, getstrlen(x));
888875 break;
889876 case CT_BIGINT:
890− cl = MKBIGMc(vm, x->info.ptr);
877+ cl = MKBIGMc(vm, GETPTR(x));
891878 break;
892879 case CT_PTR:
893− cl = MKPTRc(vm, x->info.ptr);
880+ cl = MKPTRc(vm, GETPTR(x));
894881 break;
895882 case CT_MANAGEDPTR:
896− cl = MKMPTRc(vm, x->info.mptr, x->sz);
883+ cl = MKMPTRc(vm, x->extra.mptr, x->extrasz);
897884 break;
898885 case CT_CDATA:
899− cl = MKCDATAc(vm, x->info.c_heap_item);
886+ cl = MKCDATAc(vm, GETCDATA(x));
900887 break;
901888 case CT_BITS8:
902889 cl = idris_b8CopyForGC(vm, x);
@@ -912,7 +899,7 @@ VAL doCopyTo(VM* vm, VAL x) {
912899 break;
913900 case CT_RAWDATA:
914901 {
915− size_t size = x->sz + sizeof(Closure);
902+ size_t size = sizeof(Closure) + x->extrasz;
916903 cl = allocate(size, 0);
917904 memcpy(cl, x, size);
918905 }
@@ -1148,9 +1135,9 @@ void init_nullaries(void) {
11481135 VAL cl;
11491136 nullary_cons = malloc(256 * sizeof(VAL));
11501137 for(i = 0; i < 256; ++i) {
1151− cl = malloc(sizeof(Closure));
1138+ cl = calloc(1, sizeof(Closure));
11521139 SETTY(cl, CT_CON);
1153− cl->sz = i << 8;
1140+ cl->info.tag = i;
11541141 nullary_cons[i] = cl;
11551142 }
11561143}
rts/idris_rts.h+49−34
@@ -34,29 +34,27 @@ typedef struct Closure *VAL;
3434
3535typedef struct Closure {
3636 uint64_t ty:8;
37−// True for null strings. Might be useful at some point for other types.
38− uint64_t flag:1;
39− uint64_t sz:55;
37+ uint64_t extrasz:56;
4038 union {
41−// A constructor, consisting of a tag (encoded in the sz field),
42−// an arity (encoded in 8 bits in the sz field), and arguments
43− VAL cargs[0];
44−// An array; similar to a constructor but with a length, and contents
45−// initialised to NULL (high level Idris programs are responsible for
46−// initialising them properly)
47− VAL array[0];
39+ uint32_t tag;
40+ size_t slen;
41+ size_t soffset;
4842 int i;
4943 double f;
50− VAL str_offset;
5144 void * ptr;
52− char str[0];
5345 uint8_t bits8;
5446 uint16_t bits16;
5547 uint32_t bits32;
5648 uint64_t bits64;
57− char mptr[0]; // A foreign pointer, managed by the idris GC
5849 CHeapItem* c_heap_item;
5950 } info;
51+ union {
52+ VAL array[0];
53+ VAL cargs[0];
54+ VAL basestr[0];
55+ char str[0];
56+ char mptr[0]; // A foreign pointer, managed by the idris GC
57+ } extra;
6058} Closure;
6159
6260struct VM;
@@ -167,13 +165,17 @@ typedef void(*func)(VM*, VAL*);
167165
168166// Retrieving values
169167static inline char * getstr(VAL x) {
170− return x->flag? NULL : x->info.str;
168+ return x->info.slen == ~0? NULL : x->extra.str;
169+}
170+
171+static inline size_t getstrlen(VAL x) {
172+ return x->info.slen == ~0? 0 : x->info.slen;
171173}
172174
173175#define GETSTR(x) (ISSTR(x) ? getstr((VAL)(x)) : GETSTROFF(x))
174−#define GETSTRLEN(x) (ISSTR(x) ? ((VAL)(x))->sz : GETSTROFFLEN(x))
176+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((VAL)(x)) : GETSTROFFLEN(x))
175177#define GETPTR(x) (((VAL)(x))->info.ptr)
176−#define GETMPTR(x) (((VAL)(x))->info.mptr)
178+#define GETMPTR(x) (((VAL)(x))->extra.mptr)
177179#define GETFLOAT(x) (((VAL)(x))->info.f)
178180#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)
179181
@@ -183,12 +185,13 @@ static inline char * getstr(VAL x) {
183185#define GETBITS64(x) (((VAL)(x))->info.bits64)
184186
185187// Already checked it's a CT_CON
186−#define CTAG(x) (((x)->sz) >> 8)
187−#define CARITY(x) (((x)->sz) & 0xff)
188+#define CTAG(x) ((x)->info.tag)
189+#define CARITY(x) (((x)->extrasz) / sizeof(VAL))
188190
189191#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG(x) : (-1)) )
190192#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY(x) : (-1)) )
191193
194+#define CELEM(x) (((x)->extrasz) / sizeof(VAL))
192195
193196#define GETTY(x) ((x)->ty)
194197#define SETTY(x,t) ((x)->ty = t)
@@ -248,7 +251,7 @@ VAL MKCDATA(VM* vm, CHeapItem * item);
248251
249252// following versions don't take a lock when allocating
250253VAL MKFLOATc(VM* vm, double val);
251−VAL MKSTROFFc(VM* vm, VAL off);
254+VAL MKSTROFFc(VM* vm, VAL basestr);
252255VAL MKSTRc(VM* vm, char* str);
253256VAL MKSTRclen(VM* vm, char* str, size_t len);
254257VAL MKPTRc(VM* vm, void* ptr);
@@ -258,11 +261,11 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);
258261char* GETSTROFF(VAL stroff);
259262size_t GETSTROFFLEN(VAL stroff);
260263
261−#define SETARG(x, i, a) ((x)->info.cargs)[i] = ((VAL)(a))
262−#define GETARG(x, i) ((x)->info.cargs[i])
264+#define SETARG(x, i, a) ((x)->extra.cargs)[i] = ((VAL)(a))
265+#define GETARG(x, i) ((x)->extra.cargs[i])
263266
264267#define PROJECT(vm,r,loc,num) \
265− memcpy(&(LOC(loc)), (r)->info.cargs, sizeof(VAL)*num)
268+ memcpy(&(LOC(loc)), (r)->extra.cargs, sizeof(VAL)*num)
266269#define SLIDE(vm, args) \
267270 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
268271
@@ -285,25 +288,29 @@ void* idris_alloc(size_t size);
285288void* idris_realloc(void* old, size_t old_size, size_t size);
286289void idris_free(void* ptr, size_t size);
287290
288−#define allocCon(cl, vm, t, a, o) do { \
289− cl = allocate(sizeof(Closure) + sizeof(VAL)*a, o); \
290− SETTY(cl, CT_CON); \
291− cl->sz = ((t) << 8) | (a); \
291+#define allocCon(cl, vm, t, a, o) do { \
292+ size_t sz = sizeof(VAL)*a; \
293+ cl = allocate(sizeof(Closure) + sz, o); \
294+ SETTY(cl, CT_CON); \
295+ cl->info.tag = t; \
296+ cl->extrasz = sz; \
292297 } while (0)
293298
294−#define updateCon(cl, old, t, a) do { \
295− cl = old; \
296− SETTY(cl, CT_CON); \
297− cl->sz = ((t) << 8) | (a); \
299+#define updateCon(cl, old, t, a) do { \
300+ cl = old; \
301+ SETTY(cl, CT_CON); \
302+ cl->info.tag = t; \
303+ cl->extrasz = sizeof(VAL)*a; \
298304 } while (0)
299305
300306
301307#define NULL_CON(x) nullary_cons[x]
302308
303−#define allocArray(cl, vm, len, o) do { \
304− cl = allocate(sizeof(Closure) + sizeof(VAL)*len, o); \
305− SETTY(cl, CT_ARRAY); \
306− cl->sz = len; \
309+#define allocArray(cl, vm, len, o) do { \
310+ size_t sz = sizeof(VAL)*len; \
311+ cl = allocate(sizeof(Closure) + sz, o); \
312+ SETTY(cl, CT_ARRAY); \
313+ cl->extrasz = sz; \
307314 } while (0)
308315
309316int idris_errno(void);
@@ -441,4 +448,12 @@ void stackOverflow(void);
441448
442449#include "idris_gmp.h"
443450
451+static inline size_t valSize(VAL v) {
452+ return sizeof(Closure) + v->extrasz;
453+}
454+
455+static inline size_t aligned(size_t sz) {
456+ return (sz + 7) & ~7;
457+}
458+
444459#endif