Bug Summary

File:heap.c
Warning:line 1259, 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.25.0/scan-build/2024-07-23-152344-239046-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) ){
7
←
Taking false branch
→
893 lbm_cons_t *cell = lbm_ref_cell(c);
894 return cell->car;
895 }
896
897 if (lbm_type_of(c) == LBM_TYPE_SYMBOL0x00000000u &&
8
←
Assuming the condition is true
→
10
←
Taking true branch
→
898 c == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
9
←
Assuming the condition is true
→
899 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
11
←
Returning zero
→
900 }
901
902 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
903}
904
905// TODO: Many comparisons "is this the nil symbol" can be
906// streamlined a bit. NIL is 0 and cannot be confused with any other
907// lbm_value.
908
909lbm_value lbm_caar(lbm_value c) {
910
911 lbm_value tmp;
912
913 if (lbm_is_ptr(c)) {
914 tmp = lbm_ref_cell(c)->car;
915
916 if (lbm_is_ptr(tmp)) {
917 return lbm_ref_cell(tmp)->car;
918 } else if (lbm_is_symbol(tmp) && tmp == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
919 return tmp;
920 }
921 } else if (lbm_is_symbol(c) && c == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
922 return c;
923 }
924 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
925}
926
927
928lbm_value lbm_cadr(lbm_value c) {
929
930 lbm_value tmp;
931
932 if (lbm_is_ptr(c)) {
933 tmp = lbm_ref_cell(c)->cdr;
934
935 if (lbm_is_ptr(tmp)) {
936 return lbm_ref_cell(tmp)->car;
937 } else if (lbm_is_symbol(tmp) && tmp == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
938 return tmp;
939 }
940 } else if (lbm_is_symbol(c) && c == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
941 return c;
942 }
943 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
944}
945
946lbm_value lbm_cdr(lbm_value c){
947
948 if (lbm_type_of(c) == LBM_TYPE_SYMBOL0x00000000u &&
949 c == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
950 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
951 }
952
953 if (lbm_is_ptr(c)) {
954 lbm_cons_t *cell = lbm_ref_cell(c);
955 return cell->cdr;
956 }
957 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
958}
959
960lbm_value lbm_cddr(lbm_value c) {
961
962 if (lbm_is_ptr(c)) {
963 lbm_value tmp = lbm_ref_cell(c)->cdr;
964 if (lbm_is_ptr(tmp)) {
965 return lbm_ref_cell(tmp)->cdr;
966 }
967 }
968 if (lbm_is_symbol(c) && c == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
969 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
970 }
971 return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
972}
973
974int lbm_set_car(lbm_value c, lbm_value v) {
975 int r = 0;
976
977 if (lbm_type_of(c) == LBM_TYPE_CONS0x10000000u) {
978 lbm_cons_t *cell = lbm_ref_cell(c);
979 cell->car = v;
980 r = 1;
981 }
982 return r;
983}
984
985int lbm_set_cdr(lbm_value c, lbm_value v) {
986 int r = 0;
987 if (lbm_is_cons_rw(c)){
988 lbm_cons_t *cell = lbm_ref_cell(c);
989 cell->cdr = v;
990 r = 1;
991 }
992 return r;
993}
994
995int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
996 int r = 0;
997 if (lbm_is_cons_rw(c)) {
998 lbm_cons_t *cell = lbm_ref_cell(c);
999 cell->car = car_val;
1000 cell->cdr = cdr_val;
1001 r = 1;
1002 }
1003 return r;
1004}
1005
1006/* calculate length of a proper list */
1007lbm_uint lbm_list_length(lbm_value c) {
1008 lbm_uint len = 0;
1009
1010 while (lbm_is_cons(c)){
1011 len ++;
1012 c = lbm_cdr(c);
1013 }
1014 return len;
1015}
1016
1017/* calculate the length of a list and check that each element
1018 fullfills the predicate pred */
1019unsigned int lbm_list_length_pred(lbm_value c, bool_Bool *pres, bool_Bool (*pred)(lbm_value)) {
1020 bool_Bool res = true1;
1021 unsigned int len = 0;
1022
1023 while (lbm_is_cons(c)){
1024 len ++;
1025 res = res && pred(lbm_car(c));
1026 c = lbm_cdr(c);
1027 }
1028 *pres = res;
1029 return len;
1030}
1031
1032/* reverse a proper list */
1033lbm_value lbm_list_reverse(lbm_value list) {
1034 if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
1035 return list;
1036 }
1037
1038 lbm_value curr = list;
1039
1040 lbm_value new_list = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1041 while (lbm_is_cons(curr)) {
1042
1043 new_list = lbm_cons(lbm_car(curr), new_list);
1044 if (lbm_type_of(new_list) == LBM_TYPE_SYMBOL0x00000000u) {
1045 return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1046 }
1047 curr = lbm_cdr(curr);
1048 }
1049 return new_list;
1050}
1051
1052lbm_value lbm_list_destructive_reverse(lbm_value list) {
1053 if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
1054 return list;
1055 }
1056 lbm_value curr = list;
1057 lbm_value last_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1058
1059 while (lbm_is_cons_rw(curr)) {
1060 lbm_value next = lbm_cdr(curr);
1061 lbm_set_cdr(curr, last_cell);
1062 last_cell = curr;
1063 curr = next;
1064 }
1065 return last_cell;
1066}
1067
1068
1069lbm_value lbm_list_copy(int *m, lbm_value list) {
1070 lbm_value curr = list;
1071 lbm_uint n = lbm_list_length(list);
1072 lbm_uint copy_n = n;
1073 if (*m >= 0 && (lbm_uint)*m < n) {
1074 copy_n = (lbm_uint)*m;
1075 } else if (*m == -1) {
1076 *m = (int)n; // TODO: smaller range in target variable.
1077 }
1078 if (copy_n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1079 lbm_uint new_list = lbm_heap_allocate_list(copy_n);
1080 if (lbm_is_symbol(new_list)) return new_list;
1081 lbm_value curr_targ = new_list;
1082
1083 while (lbm_is_cons(curr) && copy_n > 0) {
1084 lbm_value v = lbm_car(curr);
1085 lbm_set_car(curr_targ, v);
1086 curr_targ = lbm_cdr(curr_targ);
1087 curr = lbm_cdr(curr);
1088 copy_n --;
1089 }
1090
1091 return new_list;
1092}
1093
1094// Append for proper lists only
1095// Destructive update of list1.
1096lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
1097
1098 if(lbm_is_list_rw(list1) &&
1099 lbm_is_list(list2)) {
1100
1101 lbm_value curr = list1;
1102 while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS0x10000000u) {
1103 curr = lbm_cdr(curr);
1104 }
1105 if (lbm_is_symbol_nil(curr)) return list2;
1106 lbm_set_cdr(curr, list2);
1107 return list1;
1108 }
1109 return ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u);
1110}
1111
1112lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
1113 lbm_value curr = ls;
1114 while (lbm_type_of_functional(curr) == LBM_TYPE_CONS0x10000000u &&
1115 n > 0) {
1116 curr = lbm_cdr(curr);
1117 n --;
1118 }
1119 return curr;
1120}
1121
1122lbm_value lbm_index_list(lbm_value l, int32_t n) {
1123 lbm_value curr = l;
1124
1125 if (n < 0) {
1126 int32_t len = (int32_t)lbm_list_length(l);
1127 n = len + n;
1128 if (n < 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1129 }
1130
1131 while (lbm_is_cons(curr) &&
1132 n > 0) {
1133 curr = lbm_cdr(curr);
1134 n --;
1135 }
1136 if (lbm_is_cons(curr)) {
1137 return lbm_car(curr);
1138 } else {
1139 return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1140 }
1141}
1142
1143// High-level arrays are just bytearrays but with a different tag and pointer type.
1144// These arrays will be inspected by GC and the elements of the array will be marked.
1145
1146// Arrays are part of the heap module because their lifespan is managed
1147// by the garbage collector. The data in the array is not stored
1148// in the "heap of cons cells".
1149int lbm_heap_allocate_array_base(lbm_value *res, bool_Bool byte_array, lbm_uint size){
1150
1151 lbm_array_header_t *array = NULL((void*)0);
1152
1153 if (byte_array) {
1154 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1155 } else {
1156 // an extra 32bit quantity for a GC index.
1157 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
1158 }
1159
1160 if (array == NULL((void*)0)) {
1161 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1162 return 0;
1163 }
1164
1165 lbm_uint tag = ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u);
1166 lbm_uint type = LBM_TYPE_ARRAY0x80000000u;
1167 if (!byte_array) {
1168 tag = ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u);
1169 type = LBM_TYPE_LISPARRAY0xB0000000u;
1170 size = sizeof(lbm_value) * size;
1171 lbm_array_header_extended_t *ext_array = (lbm_array_header_extended_t*)array;
1172 ext_array->index = 0;
1173 }
1174
1175 array->data = (lbm_uint*)lbm_malloc(size);
1176
1177 if (array->data == NULL((void*)0)) {
1178 lbm_memory_free((lbm_uint*)array);
1179 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1180 return 0;
1181 }
1182 // It is more important to zero out high-level arrays.
1183 // 0 is symbol NIL which is perfectly safe for the GC to inspect.
1184 memset(array->data, 0, size);
1185 array->size = size;
1186
1187 // allocating a cell for array's heap-presence
1188 lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);
1189
1190 *res = cell;
1191
1192 if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // Out of heap memory
1193 lbm_memory_free((lbm_uint*)array->data);
1194 lbm_memory_free((lbm_uint*)array);
1195 *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1196 return 0;
1197 }
1198
1199 lbm_heap_state.num_alloc_arrays ++;
1200
1201 return 1;
1202}
1203
1204int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
1205 return lbm_heap_allocate_array_base(res, true1, size);
1206}
1207
1208int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
1209 return lbm_heap_allocate_array_base(res, false0, size);
1210}
1211
1212// Convert a C array into an lbm_array.
1213// if the array is in LBM_MEMORY, the lifetime will be managed by the GC after lifting.
1214int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) {
1215
1216 lbm_array_header_t *array = NULL((void*)0);
1217 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u));
1218
1219 if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // Out of heap memory
1220 *value = cell;
1221 return 0;
1222 }
1223
1224 array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
1225
1226 if (array == NULL((void*)0)) {
1227 lbm_set_car_and_cdr(cell, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1228 *value = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
1229 return 0;
1230 }
1231
1232 array->data = (lbm_uint*)data;
1233 array->size = num_elt;
1234
1235 lbm_set_car(cell, (lbm_uint)array);
1236
1237 cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY0x80000000u);
1238 *value = cell;
1239 return 1;
1240}
1241
1242lbm_int lbm_heap_array_get_size(lbm_value arr) {
1243
1244 lbm_int r = -1;
1245 if (lbm_is_array_r(arr)) {
1246 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1247 if (header == NULL((void*)0)) {
1248 return r;
1249 }
1250 r = (lbm_int)header->size;
1251 }
1252 return r;
1253}
1254
1255const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
1256 uint8_t *r = NULL((void*)0);
1257 if (lbm_is_array_r(arr)) {
1
Calling 'lbm_is_array_r'
→
4
←
Returning from 'lbm_is_array_r'
→
5
←
Taking true branch
→
1258 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
6
←
Calling 'lbm_car'
→
12
←
Returning from 'lbm_car'
→
13
←
'header' initialized to a null pointer value
→
1259 r = (uint8_t*)header->data;
14
←
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'header')
1260 }
1261 return r;
1262}
1263
1264uint8_t *lbm_heap_array_get_data_rw(lbm_value arr) {
1265 uint8_t *r = NULL((void*)0);
1266 if (lbm_is_array_rw(arr)) {
1267 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1268 r = (uint8_t*)header->data;
1269 }
1270 return r;
1271}
1272
1273
1274/* Explicitly freeing an array.
1275
1276 This is a highly unsafe operation and can only be safely
1277 used if the heap cell that points to the array has not been made
1278 accessible to the program.
1279
1280 So This function can be used to free an array in case an array
1281 is being constructed and some error case appears while doing so
1282 If the array still have not become available it can safely be
1283 "explicitly" freed.
1284
1285 The problem is that if the "array" heap-cell is made available to
1286 the program, this cell can easily be duplicated and we would have
1287 to search the entire heap to find all cells pointing to the array
1288 memory in question and "null"-them out before freeing the memory
1289*/
1290
1291int lbm_heap_explicit_free_array(lbm_value arr) {
1292
1293 int r = 0;
1294 if (lbm_is_array_rw(arr)) {
1295
1296 lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
1297 if (header == NULL((void*)0)) {
1298 return 0;
1299 }
1300 lbm_memory_free((lbm_uint*)header->data);
1301 lbm_memory_free((lbm_uint*)header);
1302
1303 arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS0x10000000u);
1304 lbm_set_car(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1305 lbm_set_cdr(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
1306 r = 1;
1307 }
1308
1309 return r;
1310}
1311
1312lbm_uint lbm_size_of(lbm_type t) {
1313 lbm_uint s = 0;
1314 switch(t) {
1315 case LBM_TYPE_BYTE0x00000004u:
1316 s = 1;
1317 break;
1318 case LBM_TYPE_I0x00000008u: /* fall through */
1319 case LBM_TYPE_U0x0000000Cu:
1320 case LBM_TYPE_SYMBOL0x00000000u:
1321 s = sizeof(lbm_uint);
1322 break;
1323 case LBM_TYPE_I320x28000000u: /* fall through */
1324 case LBM_TYPE_U320x38000000u:
1325 case LBM_TYPE_FLOAT0x68000000u:
1326 s = 4;
1327 break;
1328 case LBM_TYPE_I640x48000000u: /* fall through */
1329 case LBM_TYPE_U640x58000000u:
1330 case LBM_TYPE_DOUBLE0x78000000u:
1331 s = 8;
1332 break;
1333 }
1334 return s;
1335}
1336
1337static bool_Bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
1338 (void)ix;
1339 (void)val;
1340 return false0;
1341}
1342
1343static const_heap_write_fun const_heap_write = dummy_flash_write;
1344
1345int lbm_const_heap_init(const_heap_write_fun w_fun,
1346 lbm_const_heap_t *heap,
1347 lbm_uint *addr,
1348 lbm_uint num_words) {
1349 if (((uintptr_t)addr % 4) != 0) return 0;
1350 if ((num_words % 2) != 0) return 0;
1351
1352 if (!lbm_const_heap_mutex_initialized) {
1353 mutex_init(&lbm_const_heap_mutex);
1354 lbm_const_heap_mutex_initialized = true1;
1355 }
1356
1357 if (!lbm_mark_mutex_initialized) {
1358 mutex_init(&lbm_mark_mutex);
1359 lbm_mark_mutex_initialized = true1;
1360 }
1361
1362 const_heap_write = w_fun;
1363
1364 heap->heap = addr;
1365 heap->size = num_words;
1366 heap->next = 0;
1367
1368 lbm_const_heap_state = heap;
1369 // ref_cell views the lbm_uint array as an lbm_cons_t array
1370 lbm_heaps[1] = (lbm_cons_t*)addr;
1371 return 1;
1372}
1373
1374lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
1375 lbm_flash_status r = LBM_FLASH_FULL;
1376
1377 mutex_lock(&lbm_const_heap_mutex);
1378 // waste a cell if we have ended up unaligned after writing an array to flash.
1379 if (lbm_const_heap_state->next % 2 == 1) {
1380 lbm_const_heap_state->next++;
1381 }
1382
1383 if (lbm_const_heap_state &&
1384 (lbm_const_heap_state->next+1) < lbm_const_heap_state->size) {
1385 // A cons cell uses two words.
1386 lbm_value cell = lbm_const_heap_state->next;
1387 lbm_const_heap_state->next += 2;
1388 *res = (cell << LBM_ADDRESS_SHIFT2) | LBM_PTR_BIT0x00000001u | LBM_TYPE_CONS0x10000000u | LBM_PTR_TO_CONSTANT_BIT0x04000000u;
1389 r = LBM_FLASH_WRITE_OK;
1390 }
1391 mutex_unlock(&lbm_const_heap_mutex);
1392 return r;
1393}
1394
1395lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) {
1396 lbm_flash_status r = LBM_FLASH_FULL;
1397
1398 if (lbm_const_heap_state &&
1399 (lbm_const_heap_state->next + nwords) < lbm_const_heap_state->size) {
1400 lbm_uint ix = lbm_const_heap_state->next;
1401 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1402 lbm_const_heap_state->next += nwords;
1403 r = LBM_FLASH_WRITE_OK;
1404 }
1405 return r;
1406}
1407
1408lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {
1409
1410 lbm_flash_status r = LBM_FLASH_FULL;
1411
1412 if (lbm_const_heap_state &&
1413 (lbm_const_heap_state->next + n) < lbm_const_heap_state->size) {
1414 lbm_uint ix = lbm_const_heap_state->next;
1415
1416 for (unsigned int i = 0; i < n; i ++) {
1417 if (!const_heap_write(ix + i, ((lbm_uint*)data)[i]))
1418 return LBM_FLASH_WRITE_ERROR;
1419 }
1420 lbm_const_heap_state->next += n;
1421 *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
1422 r = LBM_FLASH_WRITE_OK;
1423 }
1424 return r;
1425}
1426
1427lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) {
1428
1429 if (lbm_const_heap_state) {
1430 lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap;
1431 lbm_uint ix = (((lbm_uint)tgt - flash) / 4); // byte address to ix
1432 if (const_heap_write(ix, val)) {
1433 return LBM_FLASH_WRITE_OK;
1434 }
1435 return LBM_FLASH_WRITE_ERROR;
1436 }
1437 return LBM_FLASH_FULL;
1438}
1439
1440lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
1441 lbm_uint addr = lbm_dec_ptr(cell);
1442 if (const_heap_write(addr+1, val))
1443 return LBM_FLASH_WRITE_OK;
1444 return LBM_FLASH_WRITE_ERROR;
1445}
1446
1447lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
1448 lbm_uint addr = lbm_dec_ptr(cell);
1449 if (const_heap_write(addr, val))
1450 return LBM_FLASH_WRITE_OK;
1451 return LBM_FLASH_WRITE_ERROR;
1452}
1453
1454lbm_uint lbm_flash_memory_usage(void) {
1455 return lbm_const_heap_state->next;
1456}
←

./include/heap.h

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