Line | Branch | Exec | Source |
---|---|---|---|
1 | /* | ||
2 | Copyright 2018, 2020, 2022 - 2024 Joel Svensson svenssonjoel@yahoo.se | ||
3 | 2022 Benjamin Vedder | ||
4 | |||
5 | This program is free software: you can redistribute it and/or modify | ||
6 | it under the terms of the GNU General Public License as published by | ||
7 | the Free Software Foundation, either version 3 of the License, or | ||
8 | (at your option) any later version. | ||
9 | |||
10 | This program is distributed in the hope that it will be useful, | ||
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
13 | GNU General Public License for more details. | ||
14 | |||
15 | You should have received a copy of the GNU General Public License | ||
16 | along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
17 | */ | ||
18 | |||
19 | #include <stdio.h> | ||
20 | #include <stdlib.h> | ||
21 | #include <stdint.h> | ||
22 | #include <stdarg.h> | ||
23 | #include <inttypes.h> | ||
24 | #include <lbm_memory.h> | ||
25 | #include <lbm_custom_type.h> | ||
26 | |||
27 | #include "heap.h" | ||
28 | #include "symrepr.h" | ||
29 | #include "stack.h" | ||
30 | #include "lbm_channel.h" | ||
31 | #include "platform_mutex.h" | ||
32 | #include "eval_cps.h" | ||
33 | #ifdef VISUALIZE_HEAP | ||
34 | #include "heap_vis.h" | ||
35 | #endif | ||
36 | |||
37 | |||
38 | 97727291 | static inline lbm_value lbm_set_gc_mark(lbm_value x) { | |
39 | 97727291 | return x | LBM_GC_MARKED; | |
40 | } | ||
41 | |||
42 | 96422811 | static inline lbm_value lbm_clr_gc_mark(lbm_value x) { | |
43 | 96422811 | return x & ~LBM_GC_MASK; | |
44 | } | ||
45 | |||
46 | 2019107060 | static inline bool lbm_get_gc_mark(lbm_value x) { | |
47 | 2019107060 | return x & LBM_GC_MASK; | |
48 | } | ||
49 | |||
50 | // flag is the same bit as mark, but in car | ||
51 | static inline bool lbm_get_gc_flag(lbm_value x) { | ||
52 | return x & LBM_GC_MARKED; | ||
53 | } | ||
54 | |||
55 | static inline lbm_value lbm_set_gc_flag(lbm_value x) { | ||
56 | return x | LBM_GC_MARKED; | ||
57 | } | ||
58 | |||
59 | static inline lbm_value lbm_clr_gc_flag(lbm_value x) { | ||
60 | return x & ~LBM_GC_MASK; | ||
61 | } | ||
62 | |||
63 | |||
64 | lbm_heap_state_t lbm_heap_state; | ||
65 | |||
66 | lbm_const_heap_t *lbm_const_heap_state; | ||
67 | |||
68 | lbm_cons_t *lbm_heaps[2] = {NULL, NULL}; | ||
69 | |||
70 | static mutex_t lbm_const_heap_mutex; | ||
71 | static bool lbm_const_heap_mutex_initialized = false; | ||
72 | |||
73 | static mutex_t lbm_mark_mutex; | ||
74 | static bool lbm_mark_mutex_initialized = false; | ||
75 | |||
76 | #ifdef USE_GC_PTR_REV | ||
77 | void lbm_gc_lock(void) { | ||
78 | mutex_lock(&lbm_mark_mutex); | ||
79 | } | ||
80 | void lbm_gc_unlock(void) { | ||
81 | mutex_unlock(&lbm_mark_mutex); | ||
82 | } | ||
83 | #else | ||
84 | ✗ | void lbm_gc_lock(void) { | |
85 | ✗ | } | |
86 | ✗ | void lbm_gc_unlock(void) { | |
87 | ✗ | } | |
88 | #endif | ||
89 | |||
90 | /****************************************************/ | ||
91 | /* ENCODERS DECODERS */ | ||
92 | |||
93 | 2809400 | lbm_value lbm_enc_i32(int32_t x) { | |
94 | #ifndef LBM64 | ||
95 | 2809400 | lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE); | |
96 |
2/2✓ Branch 1 taken 1372 times.
✓ Branch 2 taken 2808028 times.
|
2809400 | if (lbm_type_of(i) == LBM_TYPE_SYMBOL) return i; |
97 | 2808028 | return lbm_set_ptr_type(i, LBM_TYPE_I32); | |
98 | #else | ||
99 | return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_I32; | ||
100 | #endif | ||
101 | } | ||
102 | |||
103 | 3646444 | lbm_value lbm_enc_u32(uint32_t x) { | |
104 | #ifndef LBM64 | ||
105 | 3646444 | lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE); | |
106 |
2/2✓ Branch 1 taken 766 times.
✓ Branch 2 taken 3645678 times.
|
3646444 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; |
107 | 3645678 | return lbm_set_ptr_type(u, LBM_TYPE_U32); | |
108 | #else | ||
109 | return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_U32; | ||
110 | #endif | ||
111 | } | ||
112 | |||
113 | 18444 | lbm_value lbm_enc_float(float x) { | |
114 | #ifndef LBM64 | ||
115 | lbm_uint t; | ||
116 | 18444 | memcpy(&t, &x, sizeof(lbm_float)); | |
117 | 18444 | lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE); | |
118 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 18444 times.
|
18444 | if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f; |
119 | 18444 | return lbm_set_ptr_type(f, LBM_TYPE_FLOAT); | |
120 | #else | ||
121 | lbm_uint t = 0; | ||
122 | memcpy(&t, &x, sizeof(float)); | ||
123 | return (((lbm_uint)t) << LBM_VAL_SHIFT) | LBM_TYPE_FLOAT; | ||
124 | #endif | ||
125 | } | ||
126 | |||
127 | 8428002 | static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) { | |
128 | 8428002 | lbm_value res = ENC_SYM_MERROR; | |
129 | 8428002 | res = lbm_cons(ENC_SYM_NIL,ENC_SYM_NIL); | |
130 |
2/2✓ Branch 1 taken 8425680 times.
✓ Branch 2 taken 2322 times.
|
8428002 | if (lbm_type_of(res) != LBM_TYPE_SYMBOL) { |
131 | 8425680 | uint8_t* storage = lbm_malloc(sizeof(uint64_t)); | |
132 |
2/2✓ Branch 0 taken 8422972 times.
✓ Branch 1 taken 2708 times.
|
8425680 | if (storage) { |
133 | 8422972 | memcpy(storage,source, sizeof(uint64_t)); | |
134 | 8422972 | lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual); | |
135 | 8422972 | res = lbm_set_ptr_type(res, type); | |
136 | } else { | ||
137 | 2708 | res = ENC_SYM_MERROR; | |
138 | } | ||
139 | } | ||
140 | 8428002 | return res; | |
141 | } | ||
142 | |||
143 | 4493324 | lbm_value lbm_enc_i64(int64_t x) { | |
144 | #ifndef LBM64 | ||
145 | 4493324 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE, LBM_TYPE_I64); | |
146 | #else | ||
147 | lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE); | ||
148 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; | ||
149 | return lbm_set_ptr_type(u, LBM_TYPE_I64); | ||
150 | #endif | ||
151 | } | ||
152 | |||
153 | 3370334 | lbm_value lbm_enc_u64(uint64_t x) { | |
154 | #ifndef LBM64 | ||
155 | 3370334 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE, LBM_TYPE_U64); | |
156 | #else | ||
157 | lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE); | ||
158 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; | ||
159 | return lbm_set_ptr_type(u, LBM_TYPE_U64); | ||
160 | #endif | ||
161 | } | ||
162 | |||
163 | 564344 | lbm_value lbm_enc_double(double x) { | |
164 | #ifndef LBM64 | ||
165 | 564344 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE, LBM_TYPE_DOUBLE); | |
166 | #else | ||
167 | lbm_uint t; | ||
168 | memcpy(&t, &x, sizeof(double)); | ||
169 | lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE); | ||
170 | if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f; | ||
171 | return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE); | ||
172 | #endif | ||
173 | } | ||
174 | |||
175 | // Type specific (as opposed to the dec_as_X) functions | ||
176 | // should only be run on values KNOWN to represent a value of the type | ||
177 | // that the decoder decodes. | ||
178 | |||
179 | 30912 | float lbm_dec_float(lbm_value x) { | |
180 | #ifndef LBM64 | ||
181 | float f_tmp; | ||
182 | 30912 | lbm_uint tmp = lbm_car(x); | |
183 | 30912 | memcpy(&f_tmp, &tmp, sizeof(float)); | |
184 | 30912 | return f_tmp; | |
185 | #else | ||
186 | uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT); | ||
187 | float f_tmp; | ||
188 | memcpy(&f_tmp, &tmp, sizeof(float)); | ||
189 | return f_tmp; | ||
190 | #endif | ||
191 | } | ||
192 | |||
193 | 563224 | double lbm_dec_double(lbm_value x) { | |
194 | #ifndef LBM64 | ||
195 | double d; | ||
196 | 563224 | uint32_t *data = (uint32_t*)lbm_car(x); | |
197 | 563224 | memcpy(&d, data, sizeof(double)); | |
198 | 563224 | return d; | |
199 | #else | ||
200 | double f_tmp; | ||
201 | lbm_uint tmp = lbm_car(x); | ||
202 | memcpy(&f_tmp, &tmp, sizeof(double)); | ||
203 | return f_tmp; | ||
204 | #endif | ||
205 | } | ||
206 | |||
207 | 7013994 | uint64_t lbm_dec_u64(lbm_value x) { | |
208 | #ifndef LBM64 | ||
209 | uint64_t u; | ||
210 | 7013994 | uint32_t *data = (uint32_t*)lbm_car(x); | |
211 | 7013994 | memcpy(&u, data, 8); | |
212 | 7013994 | return u; | |
213 | #else | ||
214 | return (uint64_t)lbm_car(x); | ||
215 | #endif | ||
216 | } | ||
217 | |||
218 | 9256564 | int64_t lbm_dec_i64(lbm_value x) { | |
219 | #ifndef LBM64 | ||
220 | int64_t i; | ||
221 | 9256564 | uint32_t *data = (uint32_t*)lbm_car(x); | |
222 | 9256564 | memcpy(&i, data, 8); | |
223 | 9256564 | return i; | |
224 | #else | ||
225 | return (int64_t)lbm_car(x); | ||
226 | #endif | ||
227 | } | ||
228 | |||
229 | 576370 | char *lbm_dec_str(lbm_value val) { | |
230 | 576370 | char *res = 0; | |
231 | // If val is an array, car of val will be non-null. | ||
232 |
1/2✓ Branch 1 taken 576370 times.
✗ Branch 2 not taken.
|
576370 | if (lbm_is_array_r(val)) { |
233 | 576370 | lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val); | |
234 | 576370 | res = (char *)array->data; | |
235 | } | ||
236 | 576370 | return res; | |
237 | } | ||
238 | |||
239 | 2553929 | lbm_char_channel_t *lbm_dec_channel(lbm_value val) { | |
240 | 2553929 | lbm_char_channel_t *res = NULL; | |
241 | |||
242 |
1/2✓ Branch 1 taken 2553929 times.
✗ Branch 2 not taken.
|
2553929 | if (lbm_type_of(val) == LBM_TYPE_CHANNEL) { |
243 | 2553929 | res = (lbm_char_channel_t *)lbm_car(val); | |
244 | } | ||
245 | 2553929 | return res; | |
246 | } | ||
247 | |||
248 | 1260 | lbm_uint lbm_dec_custom(lbm_value val) { | |
249 | 1260 | lbm_uint res = 0; | |
250 |
1/2✓ Branch 1 taken 1260 times.
✗ Branch 2 not taken.
|
1260 | if (lbm_type_of(val) == LBM_TYPE_CUSTOM) { |
251 | 1260 | res = (lbm_uint)lbm_car(val); | |
252 | } | ||
253 | 1260 | return res; | |
254 | } | ||
255 | |||
256 | ✗ | uint8_t lbm_dec_as_char(lbm_value a) { | |
257 | ✗ | switch (lbm_type_of_functional(a)) { | |
258 | ✗ | case LBM_TYPE_CHAR: | |
259 | ✗ | return (uint8_t) lbm_dec_char(a); | |
260 | ✗ | case LBM_TYPE_I: | |
261 | ✗ | return (uint8_t) lbm_dec_i(a); | |
262 | ✗ | case LBM_TYPE_U: | |
263 | ✗ | return (uint8_t) lbm_dec_u(a); | |
264 | ✗ | case LBM_TYPE_I32: | |
265 | ✗ | return (uint8_t) lbm_dec_i32(a); | |
266 | ✗ | case LBM_TYPE_U32: | |
267 | ✗ | return (uint8_t) lbm_dec_u32(a); | |
268 | ✗ | case LBM_TYPE_FLOAT: | |
269 | ✗ | return (uint8_t)lbm_dec_float(a); | |
270 | ✗ | case LBM_TYPE_I64: | |
271 | ✗ | return (uint8_t) lbm_dec_i64(a); | |
272 | ✗ | case LBM_TYPE_U64: | |
273 | ✗ | return (uint8_t) lbm_dec_u64(a); | |
274 | ✗ | case LBM_TYPE_DOUBLE: | |
275 | ✗ | return (uint8_t) lbm_dec_double(a); | |
276 | } | ||
277 | ✗ | return 0; | |
278 | } | ||
279 | |||
280 | 35636568 | uint32_t lbm_dec_as_u32(lbm_value a) { | |
281 |
4/9✓ Branch 1 taken 561914 times.
✓ Branch 2 taken 1261590 times.
✓ Branch 3 taken 29050214 times.
✓ Branch 4 taken 4762850 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
|
35636568 | switch (lbm_type_of_functional(a)) { |
282 | 561914 | case LBM_TYPE_CHAR: | |
283 | 561914 | return (uint32_t) lbm_dec_char(a); | |
284 | 1261590 | case LBM_TYPE_I: | |
285 | 1261590 | return (uint32_t) lbm_dec_i(a); | |
286 | 29050214 | case LBM_TYPE_U: | |
287 | 29050214 | return (uint32_t) lbm_dec_u(a); | |
288 | 4762850 | case LBM_TYPE_I32: /* fall through */ | |
289 | case LBM_TYPE_U32: | ||
290 | 4762850 | return (uint32_t) lbm_dec_u32(a); | |
291 | ✗ | case LBM_TYPE_FLOAT: | |
292 | ✗ | return (uint32_t)lbm_dec_float(a); | |
293 | ✗ | case LBM_TYPE_I64: | |
294 | ✗ | return (uint32_t) lbm_dec_i64(a); | |
295 | ✗ | case LBM_TYPE_U64: | |
296 | ✗ | return (uint32_t) lbm_dec_u64(a); | |
297 | ✗ | case LBM_TYPE_DOUBLE: | |
298 | ✗ | return (uint32_t) lbm_dec_double(a); | |
299 | } | ||
300 | ✗ | return 0; | |
301 | } | ||
302 | |||
303 | 743719646 | int32_t lbm_dec_as_i32(lbm_value a) { | |
304 |
4/10✓ Branch 1 taken 33203802 times.
✓ Branch 2 taken 706870924 times.
✓ Branch 3 taken 168 times.
✓ Branch 4 taken 3644752 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
|
743719646 | switch (lbm_type_of_functional(a)) { |
305 | 33203802 | case LBM_TYPE_CHAR: | |
306 | 33203802 | return (int32_t) lbm_dec_char(a); | |
307 | 706870924 | case LBM_TYPE_I: | |
308 | 706870924 | return (int32_t) lbm_dec_i(a); | |
309 | 168 | case LBM_TYPE_U: | |
310 | 168 | return (int32_t) lbm_dec_u(a); | |
311 | 3644752 | case LBM_TYPE_I32: | |
312 | 3644752 | return (int32_t) lbm_dec_i32(a); | |
313 | ✗ | case LBM_TYPE_U32: | |
314 | ✗ | return (int32_t) lbm_dec_u32(a); | |
315 | ✗ | case LBM_TYPE_FLOAT: | |
316 | ✗ | return (int32_t) lbm_dec_float(a); | |
317 | ✗ | case LBM_TYPE_I64: | |
318 | ✗ | return (int32_t) lbm_dec_i64(a); | |
319 | ✗ | case LBM_TYPE_U64: | |
320 | ✗ | return (int32_t) lbm_dec_u64(a); | |
321 | ✗ | case LBM_TYPE_DOUBLE: | |
322 | ✗ | return (int32_t) lbm_dec_double(a); | |
323 | |||
324 | } | ||
325 | ✗ | return 0; | |
326 | } | ||
327 | |||
328 | 6731084 | int64_t lbm_dec_as_i64(lbm_value a) { | |
329 |
6/10✓ Branch 1 taken 562210 times.
✓ Branch 2 taken 1403198 times.
✓ Branch 3 taken 112 times.
✓ Branch 4 taken 112 times.
✓ Branch 5 taken 112 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4765340 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
|
6731084 | switch (lbm_type_of_functional(a)) { |
330 | 562210 | case LBM_TYPE_CHAR: | |
331 | 562210 | return (int64_t) lbm_dec_char(a); | |
332 | 1403198 | case LBM_TYPE_I: | |
333 | 1403198 | return lbm_dec_i(a); | |
334 | 112 | case LBM_TYPE_U: | |
335 | 112 | return (int64_t) lbm_dec_u(a); | |
336 | 112 | case LBM_TYPE_I32: | |
337 | 112 | return (int64_t) lbm_dec_i32(a); | |
338 | 112 | case LBM_TYPE_U32: | |
339 | 112 | return (int64_t) lbm_dec_u32(a); | |
340 | ✗ | case LBM_TYPE_FLOAT: | |
341 | ✗ | return (int64_t) lbm_dec_float(a); | |
342 | 4765340 | case LBM_TYPE_I64: | |
343 | 4765340 | return (int64_t) lbm_dec_i64(a); | |
344 | ✗ | case LBM_TYPE_U64: | |
345 | ✗ | return (int64_t) lbm_dec_u64(a); | |
346 | ✗ | case LBM_TYPE_DOUBLE: | |
347 | ✗ | return (int64_t) lbm_dec_double(a); | |
348 | } | ||
349 | ✗ | return 0; | |
350 | } | ||
351 | |||
352 | 4488654 | uint64_t lbm_dec_as_u64(lbm_value a) { | |
353 |
7/10✓ Branch 1 taken 562210 times.
✓ Branch 2 taken 280656 times.
✓ Branch 3 taken 112 times.
✓ Branch 4 taken 112 times.
✓ Branch 5 taken 112 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 112 times.
✓ Branch 8 taken 3645340 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
|
4488654 | switch (lbm_type_of_functional(a)) { |
354 | 562210 | case LBM_TYPE_CHAR: | |
355 | 562210 | return (uint64_t) lbm_dec_char(a); | |
356 | 280656 | case LBM_TYPE_I: | |
357 | 280656 | return (uint64_t) lbm_dec_i(a); | |
358 | 112 | case LBM_TYPE_U: | |
359 | 112 | return lbm_dec_u(a); | |
360 | 112 | case LBM_TYPE_I32: | |
361 | 112 | return (uint64_t) lbm_dec_i32(a); | |
362 | 112 | case LBM_TYPE_U32: | |
363 | 112 | return (uint64_t) lbm_dec_u32(a); | |
364 | ✗ | case LBM_TYPE_FLOAT: | |
365 | ✗ | return (uint64_t)lbm_dec_float(a); | |
366 | 112 | case LBM_TYPE_I64: | |
367 | 112 | return (uint64_t) lbm_dec_i64(a); | |
368 | 3645340 | case LBM_TYPE_U64: | |
369 | 3645340 | return (uint64_t) lbm_dec_u64(a); | |
370 | ✗ | case LBM_TYPE_DOUBLE: | |
371 | ✗ | return (uint64_t) lbm_dec_double(a); | |
372 | } | ||
373 | ✗ | return 0; | |
374 | } | ||
375 | |||
376 | ✗ | lbm_uint lbm_dec_as_uint(lbm_value a) { | |
377 | ✗ | switch (lbm_type_of_functional(a)) { | |
378 | ✗ | case LBM_TYPE_CHAR: | |
379 | ✗ | return (lbm_uint) lbm_dec_char(a); | |
380 | ✗ | case LBM_TYPE_I: | |
381 | ✗ | return (lbm_uint) lbm_dec_i(a); | |
382 | ✗ | case LBM_TYPE_U: | |
383 | ✗ | return (lbm_uint) lbm_dec_u(a); | |
384 | ✗ | case LBM_TYPE_I32: | |
385 | ✗ | return (lbm_uint) lbm_dec_i32(a); | |
386 | ✗ | case LBM_TYPE_U32: | |
387 | ✗ | return (lbm_uint) lbm_dec_u32(a); | |
388 | ✗ | case LBM_TYPE_FLOAT: | |
389 | ✗ | return (lbm_uint) lbm_dec_float(a); | |
390 | ✗ | case LBM_TYPE_I64: | |
391 | ✗ | return (lbm_uint) lbm_dec_i64(a); | |
392 | ✗ | case LBM_TYPE_U64: | |
393 | ✗ | return (lbm_uint) lbm_dec_u64(a); | |
394 | ✗ | case LBM_TYPE_DOUBLE: | |
395 | ✗ | return (lbm_uint) lbm_dec_double(a); | |
396 | } | ||
397 | ✗ | return 0; | |
398 | } | ||
399 | |||
400 | 224 | lbm_int lbm_dec_as_int(lbm_value a) { | |
401 |
1/10✗ Branch 1 not taken.
✓ Branch 2 taken 224 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
|
224 | switch (lbm_type_of_functional(a)) { |
402 | ✗ | case LBM_TYPE_CHAR: | |
403 | ✗ | return (lbm_int) lbm_dec_char(a); | |
404 | 224 | case LBM_TYPE_I: | |
405 | 224 | return (lbm_int) lbm_dec_i(a); | |
406 | ✗ | case LBM_TYPE_U: | |
407 | ✗ | return (lbm_int) lbm_dec_u(a); | |
408 | ✗ | case LBM_TYPE_I32: | |
409 | ✗ | return (lbm_int) lbm_dec_i32(a); | |
410 | ✗ | case LBM_TYPE_U32: | |
411 | ✗ | return (lbm_int) lbm_dec_u32(a); | |
412 | ✗ | case LBM_TYPE_FLOAT: | |
413 | ✗ | return (lbm_int)lbm_dec_float(a); | |
414 | ✗ | case LBM_TYPE_I64: | |
415 | ✗ | return (lbm_int) lbm_dec_i64(a); | |
416 | ✗ | case LBM_TYPE_U64: | |
417 | ✗ | return (lbm_int) lbm_dec_u64(a); | |
418 | ✗ | case LBM_TYPE_DOUBLE: | |
419 | ✗ | return (lbm_int) lbm_dec_double(a); | |
420 | } | ||
421 | ✗ | return 0; | |
422 | } | ||
423 | |||
424 | 17444 | float lbm_dec_as_float(lbm_value a) { | |
425 | |||
426 |
8/10✓ Branch 1 taken 1120 times.
✓ Branch 2 taken 1344 times.
✓ Branch 3 taken 112 times.
✓ Branch 4 taken 112 times.
✓ Branch 5 taken 168 times.
✓ Branch 6 taken 14364 times.
✓ Branch 7 taken 112 times.
✓ Branch 8 taken 112 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
|
17444 | switch (lbm_type_of_functional(a)) { |
427 | 1120 | case LBM_TYPE_CHAR: | |
428 | 1120 | return (float) lbm_dec_char(a); | |
429 | 1344 | case LBM_TYPE_I: | |
430 | 1344 | return (float) lbm_dec_i(a); | |
431 | 112 | case LBM_TYPE_U: | |
432 | 112 | return (float) lbm_dec_u(a); | |
433 | 112 | case LBM_TYPE_I32: | |
434 | 112 | return (float) lbm_dec_i32(a); | |
435 | 168 | case LBM_TYPE_U32: | |
436 | 168 | return (float) lbm_dec_u32(a); | |
437 | 14364 | case LBM_TYPE_FLOAT: | |
438 | 14364 | return (float) lbm_dec_float(a); | |
439 | 112 | case LBM_TYPE_I64: | |
440 | 112 | return (float) lbm_dec_i64(a); | |
441 | 112 | case LBM_TYPE_U64: | |
442 | 112 | return (float) lbm_dec_u64(a); | |
443 | ✗ | case LBM_TYPE_DOUBLE: | |
444 | ✗ | return (float) lbm_dec_double(a); | |
445 | } | ||
446 | ✗ | return 0; | |
447 | } | ||
448 | |||
449 | 563224 | double lbm_dec_as_double(lbm_value a) { | |
450 | |||
451 |
9/10✓ Branch 1 taken 281140 times.
✓ Branch 2 taken 280796 times.
✓ Branch 3 taken 112 times.
✓ Branch 4 taken 112 times.
✓ Branch 5 taken 112 times.
✓ Branch 6 taken 168 times.
✓ Branch 7 taken 112 times.
✓ Branch 8 taken 112 times.
✓ Branch 9 taken 560 times.
✗ Branch 10 not taken.
|
563224 | switch (lbm_type_of_functional(a)) { |
452 | 281140 | case LBM_TYPE_CHAR: | |
453 | 281140 | return (double) lbm_dec_char(a); | |
454 | 280796 | case LBM_TYPE_I: | |
455 | 280796 | return (double) lbm_dec_i(a); | |
456 | 112 | case LBM_TYPE_U: | |
457 | 112 | return (double) lbm_dec_u(a); | |
458 | 112 | case LBM_TYPE_I32: | |
459 | 112 | return (double) lbm_dec_i32(a); | |
460 | 112 | case LBM_TYPE_U32: | |
461 | 112 | return (double) lbm_dec_u32(a); | |
462 | 168 | case LBM_TYPE_FLOAT: | |
463 | 168 | return (double) lbm_dec_float(a); | |
464 | 112 | case LBM_TYPE_I64: | |
465 | 112 | return (double) lbm_dec_i64(a); | |
466 | 112 | case LBM_TYPE_U64: | |
467 | 112 | return (double) lbm_dec_u64(a); | |
468 | 560 | case LBM_TYPE_DOUBLE: | |
469 | 560 | return (double) lbm_dec_double(a); | |
470 | } | ||
471 | ✗ | return 0; | |
472 | } | ||
473 | |||
474 | /****************************************************/ | ||
475 | /* HEAP MANAGEMENT */ | ||
476 | |||
477 | 17444 | static int generate_freelist(size_t num_cells) { | |
478 | 17444 | size_t i = 0; | |
479 | |||
480 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17444 times.
|
17444 | if (!lbm_heap_state.heap) return 0; |
481 | |||
482 | 17444 | lbm_heap_state.freelist = lbm_enc_cons_ptr(0); | |
483 | |||
484 | lbm_cons_t *t; | ||
485 | |||
486 | // Add all cells to free list | ||
487 |
2/2✓ Branch 0 taken 162022364 times.
✓ Branch 1 taken 17444 times.
|
162039808 | for (i = 1; i < num_cells; i ++) { |
488 | 162022364 | t = lbm_ref_cell(lbm_enc_cons_ptr(i-1)); | |
489 | 162022364 | t->car = ENC_SYM_RECOVERED; // all cars in free list are "RECOVERED" | |
490 | 162022364 | t->cdr = lbm_enc_cons_ptr(i); | |
491 | } | ||
492 | |||
493 | // Replace the incorrect pointer at the last cell. | ||
494 | 17444 | t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1)); | |
495 | 17444 | t->cdr = ENC_SYM_NIL; | |
496 | |||
497 | 17444 | return 1; | |
498 | } | ||
499 | |||
500 | 1057817 | void lbm_nil_freelist(void) { | |
501 | 1057817 | lbm_heap_state.freelist = ENC_SYM_NIL; | |
502 | 1057817 | lbm_heap_state.num_alloc = lbm_heap_state.heap_size; | |
503 | 1057817 | } | |
504 | |||
505 | 17444 | static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells, | |
506 | lbm_uint* gc_stack_storage, lbm_uint gc_stack_size) { | ||
507 | 17444 | lbm_heap_state.heap = addr; | |
508 | 17444 | lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t)); | |
509 | 17444 | lbm_heap_state.heap_size = num_cells; | |
510 | |||
511 | 17444 | lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size); | |
512 | |||
513 | 17444 | lbm_heap_state.num_alloc = 0; | |
514 | 17444 | lbm_heap_state.num_alloc_arrays = 0; | |
515 | 17444 | lbm_heap_state.gc_num = 0; | |
516 | 17444 | lbm_heap_state.gc_marked = 0; | |
517 | 17444 | lbm_heap_state.gc_recovered = 0; | |
518 | 17444 | lbm_heap_state.gc_recovered_arrays = 0; | |
519 | 17444 | lbm_heap_state.gc_least_free = num_cells; | |
520 | 17444 | lbm_heap_state.gc_last_free = num_cells; | |
521 | 17444 | } | |
522 | |||
523 | 1057817 | void lbm_heap_new_freelist_length(void) { | |
524 | 1057817 | lbm_uint l = lbm_heap_state.heap_size - lbm_heap_state.num_alloc; | |
525 | 1057817 | lbm_heap_state.gc_last_free = l; | |
526 |
2/2✓ Branch 0 taken 2984 times.
✓ Branch 1 taken 1054833 times.
|
1057817 | if (l < lbm_heap_state.gc_least_free) |
527 | 2984 | lbm_heap_state.gc_least_free = l; | |
528 | 1057817 | } | |
529 | |||
530 | 17444 | int lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells, | |
531 | lbm_uint gc_stack_size) { | ||
532 | |||
533 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17444 times.
|
17444 | if (((uintptr_t)addr % 8) != 0) return 0; |
534 | |||
535 | 17444 | memset(addr,0, sizeof(lbm_cons_t) * num_cells); | |
536 | |||
537 | 17444 | lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint)); | |
538 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17444 times.
|
17444 | if (gc_stack_storage == NULL) return 0; |
539 | |||
540 | 17444 | heap_init_state(addr, num_cells, | |
541 | gc_stack_storage, gc_stack_size); | ||
542 | |||
543 | 17444 | lbm_heaps[0] = addr; | |
544 | |||
545 | 17444 | return generate_freelist(num_cells); | |
546 | } | ||
547 | |||
548 | 257628742 | lbm_uint lbm_heap_num_free(void) { | |
549 | 257628742 | return lbm_heap_state.heap_size - lbm_heap_state.num_alloc; | |
550 | } | ||
551 | |||
552 | 863619126 | lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) { | |
553 | lbm_value res; | ||
554 | // it is a ptr replace freelist with cdr of freelist; | ||
555 | 863619126 | res = lbm_heap_state.freelist; | |
556 |
2/2✓ Branch 1 taken 862982132 times.
✓ Branch 2 taken 636994 times.
|
863619126 | if (lbm_type_of(res) == LBM_TYPE_CONS) { |
557 | 862982132 | lbm_uint heap_ix = lbm_dec_ptr(res); | |
558 | 862982132 | lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr; | |
559 | 862982132 | lbm_heap_state.num_alloc++; | |
560 | 862982132 | lbm_heap_state.heap[heap_ix].car = car; | |
561 | 862982132 | lbm_heap_state.heap[heap_ix].cdr = cdr; | |
562 | 862982132 | res = lbm_set_ptr_type(res, ptr_type); | |
563 | 862982132 | return res; | |
564 | } | ||
565 | 636994 | return ENC_SYM_MERROR; | |
566 | } | ||
567 | |||
568 | 28949186 | lbm_value lbm_heap_allocate_list(lbm_uint n) { | |
569 |
2/2✓ Branch 0 taken 420 times.
✓ Branch 1 taken 28948766 times.
|
28949186 | if (n == 0) return ENC_SYM_NIL; |
570 |
2/2✓ Branch 1 taken 90448 times.
✓ Branch 2 taken 28858318 times.
|
28948766 | if (lbm_heap_num_free() < n) return ENC_SYM_MERROR; |
571 | |||
572 | 28858318 | lbm_value curr = lbm_heap_state.freelist; | |
573 | 28858318 | lbm_value res = curr; | |
574 |
1/2✓ Branch 1 taken 28858318 times.
✗ Branch 2 not taken.
|
28858318 | if (lbm_type_of(curr) == LBM_TYPE_CONS) { |
575 | |||
576 | 28858318 | lbm_cons_t *c_cell = NULL; | |
577 | 28858318 | lbm_uint count = 0; | |
578 | do { | ||
579 | 117129108 | c_cell = lbm_ref_cell(curr); | |
580 | 117129108 | c_cell->car = ENC_SYM_NIL; | |
581 | 117129108 | curr = c_cell->cdr; | |
582 | 117129108 | count ++; | |
583 |
2/2✓ Branch 0 taken 88270790 times.
✓ Branch 1 taken 28858318 times.
|
117129108 | } while (count < n); |
584 | 28858318 | lbm_heap_state.freelist = curr; | |
585 | 28858318 | c_cell->cdr = ENC_SYM_NIL; | |
586 | 28858318 | lbm_heap_state.num_alloc+=count; | |
587 | 28858318 | return res; | |
588 | } | ||
589 | ✗ | return ENC_SYM_FATAL_ERROR; | |
590 | } | ||
591 | |||
592 | 598466 | lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) { | |
593 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 598466 times.
|
598466 | if (n == 0) return ENC_SYM_NIL; |
594 |
2/2✓ Branch 1 taken 2990 times.
✓ Branch 2 taken 595476 times.
|
598466 | if (lbm_heap_num_free() < n) return ENC_SYM_MERROR; |
595 | |||
596 | 595476 | lbm_value curr = lbm_heap_state.freelist; | |
597 | 595476 | lbm_value res = curr; | |
598 |
1/2✓ Branch 1 taken 595476 times.
✗ Branch 2 not taken.
|
595476 | if (lbm_type_of(curr) == LBM_TYPE_CONS) { |
599 | |||
600 | 595476 | lbm_cons_t *c_cell = NULL; | |
601 | 595476 | unsigned int count = 0; | |
602 | do { | ||
603 | 1475096 | c_cell = lbm_ref_cell(curr); | |
604 | 1475096 | c_cell->car = va_arg(valist, lbm_value); | |
605 | 1475096 | curr = c_cell->cdr; | |
606 | 1475096 | count ++; | |
607 |
2/2✓ Branch 0 taken 879620 times.
✓ Branch 1 taken 595476 times.
|
1475096 | } while (count < n); |
608 | 595476 | lbm_heap_state.freelist = curr; | |
609 | 595476 | c_cell->cdr = ENC_SYM_NIL; | |
610 | 595476 | lbm_heap_state.num_alloc+=count; | |
611 | 595476 | return res; | |
612 | } | ||
613 | ✗ | return ENC_SYM_FATAL_ERROR; | |
614 | } | ||
615 | |||
616 | 596674 | lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) { | |
617 | va_list valist; | ||
618 | 596674 | va_start(valist, n); | |
619 | 596674 | lbm_value r = lbm_heap_allocate_list_init_va(n, valist); | |
620 | 596674 | va_end(valist); | |
621 | 596674 | return r; | |
622 | } | ||
623 | |||
624 | ✗ | lbm_uint lbm_heap_num_allocated(void) { | |
625 | ✗ | return lbm_heap_state.num_alloc; | |
626 | } | ||
627 | ✗ | lbm_uint lbm_heap_size(void) { | |
628 | ✗ | return lbm_heap_state.heap_size; | |
629 | } | ||
630 | |||
631 | ✗ | lbm_uint lbm_heap_size_bytes(void) { | |
632 | ✗ | return lbm_heap_state.heap_bytes; | |
633 | } | ||
634 | |||
635 | ✗ | void lbm_get_heap_state(lbm_heap_state_t *res) { | |
636 | ✗ | *res = lbm_heap_state; | |
637 | ✗ | } | |
638 | |||
639 | ✗ | lbm_uint lbm_get_gc_stack_max(void) { | |
640 | ✗ | return lbm_heap_state.gc_stack.max_sp; | |
641 | } | ||
642 | |||
643 | ✗ | lbm_uint lbm_get_gc_stack_size(void) { | |
644 | ✗ | return lbm_heap_state.gc_stack.size; | |
645 | } | ||
646 | |||
647 | #ifdef USE_GC_PTR_REV | ||
648 | static inline void value_assign(lbm_value *a, lbm_value b) { | ||
649 | lbm_value a_old = *a & LBM_GC_MASK; | ||
650 | *a = a_old | (b & ~LBM_GC_MASK); | ||
651 | } | ||
652 | |||
653 | void lbm_gc_mark_phase(lbm_value root) { | ||
654 | bool work_to_do = true; | ||
655 | |||
656 | if (!lbm_is_ptr(root)) return; | ||
657 | |||
658 | mutex_lock(&lbm_const_heap_mutex); | ||
659 | lbm_value curr = root; | ||
660 | lbm_value prev = lbm_enc_cons_ptr(LBM_PTR_NULL); | ||
661 | |||
662 | while (work_to_do) { | ||
663 | // follow leftwards pointers | ||
664 | while (lbm_is_ptr(curr) && | ||
665 | (lbm_dec_ptr(curr) != LBM_PTR_NULL) && | ||
666 | ((curr & LBM_PTR_TO_CONSTANT_BIT) == 0) && | ||
667 | !lbm_get_gc_mark(lbm_cdr(curr))) { | ||
668 | // Mark the cell if not a constant cell | ||
669 | lbm_cons_t *cell = lbm_ref_cell(curr); | ||
670 | cell->cdr = lbm_set_gc_mark(cell->cdr); | ||
671 | if (lbm_is_cons_rw(curr)) { | ||
672 | lbm_value next = 0; | ||
673 | value_assign(&next, cell->car); | ||
674 | value_assign(&cell->car, prev); | ||
675 | value_assign(&prev,curr); | ||
676 | value_assign(&curr, next); | ||
677 | } | ||
678 | // Will jump out next iteration as gc mark is set in curr. | ||
679 | } | ||
680 | while (lbm_is_ptr(prev) && | ||
681 | (lbm_dec_ptr(prev) != LBM_PTR_NULL) && | ||
682 | lbm_get_gc_flag(lbm_car(prev)) ) { | ||
683 | // clear the flag | ||
684 | lbm_cons_t *cell = lbm_ref_cell(prev); | ||
685 | cell->car = lbm_clr_gc_flag(cell->car); | ||
686 | lbm_value next = 0; | ||
687 | value_assign(&next, cell->cdr); | ||
688 | value_assign(&cell->cdr, curr); | ||
689 | value_assign(&curr, prev); | ||
690 | value_assign(&prev, next); | ||
691 | } | ||
692 | if (lbm_is_ptr(prev) && | ||
693 | lbm_dec_ptr(prev) == LBM_PTR_NULL) { | ||
694 | work_to_do = false; | ||
695 | } else if (lbm_is_ptr(prev)) { | ||
696 | // set the flag | ||
697 | lbm_cons_t *cell = lbm_ref_cell(prev); | ||
698 | cell->car = lbm_set_gc_flag(cell->car); | ||
699 | lbm_value next = 0; | ||
700 | value_assign(&next, cell->car); | ||
701 | value_assign(&cell->car, curr); | ||
702 | value_assign(&curr, cell->cdr); | ||
703 | value_assign(&cell->cdr, next); | ||
704 | } | ||
705 | } | ||
706 | mutex_unlock(&lbm_const_heap_mutex); | ||
707 | } | ||
708 | |||
709 | #else | ||
710 | extern eval_context_t *ctx_running; | ||
711 | 15215561 | void lbm_gc_mark_phase(lbm_value root) { | |
712 | lbm_value t_ptr; | ||
713 | 15215561 | lbm_stack_t *s = &lbm_heap_state.gc_stack; | |
714 | 15215561 | s->data[s->sp++] = root; | |
715 | |||
716 |
2/2✓ Branch 1 taken 73381269 times.
✓ Branch 2 taken 15215561 times.
|
88596830 | while (!lbm_stack_is_empty(s)) { |
717 | lbm_value curr; | ||
718 | 73381269 | lbm_pop(s, &curr); | |
719 | |||
720 | 159651830 | mark_shortcut: | |
721 | |||
722 |
2/2✓ Branch 1 taken 92402008 times.
✓ Branch 2 taken 67249822 times.
|
159651830 | if (!lbm_is_ptr(curr) || |
723 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 92402008 times.
|
92402008 | (curr & LBM_PTR_TO_CONSTANT_BIT)) { |
724 | 72413359 | continue; | |
725 | } | ||
726 | |||
727 | 92402008 | lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)]; | |
728 | |||
729 |
2/2✓ Branch 1 taken 5148725 times.
✓ Branch 2 taken 87253283 times.
|
92402008 | if (lbm_get_gc_mark(cell->cdr)) { |
730 | 5148725 | continue; | |
731 | } | ||
732 | |||
733 | 87253283 | t_ptr = lbm_type_of(curr); | |
734 | |||
735 | // An array is marked in O(N) time using an additional 32bit | ||
736 | // value per array that keeps track of how far into the array GC | ||
737 | // has progressed. | ||
738 |
2/2✓ Branch 0 taken 16352 times.
✓ Branch 1 taken 87236931 times.
|
87253283 | if (t_ptr == LBM_TYPE_LISPARRAY) { |
739 | 16352 | lbm_push(s, curr); // put array back as bookkeeping. | |
740 | 16352 | lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car; | |
741 | 16352 | lbm_value *arrdata = (lbm_value *)arr->data; | |
742 | 16352 | uint32_t index = arr->index; | |
743 | |||
744 | // Potential optimization. | ||
745 | // 1. CONS pointers are set to curr and recurse. | ||
746 | // 2. Any other ptr is marked immediately and index is increased. | ||
747 |
3/4✓ Branch 1 taken 8848 times.
✓ Branch 2 taken 7504 times.
✓ Branch 3 taken 8848 times.
✗ Branch 4 not taken.
|
16352 | if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT) == 0) && |
748 |
2/2✓ Branch 0 taken 4508 times.
✓ Branch 1 taken 4340 times.
|
8848 | !((arrdata[index] & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)) { |
749 | 4508 | lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])]; | |
750 |
2/2✓ Branch 1 taken 1540 times.
✓ Branch 2 taken 2968 times.
|
4508 | if (!lbm_get_gc_mark(elt->cdr)) { |
751 | 1540 | curr = arrdata[index]; | |
752 | 1540 | goto mark_shortcut; | |
753 | } | ||
754 | } | ||
755 |
2/2✓ Branch 0 taken 13944 times.
✓ Branch 1 taken 868 times.
|
14812 | if (index < ((arr->size/(sizeof(lbm_value))) - 1)) { |
756 | 13944 | arr->index++; | |
757 | 13944 | continue; | |
758 | } | ||
759 | |||
760 | 868 | arr->index = 0; | |
761 | 868 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
762 | 868 | lbm_heap_state.gc_marked ++; | |
763 | 868 | lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it. | |
764 | 868 | continue; | |
765 | } | ||
766 | |||
767 | 87236931 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
768 | 87236931 | lbm_heap_state.gc_marked ++; | |
769 | |||
770 |
2/2✓ Branch 0 taken 86269021 times.
✓ Branch 1 taken 967910 times.
|
87236931 | if (t_ptr == LBM_TYPE_CONS) { |
771 |
2/2✓ Branch 1 taken 58150224 times.
✓ Branch 2 taken 28118797 times.
|
86269021 | if (lbm_is_ptr(cell->cdr)) { |
772 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 58150224 times.
|
58150224 | if (!lbm_push(s, cell->cdr)) { |
773 | ✗ | lbm_critical_error(); | |
774 | ✗ | break; | |
775 | } | ||
776 | } | ||
777 | 86269021 | curr = cell->car; | |
778 | 86269021 | goto mark_shortcut; // Skip a push/pop | |
779 | } | ||
780 | } | ||
781 | 15215561 | } | |
782 | #endif | ||
783 | |||
784 | //Environments are proper lists with a 2 element list stored in each car. | ||
785 | 34911385 | void lbm_gc_mark_env(lbm_value env) { | |
786 | 34911385 | lbm_value curr = env; | |
787 | lbm_cons_t *c; | ||
788 | |||
789 |
2/2✓ Branch 1 taken 5244746 times.
✓ Branch 2 taken 34911385 times.
|
40156131 | while (lbm_is_ptr(curr)) { |
790 | 5244746 | c = lbm_ref_cell(curr); | |
791 | 5244746 | c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure. | |
792 | 5244746 | lbm_cons_t *b = lbm_ref_cell(c->car); | |
793 | 5244746 | b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell. | |
794 | 5244746 | lbm_gc_mark_phase(b->cdr); // mark the bound object. | |
795 | 5244746 | lbm_heap_state.gc_marked +=2; | |
796 | 5244746 | curr = c->cdr; | |
797 | } | ||
798 | 34911385 | } | |
799 | |||
800 | |||
801 | 1061241 | void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) { | |
802 |
2/2✓ Branch 0 taken 20839036 times.
✓ Branch 1 taken 1061241 times.
|
21900277 | for (lbm_uint i = 0; i < aux_size; i ++) { |
803 |
2/2✓ Branch 1 taken 11804560 times.
✓ Branch 2 taken 9034476 times.
|
20839036 | if (lbm_is_ptr(aux_data[i])) { |
804 | 11804560 | lbm_type pt_t = lbm_type_of(aux_data[i]); | |
805 | 11804560 | lbm_uint pt_v = lbm_dec_ptr(aux_data[i]); | |
806 |
3/4✓ Branch 0 taken 11804560 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 5901436 times.
✓ Branch 3 taken 5903124 times.
|
11804560 | if( pt_t >= LBM_POINTER_TYPE_FIRST && |
807 | 5901436 | pt_t <= LBM_POINTER_TYPE_LAST && | |
808 |
1/2✓ Branch 0 taken 5901436 times.
✗ Branch 1 not taken.
|
5901436 | pt_v < lbm_heap_state.heap_size) { |
809 | 5901436 | lbm_gc_mark_phase(aux_data[i]); | |
810 | } | ||
811 | } | ||
812 | } | ||
813 | 1061241 | } | |
814 | |||
815 | 2122490 | void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) { | |
816 |
2/2✓ Branch 0 taken 3185281 times.
✓ Branch 1 taken 2122490 times.
|
5307771 | for (lbm_uint i = 0; i < num_roots; i ++) { |
817 | 3185281 | lbm_gc_mark_phase(roots[i]); | |
818 | } | ||
819 | 2122490 | } | |
820 | |||
821 | // Sweep moves non-marked heap objects to the free list. | ||
822 | 1057817 | int lbm_gc_sweep_phase(void) { | |
823 | 1057817 | unsigned int i = 0; | |
824 | 1057817 | lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap; | |
825 | |||
826 |
2/2✓ Branch 0 taken 1926700544 times.
✓ Branch 1 taken 1057817 times.
|
1927758361 | for (i = 0; i < lbm_heap_state.heap_size; i ++) { |
827 |
2/2✓ Branch 1 taken 96422811 times.
✓ Branch 2 taken 1830277733 times.
|
1926700544 | if ( lbm_get_gc_mark(heap[i].cdr)) { |
828 | 96422811 | heap[i].cdr = lbm_clr_gc_mark(heap[i].cdr); | |
829 | } else { | ||
830 | // Check if this cell is a pointer to an array | ||
831 | // and free it. | ||
832 |
2/2✓ Branch 1 taken 1644381838 times.
✓ Branch 2 taken 185895895 times.
|
1830277733 | if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL) { |
833 |
4/5✓ Branch 0 taken 8368620 times.
✓ Branch 1 taken 151820 times.
✓ Branch 2 taken 14033 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 177361422 times.
|
185895895 | switch(heap[i].cdr) { |
834 | |||
835 | 8368620 | case ENC_SYM_IND_I_TYPE: /* fall through */ | |
836 | case ENC_SYM_IND_U_TYPE: | ||
837 | case ENC_SYM_IND_F_TYPE: | ||
838 | 8368620 | lbm_memory_free((lbm_uint*)heap[i].car); | |
839 | 8368620 | break; | |
840 | 151820 | case ENC_SYM_LISPARRAY_TYPE: /* fall through */ | |
841 | case ENC_SYM_ARRAY_TYPE:{ | ||
842 | 151820 | lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car; | |
843 |
1/2✓ Branch 1 taken 151820 times.
✗ Branch 2 not taken.
|
151820 | if (lbm_memory_ptr_inside((lbm_uint*)arr->data)) { |
844 | 151820 | lbm_memory_free((lbm_uint *)arr->data); | |
845 | 151820 | lbm_heap_state.gc_recovered_arrays++; | |
846 | } | ||
847 | 151820 | lbm_memory_free((lbm_uint *)arr); | |
848 | 151820 | } break; | |
849 | 14033 | case ENC_SYM_CHANNEL_TYPE:{ | |
850 | 14033 | lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car; | |
851 |
2/2✓ Branch 1 taken 12874 times.
✓ Branch 2 taken 1159 times.
|
14033 | if (lbm_memory_ptr_inside((lbm_uint*)chan)) { |
852 | 12874 | lbm_memory_free((lbm_uint*)chan->state); | |
853 | 12874 | lbm_memory_free((lbm_uint*)chan); | |
854 | } | ||
855 | 14033 | } break; | |
856 | ✗ | case ENC_SYM_CUSTOM_TYPE: { | |
857 | ✗ | lbm_uint *t = (lbm_uint*)heap[i].car; | |
858 | ✗ | lbm_custom_type_destroy(t); | |
859 | ✗ | lbm_memory_free(t); | |
860 | ✗ | } break; | |
861 | 177361422 | default: | |
862 | 177361422 | break; | |
863 | } | ||
864 | 1644381838 | } | |
865 | // create pointer to use as new freelist | ||
866 | 1830277733 | lbm_uint addr = lbm_enc_cons_ptr(i); | |
867 | |||
868 | // Clear the "freed" cell. | ||
869 | 1830277733 | heap[i].car = ENC_SYM_RECOVERED; | |
870 | 1830277733 | heap[i].cdr = lbm_heap_state.freelist; | |
871 | 1830277733 | lbm_heap_state.freelist = addr; | |
872 | 1830277733 | lbm_heap_state.num_alloc --; | |
873 | 1830277733 | lbm_heap_state.gc_recovered ++; | |
874 | } | ||
875 | } | ||
876 | 1057817 | return 1; | |
877 | } | ||
878 | |||
879 | 1057817 | void lbm_gc_state_inc(void) { | |
880 | 1057817 | lbm_heap_state.gc_num ++; | |
881 | 1057817 | lbm_heap_state.gc_recovered = 0; | |
882 | 1057817 | lbm_heap_state.gc_marked = 0; | |
883 | 1057817 | } | |
884 | |||
885 | // construct, alter and break apart | ||
886 | 862505540 | lbm_value lbm_cons(lbm_value car, lbm_value cdr) { | |
887 | 862505540 | return lbm_heap_allocate_cell(LBM_TYPE_CONS, car, cdr); | |
888 | } | ||
889 | |||
890 | 1461199125 | lbm_value lbm_car(lbm_value c){ | |
891 | |||
892 |
2/2✓ Branch 1 taken 1461198957 times.
✓ Branch 2 taken 168 times.
|
1461199125 | if (lbm_is_ptr(c) ){ |
893 | 1461198957 | lbm_cons_t *cell = lbm_ref_cell(c); | |
894 | 1461198957 | return cell->car; | |
895 | } | ||
896 | |||
897 |
1/2✓ Branch 1 taken 168 times.
✗ Branch 2 not taken.
|
168 | if (lbm_is_symbol_nil(c)) { |
898 | 168 | return c; // if nil, return nil. | |
899 | } | ||
900 | |||
901 | ✗ | return ENC_SYM_TERROR; | |
902 | } | ||
903 | |||
904 | // TODO: Many comparisons "is this the nil symbol" can be | ||
905 | // streamlined a bit. NIL is 0 and cannot be confused with any other | ||
906 | // lbm_value. | ||
907 | |||
908 | 68 | lbm_value lbm_caar(lbm_value c) { | |
909 | |||
910 | lbm_value tmp; | ||
911 | |||
912 |
1/2✓ Branch 1 taken 68 times.
✗ Branch 2 not taken.
|
68 | if (lbm_is_ptr(c)) { |
913 | 68 | tmp = lbm_ref_cell(c)->car; | |
914 | |||
915 |
1/2✓ Branch 1 taken 68 times.
✗ Branch 2 not taken.
|
68 | if (lbm_is_ptr(tmp)) { |
916 | 68 | return lbm_ref_cell(tmp)->car; | |
917 | ✗ | } else if (lbm_is_symbol_nil(tmp)) { | |
918 | ✗ | return tmp; | |
919 | } | ||
920 | ✗ | } else if (lbm_is_symbol_nil(c)){ | |
921 | ✗ | return c; | |
922 | } | ||
923 | ✗ | return ENC_SYM_TERROR; | |
924 | } | ||
925 | |||
926 | |||
927 | 11004 | lbm_value lbm_cadr(lbm_value c) { | |
928 | |||
929 | lbm_value tmp; | ||
930 | |||
931 |
1/2✓ Branch 1 taken 11004 times.
✗ Branch 2 not taken.
|
11004 | if (lbm_is_ptr(c)) { |
932 | 11004 | tmp = lbm_ref_cell(c)->cdr; | |
933 | |||
934 |
1/2✓ Branch 1 taken 11004 times.
✗ Branch 2 not taken.
|
11004 | if (lbm_is_ptr(tmp)) { |
935 | 11004 | return lbm_ref_cell(tmp)->car; | |
936 | ✗ | } else if (lbm_is_symbol_nil(tmp)) { | |
937 | ✗ | return tmp; | |
938 | } | ||
939 | ✗ | } else if (lbm_is_symbol_nil(c)) { | |
940 | ✗ | return c; | |
941 | } | ||
942 | ✗ | return ENC_SYM_TERROR; | |
943 | } | ||
944 | |||
945 | 751558790 | lbm_value lbm_cdr(lbm_value c){ | |
946 |
2/2✓ Branch 1 taken 750992182 times.
✓ Branch 2 taken 566608 times.
|
751558790 | if (lbm_is_ptr(c)) { |
947 | 750992182 | lbm_cons_t *cell = lbm_ref_cell(c); | |
948 | 750992182 | return cell->cdr; | |
949 | } | ||
950 |
1/2✓ Branch 1 taken 566608 times.
✗ Branch 2 not taken.
|
566608 | if (lbm_is_symbol_nil(c)) { |
951 | 566608 | return ENC_SYM_NIL; // if nil, return nil. | |
952 | } | ||
953 | ✗ | return ENC_SYM_TERROR; | |
954 | } | ||
955 | |||
956 | ✗ | lbm_value lbm_cddr(lbm_value c) { | |
957 | ✗ | if (lbm_is_ptr(c)) { | |
958 | ✗ | lbm_value tmp = lbm_ref_cell(c)->cdr; | |
959 | ✗ | if (lbm_is_ptr(tmp)) { | |
960 | ✗ | return lbm_ref_cell(tmp)->cdr; | |
961 | } | ||
962 | } | ||
963 | ✗ | if (lbm_is_symbol_nil(c)) { | |
964 | ✗ | return ENC_SYM_NIL; | |
965 | } | ||
966 | ✗ | return ENC_SYM_TERROR; | |
967 | } | ||
968 | |||
969 | 117132384 | int lbm_set_car(lbm_value c, lbm_value v) { | |
970 | 117132384 | int r = 0; | |
971 | |||
972 |
2/2✓ Branch 1 taken 117132356 times.
✓ Branch 2 taken 28 times.
|
117132384 | if (lbm_type_of(c) == LBM_TYPE_CONS) { |
973 | 117132356 | lbm_cons_t *cell = lbm_ref_cell(c); | |
974 | 117132356 | cell->car = v; | |
975 | 117132356 | r = 1; | |
976 | } | ||
977 | 117132384 | return r; | |
978 | } | ||
979 | |||
980 | 536518528 | int lbm_set_cdr(lbm_value c, lbm_value v) { | |
981 | 536518528 | int r = 0; | |
982 |
2/2✓ Branch 1 taken 535952004 times.
✓ Branch 2 taken 566524 times.
|
536518528 | if (lbm_is_cons_rw(c)){ |
983 | 535952004 | lbm_cons_t *cell = lbm_ref_cell(c); | |
984 | 535952004 | cell->cdr = v; | |
985 | 535952004 | r = 1; | |
986 | } | ||
987 | 536518528 | return r; | |
988 | } | ||
989 | |||
990 | 8424204 | int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) { | |
991 | 8424204 | int r = 0; | |
992 |
1/2✓ Branch 1 taken 8424204 times.
✗ Branch 2 not taken.
|
8424204 | if (lbm_is_cons_rw(c)) { |
993 | 8424204 | lbm_cons_t *cell = lbm_ref_cell(c); | |
994 | 8424204 | cell->car = car_val; | |
995 | 8424204 | cell->cdr = cdr_val; | |
996 | 8424204 | r = 1; | |
997 | } | ||
998 | 8424204 | return r; | |
999 | } | ||
1000 | |||
1001 | /* calculate length of a proper list */ | ||
1002 | 28950158 | lbm_uint lbm_list_length(lbm_value c) { | |
1003 | 28950158 | lbm_uint len = 0; | |
1004 | |||
1005 |
2/2✓ Branch 1 taken 116976252 times.
✓ Branch 2 taken 28950158 times.
|
145926410 | while (lbm_is_cons(c)){ |
1006 | 116976252 | len ++; | |
1007 | 116976252 | c = lbm_cdr(c); | |
1008 | } | ||
1009 | 28950158 | return len; | |
1010 | } | ||
1011 | |||
1012 | /* calculate the length of a list and check that each element | ||
1013 | fullfills the predicate pred */ | ||
1014 | 84 | unsigned int lbm_list_length_pred(lbm_value c, bool *pres, bool (*pred)(lbm_value)) { | |
1015 | 84 | bool res = true; | |
1016 | 84 | unsigned int len = 0; | |
1017 | |||
1018 |
2/2✓ Branch 1 taken 448 times.
✓ Branch 2 taken 84 times.
|
532 | while (lbm_is_cons(c)){ |
1019 | 448 | len ++; | |
1020 |
2/4✓ Branch 0 taken 448 times.
✗ Branch 1 not taken.
✓ Branch 4 taken 448 times.
✗ Branch 5 not taken.
|
448 | res = res && pred(lbm_car(c)); |
1021 | 448 | c = lbm_cdr(c); | |
1022 | } | ||
1023 | 84 | *pres = res; | |
1024 | 84 | return len; | |
1025 | } | ||
1026 | |||
1027 | /* reverse a proper list */ | ||
1028 | ✗ | lbm_value lbm_list_reverse(lbm_value list) { | |
1029 | ✗ | if (lbm_type_of(list) == LBM_TYPE_SYMBOL) { | |
1030 | ✗ | return list; | |
1031 | } | ||
1032 | |||
1033 | ✗ | lbm_value curr = list; | |
1034 | |||
1035 | ✗ | lbm_value new_list = ENC_SYM_NIL; | |
1036 | ✗ | while (lbm_is_cons(curr)) { | |
1037 | |||
1038 | ✗ | new_list = lbm_cons(lbm_car(curr), new_list); | |
1039 | ✗ | if (lbm_type_of(new_list) == LBM_TYPE_SYMBOL) { | |
1040 | ✗ | return ENC_SYM_MERROR; | |
1041 | } | ||
1042 | ✗ | curr = lbm_cdr(curr); | |
1043 | } | ||
1044 | ✗ | return new_list; | |
1045 | } | ||
1046 | |||
1047 | 112 | lbm_value lbm_list_destructive_reverse(lbm_value list) { | |
1048 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 112 times.
|
112 | if (lbm_type_of(list) == LBM_TYPE_SYMBOL) { |
1049 | ✗ | return list; | |
1050 | } | ||
1051 | 112 | lbm_value curr = list; | |
1052 | 112 | lbm_value last_cell = ENC_SYM_NIL; | |
1053 | |||
1054 |
2/2✓ Branch 1 taken 560 times.
✓ Branch 2 taken 112 times.
|
672 | while (lbm_is_cons_rw(curr)) { |
1055 | 560 | lbm_value next = lbm_cdr(curr); | |
1056 | 560 | lbm_set_cdr(curr, last_cell); | |
1057 | 560 | last_cell = curr; | |
1058 | 560 | curr = next; | |
1059 | } | ||
1060 | 112 | return last_cell; | |
1061 | } | ||
1062 | |||
1063 | |||
1064 | 294774 | lbm_value lbm_list_copy(int *m, lbm_value list) { | |
1065 | 294774 | lbm_value curr = list; | |
1066 | 294774 | lbm_uint n = lbm_list_length(list); | |
1067 | 294774 | lbm_uint copy_n = n; | |
1068 |
4/4✓ Branch 0 taken 1432 times.
✓ Branch 1 taken 293342 times.
✓ Branch 2 taken 84 times.
✓ Branch 3 taken 1348 times.
|
294774 | if (*m >= 0 && (lbm_uint)*m < n) { |
1069 | 84 | copy_n = (lbm_uint)*m; | |
1070 |
2/2✓ Branch 0 taken 293342 times.
✓ Branch 1 taken 1348 times.
|
294690 | } else if (*m == -1) { |
1071 | 293342 | *m = (int)n; // TODO: smaller range in target variable. | |
1072 | } | ||
1073 |
2/2✓ Branch 0 taken 196 times.
✓ Branch 1 taken 294578 times.
|
294774 | if (copy_n == 0) return ENC_SYM_NIL; |
1074 | 294578 | lbm_uint new_list = lbm_heap_allocate_list(copy_n); | |
1075 |
2/2✓ Branch 1 taken 1328 times.
✓ Branch 2 taken 293250 times.
|
294578 | if (lbm_is_symbol(new_list)) return new_list; |
1076 | 293250 | lbm_value curr_targ = new_list; | |
1077 | |||
1078 |
4/4✓ Branch 1 taken 3431964 times.
✓ Branch 2 taken 293202 times.
✓ Branch 3 taken 3431916 times.
✓ Branch 4 taken 48 times.
|
3725166 | while (lbm_is_cons(curr) && copy_n > 0) { |
1079 | 3431916 | lbm_value v = lbm_car(curr); | |
1080 | 3431916 | lbm_set_car(curr_targ, v); | |
1081 | 3431916 | curr_targ = lbm_cdr(curr_targ); | |
1082 | 3431916 | curr = lbm_cdr(curr); | |
1083 | 3431916 | copy_n --; | |
1084 | } | ||
1085 | |||
1086 | 293250 | return new_list; | |
1087 | } | ||
1088 | |||
1089 | // Append for proper lists only | ||
1090 | // Destructive update of list1. | ||
1091 | 10780 | lbm_value lbm_list_append(lbm_value list1, lbm_value list2) { | |
1092 | |||
1093 |
2/4✓ Branch 1 taken 10780 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 10780 times.
✗ Branch 4 not taken.
|
21560 | if(lbm_is_list_rw(list1) && |
1094 | 10780 | lbm_is_list(list2)) { | |
1095 | |||
1096 | 10780 | lbm_value curr = list1; | |
1097 |
2/2✓ Branch 2 taken 17234 times.
✓ Branch 3 taken 10780 times.
|
28014 | while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) { |
1098 | 17234 | curr = lbm_cdr(curr); | |
1099 | } | ||
1100 |
2/2✓ Branch 1 taken 28 times.
✓ Branch 2 taken 10752 times.
|
10780 | if (lbm_is_symbol_nil(curr)) return list2; |
1101 | 10752 | lbm_set_cdr(curr, list2); | |
1102 | 10752 | return list1; | |
1103 | } | ||
1104 | ✗ | return ENC_SYM_EERROR; | |
1105 | } | ||
1106 | |||
1107 | 84 | lbm_value lbm_list_drop(unsigned int n, lbm_value ls) { | |
1108 | 84 | lbm_value curr = ls; | |
1109 |
4/4✓ Branch 1 taken 728 times.
✓ Branch 2 taken 56 times.
✓ Branch 3 taken 700 times.
✓ Branch 4 taken 28 times.
|
784 | while (lbm_type_of_functional(curr) == LBM_TYPE_CONS && |
1110 | n > 0) { | ||
1111 | 700 | curr = lbm_cdr(curr); | |
1112 | 700 | n --; | |
1113 | } | ||
1114 | 84 | return curr; | |
1115 | } | ||
1116 | |||
1117 | 56069252 | lbm_value lbm_index_list(lbm_value l, int32_t n) { | |
1118 | 56069252 | lbm_value curr = l; | |
1119 | |||
1120 |
2/2✓ Branch 0 taken 112 times.
✓ Branch 1 taken 56069140 times.
|
56069252 | if (n < 0) { |
1121 | 112 | int32_t len = (int32_t)lbm_list_length(l); | |
1122 | 112 | n = len + n; | |
1123 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
|
112 | if (n < 0) return ENC_SYM_NIL; |
1124 | } | ||
1125 | |||
1126 |
4/4✓ Branch 1 taken 84083852 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 28014628 times.
✓ Branch 4 taken 56069224 times.
|
84083880 | while (lbm_is_cons(curr) && |
1127 | n > 0) { | ||
1128 | 28014628 | curr = lbm_cdr(curr); | |
1129 | 28014628 | n --; | |
1130 | } | ||
1131 |
2/2✓ Branch 1 taken 56069224 times.
✓ Branch 2 taken 28 times.
|
56069252 | if (lbm_is_cons(curr)) { |
1132 | 56069224 | return lbm_car(curr); | |
1133 | } else { | ||
1134 | 28 | return ENC_SYM_NIL; | |
1135 | } | ||
1136 | } | ||
1137 | |||
1138 | // High-level arrays are just bytearrays but with a different tag and pointer type. | ||
1139 | // These arrays will be inspected by GC and the elements of the array will be marked. | ||
1140 | |||
1141 | // Arrays are part of the heap module because their lifespan is managed | ||
1142 | // by the garbage collector. The data in the array is not stored | ||
1143 | // in the "heap of cons cells". | ||
1144 | 168136 | int lbm_heap_allocate_array_base(lbm_value *res, bool byte_array, lbm_uint size){ | |
1145 | |||
1146 | 168136 | lbm_array_header_t *array = NULL; | |
1147 | |||
1148 |
2/2✓ Branch 0 taken 167492 times.
✓ Branch 1 taken 644 times.
|
168136 | if (byte_array) { |
1149 | 167492 | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t)); | |
1150 | } else { | ||
1151 | // an extra 32bit quantity for a GC index. | ||
1152 | 644 | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t)); | |
1153 | } | ||
1154 | |||
1155 |
2/2✓ Branch 0 taken 96 times.
✓ Branch 1 taken 168040 times.
|
168136 | if (array == NULL) { |
1156 | 96 | *res = ENC_SYM_MERROR; | |
1157 | 96 | return 0; | |
1158 | } | ||
1159 | |||
1160 | 168040 | lbm_uint tag = ENC_SYM_ARRAY_TYPE; | |
1161 | 168040 | lbm_uint type = LBM_TYPE_ARRAY; | |
1162 |
2/2✓ Branch 0 taken 644 times.
✓ Branch 1 taken 167396 times.
|
168040 | if (!byte_array) { |
1163 | 644 | tag = ENC_SYM_LISPARRAY_TYPE; | |
1164 | 644 | type = LBM_TYPE_LISPARRAY; | |
1165 | 644 | size = sizeof(lbm_value) * size; | |
1166 | 644 | lbm_array_header_extended_t *ext_array = (lbm_array_header_extended_t*)array; | |
1167 | 644 | ext_array->index = 0; | |
1168 | } | ||
1169 | |||
1170 | 168040 | array->data = (lbm_uint*)lbm_malloc(size); | |
1171 | |||
1172 |
2/2✓ Branch 0 taken 5634 times.
✓ Branch 1 taken 162406 times.
|
168040 | if (array->data == NULL) { |
1173 | 5634 | lbm_memory_free((lbm_uint*)array); | |
1174 | 5634 | *res = ENC_SYM_MERROR; | |
1175 | 5634 | return 0; | |
1176 | } | ||
1177 | // It is more important to zero out high-level arrays. | ||
1178 | // 0 is symbol NIL which is perfectly safe for the GC to inspect. | ||
1179 | 162406 | memset(array->data, 0, size); | |
1180 | 162406 | array->size = size; | |
1181 | |||
1182 | // allocating a cell for array's heap-presence | ||
1183 | 162406 | lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag); | |
1184 | |||
1185 | 162406 | *res = cell; | |
1186 | |||
1187 |
2/2✓ Branch 1 taken 34 times.
✓ Branch 2 taken 162372 times.
|
162406 | if (lbm_type_of(cell) == LBM_TYPE_SYMBOL) { // Out of heap memory |
1188 | 34 | lbm_memory_free((lbm_uint*)array->data); | |
1189 | 34 | lbm_memory_free((lbm_uint*)array); | |
1190 | 34 | *res = ENC_SYM_MERROR; | |
1191 | 34 | return 0; | |
1192 | } | ||
1193 | |||
1194 | 162372 | lbm_heap_state.num_alloc_arrays ++; | |
1195 | |||
1196 | 162372 | return 1; | |
1197 | } | ||
1198 | |||
1199 | 167492 | int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){ | |
1200 | 167492 | return lbm_heap_allocate_array_base(res, true, size); | |
1201 | } | ||
1202 | |||
1203 | 644 | int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) { | |
1204 | 644 | return lbm_heap_allocate_array_base(res, false, size); | |
1205 | } | ||
1206 | |||
1207 | // Convert a C array into an lbm_array. | ||
1208 | // if the array is in LBM_MEMORY, the lifetime will be managed by the GC after lifting. | ||
1209 | ✗ | int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) { | |
1210 | |||
1211 | ✗ | lbm_array_header_t *array = NULL; | |
1212 | ✗ | lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, ENC_SYM_ARRAY_TYPE); | |
1213 | |||
1214 | ✗ | if (lbm_type_of(cell) == LBM_TYPE_SYMBOL) { // Out of heap memory | |
1215 | ✗ | *value = cell; | |
1216 | ✗ | return 0; | |
1217 | } | ||
1218 | |||
1219 | ✗ | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t)); | |
1220 | |||
1221 | ✗ | if (array == NULL) { | |
1222 | ✗ | lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL); | |
1223 | ✗ | *value = ENC_SYM_MERROR; | |
1224 | ✗ | return 0; | |
1225 | } | ||
1226 | |||
1227 | ✗ | array->data = (lbm_uint*)data; | |
1228 | ✗ | array->size = num_elt; | |
1229 | |||
1230 | ✗ | lbm_set_car(cell, (lbm_uint)array); | |
1231 | |||
1232 | ✗ | cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY); | |
1233 | ✗ | *value = cell; | |
1234 | ✗ | return 1; | |
1235 | } | ||
1236 | |||
1237 | 448 | lbm_int lbm_heap_array_get_size(lbm_value arr) { | |
1238 | |||
1239 | 448 | lbm_int r = -1; | |
1240 |
1/2✓ Branch 1 taken 448 times.
✗ Branch 2 not taken.
|
448 | if (lbm_is_array_r(arr)) { |
1241 | 448 | lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr); | |
1242 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 448 times.
|
448 | if (header == NULL) { |
1243 | ✗ | return r; | |
1244 | } | ||
1245 | 448 | r = (lbm_int)header->size; | |
1246 | } | ||
1247 | 448 | return r; | |
1248 | } | ||
1249 | |||
1250 | 224 | const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) { | |
1251 | 224 | uint8_t *r = NULL; | |
1252 |
1/2✓ Branch 1 taken 224 times.
✗ Branch 2 not taken.
|
224 | if (lbm_is_array_r(arr)) { |
1253 | 224 | lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr); | |
1254 | 224 | r = (uint8_t*)header->data; | |
1255 | } | ||
1256 | 224 | return r; | |
1257 | } | ||
1258 | |||
1259 | ✗ | uint8_t *lbm_heap_array_get_data_rw(lbm_value arr) { | |
1260 | ✗ | uint8_t *r = NULL; | |
1261 | ✗ | if (lbm_is_array_rw(arr)) { | |
1262 | ✗ | lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr); | |
1263 | ✗ | r = (uint8_t*)header->data; | |
1264 | } | ||
1265 | ✗ | return r; | |
1266 | } | ||
1267 | |||
1268 | |||
1269 | /* Explicitly freeing an array. | ||
1270 | |||
1271 | This is a highly unsafe operation and can only be safely | ||
1272 | used if the heap cell that points to the array has not been made | ||
1273 | accessible to the program. | ||
1274 | |||
1275 | So This function can be used to free an array in case an array | ||
1276 | is being constructed and some error case appears while doing so | ||
1277 | If the array still have not become available it can safely be | ||
1278 | "explicitly" freed. | ||
1279 | |||
1280 | The problem is that if the "array" heap-cell is made available to | ||
1281 | the program, this cell can easily be duplicated and we would have | ||
1282 | to search the entire heap to find all cells pointing to the array | ||
1283 | memory in question and "null"-them out before freeing the memory | ||
1284 | */ | ||
1285 | |||
1286 | ✗ | int lbm_heap_explicit_free_array(lbm_value arr) { | |
1287 | |||
1288 | ✗ | int r = 0; | |
1289 | ✗ | if (lbm_is_array_rw(arr)) { | |
1290 | |||
1291 | ✗ | lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr); | |
1292 | ✗ | if (header == NULL) { | |
1293 | ✗ | return 0; | |
1294 | } | ||
1295 | ✗ | lbm_memory_free((lbm_uint*)header->data); | |
1296 | ✗ | lbm_memory_free((lbm_uint*)header); | |
1297 | |||
1298 | ✗ | arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS); | |
1299 | ✗ | lbm_set_car(arr, ENC_SYM_NIL); | |
1300 | ✗ | lbm_set_cdr(arr, ENC_SYM_NIL); | |
1301 | ✗ | r = 1; | |
1302 | } | ||
1303 | |||
1304 | ✗ | return r; | |
1305 | } | ||
1306 | |||
1307 | ✗ | lbm_uint lbm_size_of(lbm_type t) { | |
1308 | ✗ | lbm_uint s = 0; | |
1309 | ✗ | switch(t) { | |
1310 | ✗ | case LBM_TYPE_BYTE: | |
1311 | ✗ | s = 1; | |
1312 | ✗ | break; | |
1313 | ✗ | case LBM_TYPE_I: /* fall through */ | |
1314 | case LBM_TYPE_U: | ||
1315 | case LBM_TYPE_SYMBOL: | ||
1316 | ✗ | s = sizeof(lbm_uint); | |
1317 | ✗ | break; | |
1318 | ✗ | case LBM_TYPE_I32: /* fall through */ | |
1319 | case LBM_TYPE_U32: | ||
1320 | case LBM_TYPE_FLOAT: | ||
1321 | ✗ | s = 4; | |
1322 | ✗ | break; | |
1323 | ✗ | case LBM_TYPE_I64: /* fall through */ | |
1324 | case LBM_TYPE_U64: | ||
1325 | case LBM_TYPE_DOUBLE: | ||
1326 | ✗ | s = 8; | |
1327 | ✗ | break; | |
1328 | } | ||
1329 | ✗ | return s; | |
1330 | } | ||
1331 | |||
1332 | ✗ | static bool dummy_flash_write(lbm_uint ix, lbm_uint val) { | |
1333 | (void)ix; | ||
1334 | (void)val; | ||
1335 | ✗ | return false; | |
1336 | } | ||
1337 | |||
1338 | static const_heap_write_fun const_heap_write = dummy_flash_write; | ||
1339 | |||
1340 | 17444 | int lbm_const_heap_init(const_heap_write_fun w_fun, | |
1341 | lbm_const_heap_t *heap, | ||
1342 | lbm_uint *addr, | ||
1343 | lbm_uint num_words) { | ||
1344 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17444 times.
|
17444 | if (((uintptr_t)addr % 4) != 0) return 0; |
1345 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17444 times.
|
17444 | if ((num_words % 2) != 0) return 0; |
1346 | |||
1347 |
1/2✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
|
17444 | if (!lbm_const_heap_mutex_initialized) { |
1348 | 17444 | mutex_init(&lbm_const_heap_mutex); | |
1349 | 17444 | lbm_const_heap_mutex_initialized = true; | |
1350 | } | ||
1351 | |||
1352 |
1/2✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
|
17444 | if (!lbm_mark_mutex_initialized) { |
1353 | 17444 | mutex_init(&lbm_mark_mutex); | |
1354 | 17444 | lbm_mark_mutex_initialized = true; | |
1355 | } | ||
1356 | |||
1357 | 17444 | const_heap_write = w_fun; | |
1358 | |||
1359 | 17444 | heap->heap = addr; | |
1360 | 17444 | heap->size = num_words; | |
1361 | 17444 | heap->next = 0; | |
1362 | |||
1363 | 17444 | lbm_const_heap_state = heap; | |
1364 | // ref_cell views the lbm_uint array as an lbm_cons_t array | ||
1365 | 17444 | lbm_heaps[1] = (lbm_cons_t*)addr; | |
1366 | 17444 | return 1; | |
1367 | } | ||
1368 | |||
1369 | 2352 | lbm_flash_status lbm_allocate_const_cell(lbm_value *res) { | |
1370 | 2352 | lbm_flash_status r = LBM_FLASH_FULL; | |
1371 | |||
1372 | 2352 | mutex_lock(&lbm_const_heap_mutex); | |
1373 | // waste a cell if we have ended up unaligned after writing an array to flash. | ||
1374 |
2/2✓ Branch 0 taken 28 times.
✓ Branch 1 taken 2324 times.
|
2352 | if (lbm_const_heap_state->next % 2 == 1) { |
1375 | 28 | lbm_const_heap_state->next++; | |
1376 | } | ||
1377 | |||
1378 |
1/2✓ Branch 0 taken 2352 times.
✗ Branch 1 not taken.
|
2352 | if (lbm_const_heap_state && |
1379 |
1/2✓ Branch 0 taken 2352 times.
✗ Branch 1 not taken.
|
2352 | (lbm_const_heap_state->next+1) < lbm_const_heap_state->size) { |
1380 | // A cons cell uses two words. | ||
1381 | 2352 | lbm_value cell = lbm_const_heap_state->next; | |
1382 | 2352 | lbm_const_heap_state->next += 2; | |
1383 | 2352 | *res = (cell << LBM_ADDRESS_SHIFT) | LBM_PTR_BIT | LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT; | |
1384 | 2352 | r = LBM_FLASH_WRITE_OK; | |
1385 | } | ||
1386 | 2352 | mutex_unlock(&lbm_const_heap_mutex); | |
1387 | 2352 | return r; | |
1388 | } | ||
1389 | |||
1390 | ✗ | lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) { | |
1391 | ✗ | lbm_flash_status r = LBM_FLASH_FULL; | |
1392 | |||
1393 | ✗ | if (lbm_const_heap_state && | |
1394 | ✗ | (lbm_const_heap_state->next + nwords) < lbm_const_heap_state->size) { | |
1395 | ✗ | lbm_uint ix = lbm_const_heap_state->next; | |
1396 | ✗ | *res = (lbm_uint)&lbm_const_heap_state->heap[ix]; | |
1397 | ✗ | lbm_const_heap_state->next += nwords; | |
1398 | ✗ | r = LBM_FLASH_WRITE_OK; | |
1399 | } | ||
1400 | ✗ | return r; | |
1401 | } | ||
1402 | |||
1403 | 224 | lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) { | |
1404 | |||
1405 | 224 | lbm_flash_status r = LBM_FLASH_FULL; | |
1406 | |||
1407 |
1/2✓ Branch 0 taken 224 times.
✗ Branch 1 not taken.
|
224 | if (lbm_const_heap_state && |
1408 |
1/2✓ Branch 0 taken 224 times.
✗ Branch 1 not taken.
|
224 | (lbm_const_heap_state->next + n) < lbm_const_heap_state->size) { |
1409 | 224 | lbm_uint ix = lbm_const_heap_state->next; | |
1410 | |||
1411 |
2/2✓ Branch 0 taken 420 times.
✓ Branch 1 taken 224 times.
|
644 | for (unsigned int i = 0; i < n; i ++) { |
1412 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 420 times.
|
420 | if (!const_heap_write(ix + i, ((lbm_uint*)data)[i])) |
1413 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
1414 | } | ||
1415 | 224 | lbm_const_heap_state->next += n; | |
1416 | 224 | *res = (lbm_uint)&lbm_const_heap_state->heap[ix]; | |
1417 | 224 | r = LBM_FLASH_WRITE_OK; | |
1418 | } | ||
1419 | 224 | return r; | |
1420 | } | ||
1421 | |||
1422 | ✗ | lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) { | |
1423 | |||
1424 | ✗ | if (lbm_const_heap_state) { | |
1425 | ✗ | lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap; | |
1426 | ✗ | lbm_uint ix = (((lbm_uint)tgt - flash) / 4); // byte address to ix | |
1427 | ✗ | if (const_heap_write(ix, val)) { | |
1428 | ✗ | return LBM_FLASH_WRITE_OK; | |
1429 | } | ||
1430 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
1431 | } | ||
1432 | ✗ | return LBM_FLASH_FULL; | |
1433 | } | ||
1434 | |||
1435 | 2352 | lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) { | |
1436 | 2352 | lbm_uint addr = lbm_dec_ptr(cell); | |
1437 |
1/2✓ Branch 1 taken 2352 times.
✗ Branch 2 not taken.
|
2352 | if (const_heap_write(addr+1, val)) |
1438 | 2352 | return LBM_FLASH_WRITE_OK; | |
1439 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
1440 | } | ||
1441 | |||
1442 | 2352 | lbm_flash_status write_const_car(lbm_value cell, lbm_value val) { | |
1443 | 2352 | lbm_uint addr = lbm_dec_ptr(cell); | |
1444 |
1/2✓ Branch 1 taken 2352 times.
✗ Branch 2 not taken.
|
2352 | if (const_heap_write(addr, val)) |
1445 | 2352 | return LBM_FLASH_WRITE_OK; | |
1446 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
1447 | } | ||
1448 | |||
1449 | ✗ | lbm_uint lbm_flash_memory_usage(void) { | |
1450 | ✗ | return lbm_const_heap_state->next; | |
1451 | } | ||
1452 |