git.iko.soy/Idris-dev
on master help sign in
Heap allocations no longer preceded by allocation size field
5ff3350Jorge Acereda
rts/idris_gc.c+18−20
compare with master
unifiedsplit
@@ -17,22 +17,22 @@ VAL copy(VM* vm, VAL x) {
17 return x;
17 return x;
18 } else {
18 } else {
19 allocCon(cl, vm, CTAG(x), ar, 1);
19 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);
21 }
21 }
22 break;
22 break;
23 case CT_ARRAY:
23 case CT_ARRAY:
24− len = x->sz;
24+ len = CELEM(x);
25 allocArray(cl, vm, len, 1);
25 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));
27 break;
27 break;
28 case CT_FLOAT:
28 case CT_FLOAT:
29 cl = MKFLOATc(vm, GETFLOAT(x));
29 cl = MKFLOATc(vm, GETFLOAT(x));
30 break;
30 break;
31 case CT_STRING:
31 case CT_STRING:
32− cl = MKSTRclen(vm, x->info.str, x->sz);
32+ cl = MKSTRclen(vm, getstr(x), getstrlen(x));
33 break;
33 break;
34 case CT_STROFFSET:
34 case CT_STROFFSET:
35− cl = MKSTROFFc(vm, x->info.str_offset);
35+ cl = MKSTROFFc(vm, x->extra.basestr[0]);
36 break;
36 break;
37 case CT_BIGINT:
37 case CT_BIGINT:
38 cl = MKBIGMc(vm, GETPTR(x));
38 cl = MKBIGMc(vm, GETPTR(x));
@@ -41,7 +41,7 @@ VAL copy(VM* vm, VAL x) {
41 cl = MKPTRc(vm, GETPTR(x));
41 cl = MKPTRc(vm, GETPTR(x));
42 break;
42 break;
43 case CT_MANAGEDPTR:
43 case CT_MANAGEDPTR:
44− cl = MKMPTRc(vm, x->info.mptr, x->sz);
44+ cl = MKMPTRc(vm, x->extra.mptr, x->extrasz);
45 break;
45 break;
46 case CT_BITS8:
46 case CT_BITS8:
47 cl = idris_b8CopyForGC(vm, x);
47 cl = idris_b8CopyForGC(vm, x);
@@ -62,7 +62,7 @@ VAL copy(VM* vm, VAL x) {
62 return GETPTR(x);
62 return GETPTR(x);
63 case CT_RAWDATA:
63 case CT_RAWDATA:
64 {
64 {
65− size_t size = x->sz + sizeof(Closure);
65+ size_t size = sizeof(Closure) + x->extrasz;
66 cl = allocate(size, 1);
66 cl = allocate(size, 1);
67 memcpy(cl, x, size);
67 memcpy(cl, x, size);
68 }
68 }
@@ -80,39 +80,37 @@ VAL copy(VM* vm, VAL x) {
80}
80}
81
81
82void cheney(VM *vm) {
82void cheney(VM *vm) {
83− int i;
83+ size_t i, len;
84− int ar, len;
85 char* scan = aligned_heap_pointer(vm->heap.heap);
84 char* scan = aligned_heap_pointer(vm->heap.heap);
86
85
87 while(scan < vm->heap.next) {
86 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;
90 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
88 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
91 switch(GETTY(heap_item)) {
89 switch(GETTY(heap_item)) {
92 case CT_CON:
90 case CT_CON:
93− ar = ARITY(heap_item);
91+ len = CARITY(heap_item);
94− for(i = 0; i < ar; ++i) {
92+ for(i = 0; i < len; ++i) {
95− VAL newptr = copy(vm, heap_item->info.cargs[i]);
93+ VAL newptr = copy(vm, heap_item->extra.cargs[i]);
96− heap_item->info.cargs[i] = newptr;
94+ heap_item->extra.cargs[i] = newptr;
97 }
95 }
98 break;
96 break;
99 case CT_ARRAY:
97 case CT_ARRAY:
100− len = heap_item->sz;
98+ len = CELEM(heap_item);
101 for(i = 0; i < len; ++i) {
99 for(i = 0; i < len; ++i) {
102− VAL newptr = copy(vm, heap_item->info.array[i]);
100+ VAL newptr = copy(vm, heap_item->extra.array[i]);
103− heap_item->info.array[i] = newptr;
101+ heap_item->extra.array[i] = newptr;
104 }
102 }
105 break;
103 break;
106 case CT_REF:
104 case CT_REF:
107 heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
105 heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
108 break;
106 break;
109 case CT_STROFFSET:
107 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]);
111 break;
109 break;
112 default: // Nothing to copy
110 default: // Nothing to copy
113 break;
111 break;
114 }
112 }
115− scan += inc;
113+ scan += aligned(valSize(heap_item));
116 }
114 }
117 assert(scan == vm->heap.next);
115 assert(scan == vm->heap.next);
118}
116}
rts/idris_gmp.c+53−180
@@ -22,111 +22,62 @@ VAL MKBIGI(int val) {
22 return MKINT((i_int)val);
22 return MKINT((i_int)val);
23}
23}
24
24
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+
25VAL MKBIGC(VM* vm, char* val) {
40VAL MKBIGC(VM* vm, char* val) {
26 if (*val == '\0') {
41 if (*val == '\0') {
27 return MKBIGI(0);
42 return MKBIGI(0);
28 }
43 }
29 else {
44 else {
30− idris_requireAlloc(IDRIS_MAXGMP);
45+ VAL cl = allocBig();
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);
46+ mpz_set_str(*big(cl), val, 10);
39−
40− SETTY(cl, CT_BIGINT);
41− cl -> info.ptr = (void*)bigint;
42−
43 return cl;
47 return cl;
44 }
48 }
45}
49}
46
50
47−VAL MKBIGM(VM* vm, void* big) {
51+VAL MKBIGM(VM* vm, void* ibig) {
48− idris_requireAlloc(IDRIS_MAXGMP);
52+ VAL cl = allocBig();
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));
53+ mpz_set(*big(cl), *((mpz_t*)ibig));
57−
58− SETTY(cl, CT_BIGINT);
59− cl -> info.ptr = (void*)bigint;
60−
61 return cl;
54 return cl;
62}
55}
63
56
64−VAL MKBIGMc(VM* vm, void* big) {
57+VAL MKBIGMc(VM* vm, void* ibig) {
65− idris_requireAlloc(IDRIS_MAXGMP);
58+ VAL cl = allocBig();
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));
59+ mpz_init_set(*big(cl), *((mpz_t*)ibig));
73−
74− SETTY(cl, CT_BIGINT);
75− cl -> info.ptr = (void*)bigint;
76−
77 return cl;
60 return cl;
78}
61}
79
62
80VAL MKBIGUI(VM* vm, unsigned long val) {
63VAL MKBIGUI(VM* vm, unsigned long val) {
81− idris_requireAlloc(IDRIS_MAXGMP);
64+ VAL cl = allocBig();
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);
65+ mpz_init_set_ui(*big(cl), val);
89−
90− SETTY(cl, CT_BIGINT);
91− cl -> info.ptr = (void*)bigint;
92−
93 return cl;
66 return cl;
94}
67}
95
68
96VAL MKBIGSI(VM* vm, signed long val) {
69VAL MKBIGSI(VM* vm, signed long val) {
97− idris_requireAlloc(IDRIS_MAXGMP);
70+ VAL cl = allocBig();
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);
71+ mpz_init_set_si(*big(cl), val);
105−
106− SETTY(cl, CT_BIGINT);
107− cl -> info.ptr = (void*)bigint;
108−
109 return cl;
72 return cl;
110}
73}
111
74
112VAL GETBIG(VM * vm, VAL x) {
75VAL GETBIG(VM * vm, VAL x) {
113− idris_requireAlloc(IDRIS_MAXGMP);
114−
115 if (ISINT(x)) {
76 if (ISINT(x)) {
116− mpz_t* bigint;
77+ VAL cl = allocBig();
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));
78+ mpz_set_si(*big(cl), GETINT(x));
123−
124− SETTY(cl, CT_BIGINT);
125− cl -> info.ptr = (void*)bigint;
126−
127 return cl;
79 return cl;
128 } else {
80 } else {
129− idris_doneAlloc();
130 switch(GETTY(x)) {
81 switch(GETTY(x)) {
131 case CT_FWD:
82 case CT_FWD:
132 return GETBIG(vm, x->info.ptr);
83 return GETBIG(vm, x->info.ptr);
@@ -137,133 +88,63 @@ VAL GETBIG(VM * vm, VAL x) {
137}
88}
138
89
139VAL bigAdd(VM* vm, VAL x, VAL y) {
90VAL bigAdd(VM* vm, VAL x, VAL y) {
140− idris_requireAlloc(IDRIS_MAXGMP);
91+ VAL cl = allocBig();
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)));
92+ mpz_add(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
147− SETTY(cl, CT_BIGINT);
148− cl -> info.ptr = (void*)bigint;
149 return cl;
93 return cl;
150}
94}
151
95
152VAL bigSub(VM* vm, VAL x, VAL y) {
96VAL bigSub(VM* vm, VAL x, VAL y) {
153− idris_requireAlloc(IDRIS_MAXGMP);
97+ VAL cl = allocBig();
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)));
98+ mpz_sub(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
160− SETTY(cl, CT_BIGINT);
161− cl -> info.ptr = (void*)bigint;
162 return cl;
99 return cl;
163}
100}
164
101
165VAL bigMul(VM* vm, VAL x, VAL y) {
102VAL bigMul(VM* vm, VAL x, VAL y) {
166− idris_requireAlloc(IDRIS_MAXGMP);
103+ VAL cl = allocBig();
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)));
104+ mpz_mul(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
173− SETTY(cl, CT_BIGINT);
174− cl -> info.ptr = (void*)bigint;
175 return cl;
105 return cl;
176}
106}
177
107
178VAL bigDiv(VM* vm, VAL x, VAL y) {
108VAL bigDiv(VM* vm, VAL x, VAL y) {
179− idris_requireAlloc(IDRIS_MAXGMP);
109+ VAL cl = allocBig();
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)));
110+ mpz_tdiv_q(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
186− SETTY(cl, CT_BIGINT);
187− cl -> info.ptr = (void*)bigint;
188 return cl;
111 return cl;
189}
112}
190
113
191VAL bigMod(VM* vm, VAL x, VAL y) {
114VAL bigMod(VM* vm, VAL x, VAL y) {
192− idris_requireAlloc(IDRIS_MAXGMP);
115+ VAL cl = allocBig();
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)));
116+ mpz_tdiv_r(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
199− SETTY(cl, CT_BIGINT);
200− cl -> info.ptr = (void*)bigint;
201 return cl;
117 return cl;
202}
118}
203
119
204VAL bigAnd(VM* vm, VAL x, VAL y) {
120VAL bigAnd(VM* vm, VAL x, VAL y) {
205− idris_requireAlloc(IDRIS_MAXGMP);
121+ VAL cl = allocBig();
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)));
122+ mpz_and(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
212− SETTY(cl, CT_BIGINT);
213− cl -> info.ptr = (void*)bigint;
214 return cl;
123 return cl;
215}
124}
216
125
217VAL bigOr(VM* vm, VAL x, VAL y) {
126VAL bigOr(VM* vm, VAL x, VAL y) {
218− idris_requireAlloc(IDRIS_MAXGMP);
127+ VAL cl = allocBig();
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)));
128+ mpz_ior(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
225− SETTY(cl, CT_BIGINT);
226− cl -> info.ptr = (void*)bigint;
227 return cl;
129 return cl;
228}
130}
229
131
230VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
132VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
231− idris_requireAlloc(IDRIS_MAXGMP);
133+ VAL cl = allocBig();
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));
134+ mpz_mul_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
238− SETTY(cl, CT_BIGINT);
239− cl -> info.ptr = (void*)bigint;
240 return cl;
135 return cl;
241}
136}
242
137
243
138
244VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
139VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
245− idris_requireAlloc(IDRIS_MAXGMP);
140+ VAL cl = allocBig();
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));
141+ mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
252− SETTY(cl, CT_BIGINT);
253− cl -> info.ptr = (void*)bigint;
254 return cl;
142 return cl;
255}
143}
256
144
257VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
145VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
258− idris_requireAlloc(IDRIS_MAXGMP);
146+ VAL cl = allocBig();
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));
147+ mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
265− SETTY(cl, CT_BIGINT);
266− cl -> info.ptr = (void*)bigint;
267 return cl;
148 return cl;
268}
149}
269
150
@@ -382,8 +263,8 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {
382
263
383int bigEqConst(VAL x, int c) {
264int bigEqConst(VAL x, int c) {
384 if (ISINT(x)) { return (GETINT(x) == c); }
265 if (ISINT(x)) { return (GETINT(x) == c); }
385− else {
266+ else {
386− int rv = mpz_cmp_si(GETMPZ(x), c);
267+ int rv = mpz_cmp_si(GETMPZ(x), c);
387 return (rv == 0);
268 return (rv == 0);
388 }
269 }
389}
270}
@@ -471,16 +352,8 @@ VAL idris_castBigFloat(VM* vm, VAL i) {
471
352
472VAL idris_castFloatBig(VM* vm, VAL f) {
353VAL idris_castFloatBig(VM* vm, VAL f) {
473 double val = GETFLOAT(f);
354 double val = GETFLOAT(f);
474−
355+ VAL cl = allocBig();
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);
356+ mpz_init_set_d(*big(cl), val);
480−
481− SETTY(cl, CT_BIGINT);
482− cl -> info.ptr = (void*)bigint;
483−
484 return cl;
357 return cl;
485}
358}
486
359
rts/idris_heap.c+4−4
@@ -186,16 +186,16 @@ void heap_check_pointers(Heap * heap) {
186
186
187 size_t item_size = 0;
187 size_t item_size = 0;
188 for(scan = heap->heap; scan < heap->next; scan += item_size) {
188 for(scan = heap->heap; scan < heap->next; scan += item_size) {
189− item_size = *((size_t*)scan);
189+ VAL heap_item = (VAL)scan;
190− VAL heap_item = (VAL)(scan + sizeof(size_t));
190+ item_size = aligned(valSize(heap_item));
191
191
192 switch(GETTY(heap_item)) {
192 switch(GETTY(heap_item)) {
193 case CT_CON:
193 case CT_CON:
194 {
194 {
195− int ar = ARITY(heap_item);
195+ int ar = CARITY(heap_item);
196 int i = 0;
196 int i = 0;
197 for(i = 0; i < ar; ++i) {
197 for(i = 0; i < ar; ++i) {
198− VAL ptr = heap_item->info.cargs[i];
198+ VAL ptr = heap_item->extra.cargs[i];
199
199
200 if (is_valid_ref(ptr)) {
200 if (is_valid_ref(ptr)) {
201 // Check for closure.
201 // Check for closure.
rts/idris_rts.c+80−93
@@ -189,13 +189,13 @@ void idris_doneAlloc(void) {
189}
189}
190
190
191int space(VM* vm, size_t size) {
191int 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;
193}
193}
194
194
195void* idris_alloc(size_t size) {
195void* idris_alloc(size_t size) {
196 Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);
196 Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);
197 SETTY(cl, CT_RAWDATA);
197 SETTY(cl, CT_RAWDATA);
198− cl->sz = size;
198+ cl->extrasz = size;
199 return (void*)(cl+1);
199 return (void*)(cl+1);
200}
200}
201
201
@@ -208,8 +208,9 @@ void* idris_realloc(void* old, size_t old_size, size_t size) {
208void idris_free(void* ptr, size_t size) {
208void idris_free(void* ptr, size_t size) {
209}
209}
210
210
211−void* allocate(size_t size, int outerlock) {
211+void* allocate(size_t isize, int outerlock) {
212// return malloc(size);
212// return malloc(size);
213+ size_t size = aligned(isize);
213
214
214#ifdef HAS_PTHREAD
215#ifdef HAS_PTHREAD
215 VM* vm = pthread_getspecific(vm_key);
216 VM* vm = pthread_getspecific(vm_key);
@@ -222,16 +223,10 @@ void* allocate(size_t size, int outerlock) {
222 VM* vm = global_vm;
223 VM* vm = global_vm;
223#endif
224#endif
224
225
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) {
226+ if (vm->heap.next + size < vm->heap.end) {
231− STATS_ALLOC(vm->stats, chunk_size)
227+ STATS_ALLOC(vm->stats, size)
232− void* ptr = (void*)(vm->heap.next + sizeof(size_t));
233− *((size_t*)(vm->heap.next)) = chunk_size;
228+ char* ptr = vm->heap.next;
234− vm->heap.next += chunk_size;
229+ vm->heap.next += size;
235
230
236 assert(vm->heap.next <= vm->heap.end);
231 assert(vm->heap.next <= vm->heap.end);
237
232
@@ -241,7 +236,7 @@ void* allocate(size_t size, int outerlock) {
241 pthread_mutex_unlock(&vm->alloc_lock);
236 pthread_mutex_unlock(&vm->alloc_lock);
242 }
237 }
243#endif
238#endif
244− return ptr;
239+ return (void*)ptr;
245 } else {
240 } else {
246 // If we're trying to allocate something bigger than the heap,
241 // If we're trying to allocate something bigger than the heap,
247 // grow the heap here so that the new heap is big enough.
242 // grow the heap here so that the new heap is big enough.
@@ -259,16 +254,12 @@ void* allocate(size_t size, int outerlock) {
259
254
260}
255}
261
256
262−static size_t szMax(ssize_t a, ssize_t b) {
263− return a > b? a : b;
264−}
265−
266static Closure * allocStr(size_t len, int outer) {
257static Closure * allocStr(size_t len, int outer) {
267− size_t sz = szMax(len + 1 - 8, 0);
268− Closure * cl = allocate(sizeof(*cl) + sz, outer);
258+ Closure * cl = allocate(sizeof(Closure) + len + 1, outer);
269− SETTY(cl, CT_STRING);
259+ SETTY(cl, CT_STRING);
260+ cl->extrasz = len + 1;
270− cl->sz = len;
261+ cl->info.slen = len;
271− return cl;
262+ return cl;
272}
263}
273
264
274/* Now a macro
265/* Now a macro
@@ -293,8 +284,9 @@ VAL MKFLOAT(VM* vm, double val) {
293
284
294VAL MKSTRlen(VM* vm, const char * str, size_t len) {
285VAL MKSTRlen(VM* vm, const char * str, size_t len) {
295 Closure* cl = allocStr(len, 0);
286 Closure* cl = allocStr(len, 0);
296− memcpy(cl->info.str, str, len);
287+ memcpy(cl->extra.str, str, len);
297− cl->flag = str == NULL;
288+ if (str == NULL)
289+ cl->info.slen = ~0;
298 return cl;
290 return cl;
299}
291}
300
292
@@ -304,13 +296,13 @@ VAL MKSTR(VM* vm, const char* str) {
304
296
305char* GETSTROFF(VAL stroff) {
297char* GETSTROFF(VAL stroff) {
306 // Assume STROFF
298 // Assume STROFF
307− return stroff->info.str_offset->info.str + stroff->sz;
299+ return stroff->extra.basestr[0]->extra.str + stroff->info.soffset;
308}
300}
309
301
310size_t GETSTROFFLEN(VAL stroff) {
302size_t GETSTROFFLEN(VAL stroff) {
311 // Assume STROFF
303 // Assume STROFF
312 // we're working in char* here so no worries about utf8 char length
304 // 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;
314}
306}
315
307
316VAL MKCDATA(VM* vm, CHeapItem * item) {
308VAL MKCDATA(VM* vm, CHeapItem * item) {
@@ -339,8 +331,8 @@ VAL MKPTR(VM* vm, void* ptr) {
339VAL MKMPTR(VM* vm, void* ptr, size_t size) {
331VAL MKMPTR(VM* vm, void* ptr, size_t size) {
340 Closure* cl = allocate(sizeof(Closure) + size, 0);
332 Closure* cl = allocate(sizeof(Closure) + size, 0);
341 SETTY(cl, CT_MANAGEDPTR);
333 SETTY(cl, CT_MANAGEDPTR);
342− memcpy(cl->info.mptr, ptr, size);
334+ memcpy(cl->extra.mptr, ptr, size);
343− cl->sz = size;
335+ cl->extrasz = size;
344 return cl;
336 return cl;
345}
337}
346
338
@@ -353,7 +345,7 @@ VAL MKFLOATc(VM* vm, double val) {
353
345
354VAL MKSTRclen(VM* vm, char* str, size_t len) {
346VAL MKSTRclen(VM* vm, char* str, size_t len) {
355 Closure* cl = allocStr(len, 1);
347 Closure* cl = allocStr(len, 1);
356− memcpy(cl->info.str, str, len);
348+ memcpy(cl->extra.str, str, len);
357 return cl;
349 return cl;
358}
350}
359
351
@@ -371,8 +363,8 @@ VAL MKPTRc(VM* vm, void* ptr) {
371VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
363VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
372 Closure* cl = allocate(sizeof(Closure) + size, 1);
364 Closure* cl = allocate(sizeof(Closure) + size, 1);
373 SETTY(cl, CT_MANAGEDPTR);
365 SETTY(cl, CT_MANAGEDPTR);
374− memcpy(cl->info.mptr, ptr, size);
366+ memcpy(cl->extra.mptr, ptr, size);
375− cl->sz = size;
367+ cl->extrasz = size;
376 return cl;
368 return cl;
377}
369}
378
370
@@ -437,17 +429,17 @@ void dumpVal(VAL v) {
437 switch(GETTY(v)) {
429 switch(GETTY(v)) {
438 case CT_CON:
430 case CT_CON:
439 printf("%d[", (int)TAG(v));
431 printf("%d[", (int)TAG(v));
440− for(i = 0; i < ARITY(v); ++i) {
432+ for(i = 0; i < CARITY(v); ++i) {
441− dumpVal(v->info.cargs[i]);
433+ dumpVal(v->extra.cargs[i]);
442 }
434 }
443 printf("] ");
435 printf("] ");
444 break;
436 break;
445 case CT_STRING:
437 case CT_STRING:
446− printf("STR[%s]", v->info.str);
438+ printf("STR[%s]", v->extra.str);
447 break;
439 break;
448 case CT_STROFFSET:
440 case CT_STROFFSET:
449 printf("OFFSET[");
441 printf("OFFSET[");
450− dumpVal((VAL)(v->info.str_offset));
442+ dumpVal((VAL)(v->extra.basestr[0]));
451 printf("]");
443 printf("]");
452 break;
444 break;
453 case CT_FWD:
445 case CT_FWD:
@@ -509,7 +501,7 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i
509VAL idris_castIntStr(VM* vm, VAL i) {
501VAL idris_castIntStr(VM* vm, VAL i) {
510 int x = (int) GETINT(i);
502 int x = (int) GETINT(i);
511 Closure* cl = allocStr(16, 0);
503 Closure* cl = allocStr(16, 0);
512− cl->sz = sprintf(cl->info.str, "%d", x);
504+ cl->info.slen = sprintf(cl->extra.str, "%d", x);
513 return cl;
505 return cl;
514}
506}
515
507
@@ -521,22 +513,22 @@ VAL idris_castBitsStr(VM* vm, VAL i) {
521 case CT_BITS8:
513 case CT_BITS8:
522 // max length 8 bit unsigned int str 3 chars (256)
514 // max length 8 bit unsigned int str 3 chars (256)
523 cl = allocStr(4, 0);
515 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));
525 break;
517 break;
526 case CT_BITS16:
518 case CT_BITS16:
527 // max length 16 bit unsigned int str 5 chars (65,535)
519 // max length 16 bit unsigned int str 5 chars (65,535)
528 cl = allocStr(6, 0);
520 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));
530 break;
522 break;
531 case CT_BITS32:
523 case CT_BITS32:
532 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
524 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
533 cl = allocStr(11, 0);
525 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));
535 break;
527 break;
536 case CT_BITS64:
528 case CT_BITS64:
537 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
529 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
538 cl = allocStr(21, 0);
530 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));
540 break;
532 break;
541 default:
533 default:
542 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
534 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
@@ -556,7 +548,7 @@ VAL idris_castStrInt(VM* vm, VAL i) {
556
548
557VAL idris_castFloatStr(VM* vm, VAL i) {
549VAL idris_castFloatStr(VM* vm, VAL i) {
558 Closure* cl = allocStr(32, 0);
550 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));
560 return cl;
552 return cl;
561}
553}
562
554
@@ -571,8 +563,8 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
571 size_t rlen = GETSTRLEN(r);
563 size_t rlen = GETSTRLEN(r);
572
564
573 Closure* cl = allocStr(llen + rlen, 0);
565 Closure* cl = allocStr(llen + rlen, 0);
574− memcpy(cl->info.str, ls, llen);
566+ memcpy(cl->extra.str, ls, llen);
575− memcpy(cl->info.str + llen, rs, rlen);
567+ memcpy(cl->extra.str + llen, rs, rlen);
576 return cl;
568 return cl;
577}
569}
578
570
@@ -634,12 +626,11 @@ VAL idris_strHead(VM* vm, VAL str) {
634 return idris_strIndex(vm, str, 0);
626 return idris_strIndex(vm, str, 0);
635}
627}
636
628
637−VAL MKSTROFFc(VM* vm, VAL off) {
629+VAL MKSTROFFc(VM* vm, VAL basestr) {
638− Closure* cl = allocate(sizeof(Closure), 1);
630+ Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 1);
639 SETTY(cl, CT_STROFFSET);
631 SETTY(cl, CT_STROFFSET);
640− cl->info.str_offset = off->info.str_offset;
632+ cl->extrasz = sizeof(VAL);
641− cl->sz = off->sz;
633+ cl->extra.basestr[0] = basestr;
642−
643 return cl;
634 return cl;
644}
635}
645
636
@@ -647,22 +638,20 @@ VAL idris_strShift(VM* vm, VAL str, int num) {
647 // If there's no room, just copy the string, or we'll have a problem after
638 // If there's no room, just copy the string, or we'll have a problem after
648 // gc moves str
639 // gc moves str
649 if (space(vm, sizeof(Closure))) {
640 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−
654 int offset = 0;
641 int offset = 0;
655 VAL root = str;
642 VAL root = str;
643+ Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 0);
644+ SETTY(cl, CT_STROFFSET);
645+ cl->extrasz = sizeof(VAL);
656
646
657 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
647 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
658 // In theory, at most one step here!
648 // In theory, at most one step here!
659− offset += root->sz;
649+ offset += root->info.soffset;
660− root = root->info.str_offset;
650+ root = root->extra.basestr[0];
661 }
651 }
662
652
663− cl->info.str_offset = root;
653+ cl->extra.basestr[0] = root;
664− cl->sz = offset+idris_utf8_findOffset(GETSTR(str), num);
654+ cl->info.soffset = offset+idris_utf8_findOffset(GETSTR(str), num);
665−
666 return cl;
655 return cl;
667 } else {
656 } else {
668 char* nstr = GETSTR(str);
657 char* nstr = GETSTR(str);
@@ -681,16 +670,16 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {
681
670
682 if (xval < 0x80) { // ASCII char
671 if (xval < 0x80) { // ASCII char
683 Closure* cl = allocStr(xlen + 1, 0);
672 Closure* cl = allocStr(xlen + 1, 0);
684− cl->info.str[0] = (char)(GETINT(x));
673+ cl->extra.str[0] = (char)(GETINT(x));
685− memcpy(cl->info.str+1, xstr, xlen);
674+ memcpy(cl->extra.str+1, xstr, xlen);
686 return cl;
675 return cl;
687 } else {
676 } else {
688 char *init = idris_utf8_fromChar(xval);
677 char *init = idris_utf8_fromChar(xval);
689 size_t ilen = strlen(init);
678 size_t ilen = strlen(init);
690 int newlen = ilen + xlen;
679 int newlen = ilen + xlen;
691 Closure* cl = allocStr(newlen, 0);
680 Closure* cl = allocStr(newlen, 0);
692− memcpy(cl->info.str, init, ilen);
681+ memcpy(cl->extra.str, init, ilen);
693− memcpy(cl->info.str + ilen, xstr, xlen);
682+ memcpy(cl->extra.str + ilen, xstr, xlen);
694 free(init);
683 free(init);
695 return cl;
684 return cl;
696 }
685 }
@@ -715,8 +704,8 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {
715 char *end = idris_utf8_advance(start, length_val);
704 char *end = idris_utf8_advance(start, length_val);
716 size_t sz = end - start;
705 size_t sz = end - start;
717 Closure* newstr = allocStr(sz, 0);
706 Closure* newstr = allocStr(sz, 0);
718− memcpy(newstr->info.str, start, sz);
707+ memcpy(newstr->extra.str, start, sz);
719− newstr->info.str[sz] = '\0';
708+ newstr->extra.str[sz] = '\0';
720 return newstr;
709 return newstr;
721 }
710 }
722}
711}
@@ -726,7 +715,7 @@ VAL idris_strRev(VM* vm, VAL str) {
726 size_t xlen = GETSTRLEN(str);
715 size_t xlen = GETSTRLEN(str);
727
716
728 Closure* cl = allocStr(xlen, 0);
717 Closure* cl = allocStr(xlen, 0);
729− idris_utf8_rev(xstr, cl->info.str);
718+ idris_utf8_rev(xstr, cl->extra.str);
730 return cl;
719 return cl;
731}
720}
732
721
@@ -755,17 +744,17 @@ VAL idris_newArray(VM* vm, int size, VAL def) {
755 int i;
744 int i;
756 allocArray(cl, vm, size, 0);
745 allocArray(cl, vm, size, 0);
757 for(i=0; i<size; ++i) {
746 for(i=0; i<size; ++i) {
758− cl->info.array[i] = def;
747+ cl->extra.array[i] = def;
759 }
748 }
760 return cl;
749 return cl;
761}
750}
762
751
763void idris_arraySet(VAL arr, int index, VAL newval) {
752void idris_arraySet(VAL arr, int index, VAL newval) {
764− arr->info.array[index] = newval;
753+ arr->extra.array[index] = newval;
765}
754}
766
755
767VAL idris_arrayGet(VAL arr, int index) {
756VAL idris_arrayGet(VAL arr, int index) {
768− return arr->info.array[index];
757+ return arr->extra.array[index];
769}
758}
770
759
771VAL idris_systemInfo(VM* vm, VAL index) {
760VAL idris_systemInfo(VM* vm, VAL index) {
@@ -846,11 +835,19 @@ void* idris_stopThread(VM* vm) {
846 return NULL;
835 return NULL;
847}
836}
848
837
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+
849// VM is assumed to be a different vm from the one x lives on
847// VM is assumed to be a different vm from the one x lives on
850
848
851−VAL doCopyTo(VM* vm, VAL x) {
849+static VAL doCopyTo(VM* vm, VAL x) {
852− int i, ar, len;
850+ int ar, len;
853− VAL* argptr;
854 Closure* cl;
851 Closure* cl;
855 if (x==NULL || ISINT(x)) {
852 if (x==NULL || ISINT(x)) {
856 return x;
853 return x;
@@ -862,41 +859,31 @@ VAL doCopyTo(VM* vm, VAL x) {
862 cl = x;
859 cl = x;
863 } else {
860 } else {
864 allocCon(cl, vm, CTAG(x), ar, 1);
861 allocCon(cl, vm, CTAG(x), ar, 1);
865−
862+ copyArray(vm, cl->extra.cargs, x->extra.cargs, ar);
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− }
871 }
863 }
872 break;
864 break;
873 case CT_ARRAY:
865 case CT_ARRAY:
874− len = x->sz;
866+ len = CELEM(x);
875 allocArray(cl, vm, len, 1);
867 allocArray(cl, vm, len, 1);
876−
868+ copyArray(vm, cl->extra.array, x->extra.array, len);
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− }
882 break;
869 break;
883 case CT_FLOAT:
870 case CT_FLOAT:
884− cl = MKFLOATc(vm, x->info.f);
871+ cl = MKFLOATc(vm, GETFLOAT(x));
885 break;
872 break;
886 case CT_STRING:
873 case CT_STRING:
887− cl = MKSTRc(vm, x->info.str);
874+ cl = MKSTRclen(vm, x->extra.str, getstrlen(x));
888 break;
875 break;
889 case CT_BIGINT:
876 case CT_BIGINT:
890− cl = MKBIGMc(vm, x->info.ptr);
877+ cl = MKBIGMc(vm, GETPTR(x));
891 break;
878 break;
892 case CT_PTR:
879 case CT_PTR:
893− cl = MKPTRc(vm, x->info.ptr);
880+ cl = MKPTRc(vm, GETPTR(x));
894 break;
881 break;
895 case CT_MANAGEDPTR:
882 case CT_MANAGEDPTR:
896− cl = MKMPTRc(vm, x->info.mptr, x->sz);
883+ cl = MKMPTRc(vm, x->extra.mptr, x->extrasz);
897 break;
884 break;
898 case CT_CDATA:
885 case CT_CDATA:
899− cl = MKCDATAc(vm, x->info.c_heap_item);
886+ cl = MKCDATAc(vm, GETCDATA(x));
900 break;
887 break;
901 case CT_BITS8:
888 case CT_BITS8:
902 cl = idris_b8CopyForGC(vm, x);
889 cl = idris_b8CopyForGC(vm, x);
@@ -912,7 +899,7 @@ VAL doCopyTo(VM* vm, VAL x) {
912 break;
899 break;
913 case CT_RAWDATA:
900 case CT_RAWDATA:
914 {
901 {
915− size_t size = x->sz + sizeof(Closure);
902+ size_t size = sizeof(Closure) + x->extrasz;
916 cl = allocate(size, 0);
903 cl = allocate(size, 0);
917 memcpy(cl, x, size);
904 memcpy(cl, x, size);
918 }
905 }
@@ -1148,9 +1135,9 @@ void init_nullaries(void) {
1148 VAL cl;
1135 VAL cl;
1149 nullary_cons = malloc(256 * sizeof(VAL));
1136 nullary_cons = malloc(256 * sizeof(VAL));
1150 for(i = 0; i < 256; ++i) {
1137 for(i = 0; i < 256; ++i) {
1151− cl = malloc(sizeof(Closure));
1138+ cl = calloc(1, sizeof(Closure));
1152 SETTY(cl, CT_CON);
1139 SETTY(cl, CT_CON);
1153− cl->sz = i << 8;
1140+ cl->info.tag = i;
1154 nullary_cons[i] = cl;
1141 nullary_cons[i] = cl;
1155 }
1142 }
1156}
1143}
rts/idris_rts.h+49−34
@@ -34,29 +34,27 @@ typedef struct Closure *VAL;
34
34
35typedef struct Closure {
35typedef struct Closure {
36 uint64_t ty:8;
36 uint64_t ty:8;
37−// True for null strings. Might be useful at some point for other types.
38− uint64_t flag:1;
37+ uint64_t extrasz:56;
39− uint64_t sz:55;
40 union {
38 union {
41−// A constructor, consisting of a tag (encoded in the sz field),
39+ uint32_t tag;
42−// an arity (encoded in 8 bits in the sz field), and arguments
40+ size_t slen;
43− VAL cargs[0];
41+ size_t soffset;
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];
48 int i;
42 int i;
49 double f;
43 double f;
50− VAL str_offset;
51 void * ptr;
44 void * ptr;
52− char str[0];
53 uint8_t bits8;
45 uint8_t bits8;
54 uint16_t bits16;
46 uint16_t bits16;
55 uint32_t bits32;
47 uint32_t bits32;
56 uint64_t bits64;
48 uint64_t bits64;
57− char mptr[0]; // A foreign pointer, managed by the idris GC
58 CHeapItem* c_heap_item;
49 CHeapItem* c_heap_item;
59 } info;
50 } 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;
60} Closure;
58} Closure;
61
59
62struct VM;
60struct VM;
@@ -167,13 +165,17 @@ typedef void(*func)(VM*, VAL*);
167
165
168// Retrieving values
166// Retrieving values
169static inline char * getstr(VAL x) {
167static 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;
171}
173}
172
174
173#define GETSTR(x) (ISSTR(x) ? getstr((VAL)(x)) : GETSTROFF(x))
175#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))
175#define GETPTR(x) (((VAL)(x))->info.ptr)
177#define GETPTR(x) (((VAL)(x))->info.ptr)
176−#define GETMPTR(x) (((VAL)(x))->info.mptr)
178+#define GETMPTR(x) (((VAL)(x))->extra.mptr)
177#define GETFLOAT(x) (((VAL)(x))->info.f)
179#define GETFLOAT(x) (((VAL)(x))->info.f)
178#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)
180#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)
179
181
@@ -183,12 +185,13 @@ static inline char * getstr(VAL x) {
183#define GETBITS64(x) (((VAL)(x))->info.bits64)
185#define GETBITS64(x) (((VAL)(x))->info.bits64)
184
186
185// Already checked it's a CT_CON
187// Already checked it's a CT_CON
186−#define CTAG(x) (((x)->sz) >> 8)
188+#define CTAG(x) ((x)->info.tag)
187−#define CARITY(x) (((x)->sz) & 0xff)
189+#define CARITY(x) (((x)->extrasz) / sizeof(VAL))
188
190
189#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG(x) : (-1)) )
191#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG(x) : (-1)) )
190#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY(x) : (-1)) )
192#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY(x) : (-1)) )
191
193
194+#define CELEM(x) (((x)->extrasz) / sizeof(VAL))
192
195
193#define GETTY(x) ((x)->ty)
196#define GETTY(x) ((x)->ty)
194#define SETTY(x,t) ((x)->ty = t)
197#define SETTY(x,t) ((x)->ty = t)
@@ -248,7 +251,7 @@ VAL MKCDATA(VM* vm, CHeapItem * item);
248
251
249// following versions don't take a lock when allocating
252// following versions don't take a lock when allocating
250VAL MKFLOATc(VM* vm, double val);
253VAL MKFLOATc(VM* vm, double val);
251−VAL MKSTROFFc(VM* vm, VAL off);
254+VAL MKSTROFFc(VM* vm, VAL basestr);
252VAL MKSTRc(VM* vm, char* str);
255VAL MKSTRc(VM* vm, char* str);
253VAL MKSTRclen(VM* vm, char* str, size_t len);
256VAL MKSTRclen(VM* vm, char* str, size_t len);
254VAL MKPTRc(VM* vm, void* ptr);
257VAL MKPTRc(VM* vm, void* ptr);
@@ -258,11 +261,11 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);
258char* GETSTROFF(VAL stroff);
261char* GETSTROFF(VAL stroff);
259size_t GETSTROFFLEN(VAL stroff);
262size_t GETSTROFFLEN(VAL stroff);
260
263
261−#define SETARG(x, i, a) ((x)->info.cargs)[i] = ((VAL)(a))
264+#define SETARG(x, i, a) ((x)->extra.cargs)[i] = ((VAL)(a))
262−#define GETARG(x, i) ((x)->info.cargs[i])
265+#define GETARG(x, i) ((x)->extra.cargs[i])
263
266
264#define PROJECT(vm,r,loc,num) \
267#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)
266#define SLIDE(vm, args) \
269#define SLIDE(vm, args) \
267 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
270 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
268
271
@@ -285,25 +288,29 @@ void* idris_alloc(size_t size);
285void* idris_realloc(void* old, size_t old_size, size_t size);
288void* idris_realloc(void* old, size_t old_size, size_t size);
286void idris_free(void* ptr, size_t size);
289void idris_free(void* ptr, size_t size);
287
290
288−#define allocCon(cl, vm, t, a, o) do { \
291+#define allocCon(cl, vm, t, a, o) do { \
292+ size_t sz = sizeof(VAL)*a; \
289− cl = allocate(sizeof(Closure) + sizeof(VAL)*a, o); \
293+ cl = allocate(sizeof(Closure) + sz, o); \
290− SETTY(cl, CT_CON); \
294+ SETTY(cl, CT_CON); \
291− cl->sz = ((t) << 8) | (a); \
295+ cl->info.tag = t; \
296+ cl->extrasz = sz; \
292 } while (0)
297 } while (0)
293
298
294−#define updateCon(cl, old, t, a) do { \
299+#define updateCon(cl, old, t, a) do { \
295− cl = old; \
300+ cl = old; \
296− SETTY(cl, CT_CON); \
301+ SETTY(cl, CT_CON); \
297− cl->sz = ((t) << 8) | (a); \
302+ cl->info.tag = t; \
303+ cl->extrasz = sizeof(VAL)*a; \
298 } while (0)
304 } while (0)
299
305
300
306
301#define NULL_CON(x) nullary_cons[x]
307#define NULL_CON(x) nullary_cons[x]
302
308
303−#define allocArray(cl, vm, len, o) do { \
309+#define allocArray(cl, vm, len, o) do { \
310+ size_t sz = sizeof(VAL)*len; \
304− cl = allocate(sizeof(Closure) + sizeof(VAL)*len, o); \
311+ cl = allocate(sizeof(Closure) + sz, o); \
305− SETTY(cl, CT_ARRAY); \
312+ SETTY(cl, CT_ARRAY); \
306− cl->sz = len; \
313+ cl->extrasz = sz; \
307 } while (0)
314 } while (0)
308
315
309int idris_errno(void);
316int idris_errno(void);
@@ -441,4 +448,12 @@ void stackOverflow(void);
441
448
442#include "idris_gmp.h"
449#include "idris_gmp.h"
443
450
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+
444#endif
459#endif