git.iko.soy/Idris-dev
on master help sign in
Use a common header instead of a union
commit4698b9ae4dccc9c33356bce5bab0b4736549a989 authorJorge Acereda <jacereda@gmail.com> dateTue 20 Mar 2018, 00:53 (9 years ago) parent807f009
9 files changed+579−736
compare with master
unifiedsplit
rts/idris_bitstring.c+145−373 rts/idris_buffer.c+1−2 rts/idris_gc.c+28−28 rts/idris_gmp.c+69−67 rts/idris_gmp.h+1−1 rts/idris_heap.c+4−3 rts/idris_rts.c+172−183 rts/idris_rts.h+158−76 rts/idris_stdfgn.c+1−3
rts/idris_bitstring.c+145−373
@@ -2,131 +2,94 @@
22
33#include "idris_rts.h"
44
5−VAL idris_b8(VM *vm, VAL a) {
6− uint8_t A = GETINT(a);
7− VAL cl = allocate(sizeof(Closure), 0);
5+VAL idris_b8const(VM *vm, uint8_t a) {
6+ Bits8 * cl = iallocate(vm, sizeof(*cl), 0);
87 SETTY(cl, CT_BITS8);
9− cl->info.bits8 = (uint8_t) A;
10− return cl;
8+ cl->bits8 = a;
9+ return (VAL)cl;
1110}
1211
13−VAL idris_b16(VM *vm, VAL a) {
14− uint16_t A = GETINT(a);
15− VAL cl = allocate(sizeof(Closure), 0);
12+VAL idris_b16const(VM *vm, uint16_t a) {
13+ Bits16 * cl = iallocate(vm, sizeof(*cl), 0);
1614 SETTY(cl, CT_BITS16);
17− cl->info.bits16 = (uint16_t) A;
18− return cl;
15+ cl->bits16 = a;
16+ return (VAL)cl;
1917}
2018
21−VAL idris_b32(VM *vm, VAL a) {
22− uint32_t A = GETINT(a);
23− VAL cl = allocate(sizeof(Closure), 0);
19+VAL idris_b32const(VM *vm, uint32_t a) {
20+ Bits32 * cl = iallocate(vm, sizeof(*cl), 0);
2421 SETTY(cl, CT_BITS32);
25− cl->info.bits32 = (uint32_t) A;
26− return cl;
22+ cl->bits32 = a;
23+ return (VAL)cl;
2724}
2825
29−VAL idris_b64(VM *vm, VAL a) {
30− uint64_t A = GETINT(a);
31− VAL cl = allocate(sizeof(Closure), 0);
26+VAL idris_b64const(VM *vm, uint64_t a) {
27+ Bits64 * cl = iallocate(vm, sizeof(*cl), 0);
3228 SETTY(cl, CT_BITS64);
33− cl->info.bits64 = (uint64_t) A;
34− return cl;
29+ cl->bits64 = a;
30+ return (VAL)cl;
3531}
3632
37−VAL idris_castB32Int(VM *vm, VAL a) {
38− return MKINT(GETBITS32(a));
33+VAL idris_b8(VM *vm, VAL a) {
34+ return idris_b8const(vm, GETINT(a));
3935}
4036
41−VAL idris_b8const(VM *vm, uint8_t a) {
42− VAL cl = allocate(sizeof(Closure), 0);
43− SETTY(cl, CT_BITS8);
44− cl->info.bits8 = a;
45− return cl;
37+VAL idris_b16(VM *vm, VAL a) {
38+ return idris_b16const(vm, GETINT(a));
4639}
4740
48−VAL idris_b16const(VM *vm, uint16_t a) {
49− VAL cl = allocate(sizeof(Closure), 0);
50− SETTY(cl, CT_BITS16);
51− cl->info.bits16 = a;
52− return cl;
41+VAL idris_b32(VM *vm, VAL a) {
42+ return idris_b32const(vm, GETINT(a));
5343}
5444
55−VAL idris_b32const(VM *vm, uint32_t a) {
56− VAL cl = allocate(sizeof(Closure), 0);
57− SETTY(cl, CT_BITS32);
58− cl->info.bits32 = a;
59− return cl;
45+VAL idris_b64(VM *vm, VAL a) {
46+ return idris_b64const(vm, GETINT(a));
6047}
6148
62−VAL idris_b64const(VM *vm, uint64_t a) {
63− VAL cl = allocate(sizeof(Closure), 0);
64− SETTY(cl, CT_BITS64);
65− cl->info.bits64 = a;
66− return cl;
49+VAL idris_castB32Int(VM *vm, VAL a) {
50+ return MKINT(GETBITS32(a));
6751}
6852
6953VAL idris_b8Plus(VM *vm, VAL a, VAL b) {
7054 uint8_t A = GETBITS8(a);
7155 uint8_t B = GETBITS8(b);
72− VAL cl = allocate(sizeof(Closure), 0);
73− SETTY(cl, CT_BITS8);
74− cl->info.bits8 = A + B;
75− return cl;
56+ return idris_b8const(vm, A + B);
7657}
7758
7859VAL idris_b8Minus(VM *vm, VAL a, VAL b) {
7960 uint8_t A = GETBITS8(a);
8061 uint8_t B = GETBITS8(b);
81− VAL cl = allocate(sizeof(Closure), 0);
82− SETTY(cl, CT_BITS8);
83− cl->info.bits8 = A - B;
84− return cl;
62+ return idris_b8const(vm, A - B);
8563}
8664
8765VAL idris_b8Times(VM *vm, VAL a, VAL b) {
8866 uint8_t A = GETBITS8(a);
8967 uint8_t B = GETBITS8(b);
90− VAL cl = allocate(sizeof(Closure), 0);
91− SETTY(cl, CT_BITS8);
92− cl->info.bits8 = A * B;
93− return cl;
68+ return idris_b8const(vm, A * B);
9469}
9570
9671VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {
9772 uint8_t A = GETBITS8(a);
9873 uint8_t B = GETBITS8(b);
99− VAL cl = allocate(sizeof(Closure), 0);
100− SETTY(cl, CT_BITS8);
101− cl->info.bits8 = A / B;
102− return cl;
74+ return idris_b8const(vm, A / B);
10375}
10476
10577VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {
106− uint8_t A = GETBITS8(a);
107− uint8_t B = GETBITS8(b);
108− VAL cl = allocate(sizeof(Closure), 0);
109− SETTY(cl, CT_BITS8);
110− cl->info.bits8 = (uint8_t) (((int8_t) A) / ((int8_t) B));
111− return cl;
78+ int8_t A = GETBITS8(a);
79+ int8_t B = GETBITS8(b);
80+ return idris_b8const(vm, A / B);
11281}
11382
11483VAL idris_b8URem(VM *vm, VAL a, VAL b) {
11584 uint8_t A = GETBITS8(a);
11685 uint8_t B = GETBITS8(b);
117− VAL cl = allocate(sizeof(Closure), 0);
118− SETTY(cl, CT_BITS8);
119− cl->info.bits8 = A % B;
120− return cl;
86+ return idris_b8const(vm, A % B);
12187}
12288
12389VAL idris_b8SRem(VM *vm, VAL a, VAL b) {
124− uint8_t A = GETBITS8(a);
125− uint8_t B = GETBITS8(b);
126− VAL cl = allocate(sizeof(Closure), 0);
127− SETTY(cl, CT_BITS8);
128− cl->info.bits8 = (uint8_t) (((int8_t) A) % ((int8_t) B));
129− return cl;
90+ int8_t A = GETBITS8(a);
91+ int8_t B = GETBITS8(b);
92+ return idris_b8const(vm, A % B);
13093}
13194
13295VAL idris_b8Lt(VM *vm, VAL a, VAL b) {
@@ -151,127 +114,85 @@ VAL idris_b8Gte(VM *vm, VAL a, VAL b) {
151114
152115VAL idris_b8Compl(VM *vm, VAL a) {
153116 uint8_t A = GETBITS8(a);
154− VAL cl = allocate(sizeof(Closure), 0);
155− SETTY(cl, CT_BITS8);
156− cl->info.bits8 = ~ A;
157− return cl;
117+ return idris_b8const(vm, ~ A);
158118}
159119
160120VAL idris_b8And(VM *vm, VAL a, VAL b) {
161121 uint8_t A = GETBITS8(a);
162122 uint8_t B = GETBITS8(b);
163− VAL cl = allocate(sizeof(Closure), 0);
164− SETTY(cl, CT_BITS8);
165− cl->info.bits8 = A & B;
166− return cl;
123+ return idris_b8const(vm, A & B);
167124}
168125
169126VAL idris_b8Or(VM *vm, VAL a, VAL b) {
170127 uint8_t A = GETBITS8(a);
171128 uint8_t B = GETBITS8(b);
172− VAL cl = allocate(sizeof(Closure), 0);
173− SETTY(cl, CT_BITS8);
174− cl->info.bits8 = A | B;
175− return cl;
129+ return idris_b8const(vm, A | B);
176130}
177131
178132VAL idris_b8Xor(VM *vm, VAL a, VAL b) {
179133 uint8_t A = GETBITS8(a);
180134 uint8_t B = GETBITS8(b);
181− VAL cl = allocate(sizeof(Closure), 0);
182− SETTY(cl, CT_BITS8);
183− cl->info.bits8 = A ^ B;
184− return cl;
135+ return idris_b8const(vm, A ^ B);
185136}
186137
187138VAL idris_b8Shl(VM *vm, VAL a, VAL b) {
188139 uint8_t A = GETBITS8(a);
189140 uint8_t B = GETBITS8(b);
190− VAL cl = allocate(sizeof(Closure), 0);
191− SETTY(cl, CT_BITS8);
192− cl->info.bits8 = A << B;
193− return cl;
141+ return idris_b8const(vm, A << B);
194142}
195143
196144VAL idris_b8LShr(VM *vm, VAL a, VAL b) {
197145 uint8_t A = GETBITS8(a);
198146 uint8_t B = GETBITS8(b);
199− VAL cl = allocate(sizeof(Closure), 0);
200− SETTY(cl, CT_BITS8);
201− cl->info.bits8 = A >> B;
202− return cl;
147+ return idris_b8const(vm, A >> B);
203148}
204149
205150VAL idris_b8AShr(VM *vm, VAL a, VAL b) {
206− uint8_t A = GETBITS8(a);
207− uint8_t B = GETBITS8(b);
208− VAL cl = allocate(sizeof(Closure), 0);
209− SETTY(cl, CT_BITS8);
210− cl->info.bits8 = (uint8_t) (((int8_t) A) >> ((int8_t) B));
211− return cl;
151+ int8_t A = GETBITS8(a);
152+ int8_t B = GETBITS8(b);
153+ return idris_b8const(vm, A >> B);
212154}
213155
214156VAL idris_b16Plus(VM *vm, VAL a, VAL b) {
215157 uint16_t A = GETBITS16(a);
216158 uint16_t B = GETBITS16(b);
217− VAL cl = allocate(sizeof(Closure), 0);
218− SETTY(cl, CT_BITS16);
219− cl->info.bits16 = A + B;
220− return cl;
159+ return idris_b16const(vm, A + B);
221160}
222161
223162VAL idris_b16Minus(VM *vm, VAL a, VAL b) {
224163 uint16_t A = GETBITS16(a);
225164 uint16_t B = GETBITS16(b);
226− VAL cl = allocate(sizeof(Closure), 0);
227− SETTY(cl, CT_BITS16);
228− cl->info.bits16 = A - B;
229− return cl;
165+ return idris_b16const(vm, A - B);
230166}
231167
232168VAL idris_b16Times(VM *vm, VAL a, VAL b) {
233169 uint16_t A = GETBITS16(a);
234170 uint16_t B = GETBITS16(b);
235− VAL cl = allocate(sizeof(Closure), 0);
236− SETTY(cl, CT_BITS16);
237− cl->info.bits16 = A * B;
238− return cl;
171+ return idris_b16const(vm, A * B);
239172}
240173
241174VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {
242175 uint16_t A = GETBITS16(a);
243176 uint16_t B = GETBITS16(b);
244− VAL cl = allocate(sizeof(Closure), 0);
245− SETTY(cl, CT_BITS16);
246− cl->info.bits16 = A / B;
247− return cl;
177+ return idris_b16const(vm, A / B);
248178}
249179
250180VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {
251− uint16_t A = GETBITS16(a);
252− uint16_t B = GETBITS16(b);
253− VAL cl = allocate(sizeof(Closure), 0);
254− SETTY(cl, CT_BITS16);
255− cl->info.bits16 = (uint16_t) (((int16_t) A) / ((int16_t) B));
256− return cl;
181+ int16_t A = GETBITS16(a);
182+ int16_t B = GETBITS16(b);
183+ return idris_b16const(vm, A / B);
257184}
258185
259186VAL idris_b16URem(VM *vm, VAL a, VAL b) {
260187 uint16_t A = GETBITS16(a);
261188 uint16_t B = GETBITS16(b);
262− VAL cl = allocate(sizeof(Closure), 0);
263− SETTY(cl, CT_BITS16);
264− cl->info.bits16 = A % B;
265− return cl;
189+ return idris_b16const(vm, A % B);
266190}
267191
268192VAL idris_b16SRem(VM *vm, VAL a, VAL b) {
269− uint16_t A = GETBITS16(a);
270− uint16_t B = GETBITS16(b);
271− VAL cl = allocate(sizeof(Closure), 0);
272− SETTY(cl, CT_BITS16);
273− cl->info.bits16 = (uint16_t) (((int16_t) A) % ((int16_t) B));
274− return cl;
193+ int16_t A = GETBITS16(a);
194+ int16_t B = GETBITS16(b);
195+ return idris_b16const(vm, A % B);
275196}
276197
277198VAL idris_b16Lt(VM *vm, VAL a, VAL b) {
@@ -296,127 +217,85 @@ VAL idris_b16Gte(VM *vm, VAL a, VAL b) {
296217
297218VAL idris_b16Compl(VM *vm, VAL a) {
298219 uint16_t A = GETBITS16(a);
299− VAL cl = allocate(sizeof(Closure), 0);
300− SETTY(cl, CT_BITS16);
301− cl->info.bits16 = ~ A;
302− return cl;
220+ return idris_b16const(vm, ~ A);
303221}
304222
305223VAL idris_b16And(VM *vm, VAL a, VAL b) {
306224 uint16_t A = GETBITS16(a);
307225 uint16_t B = GETBITS16(b);
308− VAL cl = allocate(sizeof(Closure), 0);
309− SETTY(cl, CT_BITS16);
310− cl->info.bits16 = A & B;
311− return cl;
226+ return idris_b16const(vm, A & B);
312227}
313228
314229VAL idris_b16Or(VM *vm, VAL a, VAL b) {
315230 uint16_t A = GETBITS16(a);
316231 uint16_t B = GETBITS16(b);
317− VAL cl = allocate(sizeof(Closure), 0);
318− SETTY(cl, CT_BITS16);
319− cl->info.bits16 = A | B;
320− return cl;
232+ return idris_b16const(vm, A | B);
321233}
322234
323235VAL idris_b16Xor(VM *vm, VAL a, VAL b) {
324236 uint16_t A = GETBITS16(a);
325237 uint16_t B = GETBITS16(b);
326− VAL cl = allocate(sizeof(Closure), 0);
327− SETTY(cl, CT_BITS16);
328− cl->info.bits16 = A ^ B;
329− return cl;
238+ return idris_b16const(vm, A ^ B);
330239}
331240
332241VAL idris_b16Shl(VM *vm, VAL a, VAL b) {
333242 uint16_t A = GETBITS16(a);
334243 uint16_t B = GETBITS16(b);
335− VAL cl = allocate(sizeof(Closure), 0);
336− SETTY(cl, CT_BITS16);
337− cl->info.bits16 = A << B;
338− return cl;
244+ return idris_b16const(vm, A << B);
339245}
340246
341247VAL idris_b16LShr(VM *vm, VAL a, VAL b) {
342248 uint16_t A = GETBITS16(a);
343249 uint16_t B = GETBITS16(b);
344− VAL cl = allocate(sizeof(Closure), 0);
345− SETTY(cl, CT_BITS16);
346− cl->info.bits16 = A >> B;
347− return cl;
250+ return idris_b16const(vm, A >> B);
348251}
349252
350253VAL idris_b16AShr(VM *vm, VAL a, VAL b) {
351− uint16_t A = GETBITS16(a);
352− uint16_t B = GETBITS16(b);
353− VAL cl = allocate(sizeof(Closure), 0);
354− SETTY(cl, CT_BITS16);
355− cl->info.bits16 = (uint16_t) (((int16_t) A) >> ((int16_t) B));
356− return cl;
254+ int16_t A = GETBITS16(a);
255+ int16_t B = GETBITS16(b);
256+ return idris_b16const(vm, A >> B);
357257}
358258
359259VAL idris_b32Plus(VM *vm, VAL a, VAL b) {
360260 uint32_t A = GETBITS32(a);
361261 uint32_t B = GETBITS32(b);
362− VAL cl = allocate(sizeof(Closure), 0);
363− SETTY(cl, CT_BITS32);
364− cl->info.bits32 = A + B;
365− return cl;
262+ return idris_b32const(vm, A + B);
366263}
367264
368265VAL idris_b32Minus(VM *vm, VAL a, VAL b) {
369266 uint32_t A = GETBITS32(a);
370267 uint32_t B = GETBITS32(b);
371− VAL cl = allocate(sizeof(Closure), 0);
372− SETTY(cl, CT_BITS32);
373− cl->info.bits32 = A - B;
374− return cl;
268+ return idris_b32const(vm, A - B);
375269}
376270
377271VAL idris_b32Times(VM *vm, VAL a, VAL b) {
378272 uint32_t A = GETBITS32(a);
379273 uint32_t B = GETBITS32(b);
380− VAL cl = allocate(sizeof(Closure), 0);
381− SETTY(cl, CT_BITS32);
382− cl->info.bits32 = A * B;
383− return cl;
274+ return idris_b32const(vm, A * B);
384275}
385276
386277VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {
387278 uint32_t A = GETBITS32(a);
388279 uint32_t B = GETBITS32(b);
389− VAL cl = allocate(sizeof(Closure), 0);
390− SETTY(cl, CT_BITS32);
391− cl->info.bits32 = A / B;
392− return cl;
280+ return idris_b32const(vm, A / B);
393281}
394282
395283VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {
396− uint32_t A = GETBITS32(a);
397− uint32_t B = GETBITS32(b);
398− VAL cl = allocate(sizeof(Closure), 0);
399− SETTY(cl, CT_BITS32);
400− cl->info.bits32 = (uint32_t) (((int32_t) A) / ((int32_t) B));
401− return cl;
284+ int32_t A = GETBITS32(a);
285+ int32_t B = GETBITS32(b);
286+ return idris_b32const(vm, A / B);
402287}
403288
404289VAL idris_b32URem(VM *vm, VAL a, VAL b) {
405290 uint32_t A = GETBITS32(a);
406291 uint32_t B = GETBITS32(b);
407− VAL cl = allocate(sizeof(Closure), 0);
408− SETTY(cl, CT_BITS32);
409− cl->info.bits32 = A % B;
410− return cl;
292+ return idris_b32const(vm, A % B);
411293}
412294
413295VAL idris_b32SRem(VM *vm, VAL a, VAL b) {
414− uint32_t A = GETBITS32(a);
415− uint32_t B = GETBITS32(b);
416− VAL cl = allocate(sizeof(Closure), 0);
417− SETTY(cl, CT_BITS32);
418− cl->info.bits32 = (uint32_t) (((int32_t) A) % ((int32_t) B));
419− return cl;
296+ int32_t A = GETBITS32(a);
297+ int32_t B = GETBITS32(b);
298+ return idris_b32const(vm, A % B);
420299}
421300
422301VAL idris_b32Lt(VM *vm, VAL a, VAL b) {
@@ -441,353 +320,246 @@ VAL idris_b32Gte(VM *vm, VAL a, VAL b) {
441320
442321VAL idris_b32Compl(VM *vm, VAL a) {
443322 uint32_t A = GETBITS32(a);
444− VAL cl = allocate(sizeof(Closure), 0);
445− SETTY(cl, CT_BITS32);
446− cl->info.bits32 = ~ A;
447− return cl;
323+ return idris_b32const(vm, ~ A);
448324}
449325
450326VAL idris_b32And(VM *vm, VAL a, VAL b) {
451327 uint32_t A = GETBITS32(a);
452328 uint32_t B = GETBITS32(b);
453− VAL cl = allocate(sizeof(Closure), 0);
454− SETTY(cl, CT_BITS32);
455− cl->info.bits32 = A & B;
456− return cl;
329+ return idris_b32const(vm, A & B);
457330}
458331
459332VAL idris_b32Or(VM *vm, VAL a, VAL b) {
460333 uint32_t A = GETBITS32(a);
461334 uint32_t B = GETBITS32(b);
462− VAL cl = allocate(sizeof(Closure), 0);
463− SETTY(cl, CT_BITS32);
464− cl->info.bits32 = A | B;
465− return cl;
335+ return idris_b32const(vm, A | B);
466336}
467337
468338VAL idris_b32Xor(VM *vm, VAL a, VAL b) {
469339 uint32_t A = GETBITS32(a);
470340 uint32_t B = GETBITS32(b);
471− VAL cl = allocate(sizeof(Closure), 0);
472− SETTY(cl, CT_BITS32);
473− cl->info.bits32 = A ^ B;
474− return cl;
341+ return idris_b32const(vm, A ^ B);
475342}
476343
477344VAL idris_b32Shl(VM *vm, VAL a, VAL b) {
478345 uint32_t A = GETBITS32(a);
479346 uint32_t B = GETBITS32(b);
480− VAL cl = allocate(sizeof(Closure), 0);
481− SETTY(cl, CT_BITS32);
482− cl->info.bits32 = A << B;
483− return cl;
347+ return idris_b32const(vm, A << B);
484348}
485349
486350VAL idris_b32LShr(VM *vm, VAL a, VAL b) {
487351 uint32_t A = GETBITS32(a);
488352 uint32_t B = GETBITS32(b);
489− VAL cl = allocate(sizeof(Closure), 0);
490− SETTY(cl, CT_BITS32);
491− cl->info.bits32 = A >> B;
492− return cl;
353+ return idris_b32const(vm, A >> B);
493354}
494355
495356VAL idris_b32AShr(VM *vm, VAL a, VAL b) {
496− uint32_t A = GETBITS32(a);
497− uint32_t B = GETBITS32(b);
498− VAL cl = allocate(sizeof(Closure), 0);
499− SETTY(cl, CT_BITS32);
500− cl->info.bits32 = (uint32_t) (((int32_t)A) >> ((int32_t)B));
501− return cl;
357+ int32_t A = GETBITS32(a);
358+ int32_t B = GETBITS32(b);
359+ return idris_b32const(vm, A >> B);
502360}
503361
504362VAL idris_b64Plus(VM *vm, VAL a, VAL b) {
505363 uint64_t A = GETBITS64(a);
506364 uint64_t B = GETBITS64(b);
507− VAL cl = allocate(sizeof(Closure), 0);
508− SETTY(cl, CT_BITS64);
509− cl->info.bits64 = A + B;
510− return cl;
365+ return idris_b64const(vm, A + B);
511366}
512367
513368VAL idris_b64Minus(VM *vm, VAL a, VAL b) {
514369 uint64_t A = GETBITS64(a);
515370 uint64_t B = GETBITS64(b);
516− VAL cl = allocate(sizeof(Closure), 0);
517− SETTY(cl, CT_BITS64);
518− cl->info.bits64 = A - B;
519− return cl;
371+ return idris_b64const(vm, A - B);
520372}
521373
522374VAL idris_b64Times(VM *vm, VAL a, VAL b) {
523375 uint64_t A = GETBITS64(a);
524376 uint64_t B = GETBITS64(b);
525− VAL cl = allocate(sizeof(Closure), 0);
526− SETTY(cl, CT_BITS64);
527− cl->info.bits64 = A * B;
528− return cl;
377+ return idris_b64const(vm, A * B);
529378}
530379
531380VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {
532381 uint64_t A = GETBITS64(a);
533382 uint64_t B = GETBITS64(b);
534− VAL cl = allocate(sizeof(Closure), 0);
535− SETTY(cl, CT_BITS64);
536− cl->info.bits64 = A / B;
537− return cl;
383+ return idris_b64const(vm, A / B);
538384}
539385
540386VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {
541− uint64_t A = GETBITS64(a);
542− uint64_t B = GETBITS64(b);
543− VAL cl = allocate(sizeof(Closure), 0);
544− SETTY(cl, CT_BITS64);
545− cl->info.bits64 = (uint64_t) (((int64_t) A) / ((int64_t) B));
546− return cl;
387+ int64_t A = GETBITS64(a);
388+ int64_t B = GETBITS64(b);
389+ return idris_b64const(vm, A / B);
547390}
548391
549392VAL idris_b64URem(VM *vm, VAL a, VAL b) {
550393 uint64_t A = GETBITS64(a);
551394 uint64_t B = GETBITS64(b);
552− VAL cl = allocate(sizeof(Closure), 0);
553− SETTY(cl, CT_BITS64);
554− cl->info.bits64 = A % B;
555− return cl;
395+ return idris_b64const(vm, A % B);
556396}
557397
558398VAL idris_b64SRem(VM *vm, VAL a, VAL b) {
559− uint64_t A = GETBITS64(a);
560− uint64_t B = GETBITS64(b);
561− VAL cl = allocate(sizeof(Closure), 0);
562− SETTY(cl, CT_BITS64);
563− cl->info.bits64 = (uint64_t) (((int64_t) A) % ((int64_t) B));
564− return cl;
399+ int64_t A = GETBITS64(a);
400+ int64_t B = GETBITS64(b);
401+ return idris_b64const(vm, A % B);
565402}
566403
567404VAL idris_b64Lt(VM *vm, VAL a, VAL b) {
568− return MKINT((i_int) (a->info.bits64 < b->info.bits64));
405+ uint64_t A = GETBITS64(a);
406+ uint64_t B = GETBITS64(b);
407+ return MKINT((i_int) (A < B));
569408}
570409
571410VAL idris_b64Gt(VM *vm, VAL a, VAL b) {
572− return MKINT((i_int) (a->info.bits64 > b->info.bits64));
411+ uint64_t A = GETBITS64(a);
412+ uint64_t B = GETBITS64(b);
413+ return MKINT((i_int) (A > B));
573414}
574415
575416VAL idris_b64Eq(VM *vm, VAL a, VAL b) {
576− return MKINT((i_int) (a->info.bits64 == b->info.bits64));
417+ uint64_t A = GETBITS64(a);
418+ uint64_t B = GETBITS64(b);
419+ return MKINT((i_int) (A == B));
577420}
578421
579422VAL idris_b64Lte(VM *vm, VAL a, VAL b) {
580− return MKINT((i_int) (a->info.bits64 <= b->info.bits64));
423+ uint64_t A = GETBITS64(a);
424+ uint64_t B = GETBITS64(b);
425+ return MKINT((i_int) (A <= B));
581426}
582427
583428VAL idris_b64Gte(VM *vm, VAL a, VAL b) {
584− return MKINT((i_int) (a->info.bits64 >= b->info.bits64));
429+ uint64_t A = GETBITS64(a);
430+ uint64_t B = GETBITS64(b);
431+ return MKINT((i_int) (A >= B));
585432}
586433
587434VAL idris_b64Compl(VM *vm, VAL a) {
588435 uint64_t A = GETBITS64(a);
589− VAL cl = allocate(sizeof(Closure), 0);
590− SETTY(cl, CT_BITS64);
591− cl->info.bits64 = ~ A;
592− return cl;
436+ return idris_b64const(vm, ~ A);
593437}
594438
595439VAL idris_b64And(VM *vm, VAL a, VAL b) {
596440 uint64_t A = GETBITS64(a);
597441 uint64_t B = GETBITS64(b);
598− VAL cl = allocate(sizeof(Closure), 0);
599− SETTY(cl, CT_BITS64);
600− cl->info.bits64 = A & B;
601− return cl;
442+ return idris_b64const(vm, A & B);
602443}
603444
604445VAL idris_b64Or(VM *vm, VAL a, VAL b) {
605446 uint64_t A = GETBITS64(a);
606447 uint64_t B = GETBITS64(b);
607− VAL cl = allocate(sizeof(Closure), 0);
608− SETTY(cl, CT_BITS64);
609− cl->info.bits64 = A | B;
610− return cl;
448+ return idris_b64const(vm, A | B);
611449}
612450
613451VAL idris_b64Xor(VM *vm, VAL a, VAL b) {
614452 uint64_t A = GETBITS64(a);
615453 uint64_t B = GETBITS64(b);
616− VAL cl = allocate(sizeof(Closure), 0);
617− SETTY(cl, CT_BITS64);
618− cl->info.bits64 = A ^ B;
619− return cl;
454+ return idris_b64const(vm, A ^ B);
620455}
621456
622457VAL idris_b64Shl(VM *vm, VAL a, VAL b) {
623458 uint64_t A = GETBITS64(a);
624459 uint64_t B = GETBITS64(b);
625− VAL cl = allocate(sizeof(Closure), 0);
626− SETTY(cl, CT_BITS64);
627− cl->info.bits64 = A << B;
628− return cl;
460+ return idris_b64const(vm, A << B);
629461}
630462
631463VAL idris_b64LShr(VM *vm, VAL a, VAL b) {
632464 uint64_t A = GETBITS64(a);
633465 uint64_t B = GETBITS64(b);
634− VAL cl = allocate(sizeof(Closure), 0);
635− SETTY(cl, CT_BITS64);
636− cl->info.bits64 = A >> B;
637− return cl;
466+ return idris_b64const(vm, A >> B);
638467}
639468
640469VAL idris_b64AShr(VM *vm, VAL a, VAL b) {
641− uint64_t A = GETBITS64(a);
642− uint64_t B = GETBITS64(b);
643− VAL cl = allocate(sizeof(Closure), 0);
644− SETTY(cl, CT_BITS64);
645− cl->info.bits64 = (uint64_t) (((int64_t) A) >> ((int64_t) B));
646− return cl;
470+ int64_t A = GETBITS64(a);
471+ int64_t B = GETBITS64(b);
472+ return idris_b64const(vm, A >> B);
647473}
648474
649475VAL idris_b8Z16(VM *vm, VAL a) {
650476 uint8_t A = GETBITS8(a);
651− VAL cl = allocate(sizeof(Closure), 0);
652− SETTY(cl, CT_BITS16);
653− cl->info.bits16 = (uint16_t) A;
654− return cl;
477+ return idris_b16const(vm, A);
655478}
656479
657480VAL idris_b8Z32(VM *vm, VAL a) {
658481 uint8_t A = GETBITS8(a);
659− VAL cl = allocate(sizeof(Closure), 0);
660− SETTY(cl, CT_BITS32);
661− cl->info.bits32 = (uint32_t) A;
662− return cl;
482+ return idris_b32const(vm, A);
663483}
664484
665485VAL idris_b8Z64(VM *vm, VAL a) {
666486 uint8_t A = GETBITS8(a);
667− VAL cl = allocate(sizeof(Closure), 0);
668− SETTY(cl, CT_BITS64);
669− cl->info.bits64 = (uint64_t) A;
670− return cl;
487+ return idris_b64const(vm, A);
671488}
672489
673490VAL idris_b8S16(VM *vm, VAL a) {
674− uint8_t A = GETBITS8(a);
675− VAL cl = allocate(sizeof(Closure), 0);
676− SETTY(cl, CT_BITS16);
677− cl->info.bits16 = (uint16_t) (int16_t) (int8_t) A;
678− return cl;
491+ int8_t A = GETBITS8(a);
492+ return idris_b16const(vm, (int16_t) A);
679493}
680494
681495VAL idris_b8S32(VM *vm, VAL a) {
682− uint8_t A = GETBITS8(a);
683− VAL cl = allocate(sizeof(Closure), 0);
684− SETTY(cl, CT_BITS32);
685− cl->info.bits32 = (uint32_t) (int32_t) (int8_t) A;
686− return cl;
496+ int8_t A = GETBITS8(a);
497+ return idris_b32const(vm, (int32_t) A);
687498}
688499
689500VAL idris_b8S64(VM *vm, VAL a) {
690− uint8_t A = GETBITS8(a);
691− VAL cl = allocate(sizeof(Closure), 0);
692− SETTY(cl, CT_BITS64);
693− cl->info.bits64 = (uint64_t) (int64_t) (int8_t) A;
694− return cl;
501+ int8_t A = GETBITS8(a);
502+ return idris_b64const(vm, (int64_t) A);
695503}
696504
697505VAL idris_b16Z32(VM *vm, VAL a) {
698506 uint16_t A = GETBITS16(a);
699− VAL cl = allocate(sizeof(Closure), 0);
700− SETTY(cl, CT_BITS32);
701− cl->info.bits32 = (uint32_t) A;
702− return cl;
507+ return idris_b32const(vm, (uint32_t) A);
703508}
704509
705510VAL idris_b16Z64(VM *vm, VAL a) {
706511 uint16_t A = GETBITS16(a);
707− VAL cl = allocate(sizeof(Closure), 0);
708− SETTY(cl, CT_BITS64);
709− cl->info.bits64 = (uint64_t) A;
710− return cl;
512+ return idris_b64const(vm, (uint64_t) A);
711513}
712514
713515VAL idris_b16S32(VM *vm, VAL a) {
714− uint16_t A = GETBITS16(a);
715− VAL cl = allocate(sizeof(Closure), 0);
716− SETTY(cl, CT_BITS32);
717− cl->info.bits32 = (uint32_t) (int32_t) (int16_t) A;
718− return cl;
516+ int16_t A = GETBITS16(a);
517+ return idris_b32const(vm, (int32_t) A);
719518}
720519
721520VAL idris_b16S64(VM *vm, VAL a) {
722− uint16_t A = GETBITS16(a);
723− VAL cl = allocate(sizeof(Closure), 0);
724− SETTY(cl, CT_BITS64);
725− cl->info.bits64 = (uint64_t) (int64_t) (int16_t) A;
726− return cl;
521+ int16_t A = GETBITS16(a);
522+ return idris_b64const(vm, (int64_t) A);
727523}
728524
729525VAL idris_b16T8(VM *vm, VAL a) {
730526 uint16_t A = GETBITS16(a);
731− VAL cl = allocate(sizeof(Closure), 0);
732− SETTY(cl, CT_BITS8);
733− cl->info.bits8 = (uint8_t) A;
734− return cl;
527+ return idris_b8const(vm, (uint8_t) A);
735528}
736529
737530VAL idris_b32Z64(VM *vm, VAL a) {
738531 uint32_t A = GETBITS32(a);
739− VAL cl = allocate(sizeof(Closure), 0);
740− SETTY(cl, CT_BITS64);
741− cl->info.bits64 = (uint64_t) A;
742− return cl;
532+ return idris_b64const(vm, (uint64_t) A);
743533}
744534
745535VAL idris_b32S64(VM *vm, VAL a) {
746− uint32_t A = GETBITS32(a);
747− VAL cl = allocate(sizeof(Closure), 0);
748− SETTY(cl, CT_BITS64);
749− cl->info.bits64 = (uint64_t) (int64_t) (int32_t) A;
750− return cl;
536+ int32_t A = GETBITS32(a);
537+ return idris_b64const(vm, (int64_t) A);
751538}
752539
753540VAL idris_b32T8(VM *vm, VAL a) {
754541 uint32_t A = GETBITS32(a);
755− VAL cl = allocate(sizeof(Closure), 0);
756− SETTY(cl, CT_BITS8);
757− cl->info.bits8 = (uint8_t) A;
758− return cl;
542+ return idris_b8const(vm, (uint8_t) A);
759543}
760544
761545VAL idris_b32T16(VM *vm, VAL a) {
762546 uint32_t A = GETBITS32(a);
763− VAL cl = allocate(sizeof(Closure), 0);
764− SETTY(cl, CT_BITS16);
765− cl->info.bits16 = (uint16_t) A;
766− return cl;
547+ return idris_b16const(vm, (uint16_t) A);
767548}
768549
769550VAL idris_b64T8(VM *vm, VAL a) {
770551 uint64_t A = GETBITS64(a);
771− VAL cl = allocate(sizeof(Closure), 0);
772− SETTY(cl, CT_BITS8);
773− cl->info.bits8 = (uint8_t) A;
774− return cl;
552+ return idris_b8const(vm, (uint8_t) A);
775553}
776554
777555VAL idris_b64T16(VM *vm, VAL a) {
778556 uint64_t A = GETBITS64(a);
779− VAL cl = allocate(sizeof(Closure), 0);
780− SETTY(cl, CT_BITS16);
781− cl->info.bits16 = (uint16_t) A;
782− return cl;
557+ return idris_b16const(vm, (uint16_t) A);
783558}
784559
785560VAL idris_b64T32(VM *vm, VAL a) {
786561 uint64_t A = GETBITS64(a);
787− VAL cl = allocate(sizeof(Closure), 0);
788− SETTY(cl, CT_BITS32);
789− cl->info.bits32 = (uint32_t) A;
790− return cl;
562+ return idris_b32const(vm, (uint32_t) A);
791563}
792564
793565VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {
rts/idris_buffer.c+1−2
@@ -110,10 +110,9 @@ double idris_getBufferDouble(void* buffer, int loc) {
110110
111111VAL idris_getBufferString(void* buffer, int loc, int len) {
112112 Buffer* b = buffer;
113−
114113 char * s = (char*)(b->data + loc);
115114 size_t sz = loc >= 0 && loc+len <= b->size? len : 0;
116− return MKSTRlen(NULL, s, sz);
115+ return MKSTRlen(get_vm(), s, sz);
117116}
118117
119118int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {
rts/idris_gc.c+28−28
@@ -5,8 +5,8 @@
55#include <assert.h>
66
77VAL copy(VM* vm, VAL x) {
8− int ar, len;
9− Closure* cl = NULL;
8+ int ar;
9+ VAL cl;
1010 if (x==NULL || ISINT(x)) {
1111 return x;
1212 }
@@ -18,7 +18,7 @@ VAL copy(VM* vm, VAL x) {
1818 c_heap_mark_item(GETCDATA(x));
1919 break;
2020 case CT_BIGINT:
21− cl = MKBIGMc(vm, GETPTR(x));
21+ cl = MKBIGMc(vm, GETMPZ(x));
2222 break;
2323 case CT_CON:
2424 ar = CARITY(x);
@@ -39,47 +39,47 @@ VAL copy(VM* vm, VAL x) {
3939 case CT_BITS64:
4040 case CT_RAWDATA:
4141 {
42− size_t size = sizeof(Closure) + x->extrasz;
43− cl = allocate(size, 1);
44− memcpy(cl, x, size);
42+ Hdr * s = (Hdr*)x;
43+ cl = iallocate(vm, s->sz, 1);
44+ memcpy(cl, x, s->sz);
4545 }
4646 break;
4747 default:
48+ cl = NULL;
4849 break;
4950 }
5051 SETTY(x, CT_FWD);
51− x->info.ptr = cl;
52+ ((Fwd*)x)->fwd = cl;
5253 return cl;
5354}
5455
5556void cheney(VM *vm) {
56− size_t i, len;
5757 char* scan = aligned_heap_pointer(vm->heap.heap);
5858
5959 while(scan < vm->heap.next) {
6060 VAL heap_item = (VAL)scan;
6161 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
6262 switch(GETTY(heap_item)) {
63− case CT_CON:
64− len = CARITY(heap_item);
65− for(i = 0; i < len; ++i) {
66− VAL newptr = copy(vm, heap_item->extra.cargs[i]);
67− heap_item->extra.cargs[i] = newptr;
68− }
69− break;
70− case CT_ARRAY:
71− len = CELEM(heap_item);
72− for(i = 0; i < len; ++i) {
73− VAL newptr = copy(vm, heap_item->extra.array[i]);
74− heap_item->extra.array[i] = newptr;
75− }
76− break;
77− case CT_REF:
78− heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
79− break;
80− case CT_STROFFSET:
81− heap_item->extra.basestr[0] = copy(vm, heap_item->extra.basestr[0]);
82− break;
63+ case CT_CON: {
64+ Con * c = (Con*)heap_item;
65+ size_t len = CARITY(c);
66+ for(size_t i = 0; i < len; ++i)
67+ c->args[i] = copy(vm, c->args[i]);
68+ } break;
69+ case CT_ARRAY: {
70+ Array * a = (Array*)heap_item;
71+ size_t len = CELEM(a);
72+ for(size_t i = 0; i < len; ++i)
73+ a->array[i] = copy(vm, a->array[i]);
74+ } break;
75+ case CT_REF: {
76+ Ref * r = (Ref*)heap_item;
77+ r->ref = copy(vm, r->ref);
78+ } break;
79+ case CT_STROFFSET: {
80+ StrOffset * s = (StrOffset*)heap_item;
81+ s->base = (String*)copy(vm, (VAL)s->base);
82+ } break;
8383 default: // Nothing to copy
8484 break;
8585 }
rts/idris_gmp.c+69−67
@@ -22,17 +22,17 @@ 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);
25+static mpz_t * big(BigInt * v) {
26+ return (mpz_t*)(v->big);
2727}
2828
29−static VAL allocBig() {
30− idris_requireAlloc(IDRIS_MAXGMP);
31− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
32− idris_doneAlloc();
29+#define BIG(x) big((BigInt*)(x))
30+
31+static BigInt * allocBig(VM * vm) {
32+ idris_requireAlloc(vm, IDRIS_MAXGMP);
33+ BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);
34+ idris_doneAlloc(vm);
3335 SETTY(cl, CT_BIGINT);
34− cl->info.ptr = (void*)(cl+1);
35− cl->extrasz = sizeof(mpz_t);
3636 mpz_init(*big(cl));
3737 return cl;
3838}
@@ -42,117 +42,119 @@ VAL MKBIGC(VM* vm, char* val) {
4242 return MKBIGI(0);
4343 }
4444 else {
45− VAL cl = allocBig();
45+ BigInt * cl = allocBig(vm);
4646 mpz_set_str(*big(cl), val, 10);
47− return cl;
47+ return (VAL)cl;
4848 }
4949}
5050
5151VAL MKBIGM(VM* vm, void* ibig) {
52− VAL cl = allocBig();
52+ BigInt * cl = allocBig(vm);
5353 mpz_set(*big(cl), *((mpz_t*)ibig));
54− return cl;
54+ return (VAL)cl;
5555}
5656
5757VAL MKBIGMc(VM* vm, void* ibig) {
58− VAL cl = allocBig();
58+ BigInt * cl = allocBig(vm);
5959 mpz_init_set(*big(cl), *((mpz_t*)ibig));
60− return cl;
60+ return (VAL)cl;
6161}
6262
6363VAL MKBIGUI(VM* vm, unsigned long val) {
64− VAL cl = allocBig();
64+ BigInt * cl = allocBig(vm);
6565 mpz_init_set_ui(*big(cl), val);
66− return cl;
66+ return (VAL)cl;
6767}
6868
6969VAL MKBIGSI(VM* vm, signed long val) {
70− VAL cl = allocBig();
70+ BigInt * cl = allocBig(vm);
7171 mpz_init_set_si(*big(cl), val);
72− return cl;
72+ return (VAL)cl;
7373}
7474
75−VAL GETBIG(VM * vm, VAL x) {
75+static BigInt * getbig(VM * vm, VAL x) {
7676 if (ISINT(x)) {
77− VAL cl = allocBig();
77+ BigInt * cl = allocBig(vm);
7878 mpz_set_si(*big(cl), GETINT(x));
7979 return cl;
8080 } else {
8181 switch(GETTY(x)) {
8282 case CT_FWD:
83− return GETBIG(vm, x->info.ptr);
83+ return getbig(vm, ((Fwd*)x)->fwd);
8484 default:
85− return x;
85+ return (BigInt*)x;
8686 }
8787 }
8888}
8989
90+#define GETBIG (VAL)getbig
91+
9092VAL bigAdd(VM* vm, VAL x, VAL y) {
91− VAL cl = allocBig();
92− mpz_add(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
93− return cl;
93+ BigInt * cl = allocBig(vm);
94+ mpz_add(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
95+ return (VAL)cl;
9496}
9597
9698VAL bigSub(VM* vm, VAL x, VAL y) {
97− VAL cl = allocBig();
98− mpz_sub(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
99− return cl;
99+ BigInt * cl = allocBig(vm);
100+ mpz_sub(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
101+ return (VAL)cl;
100102}
101103
102104VAL bigMul(VM* vm, VAL x, VAL y) {
103− VAL cl = allocBig();
104− mpz_mul(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
105− return cl;
105+ BigInt * cl = allocBig(vm);
106+ mpz_mul(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
107+ return (VAL)cl;
106108}
107109
108110VAL bigDiv(VM* vm, VAL x, VAL y) {
109− VAL cl = allocBig();
110− mpz_tdiv_q(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
111− return cl;
111+ BigInt * cl = allocBig(vm);
112+ mpz_tdiv_q(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
113+ return (VAL)cl;
112114}
113115
114116VAL bigMod(VM* vm, VAL x, VAL y) {
115− VAL cl = allocBig();
116− mpz_tdiv_r(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
117− return cl;
117+ BigInt * cl = allocBig(vm);
118+ mpz_tdiv_r(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
119+ return (VAL)cl;
118120}
119121
120122VAL bigAnd(VM* vm, VAL x, VAL y) {
121− VAL cl = allocBig();
122− mpz_and(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
123− return cl;
123+ BigInt * cl = allocBig(vm);
124+ mpz_and(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
125+ return (VAL)cl;
124126}
125127
126128VAL bigOr(VM* vm, VAL x, VAL y) {
127− VAL cl = allocBig();
128− mpz_ior(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
129− return cl;
129+ BigInt * cl = allocBig(vm);
130+ mpz_ior(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
131+ return (VAL)cl;
130132}
131133
132134VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
133− VAL cl = allocBig();
134− mpz_mul_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
135− return cl;
135+ BigInt * cl = allocBig(vm);
136+ mpz_mul_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
137+ return (VAL)cl;
136138}
137139
138140
139141VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
140− VAL cl = allocBig();
141− mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
142− return cl;
142+ BigInt * cl = allocBig(vm);
143+ mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
144+ return (VAL)cl;
143145}
144146
145147VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
146− VAL cl = allocBig();
147− mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
148− return cl;
148+ BigInt * cl = allocBig(vm);
149+ mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
150+ return (VAL)cl;
149151}
150152
151153VAL idris_bigAnd(VM* vm, VAL x, VAL y) {
152154 if (ISINT(x) && ISINT(y)) {
153155 return INTOP(&, x, y);
154156 } else {
155− return bigAnd(vm, GETBIG(vm, x), GETBIG(vm, y));
157+ return bigAnd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
156158 }
157159}
158160
@@ -160,7 +162,7 @@ VAL idris_bigOr(VM* vm, VAL x, VAL y) {
160162 if (ISINT(x) && ISINT(y)) {
161163 return INTOP(|, x, y);
162164 } else {
163− return bigOr(vm, GETBIG(vm, x), GETBIG(vm, y));
165+ return bigOr(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
164166 }
165167}
166168
@@ -173,12 +175,12 @@ VAL idris_bigPlus(VM* vm, VAL x, VAL y) {
173175 }
174176 i_int res = vx + vy;
175177 if (res >= 1<<30 || res <= -(1 << 30)) {
176− return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
178+ return bigAdd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
177179 } else {
178180 return MKINT(res);
179181 }
180182 } else {
181− return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
183+ return bigAdd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
182184 }
183185}
184186
@@ -264,29 +266,29 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {
264266int bigEqConst(VAL x, int c) {
265267 if (ISINT(x)) { return (GETINT(x) == c); }
266268 else {
267− int rv = mpz_cmp_si(GETMPZ(x), c);
269+ int rv = mpz_cmp_si(*BIG(x), c);
268270 return (rv == 0);
269271 }
270272}
271273
272274VAL bigEq(VM* vm, VAL x, VAL y) {
273− return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));
275+ return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) == 0));
274276}
275277
276278VAL bigLt(VM* vm, VAL x, VAL y) {
277− return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) < 0));
279+ return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) < 0));
278280}
279281
280282VAL bigGt(VM* vm, VAL x, VAL y) {
281− return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) > 0));
283+ return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) > 0));
282284}
283285
284286VAL bigLe(VM* vm, VAL x, VAL y) {
285− return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) <= 0));
287+ return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) <= 0));
286288}
287289
288290VAL bigGe(VM* vm, VAL x, VAL y) {
289− return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) >= 0));
291+ return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) >= 0));
290292}
291293
292294VAL idris_bigEq(VM* vm, VAL x, VAL y) {
@@ -338,7 +340,7 @@ VAL idris_castBigInt(VM* vm, VAL i) {
338340 if (ISINT(i)) {
339341 return i;
340342 } else {
341− return MKINT((i_int)(mpz_get_ui(GETMPZ(i))));
343+ return MKINT((i_int)(mpz_get_ui(*BIG(i))));
342344 }
343345}
344346
@@ -346,15 +348,15 @@ VAL idris_castBigFloat(VM* vm, VAL i) {
346348 if (ISINT(i)) {
347349 return MKFLOAT(vm, GETINT(i));
348350 } else {
349− return MKFLOAT(vm, mpz_get_d(GETMPZ(i)));
351+ return MKFLOAT(vm, mpz_get_d(*BIG(i)));
350352 }
351353}
352354
353355VAL idris_castFloatBig(VM* vm, VAL f) {
354356 double val = GETFLOAT(f);
355− VAL cl = allocBig();
357+ BigInt * cl = allocBig(vm);
356358 mpz_init_set_d(*big(cl), val);
357− return cl;
359+ return (VAL)cl;
358360}
359361
360362VAL idris_castStrBig(VM* vm, VAL i) {
@@ -362,7 +364,7 @@ VAL idris_castStrBig(VM* vm, VAL i) {
362364}
363365
364366VAL idris_castBigStr(VM* vm, VAL i) {
365− char* str = mpz_get_str(NULL, 10, GETMPZ(GETBIG(vm, i)));
367+ char* str = mpz_get_str(NULL, 10, *big(getbig(vm, i)));
366368 return MKSTR(vm, str);
367369}
368370
rts/idris_gmp.h+1−1
@@ -48,6 +48,6 @@ VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y);
4848
4949uint64_t idris_truncBigB64(const mpz_t bi);
5050
51−#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))
51+#define GETMPZ(x) *((mpz_t*)(((BigInt*)(x))->big))
5252
5353#endif
rts/idris_heap.c+4−3
@@ -192,10 +192,11 @@ void heap_check_pointers(Heap * heap) {
192192 switch(GETTY(heap_item)) {
193193 case CT_CON:
194194 {
195− int ar = CARITY(heap_item);
196− int i = 0;
195+ Con * c = (Con*)heap_item;
196+ size_t ar = CARITY(c);
197+ size_t i;
197198 for(i = 0; i < ar; ++i) {
198− VAL ptr = heap_item->extra.cargs[i];
199+ VAL ptr = c->args[i];
199200
200201 if (is_valid_ref(ptr)) {
201202 // Check for closure.
rts/idris_rts.c+172−183
@@ -7,10 +7,10 @@
77#include "idris_bitstring.h"
88#include "getline.h"
99
10−#define STATIC_ASSERT(COND,MSG) typedef char static_assertion_##MSG[(COND)?1:-1]
11−
10+#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)
11+#include <signal.h>
12+#endif
1213
13−STATIC_ASSERT(sizeof(Closure) == 16, sizeofClosure);
1414
1515#ifdef HAS_PTHREAD
1616static pthread_key_t vm_key;
@@ -18,7 +18,7 @@ static pthread_key_t vm_key;
1818static VM* global_vm;
1919#endif
2020
21−void free_key(VM *vm) {
21+void free_key(void *vvm) {
2222 // nothing to free, we just used the VM pointer which is freed elsewhere
2323}
2424
@@ -88,7 +88,6 @@ VM* idris_vm(void) {
8888
8989VM* get_vm(void) {
9090#ifdef HAS_PTHREAD
91− init_threadkeys();
9291 return pthread_getspecific(vm_key);
9392#else
9493 return global_vm;
@@ -101,7 +100,7 @@ void close_vm(VM* vm) {
101100
102101#ifdef HAS_PTHREAD
103102void create_key(void) {
104− pthread_key_create(&vm_key, (void*)free_key);
103+ pthread_key_create(&vm_key, free_key);
105104}
106105#endif
107106
@@ -160,13 +159,7 @@ CData cdata_manage(void * data, size_t size, CDataFinalizer finalizer)
160159 return c_heap_create_item(data, size, finalizer);
161160}
162161
163−void idris_requireAlloc(size_t size) {
164−#ifdef HAS_PTHREAD
165− VM* vm = pthread_getspecific(vm_key);
166−#else
167− VM* vm = global_vm;
168−#endif
169−
162+void idris_requireAlloc(VM * vm, size_t size) {
170163 if (!(vm->heap.next + size < vm->heap.end)) {
171164 idris_gc(vm);
172165 }
@@ -178,9 +171,8 @@ void idris_requireAlloc(size_t size) {
178171#endif
179172}
180173
181−void idris_doneAlloc(void) {
174+void idris_doneAlloc(VM * vm) {
182175#ifdef HAS_PTHREAD
183− VM* vm = pthread_getspecific(vm_key);
184176 int lock = vm->processes > 0;
185177 if (lock) { // We only need to lock if we're in concurrent mode
186178 pthread_mutex_unlock(&vm->alloc_lock);
@@ -193,10 +185,9 @@ int space(VM* vm, size_t size) {
193185}
194186
195187void* idris_alloc(size_t size) {
196− Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);
188+ RawData * cl = (RawData*) allocate(sizeof(*cl)+size, 0);
197189 SETTY(cl, CT_RAWDATA);
198− cl->extrasz = size;
199− return (void*)(cl+1);
190+ return (void*)cl->raw;
200191}
201192
202193void* idris_realloc(void* old, size_t old_size, size_t size) {
@@ -208,19 +199,20 @@ void* idris_realloc(void* old, size_t old_size, size_t size) {
208199void idris_free(void* ptr, size_t size) {
209200}
210201
211−void* allocate(size_t isize, int outerlock) {
202+void * allocate(size_t sz, int lock) {
203+ return iallocate(get_vm(), sz, lock);
204+}
205+
206+void* iallocate(VM * vm, size_t isize, int outerlock) {
212207// return malloc(size);
213208 size_t size = aligned(isize);
214209
215210#ifdef HAS_PTHREAD
216− VM* vm = pthread_getspecific(vm_key);
217211 int lock = vm->processes > 0 && !outerlock;
218212
219213 if (lock) { // not message passing
220214 pthread_mutex_lock(&vm->alloc_lock);
221215 }
222−#else
223− VM* vm = global_vm;
224216#endif
225217
226218 if (vm->heap.next + size < vm->heap.end) {
@@ -236,6 +228,7 @@ void* allocate(size_t isize, int outerlock) {
236228 pthread_mutex_unlock(&vm->alloc_lock);
237229 }
238230#endif
231+ ((Hdr*)ptr)->sz = size;
239232 return (void*)ptr;
240233 } else {
241234 // If we're trying to allocate something bigger than the heap,
@@ -249,104 +242,97 @@ void* allocate(size_t isize, int outerlock) {
249242 pthread_mutex_unlock(&vm->alloc_lock);
250243 }
251244#endif
252− return allocate(size, 0);
245+ return iallocate(vm, size, outerlock);
253246 }
254247
255248}
256249
257−static Closure * allocStr(size_t len, int outer) {
258− Closure * cl = allocate(sizeof(Closure) + len + 1, outer);
250+static String * allocStr(VM * vm, size_t len, int outer) {
251+ String * cl = iallocate(vm, sizeof(*cl) + len + 1, outer);
259252 SETTY(cl, CT_STRING);
260− cl->extrasz = len + 1;
261− cl->info.slen = len;
253+ cl->slen = len;
262254 return cl;
263255}
264256
265−/* Now a macro
266−void* allocCon(VM* vm, int arity, int outer) {
267− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity,
268− outer);
269− SETTY(cl, CT_CON);
270−
271− cl -> info.c.arity = arity;
272−// cl -> info.c.tag = 42424242;
273−// printf("%p\n", cl);
274− return (void*)cl;
275−}
276−*/
277−
278257VAL MKFLOAT(VM* vm, double val) {
279− Closure* cl = allocate(sizeof(Closure), 0);
258+ Float * cl = iallocate(vm, sizeof(*cl), 0);
280259 SETTY(cl, CT_FLOAT);
281− cl -> info.f = val;
282− return cl;
260+ cl->f = val;
261+ return (VAL)cl;
283262}
284263
285264VAL MKSTRlen(VM* vm, const char * str, size_t len) {
286− Closure* cl = allocStr(len, 0);
287− memcpy(cl->extra.str, str, len);
265+ String * cl = allocStr(vm, len, 0);
266+ memcpy(cl->str, str, len);
288267 if (str == NULL)
289− cl->info.slen = ~0;
290− return cl;
268+ cl->slen = ~0;
269+ return (VAL)cl;
291270}
292271
293272VAL MKSTR(VM* vm, const char* str) {
294273 return MKSTRlen(vm, str, str? strlen(str) : 0);
295274}
296275
276+static char * getstroff(StrOffset * stroff) {
277+ return stroff->base->str + stroff->offset;
278+}
279+
297280char* GETSTROFF(VAL stroff) {
298281 // Assume STROFF
299− return stroff->extra.basestr[0]->extra.str + stroff->info.soffset;
282+ return getstroff((StrOffset*)stroff);
283+}
284+
285+static size_t getstrofflen(StrOffset * stroff) {
286+ return stroff->base->slen - stroff->offset;
300287}
301288
302289size_t GETSTROFFLEN(VAL stroff) {
303290 // Assume STROFF
304291 // we're working in char* here so no worries about utf8 char length
305− return stroff->extra.basestr[0]->info.slen - stroff->info.soffset;
292+ return getstrofflen((StrOffset*)stroff);
306293}
307294
308295VAL MKCDATA(VM* vm, CHeapItem * item) {
309296 c_heap_insert_if_needed(vm, &vm->c_heap, item);
310− Closure* cl = allocate(sizeof(Closure), 0);
297+ CDataC * cl = iallocate(vm, sizeof(*cl), 0);
311298 SETTY(cl, CT_CDATA);
312− cl->info.c_heap_item = item;
313− return cl;
299+ cl->item = item;
300+ return (VAL)cl;
314301}
315302
316303VAL MKCDATAc(VM* vm, CHeapItem * item) {
317304 c_heap_insert_if_needed(vm, &vm->c_heap, item);
318− Closure* cl = allocate(sizeof(Closure), 1);
305+ CDataC * cl = iallocate(vm, sizeof(*cl), 1);
319306 SETTY(cl, CT_CDATA);
320− cl->info.c_heap_item = item;
321− return cl;
307+ cl->item = item;
308+ return (VAL)cl;
322309}
323310
324311VAL MKPTR(VM* vm, void* ptr) {
325− Closure* cl = allocate(sizeof(Closure), 0);
312+ Ptr * cl = iallocate(vm, sizeof(*cl), 0);
326313 SETTY(cl, CT_PTR);
327− cl -> info.ptr = ptr;
328− return cl;
314+ cl->ptr = ptr;
315+ return (VAL)cl;
329316}
330317
331318VAL MKMPTR(VM* vm, void* ptr, size_t size) {
332− Closure* cl = allocate(sizeof(Closure) + size, 0);
319+ ManagedPtr * cl = iallocate(vm, sizeof(*cl) + size, 0);
333320 SETTY(cl, CT_MANAGEDPTR);
334− memcpy(cl->extra.mptr, ptr, size);
335− cl->extrasz = size;
336− return cl;
321+ memcpy(cl->mptr, ptr, size);
322+ return (VAL)cl;
337323}
338324
339325VAL MKFLOATc(VM* vm, double val) {
340− Closure* cl = allocate(sizeof(Closure), 1);
326+ Float * cl = iallocate(vm, sizeof(*cl), 1);
341327 SETTY(cl, CT_FLOAT);
342− cl -> info.f = val;
343− return cl;
328+ cl->f = val;
329+ return (VAL)cl;
344330}
345331
346332VAL MKSTRclen(VM* vm, char* str, size_t len) {
347− Closure* cl = allocStr(len, 1);
348− memcpy(cl->extra.str, str, len);
349− return cl;
333+ String * cl = allocStr(vm, len, 1);
334+ memcpy(cl->str, str, len);
335+ return (VAL)cl;
350336}
351337
352338VAL MKSTRc(VM* vm, char* str) {
@@ -354,46 +340,45 @@ VAL MKSTRc(VM* vm, char* str) {
354340}
355341
356342VAL MKPTRc(VM* vm, void* ptr) {
357− Closure* cl = allocate(sizeof(Closure), 1);
343+ Ptr * cl = iallocate(vm, sizeof(*cl), 1);
358344 SETTY(cl, CT_PTR);
359− cl -> info.ptr = ptr;
360− return cl;
345+ cl->ptr = ptr;
346+ return (VAL)cl;
361347}
362348
363349VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
364− Closure* cl = allocate(sizeof(Closure) + size, 1);
350+ ManagedPtr * cl = iallocate(vm, sizeof(*cl) + size, 1);
365351 SETTY(cl, CT_MANAGEDPTR);
366− memcpy(cl->extra.mptr, ptr, size);
367− cl->extrasz = size;
368− return cl;
352+ memcpy(cl->mptr, ptr, size);
353+ return (VAL)cl;
369354}
370355
371356VAL MKB8(VM* vm, uint8_t bits8) {
372− Closure* cl = allocate(sizeof(Closure), 1);
357+ Bits8 * cl = iallocate(vm, sizeof(*cl), 1);
373358 SETTY(cl, CT_BITS8);
374− cl -> info.bits8 = bits8;
375− return cl;
359+ cl->bits8 = bits8;
360+ return (VAL)cl;
376361}
377362
378363VAL MKB16(VM* vm, uint16_t bits16) {
379− Closure* cl = allocate(sizeof(Closure), 1);
364+ Bits16 * cl = iallocate(vm, sizeof(*cl), 1);
380365 SETTY(cl, CT_BITS16);
381− cl -> info.bits16 = bits16;
382− return cl;
366+ cl->bits16 = bits16;
367+ return (VAL)cl;
383368}
384369
385370VAL MKB32(VM* vm, uint32_t bits32) {
386− Closure* cl = allocate(sizeof(Closure), 1);
371+ Bits32 * cl = iallocate(vm, sizeof(*cl), 1);
387372 SETTY(cl, CT_BITS32);
388− cl -> info.bits32 = bits32;
389− return cl;
373+ cl->bits32 = bits32;
374+ return (VAL)cl;
390375}
391376
392377VAL MKB64(VM* vm, uint64_t bits64) {
393− Closure* cl = allocate(sizeof(Closure), 1);
378+ Bits64 * cl = iallocate(vm, sizeof(*cl), 1);
394379 SETTY(cl, CT_BITS64);
395− cl -> info.bits64 = bits64;
396− return cl;
380+ cl->bits64 = bits64;
381+ return (VAL)cl;
397382}
398383
399384void idris_trace(VM* vm, const char* func, int line) {
@@ -427,25 +412,29 @@ void dumpVal(VAL v) {
427412 return;
428413 }
429414 switch(GETTY(v)) {
430− case CT_CON:
431− printf("%d[", (int)TAG(v));
432− for(i = 0; i < CARITY(v); ++i) {
433− dumpVal(v->extra.cargs[i]);
434− }
435− printf("] ");
436− break;
437− case CT_STRING:
438− printf("STR[%s]", v->extra.str);
439− break;
440− case CT_STROFFSET:
415+ case CT_CON: {
416+ Con * cl = (Con*)v;
417+ printf("%d[", (int)TAG(cl));
418+ for(i = 0; i < CARITY(cl); ++i) {
419+ dumpVal(cl->args[i]);
420+ }
421+ printf("] ");
422+ } break;
423+ case CT_STRING: {
424+ String * cl = (String*)v;
425+ printf("STR[%s]", cl->str);
426+ } break;
427+ case CT_STROFFSET: {
428+ StrOffset * cl = (StrOffset*)v;
441429 printf("OFFSET[");
442− dumpVal((VAL)(v->extra.basestr[0]));
430+ dumpVal((VAL)cl->base);
443431 printf("]");
444− break;
445− case CT_FWD:
432+ } break;
433+ case CT_FWD: {
434+ Fwd * cl = (Fwd*)v;
446435 printf("CT_FWD ");
447− dumpVal((VAL)(v->info.ptr));
448− break;
436+ dumpVal((VAL)cl->fwd);
437+ } break;
449438 default:
450439 printf("val");
451440 }
@@ -466,7 +455,7 @@ void idris_poke(void* ptr, i_int offset, uint8_t data) {
466455
467456
468457VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset) {
469− void** addr = (void **)((char *)GETPTR(ptr) + GETINT(offset));
458+ void** addr = (void **)(((char *)GETPTR(ptr)) + GETINT(offset));
470459 return MKPTR(vm, *addr);
471460}
472461
@@ -500,41 +489,41 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i
500489
501490VAL idris_castIntStr(VM* vm, VAL i) {
502491 int x = (int) GETINT(i);
503− Closure* cl = allocStr(16, 0);
504− cl->info.slen = sprintf(cl->extra.str, "%d", x);
505− return cl;
492+ String * cl = allocStr(vm, 16, 0);
493+ cl->slen = sprintf(cl->str, "%d", x);
494+ return (VAL)cl;
506495}
507496
508497VAL idris_castBitsStr(VM* vm, VAL i) {
509− Closure* cl;
498+ String * cl;
510499 ClosureType ty = GETTY(i);
511500
512501 switch (ty) {
513502 case CT_BITS8:
514503 // max length 8 bit unsigned int str 3 chars (256)
515− cl = allocStr(4, 0);
516− cl->info.slen = sprintf(cl->extra.str, "%" PRIu8, GETBITS8(i));
504+ cl = allocStr(vm, 4, 0);
505+ cl->slen = sprintf(cl->str, "%" PRIu8, GETBITS8(i));
517506 break;
518507 case CT_BITS16:
519508 // max length 16 bit unsigned int str 5 chars (65,535)
520− cl = allocStr(6, 0);
521− cl->info.slen = sprintf(cl->extra.str, "%" PRIu16, GETBITS16(i));
509+ cl = allocStr(vm, 6, 0);
510+ cl->slen = sprintf(cl->str, "%" PRIu16, GETBITS16(i));
522511 break;
523512 case CT_BITS32:
524513 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
525− cl = allocStr(11, 0);
526− cl->info.slen = sprintf(cl->extra.str, "%" PRIu32, GETBITS32(i));
514+ cl = allocStr(vm, 11, 0);
515+ cl->slen = sprintf(cl->str, "%" PRIu32, GETBITS32(i));
527516 break;
528517 case CT_BITS64:
529518 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
530− cl = allocStr(21, 0);
531− cl->info.slen = sprintf(cl->extra.str, "%" PRIu64, GETBITS64(i));
519+ cl = allocStr(vm, 21, 0);
520+ cl->slen = sprintf(cl->str, "%" PRIu64, GETBITS64(i));
532521 break;
533522 default:
534523 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
535524 exit(EXIT_FAILURE);
536525 }
537− return cl;
526+ return (VAL)cl;
538527}
539528
540529VAL idris_castStrInt(VM* vm, VAL i) {
@@ -547,9 +536,9 @@ VAL idris_castStrInt(VM* vm, VAL i) {
547536}
548537
549538VAL idris_castFloatStr(VM* vm, VAL i) {
550− Closure* cl = allocStr(32, 0);
551− cl->info.slen = snprintf(cl->extra.str, 32, "%.16g", GETFLOAT(i));
552− return cl;
539+ String * cl = allocStr(vm, 32, 0);
540+ cl->slen = snprintf(cl->str, 32, "%.16g", GETFLOAT(i));
541+ return (VAL)cl;
553542}
554543
555544VAL idris_castStrFloat(VM* vm, VAL i) {
@@ -562,10 +551,10 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
562551 size_t llen = GETSTRLEN(l);
563552 size_t rlen = GETSTRLEN(r);
564553
565− Closure* cl = allocStr(llen + rlen, 0);
566− memcpy(cl->extra.str, ls, llen);
567− memcpy(cl->extra.str + llen, rs, rlen);
568− return cl;
554+ String * cl = allocStr(vm, llen + rlen, 0);
555+ memcpy(cl->str, ls, llen);
556+ memcpy(cl->str + llen, rs, rlen);
557+ return (VAL)cl;
569558}
570559
571560VAL idris_strlt(VM* vm, VAL l, VAL r) {
@@ -627,32 +616,31 @@ VAL idris_strHead(VM* vm, VAL str) {
627616}
628617
629618VAL MKSTROFFc(VM* vm, VAL basestr) {
630− Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 1);
619+ StrOffset * cl = iallocate(vm, sizeof(*cl), 1);
631620 SETTY(cl, CT_STROFFSET);
632− cl->extrasz = sizeof(VAL);
633− cl->extra.basestr[0] = basestr;
634− return cl;
621+ cl->base = (String*)basestr;
622+ return (VAL)cl;
635623}
636624
637625VAL idris_strShift(VM* vm, VAL str, int num) {
626+ size_t sz = sizeof(StrOffset);
638627 // If there's no room, just copy the string, or we'll have a problem after
639628 // gc moves str
640− if (space(vm, sizeof(Closure))) {
629+ if (space(vm, sz)) {
641630 int offset = 0;
642− VAL root = str;
643− Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 0);
631+ StrOffset * root = (StrOffset*)str;
632+ StrOffset * cl = iallocate(vm, sz, 0);
644633 SETTY(cl, CT_STROFFSET);
645− cl->extrasz = sizeof(VAL);
646634
647635 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
648636 // In theory, at most one step here!
649− offset += root->info.soffset;
650− root = root->extra.basestr[0];
637+ offset += root->offset;
638+ root = (StrOffset*)root->base;
651639 }
652640
653− cl->extra.basestr[0] = root;
654− cl->info.soffset = offset+idris_utf8_findOffset(GETSTR(str), num);
655− return cl;
641+ cl->base = (String*)root;
642+ cl->offset = offset+idris_utf8_findOffset(GETSTR(str), num);
643+ return (VAL)cl;
656644 } else {
657645 char* nstr = GETSTR(str);
658646 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));
@@ -667,22 +655,22 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {
667655 char *xstr = GETSTR(xs);
668656 int xval = GETINT(x);
669657 size_t xlen = GETSTRLEN(xs);
658+ String * cl;
670659
671660 if (xval < 0x80) { // ASCII char
672− Closure* cl = allocStr(xlen + 1, 0);
673− cl->extra.str[0] = (char)(GETINT(x));
674− memcpy(cl->extra.str+1, xstr, xlen);
675− return cl;
661+ cl = allocStr(vm, xlen + 1, 0);
662+ cl->str[0] = (char)(GETINT(x));
663+ memcpy(cl->str+1, xstr, xlen);
676664 } else {
677665 char *init = idris_utf8_fromChar(xval);
678666 size_t ilen = strlen(init);
679667 int newlen = ilen + xlen;
680− Closure* cl = allocStr(newlen, 0);
681− memcpy(cl->extra.str, init, ilen);
682− memcpy(cl->extra.str + ilen, xstr, xlen);
668+ cl = allocStr(vm, newlen, 0);
669+ memcpy(cl->str, init, ilen);
670+ memcpy(cl->str + ilen, xstr, xlen);
683671 free(init);
684− return cl;
685672 }
673+ return (VAL)cl;
686674}
687675
688676VAL idris_strIndex(VM* vm, VAL str, VAL i) {
@@ -703,10 +691,10 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {
703691 char *start = idris_utf8_advance(str_val, offset_val);
704692 char *end = idris_utf8_advance(start, length_val);
705693 size_t sz = end - start;
706− Closure* newstr = allocStr(sz, 0);
707− memcpy(newstr->extra.str, start, sz);
708− newstr->extra.str[sz] = '\0';
709− return newstr;
694+ String * newstr = allocStr(vm, sz, 0);
695+ memcpy(newstr->str, start, sz);
696+ newstr->str[sz] = '\0';
697+ return (VAL)newstr;
710698 }
711699}
712700
@@ -714,16 +702,16 @@ VAL idris_strRev(VM* vm, VAL str) {
714702 char *xstr = GETSTR(str);
715703 size_t xlen = GETSTRLEN(str);
716704
717− Closure* cl = allocStr(xlen, 0);
718− idris_utf8_rev(xstr, cl->extra.str);
719− return cl;
705+ String * cl = allocStr(vm, xlen, 0);
706+ idris_utf8_rev(xstr, cl->str);
707+ return (VAL)cl;
720708}
721709
722710VAL idris_newRefLock(VAL x, int outerlock) {
723− Closure* cl = allocate(sizeof(Closure), outerlock);
711+ Ref * cl = allocate(sizeof(*cl), outerlock);
724712 SETTY(cl, CT_REF);
725− cl->info.ptr = (void*)x;
726− return cl;
713+ cl->ref = x;
714+ return (VAL)cl;
727715}
728716
729717VAL idris_newRef(VAL x) {
@@ -731,30 +719,34 @@ VAL idris_newRef(VAL x) {
731719}
732720
733721void idris_writeRef(VAL ref, VAL x) {
734− ref->info.ptr = (void*)x;
722+ Ref * r = (Ref*)ref;
723+ r->ref = x;
735724 SETTY(ref, CT_REF);
736725}
737726
738727VAL idris_readRef(VAL ref) {
739− return (VAL)(ref->info.ptr);
728+ Ref * r = (Ref*)ref;
729+ return r->ref;
740730}
741731
742732VAL idris_newArray(VM* vm, int size, VAL def) {
743− Closure* cl;
733+ Array * cl;
744734 int i;
745− allocArray(cl, vm, size, 0);
735+ cl = allocArrayF(vm, size, 0);
746736 for(i=0; i<size; ++i) {
747− cl->extra.array[i] = def;
737+ cl->array[i] = def;
748738 }
749− return cl;
739+ return (VAL)cl;
750740}
751741
752742void idris_arraySet(VAL arr, int index, VAL newval) {
753− arr->extra.array[index] = newval;
743+ Array * cl = (Array*)arr;
744+ cl->array[index] = newval;
754745}
755746
756747VAL idris_arrayGet(VAL arr, int index) {
757− return arr->extra.array[index];
748+ Array * cl = (Array*)arr;
749+ return cl->array[index];
758750}
759751
760752VAL idris_systemInfo(VM* vm, VAL index) {
@@ -847,8 +839,8 @@ static void copyArray(VM* vm, VAL * dst, VAL * src, size_t len) {
847839// VM is assumed to be a different vm from the one x lives on
848840
849841static VAL doCopyTo(VM* vm, VAL x) {
850− int ar, len;
851− Closure* cl;
842+ int ar;
843+ VAL cl;
852844 if (x==NULL || ISINT(x)) {
853845 return x;
854846 }
@@ -857,22 +849,24 @@ static VAL doCopyTo(VM* vm, VAL x) {
857849 cl = MKCDATAc(vm, GETCDATA(x));
858850 break;
859851 case CT_BIGINT:
860− cl = MKBIGMc(vm, GETPTR(x));
852+ cl = MKBIGMc(vm, GETMPZ(x));
861853 break;
862854 case CT_CON:
863855 ar = CARITY(x);
864856 if (ar == 0 && CTAG(x) < 256) { // globally allocated
865857 cl = x;
866858 } else {
867− allocCon(cl, vm, CTAG(x), ar, 1);
868− copyArray(vm, cl->extra.cargs, x->extra.cargs, ar);
859+ Con * c = allocConF(vm, CTAG(x), ar, 1);
860+ copyArray(vm, c->args, ((Con*)x)->args, ar);
861+ cl = (VAL)c;
869862 }
870863 break;
871− case CT_ARRAY:
872− len = CELEM(x);
873− allocArray(cl, vm, len, 1);
874− copyArray(vm, cl->extra.array, x->extra.array, len);
875− break;
864+ case CT_ARRAY: {
865+ size_t len = CELEM(x);
866+ Array * a = allocArrayF(vm, len, 1);
867+ copyArray(vm, a->array, ((Array*)x)->array, len);
868+ cl = (VAL)a;
869+ } break;
876870 case CT_STRING:
877871 case CT_FLOAT:
878872 case CT_PTR:
@@ -883,9 +877,8 @@ static VAL doCopyTo(VM* vm, VAL x) {
883877 case CT_BITS64:
884878 case CT_RAWDATA:
885879 {
886− size_t size = sizeof(Closure) + x->extrasz;
887− cl = allocate(size, 0);
888− memcpy(cl, x, size);
880+ cl = iallocate(vm, x->hdr.sz, 0);
881+ memcpy(cl, x, x->hdr.sz);
889882 }
890883 break;
891884 default:
@@ -895,10 +888,7 @@ static VAL doCopyTo(VM* vm, VAL x) {
895888}
896889
897890VAL copyTo(VM* vm, VAL x) {
898− VM* current = pthread_getspecific(vm_key);
899− pthread_setspecific(vm_key, vm);
900891 VAL ret = doCopyTo(vm, x);
901− pthread_setspecific(vm_key, current);
902892 return ret;
903893}
904894
@@ -1116,13 +1106,12 @@ VAL* nullary_cons;
11161106
11171107void init_nullaries(void) {
11181108 int i;
1119− VAL cl;
11201109 nullary_cons = malloc(256 * sizeof(VAL));
11211110 for(i = 0; i < 256; ++i) {
1122− cl = calloc(1, sizeof(Closure));
1111+ Con * cl = calloc(1, sizeof(*cl));
11231112 SETTY(cl, CT_CON);
1124− cl->info.tag = i;
1125− nullary_cons[i] = cl;
1113+ cl->tag = i;
1114+ nullary_cons[i] = (VAL)cl;
11261115 }
11271116}
11281117
rts/idris_rts.h+158−76
@@ -3,19 +3,17 @@
33
44#include <stdlib.h>
55#include <stdio.h>
6+#include <stdatomic.h>
7+#ifdef HAS_PTHREAD
68#include <string.h>
79#include <stdarg.h>
8−#ifdef HAS_PTHREAD
910#include <pthread.h>
1011#endif
11−#include <stdint.h>
12−#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)
13−#include <signal.h>
14−#endif
1512
1613#include "idris_heap.h"
1714#include "idris_stats.h"
1815
16+
1917#ifndef EXIT_SUCCESS
2018#define EXIT_SUCCESS 0
2119#endif
@@ -26,36 +24,111 @@
2624// Closures
2725typedef enum {
2826 CT_CON, CT_ARRAY, CT_INT, CT_BIGINT, CT_FLOAT, CT_STRING, CT_STROFFSET,
29− CT_BITS8, CT_BITS16, CT_BITS32, CT_BITS64, CT_UNIT, CT_PTR, CT_REF,
27+ CT_BITS8, CT_BITS16, CT_BITS32, CT_BITS64, CT_PTR, CT_REF,
3028 CT_FWD, CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA
3129} ClosureType;
3230
33−typedef struct Closure *VAL;
3431
35−typedef struct Closure {
32+typedef struct Hdr {
3633 uint64_t ty:8;
37− uint64_t extrasz:56;
38− union {
39− uint32_t tag;
40− size_t slen;
41− size_t soffset;
42− int i;
43− double f;
44− void * ptr;
45− uint8_t bits8;
46− uint16_t bits16;
47− uint32_t bits32;
48− uint64_t bits64;
49− CHeapItem* c_heap_item;
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;
58−} Closure;
34+ uint64_t sz:56;
35+} Hdr;
36+
37+
38+typedef struct Val {
39+ Hdr hdr;
40+} Val;
41+
42+typedef struct Val * VAL;
43+
44+typedef struct Con {
45+ Hdr hdr;
46+ uint32_t tag;
47+ uint32_t arity;
48+ VAL args[0];
49+} Con;
50+
51+typedef struct Array {
52+ Hdr hdr;
53+ VAL array[0];
54+} Array;
55+
56+typedef struct Int {
57+ Hdr hdr;
58+ int i;
59+} Int;
60+
61+typedef struct BigInt {
62+ Hdr hdr;
63+ char big[0];
64+} BigInt;
65+
66+typedef struct Float {
67+ Hdr hdr;
68+ double f;
69+} Float;
70+
71+typedef struct String {
72+ Hdr hdr;
73+ size_t slen;
74+ char str[0];
75+} String;
76+
77+typedef struct StrOffset {
78+ Hdr hdr;
79+ String * base;
80+ size_t offset;
81+} StrOffset;
82+
83+typedef struct Bits8 {
84+ Hdr hdr;
85+ uint8_t bits8;
86+} Bits8;
87+
88+typedef struct Bits16 {
89+ Hdr hdr;
90+ uint16_t bits16;
91+} Bits16;
92+
93+typedef struct Bits32 {
94+ Hdr hdr;
95+ uint32_t bits32;
96+} Bits32;
97+
98+typedef struct Bits64 {
99+ Hdr hdr;
100+ uint64_t bits64;
101+} Bits64;
102+
103+typedef struct Ptr {
104+ Hdr hdr;
105+ void * ptr;
106+} Ptr;
107+
108+typedef struct Ref {
109+ Hdr hdr;
110+ VAL ref;
111+} Ref;
112+
113+typedef struct Fwd {
114+ Hdr hdr;
115+ VAL fwd;
116+} Fwd;
117+
118+typedef struct ManagedPtr {
119+ Hdr hdr;
120+ char mptr[0];
121+} ManagedPtr;
122+
123+typedef struct RawData {
124+ Hdr hdr;
125+ char raw[0];
126+} RawData;
127+
128+typedef struct CDataC {
129+ Hdr hdr;
130+ CHeapItem * item;
131+} CDataC;
59132
60133struct VM;
61134
@@ -164,37 +237,37 @@ typedef void(*func)(VM*, VAL*);
164237#define REG1 (vm->reg1)
165238
166239// Retrieving values
167−static inline char * getstr(VAL x) {
168− return x->info.slen == ~0? NULL : x->extra.str;
240+static inline char * getstr(String * x) {
241+ return x->slen == ~0? NULL : x->str;
169242}
170243
171−static inline size_t getstrlen(VAL x) {
172− return x->info.slen == ~0? 0 : x->info.slen;
244+static inline size_t getstrlen(String * x) {
245+ return x->slen == ~0? 0 : x->slen;
173246}
174247
175−#define GETSTR(x) (ISSTR(x) ? getstr((VAL)(x)) : GETSTROFF(x))
176−#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((VAL)(x)) : GETSTROFFLEN(x))
177−#define GETPTR(x) (((VAL)(x))->info.ptr)
178−#define GETMPTR(x) (((VAL)(x))->extra.mptr)
179−#define GETFLOAT(x) (((VAL)(x))->info.f)
180−#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)
248+#define GETSTR(x) (ISSTR(x) ? getstr((String*)(x)) : GETSTROFF(x))
249+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((String*)(x)) : GETSTROFFLEN(x))
250+#define GETPTR(x) (((Ptr*)(x))->ptr)
251+#define GETMPTR(x) (((ManagedPtr*)(x))->mptr)
252+#define GETFLOAT(x) (((Float*)(x))->f)
253+#define GETCDATA(x) (((CDataC*)(x))->item)
181254
182−#define GETBITS8(x) (((VAL)(x))->info.bits8)
183−#define GETBITS16(x) (((VAL)(x))->info.bits16)
184−#define GETBITS32(x) (((VAL)(x))->info.bits32)
185−#define GETBITS64(x) (((VAL)(x))->info.bits64)
255+#define GETBITS8(x) (((Bits8*)(x))->bits8)
256+#define GETBITS16(x) (((Bits16*)(x))->bits16)
257+#define GETBITS32(x) (((Bits32*)(x))->bits32)
258+#define GETBITS64(x) (((Bits64*)(x))->bits64)
186259
187260// Already checked it's a CT_CON
188−#define CTAG(x) ((x)->info.tag)
189−#define CARITY(x) (((x)->extrasz) / sizeof(VAL))
261+#define CTAG(x) (((Con*)(x))->tag)
262+#define CARITY(x) (((Con*)(x))->arity)
190263
191−#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG(x) : (-1)) )
192−#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY(x) : (-1)) )
264+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG((Con*)x) : (-1)) )
265+#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY((Con*)x) : (-1)) )
193266
194−#define CELEM(x) (((x)->extrasz) / sizeof(VAL))
267+#define CELEM(x) (((x)->hdr.sz - sizeof(Array)) / sizeof(VAL))
195268
196−#define GETTY(x) ((x)->ty)
197−#define SETTY(x,t) ((x)->ty = t)
269+#define GETTY(x) ((ClosureType)((x)->hdr.ty))
270+#define SETTY(x,t) ((x)->hdr.ty = t)
198271
199272// Integers, floats and operators
200273
@@ -261,14 +334,16 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);
261334char* GETSTROFF(VAL stroff);
262335size_t GETSTROFFLEN(VAL stroff);
263336
264−#define SETARG(x, i, a) ((x)->extra.cargs)[i] = ((VAL)(a))
265−#define GETARG(x, i) ((x)->extra.cargs[i])
337+#define SETARG(x, i, a) (((Con*)(x))->args)[i] = ((VAL)(a))
338+#define GETARG(x, i) (((Con*)(x))->args[i])
266339
267340#define PROJECT(vm,r,loc,num) \
268− memcpy(&(LOC(loc)), (r)->extra.cargs, sizeof(VAL)*num)
341+ memcpy(&(LOC(loc)), ((Con*)(r))->args, sizeof(VAL)*num)
269342#define SLIDE(vm, args) \
270343 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
271344
345+void* iallocate(VM *, size_t, int);
346+
272347void* allocate(size_t size, int outerlock);
273348// void* allocCon(VM* vm, int arity, int outerlock);
274349
@@ -278,8 +353,8 @@ void* allocate(size_t size, int outerlock);
278353// idris_doneAlloc *must* be called when allocation from C is done (as it
279354// may take a lock if other threads are running).
280355
281−void idris_requireAlloc(size_t size);
282−void idris_doneAlloc(void);
356+void idris_requireAlloc(VM *, size_t size);
357+void idris_doneAlloc(VM *);
283358
284359// public interface to allocation (note that this may move other pointers
285360// if allocating beyond the limits given by idris_requireAlloc!)
@@ -288,30 +363,35 @@ void* idris_alloc(size_t size);
288363void* idris_realloc(void* old, size_t old_size, size_t size);
289364void idris_free(void* ptr, size_t size);
290365
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; \
297− } while (0)
366+static inline void updateConF(Con * cl, unsigned tag, unsigned arity) {
367+ SETTY(cl, CT_CON);
368+ cl->tag = tag;
369+ cl->arity = arity;
370+ cl->hdr.sz = sizeof(*cl) + sizeof(VAL) * arity;
371+}
298372
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; \
304− } while (0)
373+static inline Con * allocConF(VM * vm, unsigned tag, unsigned arity, int outer) {
374+ size_t sz = sizeof(VAL) * arity;
375+ Con * cl = iallocate(vm, sizeof(*cl) + sz, outer);
376+ updateConF(cl, tag, arity);
377+ return cl;
378+}
305379
380+static inline Array * allocArrayF(VM * vm, size_t len, int outer) {
381+ size_t sz = sizeof(VAL) * len;
382+ Array * cl = iallocate(vm, sizeof(*cl) + sz, outer);
383+ SETTY(cl, CT_ARRAY);
384+ return cl;
385+}
386+
387+
388+#define allocCon(cl, vm, t, a, o) (cl) = (VAL)allocConF(vm, t, a, o)
389+
390+#define updateCon(cl, old, tag, arity) (cl) = (old); updateConF(cl, tag, arity)
306391
307392#define NULL_CON(x) nullary_cons[x]
308393
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; \
314− } while (0)
394+#define allocArray(cl, vm, len, o) (cl) = (VAL)allocArrayF(vm, len, o)
315395
316396int idris_errno(void);
317397char* idris_showerror(int err);
@@ -449,11 +529,13 @@ void stackOverflow(void);
449529#include "idris_gmp.h"
450530
451531static inline size_t valSize(VAL v) {
452− return sizeof(Closure) + v->extrasz;
532+ return v->hdr.sz;
453533}
454534
455535static inline size_t aligned(size_t sz) {
456536 return (sz + 7) & ~7;
457537}
458538
539+VM* get_vm(void);
540+
459541#endif
rts/idris_stdfgn.c+1−3
@@ -6,7 +6,6 @@
66#include <fcntl.h>
77#include <errno.h>
88#include <sys/stat.h>
9−#include <stdio.h>
109#include <time.h>
1110#include <dirent.h>
1211
@@ -79,7 +78,7 @@ void* idris_dirOpen(char* dname) {
7978
8079void idris_dirClose(void* h) {
8180 DirInfo* di = (DirInfo*)h;
82−
81+
8382 closedir(di->dirptr);
8483 free(di);
8584}
@@ -219,4 +218,3 @@ VAL idris_getString(VM* vm, void* buffer) {
219218 free(sb);
220219 return str;
221220}
222−