GCC Code Coverage Report


Directory: ../src/
File: /home/joels/Current/lispbm/src/heap.c
Date: 2025-10-27 19:12:55
Exec Total Coverage
Lines: 800 847 94.5%
Functions: 78 88 88.6%
Branches: 302 370 81.6%

Line Branch Exec Source
1 /*
2 Copyright 2018, 2020, 2022 - 2025 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 #include <lbm_defrag_mem.h>
27 #include <lbm_image.h>
28
29 #include "heap.h"
30 #include "symrepr.h"
31 #include "stack.h"
32 #include "lbm_channel.h"
33 #include "platform_mutex.h"
34 #include "eval_cps.h"
35 #ifdef VISUALIZE_HEAP
36 #include "heap_vis.h"
37 #endif
38
39 67805637 static inline lbm_value lbm_set_gc_mark(lbm_value x) {
40 67805637 return x | LBM_GC_MARKED;
41 }
42 67604831 static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
43 67604831 return x & ~LBM_GC_MASK;
44 }
45
46 1453912589 static inline bool lbm_get_gc_mark(lbm_value x) {
47 1453912589 return x & LBM_GC_MASK;
48 }
49
50 24081 static inline void gc_mark(lbm_value c) {
51 //c must be a cons cell.
52 24081 lbm_cons_t *cell = lbm_ref_cell(c);
53 24081 cell->cdr = lbm_set_gc_mark(cell->cdr);
54 24081 }
55
56 24422 static inline bool gc_marked(lbm_value c) {
57 24422 lbm_cons_t *cell = lbm_ref_cell(c);
58 24422 return lbm_get_gc_mark(cell->cdr);
59 }
60
61 static inline void gc_clear_mark(lbm_value c) {
62 //c must be a cons cell.
63 lbm_cons_t *cell = lbm_ref_cell(c);
64 cell->cdr = lbm_clr_gc_mark(cell->cdr);
65 }
66
67 // flag is the same bit as mark, but in car
68 46584 static inline bool lbm_get_gc_flag(lbm_value x) {
69 46584 return x & LBM_GC_MARKED;
70 }
71
72 23292 static inline lbm_value lbm_set_gc_flag(lbm_value x) {
73 23292 return x | LBM_GC_MARKED;
74 }
75
76 23292 static inline lbm_value lbm_clr_gc_flag(lbm_value x) {
77 23292 return x & ~LBM_GC_MASK;
78 }
79
80
81 lbm_heap_state_t lbm_heap_state;
82
83 lbm_const_heap_t *lbm_const_heap_state;
84
85 lbm_cons_t *lbm_heaps[2] = {NULL, NULL};
86
87 static lbm_mutex_t lbm_const_heap_mutex;
88 static bool lbm_const_heap_mutex_initialized = false;
89
90 static lbm_mutex_t lbm_mark_mutex;
91 static bool lbm_mark_mutex_initialized = false;
92
93 #ifdef USE_GC_PTR_REV
94 void lbm_gc_lock(void) {
95 lbm_mutex_lock(&lbm_mark_mutex);
96 }
97 void lbm_gc_unlock(void) {
98 lbm_mutex_unlock(&lbm_mark_mutex);
99 }
100 #else
101 void lbm_gc_lock(void) {
102 }
103 void lbm_gc_unlock(void) {
104 }
105 #endif
106
107 /****************************************************/
108 /* ENCODERS DECODERS */
109
110 2837949 lbm_value lbm_enc_i32(int32_t x) {
111 #ifndef LBM64
112 2837949 lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE);
113
2/2
✓ Branch 0 taken 618 times.
✓ Branch 1 taken 2837331 times.
2837949 if (lbm_type_of(i) == LBM_TYPE_SYMBOL) return i;
114 2837331 return lbm_set_ptr_type(i, LBM_TYPE_I32);
115 #else
116 return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_I32;
117 #endif
118 }
119
120 3684951 lbm_value lbm_enc_u32(uint32_t x) {
121 #ifndef LBM64
122 3684951 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE);
123
2/2
✓ Branch 0 taken 1088 times.
✓ Branch 1 taken 3683863 times.
3684951 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
124 3683863 return lbm_set_ptr_type(u, LBM_TYPE_U32);
125 #else
126 return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_U32;
127 #endif
128 }
129
130 229894192 lbm_value lbm_enc_float(float x) {
131 #ifndef LBM64
132 lbm_uint t;
133 229894192 memcpy(&t, &x, sizeof(lbm_float));
134 229894192 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE);
135
2/2
✓ Branch 0 taken 147244 times.
✓ Branch 1 taken 229746948 times.
229894192 if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
136 229746948 return lbm_set_ptr_type(f, LBM_TYPE_FLOAT);
137 #else
138 lbm_uint t = 0;
139 memcpy(&t, &x, sizeof(float));
140 return (((lbm_uint)t) << LBM_VAL_SHIFT) | LBM_TYPE_FLOAT;
141 #endif
142 }
143
144 #ifndef LBM64
145 8429219 static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) {
146 8429219 lbm_value res = lbm_cons(ENC_SYM_NIL,ENC_SYM_NIL);
147
2/2
✓ Branch 0 taken 8427033 times.
✓ Branch 1 taken 2186 times.
8429219 if (lbm_type_of(res) != LBM_TYPE_SYMBOL) {
148 8427033 uint8_t* storage = lbm_malloc(sizeof(uint64_t));
149
2/2
✓ Branch 0 taken 8424405 times.
✓ Branch 1 taken 2628 times.
8427033 if (storage) {
150 8424405 memcpy(storage,source, sizeof(uint64_t));
151 8424405 lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual);
152 8424405 res = lbm_set_ptr_type(res, type);
153 } else {
154 2628 res = ENC_SYM_MERROR;
155 }
156 }
157 8429219 return res;
158 }
159 #endif
160
161 4492273 lbm_value lbm_enc_i64(int64_t x) {
162 #ifndef LBM64
163 4492273 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE, LBM_TYPE_I64);
164 #else
165 lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE);
166 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
167 return lbm_set_ptr_type(u, LBM_TYPE_I64);
168 #endif
169 }
170
171 3371200 lbm_value lbm_enc_u64(uint64_t x) {
172 #ifndef LBM64
173 3371200 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE, LBM_TYPE_U64);
174 #else
175 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE);
176 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
177 return lbm_set_ptr_type(u, LBM_TYPE_U64);
178 #endif
179 }
180
181 565746 lbm_value lbm_enc_double(double x) {
182 #ifndef LBM64
183 565746 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE, LBM_TYPE_DOUBLE);
184 #else
185 lbm_uint t;
186 memcpy(&t, &x, sizeof(double));
187 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE);
188 if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
189 return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE);
190 #endif
191 }
192
193 // Type specific (as opposed to the dec_as_X) functions
194 // should only be run on values KNOWN to represent a value of the type
195 // that the decoder decodes.
196
197 333562716 float lbm_dec_float(lbm_value x) {
198 #ifndef LBM64
199 float f_tmp;
200 333562716 lbm_uint tmp = lbm_car(x);
201 333562716 memcpy(&f_tmp, &tmp, sizeof(float));
202 333562716 return f_tmp;
203 #else
204 uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT);
205 float f_tmp;
206 memcpy(&f_tmp, &tmp, sizeof(float));
207 return f_tmp;
208 #endif
209 }
210
211 564847 double lbm_dec_double(lbm_value x) {
212 #ifndef LBM64
213 564847 double d = 0.0;
214
1/2
✓ Branch 0 taken 564847 times.
✗ Branch 1 not taken.
564847 if (lbm_is_ptr(x)) {
215 564847 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
216 564847 memcpy(&d, data, sizeof(double));
217 }
218 564847 return d;
219 #else
220 double f_tmp;
221 lbm_uint tmp = lbm_car(x);
222 memcpy(&f_tmp, &tmp, sizeof(double));
223 return f_tmp;
224 #endif
225 }
226
227 7013756 uint64_t lbm_dec_u64(lbm_value x) {
228 #ifndef LBM64
229 7013756 uint64_t u = 0;
230
1/2
✓ Branch 0 taken 7013756 times.
✗ Branch 1 not taken.
7013756 if (lbm_is_ptr(x)) {
231 7013756 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
232 7013756 memcpy(&u, data, 8);
233 }
234 7013756 return u;
235 #else
236 return (uint64_t)lbm_car(x);
237 #endif
238 }
239
240 9254413 int64_t lbm_dec_i64(lbm_value x) {
241 #ifndef LBM64
242 9254413 int64_t i = 0;
243
1/2
✓ Branch 0 taken 9254413 times.
✗ Branch 1 not taken.
9254413 if (lbm_is_ptr(x)) {
244 9254413 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
245 9254413 memcpy(&i, data, 8);
246 }
247 9254413 return i;
248 #else
249 return (int64_t)lbm_car(x);
250 #endif
251 }
252
253 797441 char *lbm_dec_str(lbm_value val) {
254 797441 char *res = 0;
255
2/2
✓ Branch 0 taken 797293 times.
✓ Branch 1 taken 148 times.
797441 if (lbm_is_array_r(val)) {
256 797293 lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
257
1/2
✓ Branch 0 taken 797293 times.
✗ Branch 1 not taken.
797293 if (array) {
258 797293 res = (char *)array->data;
259 }
260 }
261 797441 return res;
262 }
263
264 603498 lbm_array_header_t *lbm_dec_array_r(lbm_value val) {
265 603498 lbm_array_header_t *array = NULL;
266
2/2
✓ Branch 0 taken 602111 times.
✓ Branch 1 taken 1387 times.
603498 if (lbm_is_array_r(val)) {
267 602111 array = (lbm_array_header_t *)lbm_car(val);
268 }
269 603498 return array;
270 }
271
272 59591 lbm_array_header_t *lbm_dec_array_rw(lbm_value val) {
273 59591 lbm_array_header_t *array = NULL;
274
2/2
✓ Branch 0 taken 59505 times.
✓ Branch 1 taken 86 times.
59591 if (lbm_is_array_rw(val)) {
275 59505 array = (lbm_array_header_t *)lbm_car(val);
276 }
277 59591 return array;
278 }
279
280 12736034 lbm_char_channel_t *lbm_dec_channel(lbm_value val) {
281 12736034 lbm_char_channel_t *res = NULL;
282
283
1/2
✓ Branch 0 taken 12736034 times.
✗ Branch 1 not taken.
12736034 if (lbm_type_of(val) == LBM_TYPE_CHANNEL) {
284 12736034 res = (lbm_char_channel_t *)lbm_car(val);
285 }
286 12736034 return res;
287 }
288
289 3374 lbm_uint lbm_dec_custom(lbm_value val) {
290 3374 lbm_uint res = 0;
291
1/2
✓ Branch 0 taken 3374 times.
✗ Branch 1 not taken.
3374 if (lbm_type_of(val) == LBM_TYPE_CUSTOM) {
292 3374 res = (lbm_uint)lbm_car(val);
293 }
294 3374 return res;
295 }
296
297 60948 uint8_t lbm_dec_as_char(lbm_value a) {
298 60948 uint8_t r = 0;
299
9/10
✓ Branch 0 taken 60701 times.
✓ Branch 1 taken 51 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 28 times.
✓ Branch 4 taken 28 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 28 times.
✓ Branch 7 taken 28 times.
✓ Branch 8 taken 28 times.
✗ Branch 9 not taken.
60948 switch (lbm_type_of_functional(a)) {
300 60701 case LBM_TYPE_CHAR:
301 60701 r = (uint8_t)lbm_dec_char(a); break;
302 51 case LBM_TYPE_I:
303 51 r = (uint8_t)lbm_dec_i(a); break;
304 28 case LBM_TYPE_U:
305 28 r = (uint8_t)lbm_dec_u(a); break;
306 28 case LBM_TYPE_I32:
307 28 r = (uint8_t)lbm_dec_i32(a); break;
308 28 case LBM_TYPE_U32:
309 28 r = (uint8_t)lbm_dec_u32(a); break;
310 28 case LBM_TYPE_FLOAT:
311 28 r = (uint8_t)lbm_dec_float(a); break;
312 28 case LBM_TYPE_I64:
313 28 r = (uint8_t)lbm_dec_i64(a); break;
314 28 case LBM_TYPE_U64:
315 28 r = (uint8_t)lbm_dec_u64(a); break;
316 28 case LBM_TYPE_DOUBLE:
317 28 r = (uint8_t) lbm_dec_double(a); break;
318 }
319 60948 return r;
320 }
321
322 8915159 uint32_t lbm_dec_as_u32(lbm_value a) {
323 8915159 uint32_t r = 0;
324
8/9
✓ Branch 0 taken 562265 times.
✓ Branch 1 taken 1701536 times.
✓ Branch 2 taken 1852501 times.
✓ Branch 3 taken 4798686 times.
✓ Branch 4 taken 31 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 84 times.
✓ Branch 7 taken 28 times.
✗ Branch 8 not taken.
8915159 switch (lbm_type_of_functional(a)) {
325 562265 case LBM_TYPE_CHAR:
326 562265 r = (uint32_t)lbm_dec_char(a); break;
327 1701536 case LBM_TYPE_I:
328 1701536 r = (uint32_t)lbm_dec_i(a); break;
329 1852501 case LBM_TYPE_U:
330 1852501 r = (uint32_t)lbm_dec_u(a); break;
331 4798686 case LBM_TYPE_I32: /* fall through */
332 case LBM_TYPE_U32:
333 4798686 r = (uint32_t)lbm_dec_u32(a); break;
334 31 case LBM_TYPE_FLOAT:
335 31 r = (uint32_t)lbm_dec_float(a); break;
336 28 case LBM_TYPE_I64:
337 28 r = (uint32_t)lbm_dec_i64(a); break;
338 84 case LBM_TYPE_U64:
339 84 r = (uint32_t)lbm_dec_u64(a); break;
340 28 case LBM_TYPE_DOUBLE:
341 28 r = (uint32_t)lbm_dec_double(a); break;
342 }
343 8915159 return r;
344 }
345
346 246233988 int32_t lbm_dec_as_i32(lbm_value a) {
347 246233988 int32_t r = 0;
348
10/10
✓ Branch 0 taken 6276905 times.
✓ Branch 1 taken 236274328 times.
✓ Branch 2 taken 8196 times.
✓ Branch 3 taken 3672189 times.
✓ Branch 4 taken 30 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 56 times.
✓ Branch 7 taken 56 times.
✓ Branch 8 taken 28 times.
✓ Branch 9 taken 2172 times.
246233988 switch (lbm_type_of_functional(a)) {
349 6276905 case LBM_TYPE_CHAR:
350 6276905 r = (int32_t)lbm_dec_char(a); break;
351 236274328 case LBM_TYPE_I:
352 236274328 r = (int32_t)lbm_dec_i(a); break;
353 8196 case LBM_TYPE_U:
354 8196 r = (int32_t)lbm_dec_u(a); break;
355 3672189 case LBM_TYPE_I32:
356 3672189 r = (int32_t)lbm_dec_i32(a); break;
357 30 case LBM_TYPE_U32:
358 30 r = (int32_t)lbm_dec_u32(a); break;
359 28 case LBM_TYPE_FLOAT:
360 28 r = (int32_t)lbm_dec_float(a); break;
361 56 case LBM_TYPE_I64:
362 56 r = (int32_t)lbm_dec_i64(a); break;
363 56 case LBM_TYPE_U64:
364 56 r = (int32_t)lbm_dec_u64(a); break;
365 28 case LBM_TYPE_DOUBLE:
366 28 r = (int32_t) lbm_dec_double(a); break;
367 }
368 246233988 return r;
369 }
370
371 6729254 int64_t lbm_dec_as_i64(lbm_value a) {
372 6729254 int64_t r = 0;
373
10/10
✓ Branch 0 taken 562560 times.
✓ Branch 1 taken 1401389 times.
✓ Branch 2 taken 168 times.
✓ Branch 3 taken 168 times.
✓ Branch 4 taken 168 times.
✓ Branch 5 taken 68 times.
✓ Branch 6 taken 4764557 times.
✓ Branch 7 taken 112 times.
✓ Branch 8 taken 56 times.
✓ Branch 9 taken 8 times.
6729254 switch (lbm_type_of_functional(a)) {
374 562560 case LBM_TYPE_CHAR:
375 562560 r = (int64_t)lbm_dec_char(a); break;
376 1401389 case LBM_TYPE_I:
377 1401389 r = (int64_t)lbm_dec_i(a); break;
378 168 case LBM_TYPE_U:
379 168 r = (int64_t)lbm_dec_u(a); break;
380 168 case LBM_TYPE_I32:
381 168 r = (int64_t)lbm_dec_i32(a); break;
382 168 case LBM_TYPE_U32:
383 168 r = (int64_t)lbm_dec_u32(a); break;
384 68 case LBM_TYPE_FLOAT:
385 68 r = (int64_t)lbm_dec_float(a); break;
386 4764557 case LBM_TYPE_I64:
387 4764557 r = (int64_t)lbm_dec_i64(a); break;
388 112 case LBM_TYPE_U64:
389 112 r = (int64_t)lbm_dec_u64(a); break;
390 56 case LBM_TYPE_DOUBLE:
391 56 r = (int64_t) lbm_dec_double(a); break;
392 }
393 6729254 return r;
394 }
395
396 4488482 uint64_t lbm_dec_as_u64(lbm_value a) {
397 4488482 uint64_t r = 0;
398
9/10
✓ Branch 0 taken 562532 times.
✓ Branch 1 taken 280592 times.
✓ Branch 2 taken 168 times.
✓ Branch 3 taken 168 times.
✓ Branch 4 taken 168 times.
✓ Branch 5 taken 56 times.
✓ Branch 6 taken 168 times.
✓ Branch 7 taken 3644574 times.
✓ Branch 8 taken 56 times.
✗ Branch 9 not taken.
4488482 switch (lbm_type_of_functional(a)) {
399 562532 case LBM_TYPE_CHAR:
400 562532 r = (uint64_t)lbm_dec_char(a); break;
401 280592 case LBM_TYPE_I:
402 280592 r = (uint64_t)lbm_dec_i(a); break;
403 168 case LBM_TYPE_U:
404 168 r = (uint64_t)lbm_dec_u(a); break;
405 168 case LBM_TYPE_I32:
406 168 r = (uint64_t)lbm_dec_i32(a); break;
407 168 case LBM_TYPE_U32:
408 168 r = (uint64_t)lbm_dec_u32(a); break;
409 56 case LBM_TYPE_FLOAT:
410 56 r = (uint64_t)lbm_dec_float(a); break;
411 168 case LBM_TYPE_I64:
412 168 r = (uint64_t)lbm_dec_i64(a); break;
413 3644574 case LBM_TYPE_U64:
414 3644574 r = (uint64_t)lbm_dec_u64(a); break;
415 56 case LBM_TYPE_DOUBLE:
416 56 r = (uint64_t)lbm_dec_double(a); break;
417 }
418 4488482 return r;
419 }
420
421 /* lbm_uint lbm_dec_as_uint(lbm_value a) { */
422 /* lbm_uint r = 0; */
423 /* switch (lbm_type_of_functional(a)) { */
424 /* case LBM_TYPE_CHAR: */
425 /* r = (lbm_uint)lbm_dec_char(a); break; */
426 /* case LBM_TYPE_I: */
427 /* r = (lbm_uint)lbm_dec_i(a); break; */
428 /* case LBM_TYPE_U: */
429 /* r = (lbm_uint)lbm_dec_u(a); break; */
430 /* case LBM_TYPE_I32: */
431 /* r = (lbm_uint)lbm_dec_i32(a); break; */
432 /* case LBM_TYPE_U32: */
433 /* r = (lbm_uint)lbm_dec_u32(a); break; */
434 /* case LBM_TYPE_FLOAT: */
435 /* r = (lbm_uint)lbm_dec_float(a); break; */
436 /* case LBM_TYPE_I64: */
437 /* r = (lbm_uint)lbm_dec_i64(a); break; */
438 /* case LBM_TYPE_U64: */
439 /* r = (lbm_uint) lbm_dec_u64(a); break; */
440 /* case LBM_TYPE_DOUBLE: */
441 /* r = (lbm_uint)lbm_dec_double(a); break; */
442 /* } */
443 /* return r; */
444 /* } */
445
446 /* lbm_int lbm_dec_as_int(lbm_value a) { */
447 /* lbm_int r = 0; */
448 /* switch (lbm_type_of_functional(a)) { */
449 /* case LBM_TYPE_CHAR: */
450 /* r = (lbm_int)lbm_dec_char(a); break; */
451 /* case LBM_TYPE_I: */
452 /* r = (lbm_int)lbm_dec_i(a); break; */
453 /* case LBM_TYPE_U: */
454 /* r = (lbm_int)lbm_dec_u(a); break; */
455 /* case LBM_TYPE_I32: */
456 /* r = (lbm_int)lbm_dec_i32(a); break; */
457 /* case LBM_TYPE_U32: */
458 /* r = (lbm_int)lbm_dec_u32(a); break; */
459 /* case LBM_TYPE_FLOAT: */
460 /* r = (lbm_int)lbm_dec_float(a); break; */
461 /* case LBM_TYPE_I64: */
462 /* r = (lbm_int)lbm_dec_i64(a); break; */
463 /* case LBM_TYPE_U64: */
464 /* r = (lbm_int)lbm_dec_u64(a); break; */
465 /* case LBM_TYPE_DOUBLE: */
466 /* r = (lbm_int)lbm_dec_double(a); break; */
467 /* } */
468 /* return r; */
469 /* } */
470
471 375496030 float lbm_dec_as_float(lbm_value a) {
472 375496030 float r = 0;
473
10/10
✓ Branch 0 taken 103748350 times.
✓ Branch 1 taken 168075782 times.
✓ Branch 2 taken 140 times.
✓ Branch 3 taken 140 times.
✓ Branch 4 taken 197 times.
✓ Branch 5 taken 103671009 times.
✓ Branch 6 taken 140 times.
✓ Branch 7 taken 140 times.
✓ Branch 8 taken 28 times.
✓ Branch 9 taken 104 times.
375496030 switch (lbm_type_of_functional(a)) {
474 103748350 case LBM_TYPE_CHAR:
475 103748350 r = (float)lbm_dec_char(a); break;
476 168075782 case LBM_TYPE_I:
477 168075782 r = (float)lbm_dec_i(a); break;
478 140 case LBM_TYPE_U:
479 140 r = (float)lbm_dec_u(a); break;
480 140 case LBM_TYPE_I32:
481 140 r = (float)lbm_dec_i32(a); break;
482 197 case LBM_TYPE_U32:
483 197 r = (float)lbm_dec_u32(a); break;
484 103671009 case LBM_TYPE_FLOAT:
485 103671009 r = (float)lbm_dec_float(a); break;
486 140 case LBM_TYPE_I64:
487 140 r = (float)lbm_dec_i64(a); break;
488 140 case LBM_TYPE_U64:
489 140 r = (float)lbm_dec_u64(a); break;
490 28 case LBM_TYPE_DOUBLE:
491 28 r = (float)lbm_dec_double(a); break;
492 }
493 375496030 return r;
494 }
495
496 564020 double lbm_dec_as_double(lbm_value a) {
497 564020 double r = 0;
498
9/10
✓ Branch 0 taken 281169 times.
✓ Branch 1 taken 280626 times.
✓ Branch 2 taken 140 times.
✓ Branch 3 taken 140 times.
✓ Branch 4 taken 140 times.
✓ Branch 5 taken 386 times.
✓ Branch 6 taken 140 times.
✓ Branch 7 taken 140 times.
✓ Branch 8 taken 1139 times.
✗ Branch 9 not taken.
564020 switch (lbm_type_of_functional(a)) {
499 281169 case LBM_TYPE_CHAR:
500 281169 r = (double)lbm_dec_char(a); break;
501 280626 case LBM_TYPE_I:
502 280626 r = (double)lbm_dec_i(a); break;
503 140 case LBM_TYPE_U:
504 140 r = (double)lbm_dec_u(a); break;
505 140 case LBM_TYPE_I32:
506 140 r = (double)lbm_dec_i32(a); break;
507 140 case LBM_TYPE_U32:
508 140 r = (double)lbm_dec_u32(a); break;
509 386 case LBM_TYPE_FLOAT:
510 386 r = (double)lbm_dec_float(a); break;
511 140 case LBM_TYPE_I64:
512 140 r = (double)lbm_dec_i64(a); break;
513 140 case LBM_TYPE_U64:
514 140 r = (double)lbm_dec_u64(a); break;
515 1139 case LBM_TYPE_DOUBLE:
516 1139 r = (double)lbm_dec_double(a); break;
517 }
518 564020 return r;
519 }
520
521 /****************************************************/
522 /* HEAP MANAGEMENT */
523
524 22390 static bool generate_freelist(size_t num_cells) {
525 22390 size_t i = 0;
526
527
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
22390 if (!lbm_heap_state.heap) return false;
528
529 22390 lbm_heap_state.freelist = lbm_enc_cons_ptr(0);
530
531 lbm_cons_t *t;
532
533 // Add all cells to free list
534
2/2
✓ Branch 0 taken 205398154 times.
✓ Branch 1 taken 22390 times.
205420544 for (i = 1; i < num_cells; i ++) {
535 205398154 t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
536 205398154 t->car = ENC_SYM_RECOVERED; // all cars in free list are "RECOVERED"
537 205398154 t->cdr = lbm_enc_cons_ptr(i);
538 }
539
540 // Replace the incorrect pointer at the last cell.
541 22390 t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
542 22390 t->cdr = ENC_SYM_NIL;
543
544 22390 return true;
545 }
546
547 594687 void lbm_nil_freelist(void) {
548 594687 lbm_heap_state.freelist = ENC_SYM_NIL;
549 594687 lbm_heap_state.num_free = 0;
550 594687 }
551
552 22390 static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells,
553 lbm_uint* gc_stack_storage, lbm_uint gc_stack_size) {
554 22390 lbm_heap_state.heap = addr;
555 22390 lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
556 22390 lbm_heap_state.heap_size = num_cells;
557
558 22390 lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size);
559
560 22390 lbm_heap_state.num_free = num_cells;
561 22390 lbm_heap_state.num_alloc_arrays = 0;
562 22390 lbm_heap_state.gc_num = 0;
563 22390 lbm_heap_state.gc_marked = 0;
564 22390 lbm_heap_state.gc_recovered = 0;
565 22390 lbm_heap_state.gc_recovered_arrays = 0;
566 22390 lbm_heap_state.gc_least_free = num_cells;
567 22390 lbm_heap_state.gc_last_free = num_cells;
568 22390 }
569
570 594687 void lbm_heap_new_freelist_length(void) {
571 594687 lbm_heap_state.gc_last_free = lbm_heap_state.num_free;
572
2/2
✓ Branch 0 taken 4099 times.
✓ Branch 1 taken 590588 times.
594687 if (lbm_heap_state.num_free < lbm_heap_state.gc_least_free)
573 4099 lbm_heap_state.gc_least_free = lbm_heap_state.num_free;
574 594687 }
575
576 22390 bool lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
577 lbm_uint gc_stack_size) {
578
579
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
22390 if (((uintptr_t)addr % 8) != 0) return false;
580
581 22390 memset(addr,0, sizeof(lbm_cons_t) * num_cells);
582
583 22390 lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint));
584
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
22390 if (gc_stack_storage == NULL) return 0;
585
586 22390 heap_init_state(addr, num_cells,
587 gc_stack_storage, gc_stack_size);
588
589 22390 lbm_heaps[0] = addr;
590
591 22390 return generate_freelist(num_cells);
592 }
593
594
595 550195605 lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) {
596 lbm_value r;
597 550195605 lbm_value cell = lbm_heap_state.freelist;
598
2/2
✓ Branch 0 taken 550039592 times.
✓ Branch 1 taken 156013 times.
550195605 if (cell) {
599 550039592 lbm_uint heap_ix = lbm_dec_ptr(cell);
600 550039592 lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
601 550039592 lbm_heap_state.num_free--;
602 550039592 lbm_heap_state.heap[heap_ix].car = car;
603 550039592 lbm_heap_state.heap[heap_ix].cdr = cdr;
604 550039592 r = lbm_set_ptr_type(cell, ptr_type);
605 } else {
606 156013 r = ENC_SYM_MERROR;
607 }
608 550195605 return r;
609 }
610
611 1257587 lbm_value lbm_heap_allocate_list(lbm_uint n) {
612
2/2
✓ Branch 0 taken 3368 times.
✓ Branch 1 taken 1254219 times.
1257587 if (n == 0) return ENC_SYM_NIL;
613
2/2
✓ Branch 0 taken 1634 times.
✓ Branch 1 taken 1252585 times.
1254219 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
614 // Here the freelist is guaranteed to be a cons_cell.
615
616 1252585 lbm_value curr = lbm_heap_state.freelist;
617 1252585 lbm_value res = curr;
618
619 1252585 lbm_cons_t *c_cell = NULL;
620 1252585 lbm_uint count = 0;
621 do {
622 6467514 c_cell = lbm_ref_cell(curr);
623 6467514 c_cell->car = ENC_SYM_NIL;
624 6467514 curr = c_cell->cdr;
625 6467514 count ++;
626
2/2
✓ Branch 0 taken 5214929 times.
✓ Branch 1 taken 1252585 times.
6467514 } while (count < n);
627 1252585 lbm_heap_state.freelist = curr;
628 1252585 c_cell->cdr = ENC_SYM_NIL;
629 1252585 lbm_heap_state.num_free-=count;
630 1252585 return res;
631 }
632
633 21978639 lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) {
634
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21978639 times.
21978639 if (n == 0) return ENC_SYM_NIL;
635
2/2
✓ Branch 0 taken 33189 times.
✓ Branch 1 taken 21945450 times.
21978639 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
636
637 21945450 lbm_value curr = lbm_heap_state.freelist;
638 21945450 lbm_value res = curr;
639
640 21945450 lbm_cons_t *c_cell = NULL;
641 21945450 unsigned int count = 0;
642 do {
643 44174756 c_cell = lbm_ref_cell(curr);
644 44174756 c_cell->car = va_arg(valist, lbm_value);
645 44174756 curr = c_cell->cdr;
646 44174756 count ++;
647
2/2
✓ Branch 0 taken 22229306 times.
✓ Branch 1 taken 21945450 times.
44174756 } while (count < n);
648 21945450 lbm_heap_state.freelist = curr;
649 21945450 c_cell->cdr = ENC_SYM_NIL;
650 21945450 lbm_heap_state.num_free-=count;
651 21945450 return res;
652 }
653
654 21978639 lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) {
655 va_list valist;
656 21978639 va_start(valist, n);
657 21978639 lbm_value r = lbm_heap_allocate_list_init_va(n, valist);
658 21978639 va_end(valist);
659 21978639 return r;
660 }
661
662 lbm_uint lbm_heap_num_allocated(void) {
663 return lbm_heap_state.heap_size - lbm_heap_state.num_free;
664 }
665 lbm_uint lbm_heap_size(void) {
666 return lbm_heap_state.heap_size;
667 }
668
669 lbm_uint lbm_heap_size_bytes(void) {
670 return lbm_heap_state.heap_bytes;
671 }
672
673 261 void lbm_get_heap_state(lbm_heap_state_t *res) {
674 261 *res = lbm_heap_state;
675 261 }
676
677 lbm_uint lbm_get_gc_stack_max(void) {
678 return lbm_get_max_stack(&lbm_heap_state.gc_stack);
679 }
680
681 lbm_uint lbm_get_gc_stack_size(void) {
682 return lbm_heap_state.gc_stack.size;
683 }
684
685 281676 static inline void value_assign(lbm_value *a, lbm_value b) {
686 281676 lbm_value a_old = *a & LBM_GC_MASK;
687 281676 *a = a_old | (b & ~LBM_GC_MASK);
688 281676 }
689
690 #ifdef LBM_USE_GC_PTR_REV
691 /* ************************************************************
692 Deutch-Schorr-Waite (DSW) pointer reversal GC for 2-ptr cells
693 with a hack-solution for the lisp-array case (n-ptr cells).
694
695 DSW visits each branch node 3 times compared to 2 times for
696 the stack based recursive mark.
697 Where the stack based recursive mark performs a stack push/pop,
698 DSW rearranges the, current, prev, next and a ptr field on
699 the heap.
700
701 DSW changes the structure of the heap and it introduces an
702 invalid pointer (LBM_PTR_NULL) temporarily during marking.
703 Since the heap will be "messed up" while marking, a mutex
704 is introuded to keep other processes out of the heap while
705 marking.
706 */
707
708 static int do_nothing(lbm_value v, bool shared, void *arg) {
709 (void) v;
710 (void) shared;
711 (void) arg;
712 return TRAV_FUN_SUBTREE_CONTINUE;
713 }
714
715 void lbm_gc_mark_phase(lbm_value root) {
716 lbm_mutex_lock(&lbm_const_heap_mutex);
717 lbm_ptr_rev_trav(do_nothing, root, NULL);
718 lbm_mutex_unlock(&lbm_const_heap_mutex);
719 }
720
721 #else
722 // ////////////////////////////////////////////////////////////
723 // Check if a value is currently on the stack
724 // This is a temporary hack to make arrays with cycles work
725 // with Garbage collection. It is an O(stack_size) sollution, there
726 // are O(1) sollutions that has a constant cost even in non-array cases.
727
728 21842 bool active_ptr(lbm_value p) {
729 21842 lbm_stack_t *s = &lbm_heap_state.gc_stack;
730 21842 bool r = false;
731
2/2
✓ Branch 0 taken 260 times.
✓ Branch 1 taken 21842 times.
22102 for (lbm_uint i = 0; i < s->sp; i ++) {
732
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 260 times.
260 if (p == s->data[i]) {
733 r = true;
734 break;
735 }
736 }
737 21842 return r;
738 }
739
740 // ////////////////////////////////////////////////////////////
741 // Explicit stack "recursive" mark phase
742
743 // Trees are marked in a left subtree before rigth subtree, car first then cdr,
744 // way to favor lisp lists. This means that stack will grow slowly when
745 // marking right-leaning (cdr-recursive) data-structures while left-leaning
746 // (car-recursive) structures uses a lot of stack.
747
748 // Lisp arrays contain an extra book-keeping field to keep track
749 // of how far into the array the marking process has gone.
750
751 // TODO: DSW should be used as a last-resort if the GC stack is exhausted.
752 // If we use DSW as last-resort can we get away with a way smaller
753 // GC stack and unchanged performance (on sensible programs)?
754
755 extern eval_context_t *ctx_running;
756 9666136 void lbm_gc_mark_phase(lbm_value root) {
757 lbm_value t_ptr;
758 9666136 lbm_stack_t *s = &lbm_heap_state.gc_stack;
759 9666136 s->data[s->sp++] = root;
760
761
2/2
✓ Branch 0 taken 47357637 times.
✓ Branch 1 taken 9666136 times.
57023773 while (!lbm_stack_is_empty(s)) {
762 lbm_value curr;
763 47357637 lbm_pop(s, &curr);
764
765 106383598 mark_shortcut:
766
767
2/2
✓ Branch 0 taken 65548798 times.
✓ Branch 1 taken 40834800 times.
106383598 if (!lbm_is_ptr(curr) ||
768
2/2
✓ Branch 0 taken 305 times.
✓ Branch 1 taken 65548493 times.
65548798 (curr & LBM_PTR_TO_CONSTANT_BIT)) {
769 45330262 continue;
770 }
771
772 65548493 lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)];
773
774
2/2
✓ Branch 0 taken 4474273 times.
✓ Branch 1 taken 61074220 times.
65548493 if (lbm_get_gc_mark(cell->cdr)) {
775 4474273 continue;
776 }
777
778 61074220 t_ptr = lbm_type_of(curr);
779
780 // An array is marked in O(N) time using an additional 32bit
781 // value per array that keeps track of how far into the array GC
782 // has progressed.
783
2/2
✓ Branch 0 taken 21842 times.
✓ Branch 1 taken 61052378 times.
61074220 if (t_ptr == LBM_TYPE_LISPARRAY) {
784 // O(stack_size) cost when seeing array. This protects
785 // against gc recursing into arrays via cycles.
786
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21842 times.
21842 if (active_ptr(curr)) {
787 continue; // Already in process of marking this array, abort cycle!
788 }
789 21842 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
790 21842 lbm_value *arrdata = (lbm_value *)arr->data;
791 21842 uint32_t index = arr->index;
792
2/2
✓ Branch 0 taken 21832 times.
✓ Branch 1 taken 10 times.
21842 if (arr->size > 0) {
793 21832 lbm_push(s, curr); // put array back as bookkeeping.
794 // Potential optimization.
795 // 1. CONS pointers are set to curr and recurse.
796 // 2. Any other ptr is marked immediately and index is increased.
797
3/4
✓ Branch 0 taken 1140 times.
✓ Branch 1 taken 20692 times.
✓ Branch 2 taken 1140 times.
✗ Branch 3 not taken.
21832 if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT) == 0) &&
798
2/2
✓ Branch 0 taken 986 times.
✓ Branch 1 taken 154 times.
1140 !((arrdata[index] & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)) {
799 986 lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])];
800
2/2
✓ Branch 0 taken 958 times.
✓ Branch 1 taken 28 times.
986 if (!lbm_get_gc_mark(elt->cdr)) {
801 958 curr = arrdata[index];
802 958 arr->index++;
803 958 goto mark_shortcut;
804 }
805 }
806
2/2
✓ Branch 0 taken 18528 times.
✓ Branch 1 taken 2346 times.
20874 if (index < ((arr->size/(sizeof(lbm_value))) - 1)) {
807 18528 arr->index++;
808 18528 continue;
809 }
810 2346 arr->index = 0;
811 2346 lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it.
812 }
813 2356 cell->cdr = lbm_set_gc_mark(cell->cdr);
814 2356 lbm_heap_state.gc_marked ++;
815 2356 continue;
816
2/2
✓ Branch 0 taken 303186 times.
✓ Branch 1 taken 60749192 times.
61052378 } else if (t_ptr == LBM_TYPE_CHANNEL) {
817 303186 cell->cdr = lbm_set_gc_mark(cell->cdr);
818 303186 lbm_heap_state.gc_marked ++;
819 // TODO: Can channels be explicitly freed ?
820
1/2
✓ Branch 0 taken 303186 times.
✗ Branch 1 not taken.
303186 if (cell->car != ENC_SYM_NIL) {
821 303186 lbm_char_channel_t *chan = (lbm_char_channel_t *)cell->car;
822 303186 curr = chan->dependency;
823 303186 goto mark_shortcut;
824 }
825 continue;
826 }
827
828 60749192 cell->cdr = lbm_set_gc_mark(cell->cdr);
829 60749192 lbm_heap_state.gc_marked ++;
830
831
2/2
✓ Branch 0 taken 58721817 times.
✓ Branch 1 taken 2027375 times.
60749192 if (t_ptr == LBM_TYPE_CONS) {
832
2/2
✓ Branch 0 taken 37672015 times.
✓ Branch 1 taken 21049802 times.
58721817 if (lbm_is_ptr(cell->cdr)) {
833
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 37672015 times.
37672015 if (!lbm_push(s, cell->cdr)) {
834 lbm_critical_error();
835 break;
836 }
837 }
838 58721817 curr = cell->car;
839 58721817 goto mark_shortcut; // Skip a push/pop
840 }
841 }
842 9666136 }
843 #endif
844
845 //Environments are proper lists with a 2 element list stored in each car.
846 19637856 void lbm_gc_mark_env(lbm_value env) {
847 19637856 lbm_value curr = env;
848 lbm_cons_t *c;
849
850
2/2
✓ Branch 0 taken 3363411 times.
✓ Branch 1 taken 19637856 times.
23001267 while (lbm_is_ptr(curr)) {
851 3363411 c = lbm_ref_cell(curr);
852 3363411 c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
853 3363411 lbm_cons_t *b = lbm_ref_cell(c->car);
854 3363411 b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
855 3363411 lbm_gc_mark_phase(b->cdr); // mark the bound object.
856 3363411 lbm_heap_state.gc_marked +=2;
857 3363411 curr = c->cdr;
858 }
859 19637856 }
860
861
862 607872 void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
863
2/2
✓ Branch 0 taken 13760190 times.
✓ Branch 1 taken 607872 times.
14368062 for (lbm_uint i = 0; i < aux_size; i ++) {
864
2/2
✓ Branch 0 taken 8036920 times.
✓ Branch 1 taken 5723270 times.
13760190 if (lbm_is_ptr(aux_data[i])) {
865 8036920 lbm_type pt_t = lbm_type_of(aux_data[i]);
866 8036920 lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
867
3/4
✓ Branch 0 taken 8036920 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3996485 times.
✓ Branch 3 taken 4040435 times.
8036920 if( pt_t >= LBM_POINTER_TYPE_FIRST &&
868 3996485 pt_t <= LBM_POINTER_TYPE_LAST &&
869
1/2
✓ Branch 0 taken 3996485 times.
✗ Branch 1 not taken.
3996485 pt_v < lbm_heap_state.heap_size) {
870 3996485 lbm_gc_mark_phase(aux_data[i]);
871 }
872 }
873 }
874 607872 }
875
876 1219504 void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
877
2/2
✓ Branch 0 taken 1836370 times.
✓ Branch 1 taken 1219504 times.
3055874 for (lbm_uint i = 0; i < num_roots; i ++) {
878 1836370 lbm_gc_mark_phase(roots[i]);
879 }
880 1219504 }
881
882 // Sweep moves non-marked heap objects to the free list.
883 594687 int lbm_gc_sweep_phase(void) {
884 594687 unsigned int i = 0;
885 594687 lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap;
886
887
2/2
✓ Branch 0 taken 1388338688 times.
✓ Branch 1 taken 594687 times.
1388933375 for (i = 0; i < lbm_heap_state.heap_size; i ++) {
888
2/2
✓ Branch 0 taken 67604831 times.
✓ Branch 1 taken 1320733857 times.
1388338688 if ( lbm_get_gc_mark(heap[i].cdr)) {
889 67604831 heap[i].cdr = lbm_clr_gc_mark(heap[i].cdr);
890 } else {
891 // Check if this cell is a pointer to an array
892 // and free it.
893
2/2
✓ Branch 0 taken 293829881 times.
✓ Branch 1 taken 1026903976 times.
1320733857 if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL) {
894
7/7
✓ Branch 0 taken 8398004 times.
✓ Branch 1 taken 29008 times.
✓ Branch 2 taken 585311 times.
✓ Branch 3 taken 306697 times.
✓ Branch 4 taken 2 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 284510831 times.
293829881 switch(heap[i].cdr) {
895
896 8398004 case ENC_SYM_IND_I_TYPE: /* fall through */
897 case ENC_SYM_IND_U_TYPE:
898 case ENC_SYM_IND_F_TYPE:
899 8398004 lbm_memory_free((lbm_uint*)heap[i].car);
900 8398004 break;
901 29008 case ENC_SYM_DEFRAG_LISPARRAY_TYPE: /* fall through */
902 case ENC_SYM_DEFRAG_ARRAY_TYPE:
903 29008 lbm_defrag_mem_free((lbm_uint*)heap[i].car);
904 29008 break;
905 585311 case ENC_SYM_LISPARRAY_TYPE: /* fall through */
906 case ENC_SYM_ARRAY_TYPE:{
907 585311 lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
908 585311 lbm_memory_free((lbm_uint *)arr->data);
909 585311 lbm_heap_state.gc_recovered_arrays++;
910 585311 lbm_memory_free((lbm_uint *)arr);
911 585311 } break;
912 306697 case ENC_SYM_CHANNEL_TYPE:{
913 306697 lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car;
914 306697 lbm_memory_free((lbm_uint*)chan->state);
915 306697 lbm_memory_free((lbm_uint*)chan);
916 306697 } break;
917 2 case ENC_SYM_CUSTOM_TYPE: {
918 2 lbm_uint *t = (lbm_uint*)heap[i].car;
919 2 lbm_custom_type_destroy(t);
920 2 lbm_memory_free(t);
921 2 } break;
922 28 case ENC_SYM_DEFRAG_MEM_TYPE: {
923 28 lbm_uint *ptr = (lbm_uint *)heap[i].car;
924 28 lbm_defrag_mem_destroy(ptr);
925 28 } break;
926 284510831 default:
927 284510831 break;
928 }
929 }
930 // create pointer to use as new freelist
931 1320733857 lbm_uint addr = lbm_enc_cons_ptr(i);
932
933 // Clear the "freed" cell.
934 1320733857 heap[i].car = ENC_SYM_RECOVERED;
935 1320733857 heap[i].cdr = lbm_heap_state.freelist;
936 1320733857 lbm_heap_state.freelist = addr;
937 1320733857 lbm_heap_state.num_free++;
938 1320733857 lbm_heap_state.gc_recovered ++;
939 }
940 }
941 594687 return 1;
942 }
943
944 594687 void lbm_gc_state_inc(void) {
945 594687 lbm_heap_state.gc_num ++;
946 594687 lbm_heap_state.gc_recovered = 0;
947 594687 lbm_heap_state.gc_marked = 0;
948 594687 }
949
950 // construct, alter and break apart
951 549152998 lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
952 549152998 return lbm_heap_allocate_cell(LBM_TYPE_CONS, car, cdr);
953 }
954
955 539393713 lbm_value lbm_car(lbm_value c){
956
2/2
✓ Branch 0 taken 539392896 times.
✓ Branch 1 taken 817 times.
539393713 if (lbm_is_ptr(c) ){
957 539392896 lbm_cons_t *cell = lbm_ref_cell(c);
958 539392896 return cell->car;
959 }
960
2/2
✓ Branch 0 taken 47 times.
✓ Branch 1 taken 770 times.
817 return c ? ENC_SYM_TERROR : c; //nil if c == nil
961 }
962
963 // TODO: Many comparisons "is this the nil symbol" can be
964 // streamlined a bit. NIL is 0 and cannot be confused with any other
965 // lbm_value.
966
967 1727108 lbm_value lbm_caar(lbm_value c) {
968 1727108 lbm_value tmp = ENC_SYM_NIL;
969
2/2
✓ Branch 0 taken 1727021 times.
✓ Branch 1 taken 87 times.
1727108 if (lbm_is_ptr(c)) {
970 1727021 tmp = lbm_ref_cell(c)->car;
971
1/2
✓ Branch 0 taken 1727021 times.
✗ Branch 1 not taken.
1727021 if (lbm_is_ptr(tmp)) {
972 1727021 return lbm_ref_cell(tmp)->car;
973 }
974 }
975
2/4
✓ Branch 0 taken 87 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 87 times.
✗ Branch 3 not taken.
87 return c || tmp ? ENC_SYM_TERROR : c; //nil if not something else
976 }
977
978
979 11989 lbm_value lbm_cadr(lbm_value c) {
980 11989 lbm_value tmp = ENC_SYM_NIL;
981
1/2
✓ Branch 0 taken 11989 times.
✗ Branch 1 not taken.
11989 if (lbm_is_ptr(c)) {
982 11989 tmp = lbm_ref_cell(c)->cdr;
983
1/2
✓ Branch 0 taken 11989 times.
✗ Branch 1 not taken.
11989 if (lbm_is_ptr(tmp)) {
984 11989 return lbm_ref_cell(tmp)->car;
985 }
986 }
987 return c || tmp ? ENC_SYM_TERROR : c;
988 }
989
990 78046579 lbm_value lbm_cdr(lbm_value c){
991
2/2
✓ Branch 0 taken 77479946 times.
✓ Branch 1 taken 566633 times.
78046579 if (lbm_is_ptr(c)) {
992 77479946 lbm_cons_t *cell = lbm_ref_cell(c);
993 77479946 return cell->cdr;
994 }
995
1/2
✓ Branch 0 taken 566633 times.
✗ Branch 1 not taken.
566633 return c ? ENC_SYM_TERROR: c;
996 }
997
998 lbm_value lbm_cddr(lbm_value c) {
999 if (lbm_is_ptr(c)) {
1000 lbm_value tmp = lbm_ref_cell(c)->cdr;
1001 if (lbm_is_ptr(tmp)) {
1002 return lbm_ref_cell(tmp)->cdr;
1003 }
1004 }
1005 return c ? ENC_SYM_TERROR : c;
1006 }
1007
1008 6858491 int lbm_set_car(lbm_value c, lbm_value v) {
1009 6858491 int r = 0;
1010
1011
2/2
✓ Branch 0 taken 6858463 times.
✓ Branch 1 taken 28 times.
6858491 if (lbm_type_of(c) == LBM_TYPE_CONS) {
1012 6858463 lbm_cons_t *cell = lbm_ref_cell(c);
1013 6858463 cell->car = v;
1014 6858463 r = 1;
1015 }
1016 6858491 return r;
1017 }
1018
1019 101371179 int lbm_set_cdr(lbm_value c, lbm_value v) {
1020 101371179 int r = 0;
1021
2/2
✓ Branch 0 taken 100804635 times.
✓ Branch 1 taken 566544 times.
101371179 if (lbm_is_cons_rw(c)){
1022 100804635 lbm_cons_t *cell = lbm_ref_cell(c);
1023 100804635 cell->cdr = v;
1024 100804635 r = 1;
1025 }
1026 101371179 return r;
1027 }
1028
1029 8505665 int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
1030 8505665 int r = 0;
1031
1/2
✓ Branch 0 taken 8505665 times.
✗ Branch 1 not taken.
8505665 if (lbm_is_cons_rw(c)) {
1032 8505665 lbm_cons_t *cell = lbm_ref_cell(c);
1033 8505665 cell->car = car_val;
1034 8505665 cell->cdr = cdr_val;
1035 8505665 r = 1;
1036 }
1037 8505665 return r;
1038 }
1039
1040 /* calculate length of a proper list */
1041 1252766 lbm_uint lbm_list_length(lbm_value c) {
1042 1252766 lbm_uint len = 0;
1043
1044
2/2
✓ Branch 0 taken 5969833 times.
✓ Branch 1 taken 1252766 times.
7222599 while (lbm_is_cons(c)){
1045 5969833 len ++;
1046 5969833 c = lbm_cdr(c);
1047 }
1048 1252766 return len;
1049 }
1050
1051 11316 lbm_value lbm_list_destructive_reverse(lbm_value list) {
1052
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 11316 times.
11316 if (lbm_type_of(list) == LBM_TYPE_SYMBOL) {
1053 return list;
1054 }
1055 11316 lbm_value curr = list;
1056 11316 lbm_value last_cell = ENC_SYM_NIL;
1057
1058
2/2
✓ Branch 0 taken 29165 times.
✓ Branch 1 taken 11316 times.
40481 while (lbm_is_cons_rw(curr)) {
1059 29165 lbm_value next = lbm_cdr(curr);
1060 29165 lbm_set_cdr(curr, last_cell);
1061 29165 last_cell = curr;
1062 29165 curr = next;
1063 }
1064 11316 return last_cell;
1065 }
1066
1067
1068 330340 lbm_value lbm_list_copy(int *m, lbm_value list) {
1069 330340 lbm_value curr = list;
1070 330340 lbm_uint n = lbm_list_length(list);
1071 330340 lbm_uint copy_n = n;
1072
4/4
✓ Branch 0 taken 6174 times.
✓ Branch 1 taken 324166 times.
✓ Branch 2 taken 5414 times.
✓ Branch 3 taken 760 times.
330340 if (*m >= 0 && (lbm_uint)*m < n) {
1073 5414 copy_n = (lbm_uint)*m;
1074
2/2
✓ Branch 0 taken 295762 times.
✓ Branch 1 taken 29164 times.
324926 } else if (*m == -1) {
1075 295762 *m = (int)n; // TODO: smaller range in target variable.
1076 }
1077
2/2
✓ Branch 0 taken 231 times.
✓ Branch 1 taken 330109 times.
330340 if (copy_n == 0) return ENC_SYM_NIL;
1078 330109 lbm_uint new_list = lbm_heap_allocate_list(copy_n);
1079
2/2
✓ Branch 0 taken 610 times.
✓ Branch 1 taken 329499 times.
330109 if (lbm_is_symbol(new_list)) return new_list;
1080 329499 lbm_value curr_targ = new_list;
1081
1082
4/4
✓ Branch 0 taken 3766461 times.
✓ Branch 1 taken 324159 times.
✓ Branch 2 taken 3761121 times.
✓ Branch 3 taken 5340 times.
4090620 while (lbm_is_cons(curr) && copy_n > 0) {
1083 3761121 lbm_value v = lbm_car(curr);
1084 3761121 lbm_set_car(curr_targ, v);
1085 3761121 curr_targ = lbm_cdr(curr_targ);
1086 3761121 curr = lbm_cdr(curr);
1087 3761121 copy_n --;
1088 }
1089
1090 329499 return new_list;
1091 }
1092
1093 // Append for proper lists only
1094 // Destructive update of list1.
1095 24178 lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
1096
1097
2/4
✓ Branch 0 taken 24178 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 24178 times.
✗ Branch 3 not taken.
48356 if(lbm_is_list_rw(list1) &&
1098 24178 lbm_is_list(list2)) {
1099
1100 24178 lbm_value curr = list1;
1101
2/2
✓ Branch 0 taken 31645 times.
✓ Branch 1 taken 24178 times.
55823 while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) {
1102 31645 curr = lbm_cdr(curr);
1103 }
1104
2/2
✓ Branch 0 taken 30 times.
✓ Branch 1 taken 24148 times.
24178 if (lbm_is_symbol_nil(curr)) return list2;
1105 24148 lbm_set_cdr(curr, list2);
1106 24148 return list1;
1107 }
1108 return ENC_SYM_EERROR;
1109 }
1110
1111 84 lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
1112 84 lbm_value curr = ls;
1113
4/4
✓ Branch 0 taken 728 times.
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 700 times.
✓ Branch 3 taken 28 times.
784 while (lbm_type_of_functional(curr) == LBM_TYPE_CONS &&
1114 n > 0) {
1115 700 curr = lbm_cdr(curr);
1116 700 n --;
1117 }
1118 84 return curr;
1119 }
1120
1121 184800 lbm_value lbm_index_list(lbm_value l, int32_t n) {
1122 184800 lbm_value curr = l;
1123
1124
2/2
✓ Branch 0 taken 113 times.
✓ Branch 1 taken 184687 times.
184800 if (n < 0) {
1125 113 int32_t len = (int32_t)lbm_list_length(l);
1126 113 n = len + n;
1127
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 113 times.
113 if (n < 0) return ENC_SYM_NIL;
1128 }
1129
1130
4/4
✓ Branch 0 taken 280638 times.
✓ Branch 1 taken 30 times.
✓ Branch 2 taken 95868 times.
✓ Branch 3 taken 184770 times.
280668 while (lbm_is_cons(curr) &&
1131 n > 0) {
1132 95868 curr = lbm_cdr(curr);
1133 95868 n --;
1134 }
1135
2/2
✓ Branch 0 taken 184770 times.
✓ Branch 1 taken 30 times.
184800 if (lbm_is_cons(curr)) {
1136 184770 return lbm_car(curr);
1137 } else {
1138 30 return ENC_SYM_NIL;
1139 }
1140 }
1141
1142 // High-level arrays are just bytearrays but with a different tag and pointer type.
1143 // These arrays will be inspected by GC and the elements of the array will be marked.
1144
1145 // Arrays are part of the heap module because their lifespan is managed
1146 // by the garbage collector. The data in the array is not stored
1147 // in the "heap of cons cells".
1148 590615 int lbm_heap_allocate_array_base(lbm_value *res, bool byte_array, lbm_uint size){
1149
1150 590615 lbm_uint tag = ENC_SYM_ARRAY_TYPE;
1151 590615 lbm_uint type = LBM_TYPE_ARRAY;
1152 590615 lbm_array_header_t *array = NULL;
1153 590615 lbm_array_header_extended_t *ext_array = NULL;
1154
1155
2/2
✓ Branch 0 taken 307919 times.
✓ Branch 1 taken 282696 times.
590615 if (byte_array) {
1156 307919 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1157 } else {
1158 282696 tag = ENC_SYM_LISPARRAY_TYPE;
1159 282696 type = LBM_TYPE_LISPARRAY;
1160 282696 size = sizeof(lbm_value) * size;
1161 282696 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
1162 282696 ext_array = (lbm_array_header_extended_t*)array;
1163 }
1164
2/2
✓ Branch 0 taken 589714 times.
✓ Branch 1 taken 901 times.
590615 if (array) {
1165
2/2
✓ Branch 0 taken 281836 times.
✓ Branch 1 taken 307878 times.
589714 if (!byte_array) ext_array->index = 0;
1166
1167 589714 array->data = NULL;
1168 589714 array->size = size;
1169
2/2
✓ Branch 0 taken 589562 times.
✓ Branch 1 taken 152 times.
589714 if ( size > 0) {
1170 589562 array->data = (lbm_uint*)lbm_malloc(size);
1171
2/2
✓ Branch 0 taken 5752 times.
✓ Branch 1 taken 583810 times.
589562 if (array->data == NULL) {
1172 5752 lbm_memory_free((lbm_uint*)array);
1173 5752 goto allocate_array_merror;
1174 }
1175 // It is more important to zero out high-level arrays.
1176 // 0 is symbol NIL which is perfectly safe for the GC to inspect.
1177 583810 memset(array->data, 0, size);
1178 }
1179 // allocating a cell for array's heap-presence
1180 583962 lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);
1181
2/2
✓ Branch 0 taken 351 times.
✓ Branch 1 taken 583611 times.
583962 if (cell == ENC_SYM_MERROR) {
1182 351 lbm_memory_free((lbm_uint*)array->data);
1183 351 lbm_memory_free((lbm_uint*)array);
1184 351 goto allocate_array_merror;
1185 }
1186 583611 *res = cell;
1187 583611 lbm_heap_state.num_alloc_arrays ++;
1188 583611 return 1;
1189 }
1190 901 allocate_array_merror:
1191 7004 *res = ENC_SYM_MERROR;
1192 7004 return 0;
1193 }
1194
1195 307919 int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
1196 307919 return lbm_heap_allocate_array_base(res, true, size);
1197 }
1198
1199 282696 int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
1200 282696 return lbm_heap_allocate_array_base(res, false, size);
1201 }
1202
1203 1126 int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
1204
1205 1126 lbm_array_header_t *array = NULL;
1206 1126 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, ENC_SYM_ARRAY_TYPE);
1207
1208
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1126 times.
1126 if (cell == ENC_SYM_MERROR) {
1209 *value = cell;
1210 return 0;
1211 }
1212
1213 1126 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1214
1215
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1126 times.
1126 if (array == NULL) {
1216 lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL);
1217 *value = ENC_SYM_MERROR;
1218 return 0;
1219 }
1220
1221 1126 array->data = (lbm_uint*)data;
1222 1126 array->size = num_elt;
1223
1224 1126 lbm_set_car(cell, (lbm_uint)array);
1225
1226 1126 cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY);
1227 1126 *value = cell;
1228 1126 return 1;
1229 }
1230
1231 237774 lbm_int lbm_heap_array_get_size(lbm_value arr) {
1232
1233 237774 lbm_int r = -1;
1234 237774 lbm_array_header_t *header = lbm_dec_array_r(arr);
1235
1/2
✓ Branch 0 taken 237774 times.
✗ Branch 1 not taken.
237774 if (header) {
1236 237774 r = (lbm_int)header->size;
1237 }
1238 237774 return r;
1239 }
1240
1241 119050 const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
1242 119050 uint8_t *r = NULL;
1243 119050 lbm_array_header_t *header = lbm_dec_array_r(arr);
1244
1/2
✓ Branch 0 taken 119050 times.
✗ Branch 1 not taken.
119050 if (header) {
1245 119050 r = (uint8_t*)header->data;
1246 }
1247 119050 return r;
1248 }
1249
1250 /* Explicitly freeing an array.
1251
1252 This is a highly unsafe operation and can only be safely
1253 used if the heap cell that points to the array has not been made
1254 accessible to the program.
1255
1256 So This function can be used to free an array in case an array
1257 is being constructed and some error case appears while doing so
1258 If the array still have not become available it can safely be
1259 "explicitly" freed.
1260
1261 The problem is that if the "array" heap-cell is made available to
1262 the program, this cell can easily be duplicated and we would have
1263 to search the entire heap to find all cells pointing to the array
1264 memory in question and "null"-them out before freeing the memory
1265 */
1266
1267 112 int lbm_heap_explicit_free_array(lbm_value arr) {
1268
1269 112 int r = 0;
1270
2/4
✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 112 times.
✗ Branch 3 not taken.
112 if (lbm_is_array_rw(arr) && lbm_cdr(arr) == ENC_SYM_ARRAY_TYPE) {
1271 112 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1272
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
112 if (header == NULL) {
1273 return 0;
1274 }
1275 112 lbm_memory_free((lbm_uint*)header->data);
1276 112 lbm_memory_free((lbm_uint*)header);
1277
1278 112 arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS);
1279 112 lbm_set_car(arr, ENC_SYM_NIL);
1280 112 lbm_set_cdr(arr, ENC_SYM_NIL);
1281 112 r = 1;
1282 }
1283
1284 112 return r;
1285 }
1286
1287 static bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
1288 (void)ix;
1289 (void)val;
1290 return false;
1291 }
1292
1293 static const_heap_write_fun const_heap_write = dummy_flash_write;
1294
1295 22390 int lbm_const_heap_init(const_heap_write_fun w_fun,
1296 lbm_const_heap_t *heap,
1297 lbm_uint *addr) {
1298
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
22390 if (((uintptr_t)addr % 4) != 0) return 0;
1299
1300
1/2
✓ Branch 0 taken 22390 times.
✗ Branch 1 not taken.
22390 if (!lbm_const_heap_mutex_initialized) {
1301 22390 lbm_mutex_init(&lbm_const_heap_mutex);
1302 22390 lbm_const_heap_mutex_initialized = true;
1303 }
1304
1305
1/2
✓ Branch 0 taken 22390 times.
✗ Branch 1 not taken.
22390 if (!lbm_mark_mutex_initialized) {
1306 22390 lbm_mutex_init(&lbm_mark_mutex);
1307 22390 lbm_mark_mutex_initialized = true;
1308 }
1309
1310 22390 const_heap_write = w_fun;
1311
1312 22390 heap->heap = addr;
1313 22390 heap->size = 0;
1314 22390 heap->next = 0;
1315
1316 22390 lbm_const_heap_state = heap;
1317 // ref_cell views the lbm_uint array as an lbm_cons_t array
1318 22390 lbm_heaps[1] = (lbm_cons_t*)addr;
1319 22390 return 1;
1320 }
1321
1322 2891 lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
1323 2891 lbm_flash_status r = LBM_FLASH_FULL;
1324
1325 2891 lbm_mutex_lock(&lbm_const_heap_mutex);
1326 // waste a cell if we have ended up unaligned after writing an array to flash.
1327
2/2
✓ Branch 0 taken 163 times.
✓ Branch 1 taken 2728 times.
2891 if (lbm_const_heap_state->next % 2 == 1) {
1328 163 lbm_const_heap_state->next++;
1329 }
1330
1331
1/2
✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
2891 if (lbm_const_heap_state &&
1332
1/2
✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
2891 (lbm_const_heap_state->next+1) < (uint32_t)lbm_image_get_write_index()) {
1333 // A cons cell uses two words.
1334 2891 lbm_value cell = lbm_const_heap_state->next;
1335 2891 lbm_const_heap_state->next += 2;
1336 2891 *res = (cell << LBM_ADDRESS_SHIFT) | LBM_PTR_BIT | LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT;
1337 2891 r = LBM_FLASH_WRITE_OK;
1338 }
1339 2891 lbm_mutex_unlock(&lbm_const_heap_mutex);
1340 2891 return r;
1341 }
1342
1343 28 lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) {
1344 28 lbm_flash_status r = LBM_FLASH_FULL;
1345
1346
1/2
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
28 if (lbm_const_heap_state &&
1347
1/2
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
28 (lbm_const_heap_state->next + nwords) < (uint32_t)lbm_image_get_write_index()) {
1348 28 lbm_uint ix = lbm_const_heap_state->next;
1349 28 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1350 28 lbm_const_heap_state->next += nwords;
1351 28 r = LBM_FLASH_WRITE_OK;
1352 }
1353 28 return r;
1354 }
1355
1356 195045 lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {
1357
1358 195045 lbm_flash_status r = LBM_FLASH_FULL;
1359
1360
1/2
✓ Branch 0 taken 195045 times.
✗ Branch 1 not taken.
195045 if (lbm_const_heap_state &&
1361
1/2
✓ Branch 0 taken 195045 times.
✗ Branch 1 not taken.
195045 (lbm_const_heap_state->next + n) < (uint32_t)lbm_image_get_write_index()) {
1362 195045 lbm_uint ix = lbm_const_heap_state->next;
1363
1364
2/2
✓ Branch 0 taken 218971 times.
✓ Branch 1 taken 195045 times.
414016 for (unsigned int i = 0; i < n; i ++) {
1365
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 218971 times.
218971 if (!const_heap_write(((lbm_uint*)data)[i],ix + i))
1366 return LBM_FLASH_WRITE_ERROR;
1367 }
1368 195045 lbm_const_heap_state->next += n;
1369 195045 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1370 195045 r = LBM_FLASH_WRITE_OK;
1371 }
1372 195045 return r;
1373 }
1374
1375 84 lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) {
1376
1377
1/2
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
84 if (lbm_const_heap_state) {
1378 84 lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap;
1379 84 lbm_uint ix = (((lbm_uint)tgt - flash) / sizeof(lbm_uint)); // byte address to ix
1380
1/2
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
84 if (const_heap_write(val, ix)) {
1381 84 return LBM_FLASH_WRITE_OK;
1382 }
1383 return LBM_FLASH_WRITE_ERROR;
1384 }
1385 return LBM_FLASH_FULL;
1386 }
1387
1388 2891 lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
1389 2891 lbm_uint addr = lbm_dec_ptr(cell);
1390
1/2
✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
2891 if (const_heap_write(val, addr+1))
1391 2891 return LBM_FLASH_WRITE_OK;
1392 return LBM_FLASH_WRITE_ERROR;
1393 }
1394
1395 2891 lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
1396 2891 lbm_uint addr = lbm_dec_ptr(cell);
1397
1/2
✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
2891 if (const_heap_write(val, addr))
1398 2891 return LBM_FLASH_WRITE_OK;
1399 return LBM_FLASH_WRITE_ERROR;
1400 }
1401
1402 lbm_uint lbm_flash_memory_usage(void) {
1403 return lbm_const_heap_state->next;
1404 }
1405
1406
1407 // ////////////////////////////////////////////////////////////
1408 // pointer reversal traversal
1409 //
1410 // Caveats:
1411 // * Structures on the constant heap cannot be traversed using
1412 // pointer reversal. If a dynamic structure is pointing into the
1413 // constant heap, the 'f' will be applied to the constant cons cell on
1414 // the border and then traversal will retreat.
1415 //
1416 // * It may be impossible to detect all kinds of cycles
1417 // if attempting to use and restore the GC in a single pass
1418 // over the tree. To detect cycles all visited nodes must
1419 // remain detectable when traversing all branches!
1420 //
1421 // * Potential fix is to run GC after a complete traversal of the
1422 // entire value in order to restore the GC bits.
1423 //
1424 // * If we leave GC bits set when traversing values, we can use this
1425 // to detect cycles that happen in multiple steps accross values
1426 // in the environment.
1427 //
1428 // * lbm_ptr_rev_trav with the "do_nothing" travfun is the same thing
1429 // as a GC mark phase! Maybe utilize this for code-size
1430 // purposes. This also increases the amount of testing the
1431 // ptr_rev_trav function is subjected to.
1432
1433 945 void lbm_ptr_rev_trav(trav_fun f, lbm_value v, void* arg) {
1434
1435 945 lbm_value curr = v;
1436 945 lbm_value prev = lbm_enc_cons_ptr(LBM_PTR_NULL);
1437 while (true) {
1438
1439 // Run leftwards and process conses until
1440 // hitting a leaf in the left direction.
1441
1442 // If curr is marked here there is a cycle in the graph.
1443 // In case of a cycle or leaf, this first loop is exited.
1444
2/2
✓ Branch 0 taken 75 times.
✓ Branch 1 taken 24462 times.
72555 while (((lbm_is_cons_rw(curr)) ||
1445
4/4
✓ Branch 0 taken 24537 times.
✓ Branch 1 taken 23481 times.
✓ Branch 2 taken 23428 times.
✓ Branch 3 taken 128 times.
48093 (lbm_is_lisp_array_rw(curr))) && !gc_marked(curr)) {
1446 23428 lbm_cons_t *cell = lbm_ref_cell(curr);
1447
2/2
✓ Branch 0 taken 23368 times.
✓ Branch 1 taken 60 times.
23428 if (lbm_is_cons(curr)) {
1448 // In-order traversal
1449
2/2
✓ Branch 0 taken 76 times.
✓ Branch 1 taken 23292 times.
23368 if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) {
1450 76 lbm_gc_mark_phase(curr);
1451 76 goto trav_backtrack;
1452 }
1453 23292 gc_mark(curr);
1454
1455 23292 lbm_value next = 0;
1456 23292 value_assign(&next, cell->car);
1457 23292 value_assign(&cell->car, prev);
1458 23292 value_assign(&prev, curr);
1459 23292 value_assign(&curr, next);
1460 } else { // it is an array
1461
1462 60 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1463 60 lbm_value *arr_data = (lbm_value *)arr->data;
1464 60 uint32_t index = arr->index;
1465
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 54 times.
60 if (arr->size == 0) break;
1466
1/2
✓ Branch 0 taken 54 times.
✗ Branch 1 not taken.
54 if (index == 0) { // index should only be 0 or there is a potential cycle
1467
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
54 if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) {
1468 lbm_gc_mark_phase(curr);
1469 break;
1470 }
1471 54 arr->index = 1;
1472 54 gc_mark(curr);
1473
1474 54 lbm_value next = 0;
1475 54 value_assign(&next, arr_data[0]);
1476 54 value_assign(&arr_data[0], prev);
1477 54 value_assign(&prev, curr);
1478 54 value_assign(&curr, next);
1479 }
1480 }
1481 }
1482 // Currently there are a few different users of this traversal.
1483 // size, flatten and detect_sharing.
1484 // detect_sharing make use of the shared (true) argument in f(curr, true, arg)
1485 // while the other do not. detect_sharing also assumes it is run once per env item
1486 // while not resetting any GC-bits in between. This detects global sharing.
1487
1488
4/4
✓ Branch 0 taken 866 times.
✓ Branch 1 taken 23730 times.
✓ Branch 2 taken 128 times.
✓ Branch 3 taken 738 times.
24596 if (lbm_is_ptr(curr) && gc_marked(curr)) {
1489 // gc bit set so this subtree is already traversed.
1490 // f is called with true to indicate visited node.
1491 // if this happens during a sharing discovery phase, curr will be added to sharing table.
1492 128 f(curr, true, arg);
1493 // In this case f should not be able to return subtree continue.
1494 // The only correct return value from f is PROCEED.
1495
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 24465 times.
24468 } else if (!lbm_is_cons(curr) || // Found a leaf
1496
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
3 (curr & LBM_PTR_TO_CONSTANT_BIT)) {
1497
4/4
✓ Branch 0 taken 738 times.
✓ Branch 1 taken 23730 times.
✓ Branch 2 taken 735 times.
✓ Branch 3 taken 3 times.
24468 if (lbm_is_ptr(curr) && !(curr & LBM_PTR_TO_CONSTANT_BIT)) gc_mark(curr); // Mark it so that the mandatory GC does not swipe it.
1498 24468 f(curr, false, arg);
1499 }
1500
1501 // Now either prev has the "flag" set or it doesnt.
1502 // If the flag is set that means that the prev node
1503 // have had both its car and cdr visited. So that node is done!
1504 //
1505 // If the flag is not set, jump down to SWAP
1506
1507 trav_backtrack:
1508
2/2
✓ Branch 0 taken 46584 times.
✓ Branch 1 taken 945 times.
95547 while ((lbm_is_cons(prev) &&
1509
2/2
✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 23292 times.
94113 (lbm_dec_ptr(prev) != LBM_PTR_NULL) && // is LBM_NULL a cons type?
1510
4/4
✓ Branch 0 taken 47529 times.
✓ Branch 1 taken 489 times.
✓ Branch 2 taken 489 times.
✓ Branch 3 taken 24237 times.
119328 lbm_get_gc_flag(lbm_car(prev))) ||
1511 24726 lbm_is_lisp_array_rw(prev)) {
1512 23781 lbm_cons_t *cell = lbm_ref_cell(prev);
1513
2/2
✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 489 times.
23781 if (lbm_is_cons(prev)) {
1514
1515 // clear the flag
1516 // This means that we are done with a "CDR" child.
1517 // prev = [ a , b ][flag = 1]
1518 // =>
1519 // prev = [ a , b ][flag = 0]
1520
1521 //gc_clear_mark(prev);
1522 23292 cell->car = lbm_clr_gc_flag(cell->car);
1523 // Move on downwards until
1524 // finding a cons cell without flag or NULL
1525
1526 // curr = c
1527 // prev = [ a , b ][flag = 0]
1528 // =>
1529 // prev = [ a , c ][flag = 0]
1530 // curr = prev
1531 // prev = b
1532
1533 23292 lbm_value next = 0;
1534 23292 value_assign(&next, cell->cdr);
1535 23292 value_assign(&cell->cdr, curr);
1536 23292 value_assign(&curr, prev);
1537 23292 value_assign(&prev, next);
1538 } else { // is an array
1539 489 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1540 489 lbm_value *arr_data = (lbm_value *)arr->data;
1541 489 size_t arr_size = (size_t)arr->size / sizeof(lbm_value);
1542 489 lbm_value next = 0;
1543
2/2
✓ Branch 0 taken 54 times.
✓ Branch 1 taken 435 times.
489 if (arr->index == arr_size) {
1544 54 value_assign(&next, arr_data[arr->index-1]);
1545 54 value_assign(&arr_data[arr->index-1], curr);
1546 54 value_assign(&curr, prev);
1547 54 value_assign(&prev, next);
1548 54 arr->index = 0;
1549 } else {
1550 435 break;
1551 }
1552 }
1553 }
1554
1555 // SWAP
1556
1557 // if the prev node is NULL we have traced backwards all the
1558 // way back to where curr == v. Another alternative is that
1559 // the input v was an Atom. We are done!
1560
3/4
✓ Branch 0 taken 24672 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 945 times.
✓ Branch 3 taken 23727 times.
49344 if (lbm_is_ptr(prev) &&
1561 24672 lbm_dec_ptr(prev) == LBM_PTR_NULL) {
1562 945 if (lbm_is_cons(curr)) {
1563 //gc_clear_mark(curr);
1564 }
1565 //done = true;
1566 945 break;
1567 }
1568
1569 // if the prev node is not NULL then we should move
1570 // down to the prev node and start process its remaining child.
1571
2/2
✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 435 times.
23727 else if (lbm_is_cons(prev)) {
1572
1573 23292 lbm_cons_t *cell = lbm_ref_cell(prev);
1574 23292 lbm_value next = 0;
1575
1576
1577 // prev = [ p , cdr ][flag = 0]
1578 // =>
1579 // prev = [ p , cdr ][flag = 1]
1580
1581 23292 cell->car = lbm_set_gc_flag(cell->car);
1582
1583 // switch to processing the cdr field and set the flag.
1584 // curr = c
1585 // prev = [ a, b ][flag = 1]
1586 // =>
1587 // prev = [ c, a ][flag = 1]
1588 // curr = b
1589
1590 23292 value_assign(&next, cell->car);
1591 23292 value_assign(&cell->car, curr);
1592 23292 value_assign(&curr, cell->cdr);
1593 23292 value_assign(&cell->cdr, next);
1594
1/2
✓ Branch 0 taken 435 times.
✗ Branch 1 not taken.
435 } else if (lbm_is_lisp_array_rw(prev)) {
1595 435 lbm_cons_t *cell = lbm_ref_cell(prev);
1596 435 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1597 435 lbm_value *arr_data = (lbm_value *)arr->data;
1598 435 lbm_value next = 0;
1599
1600 435 value_assign(&next, arr_data[arr->index-1]);
1601 435 value_assign(&arr_data[arr->index-1], curr);
1602 435 value_assign(&curr, arr_data[arr->index]);
1603 435 value_assign(&arr_data[arr->index], next);
1604 435 arr->index = arr->index + 1;
1605 }
1606 }
1607 945 }
1608