GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/heap.c
Date: 2025-10-28 15:15:18
Exec Total Coverage
Lines: 847 870 97.4%
Functions: 87 88 98.9%
Branches: 322 376 85.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 176027064 static inline lbm_value lbm_set_gc_mark(lbm_value x) {
40 176027064 return x | LBM_GC_MARKED;
41 }
42 175431163 static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
43 175431163 return x & ~LBM_GC_MASK;
44 }
45
46 3993586924 static inline bool lbm_get_gc_mark(lbm_value x) {
47 3993586924 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 4 void lbm_gc_lock(void) {
102 4 }
103 4 void lbm_gc_unlock(void) {
104 4 }
105 #endif
106
107 /****************************************************/
108 /* ENCODERS DECODERS */
109
110 8510916 lbm_value lbm_enc_i32(int32_t x) {
111 #ifndef LBM64
112 5675926 lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE);
113
2/2
✓ Branch 0 taken 1236 times.
✓ Branch 1 taken 5674690 times.
 5675926 if (lbm_type_of(i) == LBM_TYPE_SYMBOL) return i;
114 5674690 return lbm_set_ptr_type(i, LBM_TYPE_I32);
115 #else
116 2834990 return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_I32;
117 #endif
118 }
119
120 10204899 lbm_value lbm_enc_u32(uint32_t x) {
121 #ifndef LBM64
122 7366691 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE);
123
2/2
✓ Branch 0 taken 2176 times.
✓ Branch 1 taken 7364515 times.
 7366691 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
124 7364515 return lbm_set_ptr_type(u, LBM_TYPE_U32);
125 #else
126 2838208 return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_U32;
127 #endif
128 }
129
130 689407151 lbm_value lbm_enc_float(float x) {
131 #ifndef LBM64
132 lbm_uint t;
133 459788027 memcpy(&t, &x, sizeof(lbm_float));
134 459788027 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE);
135
2/2
✓ Branch 0 taken 294488 times.
✓ Branch 1 taken 459493539 times.
 459788027 if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
136 459493539 return lbm_set_ptr_type(f, LBM_TYPE_FLOAT);
137 #else
138 229619124 lbm_uint t = 0;
139 229619124 memcpy(&t, &x, sizeof(float));
140 229619124 return (((lbm_uint)t) << LBM_VAL_SHIFT) | LBM_TYPE_FLOAT;
141 #endif
142 }
143
144 #ifndef LBM64
145 16858427 static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) {
146 16858427 lbm_value res = lbm_cons(ENC_SYM_NIL,ENC_SYM_NIL);
147
2/2
✓ Branch 0 taken 16854055 times.
✓ Branch 1 taken 4372 times.
 16858427 if (lbm_type_of(res) != LBM_TYPE_SYMBOL) {
148 16854055 uint8_t* storage = lbm_malloc(sizeof(uint64_t));
149
2/2
✓ Branch 0 taken 16848799 times.
✓ Branch 1 taken 5256 times.
 16854055 if (storage) {
150 16848799 memcpy(storage,source, sizeof(uint64_t));
151 16848799 lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual);
152 16848799 res = lbm_set_ptr_type(res, type);
153 } else {
154 5256 res = ENC_SYM_MERROR;
155 }
156 }
157 16858427 return res;
158 }
159 #endif
160
161 13473934 lbm_value lbm_enc_i64(int64_t x) {
162 #ifndef LBM64
163 8984550 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE, LBM_TYPE_I64);
164 #else
165 4489384 lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE);
166
2/2
✓ Branch 0 taken 1232 times.
✓ Branch 1 taken 4488152 times.
 4489384 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
167 4488152 return lbm_set_ptr_type(u, LBM_TYPE_I64);
168 #endif
169 }
170
171 10111156 lbm_value lbm_enc_u64(uint64_t x) {
172 #ifndef LBM64
173 6742408 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE, LBM_TYPE_U64);
174 #else
175 3368748 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE);
176
2/2
✓ Branch 0 taken 876 times.
✓ Branch 1 taken 3367872 times.
 3368748 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
177 3367872 return lbm_set_ptr_type(u, LBM_TYPE_U64);
178 #endif
179 }
180
181 1697037 lbm_value lbm_enc_double(double x) {
182 #ifndef LBM64
183 1131469 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE, LBM_TYPE_DOUBLE);
184 #else
185 lbm_uint t;
186 565568 memcpy(&t, &x, sizeof(double));
187 565568 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE);
188
2/2
✓ Branch 0 taken 332 times.
✓ Branch 1 taken 565236 times.
 565568 if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
189 565236 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 1000359328 float lbm_dec_float(lbm_value x) {
198 #ifndef LBM64
199 float f_tmp;
200 667125325 lbm_uint tmp = lbm_car(x);
201 667125325 memcpy(&f_tmp, &tmp, sizeof(float));
202 667125325 return f_tmp;
203 #else
204 333234003 uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT);
205 float f_tmp;
206 333234003 memcpy(&f_tmp, &tmp, sizeof(float));
207 333234003 return f_tmp;
208 #endif
209 }
210
211 1694301 double lbm_dec_double(lbm_value x) {
212 #ifndef LBM64
213 1129657 double d = 0.0;
214
1/2
✓ Branch 0 taken 1129657 times.
✗ Branch 1 not taken.
 1129657 if (lbm_is_ptr(x)) {
215 1129657 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
216 1129657 memcpy(&d, data, sizeof(double));
217 }
218 1129657 return d;
219 #else
220 double f_tmp;
221 564644 lbm_uint tmp = lbm_car(x);
222 564644 memcpy(&f_tmp, &tmp, sizeof(double));
223 564644 return f_tmp;
224 #endif
225 }
226
227 21037317 uint64_t lbm_dec_u64(lbm_value x) {
228 #ifndef LBM64
229 14027529 uint64_t u = 0;
230
1/2
✓ Branch 0 taken 14027529 times.
✗ Branch 1 not taken.
 14027529 if (lbm_is_ptr(x)) {
231 14027529 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
232 14027529 memcpy(&u, data, 8);
233 }
234 14027529 return u;
235 #else
236 7009788 return (uint64_t)lbm_car(x);
237 #endif
238 }
239
240 27758844 int64_t lbm_dec_i64(lbm_value x) {
241 #ifndef LBM64
242 18508840 int64_t i = 0;
243
1/2
✓ Branch 0 taken 18508840 times.
✗ Branch 1 not taken.
 18508840 if (lbm_is_ptr(x)) {
244 18508840 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
245 18508840 memcpy(&i, data, 8);
246 }
247 18508840 return i;
248 #else
249 9250004 return (int64_t)lbm_car(x);
250 #endif
251 }
252
253 2382400 char *lbm_dec_str(lbm_value val) {
254 2382400 char *res = 0;
255
2/2
✓ Branch 0 taken 2381972 times.
✓ Branch 1 taken 428 times.
 2382400 if (lbm_is_array_r(val)) {
256 2381972 lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
257
1/2
✓ Branch 0 taken 2381972 times.
✗ Branch 1 not taken.
 2381972 if (array) {
258 2381972 res = (char *)array->data;
259 }
260 }
261 2382400 return res;
262 }
263
264 1803673 lbm_array_header_t *lbm_dec_array_r(lbm_value val) {
265 1803673 lbm_array_header_t *array = NULL;
266
2/2
✓ Branch 0 taken 1799598 times.
✓ Branch 1 taken 4075 times.
 1803673 if (lbm_is_array_r(val)) {
267 1799598 array = (lbm_array_header_t *)lbm_car(val);
268 }
269 1803673 return array;
270 }
271
272 178684 lbm_array_header_t *lbm_dec_array_rw(lbm_value val) {
273 178684 lbm_array_header_t *array = NULL;
274
2/2
✓ Branch 0 taken 178430 times.
✓ Branch 1 taken 254 times.
 178684 if (lbm_is_array_rw(val)) {
275 178430 array = (lbm_array_header_t *)lbm_car(val);
276 }
277 178684 return array;
278 }
279
280 35179217 lbm_char_channel_t *lbm_dec_channel(lbm_value val) {
281 35179217 lbm_char_channel_t *res = NULL;
282
283
1/2
✓ Branch 0 taken 35179217 times.
✗ Branch 1 not taken.
 35179217 if (lbm_type_of(val) == LBM_TYPE_CHANNEL) {
284 35179217 res = (lbm_char_channel_t *)lbm_car(val);
285 }
286 35179217 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 182870 uint8_t lbm_dec_as_char(lbm_value a) {
298 182870 uint8_t r = 0;
299
10/10
✓ Branch 0 taken 182159 times.
✓ Branch 1 taken 108 times.
✓ Branch 2 taken 86 times.
✓ Branch 3 taken 85 times.
✓ Branch 4 taken 85 times.
✓ Branch 5 taken 85 times.
✓ Branch 6 taken 85 times.
✓ Branch 7 taken 85 times.
✓ Branch 8 taken 85 times.
✓ Branch 9 taken 7 times.
 182870 switch (lbm_type_of_functional(a)) {
300 182159 case LBM_TYPE_CHAR:
301 182159 r = (uint8_t)lbm_dec_char(a); break;
302 108 case LBM_TYPE_I:
303 108 r = (uint8_t)lbm_dec_i(a); break;
304 86 case LBM_TYPE_U:
305 86 r = (uint8_t)lbm_dec_u(a); break;
306 85 case LBM_TYPE_I32:
307 85 r = (uint8_t)lbm_dec_i32(a); break;
308 85 case LBM_TYPE_U32:
309 85 r = (uint8_t)lbm_dec_u32(a); break;
310 85 case LBM_TYPE_FLOAT:
311 85 r = (uint8_t)lbm_dec_float(a); break;
312 85 case LBM_TYPE_I64:
313 85 r = (uint8_t)lbm_dec_i64(a); break;
314 85 case LBM_TYPE_U64:
315 85 r = (uint8_t)lbm_dec_u64(a); break;
316 85 case LBM_TYPE_DOUBLE:
317 85 r = (uint8_t) lbm_dec_double(a); break;
318 }
319 182870 return r;
320 }
321
322 24311067 uint32_t lbm_dec_as_u32(lbm_value a) {
323 24311067 uint32_t r = 0;
324
9/9
✓ Branch 0 taken 1405424 times.
✓ Branch 1 taken 4176870 times.
✓ Branch 2 taken 5460847 times.
✓ Branch 3 taken 13267408 times.
✓ Branch 4 taken 88 times.
✓ Branch 5 taken 85 times.
✓ Branch 6 taken 253 times.
✓ Branch 7 taken 85 times.
✓ Branch 8 taken 7 times.
 24311067 switch (lbm_type_of_functional(a)) {
325 1405424 case LBM_TYPE_CHAR:
326 1405424 r = (uint32_t)lbm_dec_char(a); break;
327 4176870 case LBM_TYPE_I:
328 4176870 r = (uint32_t)lbm_dec_i(a); break;
329 5460847 case LBM_TYPE_U:
330 5460847 r = (uint32_t)lbm_dec_u(a); break;
331 13267408 case LBM_TYPE_I32: /* fall through */
332 case LBM_TYPE_U32:
333 13267408 r = (uint32_t)lbm_dec_u32(a); break;
334 88 case LBM_TYPE_FLOAT:
335 88 r = (uint32_t)lbm_dec_float(a); break;
336 85 case LBM_TYPE_I64:
337 85 r = (uint32_t)lbm_dec_i64(a); break;
338 253 case LBM_TYPE_U64:
339 253 r = (uint32_t)lbm_dec_u64(a); break;
340 85 case LBM_TYPE_DOUBLE:
341 85 r = (uint32_t)lbm_dec_double(a); break;
342 }
343 24311067 return r;
344 }
345
346 505080864 int32_t lbm_dec_as_i32(lbm_value a) {
347 505080864 int32_t r = 0;
348
10/10
✓ Branch 0 taken 13760140 times.
✓ Branch 1 taken 480279192 times.
✓ Branch 2 taken 24422 times.
✓ Branch 3 taken 11014336 times.
✓ Branch 4 taken 87 times.
✓ Branch 5 taken 85 times.
✓ Branch 6 taken 169 times.
✓ Branch 7 taken 169 times.
✓ Branch 8 taken 85 times.
✓ Branch 9 taken 2179 times.
 505080864 switch (lbm_type_of_functional(a)) {
349 13760140 case LBM_TYPE_CHAR:
350 13760140 r = (int32_t)lbm_dec_char(a); break;
351 480279192 case LBM_TYPE_I:
352 480279192 r = (int32_t)lbm_dec_i(a); break;
353 24422 case LBM_TYPE_U:
354 24422 r = (int32_t)lbm_dec_u(a); break;
355 11014336 case LBM_TYPE_I32:
356 11014336 r = (int32_t)lbm_dec_i32(a); break;
357 87 case LBM_TYPE_U32:
358 87 r = (int32_t)lbm_dec_u32(a); break;
359 85 case LBM_TYPE_FLOAT:
360 85 r = (int32_t)lbm_dec_float(a); break;
361 169 case LBM_TYPE_I64:
362 169 r = (int32_t)lbm_dec_i64(a); break;
363 169 case LBM_TYPE_U64:
364 169 r = (int32_t)lbm_dec_u64(a); break;
365 85 case LBM_TYPE_DOUBLE:
366 85 r = (int32_t) lbm_dec_double(a); break;
367 }
368 505080864 return r;
369 }
370
371 253668700 int64_t lbm_dec_as_i64(lbm_value a) {
372 253668700 int64_t r = 0;
373
10/10
✓ Branch 0 taken 7813529 times.
✓ Branch 1 taken 231559188 times.
✓ Branch 2 taken 506 times.
✓ Branch 3 taken 841 times.
✓ Branch 4 taken 1793 times.
✓ Branch 5 taken 181 times.
✓ Branch 6 taken 14292141 times.
✓ Branch 7 taken 337 times.
✓ Branch 8 taken 169 times.
✓ Branch 9 taken 15 times.
 253668700 switch (lbm_type_of_functional(a)) {
374 7813529 case LBM_TYPE_CHAR:
375 7813529 r = (int64_t)lbm_dec_char(a); break;
376 231559188 case LBM_TYPE_I:
377 231559188 r = (int64_t)lbm_dec_i(a); break;
378 506 case LBM_TYPE_U:
379 506 r = (int64_t)lbm_dec_u(a); break;
380 841 case LBM_TYPE_I32:
381 841 r = (int64_t)lbm_dec_i32(a); break;
382 1793 case LBM_TYPE_U32:
383 1793 r = (int64_t)lbm_dec_u32(a); break;
384 181 case LBM_TYPE_FLOAT:
385 181 r = (int64_t)lbm_dec_float(a); break;
386 14292141 case LBM_TYPE_I64:
387 14292141 r = (int64_t)lbm_dec_i64(a); break;
388 337 case LBM_TYPE_U64:
389 337 r = (int64_t)lbm_dec_u64(a); break;
390 169 case LBM_TYPE_DOUBLE:
391 169 r = (int64_t) lbm_dec_double(a); break;
392 }
393 253668700 return r;
394 }
395
396 13560016 uint64_t lbm_dec_as_u64(lbm_value a) {
397 13560016 uint64_t r = 0;
398
10/10
✓ Branch 0 taken 1687425 times.
✓ Branch 1 taken 918777 times.
✓ Branch 2 taken 19410 times.
✓ Branch 3 taken 673 times.
✓ Branch 4 taken 673 times.
✓ Branch 5 taken 169 times.
✓ Branch 6 taken 505 times.
✓ Branch 7 taken 10932208 times.
✓ Branch 8 taken 169 times.
✓ Branch 9 taken 7 times.
 13560016 switch (lbm_type_of_functional(a)) {
399 1687425 case LBM_TYPE_CHAR:
400 1687425 r = (uint64_t)lbm_dec_char(a); break;
401 918777 case LBM_TYPE_I:
402 918777 r = (uint64_t)lbm_dec_i(a); break;
403 19410 case LBM_TYPE_U:
404 19410 r = (uint64_t)lbm_dec_u(a); break;
405 673 case LBM_TYPE_I32:
406 673 r = (uint64_t)lbm_dec_i32(a); break;
407 673 case LBM_TYPE_U32:
408 673 r = (uint64_t)lbm_dec_u32(a); break;
409 169 case LBM_TYPE_FLOAT:
410 169 r = (uint64_t)lbm_dec_float(a); break;
411 505 case LBM_TYPE_I64:
412 505 r = (uint64_t)lbm_dec_i64(a); break;
413 10932208 case LBM_TYPE_U64:
414 10932208 r = (uint64_t)lbm_dec_u64(a); break;
415 169 case LBM_TYPE_DOUBLE:
416 169 r = (uint64_t)lbm_dec_double(a); break;
417 }
418 13560016 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 1126211493 float lbm_dec_as_float(lbm_value a) {
472 1126211493 float r = 0;
473
10/10
✓ Branch 0 taken 311097780 times.
✓ Branch 1 taken 504152176 times.
✓ Branch 2 taken 478 times.
✓ Branch 3 taken 421 times.
✓ Branch 4 taken 534 times.
✓ Branch 5 taken 310959066 times.
✓ Branch 6 taken 421 times.
✓ Branch 7 taken 421 times.
✓ Branch 8 taken 85 times.
✓ Branch 9 taken 111 times.
 1126211493 switch (lbm_type_of_functional(a)) {
474 311097780 case LBM_TYPE_CHAR:
475 311097780 r = (float)lbm_dec_char(a); break;
476 504152176 case LBM_TYPE_I:
477 504152176 r = (float)lbm_dec_i(a); break;
478 478 case LBM_TYPE_U:
479 478 r = (float)lbm_dec_u(a); break;
480 421 case LBM_TYPE_I32:
481 421 r = (float)lbm_dec_i32(a); break;
482 534 case LBM_TYPE_U32:
483 534 r = (float)lbm_dec_u32(a); break;
484 310959066 case LBM_TYPE_FLOAT:
485 310959066 r = (float)lbm_dec_float(a); break;
486 421 case LBM_TYPE_I64:
487 421 r = (float)lbm_dec_i64(a); break;
488 421 case LBM_TYPE_U64:
489 421 r = (float)lbm_dec_u64(a); break;
490 85 case LBM_TYPE_DOUBLE:
491 85 r = (float)lbm_dec_double(a); break;
492 }
493 1126211493 return r;
494 }
495
496 1691793 double lbm_dec_as_double(lbm_value a) {
497 1691793 double r = 0;
498
10/10
✓ Branch 0 taken 843314 times.
✓ Branch 1 taken 841919 times.
✓ Branch 2 taken 422 times.
✓ Branch 3 taken 421 times.
✓ Branch 4 taken 421 times.
✓ Branch 5 taken 1115 times.
✓ Branch 6 taken 421 times.
✓ Branch 7 taken 421 times.
✓ Branch 8 taken 3332 times.
✓ Branch 9 taken 7 times.
 1691793 switch (lbm_type_of_functional(a)) {
499 843314 case LBM_TYPE_CHAR:
500 843314 r = (double)lbm_dec_char(a); break;
501 841919 case LBM_TYPE_I:
502 841919 r = (double)lbm_dec_i(a); break;
503 422 case LBM_TYPE_U:
504 422 r = (double)lbm_dec_u(a); break;
505 421 case LBM_TYPE_I32:
506 421 r = (double)lbm_dec_i32(a); break;
507 421 case LBM_TYPE_U32:
508 421 r = (double)lbm_dec_u32(a); break;
509 1115 case LBM_TYPE_FLOAT:
510 1115 r = (double)lbm_dec_float(a); break;
511 421 case LBM_TYPE_I64:
512 421 r = (double)lbm_dec_i64(a); break;
513 421 case LBM_TYPE_U64:
514 421 r = (double)lbm_dec_u64(a); break;
515 3332 case LBM_TYPE_DOUBLE:
516 3332 r = (double)lbm_dec_double(a); break;
517 }
518 1691793 return r;
519 }
520
521 /****************************************************/
522 /* HEAP MANAGEMENT */
523
524 66566 static bool generate_freelist(size_t num_cells) {
525 66566 size_t i = 0;
526
527
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 66566 times.
 66566 if (!lbm_heap_state.heap) return false;
528
529 66566 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 615160826 times.
✓ Branch 1 taken 66566 times.
 615227392 for (i = 1; i < num_cells; i ++) {
535 615160826 t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
536 615160826 t->car = ENC_SYM_RECOVERED; // all cars in free list are "RECOVERED"
537 615160826 t->cdr = lbm_enc_cons_ptr(i);
538 }
539
540 // Replace the incorrect pointer at the last cell.
541 66566 t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
542 66566 t->cdr = ENC_SYM_NIL;
543
544 66566 return true;
545 }
546
547 1606087 void lbm_nil_freelist(void) {
548 1606087 lbm_heap_state.freelist = ENC_SYM_NIL;
549 1606087 lbm_heap_state.num_free = 0;
550 1606087 }
551
552 66566 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 66566 lbm_heap_state.heap = addr;
555 66566 lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
556 66566 lbm_heap_state.heap_size = num_cells;
557
558 66566 lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size);
559
560 66566 lbm_heap_state.num_free = num_cells;
561 66566 lbm_heap_state.num_alloc_arrays = 0;
562 66566 lbm_heap_state.gc_num = 0;
563 66566 lbm_heap_state.gc_marked = 0;
564 66566 lbm_heap_state.gc_recovered = 0;
565 66566 lbm_heap_state.gc_recovered_arrays = 0;
566 66566 lbm_heap_state.gc_least_free = num_cells;
567 66566 lbm_heap_state.gc_last_free = num_cells;
568 66566 }
569
570 1606086 void lbm_heap_new_freelist_length(void) {
571 1606086 lbm_heap_state.gc_last_free = lbm_heap_state.num_free;
572
2/2
✓ Branch 0 taken 12126 times.
✓ Branch 1 taken 1593960 times.
 1606086 if (lbm_heap_state.num_free < lbm_heap_state.gc_least_free)
573 12126 lbm_heap_state.gc_least_free = lbm_heap_state.num_free;
574 1606086 }
575
576 66566 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 66566 times.
 66566 if (((uintptr_t)addr % 8) != 0) return false;
580
581 66566 memset(addr,0, sizeof(lbm_cons_t) * num_cells);
582
583 66566 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 66566 times.
 66566 if (gc_stack_storage == NULL) return 0;
585
586 66566 heap_init_state(addr, num_cells,
587 gc_stack_storage, gc_stack_size);
588
589 66566 lbm_heaps[0] = addr;
590
591 66566 return generate_freelist(num_cells);
592 }
593
594
595 1414299610 lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) {
596 lbm_value r;
597 1414299610 lbm_value cell = lbm_heap_state.freelist;
598
2/2
✓ Branch 0 taken 1413980467 times.
✓ Branch 1 taken 319143 times.
 1414299610 if (cell) {
599 1413980467 lbm_uint heap_ix = lbm_dec_ptr(cell);
600 1413980467 lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
601 1413980467 lbm_heap_state.num_free--;
602 1413980467 lbm_heap_state.heap[heap_ix].car = car;
603 1413980467 lbm_heap_state.heap[heap_ix].cdr = cdr;
604 1413980467 r = lbm_set_ptr_type(cell, ptr_type);
605 } else {
606 319143 r = ENC_SYM_MERROR;
607 }
608 1414299610 return r;
609 }
610
611 3768807 lbm_value lbm_heap_allocate_list(lbm_uint n) {
612
2/2
✓ Branch 0 taken 10032 times.
✓ Branch 1 taken 3758775 times.
 3768807 if (n == 0) return ENC_SYM_NIL;
613
2/2
✓ Branch 0 taken 4660 times.
✓ Branch 1 taken 3754115 times.
 3758775 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
614 // Here the freelist is guaranteed to be a cons_cell.
615
616 3754115 lbm_value curr = lbm_heap_state.freelist;
617 3754115 lbm_value res = curr;
618
619 3754115 lbm_cons_t *c_cell = NULL;
620 3754115 lbm_uint count = 0;
621 do {
622 19397456 c_cell = lbm_ref_cell(curr);
623 19397456 c_cell->car = ENC_SYM_NIL;
624 19397456 curr = c_cell->cdr;
625 19397456 count ++;
626
2/2
✓ Branch 0 taken 15643341 times.
✓ Branch 1 taken 3754115 times.
 19397456 } while (count < n);
627 3754115 lbm_heap_state.freelist = curr;
628 3754115 c_cell->cdr = ENC_SYM_NIL;
629 3754115 lbm_heap_state.num_free-=count;
630 3754115 return res;
631 }
632
633 65904345 lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) {
634
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 65904345 times.
 65904345 if (n == 0) return ENC_SYM_NIL;
635
2/2
✓ Branch 0 taken 99562 times.
✓ Branch 1 taken 65804783 times.
 65904345 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
636
637 65804783 lbm_value curr = lbm_heap_state.freelist;
638 65804783 lbm_value res = curr;
639
640 65804783 lbm_cons_t *c_cell = NULL;
641 65804783 unsigned int count = 0;
642 do {
643 132461036 c_cell = lbm_ref_cell(curr);
644 132461036 c_cell->car = va_arg(valist, lbm_value);
645 132461036 curr = c_cell->cdr;
646 132461036 count ++;
647
2/2
✓ Branch 0 taken 66656253 times.
✓ Branch 1 taken 65804783 times.
 132461036 } while (count < n);
648 65804783 lbm_heap_state.freelist = curr;
649 65804783 c_cell->cdr = ENC_SYM_NIL;
650 65804783 lbm_heap_state.num_free-=count;
651 65804783 return res;
652 }
653
654 65904345 lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) {
655 va_list valist;
656 65904345 va_start(valist, n);
657 65904345 lbm_value r = lbm_heap_allocate_list_init_va(n, valist);
658 65904345 va_end(valist);
659 65904345 return r;
660 }
661
662 5 lbm_uint lbm_heap_num_allocated(void) {
663 5 return lbm_heap_state.heap_size - lbm_heap_state.num_free;
664 }
665 5 lbm_uint lbm_heap_size(void) {
666 5 return lbm_heap_state.heap_size;
667 }
668
669 4 lbm_uint lbm_heap_size_bytes(void) {
670 4 return lbm_heap_state.heap_bytes;
671 }
672
673 765 void lbm_get_heap_state(lbm_heap_state_t *res) {
674 765 *res = lbm_heap_state;
675 765 }
676
677 6 lbm_uint lbm_get_gc_stack_max(void) {
678 6 return lbm_get_max_stack(&lbm_heap_state.gc_stack);
679 }
680
681 5 lbm_uint lbm_get_gc_stack_size(void) {
682 5 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 63394 bool active_ptr(lbm_value p) {
729 63394 lbm_stack_t *s = &lbm_heap_state.gc_stack;
730 63394 bool r = false;
731
2/2
✓ Branch 0 taken 330 times.
✓ Branch 1 taken 63394 times.
 63724 for (lbm_uint i = 0; i < s->sp; i ++) {
732
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 330 times.
 330 if (p == s->data[i]) {
733 ✗ r = true;
734 ✗ break;
735 }
736 }
737 63394 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 25368094 void lbm_gc_mark_phase(lbm_value root) {
757 lbm_value t_ptr;
758 25368094 lbm_stack_t *s = &lbm_heap_state.gc_stack;
759 25368094 s->data[s->sp++] = root;
760
761
2/2
✓ Branch 0 taken 123424776 times.
✓ Branch 1 taken 25368093 times.
 148792869 while (!lbm_stack_is_empty(s)) {
762 lbm_value curr;
763 123424776 lbm_pop(s, &curr);
764
765 277160690 mark_shortcut:
766
767
2/2
✓ Branch 0 taken 169334321 times.
✓ Branch 1 taken 107826369 times.
 277160690 if (!lbm_is_ptr(curr) ||
768
2/2
✓ Branch 0 taken 305 times.
✓ Branch 1 taken 169334016 times.
 169334321 (curr & LBM_PTR_TO_CONSTANT_BIT)) {
769 119120833 continue;
770 }
771
772 169334016 lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)];
773
774
2/2
✓ Branch 0 taken 11233375 times.
✓ Branch 1 taken 158100641 times.
 169334016 if (lbm_get_gc_mark(cell->cdr)) {
775 11233375 continue;
776 }
777
778 158100641 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 63394 times.
✓ Branch 1 taken 158037247 times.
 158100641 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 63394 times.
 63394 if (active_ptr(curr)) {
787 ✗ continue; // Already in process of marking this array, abort cycle!
788 }
789 63394 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
790 63394 lbm_value *arrdata = (lbm_value *)arr->data;
791 63394 uint32_t index = arr->index;
792
2/2
✓ Branch 0 taken 63384 times.
✓ Branch 1 taken 10 times.
 63394 if (arr->size > 0) {
793 63384 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 3156 times.
✓ Branch 1 taken 60228 times.
✓ Branch 2 taken 3156 times.
✗ Branch 3 not taken.
 63384 if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT) == 0) &&
798
2/2
✓ Branch 0 taken 2694 times.
✓ Branch 1 taken 462 times.
 3156 !((arrdata[index] & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)) {
799 2694 lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])];
800
2/2
✓ Branch 0 taken 2610 times.
✓ Branch 1 taken 84 times.
 2694 if (!lbm_get_gc_mark(elt->cdr)) {
801 2610 curr = arrdata[index];
802 2610 arr->index++;
803 2610 goto mark_shortcut;
804 }
805 }
806
2/2
✓ Branch 0 taken 53984 times.
✓ Branch 1 taken 6790 times.
 60774 if (index < ((arr->size/(sizeof(lbm_value))) - 1)) {
807 53984 arr->index++;
808 53984 continue;
809 }
810 6790 arr->index = 0;
811 6790 lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it.
812 }
813 6800 cell->cdr = lbm_set_gc_mark(cell->cdr);
814 6800 lbm_heap_state.gc_marked ++;
815 6800 continue;
816
2/2
✓ Branch 0 taken 815287 times.
✓ Branch 1 taken 157221960 times.
 158037247 } else if (t_ptr == LBM_TYPE_CHANNEL) {
817 815287 cell->cdr = lbm_set_gc_mark(cell->cdr);
818 815287 lbm_heap_state.gc_marked ++;
819 // TODO: Can channels be explicitly freed ?
820
1/2
✓ Branch 0 taken 815287 times.
✗ Branch 1 not taken.
 815287 if (cell->car != ENC_SYM_NIL) {
821 815287 lbm_char_channel_t *chan = (lbm_char_channel_t *)cell->car;
822 815287 curr = chan->dependency;
823 815287 goto mark_shortcut;
824 }
825 ✗ continue;
826 }
827
828 157221960 cell->cdr = lbm_set_gc_mark(cell->cdr);
829 157221960 lbm_heap_state.gc_marked ++;
830
831
2/2
✓ Branch 0 taken 152918018 times.
✓ Branch 1 taken 4303942 times.
 157221960 if (t_ptr == LBM_TYPE_CONS) {
832
2/2
✓ Branch 0 taken 98000345 times.
✓ Branch 1 taken 54917673 times.
 152918018 if (lbm_is_ptr(cell->cdr)) {
833
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 98000344 times.
 98000345 if (!lbm_push(s, cell->cdr)) {
834 1 lbm_critical_error();
835 ✗ break;
836 }
837 }
838 152918017 curr = cell->car;
839 152918017 goto mark_shortcut; // Skip a push/pop
840 }
841 }
842 25368093 }
843 #endif
844
845 //Environments are proper lists with a 2 element list stored in each car.
846 53038735 void lbm_gc_mark_env(lbm_value env) {
847 53038735 lbm_value curr = env;
848 lbm_cons_t *c;
849
850
2/2
✓ Branch 0 taken 8979468 times.
✓ Branch 1 taken 53038734 times.
 62018202 while (lbm_is_ptr(curr)) {
851 8979468 c = lbm_ref_cell(curr);
852 8979468 c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
853 8979468 lbm_cons_t *b = lbm_ref_cell(c->car);
854 8979468 b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
855 8979468 lbm_gc_mark_phase(b->cdr); // mark the bound object.
856 8979467 lbm_heap_state.gc_marked +=2;
857 8979467 curr = c->cdr;
858 }
859 53038734 }
860
861
862 1643974 void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
863
2/2
✓ Branch 0 taken 34804880 times.
✓ Branch 1 taken 1643974 times.
 36448854 for (lbm_uint i = 0; i < aux_size; i ++) {
864
2/2
✓ Branch 0 taken 20472671 times.
✓ Branch 1 taken 14332209 times.
 34804880 if (lbm_is_ptr(aux_data[i])) {
865 20472671 lbm_type pt_t = lbm_type_of(aux_data[i]);
866 20472671 lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
867
3/4
✓ Branch 0 taken 20472671 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 10064717 times.
✓ Branch 3 taken 10407954 times.
 20472671 if( pt_t >= LBM_POINTER_TYPE_FIRST &&
868 10064717 pt_t <= LBM_POINTER_TYPE_LAST &&
869
1/2
✓ Branch 0 taken 10064717 times.
✗ Branch 1 not taken.
 10064717 pt_v < lbm_heap_state.heap_size) {
870 10064717 lbm_gc_mark_phase(aux_data[i]);
871 }
872 }
873 }
874 1643974 }
875
876 3298558 void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
877
2/2
✓ Branch 0 taken 4968172 times.
✓ Branch 1 taken 3298558 times.
 8266730 for (lbm_uint i = 0; i < num_roots; i ++) {
878 4968172 lbm_gc_mark_phase(roots[i]);
879 }
880 3298558 }
881
882 // Sweep moves non-marked heap objects to the free list.
883 1606086 int lbm_gc_sweep_phase(void) {
884 1606086 unsigned int i = 0;
885 1606086 lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap;
886
887
2/2
✓ Branch 0 taken 3824225792 times.
✓ Branch 1 taken 1606086 times.
 3825831878 for (i = 0; i < lbm_heap_state.heap_size; i ++) {
888
2/2
✓ Branch 0 taken 175431163 times.
✓ Branch 1 taken 3648794629 times.
 3824225792 if ( lbm_get_gc_mark(heap[i].cdr)) {
889 175431163 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 642933505 times.
✓ Branch 1 taken 3005861124 times.
 3648794629 if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL) {
894
7/7
✓ Branch 0 taken 16796006 times.
✓ Branch 1 taken 86996 times.
✓ Branch 2 taken 1728784 times.
✓ Branch 3 taken 914104 times.
✓ Branch 4 taken 2 times.
✓ Branch 5 taken 84 times.
✓ Branch 6 taken 623407529 times.
 642933505 switch(heap[i].cdr) {
895
896 16796006 case ENC_SYM_IND_I_TYPE: /* fall through */
897 case ENC_SYM_IND_U_TYPE:
898 case ENC_SYM_IND_F_TYPE:
899 16796006 lbm_memory_free((lbm_uint*)heap[i].car);
900 16796006 break;
901 86996 case ENC_SYM_DEFRAG_LISPARRAY_TYPE: /* fall through */
902 case ENC_SYM_DEFRAG_ARRAY_TYPE:
903 86996 lbm_defrag_mem_free((lbm_uint*)heap[i].car);
904 86996 break;
905 1728784 case ENC_SYM_LISPARRAY_TYPE: /* fall through */
906 case ENC_SYM_ARRAY_TYPE:{
907 1728784 lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
908 1728784 lbm_memory_free((lbm_uint *)arr->data);
909 1728784 lbm_heap_state.gc_recovered_arrays++;
910 1728784 lbm_memory_free((lbm_uint *)arr);
911 1728784 } break;
912 914104 case ENC_SYM_CHANNEL_TYPE:{
913 914104 lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car;
914 914104 lbm_memory_free((lbm_uint*)chan->state);
915 914104 lbm_memory_free((lbm_uint*)chan);
916 914104 } 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 84 case ENC_SYM_DEFRAG_MEM_TYPE: {
923 84 lbm_uint *ptr = (lbm_uint *)heap[i].car;
924 84 lbm_defrag_mem_destroy(ptr);
925 84 } break;
926 623407529 default:
927 623407529 break;
928 }
929 }
930 // create pointer to use as new freelist
931 3648794629 lbm_uint addr = lbm_enc_cons_ptr(i);
932
933 // Clear the "freed" cell.
934 3648794629 heap[i].car = ENC_SYM_RECOVERED;
935 3648794629 heap[i].cdr = lbm_heap_state.freelist;
936 3648794629 lbm_heap_state.freelist = addr;
937 3648794629 lbm_heap_state.num_free++;
938 3648794629 lbm_heap_state.gc_recovered ++;
939 }
940 }
941 1606086 return 1;
942 }
943
944 1606087 void lbm_gc_state_inc(void) {
945 1606087 lbm_heap_state.gc_num ++;
946 1606087 lbm_heap_state.gc_recovered = 0;
947 1606087 lbm_heap_state.gc_marked = 0;
948 1606087 }
949
950 // construct, alter and break apart
951 1411204636 lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
952 1411204636 return lbm_heap_allocate_cell(LBM_TYPE_CONS, car, cdr);
953 }
954
955 1279171875 lbm_value lbm_car(lbm_value c){
956
2/2
✓ Branch 0 taken 1279169375 times.
✓ Branch 1 taken 2500 times.
 1279171875 if (lbm_is_ptr(c) ){
957 1279169375 lbm_cons_t *cell = lbm_ref_cell(c);
958 1279169375 return cell->car;
959 }
960
2/2
✓ Branch 0 taken 103 times.
✓ Branch 1 taken 2397 times.
 2500 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 5180447 lbm_value lbm_caar(lbm_value c) {
968 5180447 lbm_value tmp = ENC_SYM_NIL;
969
2/2
✓ Branch 0 taken 5180191 times.
✓ Branch 1 taken 256 times.
 5180447 if (lbm_is_ptr(c)) {
970 5180191 tmp = lbm_ref_cell(c)->car;
971
1/2
✓ Branch 0 taken 5180191 times.
✗ Branch 1 not taken.
 5180191 if (lbm_is_ptr(tmp)) {
972 5180191 return lbm_ref_cell(tmp)->car;
973 }
974 }
975
2/4
✓ Branch 0 taken 256 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 256 times.
✗ Branch 3 not taken.
 256 return c || tmp ? ENC_SYM_TERROR : c; //nil if not something else
976 }
977
978
979 35173 lbm_value lbm_cadr(lbm_value c) {
980 35173 lbm_value tmp = ENC_SYM_NIL;
981
1/2
✓ Branch 0 taken 35173 times.
✗ Branch 1 not taken.
 35173 if (lbm_is_ptr(c)) {
982 35173 tmp = lbm_ref_cell(c)->cdr;
983
1/2
✓ Branch 0 taken 35173 times.
✗ Branch 1 not taken.
 35173 if (lbm_is_ptr(tmp)) {
984 35173 return lbm_ref_cell(tmp)->car;
985 }
986 }
987 ✗ return c || tmp ? ENC_SYM_TERROR : c;
988 }
989
990 232675177 lbm_value lbm_cdr(lbm_value c){
991
2/2
✓ Branch 0 taken 230975327 times.
✓ Branch 1 taken 1699850 times.
 232675177 if (lbm_is_ptr(c)) {
992 230975327 lbm_cons_t *cell = lbm_ref_cell(c);
993 230975327 return cell->cdr;
994 }
995
1/2
✓ Branch 0 taken 1699850 times.
✗ Branch 1 not taken.
 1699850 return c ? ENC_SYM_TERROR: c;
996 }
997
998 5 lbm_value lbm_cddr(lbm_value c) {
999
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 2 times.
 5 if (lbm_is_ptr(c)) {
1000 3 lbm_value tmp = lbm_ref_cell(c)->cdr;
1001
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
 3 if (lbm_is_ptr(tmp)) {
1002 2 return lbm_ref_cell(tmp)->cdr;
1003 }
1004 }
1005
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 2 times.
 3 return c ? ENC_SYM_TERROR : c;
1006 }
1007
1008 20552209 int lbm_set_car(lbm_value c, lbm_value v) {
1009 20552209 int r = 0;
1010
1011
2/2
✓ Branch 0 taken 20552125 times.
✓ Branch 1 taken 84 times.
 20552209 if (lbm_type_of(c) == LBM_TYPE_CONS) {
1012 20552125 lbm_cons_t *cell = lbm_ref_cell(c);
1013 20552125 cell->car = v;
1014 20552125 r = 1;
1015 }
1016 20552209 return r;
1017 }
1018
1019 301811555 int lbm_set_cdr(lbm_value c, lbm_value v) {
1020 301811555 int r = 0;
1021
2/2
✓ Branch 0 taken 300111963 times.
✓ Branch 1 taken 1699592 times.
 301811555 if (lbm_is_cons_rw(c)){
1022 300111963 lbm_cons_t *cell = lbm_ref_cell(c);
1023 300111963 cell->cdr = v;
1024 300111963 r = 1;
1025 }
1026 301811555 return r;
1027 }
1028
1029 17081969 int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
1030 17081969 int r = 0;
1031
1/2
✓ Branch 0 taken 17081969 times.
✗ Branch 1 not taken.
 17081969 if (lbm_is_cons_rw(c)) {
1032 17081969 lbm_cons_t *cell = lbm_ref_cell(c);
1033 17081969 cell->car = car_val;
1034 17081969 cell->cdr = cdr_val;
1035 17081969 r = 1;
1036 }
1037 17081969 return r;
1038 }
1039
1040 /* calculate length of a proper list */
1041 3751397 lbm_uint lbm_list_length(lbm_value c) {
1042 3751397 lbm_uint len = 0;
1043
1044
2/2
✓ Branch 0 taken 17893980 times.
✓ Branch 1 taken 3751397 times.
 21645377 while (lbm_is_cons(c)){
1045 17893980 len ++;
1046 17893980 c = lbm_cdr(c);
1047 }
1048 3751397 return len;
1049 }
1050
1051 32604 lbm_value lbm_list_destructive_reverse(lbm_value list) {
1052
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 32603 times.
 32604 if (lbm_type_of(list) == LBM_TYPE_SYMBOL) {
1053 1 return list;
1054 }
1055 32603 lbm_value curr = list;
1056 32603 lbm_value last_cell = ENC_SYM_NIL;
1057
1058
2/2
✓ Branch 0 taken 83724 times.
✓ Branch 1 taken 32603 times.
 116327 while (lbm_is_cons_rw(curr)) {
1059 83724 lbm_value next = lbm_cdr(curr);
1060 83724 lbm_set_cdr(curr, last_cell);
1061 83724 last_cell = curr;
1062 83724 curr = next;
1063 }
1064 32603 return last_cell;
1065 }
1066
1067
1068 990755 lbm_value lbm_list_copy(int *m, lbm_value list) {
1069 990755 lbm_value curr = list;
1070 990755 lbm_uint n = lbm_list_length(list);
1071 990755 lbm_uint copy_n = n;
1072
4/4
✓ Branch 0 taken 18542 times.
✓ Branch 1 taken 972213 times.
✓ Branch 2 taken 16266 times.
✓ Branch 3 taken 2276 times.
 990755 if (*m >= 0 && (lbm_uint)*m < n) {
1073 16266 copy_n = (lbm_uint)*m;
1074
2/2
✓ Branch 0 taken 887213 times.
✓ Branch 1 taken 87276 times.
 974489 } else if (*m == -1) {
1075 887213 *m = (int)n; // TODO: smaller range in target variable.
1076 }
1077
2/2
✓ Branch 0 taken 679 times.
✓ Branch 1 taken 990076 times.
 990755 if (copy_n == 0) return ENC_SYM_NIL;
1078 990076 lbm_uint new_list = lbm_heap_allocate_list(copy_n);
1079
2/2
✓ Branch 0 taken 1588 times.
✓ Branch 1 taken 988488 times.
 990076 if (lbm_is_symbol(new_list)) return new_list;
1080 988488 lbm_value curr_targ = new_list;
1081
1082
4/4
✓ Branch 0 taken 11299688 times.
✓ Branch 1 taken 972468 times.
✓ Branch 2 taken 11283668 times.
✓ Branch 3 taken 16020 times.
 12272156 while (lbm_is_cons(curr) && copy_n > 0) {
1083 11283668 lbm_value v = lbm_car(curr);
1084 11283668 lbm_set_car(curr_targ, v);
1085 11283668 curr_targ = lbm_cdr(curr_targ);
1086 11283668 curr = lbm_cdr(curr);
1087 11283668 copy_n --;
1088 }
1089
1090 988488 return new_list;
1091 }
1092
1093 // Append for proper lists only
1094 // Destructive update of list1.
1095 72400 lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
1096
1097
2/4
✓ Branch 0 taken 72400 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 72400 times.
✗ Branch 3 not taken.
 144800 if(lbm_is_list_rw(list1) &&
1098 72400 lbm_is_list(list2)) {
1099
1100 72400 lbm_value curr = list1;
1101
2/2
✓ Branch 0 taken 94941 times.
✓ Branch 1 taken 72400 times.
 167341 while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) {
1102 94941 curr = lbm_cdr(curr);
1103 }
1104
2/2
✓ Branch 0 taken 86 times.
✓ Branch 1 taken 72314 times.
 72400 if (lbm_is_symbol_nil(curr)) return list2;
1105 72314 lbm_set_cdr(curr, list2);
1106 72314 return list1;
1107 }
1108 ✗ return ENC_SYM_EERROR;
1109 }
1110
1111 252 lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
1112 252 lbm_value curr = ls;
1113
4/4
✓ Branch 0 taken 2184 times.
✓ Branch 1 taken 168 times.
✓ Branch 2 taken 2100 times.
✓ Branch 3 taken 84 times.
 2352 while (lbm_type_of_functional(curr) == LBM_TYPE_CONS &&
1114 n > 0) {
1115 2100 curr = lbm_cdr(curr);
1116 2100 n --;
1117 }
1118 252 return curr;
1119 }
1120
1121 486464 lbm_value lbm_index_list(lbm_value l, int32_t n) {
1122 486464 lbm_value curr = l;
1123
1124
2/2
✓ Branch 0 taken 337 times.
✓ Branch 1 taken 486127 times.
 486464 if (n < 0) {
1125 337 int32_t len = (int32_t)lbm_list_length(l);
1126 337 n = len + n;
1127
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 337 times.
 337 if (n < 0) return ENC_SYM_NIL;
1128 }
1129
1130
4/4
✓ Branch 0 taken 735122 times.
✓ Branch 1 taken 86 times.
✓ Branch 2 taken 248744 times.
✓ Branch 3 taken 486378 times.
 735208 while (lbm_is_cons(curr) &&
1131 n > 0) {
1132 248744 curr = lbm_cdr(curr);
1133 248744 n --;
1134 }
1135
2/2
✓ Branch 0 taken 486378 times.
✓ Branch 1 taken 86 times.
 486464 if (lbm_is_cons(curr)) {
1136 486378 return lbm_car(curr);
1137 } else {
1138 86 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 1744483 int lbm_heap_allocate_array_base(lbm_value *res, bool byte_array, lbm_uint size){
1149
1150 1744483 lbm_uint tag = ENC_SYM_ARRAY_TYPE;
1151 1744483 lbm_uint type = LBM_TYPE_ARRAY;
1152 1744483 lbm_array_header_t *array = NULL;
1153 1744483 lbm_array_header_extended_t *ext_array = NULL;
1154
1155
2/2
✓ Branch 0 taken 896531 times.
✓ Branch 1 taken 847952 times.
 1744483 if (byte_array) {
1156 896531 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1157 } else {
1158 847952 tag = ENC_SYM_LISPARRAY_TYPE;
1159 847952 type = LBM_TYPE_LISPARRAY;
1160 847952 size = sizeof(lbm_value) * size;
1161 847952 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
1162 847952 ext_array = (lbm_array_header_extended_t*)array;
1163 }
1164
2/2
✓ Branch 0 taken 1742627 times.
✓ Branch 1 taken 1856 times.
 1744483 if (array) {
1165
2/2
✓ Branch 0 taken 846232 times.
✓ Branch 1 taken 896395 times.
 1742627 if (!byte_array) ext_array->index = 0;
1166
1167 1742627 array->data = NULL;
1168 1742627 array->size = size;
1169
2/2
✓ Branch 0 taken 1742194 times.
✓ Branch 1 taken 433 times.
 1742627 if ( size > 0) {
1170 1742194 array->data = (lbm_uint*)lbm_malloc(size);
1171
2/2
✓ Branch 0 taken 15398 times.
✓ Branch 1 taken 1726796 times.
 1742194 if (array->data == NULL) {
1172 15398 lbm_memory_free((lbm_uint*)array);
1173 15398 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 1726796 memset(array->data, 0, size);
1178 }
1179 // allocating a cell for array's heap-presence
1180 1727229 lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);
1181
2/2
✓ Branch 0 taken 1119 times.
✓ Branch 1 taken 1726110 times.
 1727229 if (cell == ENC_SYM_MERROR) {
1182 1119 lbm_memory_free((lbm_uint*)array->data);
1183 1119 lbm_memory_free((lbm_uint*)array);
1184 1119 goto allocate_array_merror;
1185 }
1186 1726110 *res = cell;
1187 1726110 lbm_heap_state.num_alloc_arrays ++;
1188 1726110 return 1;
1189 }
1190 1856 allocate_array_merror:
1191 18373 *res = ENC_SYM_MERROR;
1192 18373 return 0;
1193 }
1194
1195 896531 int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
1196 896531 return lbm_heap_allocate_array_base(res, true, size);
1197 }
1198
1199 847952 int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
1200 847952 return lbm_heap_allocate_array_base(res, false, size);
1201 }
1202
1203 1129 int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
1204
1205 1129 lbm_array_header_t *array = NULL;
1206 1129 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 1129 times.
 1129 if (cell == ENC_SYM_MERROR) {
1209 ✗ *value = cell;
1210 ✗ return 0;
1211 }
1212
1213 1129 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1214
1215
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1129 times.
 1129 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 1129 array->data = (lbm_uint*)data;
1222 1129 array->size = num_elt;
1223
1224 1129 lbm_set_car(cell, (lbm_uint)array);
1225
1226 1129 cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY);
1227 1129 *value = cell;
1228 1129 return 1;
1229 }
1230
1231 713005 lbm_int lbm_heap_array_get_size(lbm_value arr) {
1232
1233 713005 lbm_int r = -1;
1234 713005 lbm_array_header_t *header = lbm_dec_array_r(arr);
1235
1/2
✓ Branch 0 taken 713005 times.
✗ Branch 1 not taken.
 713005 if (header) {
1236 713005 r = (lbm_int)header->size;
1237 }
1238 713005 return r;
1239 }
1240
1241 356639 const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
1242 356639 uint8_t *r = NULL;
1243 356639 lbm_array_header_t *header = lbm_dec_array_r(arr);
1244
1/2
✓ Branch 0 taken 356639 times.
✗ Branch 1 not taken.
 356639 if (header) {
1245 356639 r = (uint8_t*)header->data;
1246 }
1247 356639 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 336 int lbm_heap_explicit_free_array(lbm_value arr) {
1268
1269 336 int r = 0;
1270
2/4
✓ Branch 0 taken 336 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 336 times.
✗ Branch 3 not taken.
 336 if (lbm_is_array_rw(arr) && lbm_cdr(arr) == ENC_SYM_ARRAY_TYPE) {
1271 336 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1272
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 336 times.
 336 if (header == NULL) {
1273 ✗ return 0;
1274 }
1275 336 lbm_memory_free((lbm_uint*)header->data);
1276 336 lbm_memory_free((lbm_uint*)header);
1277
1278 336 arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS);
1279 336 lbm_set_car(arr, ENC_SYM_NIL);
1280 336 lbm_set_cdr(arr, ENC_SYM_NIL);
1281 336 r = 1;
1282 }
1283
1284 336 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 66566 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 66566 times.
 66566 if (((uintptr_t)addr % 4) != 0) return 0;
1299
1300
2/2
✓ Branch 0 taken 66477 times.
✓ Branch 1 taken 89 times.
 66566 if (!lbm_const_heap_mutex_initialized) {
1301 66477 lbm_mutex_init(&lbm_const_heap_mutex);
1302 66477 lbm_const_heap_mutex_initialized = true;
1303 }
1304
1305
2/2
✓ Branch 0 taken 66477 times.
✓ Branch 1 taken 89 times.
 66566 if (!lbm_mark_mutex_initialized) {
1306 66477 lbm_mutex_init(&lbm_mark_mutex);
1307 66477 lbm_mark_mutex_initialized = true;
1308 }
1309
1310 66566 const_heap_write = w_fun;
1311
1312 66566 heap->heap = addr;
1313 66566 heap->size = 0;
1314 66566 heap->next = 0;
1315
1316 66566 lbm_const_heap_state = heap;
1317 // ref_cell views the lbm_uint array as an lbm_cons_t array
1318 66566 lbm_heaps[1] = (lbm_cons_t*)addr;
1319 66566 return 1;
1320 }
1321
1322 7455 lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
1323 7455 lbm_flash_status r = LBM_FLASH_FULL;
1324
1325 7455 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 457 times.
✓ Branch 1 taken 6998 times.
 7455 if (lbm_const_heap_state->next % 2 == 1) {
1328 457 lbm_const_heap_state->next++;
1329 }
1330
1331
1/2
✓ Branch 0 taken 7455 times.
✗ Branch 1 not taken.
 7455 if (lbm_const_heap_state &&
1332
1/2
✓ Branch 0 taken 7455 times.
✗ Branch 1 not taken.
 7455 (lbm_const_heap_state->next+1) < (uint32_t)lbm_image_get_write_index()) {
1333 // A cons cell uses two words.
1334 7455 lbm_value cell = lbm_const_heap_state->next;
1335 7455 lbm_const_heap_state->next += 2;
1336 7455 *res = (cell << LBM_ADDRESS_SHIFT) | LBM_PTR_BIT | LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT;
1337 7455 r = LBM_FLASH_WRITE_OK;
1338 }
1339 7455 lbm_mutex_unlock(&lbm_const_heap_mutex);
1340 7455 return r;
1341 }
1342
1343 84 lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) {
1344 84 lbm_flash_status r = LBM_FLASH_FULL;
1345
1346
1/2
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
 84 if (lbm_const_heap_state &&
1347
1/2
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
 84 (lbm_const_heap_state->next + nwords) < (uint32_t)lbm_image_get_write_index()) {
1348 84 lbm_uint ix = lbm_const_heap_state->next;
1349 84 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1350 84 lbm_const_heap_state->next += nwords;
1351 84 r = LBM_FLASH_WRITE_OK;
1352 }
1353 84 return r;
1354 }
1355
1356 529911 lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {
1357
1358 529911 lbm_flash_status r = LBM_FLASH_FULL;
1359
1360
1/2
✓ Branch 0 taken 529911 times.
✗ Branch 1 not taken.
 529911 if (lbm_const_heap_state &&
1361
1/2
✓ Branch 0 taken 529911 times.
✗ Branch 1 not taken.
 529911 (lbm_const_heap_state->next + n) < (uint32_t)lbm_image_get_write_index()) {
1362 529911 lbm_uint ix = lbm_const_heap_state->next;
1363
1364
2/2
✓ Branch 0 taken 572452 times.
✓ Branch 1 taken 529911 times.
 1102363 for (unsigned int i = 0; i < n; i ++) {
1365
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 572452 times.
 572452 if (!const_heap_write(((lbm_uint*)data)[i],ix + i))
1366 ✗ return LBM_FLASH_WRITE_ERROR;
1367 }
1368 529911 lbm_const_heap_state->next += n;
1369 529911 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1370 529911 r = LBM_FLASH_WRITE_OK;
1371 }
1372 529911 return r;
1373 }
1374
1375 252 lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) {
1376
1377
1/2
✓ Branch 0 taken 252 times.
✗ Branch 1 not taken.
 252 if (lbm_const_heap_state) {
1378 252 lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap;
1379 252 lbm_uint ix = (((lbm_uint)tgt - flash) / sizeof(lbm_uint)); // byte address to ix
1380
1/2
✓ Branch 0 taken 252 times.
✗ Branch 1 not taken.
 252 if (const_heap_write(val, ix)) {
1381 252 return LBM_FLASH_WRITE_OK;
1382 }
1383 ✗ return LBM_FLASH_WRITE_ERROR;
1384 }
1385 ✗ return LBM_FLASH_FULL;
1386 }
1387
1388 7455 lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
1389 7455 lbm_uint addr = lbm_dec_ptr(cell);
1390
1/2
✓ Branch 0 taken 7455 times.
✗ Branch 1 not taken.
 7455 if (const_heap_write(val, addr+1))
1391 7455 return LBM_FLASH_WRITE_OK;
1392 ✗ return LBM_FLASH_WRITE_ERROR;
1393 }
1394
1395 7455 lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
1396 7455 lbm_uint addr = lbm_dec_ptr(cell);
1397
1/2
✓ Branch 0 taken 7455 times.
✗ Branch 1 not taken.
 7455 if (const_heap_write(val, addr))
1398 7455 return LBM_FLASH_WRITE_OK;
1399 ✗ return LBM_FLASH_WRITE_ERROR;
1400 }
1401
1402 9 lbm_uint lbm_flash_memory_usage(void) {
1403 9 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