Bug Summary

File:heap.c
Warning:line 1254, column 19
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'header')

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -triple i386-pc-linux-gnu -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name heap.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model static -mthread-model posix -mframe-pointer=none -fmath-errno -fno-rounding-math -masm-verbose -mconstructor-aliases -target-cpu i686 -dwarf-column-info -fno-split-dwarf-inlining -debugger-tuning=gdb -resource-dir /usr/lib/llvm-10/lib/clang/10.0.0 -I ./include -I ./include/extensions -I platform/linux/include -D _PRELUDE -internal-isystem /usr/local/include -internal-isystem /usr/lib/llvm-10/lib/clang/10.0.0/include -internal-externc-isystem /usr/include/i386-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -std=c99 -fdebug-compilation-dir /home/joels/Current/lispbm -ferror-limit 19 -fmessage-length 0 -fgnuc-version=4.2.1 -fobjc-runtime=gcc -fdiagnostics-show-option -vectorize-loops -vectorize-slp -analyzer-output=html -faddrsig -o /home/joels/Current/lispbm/test_reports/version_0.26.0/scan-build/2024-08-06-173222-124214-1 -x c src/heap.c

src/heap.c

→
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
38static inline lbm_value lbm_set_gc_mark(lbm_value x) {
39 return x | LBM_GC_MARKED0x00000002u;
40}
41
42static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
43 return x & ~LBM_GC_MASK0x00000002u;
44}
45
46static inline bool_Bool lbm_get_gc_mark(lbm_value x) {
47 return x & LBM_GC_MASK0x00000002u;
48}
49
50// flag is the same bit as mark, but in car
51static inline bool_Bool lbm_get_gc_flag(lbm_value x) {
52 return x & LBM_GC_MARKED0x00000002u;
53}
54
55static inline lbm_value lbm_set_gc_flag(lbm_value x) {
56 return x | LBM_GC_MARKED0x00000002u;
57}
58
59static inline lbm_value lbm_clr_gc_flag(lbm_value x) {
60 return x & ~LBM_GC_MASK0x00000002u;
61}
62
63
64lbm_heap_state_t lbm_heap_state;
65
66lbm_const_heap_t *lbm_const_heap_state;
67
68lbm_cons_t *lbm_heaps[2] = {NULL((void*)0), NULL((void*)0)};
69
70static mutex_t lbm_const_heap_mutex;
71static bool_Bool lbm_const_heap_mutex_initialized = false0;
72
73static mutex_t lbm_mark_mutex;
74static bool_Bool lbm_mark_mutex_initialized = false0;
75
76#ifdef USE_GC_PTR_REV
77void lbm_gc_lock(void) {
78 mutex_lock(&lbm_mark_mutex);
79}
80void lbm_gc_unlock(void) {
81 mutex_unlock(&lbm_mark_mutex);
82}
83#else
84void lbm_gc_lock(void) {
85}
86void lbm_gc_unlock(void) {
87}
88#endif
89
90/****************************************************/
91/* ENCODERS DECODERS */
92
93lbm_value lbm_enc_i32(int32_t x) {
94#ifndef LBM64
95 lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE(((0x31) << 4) | 0x00000000u));
96 if (lbm_type_of(i) == LBM_TYPE_SYMBOL0x00000000u) return i;
97 return lbm_set_ptr_type(i, LBM_TYPE_I320x28000000u);
98#else
99 return (((lbm_uint)x) << LBM_VAL_SHIFT4) | LBM_TYPE_I320x28000000u;
100#endif
101}
102
103lbm_value lbm_enc_u32(uint32_t x) {
104#ifndef LBM64
105 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE(((0x32) << 4) | 0x00000000u));
106 if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
107 return lbm_set_ptr_type(u, LBM_TYPE_U320x38000000u);
108#else
109 return (((lbm_uint)x) << LBM_VAL_SHIFT4) | LBM_TYPE_U320x38000000u;
110#endif
111}
112
113lbm_value lbm_enc_float(float x) {
114#ifndef LBM64
115 lbm_uint t;
116 memcpy(&t, &x, sizeof(lbm_float));
117 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE(((0x33) << 4) | 0x00000000u));
118 if (lbm_type_of(f) == LBM_TYPE_SYMBOL0x00000000u) return f;
119 return lbm_set_ptr_type(f, LBM_TYPE_FLOAT0x68000000u);
120#else
121 lbm_uint t = 0;
122 memcpy(&t, &x, sizeof(float));
123 return (((lbm_uint)t) << LBM_VAL_SHIFT4) | LBM_TYPE_FLOAT0x68000000u;
124#endif
125}
126
127static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) {
128 lbm_value res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
129 res = lbm_cons(ENC_SYM_NIL(((0x0) << 4) | 0x00000000u),ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
130 if (lbm_type_of(res) != LBM_TYPE_SYMBOL0x00000000u) {
131 uint8_t* storage = lbm_malloc(sizeof(uint64_t));
132 if (storage) {
133 memcpy(storage,source, sizeof(uint64_t));
134 lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual);
135 res = lbm_set_ptr_type(res, type);
136 } else {
137 res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
138 }
139 }
140 return res;
141}
142
143lbm_value lbm_enc_i64(int64_t x) {
144#ifndef LBM64
145 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE(((0x34) << 4) | 0x00000000u), LBM_TYPE_I640x48000000u);
146#else
147 lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE(((0x31) << 4) | 0x00000000u));
148 if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
149 return lbm_set_ptr_type(u, LBM_TYPE_I640x48000000u);
150#endif
151}
152
153lbm_value lbm_enc_u64(uint64_t x) {
154#ifndef LBM64
155 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE(((0x35) << 4) | 0x00000000u), LBM_TYPE_U640x58000000u);
156#else
157 lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE(((0x32) << 4) | 0x00000000u));
158 if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
159 return lbm_set_ptr_type(u, LBM_TYPE_U640x58000000u);
160#endif
161}
162
163lbm_value lbm_enc_double(double x) {
164#ifndef LBM64
165 return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE(((0x36) << 4) | 0x00000000u), LBM_TYPE_DOUBLE0x78000000u);
166#else
167 lbm_uint t;
168 memcpy(&t, &x, sizeof(double));
169 lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE(((0x33) << 4) | 0x00000000u));
170 if (lbm_type_of(f) == LBM_TYPE_SYMBOL0x00000000u) return f;
171 return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE0x78000000u);
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
179float lbm_dec_float(lbm_value x) {
180#ifndef LBM64
181 float f_tmp;
182 lbm_uint tmp = lbm_car(x);
183 memcpy(&f_tmp, &tmp, sizeof(float));
184 return f_tmp;
185#else
186 uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT4);
187 float f_tmp;
188 memcpy(&f_tmp, &tmp, sizeof(float));
189 return f_tmp;
190#endif
191}
192
193double lbm_dec_double(lbm_value x) {
194#ifndef LBM64
195 double d;
196 uint32_t *data = (uint32_t*)lbm_car(x);
197 memcpy(&d, data, sizeof(double));
198 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
207uint64_t lbm_dec_u64(lbm_value x) {
208#ifndef LBM64
209 uint64_t u;
210 uint32_t *data = (uint32_t*)lbm_car(x);
211 memcpy(&u, data, 8);
212 return u;
213#else
214 return (uint64_t)lbm_car(x);
215#endif
216}
217
218int64_t lbm_dec_i64(lbm_value x) {
219#ifndef LBM64
220 int64_t i;
221 uint32_t *data = (uint32_t*)lbm_car(x);
222 memcpy(&i, data, 8);
223 return i;
224#else
225 return (int64_t)lbm_car(x);
226#endif
227}
228
229char *lbm_dec_str(lbm_value val) {
230 char *res = 0;
231 // If val is an array, car of val will be non-null.
232 if (lbm_is_array_r(val)) {
233 lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
234 res = (char *)array->data;
235 }
236 return res;
237}
238
239lbm_char_channel_t *lbm_dec_channel(lbm_value val) {
240 lbm_char_channel_t *res = NULL((void*)0);
241
242 if (lbm_type_of(val) == LBM_TYPE_CHANNEL0x90000000u) {
243 res = (lbm_char_channel_t *)lbm_car(val);
244 }
245 return res;
246}
247
248lbm_uint lbm_dec_custom(lbm_value val) {
249 lbm_uint res = 0;
250 if (lbm_type_of(val) == LBM_TYPE_CUSTOM0xA0000000u) {
251 res = (lbm_uint)lbm_car(val);
252 }
253 return res;
254}
255
256uint8_t lbm_dec_as_char(lbm_value a) {
257 switch (lbm_type_of_functional(a)) {
258 case LBM_TYPE_CHAR0x00000004u:
259 return (uint8_t) lbm_dec_char(a);
260 case LBM_TYPE_I0x00000008u:
261 return (uint8_t) lbm_dec_i(a);
262 case LBM_TYPE_U0x0000000Cu:
263 return (uint8_t) lbm_dec_u(a);
264 case LBM_TYPE_I320x28000000u:
265 return (uint8_t) lbm_dec_i32(a);
266 case LBM_TYPE_U320x38000000u:
267 return (uint8_t) lbm_dec_u32(a);
268 case LBM_TYPE_FLOAT0x68000000u:
269 return (uint8_t)lbm_dec_float(a);
270 case LBM_TYPE_I640x48000000u:
271 return (uint8_t) lbm_dec_i64(a);
272 case LBM_TYPE_U640x58000000u:
273 return (uint8_t) lbm_dec_u64(a);
274 case LBM_TYPE_DOUBLE0x78000000u:
275 return (uint8_t) lbm_dec_double(a);
276 }
277 return 0;
278}
279
280uint32_t lbm_dec_as_u32(lbm_value a) {
281 switch (lbm_type_of_functional(a)) {
282 case LBM_TYPE_CHAR0x00000004u:
283 return (uint32_t) lbm_dec_char(a);
284 case LBM_TYPE_I0x00000008u:
285 return (uint32_t) lbm_dec_i(a);
286 case LBM_TYPE_U0x0000000Cu:
287 return (uint32_t) lbm_dec_u(a);
288 case LBM_TYPE_I320x28000000u: /* fall through */
289 case LBM_TYPE_U320x38000000u:
290 return (uint32_t) lbm_dec_u32(a);
291 case LBM_TYPE_FLOAT0x68000000u:
292 return (uint32_t)lbm_dec_float(a);
293 case LBM_TYPE_I640x48000000u:
294 return (uint32_t) lbm_dec_i64(a);
295 case LBM_TYPE_U640x58000000u:
296 return (uint32_t) lbm_dec_u64(a);
297 case LBM_TYPE_DOUBLE0x78000000u:
298 return (uint32_t) lbm_dec_double(a);
299 }
300 return 0;
301}
302
303int32_t lbm_dec_as_i32(lbm_value a) {
304 switch (lbm_type_of_functional(a)) {
305 case LBM_TYPE_CHAR0x00000004u:
306 return (int32_t) lbm_dec_char(a);
307 case LBM_TYPE_I0x00000008u:
308 return (int32_t) lbm_dec_i(a);
309 case LBM_TYPE_U0x0000000Cu:
310 return (int32_t) lbm_dec_u(a);
311 case LBM_TYPE_I320x28000000u:
312 return (int32_t) lbm_dec_i32(a);
313 case LBM_TYPE_U320x38000000u:
314 return (int32_t) lbm_dec_u32(a);
315 case LBM_TYPE_FLOAT0x68000000u:
316 return (int32_t) lbm_dec_float(a);
317 case LBM_TYPE_I640x48000000u:
318 return (int32_t) lbm_dec_i64(a);
319 case LBM_TYPE_U640x58000000u:
320 return (int32_t) lbm_dec_u64(a);
321 case LBM_TYPE_DOUBLE0x78000000u:
322 return (int32_t) lbm_dec_double(a);
323
324 }
325 return 0;
326}
327
328int64_t lbm_dec_as_i64(lbm_value a) {
329 switch (lbm_type_of_functional(a)) {
330 case LBM_TYPE_CHAR0x00000004u:
331 return (int64_t) lbm_dec_char(a);
332 case LBM_TYPE_I0x00000008u:
333 return lbm_dec_i(a);
334 case LBM_TYPE_U0x0000000Cu:
335 return (int64_t) lbm_dec_u(a);
336 case LBM_TYPE_I320x28000000u:
337 return (int64_t) lbm_dec_i32(a);
338 case LBM_TYPE_U320x38000000u:
339 return (int64_t) lbm_dec_u32(a);
340 case LBM_TYPE_FLOAT0x68000000u:
341 return (int64_t) lbm_dec_float(a);
342 case LBM_TYPE_I640x48000000u:
343 return (int64_t) lbm_dec_i64(a);
344 case LBM_TYPE_U640x58000000u:
345 return (int64_t) lbm_dec_u64(a);
346 case LBM_TYPE_DOUBLE0x78000000u:
347 return (int64_t) lbm_dec_double(a);
348 }
349 return 0;
350}
351
352uint64_t lbm_dec_as_u64(lbm_value a) {
353 switch (lbm_type_of_functional(a)) {
354 case LBM_TYPE_CHAR0x00000004u:
355 return (uint64_t) lbm_dec_char(a);
356 case LBM_TYPE_I0x00000008u:
357 return (uint64_t) lbm_dec_i(a);
358 case LBM_TYPE_U0x0000000Cu:
359 return lbm_dec_u(a);
360 case LBM_TYPE_I320x28000000u:
361 return (uint64_t) lbm_dec_i32(a);
362 case LBM_TYPE_U320x38000000u:
363 return (uint64_t) lbm_dec_u32(a);
364 case LBM_TYPE_FLOAT0x68000000u:
365 return (uint64_t)lbm_dec_float(a);
366 case LBM_TYPE_I640x48000000u:
367 return (uint64_t) lbm_dec_i64(a);
368 case LBM_TYPE_U640x58000000u:
369 return (uint64_t) lbm_dec_u64(a);
370 case LBM_TYPE_DOUBLE0x78000000u:
371 return (uint64_t) lbm_dec_double(a);
372 }
373 return 0;
374}
375
376lbm_uint lbm_dec_as_uint(lbm_value a) {
377 switch (lbm_type_of_functional(a)) {
378 case LBM_TYPE_CHAR0x00000004u:
379 return (lbm_uint) lbm_dec_char(a);
380 case LBM_TYPE_I0x00000008u:
381 return (lbm_uint) lbm_dec_i(a);
382 case LBM_TYPE_U0x0000000Cu:
383 return (lbm_uint) lbm_dec_u(a);
384 case LBM_TYPE_I320x28000000u:
385 return (lbm_uint) lbm_dec_i32(a);
386 case LBM_TYPE_U320x38000000u:
387 return (lbm_uint) lbm_dec_u32(a);
388 case LBM_TYPE_FLOAT0x68000000u:
389 return (lbm_uint) lbm_dec_float(a);
390 case LBM_TYPE_I640x48000000u:
391 return (lbm_uint) lbm_dec_i64(a);
392 case LBM_TYPE_U640x58000000u:
393 return (lbm_uint) lbm_dec_u64(a);
394 case LBM_TYPE_DOUBLE0x78000000u:
395 return (lbm_uint) lbm_dec_double(a);
396 }
397 return 0;
398}
399
400lbm_int lbm_dec_as_int(lbm_value a) {
401 switch (lbm_type_of_functional(a)) {
402 case LBM_TYPE_CHAR0x00000004u:
403 return (lbm_int) lbm_dec_char(a);
404 case LBM_TYPE_I0x00000008u:
405 return (lbm_int) lbm_dec_i(a);
406 case LBM_TYPE_U0x0000000Cu:
407 return (lbm_int) lbm_dec_u(a);
408 case LBM_TYPE_I320x28000000u:
409 return (lbm_int) lbm_dec_i32(a);
410 case LBM_TYPE_U320x38000000u:
411 return (lbm_int) lbm_dec_u32(a);
412 case LBM_TYPE_FLOAT0x68000000u:
413 return (lbm_int)lbm_dec_float(a);
414 case LBM_TYPE_I640x48000000u:
415 return (lbm_int) lbm_dec_i64(a);
416 case LBM_TYPE_U640x58000000u:
417 return (lbm_int) lbm_dec_u64(a);
418 case LBM_TYPE_DOUBLE0x78000000u:
419 return (lbm_int) lbm_dec_double(a);
420 }
421 return 0;
422}
423
424float lbm_dec_as_float(lbm_value a) {
425
426 switch (lbm_type_of_functional(a)) {
427 case LBM_TYPE_CHAR0x00000004u:
428 return (float) lbm_dec_char(a);
429 case LBM_TYPE_I0x00000008u:
430 return (float) lbm_dec_i(a);
431 case LBM_TYPE_U0x0000000Cu:
432 return (float) lbm_dec_u(a);
433 case LBM_TYPE_I320x28000000u:
434 return (float) lbm_dec_i32(a);
435 case LBM_TYPE_U320x38000000u:
436 return (float) lbm_dec_u32(a);
437 case LBM_TYPE_FLOAT0x68000000u:
438 return (float) lbm_dec_float(a);
439 case LBM_TYPE_I640x48000000u:
440 return (float) lbm_dec_i64(a);
441 case LBM_TYPE_U640x58000000u:
442 return (float) lbm_dec_u64(a);
443 case LBM_TYPE_DOUBLE0x78000000u:
444 return (float) lbm_dec_double(a);
445 }
446 return 0;
447}
448
449double lbm_dec_as_double(lbm_value a) {
450
451 switch (lbm_type_of_functional(a)) {
452 case LBM_TYPE_CHAR0x00000004u:
453 return (double) lbm_dec_char(a);
454 case LBM_TYPE_I0x00000008u:
455 return (double) lbm_dec_i(a);
456 case LBM_TYPE_U0x0000000Cu:
457 return (double) lbm_dec_u(a);
458 case LBM_TYPE_I320x28000000u:
459 return (double) lbm_dec_i32(a);
460 case LBM_TYPE_U320x38000000u:
461 return (double) lbm_dec_u32(a);
462 case LBM_TYPE_FLOAT0x68000000u:
463 return (double) lbm_dec_float(a);
464 case LBM_TYPE_I640x48000000u:
465 return (double) lbm_dec_i64(a);
466 case LBM_TYPE_U640x58000000u:
467 return (double) lbm_dec_u64(a);
468 case LBM_TYPE_DOUBLE0x78000000u:
469 return (double) lbm_dec_double(a);
470 }
471 return 0;
472}
473
474/****************************************************/
475/* HEAP MANAGEMENT */
476
477static int generate_freelist(size_t num_cells) {
478 size_t i = 0;
479
480 if (!lbm_heap_state.heap) return 0;
481
482 lbm_heap_state.freelist = lbm_enc_cons_ptr(0);
483
484 lbm_cons_t *t;
485
486 // Add all cells to free list
487 for (i = 1; i < num_cells; i ++) {
488 t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
489 t->car = ENC_SYM_RECOVERED(((0x28) << 4) | 0x00000000u); // all cars in free list are "RECOVERED"
490 t->cdr = lbm_enc_cons_ptr(i);
491 }
492
493 // Replace the incorrect pointer at the last cell.
494 t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
495 t->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
496
497 return 1;
498}
499
500void lbm_nil_freelist(void) {
501 lbm_heap_state.freelist = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
502 lbm_heap_state.num_alloc = lbm_heap_state.heap_size;
503}
504
505static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells,
506 lbm_uint* gc_stack_storage, lbm_uint gc_stack_size) {
507 lbm_heap_state.heap = addr;
508 lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t));
509 lbm_heap_state.heap_size = num_cells;
510
511 lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size);
512
513 lbm_heap_state.num_alloc = 0;
514 lbm_heap_state.num_alloc_arrays = 0;
515 lbm_heap_state.gc_num = 0;
516 lbm_heap_state.gc_marked = 0;
517 lbm_heap_state.gc_recovered = 0;
518 lbm_heap_state.gc_recovered_arrays = 0;
519 lbm_heap_state.gc_least_free = num_cells;
520 lbm_heap_state.gc_last_free = num_cells;
521}
522
523void lbm_heap_new_freelist_length(void) {
524 lbm_uint l = lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
525 lbm_heap_state.gc_last_free = l;
526 if (l < lbm_heap_state.gc_least_free)
527 lbm_heap_state.gc_least_free = l;
528}
529
530int lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
531 lbm_uint gc_stack_size) {
532
533 if (((uintptr_t)addr % 8) != 0) return 0;
534
535 memset(addr,0, sizeof(lbm_cons_t) * num_cells);
536
537 lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint));
538 if (gc_stack_storage == NULL((void*)0)) return 0;
539
540 heap_init_state(addr, num_cells,
541 gc_stack_storage, gc_stack_size);
542
543 lbm_heaps[0] = addr;
544
545 return generate_freelist(num_cells);
546}
547
548lbm_uint lbm_heap_num_free(void) {
549 return lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
550}
551
552lbm_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 res = lbm_heap_state.freelist;
556 if (lbm_type_of(res) == LBM_TYPE_CONS0x10000000u) {
557 lbm_uint heap_ix = lbm_dec_ptr(res);
558 lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
559 lbm_heap_state.num_alloc++;
560 lbm_heap_state.heap[heap_ix].car = car;
561 lbm_heap_state.heap[heap_ix].cdr = cdr;
562 res = lbm_set_ptr_type(res, ptr_type);
563 return res;
564 }
565 return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
566}
567
568lbm_value lbm_heap_allocate_list(lbm_uint n) {
569 if (n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
570 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
571
572 lbm_value curr = lbm_heap_state.freelist;
573 lbm_value res = curr;
574 if (lbm_type_of(curr) == LBM_TYPE_CONS0x10000000u) {
575
576 lbm_cons_t *c_cell = NULL((void*)0);
577 lbm_uint count = 0;
578 do {
579 c_cell = lbm_ref_cell(curr);
580 c_cell->car = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
581 curr = c_cell->cdr;
582 count ++;
583 } while (count < n);
584 lbm_heap_state.freelist = curr;
585 c_cell->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
586 lbm_heap_state.num_alloc+=count;
587 return res;
588 }
589 return ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
590}
591
592lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) {
593 if (n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
594 if (lbm_heap_num_free() < n) return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
595
596 lbm_value curr = lbm_heap_state.freelist;
597 lbm_value res = curr;
598 if (lbm_type_of(curr) == LBM_TYPE_CONS0x10000000u) {
599
600 lbm_cons_t *c_cell = NULL((void*)0);
601 unsigned int count = 0;
602 do {
603 c_cell = lbm_ref_cell(curr);
604 c_cell->car = va_arg(valist, lbm_value)__builtin_va_arg(valist, lbm_value);
605 curr = c_cell->cdr;
606 count ++;
607 } while (count < n);
608 lbm_heap_state.freelist = curr;
609 c_cell->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
610 lbm_heap_state.num_alloc+=count;
611 return res;
612 }
613 return ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
614}
615
616lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) {
617 va_list valist;
618 va_start(valist, n)__builtin_va_start(valist, n);
619 lbm_value r = lbm_heap_allocate_list_init_va(n, valist);
620 va_end(valist)__builtin_va_end(valist);
621 return r;
622}
623
624lbm_uint lbm_heap_num_allocated(void) {
625 return lbm_heap_state.num_alloc;
626}
627lbm_uint lbm_heap_size(void) {
628 return lbm_heap_state.heap_size;
629}
630
631lbm_uint lbm_heap_size_bytes(void) {
632 return lbm_heap_state.heap_bytes;
633}
634
635void lbm_get_heap_state(lbm_heap_state_t *res) {
636 *res = lbm_heap_state;
637}
638
639lbm_uint lbm_get_gc_stack_max(void) {
640 return lbm_heap_state.gc_stack.max_sp;
641}
642
643lbm_uint lbm_get_gc_stack_size(void) {
644 return lbm_heap_state.gc_stack.size;
645}
646
647#ifdef USE_GC_PTR_REV
648static inline void value_assign(lbm_value *a, lbm_value b) {
649 lbm_value a_old = *a & LBM_GC_MASK0x00000002u;
650 *a = a_old | (b & ~LBM_GC_MASK0x00000002u);
651}
652
653void lbm_gc_mark_phase(lbm_value root) {
654 bool_Bool work_to_do = true1;
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(0x03FFFFFCu >> 2));
661
662 while (work_to_do) {
663 // follow leftwards pointers
664 while (lbm_is_ptr(curr) &&
665 (lbm_dec_ptr(curr) != LBM_PTR_NULL(0x03FFFFFCu >> 2)) &&
666 ((curr & LBM_PTR_TO_CONSTANT_BIT0x04000000u) == 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(0x03FFFFFCu >> 2)) &&
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(0x03FFFFFCu >> 2)) {
694 work_to_do = false0;
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
710extern eval_context_t *ctx_running;
711void lbm_gc_mark_phase(lbm_value root) {
712 lbm_value t_ptr;
713 lbm_stack_t *s = &lbm_heap_state.gc_stack;
714 s->data[s->sp++] = root;
715
716 while (!lbm_stack_is_empty(s)) {
717 lbm_value curr;
718 lbm_pop(s, &curr);
719
720 mark_shortcut:
721
722 if (!lbm_is_ptr(curr) ||
723 (curr & LBM_PTR_TO_CONSTANT_BIT0x04000000u)) {
724 continue;
725 }
726
727 lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)];
728
729 if (lbm_get_gc_mark(cell->cdr)) {
730 continue;
731 }
732
733 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 if (t_ptr == LBM_TYPE_LISPARRAY0xB0000000u) {
739 lbm_push(s, curr); // put array back as bookkeeping.
740 lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
741 lbm_value *arrdata = (lbm_value *)arr->data;
742 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 if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT0x04000000u) == 0) &&
748 !((arrdata[index] & LBM_CONTINUATION_INTERNAL0xF8000001u) == LBM_CONTINUATION_INTERNAL0xF8000001u)) {
749 lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])];
750 if (!lbm_get_gc_mark(elt->cdr)) {
751 curr = arrdata[index];
752 goto mark_shortcut;
753 }
754 }
755 if (index < ((arr->size/(sizeof(lbm_value))) - 1)) {
756 arr->index++;
757 continue;
758 }
759
760 arr->index = 0;
761 cell->cdr = lbm_set_gc_mark(cell->cdr);
762 lbm_heap_state.gc_marked ++;
763 lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it.
764 continue;
765 }
766
767 cell->cdr = lbm_set_gc_mark(cell->cdr);
768 lbm_heap_state.gc_marked ++;
769
770 if (t_ptr == LBM_TYPE_CONS0x10000000u) {
771 if (lbm_is_ptr(cell->cdr)) {
772 if (!lbm_push(s, cell->cdr)) {
773 lbm_critical_error();
774 break;
775 }
776 }
777 curr = cell->car;
778 goto mark_shortcut; // Skip a push/pop
779 }
780 }
781}
782#endif
783
784//Environments are proper lists with a 2 element list stored in each car.
785void lbm_gc_mark_env(lbm_value env) {
786 lbm_value curr = env;
787 lbm_cons_t *c;
788
789 while (lbm_is_ptr(curr)) {
790 c = lbm_ref_cell(curr);
791 c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
792 lbm_cons_t *b = lbm_ref_cell(c->car);
793 b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
794 lbm_gc_mark_phase(b->cdr); // mark the bound object.
795 lbm_heap_state.gc_marked +=2;
796 curr = c->cdr;
797 }
798}
799
800
801void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
802 for (lbm_uint i = 0; i < aux_size; i ++) {
803 if (lbm_is_ptr(aux_data[i])) {
804 lbm_type pt_t = lbm_type_of(aux_data[i]);
805 lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
806 if( pt_t >= LBM_POINTER_TYPE_FIRST0x10000000u &&
807 pt_t <= LBM_POINTER_TYPE_LAST0xBC000000u &&
808 pt_v < lbm_heap_state.heap_size) {
809 lbm_gc_mark_phase(aux_data[i]);
810 }
811 }
812 }
813}
814
815void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
816 for (lbm_uint i = 0; i < num_roots; i ++) {
817 lbm_gc_mark_phase(roots[i]);
818 }
819}
820
821// Sweep moves non-marked heap objects to the free list.
822int lbm_gc_sweep_phase(void) {
823 unsigned int i = 0;
824 lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap;
825
826 for (i = 0; i < lbm_heap_state.heap_size; i ++) {
827 if ( lbm_get_gc_mark(heap[i].cdr)) {
828 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 if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL0x00000000u) {
833 switch(heap[i].cdr) {
834
835 case ENC_SYM_IND_I_TYPE(((0x34) << 4) | 0x00000000u): /* fall through */
836 case ENC_SYM_IND_U_TYPE(((0x35) << 4) | 0x00000000u):
837 case ENC_SYM_IND_F_TYPE(((0x36) << 4) | 0x00000000u):
838 lbm_memory_free((lbm_uint*)heap[i].car);
839 break;
840 case ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u): /* fall through */
841 case ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u):{
842 lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
843 if (lbm_memory_ptr_inside((lbm_uint*)arr->data)) {
844 lbm_memory_free((lbm_uint *)arr->data);
845 lbm_heap_state.gc_recovered_arrays++;
846 }
847 lbm_memory_free((lbm_uint *)arr);
848 } break;
849 case ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u):{
850 lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car;
851 if (lbm_memory_ptr_inside((lbm_uint*)chan)) {
852 lbm_memory_free((lbm_uint*)chan->state);
853 lbm_memory_free((lbm_uint*)chan);
854 }
855 } break;
856 case ENC_SYM_CUSTOM_TYPE(((0x38) << 4) | 0x00000000u): {
857 lbm_uint *t = (lbm_uint*)heap[i].car;
858 lbm_custom_type_destroy(t);
859 lbm_memory_free(t);
860 } break;
861 default:
862 break;
863 }
864 }
865 // create pointer to use as new freelist
866 lbm_uint addr = lbm_enc_cons_ptr(i);
867
868 // Clear the "freed" cell.
869 heap[i].car = ENC_SYM_RECOVERED(((0x28) << 4) | 0x00000000u);
870 heap[i].cdr = lbm_heap_state.freelist;
871 lbm_heap_state.freelist = addr;
872 lbm_heap_state.num_alloc --;
873 lbm_heap_state.gc_recovered ++;
874 }
875 }
876 return 1;
877}
878
879void lbm_gc_state_inc(void) {
880 lbm_heap_state.gc_num ++;
881 lbm_heap_state.gc_recovered = 0;
882 lbm_heap_state.gc_marked = 0;
883}
884
885// construct, alter and break apart
886lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
887 return lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, car, cdr);
888}
889
890lbm_value lbm_car(lbm_value c){
891
892 if (lbm_is_ptr(c) ){
8
←
Taking false branch
→
893 lbm_cons_t *cell = lbm_ref_cell(c);
894 return cell->car;
895 }
896
897 if (lbm_is_symbol_nil(c)) {
9
←
Calling 'lbm_is_symbol_nil'
→
12
←
Returning from 'lbm_is_symbol_nil'
→
13
←
Taking true branch
→
898 return c; // if nil, return nil.
14
←
Returning zero (loaded from 'c')
→
899 }
900
901 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
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
908lbm_value lbm_caar(lbm_value c) {
909
910 lbm_value tmp;
911
912 if (lbm_is_ptr(c)) {
913 tmp = lbm_ref_cell(c)->car;
914
915 if (lbm_is_ptr(tmp)) {
916 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(((0x21) << 4) | 0x00000000u);
924}
925
926
927lbm_value lbm_cadr(lbm_value c) {
928
929 lbm_value tmp;
930
931 if (lbm_is_ptr(c)) {
932 tmp = lbm_ref_cell(c)->cdr;
933
934 if (lbm_is_ptr(tmp)) {
935 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(((0x21) << 4) | 0x00000000u);
943}
944
945lbm_value lbm_cdr(lbm_value c){
946 if (lbm_is_ptr(c)) {
947 lbm_cons_t *cell = lbm_ref_cell(c);
948 return cell->cdr;
949 }
950 if (lbm_is_symbol_nil(c)) {
951 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
952 }
953 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
954}
955
956lbm_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(((0x0) << 4) | 0x00000000u);
965 }
966 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
967}
968
969int lbm_set_car(lbm_value c, lbm_value v) {
970 int r = 0;
971
972 if (lbm_type_of(c) == LBM_TYPE_CONS0x10000000u) {
973 lbm_cons_t *cell = lbm_ref_cell(c);
974 cell->car = v;
975 r = 1;
976 }
977 return r;
978}
979
980int lbm_set_cdr(lbm_value c, lbm_value v) {
981 int r = 0;
982 if (lbm_is_cons_rw(c)){
983 lbm_cons_t *cell = lbm_ref_cell(c);
984 cell->cdr = v;
985 r = 1;
986 }
987 return r;
988}
989
990int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
991 int r = 0;
992 if (lbm_is_cons_rw(c)) {
993 lbm_cons_t *cell = lbm_ref_cell(c);
994 cell->car = car_val;
995 cell->cdr = cdr_val;
996 r = 1;
997 }
998 return r;
999}
1000
1001/* calculate length of a proper list */
1002lbm_uint lbm_list_length(lbm_value c) {
1003 lbm_uint len = 0;
1004
1005 while (lbm_is_cons(c)){
1006 len ++;
1007 c = lbm_cdr(c);
1008 }
1009 return len;
1010}
1011
1012/* calculate the length of a list and check that each element
1013 fullfills the predicate pred */
1014unsigned int lbm_list_length_pred(lbm_value c, bool_Bool *pres, bool_Bool (*pred)(lbm_value)) {
1015 bool_Bool res = true1;
1016 unsigned int len = 0;
1017
1018 while (lbm_is_cons(c)){
1019 len ++;
1020 res = res && pred(lbm_car(c));
1021 c = lbm_cdr(c);
1022 }
1023 *pres = res;
1024 return len;
1025}
1026
1027/* reverse a proper list */
1028lbm_value lbm_list_reverse(lbm_value list) {
1029 if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
1030 return list;
1031 }
1032
1033 lbm_value curr = list;
1034
1035 lbm_value new_list = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
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_SYMBOL0x00000000u) {
1040 return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1041 }
1042 curr = lbm_cdr(curr);
1043 }
1044 return new_list;
1045}
1046
1047lbm_value lbm_list_destructive_reverse(lbm_value list) {
1048 if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
1049 return list;
1050 }
1051 lbm_value curr = list;
1052 lbm_value last_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1053
1054 while (lbm_is_cons_rw(curr)) {
1055 lbm_value next = lbm_cdr(curr);
1056 lbm_set_cdr(curr, last_cell);
1057 last_cell = curr;
1058 curr = next;
1059 }
1060 return last_cell;
1061}
1062
1063
1064lbm_value lbm_list_copy(int *m, lbm_value list) {
1065 lbm_value curr = list;
1066 lbm_uint n = lbm_list_length(list);
1067 lbm_uint copy_n = n;
1068 if (*m >= 0 && (lbm_uint)*m < n) {
1069 copy_n = (lbm_uint)*m;
1070 } else if (*m == -1) {
1071 *m = (int)n; // TODO: smaller range in target variable.
1072 }
1073 if (copy_n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1074 lbm_uint new_list = lbm_heap_allocate_list(copy_n);
1075 if (lbm_is_symbol(new_list)) return new_list;
1076 lbm_value curr_targ = new_list;
1077
1078 while (lbm_is_cons(curr) && copy_n > 0) {
1079 lbm_value v = lbm_car(curr);
1080 lbm_set_car(curr_targ, v);
1081 curr_targ = lbm_cdr(curr_targ);
1082 curr = lbm_cdr(curr);
1083 copy_n --;
1084 }
1085
1086 return new_list;
1087}
1088
1089// Append for proper lists only
1090// Destructive update of list1.
1091lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
1092
1093 if(lbm_is_list_rw(list1) &&
1094 lbm_is_list(list2)) {
1095
1096 lbm_value curr = list1;
1097 while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS0x10000000u) {
1098 curr = lbm_cdr(curr);
1099 }
1100 if (lbm_is_symbol_nil(curr)) return list2;
1101 lbm_set_cdr(curr, list2);
1102 return list1;
1103 }
1104 return ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u);
1105}
1106
1107lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
1108 lbm_value curr = ls;
1109 while (lbm_type_of_functional(curr) == LBM_TYPE_CONS0x10000000u &&
1110 n > 0) {
1111 curr = lbm_cdr(curr);
1112 n --;
1113 }
1114 return curr;
1115}
1116
1117lbm_value lbm_index_list(lbm_value l, int32_t n) {
1118 lbm_value curr = l;
1119
1120 if (n < 0) {
1121 int32_t len = (int32_t)lbm_list_length(l);
1122 n = len + n;
1123 if (n < 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1124 }
1125
1126 while (lbm_is_cons(curr) &&
1127 n > 0) {
1128 curr = lbm_cdr(curr);
1129 n --;
1130 }
1131 if (lbm_is_cons(curr)) {
1132 return lbm_car(curr);
1133 } else {
1134 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
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".
1144int lbm_heap_allocate_array_base(lbm_value *res, bool_Bool byte_array, lbm_uint size){
1145
1146 lbm_array_header_t *array = NULL((void*)0);
1147
1148 if (byte_array) {
1149 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1150 } else {
1151 // an extra 32bit quantity for a GC index.
1152 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
1153 }
1154
1155 if (array == NULL((void*)0)) {
1156 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1157 return 0;
1158 }
1159
1160 lbm_uint tag = ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u);
1161 lbm_uint type = LBM_TYPE_ARRAY0x80000000u;
1162 if (!byte_array) {
1163 tag = ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u);
1164 type = LBM_TYPE_LISPARRAY0xB0000000u;
1165 size = sizeof(lbm_value) * size;
1166 lbm_array_header_extended_t *ext_array = (lbm_array_header_extended_t*)array;
1167 ext_array->index = 0;
1168 }
1169
1170 array->data = (lbm_uint*)lbm_malloc(size);
1171
1172 if (array->data == NULL((void*)0)) {
1173 lbm_memory_free((lbm_uint*)array);
1174 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1175 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 memset(array->data, 0, size);
1180 array->size = size;
1181
1182 // allocating a cell for array's heap-presence
1183 lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);
1184
1185 *res = cell;
1186
1187 if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // Out of heap memory
1188 lbm_memory_free((lbm_uint*)array->data);
1189 lbm_memory_free((lbm_uint*)array);
1190 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1191 return 0;
1192 }
1193
1194 lbm_heap_state.num_alloc_arrays ++;
1195
1196 return 1;
1197}
1198
1199int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
1200 return lbm_heap_allocate_array_base(res, true1, size);
1201}
1202
1203int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
1204 return lbm_heap_allocate_array_base(res, false0, 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.
1209int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
1210
1211 lbm_array_header_t *array = NULL((void*)0);
1212 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u));
1213
1214 if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // 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((void*)0)) {
1222 lbm_set_car_and_cdr(cell, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1223 *value = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
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_ARRAY0x80000000u);
1233 *value = cell;
1234 return 1;
1235}
1236
1237lbm_int lbm_heap_array_get_size(lbm_value arr) {
1238
1239 lbm_int r = -1;
1240 if (lbm_is_array_r(arr)) {
1241 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1242 if (header == NULL((void*)0)) {
1243 return r;
1244 }
1245 r = (lbm_int)header->size;
1246 }
1247 return r;
1248}
1249
1250const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
1251 uint8_t *r = NULL((void*)0);
1252 if (lbm_is_array_r(arr)) {
1
Calling 'lbm_is_array_r'
→
4
←
Returning from 'lbm_is_array_r'
→
5
←
Taking true branch
→
1253 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
6
←
Passing value via 1st parameter 'c'
→
7
←
Calling 'lbm_car'
→
15
←
Returning from 'lbm_car'
→
16
←
'header' initialized to a null pointer value
→
1254 r = (uint8_t*)header->data;
17
←
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'header')
1255 }
1256 return r;
1257}
1258
1259uint8_t *lbm_heap_array_get_data_rw(lbm_value arr) {
1260 uint8_t *r = NULL((void*)0);
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
1286int 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((void*)0)) {
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_CONS0x10000000u);
1299 lbm_set_car(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1300 lbm_set_cdr(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1301 r = 1;
1302 }
1303
1304 return r;
1305}
1306
1307lbm_uint lbm_size_of(lbm_type t) {
1308 lbm_uint s = 0;
1309 switch(t) {
1310 case LBM_TYPE_BYTE0x00000004u:
1311 s = 1;
1312 break;
1313 case LBM_TYPE_I0x00000008u: /* fall through */
1314 case LBM_TYPE_U0x0000000Cu:
1315 case LBM_TYPE_SYMBOL0x00000000u:
1316 s = sizeof(lbm_uint);
1317 break;
1318 case LBM_TYPE_I320x28000000u: /* fall through */
1319 case LBM_TYPE_U320x38000000u:
1320 case LBM_TYPE_FLOAT0x68000000u:
1321 s = 4;
1322 break;
1323 case LBM_TYPE_I640x48000000u: /* fall through */
1324 case LBM_TYPE_U640x58000000u:
1325 case LBM_TYPE_DOUBLE0x78000000u:
1326 s = 8;
1327 break;
1328 }
1329 return s;
1330}
1331
1332static bool_Bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
1333 (void)ix;
1334 (void)val;
1335 return false0;
1336}
1337
1338static const_heap_write_fun const_heap_write = dummy_flash_write;
1339
1340int 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 if (((uintptr_t)addr % 4) != 0) return 0;
1345 if ((num_words % 2) != 0) return 0;
1346
1347 if (!lbm_const_heap_mutex_initialized) {
1348 mutex_init(&lbm_const_heap_mutex);
1349 lbm_const_heap_mutex_initialized = true1;
1350 }
1351
1352 if (!lbm_mark_mutex_initialized) {
1353 mutex_init(&lbm_mark_mutex);
1354 lbm_mark_mutex_initialized = true1;
1355 }
1356
1357 const_heap_write = w_fun;
1358
1359 heap->heap = addr;
1360 heap->size = num_words;
1361 heap->next = 0;
1362
1363 lbm_const_heap_state = heap;
1364 // ref_cell views the lbm_uint array as an lbm_cons_t array
1365 lbm_heaps[1] = (lbm_cons_t*)addr;
1366 return 1;
1367}
1368
1369lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
1370 lbm_flash_status r = LBM_FLASH_FULL;
1371
1372 mutex_lock(&lbm_const_heap_mutex);
1373 // waste a cell if we have ended up unaligned after writing an array to flash.
1374 if (lbm_const_heap_state->next % 2 == 1) {
1375 lbm_const_heap_state->next++;
1376 }
1377
1378 if (lbm_const_heap_state &&
1379 (lbm_const_heap_state->next+1) < lbm_const_heap_state->size) {
1380 // A cons cell uses two words.
1381 lbm_value cell = lbm_const_heap_state->next;
1382 lbm_const_heap_state->next += 2;
1383 *res = (cell << LBM_ADDRESS_SHIFT2) | LBM_PTR_BIT0x00000001u | LBM_TYPE_CONS0x10000000u | LBM_PTR_TO_CONSTANT_BIT0x04000000u;
1384 r = LBM_FLASH_WRITE_OK;
1385 }
1386 mutex_unlock(&lbm_const_heap_mutex);
1387 return r;
1388}
1389
1390lbm_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
1403lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {
1404
1405 lbm_flash_status r = LBM_FLASH_FULL;
1406
1407 if (lbm_const_heap_state &&
1408 (lbm_const_heap_state->next + n) < lbm_const_heap_state->size) {
1409 lbm_uint ix = lbm_const_heap_state->next;
1410
1411 for (unsigned int i = 0; i < n; i ++) {
1412 if (!const_heap_write(ix + i, ((lbm_uint*)data)[i]))
1413 return LBM_FLASH_WRITE_ERROR;
1414 }
1415 lbm_const_heap_state->next += n;
1416 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1417 r = LBM_FLASH_WRITE_OK;
1418 }
1419 return r;
1420}
1421
1422lbm_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
1435lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
1436 lbm_uint addr = lbm_dec_ptr(cell);
1437 if (const_heap_write(addr+1, val))
1438 return LBM_FLASH_WRITE_OK;
1439 return LBM_FLASH_WRITE_ERROR;
1440}
1441
1442lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
1443 lbm_uint addr = lbm_dec_ptr(cell);
1444 if (const_heap_write(addr, val))
1445 return LBM_FLASH_WRITE_OK;
1446 return LBM_FLASH_WRITE_ERROR;
1447}
1448
1449lbm_uint lbm_flash_memory_usage(void) {
1450 return lbm_const_heap_state->next;
1451}
←

./include/heap.h

1/*
2 Copyright 2018, 2024 Joel Svensson svenssonjoel@yahoo.se
3
4 This program is free software: you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation, either version 3 of the License, or
7 (at your option) any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program. If not, see <http://www.gnu.org/licenses/>.
16*/
17/** \file heap.h */
18
19#ifndef HEAP_H_
20#define HEAP_H_
21
22#include <string.h>
23#include <stdarg.h>
24
25#include "lbm_types.h"
26#include "symrepr.h"
27#include "stack.h"
28#include "lbm_memory.h"
29#include "lbm_defines.h"
30#include "lbm_channel.h"
31
32#ifdef __cplusplus
33extern "C" {
34#endif
35
36/*
37Planning for a more space efficient heap representation.
38TODO: Need to find a good reference to read up on this.
39 - List based heap
40 - Easy to implement and somewhat efficient
41
420000 0000 Size Free bits
43003F FFFF 4MB 10
44007F FFFF 8MB 9
4500FF FFFF 16MB 8
4601FF FFFF 32MB 7
4703FF FFFF 64MB 6 * Kind of heap size I am looking for
4807FF FFFF 128MB 5
490FFF FFFF 256MB 4
501FFF FFFF 512MB 3
51
52
53--- May 9 2021 ---
54Actually now I am much more interested in way smaller memories ;)
55
560000 0000 Size Free bits
570000 0FFF 4KB 20 |
580000 1FFF 8KB 19 |
590000 3FFF 16KB 18 |
600000 7FFF 32KB 17 |
610000 FFFF 64KB 16 |
620001 FFFF 128KB 15 |
630003 FFFF 256KB 14 | - This range is very interesting.
640007 FFFF 512KB 13
65000F FFFF 1MB 12
66001F FFFF 2MB 11
67003F FFFF 4MB 10
68007F FFFF 8MB 9
6900FF FFFF 16MB 8
7001FF FFFF 32MB 7
7103FF FFFF 64MB 6
7207FF FFFF 128MB 5
730FFF FFFF 256MB 4
741FFF FFFF 512MB 3
75
76Those are the kind of platforms that are fun... so a bunch of
77wasted bits in heap pointers if we run on small MCUs.
78
79-----------------
80
81it is also the case that not all addresses will be used if all "cells" are
82of the same size, 8 bytes...
83
84value 0: 0000 0000
85value 1: 0000 0008
86value 3: 0000 0010
87value 4: 0000 0018
88
89Means bits 0,1,2 will always be empty in a valid address.
90
91Cons cells also need to be have room for 2 pointers. So each ted cell from
92memory should be 8bytes.
93
94Things that needs to be represented within these bits:
95
96 - GC MARK one per cell
97 - TYPE: type of CAR and type of cons
98
99Types I would want:
100 - Full 32bit integer. Does not leave room for identification of type
101 - Float values. Same problem
102
103
104Free bits in pointers 64MB heap:
10531 30 29 28 27 26 2 1 0
1060 0 0 0 0 0 XX XXXX XXXX XXXX XXXX XXXX X 0 0 0
107
108
109Information needed for each cell:
110 Meaning | bits total | bits per car | bits per cdr
111 GC mark | 2 | 1 | 1 - only one of them will be used (the other is wasted)
112 Type | 2x | x | x
113 Ptr/!ptr | 2 | 1 | 1
114
115
116Types (unboxed):
117 - Symbols
118 - 28bit integer ( will need signed shift right functionality )
119 - 28bit unsigned integer
120 - Character
121
122If four types is all that should be possible (unboxed). then 2 bits are needed to differentiate.
1232 + 1 + 1 = 4 => 28bits for data.
124
125bit 0: ptr/!ptr
126bit 1: gc
127bit 2-3: type (if not ptr)
128bit 3 - 24 ptr (if ptr)
129bit 4 - 31 value (if value)
130
131An unboxed value can occupy a car or cdr field in a cons cell.
132
133types (boxed) extra information in pointer to cell can contain information
134 - 32 bit integer
135 - 32 bit unsigned integer
136 - 32 bit float
137
138boxed representation:
139 [ptr| cdr]
140 |
141 [Value | Aux + GC_MARK]
142
143Kinds of pointers:
144 - Pointer to cons cell.
145 - Pointer to unboxed value (fixnums not in a list, I hope this is so rare that it can be removed )
146 - integer
147 - unsigned integer
148 - symbol
149 - float
150 - Pointer to boxed value.
151 - 32 bit integer
152 - 32 bit unsigned integer
153 - 32 bit float
154 - (Maybe something else ? Vectors/strings allocated in memory not occupied by heap?)
155 - vector of int
156 - vector of uint
157 - vector of float
158 - vector of double
159 - String
160
16113 pointer"types" -> needs 4 bits
162for 64MB heap there are 6 free bits. So with this scheme going to 128MB or 256MB heap
163is also possible
164
165 a pointer to some off heap vector/string could be represented by
166
167 [ptr | cdr]
168 |
169 [full pointer | Aux + GC_MARK]
170 |
171 [VECTOR]
172
173Aux bits could be used for storing vector size. Up to 30bits should be available there
174>> This is problematic. Now the information that something is a vector is split up
175>> between 2 cons cells. This means GC needs both of these intact to be able to make
176>> proper decision.
177>> Will try to resolve this by adding some special symbols. But these must be symbols
178>> that cannot occur normally in programs. Then an array could be:
179
180 [Full pointer | ARRAY_SYM + GC_MARK]
181 |
182 [VECTOR]
183
184>> Boxed values same treatment as above.
185>> TODO: Could this be simpler?
186
187[ VALUE | TYPE_SYM + GC_MARK]
188
189
1900000 00XX XXXX XXXX XXXX XXXX XXXX X000 : 0x03FF FFF8
1911111 AA00 0000 0000 0000 0000 0000 0000 : 0xFC00 0000 (AA bits left unused for now, future heap growth?)
192 */
193
194typedef enum {
195 LBM_FLASH_WRITE_OK,
196 LBM_FLASH_FULL,
197 LBM_FLASH_WRITE_ERROR
198} lbm_flash_status;
199
200/** Struct representing a heap cons-cell.
201 *
202 */
203typedef struct {
204 lbm_value car;
205 lbm_value cdr;
206} lbm_cons_t;
207
208/**
209 * Heap state
210 */
211typedef struct {
212 lbm_cons_t *heap;
213 lbm_value freelist; // list of free cons cells.
214 lbm_stack_t gc_stack;
215
216 lbm_uint heap_size; // In number of cells.
217 lbm_uint heap_bytes; // In bytes.
218
219 lbm_uint num_alloc; // Number of cells allocated.
220 lbm_uint num_alloc_arrays; // Number of arrays allocated.
221
222 lbm_uint gc_num; // Number of times gc has been performed.
223 lbm_uint gc_marked; // Number of cells marked by mark phase.
224 lbm_uint gc_recovered; // Number of cells recovered by sweep phase.
225 lbm_uint gc_recovered_arrays;// Number of arrays recovered by sweep.
226 lbm_uint gc_least_free; // The smallest length of the freelist.
227 lbm_uint gc_last_free; // Number of elements on the freelist
228 // after most recent GC.
229} lbm_heap_state_t;
230
231extern lbm_heap_state_t lbm_heap_state;
232
233typedef bool_Bool (*const_heap_write_fun)(lbm_uint ix, lbm_uint w);
234
235typedef struct {
236 lbm_uint *heap;
237 lbm_uint next; // next free index.
238 lbm_uint size; // in lbm_uint words. (cons-cells = words / 2)
239} lbm_const_heap_t;
240
241/**
242 * The header portion of an array stored in array and symbol memory.
243 * An array is always a byte array. use the array-extensions for
244 * storing and reading larger values from arrays.
245 */
246typedef struct {
247 lbm_uint size; /// Number of elements
248 lbm_uint *data; /// pointer to lbm_memory array or C array.
249} lbm_array_header_t;
250
251typedef struct {
252 lbm_uint size;
253 lbm_uint *data;
254 uint32_t index; // Limits arrays to max 2^32-1 elements.
255} lbm_array_header_extended_t;
256
257/** Lock GC mutex
258 * Locks a mutex during GC marking when using the pointer reversal algorithm.
259 * Does nothing when using stack based GC mark.
260 */
261void lbm_gc_lock(void);
262/* Unlock GC mutex
263 */
264void lbm_gc_unlock(void);
265
266/** Initialize heap storage.
267 * \param addr Pointer to an array of lbm_cons_t elements. This array must at least be aligned 4.
268 * \param num_cells Number of lbm_cons_t elements in the array.
269 * \param gc_stack_size Size of the gc_stack in number of words.
270 * \return 1 on success or 0 for failure.
271 */
272int lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
273 lbm_uint gc_stack_size);
274
275/** Add GC time statistics to heap_stats
276 *
277 * \param dur Duration as reported by the timestamp callback.
278 */
279void lbm_heap_new_gc_time(lbm_uint dur);
280/** Add a new free_list length to the heap_stats.
281 * Calculates a new freelist length and updates
282 * the GC statistics.
283 */
284void lbm_heap_new_freelist_length(void);
285/** Check how many lbm_cons_t cells are on the free-list
286 *
287 * \return Number of free lbm_cons_t cells.
288 */
289lbm_uint lbm_heap_num_free(void);
290/** Check how many lbm_cons_t cells are allocated.
291 *
292 * \return Number of lbm_cons_t cells that are currently allocated.
293 */
294lbm_uint lbm_heap_num_allocated(void);
295/** Size of the heap in number of lbm_cons_t cells.
296 *
297 * \return Size of the heap in number of lbm_cons_t cells.
298 */
299lbm_uint lbm_heap_size(void);
300/** Size of the heap in bytes.
301 *
302 * \return Size of heap in bytes.
303 */
304lbm_uint lbm_heap_size_bytes(void);
305/** Allocate an lbm_cons_t cell from the heap.
306 *
307 * \param type A type that can be encoded onto the cell (most often LBM_PTR_TYPE_CONS).
308 * \param car Value to write into car position of allocated cell.
309 * \param cdr Value to write into cdr position of allocated cell.
310 * \return An lbm_value referring to a cons_cell or enc_sym(SYM_MERROR) in case the heap is full.
311 */
312lbm_value lbm_heap_allocate_cell(lbm_type type, lbm_value car, lbm_value cdr);
313/** Allocate a list of n heap-cells.
314 * \param n The number of heap-cells to allocate.
315 * \return A list of heap-cells of Memory error if unable to allocate.
316 */
317lbm_value lbm_heap_allocate_list(lbm_uint n);
318/** Allocate a list of n heap-cells and initialize the values.
319 * \pram ls The result list is passed through this ptr.
320 * \param n The length of list to allocate.
321 * \param valist The values in a va_list to initialize the list with.
322 * \return True of False depending on success of allocation.
323 */
324lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist);
325/** Allocate a list of n heap-cells and initialize the values.
326 * \param n The length of list to allocate.
327 * \param ... The values to initialize the list with.
328 * \return allocated list or error symbol.
329 */
330lbm_value lbm_heap_allocate_list_init(unsigned int n, ...);
331/** Decode an lbm_value representing a string into a C string
332 *
333 * \param val Value
334 * \return allocated list or error symbol
335 */
336char *lbm_dec_str(lbm_value val);
337/** Decode an lbm_value representing a char channel into an lbm_char_channel_t pointer.
338 *
339 * \param val Value
340 * \return A pointer to an lbm_char_channel_t or NULL if the value does not encode a channel.
341 */
342lbm_char_channel_t *lbm_dec_channel(lbm_value val);
343/** Decode an lbm_value representing a custom type into a lbm_uint value.
344 *
345 * \param val Value.
346 * \return The custom type payload.
347 */
348lbm_uint lbm_dec_custom(lbm_value val);
349/** Decode a numerical value as if it is char
350 *
351 * \param val Value to decode
352 * \return The value encoded in val casted to a char. Returns 0 if val does not encode a number.
353 */
354uint8_t lbm_dec_as_char(lbm_value a);
355/** Decode a numerical value as if it is unsigned
356 *
357 * \param val Value to decode
358 * \return The value encoded in val casted to an unsigned int. Returns 0 if val does not encode a number.
359 */
360uint32_t lbm_dec_as_u32(lbm_value val);
361/** Decode a numerical value as a signed integer.
362 *
363 * \param val Value to decode
364 * \return The value encoded in val casted to a signed int. Returns 0 if val does not encode a number.
365 */
366int32_t lbm_dec_as_i32(lbm_value val);
367/** Decode a numerical value as a float.
368 *
369 * \param val Value to decode.
370 * \return The value encoded in val casted to a float. Returns 0 if val does not encode a number.
371 */
372float lbm_dec_as_float(lbm_value val);
373/** Decode a numerical value as if it is a 64bit unsigned
374 *
375 * \param val Value to decode
376 * \return The value encoded in val casted to an unsigned int. Returns 0 if val does not encode a number.
377 */
378uint64_t lbm_dec_as_u64(lbm_value val);
379/** Decode a numerical value as a 64bit signed integer.
380 *
381 * \param val Value to decode
382 * \return The value encoded in val casted to a signed int. Returns 0 if val does not encode a number.
383 */
384int64_t lbm_dec_as_i64(lbm_value val);
385/** Decode a numerical value as a float.
386 *
387 * \param val Value to decode.
388 * \return The value encoded in val casted to a float. Returns 0 if val does not encode a number.
389 */
390double lbm_dec_as_double(lbm_value val);
391
392/** Decode a numerical value into the architecture defined unsigned integer type.
393 *
394 * \param val Value to decode
395 * \return The value encoded in val casted to an unsigned int. Returns 0 if val does not encode a number.
396 */
397lbm_uint lbm_dec_as_uint(lbm_value val);
398
399/** Decode a numerical value into the architecture defined signed integer type.
400 *
401 * \param val Value to decode
402 * \return The value encoded in val casted to a signed int. Returns 0 if val does not encode a number.
403 */
404lbm_int lbm_dec_as_int(lbm_value val);
405
406lbm_uint lbm_dec_raw(lbm_value v);
407/** Allocates an lbm_cons_t cell from the heap and populates it.
408 *
409 * \param car The value to put in the car field of the allocated lbm_cons_t.
410 * \param cdr The value to put in the cdr field of the allocated lbm_cons_t.
411 * \return A value referencing the lbm_cons_t or enc_sym(SYM_MERROR) if heap is full.
412 */
413lbm_value lbm_cons(lbm_value car, lbm_value cdr);
414
415/** Accesses the car field of an lbm_cons_t.
416 *
417 * \param cons Value
418 * \return The car field of the lbm_cons_t if cons is a reference to a heap cell.
419 * If cons is nil, the return value is nil. If the value
420 * is not cons or nil, the return value is enc_sym(SYM_TERROR) for type error.
421 */
422lbm_value lbm_car(lbm_value cons);
423/** Accesses the car field the car field of an lbm_cons_t.
424 *
425 * \param cons Value
426 * \return The car of car field or nil.
427 */
428lbm_value lbm_caar(lbm_value c);
429/** Accesses the car of the cdr of an cons cell
430 *
431 * \param c Value
432 * \return the cdr field or type error.
433 */
434lbm_value lbm_cadr(lbm_value c);
435/** Accesses the cdr field of an lbm_cons_t.
436 *
437 * \param cons Value
438 * \return The cdr field of the lbm_cons_t if cons is a reference to a heap cell.
439 * If cons is nil, the return value is nil. If the value
440 * if not cons or nil, the return value is enc_sym(SYM_TERROR) for type error.
441 */
442lbm_value lbm_cdr(lbm_value cons);
443/** Accesses the cdr of an cdr field of an lbm_cons_t.
444 *
445 * \param cons Value
446 * \return The cdr of the cdr field of the lbm_cons_t if cons is a reference to a heap cell.
447 * If cons is nil, the return value is nil. If the value
448 * if not cons or nil, the return value is enc_sym(SYM_TERROR) for type error.
449 */
450lbm_value lbm_cddr(lbm_value c);
451/** Update the value stored in the car field of a heap cell.
452 *
453 * \param c Value referring to a heap cell.
454 * \param v Value to replace the car field with.
455 * \return 1 on success and 0 if the c value does not refer to a heap cell.
456 */
457int lbm_set_car(lbm_value c, lbm_value v);
458/** Update the value stored in the cdr field of a heap cell.
459 *
460 * \param c Value referring to a heap cell.
461 * \param v Value to replace the cdr field with.
462 * \return 1 on success and 0 if the c value does not refer to a heap cell.
463 */
464int lbm_set_cdr(lbm_value c, lbm_value v);
465/** Update the value stored in the car and cdr fields of a heap cell.
466 *
467 * \param c Value referring to a heap cell.
468 * \param car_val Value to replace the car field with.
469 * \param cdr_val Value to replace the cdr field with.
470 * \return 1 on success and 0 if the c value does not refer to a heap cell.
471 */
472int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val);
473// List functions
474/** Calculate the length of a proper list
475 * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
476 * may lead to the function not terminating.
477 *
478 * \param c A list
479 * \return The length of the list. Unless the value is a cyclic structure on the heap, this function will terminate.
480 */
481lbm_uint lbm_list_length(lbm_value c);
482
483/** Calculate the length of a proper list and evaluate a predicate for each element.
484 * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
485 * may lead to the function not terminating.
486 *
487 * \param c A list
488 * \param pres Boolean result of predicate, false if predicate is false for any of the elements in the list, otherwise true.
489 * \param pred Predicate to evaluate for each element of the list.
490 */
491unsigned int lbm_list_length_pred(lbm_value c, bool_Bool *pres, bool_Bool (*pred)(lbm_value));
492/** Reverse a proper list
493 * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
494 * may lead to the function not terminating.
495 *
496 * \param list A list
497 * \return The list reversed or enc_sym(SYM_MERROR) if heap is full.
498 */
499lbm_value lbm_list_reverse(lbm_value list);
500/** Reverse a proper list destroying the original.
501 * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
502 * may lead to the function not terminating.
503 *
504 * \param list A list
505 * \return The list reversed
506 */
507lbm_value lbm_list_destructive_reverse(lbm_value list);
508/** Copy a list
509 * \warning This is a dangerous function that should be used carefully. Cyclic structures on the heap
510 * may lead to the function not terminating.
511 *
512 * \param m Number of elements to copy or -1 for all. If 1, m will be updated with the length of the list
513 * \param list A list.
514 * \return Reversed list or enc_sym(SYM_MERROR) if heap is full.
515 */
516lbm_value lbm_list_copy(int *m, lbm_value list);
517
518/** A destructive append of two lists
519 *
520 * \param list1 A list
521 * \param list2 A list
522 * \return list1 with list2 appended at the end.
523 */
524lbm_value lbm_list_append(lbm_value list1, lbm_value list2);
525
526/** Drop values from the head of a list.
527 * \param n Number of values to drop.
528 * \param ls List to drop values from.
529 * \return The list with the n first elements removed.
530 */
531lbm_value lbm_list_drop(unsigned int n, lbm_value ls);
532/** Index into a list.
533 * \param l List to index into.
534 * \param n Position to read out of the list.
535 * \return Value at position n of l or nil if out of bounds.
536 */
537lbm_value lbm_index_list(lbm_value l, int32_t n);
538
539// State and statistics
540/** Get a copy of the heap statistics structure.
541 *
542 * \param A pointer to an lbm_heap_state_t to populate
543 * with the current statistics.
544 */
545void lbm_get_heap_state(lbm_heap_state_t *);
546/** Get the maximum stack level of the GC stack
547 * \return maximum value the gc stack sp reached so far.
548 */
549lbm_uint lbm_get_gc_stack_max(void);
550/** Get the size of the GC stack.
551 * \return the size of the gc stack.
552 */
553lbm_uint lbm_get_gc_stack_size(void);
554// Garbage collection
555/** Increment the counter that is counting the number of times GC ran
556 *
557 */
558void lbm_gc_state_inc(void);
559/** Set the freelist to NIL. Means that no memory will be available
560 * until after a garbage collection.
561 */
562void lbm_nil_freelist(void);
563/** Mark all heap cells reachable from an environment.
564 * \param environment.
565 */
566void lbm_gc_mark_env(lbm_value);
567/** Mark heap cells reachable from the lbm_value v.
568 * \param root
569 */
570void lbm_gc_mark_phase(lbm_value root);
571/** Performs lbm_gc_mark_phase on all the values of an array.
572 * This function is similar to lbm_gc_mark_roots but performs
573 * extra checks to not traverse into non-standard values.
574 * TODO: Check if this function is really needed.
575 * \param data Array of roots to traverse from.
576 * \param n Number of elements in roots-array.
577 */
578void lbm_gc_mark_aux(lbm_uint *data, lbm_uint n);
579/** Performs lbm_gc_mark_phase on all the values in the roots array.
580 * \param roots pointer to array of roots.
581 * \param num_roots size of array of roots.
582 */
583void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots);
584/** Sweep up all non marked heap cells and place them on the free list.
585 *
586 * \return 1
587 */
588int lbm_gc_sweep_phase(void);
589
590// Array functionality
591/** Allocate an bytearray in symbols and arrays memory (lispbm_memory.h)
592 * and create a heap cell that refers to this bytearray.
593 * \param res The resulting lbm_value is returned through this argument.
594 * \param size Array size in number of 32 bit words.
595 * \return 1 for success of 0 for failure.
596 */
597int lbm_heap_allocate_array(lbm_value *res, lbm_uint size);
598/** Allocate an array in symbols and arrays memory (lispbm_memory.h)
599 * and create a heap cell that refers to this array.
600 * \param res The resulting lbm_value is returned through this argument.
601 * \param size Array size in number of 32 bit words.
602 * \return 1 for success of 0 for failure.
603 */
604int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size);
605/** Convert a C array into an lbm array. If the C array is allocated in LBM MEMORY
606 * the lifetime of the array will be managed by GC.
607 * \param res lbm_value result pointer for storage of the result array.
608 * \param data C array.
609 * \param type The type tag to assign to the resulting LBM array.
610 * \param num_elt Number of elements in the array.
611 * \return 1 for success and 0 for failure.
612 */
613int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt);
614/** Get the size of an array value.
615 * \param arr lbm_value array to get size of.
616 * \return -1 for failure or length of array.
617 */
618lbm_int lbm_heap_array_get_size(lbm_value arr);
619/** Get a pointer to the data of an array for read only purposes.
620 * \param arr lbm_value array to get pointer from.
621 * \return NULL or valid pointer.
622 */
623const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr);
624/** Get a pointer to the data of an array for read/write purposes.
625 * \param arr lbm_value array to get pointer from.
626 * \return NULL or valid pointer.
627 */
628uint8_t *lbm_heap_array_get_data_rw(lbm_value arr);
629/** Explicitly free an array.
630 * This function needs to be used with care and knowledge.
631 * \param arr Array value.
632 */
633int lbm_heap_explicit_free_array(lbm_value arr);
634/** Query the size in bytes of an lbm_type.
635 * \param t Type
636 * \return Size in bytes of type or 0 if the type represents a composite.
637 */
638lbm_uint lbm_size_of(lbm_type t);
639
640int lbm_const_heap_init(const_heap_write_fun w_fun,
641 lbm_const_heap_t *heap,
642 lbm_uint *addr,
643 lbm_uint num_words);
644
645lbm_flash_status lbm_allocate_const_cell(lbm_value *res);
646lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res);
647lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res);
648lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val);
649lbm_flash_status write_const_car(lbm_value cell, lbm_value val);
650lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val);
651lbm_uint lbm_flash_memory_usage(void);
652
653/** Query the type information of a value.
654 *
655 * \param x Value to check the type of.
656 * \return The type information.
657 */
658static inline lbm_type lbm_type_of(lbm_value x) {
659 return (x & LBM_PTR_BIT0x00000001u) ? (x & LBM_PTR_TYPE_MASK0xFC000000u) : (x & LBM_VAL_TYPE_MASK0x0000000Cu);
660}
661
662// type-of check that is safe in functional code
663static inline lbm_type lbm_type_of_functional(lbm_value x) {
664 return (x & LBM_PTR_BIT0x00000001u) ?
665 (x & (LBM_PTR_TO_CONSTANT_MASK~0x04000000u & LBM_PTR_TYPE_MASK0xFC000000u)) :
666 (x & LBM_VAL_TYPE_MASK0x0000000Cu);
667}
668
669static inline lbm_value lbm_enc_cons_ptr(lbm_uint x) {
670 return ((x << LBM_ADDRESS_SHIFT2) | LBM_TYPE_CONS0x10000000u | LBM_PTR_BIT0x00000001u);
671}
672
673static inline lbm_uint lbm_dec_ptr(lbm_value p) {
674 return ((LBM_PTR_VAL_MASK0x03FFFFFCu & p) >> LBM_ADDRESS_SHIFT2);
675}
676
677extern lbm_cons_t *lbm_heaps[2];
678
679static inline lbm_uint lbm_dec_cons_cell_ptr(lbm_value p) {
680 lbm_uint h = (p & LBM_PTR_TO_CONSTANT_BIT0x04000000u) >> LBM_PTR_TO_CONSTANT_SHIFT26;
681 return lbm_dec_ptr(p) >> h;
682}
683
684static inline lbm_cons_t *lbm_dec_heap(lbm_value p) {
685 lbm_uint h = (p & LBM_PTR_TO_CONSTANT_BIT0x04000000u) >> LBM_PTR_TO_CONSTANT_SHIFT26;
686 return lbm_heaps[h];
687}
688
689static inline lbm_value lbm_set_ptr_type(lbm_value p, lbm_type t) {
690 return ((LBM_PTR_VAL_MASK0x03FFFFFCu & p) | t | LBM_PTR_BIT0x00000001u);
691}
692
693static inline lbm_value lbm_enc_sym(lbm_uint s) {
694 return (s << LBM_VAL_SHIFT4) | LBM_TYPE_SYMBOL0x00000000u;
695}
696
697static inline lbm_value lbm_enc_i(lbm_int x) {
698 return ((lbm_uint)x << LBM_VAL_SHIFT4) | LBM_TYPE_I0x00000008u;
699}
700
701static inline lbm_value lbm_enc_u(lbm_uint x) {
702 return (x << LBM_VAL_SHIFT4) | LBM_TYPE_U0x0000000Cu;
703}
704
705/** Encode 32 bit integer into an lbm_value.
706 * \param x Value to encode.
707 * \return result encoded value.
708 */
709extern lbm_value lbm_enc_i32(int32_t x);
710
711/** Encode 32 bit unsigned integer into an lbm_value.
712 * \param x Value to encode.
713 * \return result encoded value.
714 */
715extern lbm_value lbm_enc_u32(uint32_t x);
716
717/** Encode a float into an lbm_value.
718 * \param x float value to encode.
719 * \return result encoded value.
720 */
721extern lbm_value lbm_enc_float(float x);
722
723/** Encode a 64 bit integer into an lbm_value.
724 * \param x 64 bit integer to encode.
725 * \return result encoded value.
726 */
727extern lbm_value lbm_enc_i64(int64_t x);
728
729/** Encode a 64 bit unsigned integer into an lbm_value.
730 * \param x 64 bit unsigned integer to encode.
731 * \return result encoded value.
732 */
733extern lbm_value lbm_enc_u64(uint64_t x);
734
735/** Encode a double into an lbm_value.
736 * \param x double to encode.
737 * \return result encoded value.
738 */
739extern lbm_value lbm_enc_double(double x);
740
741static inline lbm_value lbm_enc_char(uint8_t x) {
742 return ((lbm_uint)x << LBM_VAL_SHIFT4) | LBM_TYPE_CHAR0x00000004u;
743}
744
745static inline lbm_int lbm_dec_i(lbm_value x) {
746 return (lbm_int)x >> LBM_VAL_SHIFT4;
747}
748
749static inline lbm_uint lbm_dec_u(lbm_value x) {
750 return x >> LBM_VAL_SHIFT4;
751}
752
753static inline uint8_t lbm_dec_char(lbm_value x) {
754 return (uint8_t)(x >> LBM_VAL_SHIFT4);
755}
756
757static inline lbm_uint lbm_dec_sym(lbm_value x) {
758 return x >> LBM_VAL_SHIFT4;
759}
760
761/** Decode an lbm_value representing a float.
762 * \param x Value to decode.
763 * \return decoded float.
764 */
765extern float lbm_dec_float(lbm_value x);
766
767/** Decode an lbm_value representing a double.
768 * \param x Value to decode.
769 * \return decoded float.
770 */
771extern double lbm_dec_double(lbm_value x);
772
773
774static inline uint32_t lbm_dec_u32(lbm_value x) {
775#ifndef LBM64
776 return (uint32_t)lbm_car(x);
777#else
778 return (uint32_t)(x >> LBM_VAL_SHIFT4);
779#endif
780}
781
782/** Decode an lbm_value representing a 64 bit unsigned integer.
783 * \param x Value to decode.
784 * \return decoded uint64_t.
785 */
786extern uint64_t lbm_dec_u64(lbm_value x);
787
788static inline int32_t lbm_dec_i32(lbm_value x) {
789#ifndef LBM64
790 return (int32_t)lbm_car(x);
791#else
792 return (int32_t)(x >> LBM_VAL_SHIFT4);
793#endif
794}
795
796/** Decode an lbm_value representing a 64 bit integer.
797 * \param x Value to decode.
798 * \return decoded int64_t.
799 */
800extern int64_t lbm_dec_i64(lbm_value x);
801
802/**
803 * Check if a value is a heap pointer
804 * \param x Value to check
805 * \return true if x is a pointer to a heap cell, false otherwise.
806 */
807static inline bool_Bool lbm_is_ptr(lbm_value x) {
808 return (x & LBM_PTR_BIT0x00000001u);
809}
810
811/**
812 * Check if a value is a Read/Writeable cons cell
813 * \param x Value to check
814 * \return true if x is a Read/Writeable cons cell, false otherwise.
815 */
816static inline bool_Bool lbm_is_cons_rw(lbm_value x) {
817 return (lbm_type_of(x) == LBM_TYPE_CONS0x10000000u);
818}
819
820/**
821 * Check if a value is a Readable cons cell
822 * \param x Value to check
823 * \return true if x is a readable cons cell, false otherwise.
824 */
825static inline bool_Bool lbm_is_cons(lbm_value x) {
826 return lbm_is_ptr(x) && ((x & LBM_CONS_TYPE_MASK0xF0000000u) == LBM_TYPE_CONS0x10000000u);
827}
828
829/** Check if a value represents a number
830 * \param x Value to check.
831 * \return true is x represents a number and false otherwise.
832 */
833static inline bool_Bool lbm_is_number(lbm_value x) {
834 return
835 (x & LBM_PTR_BIT0x00000001u) ?
836 ((x & LBM_NUMBER_MASK0x08000000u) == LBM_NUMBER_MASK0x08000000u) :
837 (x & LBM_VAL_TYPE_MASK0x0000000Cu);
838}
839
840/** Check if value is an array that can be READ
841 * \param x Value to check.
842 * \return true if x represents a readable array and false otherwise.
843 */
844static inline bool_Bool lbm_is_array_r(lbm_value x) {
845 lbm_type t = lbm_type_of(x);
846 return ((t & LBM_PTR_TO_CONSTANT_MASK~0x04000000u) == LBM_TYPE_ARRAY0x80000000u);
2
←
Assuming the condition is true
→
3
←
Returning the value 1, which participates in a condition later
→
847}
848
849static inline bool_Bool lbm_is_array_rw(lbm_value x) {
850 return( (lbm_type_of(x) == LBM_TYPE_ARRAY0x80000000u) && !(x & LBM_PTR_TO_CONSTANT_BIT0x04000000u));
851}
852
853static inline bool_Bool lbm_is_lisp_array_r(lbm_value x) {
854 lbm_type t = lbm_type_of(x);
855 return ((t & LBM_PTR_TO_CONSTANT_MASK~0x04000000u) == LBM_TYPE_LISPARRAY0xB0000000u);
856}
857
858static inline bool_Bool lbm_is_lisp_array_rw(lbm_value x) {
859 return( (lbm_type_of(x) == LBM_TYPE_LISPARRAY0xB0000000u) && !(x & LBM_PTR_TO_CONSTANT_BIT0x04000000u));
860}
861
862
863static inline bool_Bool lbm_is_channel(lbm_value x) {
864 return (lbm_type_of(x) == LBM_TYPE_CHANNEL0x90000000u &&
865 lbm_type_of(lbm_cdr(x)) == LBM_TYPE_SYMBOL0x00000000u &&
866 lbm_cdr(x) == ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u));
867}
868static inline bool_Bool lbm_is_char(lbm_value x) {
869 return (lbm_type_of(x) == LBM_TYPE_CHAR0x00000004u);
870}
871
872static inline bool_Bool lbm_is_special(lbm_value symrep) {
873 return ((lbm_type_of(symrep) == LBM_TYPE_SYMBOL0x00000000u) &&
874 (lbm_dec_sym(symrep) < SPECIAL_SYMBOLS_END0xFFFF));
875}
876
877static inline bool_Bool lbm_is_closure(lbm_value exp) {
878 return ((lbm_is_cons(exp)) &&
879 (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL0x00000000u) &&
880 (lbm_car(exp) == ENC_SYM_CLOSURE(((0x10F) << 4) | 0x00000000u)));
881}
882
883static inline bool_Bool lbm_is_continuation(lbm_value exp) {
884 return ((lbm_type_of(exp) == LBM_TYPE_CONS0x10000000u) &&
885 (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL0x00000000u) &&
886 (lbm_car(exp) == ENC_SYM_CONT(((0x10E) << 4) | 0x00000000u)));
887}
888
889static inline bool_Bool lbm_is_macro(lbm_value exp) {
890 return ((lbm_type_of(exp) == LBM_TYPE_CONS0x10000000u) &&
891 (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL0x00000000u) &&
892 (lbm_car(exp) == ENC_SYM_MACRO(((0x10D) << 4) | 0x00000000u)));
893}
894
895static inline bool_Bool lbm_is_match_binder(lbm_value exp) {
896 return (lbm_is_cons(exp) &&
897 (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL0x00000000u) &&
898 (lbm_car(exp) == ENC_SYM_MATCH_ANY(((0x41) << 4) | 0x00000000u)));
899}
900
901static inline bool_Bool lbm_is_comma_qualified_symbol(lbm_value exp) {
902 return (lbm_is_cons(exp) &&
903 (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL0x00000000u) &&
904 (lbm_car(exp) == ENC_SYM_COMMA(((0x73) << 4) | 0x00000000u)) &&
905 (lbm_type_of(lbm_cadr(exp)) == LBM_TYPE_SYMBOL0x00000000u));
906}
907
908static inline bool_Bool lbm_is_symbol(lbm_value exp) {
909 return !(exp & LBM_LOW_RESERVED_BITS0x0000000Fu);
910}
911
912static inline bool_Bool lbm_is_symbol_nil(lbm_value exp) {
913 return !exp;
10
←
Assuming 'exp' is 0
→
11
←
Returning the value 1, which participates in a condition later
→
914}
915
916static inline bool_Bool lbm_is_symbol_true(lbm_value exp) {
917 return (lbm_is_symbol(exp) && exp == ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u));
918}
919
920static inline bool_Bool lbm_is_symbol_eval(lbm_value exp) {
921 return (lbm_is_symbol(exp) && exp == ENC_SYM_EVAL(((0x30008) << 4) | 0x00000000u));
922}
923
924static inline bool_Bool lbm_is_symbol_merror(lbm_value exp) {
925 return lbm_is_symbol(exp) && (exp == ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
926}
927
928static inline bool_Bool lbm_is_list(lbm_value x) {
929 return (lbm_is_cons(x) || lbm_is_symbol_nil(x));
930}
931
932static inline bool_Bool lbm_is_list_rw(lbm_value x) {
933 return (lbm_is_cons_rw(x) || lbm_is_symbol_nil(x));
934}
935
936static inline bool_Bool lbm_is_quoted_list(lbm_value x) {
937 return (lbm_is_cons(x) &&
938 lbm_is_symbol(lbm_car(x)) &&
939 (lbm_car(x) == ENC_SYM_QUOTE(((0x100) << 4) | 0x00000000u)) &&
940 lbm_is_cons(lbm_cdr(x)) &&
941 lbm_is_cons(lbm_cadr(x)));
942}
943
944#ifndef LBM64
945#define ERROR_SYMBOL_MASK0xFFFFFFF0 0xFFFFFFF0
946#else
947#define ERROR_SYMBOL_MASK0xFFFFFFF0 0xFFFFFFFFFFFFFFF0
948#endif
949
950/* all error signaling symbols are in the range 0x20 - 0x2F */
951static inline bool_Bool lbm_is_error(lbm_value v){
952 return (lbm_is_symbol(v) &&
953 ((lbm_dec_sym(v) & ERROR_SYMBOL_MASK0xFFFFFFF0) == 0x20));
954}
955
956// ref_cell: returns a reference to the cell addressed by bits 3 - 26
957// Assumes user has checked that is_ptr was set
958static inline lbm_cons_t* lbm_ref_cell(lbm_value addr) {
959 return &lbm_dec_heap(addr)[lbm_dec_cons_cell_ptr(addr)];
960 //return &lbm_heap_state.heap[lbm_dec_ptr(addr)];
961}
962
963
964// lbm_uint a = lbm_heaps[0];
965// lbm_uint b = lbm_heaps[1];
966// lbm_uint i = (addr & LBM_PTR_TO_CONSTANT_BIT) >> LBM_PTR_TO_CONSTANT_SHIFT) - 1;
967// lbm_uint h = (a & i) | (b & ~i);
968
969#ifdef __cplusplus
970}
971#endif
972#endif