git.iko.soy/Idris-dev
on master help sign in
Use a common header instead of a union
4698b9aJorge Acereda
rts/idris_bitstring.c+145−373
compare with master
unifiedsplit
@@ -2,131 +2,94 @@
2
2
3#include "idris_rts.h"
3#include "idris_rts.h"
4
4
5−VAL idris_b8(VM *vm, VAL a) {
5+VAL idris_b8const(VM *vm, uint8_t a) {
6− uint8_t A = GETINT(a);
6+ Bits8 * cl = iallocate(vm, sizeof(*cl), 0);
7− VAL cl = allocate(sizeof(Closure), 0);
8 SETTY(cl, CT_BITS8);
7 SETTY(cl, CT_BITS8);
9− cl->info.bits8 = (uint8_t) A;
8+ cl->bits8 = a;
10− return cl;
9+ return (VAL)cl;
11}
10}
12
11
13−VAL idris_b16(VM *vm, VAL a) {
12+VAL idris_b16const(VM *vm, uint16_t a) {
14− uint16_t A = GETINT(a);
13+ Bits16 * cl = iallocate(vm, sizeof(*cl), 0);
15− VAL cl = allocate(sizeof(Closure), 0);
16 SETTY(cl, CT_BITS16);
14 SETTY(cl, CT_BITS16);
17− cl->info.bits16 = (uint16_t) A;
15+ cl->bits16 = a;
18− return cl;
16+ return (VAL)cl;
19}
17}
20
18
21−VAL idris_b32(VM *vm, VAL a) {
19+VAL idris_b32const(VM *vm, uint32_t a) {
22− uint32_t A = GETINT(a);
20+ Bits32 * cl = iallocate(vm, sizeof(*cl), 0);
23− VAL cl = allocate(sizeof(Closure), 0);
24 SETTY(cl, CT_BITS32);
21 SETTY(cl, CT_BITS32);
25− cl->info.bits32 = (uint32_t) A;
22+ cl->bits32 = a;
26− return cl;
23+ return (VAL)cl;
27}
24}
28
25
29−VAL idris_b64(VM *vm, VAL a) {
26+VAL idris_b64const(VM *vm, uint64_t a) {
30− uint64_t A = GETINT(a);
27+ Bits64 * cl = iallocate(vm, sizeof(*cl), 0);
31− VAL cl = allocate(sizeof(Closure), 0);
32 SETTY(cl, CT_BITS64);
28 SETTY(cl, CT_BITS64);
33− cl->info.bits64 = (uint64_t) A;
29+ cl->bits64 = a;
34− return cl;
30+ return (VAL)cl;
35}
31}
36
32
37−VAL idris_castB32Int(VM *vm, VAL a) {
33+VAL idris_b8(VM *vm, VAL a) {
38− return MKINT(GETBITS32(a));
34+ return idris_b8const(vm, GETINT(a));
39}
35}
40
36
41−VAL idris_b8const(VM *vm, uint8_t a) {
37+VAL idris_b16(VM *vm, VAL a) {
42− VAL cl = allocate(sizeof(Closure), 0);
38+ return idris_b16const(vm, GETINT(a));
43− SETTY(cl, CT_BITS8);
44− cl->info.bits8 = a;
45− return cl;
46}
39}
47
40
48−VAL idris_b16const(VM *vm, uint16_t a) {
41+VAL idris_b32(VM *vm, VAL a) {
49− VAL cl = allocate(sizeof(Closure), 0);
42+ return idris_b32const(vm, GETINT(a));
50− SETTY(cl, CT_BITS16);
51− cl->info.bits16 = a;
52− return cl;
53}
43}
54
44
55−VAL idris_b32const(VM *vm, uint32_t a) {
45+VAL idris_b64(VM *vm, VAL a) {
56− VAL cl = allocate(sizeof(Closure), 0);
46+ return idris_b64const(vm, GETINT(a));
57− SETTY(cl, CT_BITS32);
58− cl->info.bits32 = a;
59− return cl;
60}
47}
61
48
62−VAL idris_b64const(VM *vm, uint64_t a) {
49+VAL idris_castB32Int(VM *vm, VAL a) {
63− VAL cl = allocate(sizeof(Closure), 0);
64− SETTY(cl, CT_BITS64);
65− cl->info.bits64 = a;
66− return cl;
50+ return MKINT(GETBITS32(a));
67}
51}
68
52
69VAL idris_b8Plus(VM *vm, VAL a, VAL b) {
53VAL idris_b8Plus(VM *vm, VAL a, VAL b) {
70 uint8_t A = GETBITS8(a);
54 uint8_t A = GETBITS8(a);
71 uint8_t B = GETBITS8(b);
55 uint8_t B = GETBITS8(b);
72− VAL cl = allocate(sizeof(Closure), 0);
56+ return idris_b8const(vm, A + B);
73− SETTY(cl, CT_BITS8);
74− cl->info.bits8 = A + B;
75− return cl;
76}
57}
77
58
78VAL idris_b8Minus(VM *vm, VAL a, VAL b) {
59VAL idris_b8Minus(VM *vm, VAL a, VAL b) {
79 uint8_t A = GETBITS8(a);
60 uint8_t A = GETBITS8(a);
80 uint8_t B = GETBITS8(b);
61 uint8_t B = GETBITS8(b);
81− VAL cl = allocate(sizeof(Closure), 0);
62+ return idris_b8const(vm, A - B);
82− SETTY(cl, CT_BITS8);
83− cl->info.bits8 = A - B;
84− return cl;
85}
63}
86
64
87VAL idris_b8Times(VM *vm, VAL a, VAL b) {
65VAL idris_b8Times(VM *vm, VAL a, VAL b) {
88 uint8_t A = GETBITS8(a);
66 uint8_t A = GETBITS8(a);
89 uint8_t B = GETBITS8(b);
67 uint8_t B = GETBITS8(b);
90− VAL cl = allocate(sizeof(Closure), 0);
68+ return idris_b8const(vm, A * B);
91− SETTY(cl, CT_BITS8);
92− cl->info.bits8 = A * B;
93− return cl;
94}
69}
95
70
96VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {
71VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {
97 uint8_t A = GETBITS8(a);
72 uint8_t A = GETBITS8(a);
98 uint8_t B = GETBITS8(b);
73 uint8_t B = GETBITS8(b);
99− VAL cl = allocate(sizeof(Closure), 0);
74+ return idris_b8const(vm, A / B);
100− SETTY(cl, CT_BITS8);
101− cl->info.bits8 = A / B;
102− return cl;
103}
75}
104
76
105VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {
77VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {
106− uint8_t A = GETBITS8(a);
78+ int8_t A = GETBITS8(a);
107− uint8_t B = GETBITS8(b);
79+ int8_t B = GETBITS8(b);
108− VAL cl = allocate(sizeof(Closure), 0);
80+ return idris_b8const(vm, A / B);
109− SETTY(cl, CT_BITS8);
110− cl->info.bits8 = (uint8_t) (((int8_t) A) / ((int8_t) B));
111− return cl;
112}
81}
113
82
114VAL idris_b8URem(VM *vm, VAL a, VAL b) {
83VAL idris_b8URem(VM *vm, VAL a, VAL b) {
115 uint8_t A = GETBITS8(a);
84 uint8_t A = GETBITS8(a);
116 uint8_t B = GETBITS8(b);
85 uint8_t B = GETBITS8(b);
117− VAL cl = allocate(sizeof(Closure), 0);
86+ return idris_b8const(vm, A % B);
118− SETTY(cl, CT_BITS8);
119− cl->info.bits8 = A % B;
120− return cl;
121}
87}
122
88
123VAL idris_b8SRem(VM *vm, VAL a, VAL b) {
89VAL idris_b8SRem(VM *vm, VAL a, VAL b) {
124− uint8_t A = GETBITS8(a);
90+ int8_t A = GETBITS8(a);
125− uint8_t B = GETBITS8(b);
91+ int8_t B = GETBITS8(b);
126− VAL cl = allocate(sizeof(Closure), 0);
92+ return idris_b8const(vm, A % B);
127− SETTY(cl, CT_BITS8);
128− cl->info.bits8 = (uint8_t) (((int8_t) A) % ((int8_t) B));
129− return cl;
130}
93}
131
94
132VAL idris_b8Lt(VM *vm, VAL a, VAL b) {
95VAL idris_b8Lt(VM *vm, VAL a, VAL b) {
@@ -151,127 +114,85 @@ VAL idris_b8Gte(VM *vm, VAL a, VAL b) {
151
114
152VAL idris_b8Compl(VM *vm, VAL a) {
115VAL idris_b8Compl(VM *vm, VAL a) {
153 uint8_t A = GETBITS8(a);
116 uint8_t A = GETBITS8(a);
154− VAL cl = allocate(sizeof(Closure), 0);
117+ return idris_b8const(vm, ~ A);
155− SETTY(cl, CT_BITS8);
156− cl->info.bits8 = ~ A;
157− return cl;
158}
118}
159
119
160VAL idris_b8And(VM *vm, VAL a, VAL b) {
120VAL idris_b8And(VM *vm, VAL a, VAL b) {
161 uint8_t A = GETBITS8(a);
121 uint8_t A = GETBITS8(a);
162 uint8_t B = GETBITS8(b);
122 uint8_t B = GETBITS8(b);
163− VAL cl = allocate(sizeof(Closure), 0);
123+ return idris_b8const(vm, A & B);
164− SETTY(cl, CT_BITS8);
165− cl->info.bits8 = A & B;
166− return cl;
167}
124}
168
125
169VAL idris_b8Or(VM *vm, VAL a, VAL b) {
126VAL idris_b8Or(VM *vm, VAL a, VAL b) {
170 uint8_t A = GETBITS8(a);
127 uint8_t A = GETBITS8(a);
171 uint8_t B = GETBITS8(b);
128 uint8_t B = GETBITS8(b);
172− VAL cl = allocate(sizeof(Closure), 0);
129+ return idris_b8const(vm, A | B);
173− SETTY(cl, CT_BITS8);
174− cl->info.bits8 = A | B;
175− return cl;
176}
130}
177
131
178VAL idris_b8Xor(VM *vm, VAL a, VAL b) {
132VAL idris_b8Xor(VM *vm, VAL a, VAL b) {
179 uint8_t A = GETBITS8(a);
133 uint8_t A = GETBITS8(a);
180 uint8_t B = GETBITS8(b);
134 uint8_t B = GETBITS8(b);
181− VAL cl = allocate(sizeof(Closure), 0);
135+ return idris_b8const(vm, A ^ B);
182− SETTY(cl, CT_BITS8);
183− cl->info.bits8 = A ^ B;
184− return cl;
185}
136}
186
137
187VAL idris_b8Shl(VM *vm, VAL a, VAL b) {
138VAL idris_b8Shl(VM *vm, VAL a, VAL b) {
188 uint8_t A = GETBITS8(a);
139 uint8_t A = GETBITS8(a);
189 uint8_t B = GETBITS8(b);
140 uint8_t B = GETBITS8(b);
190− VAL cl = allocate(sizeof(Closure), 0);
141+ return idris_b8const(vm, A << B);
191− SETTY(cl, CT_BITS8);
192− cl->info.bits8 = A << B;
193− return cl;
194}
142}
195
143
196VAL idris_b8LShr(VM *vm, VAL a, VAL b) {
144VAL idris_b8LShr(VM *vm, VAL a, VAL b) {
197 uint8_t A = GETBITS8(a);
145 uint8_t A = GETBITS8(a);
198 uint8_t B = GETBITS8(b);
146 uint8_t B = GETBITS8(b);
199− VAL cl = allocate(sizeof(Closure), 0);
147+ return idris_b8const(vm, A >> B);
200− SETTY(cl, CT_BITS8);
201− cl->info.bits8 = A >> B;
202− return cl;
203}
148}
204
149
205VAL idris_b8AShr(VM *vm, VAL a, VAL b) {
150VAL idris_b8AShr(VM *vm, VAL a, VAL b) {
206− uint8_t A = GETBITS8(a);
151+ int8_t A = GETBITS8(a);
207− uint8_t B = GETBITS8(b);
152+ int8_t B = GETBITS8(b);
208− VAL cl = allocate(sizeof(Closure), 0);
153+ return idris_b8const(vm, A >> B);
209− SETTY(cl, CT_BITS8);
210− cl->info.bits8 = (uint8_t) (((int8_t) A) >> ((int8_t) B));
211− return cl;
212}
154}
213
155
214VAL idris_b16Plus(VM *vm, VAL a, VAL b) {
156VAL idris_b16Plus(VM *vm, VAL a, VAL b) {
215 uint16_t A = GETBITS16(a);
157 uint16_t A = GETBITS16(a);
216 uint16_t B = GETBITS16(b);
158 uint16_t B = GETBITS16(b);
217− VAL cl = allocate(sizeof(Closure), 0);
159+ return idris_b16const(vm, A + B);
218− SETTY(cl, CT_BITS16);
219− cl->info.bits16 = A + B;
220− return cl;
221}
160}
222
161
223VAL idris_b16Minus(VM *vm, VAL a, VAL b) {
162VAL idris_b16Minus(VM *vm, VAL a, VAL b) {
224 uint16_t A = GETBITS16(a);
163 uint16_t A = GETBITS16(a);
225 uint16_t B = GETBITS16(b);
164 uint16_t B = GETBITS16(b);
226− VAL cl = allocate(sizeof(Closure), 0);
165+ return idris_b16const(vm, A - B);
227− SETTY(cl, CT_BITS16);
228− cl->info.bits16 = A - B;
229− return cl;
230}
166}
231
167
232VAL idris_b16Times(VM *vm, VAL a, VAL b) {
168VAL idris_b16Times(VM *vm, VAL a, VAL b) {
233 uint16_t A = GETBITS16(a);
169 uint16_t A = GETBITS16(a);
234 uint16_t B = GETBITS16(b);
170 uint16_t B = GETBITS16(b);
235− VAL cl = allocate(sizeof(Closure), 0);
171+ return idris_b16const(vm, A * B);
236− SETTY(cl, CT_BITS16);
237− cl->info.bits16 = A * B;
238− return cl;
239}
172}
240
173
241VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {
174VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {
242 uint16_t A = GETBITS16(a);
175 uint16_t A = GETBITS16(a);
243 uint16_t B = GETBITS16(b);
176 uint16_t B = GETBITS16(b);
244− VAL cl = allocate(sizeof(Closure), 0);
177+ return idris_b16const(vm, A / B);
245− SETTY(cl, CT_BITS16);
246− cl->info.bits16 = A / B;
247− return cl;
248}
178}
249
179
250VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {
180VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {
251− uint16_t A = GETBITS16(a);
181+ int16_t A = GETBITS16(a);
252− uint16_t B = GETBITS16(b);
182+ int16_t B = GETBITS16(b);
253− VAL cl = allocate(sizeof(Closure), 0);
183+ return idris_b16const(vm, A / B);
254− SETTY(cl, CT_BITS16);
255− cl->info.bits16 = (uint16_t) (((int16_t) A) / ((int16_t) B));
256− return cl;
257}
184}
258
185
259VAL idris_b16URem(VM *vm, VAL a, VAL b) {
186VAL idris_b16URem(VM *vm, VAL a, VAL b) {
260 uint16_t A = GETBITS16(a);
187 uint16_t A = GETBITS16(a);
261 uint16_t B = GETBITS16(b);
188 uint16_t B = GETBITS16(b);
262− VAL cl = allocate(sizeof(Closure), 0);
189+ return idris_b16const(vm, A % B);
263− SETTY(cl, CT_BITS16);
264− cl->info.bits16 = A % B;
265− return cl;
266}
190}
267
191
268VAL idris_b16SRem(VM *vm, VAL a, VAL b) {
192VAL idris_b16SRem(VM *vm, VAL a, VAL b) {
269− uint16_t A = GETBITS16(a);
193+ int16_t A = GETBITS16(a);
270− uint16_t B = GETBITS16(b);
194+ int16_t B = GETBITS16(b);
271− VAL cl = allocate(sizeof(Closure), 0);
195+ return idris_b16const(vm, A % B);
272− SETTY(cl, CT_BITS16);
273− cl->info.bits16 = (uint16_t) (((int16_t) A) % ((int16_t) B));
274− return cl;
275}
196}
276
197
277VAL idris_b16Lt(VM *vm, VAL a, VAL b) {
198VAL idris_b16Lt(VM *vm, VAL a, VAL b) {
@@ -296,127 +217,85 @@ VAL idris_b16Gte(VM *vm, VAL a, VAL b) {
296
217
297VAL idris_b16Compl(VM *vm, VAL a) {
218VAL idris_b16Compl(VM *vm, VAL a) {
298 uint16_t A = GETBITS16(a);
219 uint16_t A = GETBITS16(a);
299− VAL cl = allocate(sizeof(Closure), 0);
220+ return idris_b16const(vm, ~ A);
300− SETTY(cl, CT_BITS16);
301− cl->info.bits16 = ~ A;
302− return cl;
303}
221}
304
222
305VAL idris_b16And(VM *vm, VAL a, VAL b) {
223VAL idris_b16And(VM *vm, VAL a, VAL b) {
306 uint16_t A = GETBITS16(a);
224 uint16_t A = GETBITS16(a);
307 uint16_t B = GETBITS16(b);
225 uint16_t B = GETBITS16(b);
308− VAL cl = allocate(sizeof(Closure), 0);
226+ return idris_b16const(vm, A & B);
309− SETTY(cl, CT_BITS16);
310− cl->info.bits16 = A & B;
311− return cl;
312}
227}
313
228
314VAL idris_b16Or(VM *vm, VAL a, VAL b) {
229VAL idris_b16Or(VM *vm, VAL a, VAL b) {
315 uint16_t A = GETBITS16(a);
230 uint16_t A = GETBITS16(a);
316 uint16_t B = GETBITS16(b);
231 uint16_t B = GETBITS16(b);
317− VAL cl = allocate(sizeof(Closure), 0);
232+ return idris_b16const(vm, A | B);
318− SETTY(cl, CT_BITS16);
319− cl->info.bits16 = A | B;
320− return cl;
321}
233}
322
234
323VAL idris_b16Xor(VM *vm, VAL a, VAL b) {
235VAL idris_b16Xor(VM *vm, VAL a, VAL b) {
324 uint16_t A = GETBITS16(a);
236 uint16_t A = GETBITS16(a);
325 uint16_t B = GETBITS16(b);
237 uint16_t B = GETBITS16(b);
326− VAL cl = allocate(sizeof(Closure), 0);
238+ return idris_b16const(vm, A ^ B);
327− SETTY(cl, CT_BITS16);
328− cl->info.bits16 = A ^ B;
329− return cl;
330}
239}
331
240
332VAL idris_b16Shl(VM *vm, VAL a, VAL b) {
241VAL idris_b16Shl(VM *vm, VAL a, VAL b) {
333 uint16_t A = GETBITS16(a);
242 uint16_t A = GETBITS16(a);
334 uint16_t B = GETBITS16(b);
243 uint16_t B = GETBITS16(b);
335− VAL cl = allocate(sizeof(Closure), 0);
244+ return idris_b16const(vm, A << B);
336− SETTY(cl, CT_BITS16);
337− cl->info.bits16 = A << B;
338− return cl;
339}
245}
340
246
341VAL idris_b16LShr(VM *vm, VAL a, VAL b) {
247VAL idris_b16LShr(VM *vm, VAL a, VAL b) {
342 uint16_t A = GETBITS16(a);
248 uint16_t A = GETBITS16(a);
343 uint16_t B = GETBITS16(b);
249 uint16_t B = GETBITS16(b);
344− VAL cl = allocate(sizeof(Closure), 0);
250+ return idris_b16const(vm, A >> B);
345− SETTY(cl, CT_BITS16);
346− cl->info.bits16 = A >> B;
347− return cl;
348}
251}
349
252
350VAL idris_b16AShr(VM *vm, VAL a, VAL b) {
253VAL idris_b16AShr(VM *vm, VAL a, VAL b) {
351− uint16_t A = GETBITS16(a);
254+ int16_t A = GETBITS16(a);
352− uint16_t B = GETBITS16(b);
255+ int16_t B = GETBITS16(b);
353− VAL cl = allocate(sizeof(Closure), 0);
256+ return idris_b16const(vm, A >> B);
354− SETTY(cl, CT_BITS16);
355− cl->info.bits16 = (uint16_t) (((int16_t) A) >> ((int16_t) B));
356− return cl;
357}
257}
358
258
359VAL idris_b32Plus(VM *vm, VAL a, VAL b) {
259VAL idris_b32Plus(VM *vm, VAL a, VAL b) {
360 uint32_t A = GETBITS32(a);
260 uint32_t A = GETBITS32(a);
361 uint32_t B = GETBITS32(b);
261 uint32_t B = GETBITS32(b);
362− VAL cl = allocate(sizeof(Closure), 0);
262+ return idris_b32const(vm, A + B);
363− SETTY(cl, CT_BITS32);
364− cl->info.bits32 = A + B;
365− return cl;
366}
263}
367
264
368VAL idris_b32Minus(VM *vm, VAL a, VAL b) {
265VAL idris_b32Minus(VM *vm, VAL a, VAL b) {
369 uint32_t A = GETBITS32(a);
266 uint32_t A = GETBITS32(a);
370 uint32_t B = GETBITS32(b);
267 uint32_t B = GETBITS32(b);
371− VAL cl = allocate(sizeof(Closure), 0);
268+ return idris_b32const(vm, A - B);
372− SETTY(cl, CT_BITS32);
373− cl->info.bits32 = A - B;
374− return cl;
375}
269}
376
270
377VAL idris_b32Times(VM *vm, VAL a, VAL b) {
271VAL idris_b32Times(VM *vm, VAL a, VAL b) {
378 uint32_t A = GETBITS32(a);
272 uint32_t A = GETBITS32(a);
379 uint32_t B = GETBITS32(b);
273 uint32_t B = GETBITS32(b);
380− VAL cl = allocate(sizeof(Closure), 0);
274+ return idris_b32const(vm, A * B);
381− SETTY(cl, CT_BITS32);
382− cl->info.bits32 = A * B;
383− return cl;
384}
275}
385
276
386VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {
277VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {
387 uint32_t A = GETBITS32(a);
278 uint32_t A = GETBITS32(a);
388 uint32_t B = GETBITS32(b);
279 uint32_t B = GETBITS32(b);
389− VAL cl = allocate(sizeof(Closure), 0);
280+ return idris_b32const(vm, A / B);
390− SETTY(cl, CT_BITS32);
391− cl->info.bits32 = A / B;
392− return cl;
393}
281}
394
282
395VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {
283VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {
396− uint32_t A = GETBITS32(a);
284+ int32_t A = GETBITS32(a);
397− uint32_t B = GETBITS32(b);
285+ int32_t B = GETBITS32(b);
398− VAL cl = allocate(sizeof(Closure), 0);
286+ return idris_b32const(vm, A / B);
399− SETTY(cl, CT_BITS32);
400− cl->info.bits32 = (uint32_t) (((int32_t) A) / ((int32_t) B));
401− return cl;
402}
287}
403
288
404VAL idris_b32URem(VM *vm, VAL a, VAL b) {
289VAL idris_b32URem(VM *vm, VAL a, VAL b) {
405 uint32_t A = GETBITS32(a);
290 uint32_t A = GETBITS32(a);
406 uint32_t B = GETBITS32(b);
291 uint32_t B = GETBITS32(b);
407− VAL cl = allocate(sizeof(Closure), 0);
292+ return idris_b32const(vm, A % B);
408− SETTY(cl, CT_BITS32);
409− cl->info.bits32 = A % B;
410− return cl;
411}
293}
412
294
413VAL idris_b32SRem(VM *vm, VAL a, VAL b) {
295VAL idris_b32SRem(VM *vm, VAL a, VAL b) {
414− uint32_t A = GETBITS32(a);
296+ int32_t A = GETBITS32(a);
415− uint32_t B = GETBITS32(b);
297+ int32_t B = GETBITS32(b);
416− VAL cl = allocate(sizeof(Closure), 0);
298+ return idris_b32const(vm, A % B);
417− SETTY(cl, CT_BITS32);
418− cl->info.bits32 = (uint32_t) (((int32_t) A) % ((int32_t) B));
419− return cl;
420}
299}
421
300
422VAL idris_b32Lt(VM *vm, VAL a, VAL b) {
301VAL idris_b32Lt(VM *vm, VAL a, VAL b) {
@@ -441,353 +320,246 @@ VAL idris_b32Gte(VM *vm, VAL a, VAL b) {
441
320
442VAL idris_b32Compl(VM *vm, VAL a) {
321VAL idris_b32Compl(VM *vm, VAL a) {
443 uint32_t A = GETBITS32(a);
322 uint32_t A = GETBITS32(a);
444− VAL cl = allocate(sizeof(Closure), 0);
323+ return idris_b32const(vm, ~ A);
445− SETTY(cl, CT_BITS32);
446− cl->info.bits32 = ~ A;
447− return cl;
448}
324}
449
325
450VAL idris_b32And(VM *vm, VAL a, VAL b) {
326VAL idris_b32And(VM *vm, VAL a, VAL b) {
451 uint32_t A = GETBITS32(a);
327 uint32_t A = GETBITS32(a);
452 uint32_t B = GETBITS32(b);
328 uint32_t B = GETBITS32(b);
453− VAL cl = allocate(sizeof(Closure), 0);
329+ return idris_b32const(vm, A & B);
454− SETTY(cl, CT_BITS32);
455− cl->info.bits32 = A & B;
456− return cl;
457}
330}
458
331
459VAL idris_b32Or(VM *vm, VAL a, VAL b) {
332VAL idris_b32Or(VM *vm, VAL a, VAL b) {
460 uint32_t A = GETBITS32(a);
333 uint32_t A = GETBITS32(a);
461 uint32_t B = GETBITS32(b);
334 uint32_t B = GETBITS32(b);
462− VAL cl = allocate(sizeof(Closure), 0);
335+ return idris_b32const(vm, A | B);
463− SETTY(cl, CT_BITS32);
464− cl->info.bits32 = A | B;
465− return cl;
466}
336}
467
337
468VAL idris_b32Xor(VM *vm, VAL a, VAL b) {
338VAL idris_b32Xor(VM *vm, VAL a, VAL b) {
469 uint32_t A = GETBITS32(a);
339 uint32_t A = GETBITS32(a);
470 uint32_t B = GETBITS32(b);
340 uint32_t B = GETBITS32(b);
471− VAL cl = allocate(sizeof(Closure), 0);
341+ return idris_b32const(vm, A ^ B);
472− SETTY(cl, CT_BITS32);
473− cl->info.bits32 = A ^ B;
474− return cl;
475}
342}
476
343
477VAL idris_b32Shl(VM *vm, VAL a, VAL b) {
344VAL idris_b32Shl(VM *vm, VAL a, VAL b) {
478 uint32_t A = GETBITS32(a);
345 uint32_t A = GETBITS32(a);
479 uint32_t B = GETBITS32(b);
346 uint32_t B = GETBITS32(b);
480− VAL cl = allocate(sizeof(Closure), 0);
347+ return idris_b32const(vm, A << B);
481− SETTY(cl, CT_BITS32);
482− cl->info.bits32 = A << B;
483− return cl;
484}
348}
485
349
486VAL idris_b32LShr(VM *vm, VAL a, VAL b) {
350VAL idris_b32LShr(VM *vm, VAL a, VAL b) {
487 uint32_t A = GETBITS32(a);
351 uint32_t A = GETBITS32(a);
488 uint32_t B = GETBITS32(b);
352 uint32_t B = GETBITS32(b);
489− VAL cl = allocate(sizeof(Closure), 0);
353+ return idris_b32const(vm, A >> B);
490− SETTY(cl, CT_BITS32);
491− cl->info.bits32 = A >> B;
492− return cl;
493}
354}
494
355
495VAL idris_b32AShr(VM *vm, VAL a, VAL b) {
356VAL idris_b32AShr(VM *vm, VAL a, VAL b) {
496− uint32_t A = GETBITS32(a);
357+ int32_t A = GETBITS32(a);
497− uint32_t B = GETBITS32(b);
358+ int32_t B = GETBITS32(b);
498− VAL cl = allocate(sizeof(Closure), 0);
359+ return idris_b32const(vm, A >> B);
499− SETTY(cl, CT_BITS32);
500− cl->info.bits32 = (uint32_t) (((int32_t)A) >> ((int32_t)B));
501− return cl;
502}
360}
503
361
504VAL idris_b64Plus(VM *vm, VAL a, VAL b) {
362VAL idris_b64Plus(VM *vm, VAL a, VAL b) {
505 uint64_t A = GETBITS64(a);
363 uint64_t A = GETBITS64(a);
506 uint64_t B = GETBITS64(b);
364 uint64_t B = GETBITS64(b);
507− VAL cl = allocate(sizeof(Closure), 0);
365+ return idris_b64const(vm, A + B);
508− SETTY(cl, CT_BITS64);
509− cl->info.bits64 = A + B;
510− return cl;
511}
366}
512
367
513VAL idris_b64Minus(VM *vm, VAL a, VAL b) {
368VAL idris_b64Minus(VM *vm, VAL a, VAL b) {
514 uint64_t A = GETBITS64(a);
369 uint64_t A = GETBITS64(a);
515 uint64_t B = GETBITS64(b);
370 uint64_t B = GETBITS64(b);
516− VAL cl = allocate(sizeof(Closure), 0);
371+ return idris_b64const(vm, A - B);
517− SETTY(cl, CT_BITS64);
518− cl->info.bits64 = A - B;
519− return cl;
520}
372}
521
373
522VAL idris_b64Times(VM *vm, VAL a, VAL b) {
374VAL idris_b64Times(VM *vm, VAL a, VAL b) {
523 uint64_t A = GETBITS64(a);
375 uint64_t A = GETBITS64(a);
524 uint64_t B = GETBITS64(b);
376 uint64_t B = GETBITS64(b);
525− VAL cl = allocate(sizeof(Closure), 0);
377+ return idris_b64const(vm, A * B);
526− SETTY(cl, CT_BITS64);
527− cl->info.bits64 = A * B;
528− return cl;
529}
378}
530
379
531VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {
380VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {
532 uint64_t A = GETBITS64(a);
381 uint64_t A = GETBITS64(a);
533 uint64_t B = GETBITS64(b);
382 uint64_t B = GETBITS64(b);
534− VAL cl = allocate(sizeof(Closure), 0);
383+ return idris_b64const(vm, A / B);
535− SETTY(cl, CT_BITS64);
536− cl->info.bits64 = A / B;
537− return cl;
538}
384}
539
385
540VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {
386VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {
541− uint64_t A = GETBITS64(a);
387+ int64_t A = GETBITS64(a);
542− uint64_t B = GETBITS64(b);
388+ int64_t B = GETBITS64(b);
543− VAL cl = allocate(sizeof(Closure), 0);
389+ return idris_b64const(vm, A / B);
544− SETTY(cl, CT_BITS64);
545− cl->info.bits64 = (uint64_t) (((int64_t) A) / ((int64_t) B));
546− return cl;
547}
390}
548
391
549VAL idris_b64URem(VM *vm, VAL a, VAL b) {
392VAL idris_b64URem(VM *vm, VAL a, VAL b) {
550 uint64_t A = GETBITS64(a);
393 uint64_t A = GETBITS64(a);
551 uint64_t B = GETBITS64(b);
394 uint64_t B = GETBITS64(b);
552− VAL cl = allocate(sizeof(Closure), 0);
395+ return idris_b64const(vm, A % B);
553− SETTY(cl, CT_BITS64);
554− cl->info.bits64 = A % B;
555− return cl;
556}
396}
557
397
558VAL idris_b64SRem(VM *vm, VAL a, VAL b) {
398VAL idris_b64SRem(VM *vm, VAL a, VAL b) {
559− uint64_t A = GETBITS64(a);
399+ int64_t A = GETBITS64(a);
560− uint64_t B = GETBITS64(b);
400+ int64_t B = GETBITS64(b);
561− VAL cl = allocate(sizeof(Closure), 0);
401+ return idris_b64const(vm, A % B);
562− SETTY(cl, CT_BITS64);
563− cl->info.bits64 = (uint64_t) (((int64_t) A) % ((int64_t) B));
564− return cl;
565}
402}
566
403
567VAL idris_b64Lt(VM *vm, VAL a, VAL b) {
404VAL idris_b64Lt(VM *vm, VAL a, VAL b) {
405+ uint64_t A = GETBITS64(a);
406+ uint64_t B = GETBITS64(b);
568− return MKINT((i_int) (a->info.bits64 < b->info.bits64));
407+ return MKINT((i_int) (A < B));
569}
408}
570
409
571VAL idris_b64Gt(VM *vm, VAL a, VAL b) {
410VAL idris_b64Gt(VM *vm, VAL a, VAL b) {
411+ uint64_t A = GETBITS64(a);
412+ uint64_t B = GETBITS64(b);
572− return MKINT((i_int) (a->info.bits64 > b->info.bits64));
413+ return MKINT((i_int) (A > B));
573}
414}
574
415
575VAL idris_b64Eq(VM *vm, VAL a, VAL b) {
416VAL idris_b64Eq(VM *vm, VAL a, VAL b) {
417+ uint64_t A = GETBITS64(a);
418+ uint64_t B = GETBITS64(b);
576− return MKINT((i_int) (a->info.bits64 == b->info.bits64));
419+ return MKINT((i_int) (A == B));
577}
420}
578
421
579VAL idris_b64Lte(VM *vm, VAL a, VAL b) {
422VAL idris_b64Lte(VM *vm, VAL a, VAL b) {
423+ uint64_t A = GETBITS64(a);
424+ uint64_t B = GETBITS64(b);
580− return MKINT((i_int) (a->info.bits64 <= b->info.bits64));
425+ return MKINT((i_int) (A <= B));
581}
426}
582
427
583VAL idris_b64Gte(VM *vm, VAL a, VAL b) {
428VAL idris_b64Gte(VM *vm, VAL a, VAL b) {
429+ uint64_t A = GETBITS64(a);
430+ uint64_t B = GETBITS64(b);
584− return MKINT((i_int) (a->info.bits64 >= b->info.bits64));
431+ return MKINT((i_int) (A >= B));
585}
432}
586
433
587VAL idris_b64Compl(VM *vm, VAL a) {
434VAL idris_b64Compl(VM *vm, VAL a) {
588 uint64_t A = GETBITS64(a);
435 uint64_t A = GETBITS64(a);
589− VAL cl = allocate(sizeof(Closure), 0);
436+ return idris_b64const(vm, ~ A);
590− SETTY(cl, CT_BITS64);
591− cl->info.bits64 = ~ A;
592− return cl;
593}
437}
594
438
595VAL idris_b64And(VM *vm, VAL a, VAL b) {
439VAL idris_b64And(VM *vm, VAL a, VAL b) {
596 uint64_t A = GETBITS64(a);
440 uint64_t A = GETBITS64(a);
597 uint64_t B = GETBITS64(b);
441 uint64_t B = GETBITS64(b);
598− VAL cl = allocate(sizeof(Closure), 0);
442+ return idris_b64const(vm, A & B);
599− SETTY(cl, CT_BITS64);
600− cl->info.bits64 = A & B;
601− return cl;
602}
443}
603
444
604VAL idris_b64Or(VM *vm, VAL a, VAL b) {
445VAL idris_b64Or(VM *vm, VAL a, VAL b) {
605 uint64_t A = GETBITS64(a);
446 uint64_t A = GETBITS64(a);
606 uint64_t B = GETBITS64(b);
447 uint64_t B = GETBITS64(b);
607− VAL cl = allocate(sizeof(Closure), 0);
448+ return idris_b64const(vm, A | B);
608− SETTY(cl, CT_BITS64);
609− cl->info.bits64 = A | B;
610− return cl;
611}
449}
612
450
613VAL idris_b64Xor(VM *vm, VAL a, VAL b) {
451VAL idris_b64Xor(VM *vm, VAL a, VAL b) {
614 uint64_t A = GETBITS64(a);
452 uint64_t A = GETBITS64(a);
615 uint64_t B = GETBITS64(b);
453 uint64_t B = GETBITS64(b);
616− VAL cl = allocate(sizeof(Closure), 0);
454+ return idris_b64const(vm, A ^ B);
617− SETTY(cl, CT_BITS64);
618− cl->info.bits64 = A ^ B;
619− return cl;
620}
455}
621
456
622VAL idris_b64Shl(VM *vm, VAL a, VAL b) {
457VAL idris_b64Shl(VM *vm, VAL a, VAL b) {
623 uint64_t A = GETBITS64(a);
458 uint64_t A = GETBITS64(a);
624 uint64_t B = GETBITS64(b);
459 uint64_t B = GETBITS64(b);
625− VAL cl = allocate(sizeof(Closure), 0);
460+ return idris_b64const(vm, A << B);
626− SETTY(cl, CT_BITS64);
627− cl->info.bits64 = A << B;
628− return cl;
629}
461}
630
462
631VAL idris_b64LShr(VM *vm, VAL a, VAL b) {
463VAL idris_b64LShr(VM *vm, VAL a, VAL b) {
632 uint64_t A = GETBITS64(a);
464 uint64_t A = GETBITS64(a);
633 uint64_t B = GETBITS64(b);
465 uint64_t B = GETBITS64(b);
634− VAL cl = allocate(sizeof(Closure), 0);
466+ return idris_b64const(vm, A >> B);
635− SETTY(cl, CT_BITS64);
636− cl->info.bits64 = A >> B;
637− return cl;
638}
467}
639
468
640VAL idris_b64AShr(VM *vm, VAL a, VAL b) {
469VAL idris_b64AShr(VM *vm, VAL a, VAL b) {
641− uint64_t A = GETBITS64(a);
470+ int64_t A = GETBITS64(a);
642− uint64_t B = GETBITS64(b);
471+ int64_t B = GETBITS64(b);
643− VAL cl = allocate(sizeof(Closure), 0);
472+ return idris_b64const(vm, A >> B);
644− SETTY(cl, CT_BITS64);
645− cl->info.bits64 = (uint64_t) (((int64_t) A) >> ((int64_t) B));
646− return cl;
647}
473}
648
474
649VAL idris_b8Z16(VM *vm, VAL a) {
475VAL idris_b8Z16(VM *vm, VAL a) {
650 uint8_t A = GETBITS8(a);
476 uint8_t A = GETBITS8(a);
651− VAL cl = allocate(sizeof(Closure), 0);
477+ return idris_b16const(vm, A);
652− SETTY(cl, CT_BITS16);
653− cl->info.bits16 = (uint16_t) A;
654− return cl;
655}
478}
656
479
657VAL idris_b8Z32(VM *vm, VAL a) {
480VAL idris_b8Z32(VM *vm, VAL a) {
658 uint8_t A = GETBITS8(a);
481 uint8_t A = GETBITS8(a);
659− VAL cl = allocate(sizeof(Closure), 0);
482+ return idris_b32const(vm, A);
660− SETTY(cl, CT_BITS32);
661− cl->info.bits32 = (uint32_t) A;
662− return cl;
663}
483}
664
484
665VAL idris_b8Z64(VM *vm, VAL a) {
485VAL idris_b8Z64(VM *vm, VAL a) {
666 uint8_t A = GETBITS8(a);
486 uint8_t A = GETBITS8(a);
667− VAL cl = allocate(sizeof(Closure), 0);
487+ return idris_b64const(vm, A);
668− SETTY(cl, CT_BITS64);
669− cl->info.bits64 = (uint64_t) A;
670− return cl;
671}
488}
672
489
673VAL idris_b8S16(VM *vm, VAL a) {
490VAL idris_b8S16(VM *vm, VAL a) {
674− uint8_t A = GETBITS8(a);
491+ int8_t A = GETBITS8(a);
675− VAL cl = allocate(sizeof(Closure), 0);
492+ return idris_b16const(vm, (int16_t) A);
676− SETTY(cl, CT_BITS16);
677− cl->info.bits16 = (uint16_t) (int16_t) (int8_t) A;
678− return cl;
679}
493}
680
494
681VAL idris_b8S32(VM *vm, VAL a) {
495VAL idris_b8S32(VM *vm, VAL a) {
682− uint8_t A = GETBITS8(a);
496+ int8_t A = GETBITS8(a);
683− VAL cl = allocate(sizeof(Closure), 0);
497+ return idris_b32const(vm, (int32_t) A);
684− SETTY(cl, CT_BITS32);
685− cl->info.bits32 = (uint32_t) (int32_t) (int8_t) A;
686− return cl;
687}
498}
688
499
689VAL idris_b8S64(VM *vm, VAL a) {
500VAL idris_b8S64(VM *vm, VAL a) {
690− uint8_t A = GETBITS8(a);
501+ int8_t A = GETBITS8(a);
691− VAL cl = allocate(sizeof(Closure), 0);
502+ return idris_b64const(vm, (int64_t) A);
692− SETTY(cl, CT_BITS64);
693− cl->info.bits64 = (uint64_t) (int64_t) (int8_t) A;
694− return cl;
695}
503}
696
504
697VAL idris_b16Z32(VM *vm, VAL a) {
505VAL idris_b16Z32(VM *vm, VAL a) {
698 uint16_t A = GETBITS16(a);
506 uint16_t A = GETBITS16(a);
699− VAL cl = allocate(sizeof(Closure), 0);
507+ return idris_b32const(vm, (uint32_t) A);
700− SETTY(cl, CT_BITS32);
701− cl->info.bits32 = (uint32_t) A;
702− return cl;
703}
508}
704
509
705VAL idris_b16Z64(VM *vm, VAL a) {
510VAL idris_b16Z64(VM *vm, VAL a) {
706 uint16_t A = GETBITS16(a);
511 uint16_t A = GETBITS16(a);
707− VAL cl = allocate(sizeof(Closure), 0);
512+ return idris_b64const(vm, (uint64_t) A);
708− SETTY(cl, CT_BITS64);
709− cl->info.bits64 = (uint64_t) A;
710− return cl;
711}
513}
712
514
713VAL idris_b16S32(VM *vm, VAL a) {
515VAL idris_b16S32(VM *vm, VAL a) {
714− uint16_t A = GETBITS16(a);
516+ int16_t A = GETBITS16(a);
715− VAL cl = allocate(sizeof(Closure), 0);
517+ return idris_b32const(vm, (int32_t) A);
716− SETTY(cl, CT_BITS32);
717− cl->info.bits32 = (uint32_t) (int32_t) (int16_t) A;
718− return cl;
719}
518}
720
519
721VAL idris_b16S64(VM *vm, VAL a) {
520VAL idris_b16S64(VM *vm, VAL a) {
722− uint16_t A = GETBITS16(a);
521+ int16_t A = GETBITS16(a);
723− VAL cl = allocate(sizeof(Closure), 0);
522+ return idris_b64const(vm, (int64_t) A);
724− SETTY(cl, CT_BITS64);
725− cl->info.bits64 = (uint64_t) (int64_t) (int16_t) A;
726− return cl;
727}
523}
728
524
729VAL idris_b16T8(VM *vm, VAL a) {
525VAL idris_b16T8(VM *vm, VAL a) {
730 uint16_t A = GETBITS16(a);
526 uint16_t A = GETBITS16(a);
731− VAL cl = allocate(sizeof(Closure), 0);
527+ return idris_b8const(vm, (uint8_t) A);
732− SETTY(cl, CT_BITS8);
733− cl->info.bits8 = (uint8_t) A;
734− return cl;
735}
528}
736
529
737VAL idris_b32Z64(VM *vm, VAL a) {
530VAL idris_b32Z64(VM *vm, VAL a) {
738 uint32_t A = GETBITS32(a);
531 uint32_t A = GETBITS32(a);
739− VAL cl = allocate(sizeof(Closure), 0);
532+ return idris_b64const(vm, (uint64_t) A);
740− SETTY(cl, CT_BITS64);
741− cl->info.bits64 = (uint64_t) A;
742− return cl;
743}
533}
744
534
745VAL idris_b32S64(VM *vm, VAL a) {
535VAL idris_b32S64(VM *vm, VAL a) {
746− uint32_t A = GETBITS32(a);
536+ int32_t A = GETBITS32(a);
747− VAL cl = allocate(sizeof(Closure), 0);
537+ return idris_b64const(vm, (int64_t) A);
748− SETTY(cl, CT_BITS64);
749− cl->info.bits64 = (uint64_t) (int64_t) (int32_t) A;
750− return cl;
751}
538}
752
539
753VAL idris_b32T8(VM *vm, VAL a) {
540VAL idris_b32T8(VM *vm, VAL a) {
754 uint32_t A = GETBITS32(a);
541 uint32_t A = GETBITS32(a);
755− VAL cl = allocate(sizeof(Closure), 0);
542+ return idris_b8const(vm, (uint8_t) A);
756− SETTY(cl, CT_BITS8);
757− cl->info.bits8 = (uint8_t) A;
758− return cl;
759}
543}
760
544
761VAL idris_b32T16(VM *vm, VAL a) {
545VAL idris_b32T16(VM *vm, VAL a) {
762 uint32_t A = GETBITS32(a);
546 uint32_t A = GETBITS32(a);
763− VAL cl = allocate(sizeof(Closure), 0);
547+ return idris_b16const(vm, (uint16_t) A);
764− SETTY(cl, CT_BITS16);
765− cl->info.bits16 = (uint16_t) A;
766− return cl;
767}
548}
768
549
769VAL idris_b64T8(VM *vm, VAL a) {
550VAL idris_b64T8(VM *vm, VAL a) {
770 uint64_t A = GETBITS64(a);
551 uint64_t A = GETBITS64(a);
771− VAL cl = allocate(sizeof(Closure), 0);
552+ return idris_b8const(vm, (uint8_t) A);
772− SETTY(cl, CT_BITS8);
773− cl->info.bits8 = (uint8_t) A;
774− return cl;
775}
553}
776
554
777VAL idris_b64T16(VM *vm, VAL a) {
555VAL idris_b64T16(VM *vm, VAL a) {
778 uint64_t A = GETBITS64(a);
556 uint64_t A = GETBITS64(a);
779− VAL cl = allocate(sizeof(Closure), 0);
557+ return idris_b16const(vm, (uint16_t) A);
780− SETTY(cl, CT_BITS16);
781− cl->info.bits16 = (uint16_t) A;
782− return cl;
783}
558}
784
559
785VAL idris_b64T32(VM *vm, VAL a) {
560VAL idris_b64T32(VM *vm, VAL a) {
786 uint64_t A = GETBITS64(a);
561 uint64_t A = GETBITS64(a);
787− VAL cl = allocate(sizeof(Closure), 0);
562+ return idris_b32const(vm, (uint32_t) A);
788− SETTY(cl, CT_BITS32);
789− cl->info.bits32 = (uint32_t) A;
790− return cl;
791}
563}
792
564
793VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {
565VAL 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) {
110
110
111VAL idris_getBufferString(void* buffer, int loc, int len) {
111VAL idris_getBufferString(void* buffer, int loc, int len) {
112 Buffer* b = buffer;
112 Buffer* b = buffer;
113−
114 char * s = (char*)(b->data + loc);
113 char * s = (char*)(b->data + loc);
115 size_t sz = loc >= 0 && loc+len <= b->size? len : 0;
114 size_t sz = loc >= 0 && loc+len <= b->size? len : 0;
116− return MKSTRlen(NULL, s, sz);
115+ return MKSTRlen(get_vm(), s, sz);
117}
116}
118
117
119int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {
118int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {
rts/idris_gc.c+28−28
@@ -5,8 +5,8 @@
5#include <assert.h>
5#include <assert.h>
6
6
7VAL copy(VM* vm, VAL x) {
7VAL copy(VM* vm, VAL x) {
8− int ar, len;
8+ int ar;
9− Closure* cl = NULL;
9+ VAL cl;
10 if (x==NULL || ISINT(x)) {
10 if (x==NULL || ISINT(x)) {
11 return x;
11 return x;
12 }
12 }
@@ -18,7 +18,7 @@ VAL copy(VM* vm, VAL x) {
18 c_heap_mark_item(GETCDATA(x));
18 c_heap_mark_item(GETCDATA(x));
19 break;
19 break;
20 case CT_BIGINT:
20 case CT_BIGINT:
21− cl = MKBIGMc(vm, GETPTR(x));
21+ cl = MKBIGMc(vm, GETMPZ(x));
22 break;
22 break;
23 case CT_CON:
23 case CT_CON:
24 ar = CARITY(x);
24 ar = CARITY(x);
@@ -39,47 +39,47 @@ VAL copy(VM* vm, VAL x) {
39 case CT_BITS64:
39 case CT_BITS64:
40 case CT_RAWDATA:
40 case CT_RAWDATA:
41 {
41 {
42− size_t size = sizeof(Closure) + x->extrasz;
42+ Hdr * s = (Hdr*)x;
43− cl = allocate(size, 1);
43+ cl = iallocate(vm, s->sz, 1);
44− memcpy(cl, x, size);
44+ memcpy(cl, x, s->sz);
45 }
45 }
46 break;
46 break;
47 default:
47 default:
48+ cl = NULL;
48 break;
49 break;
49 }
50 }
50 SETTY(x, CT_FWD);
51 SETTY(x, CT_FWD);
51− x->info.ptr = cl;
52+ ((Fwd*)x)->fwd = cl;
52 return cl;
53 return cl;
53}
54}
54
55
55void cheney(VM *vm) {
56void cheney(VM *vm) {
56− size_t i, len;
57 char* scan = aligned_heap_pointer(vm->heap.heap);
57 char* scan = aligned_heap_pointer(vm->heap.heap);
58
58
59 while(scan < vm->heap.next) {
59 while(scan < vm->heap.next) {
60 VAL heap_item = (VAL)scan;
60 VAL heap_item = (VAL)scan;
61 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
61 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
62 switch(GETTY(heap_item)) {
62 switch(GETTY(heap_item)) {
63− case CT_CON:
63+ case CT_CON: {
64+ Con * c = (Con*)heap_item;
64− len = CARITY(heap_item);
65+ size_t len = CARITY(c);
65− for(i = 0; i < len; ++i) {
66+ for(size_t i = 0; i < len; ++i)
66− VAL newptr = copy(vm, heap_item->extra.cargs[i]);
67+ c->args[i] = copy(vm, c->args[i]);
67− heap_item->extra.cargs[i] = newptr;
68− }
69− break;
68+ } break;
70− case CT_ARRAY:
69+ case CT_ARRAY: {
70+ Array * a = (Array*)heap_item;
71− len = CELEM(heap_item);
71+ size_t len = CELEM(a);
72− for(i = 0; i < len; ++i) {
72+ for(size_t i = 0; i < len; ++i)
73− VAL newptr = copy(vm, heap_item->extra.array[i]);
73+ a->array[i] = copy(vm, a->array[i]);
74− heap_item->extra.array[i] = newptr;
75− }
76− break;
74+ } break;
77− case CT_REF:
75+ case CT_REF: {
78− heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
76+ Ref * r = (Ref*)heap_item;
77+ r->ref = copy(vm, r->ref);
79− break;
78+ } break;
80− case CT_STROFFSET:
79+ case CT_STROFFSET: {
81− heap_item->extra.basestr[0] = copy(vm, heap_item->extra.basestr[0]);
80+ StrOffset * s = (StrOffset*)heap_item;
81+ s->base = (String*)copy(vm, (VAL)s->base);
82− break;
82+ } break;
83 default: // Nothing to copy
83 default: // Nothing to copy
84 break;
84 break;
85 }
85 }
rts/idris_gmp.c+69−67
@@ -22,17 +22,17 @@ 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) {
25+static mpz_t * big(BigInt * v) {
26− return (mpz_t*)(v->info.ptr);
26+ return (mpz_t*)(v->big);
27}
27}
28
28
29+#define BIG(x) big((BigInt*)(x))
30+
29−static VAL allocBig() {
31+static BigInt * allocBig(VM * vm) {
30− idris_requireAlloc(IDRIS_MAXGMP);
32+ idris_requireAlloc(vm, IDRIS_MAXGMP);
31− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
33+ BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);
32− idris_doneAlloc();
34+ idris_doneAlloc(vm);
33 SETTY(cl, CT_BIGINT);
35 SETTY(cl, CT_BIGINT);
34− cl->info.ptr = (void*)(cl+1);
35− cl->extrasz = sizeof(mpz_t);
36 mpz_init(*big(cl));
36 mpz_init(*big(cl));
37 return cl;
37 return cl;
38}
38}
@@ -42,117 +42,119 @@ VAL MKBIGC(VM* vm, char* val) {
42 return MKBIGI(0);
42 return MKBIGI(0);
43 }
43 }
44 else {
44 else {
45− VAL cl = allocBig();
45+ BigInt * cl = allocBig(vm);
46 mpz_set_str(*big(cl), val, 10);
46 mpz_set_str(*big(cl), val, 10);
47− return cl;
47+ return (VAL)cl;
48 }
48 }
49}
49}
50
50
51VAL MKBIGM(VM* vm, void* ibig) {
51VAL MKBIGM(VM* vm, void* ibig) {
52− VAL cl = allocBig();
52+ BigInt * cl = allocBig(vm);
53 mpz_set(*big(cl), *((mpz_t*)ibig));
53 mpz_set(*big(cl), *((mpz_t*)ibig));
54− return cl;
54+ return (VAL)cl;
55}
55}
56
56
57VAL MKBIGMc(VM* vm, void* ibig) {
57VAL MKBIGMc(VM* vm, void* ibig) {
58− VAL cl = allocBig();
58+ BigInt * cl = allocBig(vm);
59 mpz_init_set(*big(cl), *((mpz_t*)ibig));
59 mpz_init_set(*big(cl), *((mpz_t*)ibig));
60− return cl;
60+ return (VAL)cl;
61}
61}
62
62
63VAL MKBIGUI(VM* vm, unsigned long val) {
63VAL MKBIGUI(VM* vm, unsigned long val) {
64− VAL cl = allocBig();
64+ BigInt * cl = allocBig(vm);
65 mpz_init_set_ui(*big(cl), val);
65 mpz_init_set_ui(*big(cl), val);
66− return cl;
66+ return (VAL)cl;
67}
67}
68
68
69VAL MKBIGSI(VM* vm, signed long val) {
69VAL MKBIGSI(VM* vm, signed long val) {
70− VAL cl = allocBig();
70+ BigInt * cl = allocBig(vm);
71 mpz_init_set_si(*big(cl), val);
71 mpz_init_set_si(*big(cl), val);
72− return cl;
72+ return (VAL)cl;
73}
73}
74
74
75−VAL GETBIG(VM * vm, VAL x) {
75+static BigInt * getbig(VM * vm, VAL x) {
76 if (ISINT(x)) {
76 if (ISINT(x)) {
77− VAL cl = allocBig();
77+ BigInt * cl = allocBig(vm);
78 mpz_set_si(*big(cl), GETINT(x));
78 mpz_set_si(*big(cl), GETINT(x));
79 return cl;
79 return cl;
80 } else {
80 } else {
81 switch(GETTY(x)) {
81 switch(GETTY(x)) {
82 case CT_FWD:
82 case CT_FWD:
83− return GETBIG(vm, x->info.ptr);
83+ return getbig(vm, ((Fwd*)x)->fwd);
84 default:
84 default:
85− return x;
85+ return (BigInt*)x;
86 }
86 }
87 }
87 }
88}
88}
89
89
90+#define GETBIG (VAL)getbig
91+
90VAL bigAdd(VM* vm, VAL x, VAL y) {
92VAL bigAdd(VM* vm, VAL x, VAL y) {
91− VAL cl = allocBig();
93+ BigInt * cl = allocBig(vm);
92− mpz_add(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
94+ mpz_add(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
93− return cl;
95+ return (VAL)cl;
94}
96}
95
97
96VAL bigSub(VM* vm, VAL x, VAL y) {
98VAL bigSub(VM* vm, VAL x, VAL y) {
97− VAL cl = allocBig();
99+ BigInt * cl = allocBig(vm);
98− mpz_sub(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
100+ mpz_sub(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
99− return cl;
101+ return (VAL)cl;
100}
102}
101
103
102VAL bigMul(VM* vm, VAL x, VAL y) {
104VAL bigMul(VM* vm, VAL x, VAL y) {
103− VAL cl = allocBig();
105+ BigInt * cl = allocBig(vm);
104− mpz_mul(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
106+ mpz_mul(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
105− return cl;
107+ return (VAL)cl;
106}
108}
107
109
108VAL bigDiv(VM* vm, VAL x, VAL y) {
110VAL bigDiv(VM* vm, VAL x, VAL y) {
109− VAL cl = allocBig();
111+ BigInt * cl = allocBig(vm);
110− mpz_tdiv_q(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
112+ mpz_tdiv_q(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
111− return cl;
113+ return (VAL)cl;
112}
114}
113
115
114VAL bigMod(VM* vm, VAL x, VAL y) {
116VAL bigMod(VM* vm, VAL x, VAL y) {
115− VAL cl = allocBig();
117+ BigInt * cl = allocBig(vm);
116− mpz_tdiv_r(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
118+ mpz_tdiv_r(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
117− return cl;
119+ return (VAL)cl;
118}
120}
119
121
120VAL bigAnd(VM* vm, VAL x, VAL y) {
122VAL bigAnd(VM* vm, VAL x, VAL y) {
121− VAL cl = allocBig();
123+ BigInt * cl = allocBig(vm);
122− mpz_and(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
124+ mpz_and(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
123− return cl;
125+ return (VAL)cl;
124}
126}
125
127
126VAL bigOr(VM* vm, VAL x, VAL y) {
128VAL bigOr(VM* vm, VAL x, VAL y) {
127− VAL cl = allocBig();
129+ BigInt * cl = allocBig(vm);
128− mpz_ior(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
130+ mpz_ior(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
129− return cl;
131+ return (VAL)cl;
130}
132}
131
133
132VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
134VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
133− VAL cl = allocBig();
135+ BigInt * cl = allocBig(vm);
134− mpz_mul_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
136+ mpz_mul_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
135− return cl;
137+ return (VAL)cl;
136}
138}
137
139
138
140
139VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
141VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
140− VAL cl = allocBig();
142+ BigInt * cl = allocBig(vm);
141− mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
143+ mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
142− return cl;
144+ return (VAL)cl;
143}
145}
144
146
145VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
147VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
146− VAL cl = allocBig();
148+ BigInt * cl = allocBig(vm);
147− mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
149+ mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
148− return cl;
150+ return (VAL)cl;
149}
151}
150
152
151VAL idris_bigAnd(VM* vm, VAL x, VAL y) {
153VAL idris_bigAnd(VM* vm, VAL x, VAL y) {
152 if (ISINT(x) && ISINT(y)) {
154 if (ISINT(x) && ISINT(y)) {
153 return INTOP(&, x, y);
155 return INTOP(&, x, y);
154 } else {
156 } else {
155− return bigAnd(vm, GETBIG(vm, x), GETBIG(vm, y));
157+ return bigAnd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
156 }
158 }
157}
159}
158
160
@@ -160,7 +162,7 @@ VAL idris_bigOr(VM* vm, VAL x, VAL y) {
160 if (ISINT(x) && ISINT(y)) {
162 if (ISINT(x) && ISINT(y)) {
161 return INTOP(|, x, y);
163 return INTOP(|, x, y);
162 } else {
164 } else {
163− return bigOr(vm, GETBIG(vm, x), GETBIG(vm, y));
165+ return bigOr(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
164 }
166 }
165}
167}
166
168
@@ -173,12 +175,12 @@ VAL idris_bigPlus(VM* vm, VAL x, VAL y) {
173 }
175 }
174 i_int res = vx + vy;
176 i_int res = vx + vy;
175 if (res >= 1<<30 || res <= -(1 << 30)) {
177 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));
177 } else {
179 } else {
178 return MKINT(res);
180 return MKINT(res);
179 }
181 }
180 } else {
182 } else {
181− return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
183+ return bigAdd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
182 }
184 }
183}
185}
184
186
@@ -264,29 +266,29 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {
264int bigEqConst(VAL x, int c) {
266int bigEqConst(VAL x, int c) {
265 if (ISINT(x)) { return (GETINT(x) == c); }
267 if (ISINT(x)) { return (GETINT(x) == c); }
266 else {
268 else {
267− int rv = mpz_cmp_si(GETMPZ(x), c);
269+ int rv = mpz_cmp_si(*BIG(x), c);
268 return (rv == 0);
270 return (rv == 0);
269 }
271 }
270}
272}
271
273
272VAL bigEq(VM* vm, VAL x, VAL y) {
274VAL 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));
274}
276}
275
277
276VAL bigLt(VM* vm, VAL x, VAL y) {
278VAL 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));
278}
280}
279
281
280VAL bigGt(VM* vm, VAL x, VAL y) {
282VAL 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));
282}
284}
283
285
284VAL bigLe(VM* vm, VAL x, VAL y) {
286VAL 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));
286}
288}
287
289
288VAL bigGe(VM* vm, VAL x, VAL y) {
290VAL 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));
290}
292}
291
293
292VAL idris_bigEq(VM* vm, VAL x, VAL y) {
294VAL idris_bigEq(VM* vm, VAL x, VAL y) {
@@ -338,7 +340,7 @@ VAL idris_castBigInt(VM* vm, VAL i) {
338 if (ISINT(i)) {
340 if (ISINT(i)) {
339 return i;
341 return i;
340 } else {
342 } else {
341− return MKINT((i_int)(mpz_get_ui(GETMPZ(i))));
343+ return MKINT((i_int)(mpz_get_ui(*BIG(i))));
342 }
344 }
343}
345}
344
346
@@ -346,15 +348,15 @@ VAL idris_castBigFloat(VM* vm, VAL i) {
346 if (ISINT(i)) {
348 if (ISINT(i)) {
347 return MKFLOAT(vm, GETINT(i));
349 return MKFLOAT(vm, GETINT(i));
348 } else {
350 } else {
349− return MKFLOAT(vm, mpz_get_d(GETMPZ(i)));
351+ return MKFLOAT(vm, mpz_get_d(*BIG(i)));
350 }
352 }
351}
353}
352
354
353VAL idris_castFloatBig(VM* vm, VAL f) {
355VAL idris_castFloatBig(VM* vm, VAL f) {
354 double val = GETFLOAT(f);
356 double val = GETFLOAT(f);
355− VAL cl = allocBig();
357+ BigInt * cl = allocBig(vm);
356 mpz_init_set_d(*big(cl), val);
358 mpz_init_set_d(*big(cl), val);
357− return cl;
359+ return (VAL)cl;
358}
360}
359
361
360VAL idris_castStrBig(VM* vm, VAL i) {
362VAL idris_castStrBig(VM* vm, VAL i) {
@@ -362,7 +364,7 @@ VAL idris_castStrBig(VM* vm, VAL i) {
362}
364}
363
365
364VAL idris_castBigStr(VM* vm, VAL i) {
366VAL 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)));
366 return MKSTR(vm, str);
368 return MKSTR(vm, str);
367}
369}
368
370
rts/idris_gmp.h+1−1
@@ -48,6 +48,6 @@ VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y);
48
48
49uint64_t idris_truncBigB64(const mpz_t bi);
49uint64_t idris_truncBigB64(const mpz_t bi);
50
50
51−#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))
51+#define GETMPZ(x) *((mpz_t*)(((BigInt*)(x))->big))
52
52
53#endif
53#endif
rts/idris_heap.c+4−3
@@ -192,10 +192,11 @@ void heap_check_pointers(Heap * heap) {
192 switch(GETTY(heap_item)) {
192 switch(GETTY(heap_item)) {
193 case CT_CON:
193 case CT_CON:
194 {
194 {
195+ Con * c = (Con*)heap_item;
195− int ar = CARITY(heap_item);
196+ size_t ar = CARITY(c);
196− int i = 0;
197+ size_t i;
197 for(i = 0; i < ar; ++i) {
198 for(i = 0; i < ar; ++i) {
198− VAL ptr = heap_item->extra.cargs[i];
199+ VAL ptr = c->args[i];
199
200
200 if (is_valid_ref(ptr)) {
201 if (is_valid_ref(ptr)) {
201 // Check for closure.
202 // Check for closure.
rts/idris_rts.c+172−183
@@ -7,10 +7,10 @@
7#include "idris_bitstring.h"
7#include "idris_bitstring.h"
8#include "getline.h"
8#include "getline.h"
9
9
10−#define STATIC_ASSERT(COND,MSG) typedef char static_assertion_##MSG[(COND)?1:-1]
10+#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)
11−
11+#include <signal.h>
12+#endif
12
13
13−STATIC_ASSERT(sizeof(Closure) == 16, sizeofClosure);
14
14
15#ifdef HAS_PTHREAD
15#ifdef HAS_PTHREAD
16static pthread_key_t vm_key;
16static pthread_key_t vm_key;
@@ -18,7 +18,7 @@ static pthread_key_t vm_key;
18static VM* global_vm;
18static VM* global_vm;
19#endif
19#endif
20
20
21−void free_key(VM *vm) {
21+void free_key(void *vvm) {
22 // nothing to free, we just used the VM pointer which is freed elsewhere
22 // nothing to free, we just used the VM pointer which is freed elsewhere
23}
23}
24
24
@@ -88,7 +88,6 @@ VM* idris_vm(void) {
88
88
89VM* get_vm(void) {
89VM* get_vm(void) {
90#ifdef HAS_PTHREAD
90#ifdef HAS_PTHREAD
91− init_threadkeys();
92 return pthread_getspecific(vm_key);
91 return pthread_getspecific(vm_key);
93#else
92#else
94 return global_vm;
93 return global_vm;
@@ -101,7 +100,7 @@ void close_vm(VM* vm) {
101
100
102#ifdef HAS_PTHREAD
101#ifdef HAS_PTHREAD
103void create_key(void) {
102void create_key(void) {
104− pthread_key_create(&vm_key, (void*)free_key);
103+ pthread_key_create(&vm_key, free_key);
105}
104}
106#endif
105#endif
107
106
@@ -160,13 +159,7 @@ CData cdata_manage(void * data, size_t size, CDataFinalizer finalizer)
160 return c_heap_create_item(data, size, finalizer);
159 return c_heap_create_item(data, size, finalizer);
161}
160}
162
161
163−void idris_requireAlloc(size_t size) {
162+void idris_requireAlloc(VM * vm, size_t size) {
164−#ifdef HAS_PTHREAD
165− VM* vm = pthread_getspecific(vm_key);
166−#else
167− VM* vm = global_vm;
168−#endif
169−
170 if (!(vm->heap.next + size < vm->heap.end)) {
163 if (!(vm->heap.next + size < vm->heap.end)) {
171 idris_gc(vm);
164 idris_gc(vm);
172 }
165 }
@@ -178,9 +171,8 @@ void idris_requireAlloc(size_t size) {
178#endif
171#endif
179}
172}
180
173
181−void idris_doneAlloc(void) {
174+void idris_doneAlloc(VM * vm) {
182#ifdef HAS_PTHREAD
175#ifdef HAS_PTHREAD
183− VM* vm = pthread_getspecific(vm_key);
184 int lock = vm->processes > 0;
176 int lock = vm->processes > 0;
185 if (lock) { // We only need to lock if we're in concurrent mode
177 if (lock) { // We only need to lock if we're in concurrent mode
186 pthread_mutex_unlock(&vm->alloc_lock);
178 pthread_mutex_unlock(&vm->alloc_lock);
@@ -193,10 +185,9 @@ int space(VM* vm, size_t size) {
193}
185}
194
186
195void* idris_alloc(size_t size) {
187void* idris_alloc(size_t size) {
196− Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);
188+ RawData * cl = (RawData*) allocate(sizeof(*cl)+size, 0);
197 SETTY(cl, CT_RAWDATA);
189 SETTY(cl, CT_RAWDATA);
198− cl->extrasz = size;
199− return (void*)(cl+1);
190+ return (void*)cl->raw;
200}
191}
201
192
202void* idris_realloc(void* old, size_t old_size, size_t size) {
193void* 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) {
208void idris_free(void* ptr, size_t size) {
199void idris_free(void* ptr, size_t size) {
209}
200}
210
201
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) {
212// return malloc(size);
207// return malloc(size);
213 size_t size = aligned(isize);
208 size_t size = aligned(isize);
214
209
215#ifdef HAS_PTHREAD
210#ifdef HAS_PTHREAD
216− VM* vm = pthread_getspecific(vm_key);
217 int lock = vm->processes > 0 && !outerlock;
211 int lock = vm->processes > 0 && !outerlock;
218
212
219 if (lock) { // not message passing
213 if (lock) { // not message passing
220 pthread_mutex_lock(&vm->alloc_lock);
214 pthread_mutex_lock(&vm->alloc_lock);
221 }
215 }
222−#else
223− VM* vm = global_vm;
224#endif
216#endif
225
217
226 if (vm->heap.next + size < vm->heap.end) {
218 if (vm->heap.next + size < vm->heap.end) {
@@ -236,6 +228,7 @@ void* allocate(size_t isize, int outerlock) {
236 pthread_mutex_unlock(&vm->alloc_lock);
228 pthread_mutex_unlock(&vm->alloc_lock);
237 }
229 }
238#endif
230#endif
231+ ((Hdr*)ptr)->sz = size;
239 return (void*)ptr;
232 return (void*)ptr;
240 } else {
233 } else {
241 // If we're trying to allocate something bigger than the heap,
234 // If we're trying to allocate something bigger than the heap,
@@ -249,104 +242,97 @@ void* allocate(size_t isize, int outerlock) {
249 pthread_mutex_unlock(&vm->alloc_lock);
242 pthread_mutex_unlock(&vm->alloc_lock);
250 }
243 }
251#endif
244#endif
252− return allocate(size, 0);
245+ return iallocate(vm, size, outerlock);
253 }
246 }
254
247
255}
248}
256
249
257−static Closure * allocStr(size_t len, int outer) {
250+static String * allocStr(VM * vm, size_t len, int outer) {
258− Closure * cl = allocate(sizeof(Closure) + len + 1, outer);
251+ String * cl = iallocate(vm, sizeof(*cl) + len + 1, outer);
259 SETTY(cl, CT_STRING);
252 SETTY(cl, CT_STRING);
260− cl->extrasz = len + 1;
261− cl->info.slen = len;
253+ cl->slen = len;
262 return cl;
254 return cl;
263}
255}
264
256
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−
278VAL MKFLOAT(VM* vm, double val) {
257VAL MKFLOAT(VM* vm, double val) {
279− Closure* cl = allocate(sizeof(Closure), 0);
258+ Float * cl = iallocate(vm, sizeof(*cl), 0);
280 SETTY(cl, CT_FLOAT);
259 SETTY(cl, CT_FLOAT);
281− cl -> info.f = val;
260+ cl->f = val;
282− return cl;
261+ return (VAL)cl;
283}
262}
284
263
285VAL MKSTRlen(VM* vm, const char * str, size_t len) {
264VAL MKSTRlen(VM* vm, const char * str, size_t len) {
286− Closure* cl = allocStr(len, 0);
265+ String * cl = allocStr(vm, len, 0);
287− memcpy(cl->extra.str, str, len);
266+ memcpy(cl->str, str, len);
288 if (str == NULL)
267 if (str == NULL)
289− cl->info.slen = ~0;
268+ cl->slen = ~0;
290− return cl;
269+ return (VAL)cl;
291}
270}
292
271
293VAL MKSTR(VM* vm, const char* str) {
272VAL MKSTR(VM* vm, const char* str) {
294 return MKSTRlen(vm, str, str? strlen(str) : 0);
273 return MKSTRlen(vm, str, str? strlen(str) : 0);
295}
274}
296
275
276+static char * getstroff(StrOffset * stroff) {
277+ return stroff->base->str + stroff->offset;
278+}
279+
297char* GETSTROFF(VAL stroff) {
280char* GETSTROFF(VAL stroff) {
298 // Assume STROFF
281 // 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;
300}
287}
301
288
302size_t GETSTROFFLEN(VAL stroff) {
289size_t GETSTROFFLEN(VAL stroff) {
303 // Assume STROFF
290 // Assume STROFF
304 // we're working in char* here so no worries about utf8 char length
291 // 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);
306}
293}
307
294
308VAL MKCDATA(VM* vm, CHeapItem * item) {
295VAL MKCDATA(VM* vm, CHeapItem * item) {
309 c_heap_insert_if_needed(vm, &vm->c_heap, item);
296 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);
311 SETTY(cl, CT_CDATA);
298 SETTY(cl, CT_CDATA);
312− cl->info.c_heap_item = item;
299+ cl->item = item;
313− return cl;
300+ return (VAL)cl;
314}
301}
315
302
316VAL MKCDATAc(VM* vm, CHeapItem * item) {
303VAL MKCDATAc(VM* vm, CHeapItem * item) {
317 c_heap_insert_if_needed(vm, &vm->c_heap, item);
304 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);
319 SETTY(cl, CT_CDATA);
306 SETTY(cl, CT_CDATA);
320− cl->info.c_heap_item = item;
307+ cl->item = item;
321− return cl;
308+ return (VAL)cl;
322}
309}
323
310
324VAL MKPTR(VM* vm, void* ptr) {
311VAL MKPTR(VM* vm, void* ptr) {
325− Closure* cl = allocate(sizeof(Closure), 0);
312+ Ptr * cl = iallocate(vm, sizeof(*cl), 0);
326 SETTY(cl, CT_PTR);
313 SETTY(cl, CT_PTR);
327− cl -> info.ptr = ptr;
314+ cl->ptr = ptr;
328− return cl;
315+ return (VAL)cl;
329}
316}
330
317
331VAL MKMPTR(VM* vm, void* ptr, size_t size) {
318VAL 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);
333 SETTY(cl, CT_MANAGEDPTR);
320 SETTY(cl, CT_MANAGEDPTR);
334− memcpy(cl->extra.mptr, ptr, size);
321+ memcpy(cl->mptr, ptr, size);
335− cl->extrasz = size;
336− return cl;
322+ return (VAL)cl;
337}
323}
338
324
339VAL MKFLOATc(VM* vm, double val) {
325VAL MKFLOATc(VM* vm, double val) {
340− Closure* cl = allocate(sizeof(Closure), 1);
326+ Float * cl = iallocate(vm, sizeof(*cl), 1);
341 SETTY(cl, CT_FLOAT);
327 SETTY(cl, CT_FLOAT);
342− cl -> info.f = val;
328+ cl->f = val;
343− return cl;
329+ return (VAL)cl;
344}
330}
345
331
346VAL MKSTRclen(VM* vm, char* str, size_t len) {
332VAL MKSTRclen(VM* vm, char* str, size_t len) {
347− Closure* cl = allocStr(len, 1);
333+ String * cl = allocStr(vm, len, 1);
348− memcpy(cl->extra.str, str, len);
334+ memcpy(cl->str, str, len);
349− return cl;
335+ return (VAL)cl;
350}
336}
351
337
352VAL MKSTRc(VM* vm, char* str) {
338VAL MKSTRc(VM* vm, char* str) {
@@ -354,46 +340,45 @@ VAL MKSTRc(VM* vm, char* str) {
354}
340}
355
341
356VAL MKPTRc(VM* vm, void* ptr) {
342VAL MKPTRc(VM* vm, void* ptr) {
357− Closure* cl = allocate(sizeof(Closure), 1);
343+ Ptr * cl = iallocate(vm, sizeof(*cl), 1);
358 SETTY(cl, CT_PTR);
344 SETTY(cl, CT_PTR);
359− cl -> info.ptr = ptr;
345+ cl->ptr = ptr;
360− return cl;
346+ return (VAL)cl;
361}
347}
362
348
363VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
349VAL 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);
365 SETTY(cl, CT_MANAGEDPTR);
351 SETTY(cl, CT_MANAGEDPTR);
366− memcpy(cl->extra.mptr, ptr, size);
352+ memcpy(cl->mptr, ptr, size);
367− cl->extrasz = size;
368− return cl;
353+ return (VAL)cl;
369}
354}
370
355
371VAL MKB8(VM* vm, uint8_t bits8) {
356VAL MKB8(VM* vm, uint8_t bits8) {
372− Closure* cl = allocate(sizeof(Closure), 1);
357+ Bits8 * cl = iallocate(vm, sizeof(*cl), 1);
373 SETTY(cl, CT_BITS8);
358 SETTY(cl, CT_BITS8);
374− cl -> info.bits8 = bits8;
359+ cl->bits8 = bits8;
375− return cl;
360+ return (VAL)cl;
376}
361}
377
362
378VAL MKB16(VM* vm, uint16_t bits16) {
363VAL MKB16(VM* vm, uint16_t bits16) {
379− Closure* cl = allocate(sizeof(Closure), 1);
364+ Bits16 * cl = iallocate(vm, sizeof(*cl), 1);
380 SETTY(cl, CT_BITS16);
365 SETTY(cl, CT_BITS16);
381− cl -> info.bits16 = bits16;
366+ cl->bits16 = bits16;
382− return cl;
367+ return (VAL)cl;
383}
368}
384
369
385VAL MKB32(VM* vm, uint32_t bits32) {
370VAL MKB32(VM* vm, uint32_t bits32) {
386− Closure* cl = allocate(sizeof(Closure), 1);
371+ Bits32 * cl = iallocate(vm, sizeof(*cl), 1);
387 SETTY(cl, CT_BITS32);
372 SETTY(cl, CT_BITS32);
388− cl -> info.bits32 = bits32;
373+ cl->bits32 = bits32;
389− return cl;
374+ return (VAL)cl;
390}
375}
391
376
392VAL MKB64(VM* vm, uint64_t bits64) {
377VAL MKB64(VM* vm, uint64_t bits64) {
393− Closure* cl = allocate(sizeof(Closure), 1);
378+ Bits64 * cl = iallocate(vm, sizeof(*cl), 1);
394 SETTY(cl, CT_BITS64);
379 SETTY(cl, CT_BITS64);
395− cl -> info.bits64 = bits64;
380+ cl->bits64 = bits64;
396− return cl;
381+ return (VAL)cl;
397}
382}
398
383
399void idris_trace(VM* vm, const char* func, int line) {
384void idris_trace(VM* vm, const char* func, int line) {
@@ -427,25 +412,29 @@ void dumpVal(VAL v) {
427 return;
412 return;
428 }
413 }
429 switch(GETTY(v)) {
414 switch(GETTY(v)) {
430− case CT_CON:
415+ case CT_CON: {
416+ Con * cl = (Con*)v;
431− printf("%d[", (int)TAG(v));
417+ printf("%d[", (int)TAG(cl));
432− for(i = 0; i < CARITY(v); ++i) {
418+ for(i = 0; i < CARITY(cl); ++i) {
433− dumpVal(v->extra.cargs[i]);
419+ dumpVal(cl->args[i]);
434− }
420+ }
435− printf("] ");
421+ printf("] ");
436− break;
422+ } break;
437− case CT_STRING:
423+ case CT_STRING: {
424+ String * cl = (String*)v;
438− printf("STR[%s]", v->extra.str);
425+ printf("STR[%s]", cl->str);
439− break;
426+ } break;
440− case CT_STROFFSET:
427+ case CT_STROFFSET: {
428+ StrOffset * cl = (StrOffset*)v;
441 printf("OFFSET[");
429 printf("OFFSET[");
442− dumpVal((VAL)(v->extra.basestr[0]));
430+ dumpVal((VAL)cl->base);
443 printf("]");
431 printf("]");
444− break;
432+ } break;
445− case CT_FWD:
433+ case CT_FWD: {
434+ Fwd * cl = (Fwd*)v;
446 printf("CT_FWD ");
435 printf("CT_FWD ");
447− dumpVal((VAL)(v->info.ptr));
436+ dumpVal((VAL)cl->fwd);
448− break;
437+ } break;
449 default:
438 default:
450 printf("val");
439 printf("val");
451 }
440 }
@@ -466,7 +455,7 @@ void idris_poke(void* ptr, i_int offset, uint8_t data) {
466
455
467
456
468VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset) {
457VAL 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));
470 return MKPTR(vm, *addr);
459 return MKPTR(vm, *addr);
471}
460}
472
461
@@ -500,41 +489,41 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i
500
489
501VAL idris_castIntStr(VM* vm, VAL i) {
490VAL idris_castIntStr(VM* vm, VAL i) {
502 int x = (int) GETINT(i);
491 int x = (int) GETINT(i);
503− Closure* cl = allocStr(16, 0);
492+ String * cl = allocStr(vm, 16, 0);
504− cl->info.slen = sprintf(cl->extra.str, "%d", x);
493+ cl->slen = sprintf(cl->str, "%d", x);
505− return cl;
494+ return (VAL)cl;
506}
495}
507
496
508VAL idris_castBitsStr(VM* vm, VAL i) {
497VAL idris_castBitsStr(VM* vm, VAL i) {
509− Closure* cl;
498+ String * cl;
510 ClosureType ty = GETTY(i);
499 ClosureType ty = GETTY(i);
511
500
512 switch (ty) {
501 switch (ty) {
513 case CT_BITS8:
502 case CT_BITS8:
514 // max length 8 bit unsigned int str 3 chars (256)
503 // max length 8 bit unsigned int str 3 chars (256)
515− cl = allocStr(4, 0);
504+ cl = allocStr(vm, 4, 0);
516− cl->info.slen = sprintf(cl->extra.str, "%" PRIu8, GETBITS8(i));
505+ cl->slen = sprintf(cl->str, "%" PRIu8, GETBITS8(i));
517 break;
506 break;
518 case CT_BITS16:
507 case CT_BITS16:
519 // max length 16 bit unsigned int str 5 chars (65,535)
508 // max length 16 bit unsigned int str 5 chars (65,535)
520− cl = allocStr(6, 0);
509+ cl = allocStr(vm, 6, 0);
521− cl->info.slen = sprintf(cl->extra.str, "%" PRIu16, GETBITS16(i));
510+ cl->slen = sprintf(cl->str, "%" PRIu16, GETBITS16(i));
522 break;
511 break;
523 case CT_BITS32:
512 case CT_BITS32:
524 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
513 // max length 32 bit unsigned int str 10 chars (4,294,967,295)
525− cl = allocStr(11, 0);
514+ cl = allocStr(vm, 11, 0);
526− cl->info.slen = sprintf(cl->extra.str, "%" PRIu32, GETBITS32(i));
515+ cl->slen = sprintf(cl->str, "%" PRIu32, GETBITS32(i));
527 break;
516 break;
528 case CT_BITS64:
517 case CT_BITS64:
529 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
518 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)
530− cl = allocStr(21, 0);
519+ cl = allocStr(vm, 21, 0);
531− cl->info.slen = sprintf(cl->extra.str, "%" PRIu64, GETBITS64(i));
520+ cl->slen = sprintf(cl->str, "%" PRIu64, GETBITS64(i));
532 break;
521 break;
533 default:
522 default:
534 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
523 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);
535 exit(EXIT_FAILURE);
524 exit(EXIT_FAILURE);
536 }
525 }
537− return cl;
526+ return (VAL)cl;
538}
527}
539
528
540VAL idris_castStrInt(VM* vm, VAL i) {
529VAL idris_castStrInt(VM* vm, VAL i) {
@@ -547,9 +536,9 @@ VAL idris_castStrInt(VM* vm, VAL i) {
547}
536}
548
537
549VAL idris_castFloatStr(VM* vm, VAL i) {
538VAL idris_castFloatStr(VM* vm, VAL i) {
550− Closure* cl = allocStr(32, 0);
539+ String * cl = allocStr(vm, 32, 0);
551− cl->info.slen = snprintf(cl->extra.str, 32, "%.16g", GETFLOAT(i));
540+ cl->slen = snprintf(cl->str, 32, "%.16g", GETFLOAT(i));
552− return cl;
541+ return (VAL)cl;
553}
542}
554
543
555VAL idris_castStrFloat(VM* vm, VAL i) {
544VAL idris_castStrFloat(VM* vm, VAL i) {
@@ -562,10 +551,10 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
562 size_t llen = GETSTRLEN(l);
551 size_t llen = GETSTRLEN(l);
563 size_t rlen = GETSTRLEN(r);
552 size_t rlen = GETSTRLEN(r);
564
553
565− Closure* cl = allocStr(llen + rlen, 0);
554+ String * cl = allocStr(vm, llen + rlen, 0);
566− memcpy(cl->extra.str, ls, llen);
555+ memcpy(cl->str, ls, llen);
567− memcpy(cl->extra.str + llen, rs, rlen);
556+ memcpy(cl->str + llen, rs, rlen);
568− return cl;
557+ return (VAL)cl;
569}
558}
570
559
571VAL idris_strlt(VM* vm, VAL l, VAL r) {
560VAL idris_strlt(VM* vm, VAL l, VAL r) {
@@ -627,32 +616,31 @@ VAL idris_strHead(VM* vm, VAL str) {
627}
616}
628
617
629VAL MKSTROFFc(VM* vm, VAL basestr) {
618VAL MKSTROFFc(VM* vm, VAL basestr) {
630− Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 1);
619+ StrOffset * cl = iallocate(vm, sizeof(*cl), 1);
631 SETTY(cl, CT_STROFFSET);
620 SETTY(cl, CT_STROFFSET);
632− cl->extrasz = sizeof(VAL);
621+ cl->base = (String*)basestr;
633− cl->extra.basestr[0] = basestr;
622+ return (VAL)cl;
634− return cl;
635}
623}
636
624
637VAL idris_strShift(VM* vm, VAL str, int num) {
625VAL idris_strShift(VM* vm, VAL str, int num) {
626+ size_t sz = sizeof(StrOffset);
638 // If there's no room, just copy the string, or we'll have a problem after
627 // If there's no room, just copy the string, or we'll have a problem after
639 // gc moves str
628 // gc moves str
640− if (space(vm, sizeof(Closure))) {
629+ if (space(vm, sz)) {
641 int offset = 0;
630 int offset = 0;
642− VAL root = str;
631+ StrOffset * root = (StrOffset*)str;
643− Closure* cl = allocate(sizeof(Closure) + sizeof(VAL), 0);
632+ StrOffset * cl = iallocate(vm, sz, 0);
644 SETTY(cl, CT_STROFFSET);
633 SETTY(cl, CT_STROFFSET);
645− cl->extrasz = sizeof(VAL);
646
634
647 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
635 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.
648 // In theory, at most one step here!
636 // In theory, at most one step here!
649− offset += root->info.soffset;
637+ offset += root->offset;
650− root = root->extra.basestr[0];
638+ root = (StrOffset*)root->base;
651 }
639 }
652
640
653− cl->extra.basestr[0] = root;
641+ cl->base = (String*)root;
654− cl->info.soffset = offset+idris_utf8_findOffset(GETSTR(str), num);
642+ cl->offset = offset+idris_utf8_findOffset(GETSTR(str), num);
655− return cl;
643+ return (VAL)cl;
656 } else {
644 } else {
657 char* nstr = GETSTR(str);
645 char* nstr = GETSTR(str);
658 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));
646 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));
@@ -667,22 +655,22 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {
667 char *xstr = GETSTR(xs);
655 char *xstr = GETSTR(xs);
668 int xval = GETINT(x);
656 int xval = GETINT(x);
669 size_t xlen = GETSTRLEN(xs);
657 size_t xlen = GETSTRLEN(xs);
658+ String * cl;
670
659
671 if (xval < 0x80) { // ASCII char
660 if (xval < 0x80) { // ASCII char
672− Closure* cl = allocStr(xlen + 1, 0);
661+ cl = allocStr(vm, xlen + 1, 0);
673− cl->extra.str[0] = (char)(GETINT(x));
662+ cl->str[0] = (char)(GETINT(x));
674− memcpy(cl->extra.str+1, xstr, xlen);
663+ memcpy(cl->str+1, xstr, xlen);
675− return cl;
676 } else {
664 } else {
677 char *init = idris_utf8_fromChar(xval);
665 char *init = idris_utf8_fromChar(xval);
678 size_t ilen = strlen(init);
666 size_t ilen = strlen(init);
679 int newlen = ilen + xlen;
667 int newlen = ilen + xlen;
680− Closure* cl = allocStr(newlen, 0);
668+ cl = allocStr(vm, newlen, 0);
681− memcpy(cl->extra.str, init, ilen);
669+ memcpy(cl->str, init, ilen);
682− memcpy(cl->extra.str + ilen, xstr, xlen);
670+ memcpy(cl->str + ilen, xstr, xlen);
683 free(init);
671 free(init);
684− return cl;
685 }
672 }
673+ return (VAL)cl;
686}
674}
687
675
688VAL idris_strIndex(VM* vm, VAL str, VAL i) {
676VAL idris_strIndex(VM* vm, VAL str, VAL i) {
@@ -703,10 +691,10 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {
703 char *start = idris_utf8_advance(str_val, offset_val);
691 char *start = idris_utf8_advance(str_val, offset_val);
704 char *end = idris_utf8_advance(start, length_val);
692 char *end = idris_utf8_advance(start, length_val);
705 size_t sz = end - start;
693 size_t sz = end - start;
706− Closure* newstr = allocStr(sz, 0);
694+ String * newstr = allocStr(vm, sz, 0);
707− memcpy(newstr->extra.str, start, sz);
695+ memcpy(newstr->str, start, sz);
708− newstr->extra.str[sz] = '\0';
696+ newstr->str[sz] = '\0';
709− return newstr;
697+ return (VAL)newstr;
710 }
698 }
711}
699}
712
700
@@ -714,16 +702,16 @@ VAL idris_strRev(VM* vm, VAL str) {
714 char *xstr = GETSTR(str);
702 char *xstr = GETSTR(str);
715 size_t xlen = GETSTRLEN(str);
703 size_t xlen = GETSTRLEN(str);
716
704
717− Closure* cl = allocStr(xlen, 0);
705+ String * cl = allocStr(vm, xlen, 0);
718− idris_utf8_rev(xstr, cl->extra.str);
706+ idris_utf8_rev(xstr, cl->str);
719− return cl;
707+ return (VAL)cl;
720}
708}
721
709
722VAL idris_newRefLock(VAL x, int outerlock) {
710VAL idris_newRefLock(VAL x, int outerlock) {
723− Closure* cl = allocate(sizeof(Closure), outerlock);
711+ Ref * cl = allocate(sizeof(*cl), outerlock);
724 SETTY(cl, CT_REF);
712 SETTY(cl, CT_REF);
725− cl->info.ptr = (void*)x;
713+ cl->ref = x;
726− return cl;
714+ return (VAL)cl;
727}
715}
728
716
729VAL idris_newRef(VAL x) {
717VAL idris_newRef(VAL x) {
@@ -731,30 +719,34 @@ VAL idris_newRef(VAL x) {
731}
719}
732
720
733void idris_writeRef(VAL ref, VAL x) {
721void idris_writeRef(VAL ref, VAL x) {
734− ref->info.ptr = (void*)x;
722+ Ref * r = (Ref*)ref;
723+ r->ref = x;
735 SETTY(ref, CT_REF);
724 SETTY(ref, CT_REF);
736}
725}
737
726
738VAL idris_readRef(VAL ref) {
727VAL idris_readRef(VAL ref) {
728+ Ref * r = (Ref*)ref;
739− return (VAL)(ref->info.ptr);
729+ return r->ref;
740}
730}
741
731
742VAL idris_newArray(VM* vm, int size, VAL def) {
732VAL idris_newArray(VM* vm, int size, VAL def) {
743− Closure* cl;
733+ Array * cl;
744 int i;
734 int i;
745− allocArray(cl, vm, size, 0);
735+ cl = allocArrayF(vm, size, 0);
746 for(i=0; i<size; ++i) {
736 for(i=0; i<size; ++i) {
747− cl->extra.array[i] = def;
737+ cl->array[i] = def;
748 }
738 }
749− return cl;
739+ return (VAL)cl;
750}
740}
751
741
752void idris_arraySet(VAL arr, int index, VAL newval) {
742void idris_arraySet(VAL arr, int index, VAL newval) {
743+ Array * cl = (Array*)arr;
753− arr->extra.array[index] = newval;
744+ cl->array[index] = newval;
754}
745}
755
746
756VAL idris_arrayGet(VAL arr, int index) {
747VAL idris_arrayGet(VAL arr, int index) {
748+ Array * cl = (Array*)arr;
757− return arr->extra.array[index];
749+ return cl->array[index];
758}
750}
759
751
760VAL idris_systemInfo(VM* vm, VAL index) {
752VAL idris_systemInfo(VM* vm, VAL index) {
@@ -847,8 +839,8 @@ static void copyArray(VM* vm, VAL * dst, VAL * src, size_t len) {
847// VM is assumed to be a different vm from the one x lives on
839// VM is assumed to be a different vm from the one x lives on
848
840
849static VAL doCopyTo(VM* vm, VAL x) {
841static VAL doCopyTo(VM* vm, VAL x) {
850− int ar, len;
842+ int ar;
851− Closure* cl;
843+ VAL cl;
852 if (x==NULL || ISINT(x)) {
844 if (x==NULL || ISINT(x)) {
853 return x;
845 return x;
854 }
846 }
@@ -857,22 +849,24 @@ static VAL doCopyTo(VM* vm, VAL x) {
857 cl = MKCDATAc(vm, GETCDATA(x));
849 cl = MKCDATAc(vm, GETCDATA(x));
858 break;
850 break;
859 case CT_BIGINT:
851 case CT_BIGINT:
860− cl = MKBIGMc(vm, GETPTR(x));
852+ cl = MKBIGMc(vm, GETMPZ(x));
861 break;
853 break;
862 case CT_CON:
854 case CT_CON:
863 ar = CARITY(x);
855 ar = CARITY(x);
864 if (ar == 0 && CTAG(x) < 256) { // globally allocated
856 if (ar == 0 && CTAG(x) < 256) { // globally allocated
865 cl = x;
857 cl = x;
866 } else {
858 } else {
867− allocCon(cl, vm, CTAG(x), ar, 1);
859+ Con * c = allocConF(vm, CTAG(x), ar, 1);
868− copyArray(vm, cl->extra.cargs, x->extra.cargs, ar);
860+ copyArray(vm, c->args, ((Con*)x)->args, ar);
861+ cl = (VAL)c;
869 }
862 }
870 break;
863 break;
871− case CT_ARRAY:
864+ case CT_ARRAY: {
872− len = CELEM(x);
865+ size_t len = CELEM(x);
873− allocArray(cl, vm, len, 1);
866+ Array * a = allocArrayF(vm, len, 1);
874− copyArray(vm, cl->extra.array, x->extra.array, len);
867+ copyArray(vm, a->array, ((Array*)x)->array, len);
868+ cl = (VAL)a;
875− break;
869+ } break;
876 case CT_STRING:
870 case CT_STRING:
877 case CT_FLOAT:
871 case CT_FLOAT:
878 case CT_PTR:
872 case CT_PTR:
@@ -883,9 +877,8 @@ static VAL doCopyTo(VM* vm, VAL x) {
883 case CT_BITS64:
877 case CT_BITS64:
884 case CT_RAWDATA:
878 case CT_RAWDATA:
885 {
879 {
886− size_t size = sizeof(Closure) + x->extrasz;
880+ cl = iallocate(vm, x->hdr.sz, 0);
887− cl = allocate(size, 0);
888− memcpy(cl, x, size);
881+ memcpy(cl, x, x->hdr.sz);
889 }
882 }
890 break;
883 break;
891 default:
884 default:
@@ -895,10 +888,7 @@ static VAL doCopyTo(VM* vm, VAL x) {
895}
888}
896
889
897VAL copyTo(VM* vm, VAL x) {
890VAL copyTo(VM* vm, VAL x) {
898− VM* current = pthread_getspecific(vm_key);
899− pthread_setspecific(vm_key, vm);
900 VAL ret = doCopyTo(vm, x);
891 VAL ret = doCopyTo(vm, x);
901− pthread_setspecific(vm_key, current);
902 return ret;
892 return ret;
903}
893}
904
894
@@ -1116,13 +1106,12 @@ VAL* nullary_cons;
1116
1106
1117void init_nullaries(void) {
1107void init_nullaries(void) {
1118 int i;
1108 int i;
1119− VAL cl;
1120 nullary_cons = malloc(256 * sizeof(VAL));
1109 nullary_cons = malloc(256 * sizeof(VAL));
1121 for(i = 0; i < 256; ++i) {
1110 for(i = 0; i < 256; ++i) {
1122− cl = calloc(1, sizeof(Closure));
1111+ Con * cl = calloc(1, sizeof(*cl));
1123 SETTY(cl, CT_CON);
1112 SETTY(cl, CT_CON);
1124− cl->info.tag = i;
1113+ cl->tag = i;
1125− nullary_cons[i] = cl;
1114+ nullary_cons[i] = (VAL)cl;
1126 }
1115 }
1127}
1116}
1128
1117
rts/idris_rts.h+158−76
@@ -3,19 +3,17 @@
3
3
4#include <stdlib.h>
4#include <stdlib.h>
5#include <stdio.h>
5#include <stdio.h>
6+#include <stdatomic.h>
7+#ifdef HAS_PTHREAD
6#include <string.h>
8#include <string.h>
7#include <stdarg.h>
9#include <stdarg.h>
8−#ifdef HAS_PTHREAD
9#include <pthread.h>
10#include <pthread.h>
10#endif
11#endif
11−#include <stdint.h>
12−#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)
13−#include <signal.h>
14−#endif
15
12
16#include "idris_heap.h"
13#include "idris_heap.h"
17#include "idris_stats.h"
14#include "idris_stats.h"
18
15
16+
19#ifndef EXIT_SUCCESS
17#ifndef EXIT_SUCCESS
20#define EXIT_SUCCESS 0
18#define EXIT_SUCCESS 0
21#endif
19#endif
@@ -26,36 +24,111 @@
26// Closures
24// Closures
27typedef enum {
25typedef enum {
28 CT_CON, CT_ARRAY, CT_INT, CT_BIGINT, CT_FLOAT, CT_STRING, CT_STROFFSET,
26 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,
30 CT_FWD, CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA
28 CT_FWD, CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA
31} ClosureType;
29} ClosureType;
32
30
33−typedef struct Closure *VAL;
34
31
35−typedef struct Closure {
32+typedef struct Hdr {
36 uint64_t ty:8;
33 uint64_t ty:8;
37− uint64_t extrasz:56;
34+ uint64_t sz:56;
38− union {
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;
39− uint32_t tag;
46+ uint32_t tag;
40− size_t slen;
47+ uint32_t arity;
41− size_t soffset;
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;
42− int i;
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;
43− double f;
68+ double f;
44− void * ptr;
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;
45− uint8_t bits8;
85+ uint8_t bits8;
86+} Bits8;
87+
88+typedef struct Bits16 {
89+ Hdr hdr;
46− uint16_t bits16;
90+ uint16_t bits16;
91+} Bits16;
92+
93+typedef struct Bits32 {
94+ Hdr hdr;
47− uint32_t bits32;
95+ uint32_t bits32;
96+} Bits32;
97+
98+typedef struct Bits64 {
99+ Hdr hdr;
48− uint64_t bits64;
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;
49− CHeapItem* c_heap_item;
130+ CHeapItem * item;
50− } info;
131+} CDataC;
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;
59
132
60struct VM;
133struct VM;
61
134
@@ -164,37 +237,37 @@ typedef void(*func)(VM*, VAL*);
164#define REG1 (vm->reg1)
237#define REG1 (vm->reg1)
165
238
166// Retrieving values
239// Retrieving values
167−static inline char * getstr(VAL x) {
240+static inline char * getstr(String * x) {
168− return x->info.slen == ~0? NULL : x->extra.str;
241+ return x->slen == ~0? NULL : x->str;
169}
242}
170
243
171−static inline size_t getstrlen(VAL x) {
244+static inline size_t getstrlen(String * x) {
172− return x->info.slen == ~0? 0 : x->info.slen;
245+ return x->slen == ~0? 0 : x->slen;
173}
246}
174
247
175−#define GETSTR(x) (ISSTR(x) ? getstr((VAL)(x)) : GETSTROFF(x))
248+#define GETSTR(x) (ISSTR(x) ? getstr((String*)(x)) : GETSTROFF(x))
176−#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((VAL)(x)) : GETSTROFFLEN(x))
249+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((String*)(x)) : GETSTROFFLEN(x))
177−#define GETPTR(x) (((VAL)(x))->info.ptr)
250+#define GETPTR(x) (((Ptr*)(x))->ptr)
178−#define GETMPTR(x) (((VAL)(x))->extra.mptr)
251+#define GETMPTR(x) (((ManagedPtr*)(x))->mptr)
179−#define GETFLOAT(x) (((VAL)(x))->info.f)
252+#define GETFLOAT(x) (((Float*)(x))->f)
180−#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)
253+#define GETCDATA(x) (((CDataC*)(x))->item)
181
254
182−#define GETBITS8(x) (((VAL)(x))->info.bits8)
255+#define GETBITS8(x) (((Bits8*)(x))->bits8)
183−#define GETBITS16(x) (((VAL)(x))->info.bits16)
256+#define GETBITS16(x) (((Bits16*)(x))->bits16)
184−#define GETBITS32(x) (((VAL)(x))->info.bits32)
257+#define GETBITS32(x) (((Bits32*)(x))->bits32)
185−#define GETBITS64(x) (((VAL)(x))->info.bits64)
258+#define GETBITS64(x) (((Bits64*)(x))->bits64)
186
259
187// Already checked it's a CT_CON
260// Already checked it's a CT_CON
188−#define CTAG(x) ((x)->info.tag)
261+#define CTAG(x) (((Con*)(x))->tag)
189−#define CARITY(x) (((x)->extrasz) / sizeof(VAL))
262+#define CARITY(x) (((Con*)(x))->arity)
190
263
191−#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG(x) : (-1)) )
264+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG((Con*)x) : (-1)) )
192−#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY(x) : (-1)) )
265+#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY((Con*)x) : (-1)) )
193
266
194−#define CELEM(x) (((x)->extrasz) / sizeof(VAL))
267+#define CELEM(x) (((x)->hdr.sz - sizeof(Array)) / sizeof(VAL))
195
268
196−#define GETTY(x) ((x)->ty)
269+#define GETTY(x) ((ClosureType)((x)->hdr.ty))
197−#define SETTY(x,t) ((x)->ty = t)
270+#define SETTY(x,t) ((x)->hdr.ty = t)
198
271
199// Integers, floats and operators
272// Integers, floats and operators
200
273
@@ -261,14 +334,16 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);
261char* GETSTROFF(VAL stroff);
334char* GETSTROFF(VAL stroff);
262size_t GETSTROFFLEN(VAL stroff);
335size_t GETSTROFFLEN(VAL stroff);
263
336
264−#define SETARG(x, i, a) ((x)->extra.cargs)[i] = ((VAL)(a))
337+#define SETARG(x, i, a) (((Con*)(x))->args)[i] = ((VAL)(a))
265−#define GETARG(x, i) ((x)->extra.cargs[i])
338+#define GETARG(x, i) (((Con*)(x))->args[i])
266
339
267#define PROJECT(vm,r,loc,num) \
340#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)
269#define SLIDE(vm, args) \
342#define SLIDE(vm, args) \
270 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
343 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
271
344
345+void* iallocate(VM *, size_t, int);
346+
272void* allocate(size_t size, int outerlock);
347void* allocate(size_t size, int outerlock);
273// void* allocCon(VM* vm, int arity, int outerlock);
348// void* allocCon(VM* vm, int arity, int outerlock);
274
349
@@ -278,8 +353,8 @@ void* allocate(size_t size, int outerlock);
278// idris_doneAlloc *must* be called when allocation from C is done (as it
353// idris_doneAlloc *must* be called when allocation from C is done (as it
279// may take a lock if other threads are running).
354// may take a lock if other threads are running).
280
355
281−void idris_requireAlloc(size_t size);
356+void idris_requireAlloc(VM *, size_t size);
282−void idris_doneAlloc(void);
357+void idris_doneAlloc(VM *);
283
358
284// public interface to allocation (note that this may move other pointers
359// public interface to allocation (note that this may move other pointers
285// if allocating beyond the limits given by idris_requireAlloc!)
360// if allocating beyond the limits given by idris_requireAlloc!)
@@ -288,30 +363,35 @@ void* idris_alloc(size_t size);
288void* idris_realloc(void* old, size_t old_size, size_t size);
363void* idris_realloc(void* old, size_t old_size, size_t size);
289void idris_free(void* ptr, size_t size);
364void idris_free(void* ptr, size_t size);
290
365
291−#define allocCon(cl, vm, t, a, o) do { \
366+static inline void updateConF(Con * cl, unsigned tag, unsigned arity) {
292− size_t sz = sizeof(VAL)*a; \
293− cl = allocate(sizeof(Closure) + sz, o); \
294− SETTY(cl, CT_CON); \
367+ SETTY(cl, CT_CON);
295− cl->info.tag = t; \
368+ cl->tag = tag;
296− cl->extrasz = sz; \
369+ cl->arity = arity;
297− } while (0)
370+ cl->hdr.sz = sizeof(*cl) + sizeof(VAL) * arity;
371+}
298
372
299−#define updateCon(cl, old, t, a) do { \
373+static inline Con * allocConF(VM * vm, unsigned tag, unsigned arity, int outer) {
300− cl = old; \
301− SETTY(cl, CT_CON); \
302− cl->info.tag = t; \
303− cl->extrasz = sizeof(VAL)*a; \
374+ size_t sz = sizeof(VAL) * arity;
304− } while (0)
375+ Con * cl = iallocate(vm, sizeof(*cl) + sz, outer);
376+ updateConF(cl, tag, arity);
377+ return cl;
378+}
305
379
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)
306
391
307#define NULL_CON(x) nullary_cons[x]
392#define NULL_CON(x) nullary_cons[x]
308
393
309−#define allocArray(cl, vm, len, o) do { \
394+#define allocArray(cl, vm, len, o) (cl) = (VAL)allocArrayF(vm, len, o)
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)
315
395
316int idris_errno(void);
396int idris_errno(void);
317char* idris_showerror(int err);
397char* idris_showerror(int err);
@@ -449,11 +529,13 @@ void stackOverflow(void);
449#include "idris_gmp.h"
529#include "idris_gmp.h"
450
530
451static inline size_t valSize(VAL v) {
531static inline size_t valSize(VAL v) {
452− return sizeof(Closure) + v->extrasz;
532+ return v->hdr.sz;
453}
533}
454
534
455static inline size_t aligned(size_t sz) {
535static inline size_t aligned(size_t sz) {
456 return (sz + 7) & ~7;
536 return (sz + 7) & ~7;
457}
537}
458
538
539+VM* get_vm(void);
540+
459#endif
541#endif
rts/idris_stdfgn.c+1−3
@@ -6,7 +6,6 @@
6#include <fcntl.h>
6#include <fcntl.h>
7#include <errno.h>
7#include <errno.h>
8#include <sys/stat.h>
8#include <sys/stat.h>
9−#include <stdio.h>
10#include <time.h>
9#include <time.h>
11#include <dirent.h>
10#include <dirent.h>
12
11
@@ -79,7 +78,7 @@ void* idris_dirOpen(char* dname) {
79
78
80void idris_dirClose(void* h) {
79void idris_dirClose(void* h) {
81 DirInfo* di = (DirInfo*)h;
80 DirInfo* di = (DirInfo*)h;
82−
81+
83 closedir(di->dirptr);
82 closedir(di->dirptr);
84 free(di);
83 free(di);
85}
84}
@@ -219,4 +218,3 @@ VAL idris_getString(VM* vm, void* buffer) {
219 free(sb);
218 free(sb);
220 return str;
219 return str;
221}
220}
222−