GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/heap.c
Date: 2025-08-08 18:10:24
Exec Total Coverage
Lines: 841 863 97.5%
Functions: 86 87 98.9%
Branches: 319 374 85.3%
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 108369355 static inline lbm_value lbm_set_gc_mark(lbm_value x) {
40 108369355 return x | LBM_GC_MARKED;
41 }
42 107974409 static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
43 107974409 return x & ~LBM_GC_MASK;
44 }
45
46 2543222084 static inline bool lbm_get_gc_mark(lbm_value x) {
47 2543222084 return x & LBM_GC_MASK;
48 }
49
50 11574 static inline void gc_mark(lbm_value c) {
51 //c must be a cons cell.
52 11574 lbm_cons_t *cell = lbm_ref_cell(c);
53 11574 cell->cdr = lbm_set_gc_mark(cell->cdr);
54 11574 }
55
56 11637 static inline bool gc_marked(lbm_value c) {
57 11637 lbm_cons_t *cell = lbm_ref_cell(c);
58 11637 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 22416 static inline bool lbm_get_gc_flag(lbm_value x) {
69 22416 return x & LBM_GC_MARKED;
70 }
71
72 11208 static inline lbm_value lbm_set_gc_flag(lbm_value x) {
73 11208 return x | LBM_GC_MARKED;
74 }
75
76 11208 static inline lbm_value lbm_clr_gc_flag(lbm_value x) {
77 11208 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 mutex_t lbm_const_heap_mutex;
88 static bool lbm_const_heap_mutex_initialized = false;
89
90 static 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 mutex_lock(&lbm_mark_mutex);
96 }
97 void lbm_gc_unlock(void) {
98 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 5672933 lbm_value lbm_enc_i32(int32_t x) {
111 #ifndef LBM64
112 2837943 lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE);
113
2/2
✓ Branch 0 taken 618 times.
✓ Branch 1 taken 2837325 times.
 2837943 if (lbm_type_of(i) == LBM_TYPE_SYMBOL) return i;
114 2837325 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 6520095 lbm_value lbm_enc_u32(uint32_t x) {
121 #ifndef LBM64
122 3681887 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE);
123
2/2
✓ Branch 0 taken 1088 times.
✓ Branch 1 taken 3680799 times.
 3681887 if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u;
124 3680799 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 459513068 lbm_value lbm_enc_float(float x) {
131 #ifndef LBM64
132 lbm_uint t;
133 229893944 memcpy(&t, &x, sizeof(lbm_float));
134 229893944 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE);
135
2/2
✓ Branch 0 taken 147244 times.
✓ Branch 1 taken 229746700 times.
 229893944 if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f;
136 229746700 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 8429215 static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) {
146 8429215 lbm_value res = lbm_cons(ENC_SYM_NIL,ENC_SYM_NIL);
147
2/2
✓ Branch 0 taken 8427029 times.
✓ Branch 1 taken 2186 times.
 8429215 if (lbm_type_of(res) != LBM_TYPE_SYMBOL) {
148 8427029 uint8_t* storage = lbm_malloc(sizeof(uint64_t));
149
2/2
✓ Branch 0 taken 8424401 times.
✓ Branch 1 taken 2628 times.
 8427029 if (storage) {
150 8424401 memcpy(storage,source, sizeof(uint64_t));
151 8424401 lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual);
152 8424401 res = lbm_set_ptr_type(res, type);
153 } else {
154 2628 res = ENC_SYM_MERROR;
155 }
156 }
157 8429215 return res;
158 }
159 #endif
160
161 8981662 lbm_value lbm_enc_i64(int64_t x) {
162 #ifndef LBM64
163 4492278 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 6739958 lbm_value lbm_enc_u64(uint64_t x) {
172 #ifndef LBM64
173 3371210 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 1131295 lbm_value lbm_enc_double(double x) {
182 #ifndef LBM64
183 565727 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 666796376 float lbm_dec_float(lbm_value x) {
198 #ifndef LBM64
199 float f_tmp;
200 333562367 lbm_uint tmp = lbm_car(x);
201 333562367 memcpy(&f_tmp, &tmp, sizeof(float));
202 333562367 return f_tmp;
203 #else
204 333234009 uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT);
205 float f_tmp;
206 333234009 memcpy(&f_tmp, &tmp, sizeof(float));
207 333234009 return f_tmp;
208 #endif
209 }
210
211 1129455 double lbm_dec_double(lbm_value x) {
212 #ifndef LBM64
213 564811 double d = 0.0;
214
1/2
✓ Branch 0 taken 564811 times.
✗ Branch 1 not taken.
 564811 if (lbm_is_ptr(x)) {
215 564811 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
216 564811 memcpy(&d, data, sizeof(double));
217 }
218 564811 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 14023560 uint64_t lbm_dec_u64(lbm_value x) {
228 #ifndef LBM64
229 7013772 uint64_t u = 0;
230
1/2
✓ Branch 0 taken 7013772 times.
✗ Branch 1 not taken.
 7013772 if (lbm_is_ptr(x)) {
231 7013772 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
232 7013772 memcpy(&u, data, 8);
233 }
234 7013772 return u;
235 #else
236 7009788 return (uint64_t)lbm_car(x);
237 #endif
238 }
239
240 18504424 int64_t lbm_dec_i64(lbm_value x) {
241 #ifndef LBM64
242 9254420 int64_t i = 0;
243
1/2
✓ Branch 0 taken 9254420 times.
✗ Branch 1 not taken.
 9254420 if (lbm_is_ptr(x)) {
244 9254420 uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car;
245 9254420 memcpy(&i, data, 8);
246 }
247 9254420 return i;
248 #else
249 9250004 return (int64_t)lbm_car(x);
250 #endif
251 }
252
253 1585375 char *lbm_dec_str(lbm_value val) {
254 1585375 char *res = 0;
255
2/2
✓ Branch 0 taken 1585093 times.
✓ Branch 1 taken 282 times.
 1585375 if (lbm_is_array_r(val)) {
256 1585093 lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
257
1/2
✓ Branch 0 taken 1585093 times.
✗ Branch 1 not taken.
 1585093 if (array) {
258 1585093 res = (char *)array->data;
259 }
260 }
261 1585375 return res;
262 }
263
264 1201686 lbm_array_header_t *lbm_dec_array_r(lbm_value val) {
265 1201686 lbm_array_header_t *array = NULL;
266
2/2
✓ Branch 0 taken 1198970 times.
✓ Branch 1 taken 2716 times.
 1201686 if (lbm_is_array_r(val)) {
267 1198970 array = (lbm_array_header_t *)lbm_car(val);
268 }
269 1201686 return array;
270 }
271
272 119066 lbm_array_header_t *lbm_dec_array_rw(lbm_value val) {
273 119066 lbm_array_header_t *array = NULL;
274
2/2
✓ Branch 0 taken 118898 times.
✓ Branch 1 taken 168 times.
 119066 if (lbm_is_array_rw(val)) {
275 118898 array = (lbm_array_header_t *)lbm_car(val);
276 }
277 119066 return array;
278 }
279
280 22551066 lbm_char_channel_t *lbm_dec_channel(lbm_value val) {
281 22551066 lbm_char_channel_t *res = NULL;
282
283
1/2
✓ Branch 0 taken 22551066 times.
✗ Branch 1 not taken.
 22551066 if (lbm_type_of(val) == LBM_TYPE_CHANNEL) {
284 22551066 res = (lbm_char_channel_t *)lbm_car(val);
285 }
286 22551066 return res;
287 }
288
289 209 lbm_uint lbm_dec_custom(lbm_value val) {
290 209 lbm_uint res = 0;
291
1/2
✓ Branch 0 taken 209 times.
✗ Branch 1 not taken.
 209 if (lbm_type_of(val) == LBM_TYPE_CUSTOM) {
292 209 res = (lbm_uint)lbm_car(val);
293 }
294 209 return res;
295 }
296
297 121863 uint8_t lbm_dec_as_char(lbm_value a) {
298 121863 uint8_t r = 0;
299
10/10
✓ Branch 0 taken 121378 times.
✓ Branch 1 taken 78 times.
✓ Branch 2 taken 58 times.
✓ Branch 3 taken 57 times.
✓ Branch 4 taken 57 times.
✓ Branch 5 taken 57 times.
✓ Branch 6 taken 57 times.
✓ Branch 7 taken 57 times.
✓ Branch 8 taken 57 times.
✓ Branch 9 taken 7 times.
 121863 switch (lbm_type_of_functional(a)) {
300 121378 case LBM_TYPE_CHAR:
301 121378 r = (uint8_t)lbm_dec_char(a); break;
302 78 case LBM_TYPE_I:
303 78 r = (uint8_t)lbm_dec_i(a); break;
304 58 case LBM_TYPE_U:
305 58 r = (uint8_t)lbm_dec_u(a); break;
306 57 case LBM_TYPE_I32:
307 57 r = (uint8_t)lbm_dec_i32(a); break;
308 57 case LBM_TYPE_U32:
309 57 r = (uint8_t)lbm_dec_u32(a); break;
310 57 case LBM_TYPE_FLOAT:
311 57 r = (uint8_t)lbm_dec_float(a); break;
312 57 case LBM_TYPE_I64:
313 57 r = (uint8_t)lbm_dec_i64(a); break;
314 57 case LBM_TYPE_U64:
315 57 r = (uint8_t)lbm_dec_u64(a); break;
316 57 case LBM_TYPE_DOUBLE:
317 57 r = (uint8_t) lbm_dec_double(a); break;
318 }
319 121863 return r;
320 }
321
322 15402538 uint32_t lbm_dec_as_u32(lbm_value a) {
323 15402538 uint32_t r = 0;
324
9/9
✓ Branch 0 taken 843159 times.
✓ Branch 1 taken 2477320 times.
✓ Branch 2 taken 3612707 times.
✓ Branch 3 taken 8469002 times.
✓ Branch 4 taken 60 times.
✓ Branch 5 taken 57 times.
✓ Branch 6 taken 169 times.
✓ Branch 7 taken 57 times.
✓ Branch 8 taken 7 times.
 15402538 switch (lbm_type_of_functional(a)) {
325 843159 case LBM_TYPE_CHAR:
326 843159 r = (uint32_t)lbm_dec_char(a); break;
327 2477320 case LBM_TYPE_I:
328 2477320 r = (uint32_t)lbm_dec_i(a); break;
329 3612707 case LBM_TYPE_U:
330 3612707 r = (uint32_t)lbm_dec_u(a); break;
331 8469002 case LBM_TYPE_I32: /* fall through */
332 case LBM_TYPE_U32:
333 8469002 r = (uint32_t)lbm_dec_u32(a); break;
334 60 case LBM_TYPE_FLOAT:
335 60 r = (uint32_t)lbm_dec_float(a); break;
336 57 case LBM_TYPE_I64:
337 57 r = (uint32_t)lbm_dec_i64(a); break;
338 169 case LBM_TYPE_U64:
339 169 r = (uint32_t)lbm_dec_u64(a); break;
340 57 case LBM_TYPE_DOUBLE:
341 57 r = (uint32_t)lbm_dec_double(a); break;
342 }
343 15402538 return r;
344 }
345
346 259806522 int32_t lbm_dec_as_i32(lbm_value a) {
347 259806522 int32_t r = 0;
348
10/10
✓ Branch 0 taken 7192890 times.
✓ Branch 1 taken 245252735 times.
✓ Branch 2 taken 16226 times.
✓ Branch 3 taken 7342097 times.
✓ Branch 4 taken 57 times.
✓ Branch 5 taken 57 times.
✓ Branch 6 taken 113 times.
✓ Branch 7 taken 113 times.
✓ Branch 8 taken 57 times.
✓ Branch 9 taken 2179 times.
 259806522 switch (lbm_type_of_functional(a)) {
349 7192890 case LBM_TYPE_CHAR:
350 7192890 r = (int32_t)lbm_dec_char(a); break;
351 245252735 case LBM_TYPE_I:
352 245252735 r = (int32_t)lbm_dec_i(a); break;
353 16226 case LBM_TYPE_U:
354 16226 r = (int32_t)lbm_dec_u(a); break;
355 7342097 case LBM_TYPE_I32:
356 7342097 r = (int32_t)lbm_dec_i32(a); break;
357 57 case LBM_TYPE_U32:
358 57 r = (int32_t)lbm_dec_u32(a); break;
359 57 case LBM_TYPE_FLOAT:
360 57 r = (int32_t)lbm_dec_float(a); break;
361 113 case LBM_TYPE_I64:
362 113 r = (int32_t)lbm_dec_i64(a); break;
363 113 case LBM_TYPE_U64:
364 113 r = (int32_t)lbm_dec_u64(a); break;
365 57 case LBM_TYPE_DOUBLE:
366 57 r = (int32_t) lbm_dec_double(a); break;
367 }
368 259806529 return r;
369 }
370
371 246940121 int64_t lbm_dec_as_i64(lbm_value a) {
372 246940121 int64_t r = 0;
373
10/10
✓ Branch 0 taken 7250969 times.
✓ Branch 1 taken 230158464 times.
✓ Branch 2 taken 338 times.
✓ Branch 3 taken 673 times.
✓ Branch 4 taken 1625 times.
✓ Branch 5 taken 124 times.
✓ Branch 6 taken 9527575 times.
✓ Branch 7 taken 225 times.
✓ Branch 8 taken 113 times.
✓ Branch 9 taken 15 times.
 246940121 switch (lbm_type_of_functional(a)) {
374 7250969 case LBM_TYPE_CHAR:
375 7250969 r = (int64_t)lbm_dec_char(a); break;
376 230158464 case LBM_TYPE_I:
377 230158464 r = (int64_t)lbm_dec_i(a); break;
378 338 case LBM_TYPE_U:
379 338 r = (int64_t)lbm_dec_u(a); break;
380 673 case LBM_TYPE_I32:
381 673 r = (int64_t)lbm_dec_i32(a); break;
382 1625 case LBM_TYPE_U32:
383 1625 r = (int64_t)lbm_dec_u32(a); break;
384 124 case LBM_TYPE_FLOAT:
385 124 r = (int64_t)lbm_dec_float(a); break;
386 9527575 case LBM_TYPE_I64:
387 9527575 r = (int64_t)lbm_dec_i64(a); break;
388 225 case LBM_TYPE_U64:
389 225 r = (int64_t)lbm_dec_u64(a); break;
390 113 case LBM_TYPE_DOUBLE:
391 113 r = (int64_t) lbm_dec_double(a); break;
392 }
393 246940121 return r;
394 }
395
396 9071531 uint64_t lbm_dec_as_u64(lbm_value a) {
397 9071531 uint64_t r = 0;
398
10/10
✓ Branch 0 taken 1124893 times.
✓ Branch 1 taken 638185 times.
✓ Branch 2 taken 19242 times.
✓ Branch 3 taken 505 times.
✓ Branch 4 taken 505 times.
✓ Branch 5 taken 113 times.
✓ Branch 6 taken 337 times.
✓ Branch 7 taken 7287631 times.
✓ Branch 8 taken 113 times.
✓ Branch 9 taken 7 times.
 9071531 switch (lbm_type_of_functional(a)) {
399 1124893 case LBM_TYPE_CHAR:
400 1124893 r = (uint64_t)lbm_dec_char(a); break;
401 638185 case LBM_TYPE_I:
402 638185 r = (uint64_t)lbm_dec_i(a); break;
403 19242 case LBM_TYPE_U:
404 19242 r = (uint64_t)lbm_dec_u(a); break;
405 505 case LBM_TYPE_I32:
406 505 r = (uint64_t)lbm_dec_i32(a); break;
407 505 case LBM_TYPE_U32:
408 505 r = (uint64_t)lbm_dec_u32(a); break;
409 113 case LBM_TYPE_FLOAT:
410 113 r = (uint64_t)lbm_dec_float(a); break;
411 337 case LBM_TYPE_I64:
412 337 r = (uint64_t)lbm_dec_i64(a); break;
413 7287631 case LBM_TYPE_U64:
414 7287631 r = (uint64_t)lbm_dec_u64(a); break;
415 113 case LBM_TYPE_DOUBLE:
416 113 r = (uint64_t)lbm_dec_double(a); break;
417 }
418 9071531 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 750716169 float lbm_dec_as_float(lbm_value a) {
472 750716169 float r = 0;
473
10/10
✓ Branch 0 taken 207349429 times.
✓ Branch 1 taken 336077307 times.
✓ Branch 2 taken 338 times.
✓ Branch 3 taken 281 times.
✓ Branch 4 taken 337 times.
✓ Branch 5 taken 207287747 times.
✓ Branch 6 taken 281 times.
✓ Branch 7 taken 281 times.
✓ Branch 8 taken 57 times.
✓ Branch 9 taken 111 times.
 750716169 switch (lbm_type_of_functional(a)) {
474 207349429 case LBM_TYPE_CHAR:
475 207349429 r = (float)lbm_dec_char(a); break;
476 336077307 case LBM_TYPE_I:
477 336077307 r = (float)lbm_dec_i(a); break;
478 338 case LBM_TYPE_U:
479 338 r = (float)lbm_dec_u(a); break;
480 281 case LBM_TYPE_I32:
481 281 r = (float)lbm_dec_i32(a); break;
482 337 case LBM_TYPE_U32:
483 337 r = (float)lbm_dec_u32(a); break;
484 207287747 case LBM_TYPE_FLOAT:
485 207287747 r = (float)lbm_dec_float(a); break;
486 281 case LBM_TYPE_I64:
487 281 r = (float)lbm_dec_i64(a); break;
488 281 case LBM_TYPE_U64:
489 281 r = (float)lbm_dec_u64(a); break;
490 57 case LBM_TYPE_DOUBLE:
491 57 r = (float)lbm_dec_double(a); break;
492 }
493 750716169 return r;
494 }
495
496 1127769 double lbm_dec_as_double(lbm_value a) {
497 1127769 double r = 0;
498
10/10
✓ Branch 0 taken 562145 times.
✓ Branch 1 taken 561293 times.
✓ Branch 2 taken 282 times.
✓ Branch 3 taken 281 times.
✓ Branch 4 taken 281 times.
✓ Branch 5 taken 729 times.
✓ Branch 6 taken 281 times.
✓ Branch 7 taken 281 times.
✓ Branch 8 taken 2189 times.
✓ Branch 9 taken 7 times.
 1127769 switch (lbm_type_of_functional(a)) {
499 562145 case LBM_TYPE_CHAR:
500 562145 r = (double)lbm_dec_char(a); break;
501 561293 case LBM_TYPE_I:
502 561293 r = (double)lbm_dec_i(a); break;
503 282 case LBM_TYPE_U:
504 282 r = (double)lbm_dec_u(a); break;
505 281 case LBM_TYPE_I32:
506 281 r = (double)lbm_dec_i32(a); break;
507 281 case LBM_TYPE_U32:
508 281 r = (double)lbm_dec_u32(a); break;
509 729 case LBM_TYPE_FLOAT:
510 729 r = (double)lbm_dec_float(a); break;
511 281 case LBM_TYPE_I64:
512 281 r = (double)lbm_dec_i64(a); break;
513 281 case LBM_TYPE_U64:
514 281 r = (double)lbm_dec_u64(a); break;
515 2189 case LBM_TYPE_DOUBLE:
516 2189 r = (double)lbm_dec_double(a); break;
517 }
518 1127769 return r;
519 }
520
521 /****************************************************/
522 /* HEAP MANAGEMENT */
523
524 44370 static bool generate_freelist(size_t num_cells) {
525 44370 size_t i = 0;
526
527
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 44370 times.
 44370 if (!lbm_heap_state.heap) return false;
528
529 44370 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 410110638 times.
✓ Branch 1 taken 44370 times.
 410155008 for (i = 1; i < num_cells; i ++) {
535 410110638 t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
536 410110638 t->car = ENC_SYM_RECOVERED; // all cars in free list are "RECOVERED"
537 410110638 t->cdr = lbm_enc_cons_ptr(i);
538 }
539
540 // Replace the incorrect pointer at the last cell.
541 44370 t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
542 44370 t->cdr = ENC_SYM_NIL;
543
544 44370 return true;
545 }
546
547 1012965 void lbm_nil_freelist(void) {
548 1012965 lbm_heap_state.freelist = ENC_SYM_NIL;
549 1012965 lbm_heap_state.num_alloc = lbm_heap_state.heap_size;
550 1012965 }
551
552 44370 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 44370 lbm_heap_state.heap = addr;
555 44370 lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
556 44370 lbm_heap_state.heap_size = num_cells;
557
558 44370 lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size);
559
560 44370 lbm_heap_state.num_alloc = 0;
561 44370 lbm_heap_state.num_alloc_arrays = 0;
562 44370 lbm_heap_state.gc_num = 0;
563 44370 lbm_heap_state.gc_marked = 0;
564 44370 lbm_heap_state.gc_recovered = 0;
565 44370 lbm_heap_state.gc_recovered_arrays = 0;
566 44370 lbm_heap_state.gc_least_free = num_cells;
567 44370 lbm_heap_state.gc_last_free = num_cells;
568 44370 }
569
570 1012965 void lbm_heap_new_freelist_length(void) {
571 1012965 lbm_uint l = lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
572 1012965 lbm_heap_state.gc_last_free = l;
573
2/2
✓ Branch 0 taken 8067 times.
✓ Branch 1 taken 1004898 times.
 1012965 if (l < lbm_heap_state.gc_least_free)
574 8067 lbm_heap_state.gc_least_free = l;
575 1012965 }
576
577 44370 bool lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
578 lbm_uint gc_stack_size) {
579
580
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 44370 times.
 44370 if (((uintptr_t)addr % 8) != 0) return false;
581
582 44370 memset(addr,0, sizeof(lbm_cons_t) * num_cells);
583
584 44370 lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint));
585
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 44370 times.
 44370 if (gc_stack_storage == NULL) return 0;
586
587 44370 heap_init_state(addr, num_cells,
588 gc_stack_storage, gc_stack_size);
589
590 44370 lbm_heaps[0] = addr;
591
592 44370 return generate_freelist(num_cells);
593 }
594
595
596 864186359 lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) {
597 lbm_value r;
598 864186359 lbm_value cell = lbm_heap_state.freelist;
599
2/2
✓ Branch 0 taken 864023116 times.
✓ Branch 1 taken 163243 times.
 864186359 if (cell) {
600 864023116 lbm_uint heap_ix = lbm_dec_ptr(cell);
601 864023116 lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
602 864023116 lbm_heap_state.num_alloc++;
603 864023116 lbm_heap_state.heap[heap_ix].car = car;
604 864023116 lbm_heap_state.heap[heap_ix].cdr = cdr;
605 864023116 r = lbm_set_ptr_type(cell, ptr_type);
606 } else {
607 163243 r = ENC_SYM_MERROR;
608 }
609 864186359 return r;
610 }
611
612 2511824 lbm_value lbm_heap_allocate_list(lbm_uint n) {
613
2/2
✓ Branch 0 taken 6667 times.
✓ Branch 1 taken 2505157 times.
 2511824 if (n == 0) return ENC_SYM_NIL;
614
2/2
✓ Branch 0 taken 3026 times.
✓ Branch 1 taken 2502131 times.
 2505157 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
615
616 2502131 lbm_value curr = lbm_heap_state.freelist;
617 2502131 lbm_value res = curr;
618
1/2
✓ Branch 0 taken 2502131 times.
✗ Branch 1 not taken.
 2502131 if (lbm_type_of(curr) == LBM_TYPE_CONS) {
619
620 2502131 lbm_cons_t *c_cell = NULL;
621 2502131 lbm_uint count = 0;
622 do {
623 12930879 c_cell = lbm_ref_cell(curr);
624 12930879 c_cell->car = ENC_SYM_NIL;
625 12930879 curr = c_cell->cdr;
626 12930879 count ++;
627
2/2
✓ Branch 0 taken 10428748 times.
✓ Branch 1 taken 2502131 times.
 12930879 } while (count < n);
628 2502131 lbm_heap_state.freelist = curr;
629 2502131 c_cell->cdr = ENC_SYM_NIL;
630 2502131 lbm_heap_state.num_alloc+=count;
631 2502131 return res;
632 }
633 ✗ return ENC_SYM_FATAL_ERROR;
634 }
635
636 43928097 lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) {
637
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 43928097 times.
 43928097 if (n == 0) return ENC_SYM_NIL;
638
2/2
✓ Branch 0 taken 66372 times.
✓ Branch 1 taken 43861725 times.
 43928097 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR;
639
640 43861725 lbm_value curr = lbm_heap_state.freelist;
641 43861725 lbm_value res = curr;
642
1/2
✓ Branch 0 taken 43861725 times.
✗ Branch 1 not taken.
 43861725 if (lbm_type_of(curr) == LBM_TYPE_CONS) {
643
644 43861725 lbm_cons_t *c_cell = NULL;
645 43861725 unsigned int count = 0;
646 do {
647 88291094 c_cell = lbm_ref_cell(curr);
648 88291094 c_cell->car = va_arg(valist, lbm_value);
649 88291094 curr = c_cell->cdr;
650 88291094 count ++;
651
2/2
✓ Branch 0 taken 44429369 times.
✓ Branch 1 taken 43861725 times.
 88291094 } while (count < n);
652 43861725 lbm_heap_state.freelist = curr;
653 43861725 c_cell->cdr = ENC_SYM_NIL;
654 43861725 lbm_heap_state.num_alloc+=count;
655 43861725 return res;
656 }
657 ✗ return ENC_SYM_FATAL_ERROR;
658 }
659
660 43928097 lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) {
661 va_list valist;
662 43928097 va_start(valist, n);
663 43928097 lbm_value r = lbm_heap_allocate_list_init_va(n, valist);
664 43928097 va_end(valist);
665 43928097 return r;
666 }
667
668 5 lbm_uint lbm_heap_num_allocated(void) {
669 5 return lbm_heap_state.num_alloc;
670 }
671 5 lbm_uint lbm_heap_size(void) {
672 5 return lbm_heap_state.heap_size;
673 }
674
675 4 lbm_uint lbm_heap_size_bytes(void) {
676 4 return lbm_heap_state.heap_bytes;
677 }
678
679 513 void lbm_get_heap_state(lbm_heap_state_t *res) {
680 513 *res = lbm_heap_state;
681 513 }
682
683 4 lbm_uint lbm_get_gc_stack_max(void) {
684 4 return lbm_get_max_stack(&lbm_heap_state.gc_stack);
685 }
686
687 4 lbm_uint lbm_get_gc_stack_size(void) {
688 4 return lbm_heap_state.gc_stack.size;
689 }
690
691 136236 static inline void value_assign(lbm_value *a, lbm_value b) {
692 136236 lbm_value a_old = *a & LBM_GC_MASK;
693 136236 *a = a_old | (b & ~LBM_GC_MASK);
694 136236 }
695
696 #ifdef LBM_USE_GC_PTR_REV
697 /* ************************************************************
698 Deutch-Schorr-Waite (DSW) pointer reversal GC for 2-ptr cells
699 with a hack-solution for the lisp-array case (n-ptr cells).
700
701 DSW visits each branch node 3 times compared to 2 times for
702 the stack based recursive mark.
703 Where the stack based recursive mark performs a stack push/pop,
704 DSW rearranges the, current, prev, next and a ptr field on
705 the heap.
706
707 DSW changes the structure of the heap and it introduces an
708 invalid pointer (LBM_PTR_NULL) temporarily during marking.
709 Since the heap will be "messed up" while marking, a mutex
710 is introuded to keep other processes out of the heap while
711 marking.
712 */
713
714 static int do_nothing(lbm_value v, bool shared, void *arg) {
715 (void) v;
716 (void) shared;
717 (void) arg;
718 return TRAV_FUN_SUBTREE_CONTINUE;
719 }
720
721 void lbm_gc_mark_phase(lbm_value root) {
722 mutex_lock(&lbm_const_heap_mutex);
723 lbm_ptr_rev_trav(do_nothing, root, NULL);
724 mutex_unlock(&lbm_const_heap_mutex);
725 }
726
727 #else
728 /* ************************************************************
729 Explicit stack "recursive" mark phase
730
731 Trees are marked in a left subtree before rigth subtree, car first then cdr,
732 way to favor lisp lists. This means that stack will grow slowly when
733 marking right-leaning (cdr-recursive) data-structures while left-leaning
734 (car-recursive) structures uses a lot of stack.
735
736 Lisp arrays contain an extra book-keeping field to keep track
737 of how far into the array the marking process has gone.
738
739 TODO: DSW should be used as a last-resort if the GC stack is exhausted.
740 If we use DSW as last-resort can we get away with a way smaller
741 GC stack and unchanged performance (on sensible programs)?
742 */
743
744 extern eval_context_t *ctx_running;
745 15724606 void lbm_gc_mark_phase(lbm_value root) {
746 lbm_value t_ptr;
747 15724606 lbm_stack_t *s = &lbm_heap_state.gc_stack;
748 15724606 s->data[s->sp++] = root;
749
750
2/2
✓ Branch 0 taken 76171786 times.
✓ Branch 1 taken 15724606 times.
 91896392 while (!lbm_stack_is_empty(s)) {
751 lbm_value curr;
752 76171786 lbm_pop(s, &curr);
753
754 94828723 mark_shortcut:
755
756
2/2
✓ Branch 0 taken 103919799 times.
✓ Branch 1 taken 67080710 times.
 171000509 if (!lbm_is_ptr(curr) ||
757
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 103919775 times.
 103919799 (curr & LBM_PTR_TO_CONSTANT_BIT)) {
758 73894320 continue;
759 }
760
761 103919775 lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)];
762
763
2/2
✓ Branch 0 taken 6771564 times.
✓ Branch 1 taken 97148211 times.
 103919775 if (lbm_get_gc_mark(cell->cdr)) {
764 6771564 continue;
765 }
766
767 97148211 t_ptr = lbm_type_of(curr);
768
769 // An array is marked in O(N) time using an additional 32bit
770 // value per array that keeps track of how far into the array GC
771 // has progressed.
772
2/2
✓ Branch 0 taken 43682 times.
✓ Branch 1 taken 97104529 times.
 97148211 if (t_ptr == LBM_TYPE_LISPARRAY) {
773 43682 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
774 43682 lbm_value *arrdata = (lbm_value *)arr->data;
775 43682 uint32_t index = arr->index;
776
2/2
✓ Branch 0 taken 43672 times.
✓ Branch 1 taken 10 times.
 43682 if (arr->size > 0) {
777 43672 lbm_push(s, curr); // put array back as bookkeeping.
778 // Potential optimization.
779 // 1. CONS pointers are set to curr and recurse.
780 // 2. Any other ptr is marked immediately and index is increased.
781
3/4
✓ Branch 0 taken 3684 times.
✓ Branch 1 taken 39988 times.
✓ Branch 2 taken 3684 times.
✗ Branch 3 not taken.
 43672 if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT) == 0) &&
782
2/2
✓ Branch 0 taken 3376 times.
✓ Branch 1 taken 308 times.
 3684 !((arrdata[index] & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)) {
783 3376 lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])];
784
2/2
✓ Branch 0 taken 1660 times.
✓ Branch 1 taken 1716 times.
 3376 if (!lbm_get_gc_mark(elt->cdr)) {
785 1660 curr = arrdata[index];
786 1660 goto mark_shortcut;
787 }
788 }
789
2/2
✓ Branch 0 taken 37520 times.
✓ Branch 1 taken 4492 times.
 42012 if (index < ((arr->size/(sizeof(lbm_value))) - 1)) {
790 37520 arr->index++;
791 37520 continue;
792 }
793 4492 arr->index = 0;
794 4492 lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it.
795 }
796 4502 cell->cdr = lbm_set_gc_mark(cell->cdr);
797 4502 lbm_heap_state.gc_marked ++;
798 4502 continue;
799
2/2
✓ Branch 0 taken 513802 times.
✓ Branch 1 taken 96590727 times.
 97104529 } else if (t_ptr == LBM_TYPE_CHANNEL) {
800 513802 cell->cdr = lbm_set_gc_mark(cell->cdr);
801 513802 lbm_heap_state.gc_marked ++;
802 // TODO: Can channels be explicitly freed ?
803
1/2
✓ Branch 0 taken 513802 times.
✗ Branch 1 not taken.
 513802 if (cell->car != ENC_SYM_NIL) {
804 513802 lbm_char_channel_t *chan = (lbm_char_channel_t *)cell->car;
805 513802 curr = chan->dependency;
806 513802 goto mark_shortcut;
807 }
808 ✗ continue;
809 }
810
811 96590727 cell->cdr = lbm_set_gc_mark(cell->cdr);
812 96590727 lbm_heap_state.gc_marked ++;
813
814
2/2
✓ Branch 0 taken 94313261 times.
✓ Branch 1 taken 2277466 times.
 96590727 if (t_ptr == LBM_TYPE_CONS) {
815
2/2
✓ Branch 0 taken 60408000 times.
✓ Branch 1 taken 33905261 times.
 94313261 if (lbm_is_ptr(cell->cdr)) {
816
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 60408000 times.
 60408000 if (!lbm_push(s, cell->cdr)) {
817 ✗ lbm_critical_error();
818 ✗ break;
819 }
820 }
821 94313261 curr = cell->car;
822 94313261 goto mark_shortcut; // Skip a push/pop
823 }
824 }
825 15724606 }
826 #endif
827
828 //Environments are proper lists with a 2 element list stored in each car.
829 33452553 void lbm_gc_mark_env(lbm_value env) {
830 33452553 lbm_value curr = env;
831 lbm_cons_t *c;
832
833
2/2
✓ Branch 0 taken 5624375 times.
✓ Branch 1 taken 33452553 times.
 39076928 while (lbm_is_ptr(curr)) {
834 5624375 c = lbm_ref_cell(curr);
835 5624375 c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
836 5624375 lbm_cons_t *b = lbm_ref_cell(c->car);
837 5624375 b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
838 5624375 lbm_gc_mark_phase(b->cdr); // mark the bound object.
839 5624375 lbm_heap_state.gc_marked +=2;
840 5624375 curr = c->cdr;
841 }
842 33452553 }
843
844
845 1037673 void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
846
2/2
✓ Branch 0 taken 21076445 times.
✓ Branch 1 taken 1037673 times.
 22114118 for (lbm_uint i = 0; i < aux_size; i ++) {
847
2/2
✓ Branch 0 taken 12456230 times.
✓ Branch 1 taken 8620215 times.
 21076445 if (lbm_is_ptr(aux_data[i])) {
848 12456230 lbm_type pt_t = lbm_type_of(aux_data[i]);
849 12456230 lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
850
3/4
✓ Branch 0 taken 12456230 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6077737 times.
✓ Branch 3 taken 6378493 times.
 12456230 if( pt_t >= LBM_POINTER_TYPE_FIRST &&
851 6077737 pt_t <= LBM_POINTER_TYPE_LAST &&
852
1/2
✓ Branch 0 taken 6077737 times.
✗ Branch 1 not taken.
 6077737 pt_v < lbm_heap_state.heap_size) {
853 6077737 lbm_gc_mark_phase(aux_data[i]);
854 }
855 }
856 }
857 1037673 }
858
859 2082197 void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
860
2/2
✓ Branch 0 taken 3136518 times.
✓ Branch 1 taken 2082197 times.
 5218715 for (lbm_uint i = 0; i < num_roots; i ++) {
861 3136518 lbm_gc_mark_phase(roots[i]);
862 }
863 2082197 }
864
865 // Sweep moves non-marked heap objects to the free list.
866 1012965 int lbm_gc_sweep_phase(void) {
867 1012965 unsigned int i = 0;
868 1012965 lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap;
869
870
2/2
✓ Branch 0 taken 2439287296 times.
✓ Branch 1 taken 1012965 times.
 2440300261 for (i = 0; i < lbm_heap_state.heap_size; i ++) {
871
2/2
✓ Branch 0 taken 107974409 times.
✓ Branch 1 taken 2331312887 times.
 2439287296 if ( lbm_get_gc_mark(heap[i].cdr)) {
872 107974409 heap[i].cdr = lbm_clr_gc_mark(heap[i].cdr);
873 } else {
874 // Check if this cell is a pointer to an array
875 // and free it.
876
2/2
✓ Branch 0 taken 349996408 times.
✓ Branch 1 taken 1981316479 times.
 2331312887 if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL) {
877
7/7
✓ Branch 0 taken 8398003 times.
✓ Branch 1 taken 57988 times.
✓ Branch 2 taken 1143751 times.
✓ Branch 3 taken 607506 times.
✓ Branch 4 taken 2 times.
✓ Branch 5 taken 56 times.
✓ Branch 6 taken 339789102 times.
 349996408 switch(heap[i].cdr) {
878
879 8398003 case ENC_SYM_IND_I_TYPE: /* fall through */
880 case ENC_SYM_IND_U_TYPE:
881 case ENC_SYM_IND_F_TYPE:
882 8398003 lbm_memory_free((lbm_uint*)heap[i].car);
883 8398003 break;
884 57988 case ENC_SYM_DEFRAG_LISPARRAY_TYPE: /* fall through */
885 case ENC_SYM_DEFRAG_ARRAY_TYPE:
886 57988 lbm_defrag_mem_free((lbm_uint*)heap[i].car);
887 57988 break;
888 1143751 case ENC_SYM_LISPARRAY_TYPE: /* fall through */
889 case ENC_SYM_ARRAY_TYPE:{
890 1143751 lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
891 1143751 lbm_memory_free((lbm_uint *)arr->data);
892 1143751 lbm_heap_state.gc_recovered_arrays++;
893 1143751 lbm_memory_free((lbm_uint *)arr);
894 1143751 } break;
895 607506 case ENC_SYM_CHANNEL_TYPE:{
896 607506 lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car;
897 607506 lbm_memory_free((lbm_uint*)chan->state);
898 607506 lbm_memory_free((lbm_uint*)chan);
899 607506 } break;
900 2 case ENC_SYM_CUSTOM_TYPE: {
901 2 lbm_uint *t = (lbm_uint*)heap[i].car;
902 2 lbm_custom_type_destroy(t);
903 2 lbm_memory_free(t);
904 2 } break;
905 56 case ENC_SYM_DEFRAG_MEM_TYPE: {
906 56 lbm_uint *ptr = (lbm_uint *)heap[i].car;
907 56 lbm_defrag_mem_destroy(ptr);
908 56 } break;
909 339789102 default:
910 339789102 break;
911 }
912 }
913 // create pointer to use as new freelist
914 2331312887 lbm_uint addr = lbm_enc_cons_ptr(i);
915
916 // Clear the "freed" cell.
917 2331312887 heap[i].car = ENC_SYM_RECOVERED;
918 2331312887 heap[i].cdr = lbm_heap_state.freelist;
919 2331312887 lbm_heap_state.freelist = addr;
920 2331312887 lbm_heap_state.num_alloc --;
921 2331312887 lbm_heap_state.gc_recovered ++;
922 }
923 }
924 1012965 return 1;
925 }
926
927 1012965 void lbm_gc_state_inc(void) {
928 1012965 lbm_heap_state.gc_num ++;
929 1012965 lbm_heap_state.gc_recovered = 0;
930 1012965 lbm_heap_state.gc_marked = 0;
931 1012965 }
932
933 // construct, alter and break apart
934 862132391 lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
935 862132391 return lbm_heap_allocate_cell(LBM_TYPE_CONS, car, cdr);
936 }
937
938 741923392 lbm_value lbm_car(lbm_value c){
939
2/2
✓ Branch 0 taken 741921673 times.
✓ Branch 1 taken 1719 times.
 741923392 if (lbm_is_ptr(c) ){
940 741921673 lbm_cons_t *cell = lbm_ref_cell(c);
941 741921673 return cell->car;
942 }
943
2/2
✓ Branch 0 taken 75 times.
✓ Branch 1 taken 1644 times.
 1719 return c ? ENC_SYM_TERROR : c; //nil if c == nil
944 }
945
946 // TODO: Many comparisons "is this the nil symbol" can be
947 // streamlined a bit. NIL is 0 and cannot be confused with any other
948 // lbm_value.
949
950 3453509 lbm_value lbm_caar(lbm_value c) {
951 3453509 lbm_value tmp = ENC_SYM_NIL;
952
2/2
✓ Branch 0 taken 3453340 times.
✓ Branch 1 taken 169 times.
 3453509 if (lbm_is_ptr(c)) {
953 3453340 tmp = lbm_ref_cell(c)->car;
954
1/2
✓ Branch 0 taken 3453340 times.
✗ Branch 1 not taken.
 3453340 if (lbm_is_ptr(tmp)) {
955 3453340 return lbm_ref_cell(tmp)->car;
956 }
957 }
958
2/4
✓ Branch 0 taken 169 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 169 times.
✗ Branch 3 not taken.
 169 return c || tmp ? ENC_SYM_TERROR : c; //nil if not something else
959 }
960
961
962 23187 lbm_value lbm_cadr(lbm_value c) {
963 23187 lbm_value tmp = ENC_SYM_NIL;
964
1/2
✓ Branch 0 taken 23187 times.
✗ Branch 1 not taken.
 23187 if (lbm_is_ptr(c)) {
965 23187 tmp = lbm_ref_cell(c)->cdr;
966
1/2
✓ Branch 0 taken 23187 times.
✗ Branch 1 not taken.
 23187 if (lbm_is_ptr(tmp)) {
967 23187 return lbm_ref_cell(tmp)->car;
968 }
969 }
970 ✗ return c || tmp ? ENC_SYM_TERROR : c;
971 }
972
973 155212891 lbm_value lbm_cdr(lbm_value c){
974
2/2
✓ Branch 0 taken 154079654 times.
✓ Branch 1 taken 1133237 times.
 155212891 if (lbm_is_ptr(c)) {
975 154079654 lbm_cons_t *cell = lbm_ref_cell(c);
976 154079654 return cell->cdr;
977 }
978
1/2
✓ Branch 0 taken 1133237 times.
✗ Branch 1 not taken.
 1133237 return c ? ENC_SYM_TERROR: c;
979 }
980
981 5 lbm_value lbm_cddr(lbm_value c) {
982
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 2 times.
 5 if (lbm_is_ptr(c)) {
983 3 lbm_value tmp = lbm_ref_cell(c)->cdr;
984
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
 3 if (lbm_is_ptr(tmp)) {
985 2 return lbm_ref_cell(tmp)->cdr;
986 }
987 }
988
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 2 times.
 3 return c ? ENC_SYM_TERROR : c;
989 }
990
991 13698045 int lbm_set_car(lbm_value c, lbm_value v) {
992 13698045 int r = 0;
993
994
2/2
✓ Branch 0 taken 13697989 times.
✓ Branch 1 taken 56 times.
 13698045 if (lbm_type_of(c) == LBM_TYPE_CONS) {
995 13697989 lbm_cons_t *cell = lbm_ref_cell(c);
996 13697989 cell->car = v;
997 13697989 r = 1;
998 }
999 13698045 return r;
1000 }
1001
1002 201035850 int lbm_set_cdr(lbm_value c, lbm_value v) {
1003 201035850 int r = 0;
1004
2/2
✓ Branch 0 taken 199902782 times.
✓ Branch 1 taken 1133068 times.
 201035850 if (lbm_is_cons_rw(c)){
1005 199902782 lbm_cons_t *cell = lbm_ref_cell(c);
1006 199902782 cell->cdr = v;
1007 199902782 r = 1;
1008 }
1009 201035850 return r;
1010 }
1011
1012 8576472 int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
1013 8576472 int r = 0;
1014
1/2
✓ Branch 0 taken 8576472 times.
✗ Branch 1 not taken.
 8576472 if (lbm_is_cons_rw(c)) {
1015 8576472 lbm_cons_t *cell = lbm_ref_cell(c);
1016 8576472 cell->car = car_val;
1017 8576472 cell->cdr = cdr_val;
1018 8576472 r = 1;
1019 }
1020 8576472 return r;
1021 }
1022
1023 /* calculate length of a proper list */
1024 2498617 lbm_uint lbm_list_length(lbm_value c) {
1025 2498617 lbm_uint len = 0;
1026
1027
2/2
✓ Branch 0 taken 11924895 times.
✓ Branch 1 taken 2498617 times.
 14423512 while (lbm_is_cons(c)){
1028 11924895 len ++;
1029 11924895 c = lbm_cdr(c);
1030 }
1031 2498617 return len;
1032 }
1033
1034 21547 lbm_value lbm_list_destructive_reverse(lbm_value list) {
1035
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 21546 times.
 21547 if (lbm_type_of(list) == LBM_TYPE_SYMBOL) {
1036 1 return list;
1037 }
1038 21546 lbm_value curr = list;
1039 21546 lbm_value last_cell = ENC_SYM_NIL;
1040
1041
2/2
✓ Branch 0 taken 55333 times.
✓ Branch 1 taken 21546 times.
 76879 while (lbm_is_cons_rw(curr)) {
1042 55333 lbm_value next = lbm_cdr(curr);
1043 55333 lbm_set_cdr(curr, last_cell);
1044 55333 last_cell = curr;
1045 55333 curr = next;
1046 }
1047 21546 return last_cell;
1048 }
1049
1050
1051 660403 lbm_value lbm_list_copy(int *m, lbm_value list) {
1052 660403 lbm_value curr = list;
1053 660403 lbm_uint n = lbm_list_length(list);
1054 660403 lbm_uint copy_n = n;
1055
4/4
✓ Branch 0 taken 12368 times.
✓ Branch 1 taken 648035 times.
✓ Branch 2 taken 10852 times.
✓ Branch 3 taken 1516 times.
 660403 if (*m >= 0 && (lbm_uint)*m < n) {
1056 10852 copy_n = (lbm_uint)*m;
1057
2/2
✓ Branch 0 taken 591489 times.
✓ Branch 1 taken 58062 times.
 649551 } else if (*m == -1) {
1058 591489 *m = (int)n; // TODO: smaller range in target variable.
1059 }
1060
2/2
✓ Branch 0 taken 453 times.
✓ Branch 1 taken 659950 times.
 660403 if (copy_n == 0) return ENC_SYM_NIL;
1061 659950 lbm_uint new_list = lbm_heap_allocate_list(copy_n);
1062
2/2
✓ Branch 0 taken 978 times.
✓ Branch 1 taken 658972 times.
 659950 if (lbm_is_symbol(new_list)) return new_list;
1063 658972 lbm_value curr_targ = new_list;
1064
1065
4/4
✓ Branch 0 taken 7532832 times.
✓ Branch 1 taken 648292 times.
✓ Branch 2 taken 7522152 times.
✓ Branch 3 taken 10680 times.
 8181124 while (lbm_is_cons(curr) && copy_n > 0) {
1066 7522152 lbm_value v = lbm_car(curr);
1067 7522152 lbm_set_car(curr_targ, v);
1068 7522152 curr_targ = lbm_cdr(curr_targ);
1069 7522152 curr = lbm_cdr(curr);
1070 7522152 copy_n --;
1071 }
1072
1073 658972 return new_list;
1074 }
1075
1076 // Append for proper lists only
1077 // Destructive update of list1.
1078 48224 lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
1079
1080
2/4
✓ Branch 0 taken 48224 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 48224 times.
✗ Branch 3 not taken.
 96448 if(lbm_is_list_rw(list1) &&
1081 48224 lbm_is_list(list2)) {
1082
1083 48224 lbm_value curr = list1;
1084
2/2
✓ Branch 0 taken 63297 times.
✓ Branch 1 taken 48224 times.
 111521 while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) {
1085 63297 curr = lbm_cdr(curr);
1086 }
1087
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 48168 times.
 48224 if (lbm_is_symbol_nil(curr)) return list2;
1088 48168 lbm_set_cdr(curr, list2);
1089 48168 return list1;
1090 }
1091 ✗ return ENC_SYM_EERROR;
1092 }
1093
1094 168 lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
1095 168 lbm_value curr = ls;
1096
4/4
✓ Branch 0 taken 1456 times.
✓ Branch 1 taken 112 times.
✓ Branch 2 taken 1400 times.
✓ Branch 3 taken 56 times.
 1568 while (lbm_type_of_functional(curr) == LBM_TYPE_CONS &&
1097 n > 0) {
1098 1400 curr = lbm_cdr(curr);
1099 1400 n --;
1100 }
1101 168 return curr;
1102 }
1103
1104 301863 lbm_value lbm_index_list(lbm_value l, int32_t n) {
1105 301863 lbm_value curr = l;
1106
1107
2/2
✓ Branch 0 taken 225 times.
✓ Branch 1 taken 301638 times.
 301863 if (n < 0) {
1108 225 int32_t len = (int32_t)lbm_list_length(l);
1109 225 n = len + n;
1110
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 225 times.
 225 if (n < 0) return ENC_SYM_NIL;
1111 }
1112
1113
4/4
✓ Branch 0 taken 456116 times.
✓ Branch 1 taken 57 times.
✓ Branch 2 taken 154310 times.
✓ Branch 3 taken 301806 times.
 456173 while (lbm_is_cons(curr) &&
1114 n > 0) {
1115 154310 curr = lbm_cdr(curr);
1116 154310 n --;
1117 }
1118
2/2
✓ Branch 0 taken 301806 times.
✓ Branch 1 taken 57 times.
 301863 if (lbm_is_cons(curr)) {
1119 301806 return lbm_car(curr);
1120 } else {
1121 57 return ENC_SYM_NIL;
1122 }
1123 }
1124
1125 // High-level arrays are just bytearrays but with a different tag and pointer type.
1126 // These arrays will be inspected by GC and the elements of the array will be marked.
1127
1128 // Arrays are part of the heap module because their lifespan is managed
1129 // by the garbage collector. The data in the array is not stored
1130 // in the "heap of cons cells".
1131 1154869 int lbm_heap_allocate_array_base(lbm_value *res, bool byte_array, lbm_uint size){
1132
1133 1154869 lbm_uint tag = ENC_SYM_ARRAY_TYPE;
1134 1154869 lbm_uint type = LBM_TYPE_ARRAY;
1135 1154869 lbm_array_header_t *array = NULL;
1136 1154869 lbm_array_header_extended_t *ext_array = NULL;
1137
1138
2/2
✓ Branch 0 taken 589565 times.
✓ Branch 1 taken 565304 times.
 1154869 if (byte_array) {
1139 589565 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1140 } else {
1141 565304 tag = ENC_SYM_LISPARRAY_TYPE;
1142 565304 type = LBM_TYPE_LISPARRAY;
1143 565304 size = sizeof(lbm_value) * size;
1144 565304 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
1145 565304 ext_array = (lbm_array_header_extended_t*)array;
1146 }
1147
2/2
✓ Branch 0 taken 1153915 times.
✓ Branch 1 taken 954 times.
 1154869 if (array) {
1148
2/2
✓ Branch 0 taken 564444 times.
✓ Branch 1 taken 589471 times.
 1153915 if (!byte_array) ext_array->index = 0;
1149
1150 1153915 array->data = NULL;
1151 1153915 array->size = size;
1152
2/2
✓ Branch 0 taken 1153624 times.
✓ Branch 1 taken 291 times.
 1153915 if ( size > 0) {
1153 1153624 array->data = (lbm_uint*)lbm_malloc(size);
1154
2/2
✓ Branch 0 taken 9645 times.
✓ Branch 1 taken 1143979 times.
 1153624 if (array->data == NULL) {
1155 9645 lbm_memory_free((lbm_uint*)array);
1156 9645 goto allocate_array_merror;
1157 }
1158 // It is more important to zero out high-level arrays.
1159 // 0 is symbol NIL which is perfectly safe for the GC to inspect.
1160 1143979 memset(array->data, 0, size);
1161 }
1162 // allocating a cell for array's heap-presence
1163 1144270 lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);
1164
2/2
✓ Branch 0 taken 768 times.
✓ Branch 1 taken 1143502 times.
 1144270 if (cell == ENC_SYM_MERROR) {
1165 768 lbm_memory_free((lbm_uint*)array->data);
1166 768 lbm_memory_free((lbm_uint*)array);
1167 768 goto allocate_array_merror;
1168 }
1169 1143502 *res = cell;
1170 1143502 lbm_heap_state.num_alloc_arrays ++;
1171 1143502 return 1;
1172 }
1173 954 allocate_array_merror:
1174 11367 *res = ENC_SYM_MERROR;
1175 11367 return 0;
1176 }
1177
1178 589565 int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
1179 589565 return lbm_heap_allocate_array_base(res, true, size);
1180 }
1181
1182 565304 int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
1183 565304 return lbm_heap_allocate_array_base(res, false, size);
1184 }
1185
1186 107 int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
1187
1188 107 lbm_array_header_t *array = NULL;
1189 107 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, ENC_SYM_ARRAY_TYPE);
1190
1191
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 107 times.
 107 if (cell == ENC_SYM_MERROR) {
1192 ✗ *value = cell;
1193 ✗ return 0;
1194 }
1195
1196 107 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1197
1198
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 107 times.
 107 if (array == NULL) {
1199 ✗ lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL);
1200 ✗ *value = ENC_SYM_MERROR;
1201 ✗ return 0;
1202 }
1203
1204 107 array->data = (lbm_uint*)data;
1205 107 array->size = num_elt;
1206
1207 107 lbm_set_car(cell, (lbm_uint)array);
1208
1209 107 cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY);
1210 107 *value = cell;
1211 107 return 1;
1212 }
1213
1214 475010 lbm_int lbm_heap_array_get_size(lbm_value arr) {
1215
1216 475010 lbm_int r = -1;
1217 475010 lbm_array_header_t *header = lbm_dec_array_r(arr);
1218
1/2
✓ Branch 0 taken 475010 times.
✗ Branch 1 not taken.
 475010 if (header) {
1219 475010 r = (lbm_int)header->size;
1220 }
1221 475010 return r;
1222 }
1223
1224 237562 const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
1225 237562 uint8_t *r = NULL;
1226 237562 lbm_array_header_t *header = lbm_dec_array_r(arr);
1227
1/2
✓ Branch 0 taken 237562 times.
✗ Branch 1 not taken.
 237562 if (header) {
1228 237562 r = (uint8_t*)header->data;
1229 }
1230 237562 return r;
1231 }
1232
1233 /* Explicitly freeing an array.
1234
1235 This is a highly unsafe operation and can only be safely
1236 used if the heap cell that points to the array has not been made
1237 accessible to the program.
1238
1239 So This function can be used to free an array in case an array
1240 is being constructed and some error case appears while doing so
1241 If the array still have not become available it can safely be
1242 "explicitly" freed.
1243
1244 The problem is that if the "array" heap-cell is made available to
1245 the program, this cell can easily be duplicated and we would have
1246 to search the entire heap to find all cells pointing to the array
1247 memory in question and "null"-them out before freeing the memory
1248 */
1249
1250 224 int lbm_heap_explicit_free_array(lbm_value arr) {
1251
1252 224 int r = 0;
1253
2/4
✓ Branch 0 taken 224 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 224 times.
✗ Branch 3 not taken.
 224 if (lbm_is_array_rw(arr) && lbm_cdr(arr) == ENC_SYM_ARRAY_TYPE) {
1254 224 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1255
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 224 times.
 224 if (header == NULL) {
1256 ✗ return 0;
1257 }
1258 224 lbm_memory_free((lbm_uint*)header->data);
1259 224 lbm_memory_free((lbm_uint*)header);
1260
1261 224 arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS);
1262 224 lbm_set_car(arr, ENC_SYM_NIL);
1263 224 lbm_set_cdr(arr, ENC_SYM_NIL);
1264 224 r = 1;
1265 }
1266
1267 224 return r;
1268 }
1269
1270 ✗ static bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
1271 (void)ix;
1272 (void)val;
1273 ✗ return false;
1274 }
1275
1276 static const_heap_write_fun const_heap_write = dummy_flash_write;
1277
1278 44370 int lbm_const_heap_init(const_heap_write_fun w_fun,
1279 lbm_const_heap_t *heap,
1280 lbm_uint *addr) {
1281
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 44370 times.
 44370 if (((uintptr_t)addr % 4) != 0) return 0;
1282
1283
2/2
✓ Branch 0 taken 44302 times.
✓ Branch 1 taken 68 times.
 44370 if (!lbm_const_heap_mutex_initialized) {
1284 44302 mutex_init(&lbm_const_heap_mutex);
1285 44302 lbm_const_heap_mutex_initialized = true;
1286 }
1287
1288
2/2
✓ Branch 0 taken 44302 times.
✓ Branch 1 taken 68 times.
 44370 if (!lbm_mark_mutex_initialized) {
1289 44302 mutex_init(&lbm_mark_mutex);
1290 44302 lbm_mark_mutex_initialized = true;
1291 }
1292
1293 44370 const_heap_write = w_fun;
1294
1295 44370 heap->heap = addr;
1296 44370 heap->size = 0;
1297 44370 heap->next = 0;
1298
1299 44370 lbm_const_heap_state = heap;
1300 // ref_cell views the lbm_uint array as an lbm_cons_t array
1301 44370 lbm_heaps[1] = (lbm_cons_t*)addr;
1302 44370 return 1;
1303 }
1304
1305 4573 lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
1306 4573 lbm_flash_status r = LBM_FLASH_FULL;
1307
1308 4573 mutex_lock(&lbm_const_heap_mutex);
1309 // waste a cell if we have ended up unaligned after writing an array to flash.
1310
2/2
✓ Branch 0 taken 297 times.
✓ Branch 1 taken 4276 times.
 4573 if (lbm_const_heap_state->next % 2 == 1) {
1311 297 lbm_const_heap_state->next++;
1312 }
1313
1314
1/2
✓ Branch 0 taken 4573 times.
✗ Branch 1 not taken.
 4573 if (lbm_const_heap_state &&
1315
1/2
✓ Branch 0 taken 4573 times.
✗ Branch 1 not taken.
 4573 (lbm_const_heap_state->next+1) < (uint32_t)lbm_image_get_write_index()) {
1316 // A cons cell uses two words.
1317 4573 lbm_value cell = lbm_const_heap_state->next;
1318 4573 lbm_const_heap_state->next += 2;
1319 4573 *res = (cell << LBM_ADDRESS_SHIFT) | LBM_PTR_BIT | LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT;
1320 4573 r = LBM_FLASH_WRITE_OK;
1321 }
1322 4573 mutex_unlock(&lbm_const_heap_mutex);
1323 4573 return r;
1324 }
1325
1326 56 lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) {
1327 56 lbm_flash_status r = LBM_FLASH_FULL;
1328
1329
1/2
✓ Branch 0 taken 56 times.
✗ Branch 1 not taken.
 56 if (lbm_const_heap_state &&
1330
1/2
✓ Branch 0 taken 56 times.
✗ Branch 1 not taken.
 56 (lbm_const_heap_state->next + nwords) < (uint32_t)lbm_image_get_write_index()) {
1331 56 lbm_uint ix = lbm_const_heap_state->next;
1332 56 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1333 56 lbm_const_heap_state->next += nwords;
1334 56 r = LBM_FLASH_WRITE_OK;
1335 }
1336 56 return r;
1337 }
1338
1339 342153 lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {
1340
1341 342153 lbm_flash_status r = LBM_FLASH_FULL;
1342
1343
1/2
✓ Branch 0 taken 342153 times.
✗ Branch 1 not taken.
 342153 if (lbm_const_heap_state &&
1344
1/2
✓ Branch 0 taken 342153 times.
✗ Branch 1 not taken.
 342153 (lbm_const_heap_state->next + n) < (uint32_t)lbm_image_get_write_index()) {
1345 342153 lbm_uint ix = lbm_const_heap_state->next;
1346
1347
2/2
✓ Branch 0 taken 363752 times.
✓ Branch 1 taken 342153 times.
 705905 for (unsigned int i = 0; i < n; i ++) {
1348
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 363752 times.
 363752 if (!const_heap_write(((lbm_uint*)data)[i],ix + i))
1349 ✗ return LBM_FLASH_WRITE_ERROR;
1350 }
1351 342153 lbm_const_heap_state->next += n;
1352 342153 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1353 342153 r = LBM_FLASH_WRITE_OK;
1354 }
1355 342153 return r;
1356 }
1357
1358 168 lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) {
1359
1360
1/2
✓ Branch 0 taken 168 times.
✗ Branch 1 not taken.
 168 if (lbm_const_heap_state) {
1361 168 lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap;
1362 168 lbm_uint ix = (((lbm_uint)tgt - flash) / sizeof(lbm_uint)); // byte address to ix
1363
1/2
✓ Branch 0 taken 168 times.
✗ Branch 1 not taken.
 168 if (const_heap_write(val, ix)) {
1364 168 return LBM_FLASH_WRITE_OK;
1365 }
1366 ✗ return LBM_FLASH_WRITE_ERROR;
1367 }
1368 ✗ return LBM_FLASH_FULL;
1369 }
1370
1371 4573 lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
1372 4573 lbm_uint addr = lbm_dec_ptr(cell);
1373
1/2
✓ Branch 0 taken 4573 times.
✗ Branch 1 not taken.
 4573 if (const_heap_write(val, addr+1))
1374 4573 return LBM_FLASH_WRITE_OK;
1375 ✗ return LBM_FLASH_WRITE_ERROR;
1376 }
1377
1378 4573 lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
1379 4573 lbm_uint addr = lbm_dec_ptr(cell);
1380
1/2
✓ Branch 0 taken 4573 times.
✗ Branch 1 not taken.
 4573 if (const_heap_write(val, addr))
1381 4573 return LBM_FLASH_WRITE_OK;
1382 ✗ return LBM_FLASH_WRITE_ERROR;
1383 }
1384
1385 9 lbm_uint lbm_flash_memory_usage(void) {
1386 9 return lbm_const_heap_state->next;
1387 }
1388
1389
1390 // ////////////////////////////////////////////////////////////
1391 // pointer reversal traversal
1392 //
1393 // Caveats:
1394 // * Structures on the constant heap cannot be traversed using
1395 // pointer reversal. If a dynamic structure is pointing into the
1396 // constant heap, the 'f' will be applied to the constant cons cell on
1397 // the border and then traversal will retreat.
1398 //
1399 // * It may be impossible to detect all kinds of cycles
1400 // if attempting to use and restore the GC in a single pass
1401 // over the tree. To detect cycles all visited nodes must
1402 // remain detectable when traversing all branches!
1403 //
1404 // * Potential fix is to run GC after a complete traversal of the
1405 // entire value in order to restore the GC bits.
1406 //
1407 // * If we leave GC bits set when traversing values, we can use this
1408 // to detect cycles that happen in multiple steps accross values
1409 // in the environment.
1410 //
1411 // * lbm_ptr_rev_trav with the "do_nothing" travfun is the same thing
1412 // as a GC mark phase! Maybe utilize this for code-size
1413 // purposes. This also increases the amount of testing the
1414 // ptr_rev_trav function is subjected to.
1415
1416 456 void lbm_ptr_rev_trav(trav_fun f, lbm_value v, void* arg) {
1417
1418 456 lbm_value curr = v;
1419 456 lbm_value prev = lbm_enc_cons_ptr(LBM_PTR_NULL);
1420 while (true) {
1421
1422 // Run leftwards and process conses until
1423 // hitting a leaf in the left direction.
1424
1425 // If curr is marked here there is a cycle in the graph.
1426 // In case of a cycle or leaf, this first loop is exited.
1427
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 12000 times.
 35313 while (((lbm_is_cons_rw(curr)) ||
1428
4/4
✓ Branch 0 taken 12039 times.
✓ Branch 1 taken 11235 times.
✓ Branch 2 taken 11261 times.
✓ Branch 3 taken 13 times.
 23313 (lbm_is_lisp_array_rw(curr))) && !gc_marked(curr)) {
1429 11261 lbm_cons_t *cell = lbm_ref_cell(curr);
1430
2/2
✓ Branch 0 taken 11222 times.
✓ Branch 1 taken 39 times.
 11261 if (lbm_is_cons(curr)) {
1431 // In-order traversal
1432
2/2
✓ Branch 0 taken 14 times.
✓ Branch 1 taken 11208 times.
 11222 if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) {
1433 14 lbm_gc_mark_phase(curr);
1434 14 break;
1435 }
1436 11208 gc_mark(curr);
1437
1438 11208 lbm_value next = 0;
1439 11208 value_assign(&next, cell->car);
1440 11208 value_assign(&cell->car, prev);
1441 11208 value_assign(&prev, curr);
1442 11208 value_assign(&curr, next);
1443 } else { // it is an array
1444
1445 39 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1446 39 lbm_value *arr_data = (lbm_value *)arr->data;
1447 39 uint32_t index = arr->index;
1448
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 33 times.
 39 if (arr->size == 0) break;
1449
1/2
✓ Branch 0 taken 33 times.
✗ Branch 1 not taken.
 33 if (index == 0) { // index should only be 0 or there is a potential cycle
1450
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 33 times.
 33 if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) {
1451 ✗ lbm_gc_mark_phase(curr);
1452 ✗ break;
1453 }
1454 33 arr->index = 1;
1455 33 gc_mark(curr);
1456
1457 33 lbm_value next = 0;
1458 33 value_assign(&next, arr_data[0]);
1459 33 value_assign(&arr_data[0], prev);
1460 33 value_assign(&prev, curr);
1461 33 value_assign(&curr, next);
1462 }
1463 }
1464 }
1465 // Currently there are a few different users of this traversal.
1466 // size, flatten and detect_sharing.
1467 // detect_sharing make use of the shared (true) argument in f(curr, true, arg)
1468 // while the other do not. detect_sharing also assumes it is run once per env item
1469 // while not resetting any GC-bits in between. This detects global sharing.
1470
1471
4/4
✓ Branch 0 taken 363 times.
✓ Branch 1 taken 11670 times.
✓ Branch 2 taken 27 times.
✓ Branch 3 taken 336 times.
 12033 if (lbm_is_ptr(curr) && gc_marked(curr)) {
1472 // gc bit set so this subtree is already traversed.
1473 // f is called with true to indicate visited node.
1474 // if this happens during a sharing discovery phase, curr will be added to sharing table.
1475 27 f(curr, true, arg);
1476 // In this case f should not be able to return subtree continue.
1477 // The only correct return value from f is PROCEED.
1478
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 12003 times.
 12006 } else if (!lbm_is_cons(curr) || // Found a leaf
1479
1/2
✓ Branch 0 taken 3 times.
✗ Branch 1 not taken.
 3 (curr & LBM_PTR_TO_CONSTANT_BIT)) {
1480
4/4
✓ Branch 0 taken 336 times.
✓ Branch 1 taken 11670 times.
✓ Branch 2 taken 333 times.
✓ Branch 3 taken 3 times.
 12006 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.
1481 12006 f(curr, false, arg);
1482 }
1483
1484 // Now either prev has the "flag" set or it doesnt.
1485 // If the flag is set that means that the prev node
1486 // have had both its car and cdr visited. So that node is done!
1487 //
1488 // If the flag is not set, jump down to SWAP
1489
1490
2/2
✓ Branch 0 taken 22416 times.
✓ Branch 1 taken 456 times.
 46146 while ((lbm_is_cons(prev) &&
1491
2/2
✓ Branch 0 taken 11208 times.
✓ Branch 1 taken 11208 times.
 45288 (lbm_dec_ptr(prev) != LBM_PTR_NULL) && // is LBM_NULL a cons type?
1492
4/4
✓ Branch 0 taken 22872 times.
✓ Branch 1 taken 402 times.
✓ Branch 2 taken 402 times.
✓ Branch 3 taken 11664 times.
 57756 lbm_get_gc_flag(lbm_car(prev))) ||
1493 12066 lbm_is_lisp_array_rw(prev)) {
1494 11610 lbm_cons_t *cell = lbm_ref_cell(prev);
1495
2/2
✓ Branch 0 taken 11208 times.
✓ Branch 1 taken 402 times.
 11610 if (lbm_is_cons(prev)) {
1496
1497 // clear the flag
1498 // This means that we are done with a "CDR" child.
1499 // prev = [ a , b ][flag = 1]
1500 // =>
1501 // prev = [ a , b ][flag = 0]
1502
1503 //gc_clear_mark(prev);
1504 11208 cell->car = lbm_clr_gc_flag(cell->car);
1505 // Move on downwards until
1506 // finding a cons cell without flag or NULL
1507
1508 // curr = c
1509 // prev = [ a , b ][flag = 0]
1510 // =>
1511 // prev = [ a , c ][flag = 0]
1512 // curr = prev
1513 // prev = b
1514
1515 11208 lbm_value next = 0;
1516 11208 value_assign(&next, cell->cdr);
1517 11208 value_assign(&cell->cdr, curr);
1518 11208 value_assign(&curr, prev);
1519 11208 value_assign(&prev, next);
1520 } else { // is an array
1521 402 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1522 402 lbm_value *arr_data = (lbm_value *)arr->data;
1523 402 size_t arr_size = (size_t)arr->size / sizeof(lbm_value);
1524 402 lbm_value next = 0;
1525
2/2
✓ Branch 0 taken 33 times.
✓ Branch 1 taken 369 times.
 402 if (arr->index == arr_size) {
1526 33 value_assign(&next, arr_data[arr->index-1]);
1527 33 value_assign(&arr_data[arr->index-1], curr);
1528 33 value_assign(&curr, prev);
1529 33 value_assign(&prev, next);
1530 33 arr->index = 0;
1531 } else {
1532 369 break;
1533 }
1534 }
1535 }
1536
1537 // SWAP
1538
1539 // if the prev node is NULL we have traced backwards all the
1540 // way back to where curr == v. Another alternative is that
1541 // the input v was an Atom. We are done!
1542
3/4
✓ Branch 0 taken 12033 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 456 times.
✓ Branch 3 taken 11577 times.
 24066 if (lbm_is_ptr(prev) &&
1543 12033 lbm_dec_ptr(prev) == LBM_PTR_NULL) {
1544 456 if (lbm_is_cons(curr)) {
1545 //gc_clear_mark(curr);
1546 }
1547 //done = true;
1548 456 break;
1549 }
1550
1551 // if the prev node is not NULL then we should move
1552 // down to the prev node and start process its remaining child.
1553
2/2
✓ Branch 0 taken 11208 times.
✓ Branch 1 taken 369 times.
 11577 else if (lbm_is_cons(prev)) {
1554
1555 11208 lbm_cons_t *cell = lbm_ref_cell(prev);
1556 11208 lbm_value next = 0;
1557
1558
1559 // prev = [ p , cdr ][flag = 0]
1560 // =>
1561 // prev = [ p , cdr ][flag = 1]
1562
1563 11208 cell->car = lbm_set_gc_flag(cell->car);
1564
1565 // switch to processing the cdr field and set the flag.
1566 // curr = c
1567 // prev = [ a, b ][flag = 1]
1568 // =>
1569 // prev = [ c, a ][flag = 1]
1570 // curr = b
1571
1572 11208 value_assign(&next, cell->car);
1573 11208 value_assign(&cell->car, curr);
1574 11208 value_assign(&curr, cell->cdr);
1575 11208 value_assign(&cell->cdr, next);
1576
1/2
✓ Branch 0 taken 369 times.
✗ Branch 1 not taken.
 369 } else if (lbm_is_lisp_array_rw(prev)) {
1577 369 lbm_cons_t *cell = lbm_ref_cell(prev);
1578 369 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
1579 369 lbm_value *arr_data = (lbm_value *)arr->data;
1580 369 lbm_value next = 0;
1581
1582 369 value_assign(&next, arr_data[arr->index-1]);
1583 369 value_assign(&arr_data[arr->index-1], curr);
1584 369 value_assign(&curr, arr_data[arr->index]);
1585 369 value_assign(&arr_data[arr->index], next);
1586 369 arr->index = arr->index + 1;
1587 }
1588 }
1589 456 }
1590