GCC Code Coverage Report


Directory: ../src/
File: /home/joels/Current/lispbm/src/heap.c
Date: 2024-08-06 17:32:21
Exec Total Coverage
Lines: 573 804 71.3%
Functions: 65 85 76.5%
Branches: 206 343 60.1%

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