src/heap.c

Bug Summary

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

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

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/*
  Copyright 2018, 2020, 2022 - 2024 Joel Svensson  svenssonjoel@yahoo.se
                        2022        Benjamin Vedder

  This program is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program.  If not, see <http://www.gnu.org/licenses/>.
17*/

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>

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


38static inline lbm_value lbm_set_gc_mark(lbm_value x) {
return x | LBM_GC_MARKED0x00000002u;
40}

42static inline lbm_value lbm_clr_gc_mark(lbm_value x) {
return x & ~LBM_GC_MASK0x00000002u;
44}

46static inline bool_Bool lbm_get_gc_mark(lbm_value x) {
return x & LBM_GC_MASK0x00000002u;
48}

50// flag is the same bit as mark, but in car
51static inline bool_Bool lbm_get_gc_flag(lbm_value x) {
return x & LBM_GC_MARKED0x00000002u;
53}

55static inline lbm_value lbm_set_gc_flag(lbm_value x) {
return x | LBM_GC_MARKED0x00000002u;
57}

59static inline lbm_value lbm_clr_gc_flag(lbm_value x) {
return x & ~LBM_GC_MASK0x00000002u;
61}


64lbm_heap_state_t lbm_heap_state;

66lbm_const_heap_t *lbm_const_heap_state;

68lbm_cons_t *lbm_heaps[2] = {NULL((void*)0), NULL((void*)0)};

70static mutex_t lbm_const_heap_mutex;
71static bool_Bool    lbm_const_heap_mutex_initialized = false0;

73static mutex_t lbm_mark_mutex;
74static bool_Bool    lbm_mark_mutex_initialized = false0;

76#ifdef USE_GC_PTR_REV
77void lbm_gc_lock(void) {
mutex_lock(&lbm_mark_mutex);
79}
80void lbm_gc_unlock(void) {
mutex_unlock(&lbm_mark_mutex);
82}
83#else
84void lbm_gc_lock(void) {
85}
86void lbm_gc_unlock(void) {
87}
88#endif

90/****************************************************/
91/* ENCODERS DECODERS                                */

93lbm_value lbm_enc_i32(int32_t x) {
94#ifndef LBM64
lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE(((0x31) << 4) | 0x00000000u));
if (lbm_type_of(i) == LBM_TYPE_SYMBOL0x00000000u) return i;
return lbm_set_ptr_type(i, LBM_TYPE_I320x28000000u);
98#else
return (((lbm_uint)x) << LBM_VAL_SHIFT4) | LBM_TYPE_I320x28000000u;
100#endif
101}

103lbm_value lbm_enc_u32(uint32_t x) {
104#ifndef LBM64
lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE(((0x32) << 4) | 0x00000000u));
if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
return lbm_set_ptr_type(u, LBM_TYPE_U320x38000000u);
108#else
return (((lbm_uint)x) << LBM_VAL_SHIFT4) | LBM_TYPE_U320x38000000u;
110#endif
111}

113lbm_value lbm_enc_float(float x) {
114#ifndef LBM64
lbm_uint t;
memcpy(&t, &x, sizeof(lbm_float));
lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE(((0x33) << 4) | 0x00000000u));
if (lbm_type_of(f) == LBM_TYPE_SYMBOL0x00000000u) return f;
return lbm_set_ptr_type(f, LBM_TYPE_FLOAT0x68000000u);
120#else
lbm_uint t = 0;
memcpy(&t, &x, sizeof(float));
return (((lbm_uint)t) << LBM_VAL_SHIFT4) | LBM_TYPE_FLOAT0x68000000u;
124#endif
125}

127static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) {
lbm_value res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
res = lbm_cons(ENC_SYM_NIL(((0x0) << 4) | 0x00000000u),ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
if (lbm_type_of(res) != LBM_TYPE_SYMBOL0x00000000u) {
  uint8_t* storage = lbm_malloc(sizeof(uint64_t));
  if (storage) {
    memcpy(storage,source, sizeof(uint64_t));
    lbm_set_car_and_cdr(res, (lbm_uint)storage,  type_qual);
    res = lbm_set_ptr_type(res, type);
  } else {
    res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  }
}
return res;
141}

143lbm_value lbm_enc_i64(int64_t x) {
144#ifndef LBM64
return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE(((0x34) << 4) | 0x00000000u), LBM_TYPE_I640x48000000u);
146#else
lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE(((0x31) << 4) | 0x00000000u));
if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
return lbm_set_ptr_type(u, LBM_TYPE_I640x48000000u);
150#endif
151}

153lbm_value lbm_enc_u64(uint64_t x) {
154#ifndef LBM64
return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE(((0x35) << 4) | 0x00000000u), LBM_TYPE_U640x58000000u);
156#else
lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE(((0x32) << 4) | 0x00000000u));
if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
return lbm_set_ptr_type(u, LBM_TYPE_U640x58000000u);
160#endif
161}

163lbm_value lbm_enc_double(double x) {
164#ifndef LBM64
return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE(((0x36) << 4) | 0x00000000u), LBM_TYPE_DOUBLE0x78000000u);
166#else
lbm_uint t;
memcpy(&t, &x, sizeof(double));
lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE(((0x33) << 4) | 0x00000000u));
if (lbm_type_of(f) == LBM_TYPE_SYMBOL0x00000000u) return f;
return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE0x78000000u);
172#endif
173}

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.

179float lbm_dec_float(lbm_value x) {
180#ifndef LBM64
float f_tmp;
lbm_uint tmp = lbm_car(x);
memcpy(&f_tmp, &tmp, sizeof(float));
return f_tmp;
185#else
uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT4);
float f_tmp;
memcpy(&f_tmp, &tmp, sizeof(float));
return f_tmp;
190#endif
191}

193double lbm_dec_double(lbm_value x) {
194#ifndef LBM64
double d;
uint32_t *data = (uint32_t*)lbm_car(x);
memcpy(&d, data, sizeof(double));
return d;
199#else
double f_tmp;
lbm_uint tmp = lbm_car(x);
memcpy(&f_tmp, &tmp, sizeof(double));
return f_tmp;
204#endif
205}

207uint64_t lbm_dec_u64(lbm_value x) {
208#ifndef LBM64
uint64_t u;
uint32_t *data = (uint32_t*)lbm_car(x);
memcpy(&u, data, 8);
return u;
213#else
return (uint64_t)lbm_car(x);
215#endif
216}

218int64_t lbm_dec_i64(lbm_value x) {
219#ifndef LBM64
int64_t i;
uint32_t *data = (uint32_t*)lbm_car(x);
memcpy(&i, data, 8);
return i;
224#else
return (int64_t)lbm_car(x);
226#endif
227}

229char *lbm_dec_str(lbm_value val) {
char *res = 0;
// If val is an array, car of val will be non-null.
if (lbm_is_array_r(val)) {
1
Calling 'lbm_is_array_r'→
4
←
Returning from 'lbm_is_array_r'→
5
←
Taking true branch→
  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
6
←
Passing value via 1st parameter 'c'→
7
←
Calling 'lbm_car'→
15
←
Returning from 'lbm_car'→
16
←
'array' initialized to a null pointer value→
  res = (char *)array->data;
17
←
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'array')
}
return res;
237}

239lbm_char_channel_t *lbm_dec_channel(lbm_value val) {
lbm_char_channel_t *res = NULL((void*)0);

if (lbm_type_of(val) == LBM_TYPE_CHANNEL0x90000000u) {
  res = (lbm_char_channel_t *)lbm_car(val);
}
return res;
246}

248lbm_uint lbm_dec_custom(lbm_value val) {
lbm_uint res = 0;
if (lbm_type_of(val) == LBM_TYPE_CUSTOM0xA0000000u) {
  res = (lbm_uint)lbm_car(val);
}
return res;
254}

256uint8_t lbm_dec_as_char(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
  return (uint8_t) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (uint8_t) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (uint8_t) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (uint8_t) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (uint8_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (uint8_t)lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (uint8_t) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (uint8_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (uint8_t) lbm_dec_double(a);
}
return 0;
278}

280uint32_t lbm_dec_as_u32(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
  return (uint32_t) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (uint32_t) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (uint32_t) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u: /* fall through */
case LBM_TYPE_U320x38000000u:
  return (uint32_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (uint32_t)lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (uint32_t) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (uint32_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (uint32_t) lbm_dec_double(a);
}
return 0;
301}

303int32_t lbm_dec_as_i32(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
    return (int32_t) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (int32_t) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (int32_t) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (int32_t) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (int32_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (int32_t) lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (int32_t) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (int32_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (int32_t) lbm_dec_double(a);

}
return 0;
326}

328int64_t lbm_dec_as_i64(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
    return (int64_t) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (int64_t) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (int64_t) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (int64_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (int64_t) lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (int64_t) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (int64_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (int64_t) lbm_dec_double(a);
}
return 0;
350}

352uint64_t lbm_dec_as_u64(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
  return (uint64_t) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (uint64_t) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (uint64_t) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (uint64_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (uint64_t)lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (uint64_t) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (uint64_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (uint64_t) lbm_dec_double(a);
}
return 0;
374}

376lbm_uint lbm_dec_as_uint(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
  return (lbm_uint) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (lbm_uint) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (lbm_uint) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (lbm_uint) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (lbm_uint) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (lbm_uint) lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (lbm_uint) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (lbm_uint) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (lbm_uint) lbm_dec_double(a);
}
return 0;
398}

400lbm_int lbm_dec_as_int(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
  return (lbm_int) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (lbm_int) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (lbm_int) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (lbm_int) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (lbm_int) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (lbm_int)lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (lbm_int) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (lbm_int) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (lbm_int) lbm_dec_double(a);
}
return 0;
422}

424float lbm_dec_as_float(lbm_value a) {

switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
    return (float) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (float) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (float) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (float) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (float) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (float) lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (float) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (float) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (float) lbm_dec_double(a);
}
return 0;
447}

449double lbm_dec_as_double(lbm_value a) {

switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR0x00000004u:
    return (double) lbm_dec_char(a);
case LBM_TYPE_I0x00000008u:
  return (double) lbm_dec_i(a);
case LBM_TYPE_U0x0000000Cu:
  return (double) lbm_dec_u(a);
case LBM_TYPE_I320x28000000u:
  return (double) lbm_dec_i32(a);
case LBM_TYPE_U320x38000000u:
  return (double) lbm_dec_u32(a);
case LBM_TYPE_FLOAT0x68000000u:
  return (double) lbm_dec_float(a);
case LBM_TYPE_I640x48000000u:
  return (double) lbm_dec_i64(a);
case LBM_TYPE_U640x58000000u:
  return (double) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE0x78000000u:
  return (double) lbm_dec_double(a);
}
return 0;
472}

474/****************************************************/
475/* HEAP MANAGEMENT                                  */

477static int generate_freelist(size_t num_cells) {
size_t i = 0;

if (!lbm_heap_state.heap) return 0;

lbm_heap_state.freelist = lbm_enc_cons_ptr(0);

lbm_cons_t *t;

// Add all cells to free list
for (i = 1; i < num_cells; i ++) {
  t = lbm_ref_cell(lbm_enc_cons_ptr(i-1));
  t->car = ENC_SYM_RECOVERED(((0x28) << 4) | 0x00000000u);    // all cars in free list are "RECOVERED"
  t->cdr = lbm_enc_cons_ptr(i);
}

// Replace the incorrect pointer at the last cell.
t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1));
t->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);

return 1;
498}

500void lbm_nil_freelist(void) {
lbm_heap_state.freelist = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
lbm_heap_state.num_alloc = lbm_heap_state.heap_size;
503}

505static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells,
                          lbm_uint* gc_stack_storage, lbm_uint gc_stack_size) {
lbm_heap_state.heap         = addr;
lbm_heap_state.heap_bytes   = (unsigned int)(num_cells * sizeof(lbm_cons_t));
lbm_heap_state.heap_size    = num_cells;

lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size);

lbm_heap_state.num_alloc           = 0;
lbm_heap_state.num_alloc_arrays    = 0;
lbm_heap_state.gc_num              = 0;
lbm_heap_state.gc_marked           = 0;
lbm_heap_state.gc_recovered        = 0;
lbm_heap_state.gc_recovered_arrays = 0;
lbm_heap_state.gc_least_free       = num_cells;
lbm_heap_state.gc_last_free        = num_cells;
521}

523void lbm_heap_new_freelist_length(void) {
lbm_uint l = lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
lbm_heap_state.gc_last_free = l;
if (l < lbm_heap_state.gc_least_free)
  lbm_heap_state.gc_least_free = l;
528}

530int lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells,
                lbm_uint gc_stack_size) {

if (((uintptr_t)addr % 8) != 0) return 0;

memset(addr,0, sizeof(lbm_cons_t) * num_cells);

lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint));
if (gc_stack_storage == NULL((void*)0)) return 0;

heap_init_state(addr, num_cells,
                gc_stack_storage, gc_stack_size);

lbm_heaps[0] = addr;

return generate_freelist(num_cells);
546}

548lbm_uint lbm_heap_num_free(void) {
return lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
550}

552lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) {
lbm_value res;
// it is a ptr replace freelist with cdr of freelist;
res = lbm_heap_state.freelist;
if (lbm_type_of(res) == LBM_TYPE_CONS0x10000000u) {
  lbm_uint heap_ix = lbm_dec_ptr(res);
  lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
  lbm_heap_state.num_alloc++;
  lbm_heap_state.heap[heap_ix].car = car;
  lbm_heap_state.heap[heap_ix].cdr = cdr;
  res = lbm_set_ptr_type(res, ptr_type);
  return res;
}
return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
566}

568lbm_value lbm_heap_allocate_list(lbm_uint n) {
if (n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
if (lbm_heap_num_free() < n) return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);

lbm_value curr = lbm_heap_state.freelist;
lbm_value res  = curr;
if (lbm_type_of(curr) == LBM_TYPE_CONS0x10000000u) {

  lbm_cons_t *c_cell = NULL((void*)0);
  lbm_uint count = 0;
  do {
    c_cell = lbm_ref_cell(curr);
    c_cell->car = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    curr = c_cell->cdr;
    count ++;
  } while (count < n);
  lbm_heap_state.freelist = curr;
  c_cell->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_heap_state.num_alloc+=count;
  return res;
}
return ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
590}

592lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) {
if (n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
if (lbm_heap_num_free() < n) return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);

lbm_value curr = lbm_heap_state.freelist;
lbm_value res  = curr;
if (lbm_type_of(curr) == LBM_TYPE_CONS0x10000000u) {

  lbm_cons_t *c_cell = NULL((void*)0);
  unsigned int count = 0;
  do {
    c_cell = lbm_ref_cell(curr);
    c_cell->car = va_arg(valist, lbm_value)__builtin_va_arg(valist, lbm_value);
    curr = c_cell->cdr;
    count ++;
  } while (count < n);
  lbm_heap_state.freelist = curr;
  c_cell->cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_heap_state.num_alloc+=count;
  return res;
}
return ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
614}

616lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) {
  va_list valist;
  va_start(valist, n)__builtin_va_start(valist, n);
  lbm_value r = lbm_heap_allocate_list_init_va(n, valist);
  va_end(valist)__builtin_va_end(valist);
  return r;
622}

624lbm_uint lbm_heap_num_allocated(void) {
return lbm_heap_state.num_alloc;
626}
627lbm_uint lbm_heap_size(void) {
return lbm_heap_state.heap_size;
629}

631lbm_uint lbm_heap_size_bytes(void) {
return lbm_heap_state.heap_bytes;
633}

635void lbm_get_heap_state(lbm_heap_state_t *res) {
*res = lbm_heap_state;
637}

639lbm_uint lbm_get_gc_stack_max(void) {
return lbm_heap_state.gc_stack.max_sp;
641}

643lbm_uint lbm_get_gc_stack_size(void) {
return lbm_heap_state.gc_stack.size;
645}

647#ifdef USE_GC_PTR_REV
648static inline void value_assign(lbm_value *a, lbm_value b) {
lbm_value a_old = *a & LBM_GC_MASK0x00000002u;
*a = a_old | (b & ~LBM_GC_MASK0x00000002u);
651}

653void lbm_gc_mark_phase(lbm_value root) {
bool_Bool work_to_do = true1;

if (!lbm_is_ptr(root)) return;

mutex_lock(&lbm_const_heap_mutex);
lbm_value curr = root;
lbm_value prev = lbm_enc_cons_ptr(LBM_PTR_NULL(0x03FFFFFCu >> 2));

while (work_to_do) {
  // follow leftwards pointers
  while (lbm_is_ptr(curr) &&
         (lbm_dec_ptr(curr) != LBM_PTR_NULL(0x03FFFFFCu >> 2)) &&
         ((curr & LBM_PTR_TO_CONSTANT_BIT0x04000000u) == 0) &&
         !lbm_get_gc_mark(lbm_cdr(curr))) {
    // Mark the cell if not a constant cell
    lbm_cons_t *cell = lbm_ref_cell(curr);
    cell->cdr = lbm_set_gc_mark(cell->cdr);
    if (lbm_is_cons_rw(curr)) {
      lbm_value next = 0;
      value_assign(&next, cell->car);
      value_assign(&cell->car, prev);
      value_assign(&prev,curr);
      value_assign(&curr, next);
    }
    // Will jump out next iteration as gc mark is set in curr.
  }
  while (lbm_is_ptr(prev) &&
         (lbm_dec_ptr(prev) != LBM_PTR_NULL(0x03FFFFFCu >> 2)) &&
         lbm_get_gc_flag(lbm_car(prev)) ) {
    // clear the flag
    lbm_cons_t *cell = lbm_ref_cell(prev);
    cell->car = lbm_clr_gc_flag(cell->car);
    lbm_value next = 0;
    value_assign(&next, cell->cdr);
    value_assign(&cell->cdr, curr);
    value_assign(&curr, prev);
    value_assign(&prev, next);
  }
  if (lbm_is_ptr(prev) &&
      lbm_dec_ptr(prev) == LBM_PTR_NULL(0x03FFFFFCu >> 2)) {
    work_to_do = false0;
  } else if (lbm_is_ptr(prev)) {
    // set the flag
    lbm_cons_t *cell = lbm_ref_cell(prev);
    cell->car = lbm_set_gc_flag(cell->car);
    lbm_value next = 0;
    value_assign(&next, cell->car);
    value_assign(&cell->car, curr);
    value_assign(&curr, cell->cdr);
    value_assign(&cell->cdr, next);
  }
}
mutex_unlock(&lbm_const_heap_mutex);
707}

709#else
710extern eval_context_t *ctx_running;
711void lbm_gc_mark_phase(lbm_value root) {
lbm_value t_ptr;
lbm_stack_t *s = &lbm_heap_state.gc_stack;
s->data[s->sp++] = root;

while (!lbm_stack_is_empty(s)) {
  lbm_value curr;
  lbm_pop(s, &curr);

mark_shortcut:

  if (!lbm_is_ptr(curr) ||
      (curr & LBM_PTR_TO_CONSTANT_BIT0x04000000u)) {
    continue;
  }

  lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)];

  if (lbm_get_gc_mark(cell->cdr)) {
    continue;
  }

   t_ptr = lbm_type_of(curr);

  // An array is marked in O(N) time using an additional 32bit
  // value per array that keeps track of how far into the array GC
  // has progressed.
  if (t_ptr == LBM_TYPE_LISPARRAY0xB0000000u) {
    lbm_push(s, curr); // put array back as bookkeeping.
    lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car;
    lbm_value *arrdata = (lbm_value *)arr->data;
    uint32_t index = arr->index;

    // Potential optimization.
    // 1. CONS pointers are set to curr and recurse.
    // 2. Any other ptr is marked immediately and index is increased.
    if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT0x04000000u) == 0) &&
        !((arrdata[index] & LBM_CONTINUATION_INTERNAL0xF8000001u) == LBM_CONTINUATION_INTERNAL0xF8000001u)) {
      lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])];
      if (!lbm_get_gc_mark(elt->cdr)) {
        curr = arrdata[index];
        goto mark_shortcut;
      }
    }
    if (index < ((arr->size/(sizeof(lbm_value))) - 1)) {
      arr->index++;
      continue;
    }

    arr->index = 0;
    cell->cdr = lbm_set_gc_mark(cell->cdr);
    lbm_heap_state.gc_marked ++;
    lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it.
    continue;
  }

  cell->cdr = lbm_set_gc_mark(cell->cdr);
  lbm_heap_state.gc_marked ++;

  if (t_ptr == LBM_TYPE_CONS0x10000000u) {
    if (lbm_is_ptr(cell->cdr)) {
      if (!lbm_push(s, cell->cdr)) {
        lbm_critical_error();
        break;
      }
    }
    curr = cell->car;
    goto mark_shortcut; // Skip a push/pop
  }
}
781}
782#endif

784//Environments are proper lists with a 2 element list stored in each car.
785void lbm_gc_mark_env(lbm_value env) {
lbm_value curr = env;
lbm_cons_t *c;

while (lbm_is_ptr(curr)) {
  c = lbm_ref_cell(curr);
  c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
  lbm_cons_t *b = lbm_ref_cell(c->car);
  b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
  lbm_gc_mark_phase(b->cdr);        // mark the bound object.
  lbm_heap_state.gc_marked +=2;
  curr = c->cdr;
}
798}


801void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
for (lbm_uint i = 0; i < aux_size; i ++) {
  if (lbm_is_ptr(aux_data[i])) {
    lbm_type pt_t = lbm_type_of(aux_data[i]);
    lbm_uint pt_v = lbm_dec_ptr(aux_data[i]);
    if( pt_t >= LBM_POINTER_TYPE_FIRST0x10000000u &&
        pt_t <= LBM_POINTER_TYPE_LAST0xBC000000u &&
        pt_v < lbm_heap_state.heap_size) {
      lbm_gc_mark_phase(aux_data[i]);
    }
  }
}
813}

815void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
for (lbm_uint i = 0; i < num_roots; i ++) {
  lbm_gc_mark_phase(roots[i]);
}
819}

821// Sweep moves non-marked heap objects to the free list.
822int lbm_gc_sweep_phase(void) {
unsigned int i = 0;
lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap;

for (i = 0; i < lbm_heap_state.heap_size; i ++) {
  if ( lbm_get_gc_mark(heap[i].cdr)) {
    heap[i].cdr = lbm_clr_gc_mark(heap[i].cdr);
  } else {
    // Check if this cell is a pointer to an array
    // and free it.
    if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL0x00000000u) {
      switch(heap[i].cdr) {

      case ENC_SYM_IND_I_TYPE(((0x34) << 4) | 0x00000000u): /* fall through */
      case ENC_SYM_IND_U_TYPE(((0x35) << 4) | 0x00000000u):
      case ENC_SYM_IND_F_TYPE(((0x36) << 4) | 0x00000000u):
        lbm_memory_free((lbm_uint*)heap[i].car);
        break;
      case ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u): /* fall through */
      case ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u):{
        lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car;
        if (lbm_memory_ptr_inside((lbm_uint*)arr->data)) {
          lbm_memory_free((lbm_uint *)arr->data);
          lbm_heap_state.gc_recovered_arrays++;
        }
        lbm_memory_free((lbm_uint *)arr);
      } break;
      case ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u):{
        lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car;
        if (lbm_memory_ptr_inside((lbm_uint*)chan)) {
          lbm_memory_free((lbm_uint*)chan->state);
          lbm_memory_free((lbm_uint*)chan);
        }
      } break;
      case ENC_SYM_CUSTOM_TYPE(((0x38) << 4) | 0x00000000u): {
        lbm_uint *t = (lbm_uint*)heap[i].car;
        lbm_custom_type_destroy(t);
        lbm_memory_free(t);
        } break;
      default:
        break;
      }
    }
    // create pointer to use as new freelist
    lbm_uint addr = lbm_enc_cons_ptr(i);

    // Clear the "freed" cell.
    heap[i].car = ENC_SYM_RECOVERED(((0x28) << 4) | 0x00000000u);
    heap[i].cdr = lbm_heap_state.freelist;
    lbm_heap_state.freelist = addr;
    lbm_heap_state.num_alloc --;
    lbm_heap_state.gc_recovered ++;
  }
}
return 1;
877}

879void lbm_gc_state_inc(void) {
lbm_heap_state.gc_num ++;
lbm_heap_state.gc_recovered = 0;
lbm_heap_state.gc_marked = 0;
883}

885// construct, alter and break apart
886lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
return lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, car, cdr);
888}

890lbm_value lbm_car(lbm_value c){

if (lbm_is_ptr(c) ){
8
←
Taking false branch→
  lbm_cons_t *cell = lbm_ref_cell(c);
  return cell->car;
}

if (lbm_is_symbol_nil(c)) {
9
←
Calling 'lbm_is_symbol_nil'→
12
←
Returning from 'lbm_is_symbol_nil'→
13
←
Taking true branch→
  return c; // if nil, return nil.
14
←
Returning zero (loaded from 'c')→
}

return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
902}

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.

908lbm_value lbm_caar(lbm_value c) {

lbm_value tmp;

if (lbm_is_ptr(c)) {
  tmp = lbm_ref_cell(c)->car;

  if (lbm_is_ptr(tmp)) {
    return lbm_ref_cell(tmp)->car;
  } else if (lbm_is_symbol_nil(tmp)) {
    return tmp;
  }
} else if (lbm_is_symbol_nil(c)){
  return c;
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
924}


927lbm_value lbm_cadr(lbm_value c) {

lbm_value tmp;

if (lbm_is_ptr(c)) {
  tmp = lbm_ref_cell(c)->cdr;

  if (lbm_is_ptr(tmp)) {
    return lbm_ref_cell(tmp)->car;
  } else if (lbm_is_symbol_nil(tmp)) {
    return tmp;
  }
} else if (lbm_is_symbol_nil(c)) {
  return c;
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
943}

945lbm_value lbm_cdr(lbm_value c){
if (lbm_is_ptr(c)) {
  lbm_cons_t *cell = lbm_ref_cell(c);
  return cell->cdr;
}
if (lbm_is_symbol_nil(c)) {
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
954}

956lbm_value lbm_cddr(lbm_value c) {
if (lbm_is_ptr(c)) {
  lbm_value tmp = lbm_ref_cell(c)->cdr;
  if (lbm_is_ptr(tmp)) {
    return lbm_ref_cell(tmp)->cdr;
  }
}
if (lbm_is_symbol_nil(c)) {
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
967}

969int lbm_set_car(lbm_value c, lbm_value v) {
int r = 0;

if (lbm_type_of(c) == LBM_TYPE_CONS0x10000000u) {
  lbm_cons_t *cell = lbm_ref_cell(c);
  cell->car = v;
  r = 1;
}
return r;
978}

980int lbm_set_cdr(lbm_value c, lbm_value v) {
int r = 0;
if (lbm_is_cons_rw(c)){
  lbm_cons_t *cell = lbm_ref_cell(c);
  cell->cdr = v;
  r = 1;
}
return r;
988}

990int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
int r = 0;
if (lbm_is_cons_rw(c)) {
  lbm_cons_t *cell = lbm_ref_cell(c);
  cell->car = car_val;
  cell->cdr = cdr_val;
  r = 1;
}
return r;
999}

1001/* calculate length of a proper list */
1002lbm_uint lbm_list_length(lbm_value c) {
lbm_uint len = 0;

while (lbm_is_cons(c)){
  len ++;
  c = lbm_cdr(c);
}
return len;
1010}

1012/* calculate the length of a list and check that each element
 fullfills the predicate pred */
1014unsigned int lbm_list_length_pred(lbm_value c, bool_Bool *pres, bool_Bool (*pred)(lbm_value)) {
bool_Bool res = true1;
unsigned int len = 0;

while (lbm_is_cons(c)){
  len ++;
  res = res && pred(lbm_car(c));
  c = lbm_cdr(c);
}
*pres = res;
return len;
1025}

1027/* reverse a proper list */
1028lbm_value lbm_list_reverse(lbm_value list) {
if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
  return list;
}

lbm_value curr = list;

lbm_value new_list = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
while (lbm_is_cons(curr)) {

  new_list = lbm_cons(lbm_car(curr), new_list);
  if (lbm_type_of(new_list) == LBM_TYPE_SYMBOL0x00000000u) {
    return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  }
  curr = lbm_cdr(curr);
}
return new_list;
1045}

1047lbm_value lbm_list_destructive_reverse(lbm_value list) {
if (lbm_type_of(list) == LBM_TYPE_SYMBOL0x00000000u) {
  return list;
}
lbm_value curr = list;
lbm_value last_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);

while (lbm_is_cons_rw(curr)) {
  lbm_value next = lbm_cdr(curr);
  lbm_set_cdr(curr, last_cell);
  last_cell = curr;
  curr = next;
}
return last_cell;
1061}


1064lbm_value lbm_list_copy(int *m, lbm_value list) {
lbm_value curr = list;
lbm_uint n = lbm_list_length(list);
lbm_uint copy_n = n;
if (*m >= 0 && (lbm_uint)*m < n) {
  copy_n = (lbm_uint)*m;
} else if (*m == -1) {
  *m = (int)n; // TODO: smaller range in target variable.
}
if (copy_n == 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
lbm_uint new_list = lbm_heap_allocate_list(copy_n);
if (lbm_is_symbol(new_list)) return new_list;
lbm_value curr_targ = new_list;

while (lbm_is_cons(curr) && copy_n > 0) {
  lbm_value v = lbm_car(curr);
  lbm_set_car(curr_targ, v);
  curr_targ = lbm_cdr(curr_targ);
  curr = lbm_cdr(curr);
  copy_n --;
}

return new_list;
1087}

1089// Append for proper lists only
1090// Destructive update of list1.
1091lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {

if(lbm_is_list_rw(list1) &&
   lbm_is_list(list2)) {

  lbm_value curr = list1;
  while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS0x10000000u) {
    curr = lbm_cdr(curr);
  }
  if (lbm_is_symbol_nil(curr)) return list2;
  lbm_set_cdr(curr, list2);
  return list1;
}
return ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u);
1105}

1107lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
lbm_value curr = ls;
while (lbm_type_of_functional(curr) == LBM_TYPE_CONS0x10000000u &&
       n > 0) {
  curr = lbm_cdr(curr);
  n --;
}
return curr;
1115}

1117lbm_value lbm_index_list(lbm_value l, int32_t n) {
lbm_value curr = l;

if (n < 0) {
  int32_t len = (int32_t)lbm_list_length(l);
  n = len + n;
  if (n < 0) return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
}

while (lbm_is_cons(curr) &&
        n > 0) {
  curr = lbm_cdr(curr);
  n --;
}
if (lbm_is_cons(curr)) {
  return lbm_car(curr);
} else {
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
}
1136}

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.

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){

lbm_array_header_t *array = NULL((void*)0);

if (byte_array) {
  array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));
} else {
  // an extra 32bit quantity for a GC index.
  array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t));
}

if (array == NULL((void*)0)) {
  *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  return 0;
}

lbm_uint tag = ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u);
lbm_uint type = LBM_TYPE_ARRAY0x80000000u;
if (!byte_array) {
    tag = ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u);
    type = LBM_TYPE_LISPARRAY0xB0000000u;
    size = sizeof(lbm_value) * size;
    lbm_array_header_extended_t *ext_array = (lbm_array_header_extended_t*)array;
    ext_array->index = 0;
}

array->data = (lbm_uint*)lbm_malloc(size);

if (array->data == NULL((void*)0)) {
  lbm_memory_free((lbm_uint*)array);
  *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  return 0;
}
// It is more important to zero out high-level arrays.
// 0 is symbol NIL which is perfectly safe for the GC to inspect.
memset(array->data, 0, size);
array->size = size;

// allocating a cell for array's heap-presence
lbm_value cell  = lbm_heap_allocate_cell(type, (lbm_uint) array, tag);

*res = cell;

if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // Out of heap memory
  lbm_memory_free((lbm_uint*)array->data);
  lbm_memory_free((lbm_uint*)array);
  *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  return 0;
}

lbm_heap_state.num_alloc_arrays ++;

return 1;
1197}

1199int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){
return lbm_heap_allocate_array_base(res, true1, size);
1201}

1203int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) {
return lbm_heap_allocate_array_base(res, false0, size);
1205}

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) {

lbm_array_header_t *array = NULL((void*)0);
lbm_value cell  = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u));

if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) { // Out of heap memory
  *value = cell;
  return 0;
}

array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t));

if (array == NULL((void*)0)) {
  lbm_set_car_and_cdr(cell, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  *value = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  return 0;
}

array->data = (lbm_uint*)data;
array->size = num_elt;

lbm_set_car(cell, (lbm_uint)array);

cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY0x80000000u);
*value = cell;
return 1;
1235}

1237lbm_int lbm_heap_array_get_size(lbm_value arr) {

lbm_int r = -1;
if (lbm_is_array_r(arr)) {
  lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
  if (header == NULL((void*)0)) {
    return r;
  }
  r = (lbm_int)header->size;
}
return r;
1248}

1250const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) {
uint8_t *r = NULL((void*)0);
if (lbm_is_array_r(arr)) {
  lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
  r = (uint8_t*)header->data;
}
return r;
1257}

1259uint8_t *lbm_heap_array_get_data_rw(lbm_value arr) {
uint8_t *r = NULL((void*)0);
if (lbm_is_array_rw(arr)) {
  lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
  r = (uint8_t*)header->data;
}
return r;
1266}


1269/* Explicitly freeing an array.

 This is a highly unsafe operation and can only be safely
 used if the heap cell that points to the array has not been made
 accessible to the program.

 So This function can be used to free an array in case an array
 is being constructed and some error case appears while doing so
 If the array still have not become available it can safely be
 "explicitly" freed.

 The problem is that if the "array" heap-cell is made available to
 the program, this cell can easily be duplicated and we would have
 to search the entire heap to find all cells pointing to the array
 memory in question and "null"-them out before freeing the memory
1284*/

1286int lbm_heap_explicit_free_array(lbm_value arr) {

int r = 0;
if (lbm_is_array_rw(arr)) {

  lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr);
  if (header == NULL((void*)0)) {
    return 0;
  }
  lbm_memory_free((lbm_uint*)header->data);
  lbm_memory_free((lbm_uint*)header);

  arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS0x10000000u);
  lbm_set_car(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_set_cdr(arr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  r = 1;
}

return r;
1305}

1307lbm_uint lbm_size_of(lbm_type t) {
lbm_uint s = 0;
switch(t) {
case LBM_TYPE_BYTE0x00000004u:
  s = 1;
  break;
case LBM_TYPE_I0x00000008u: /* fall through */
case LBM_TYPE_U0x0000000Cu:
case LBM_TYPE_SYMBOL0x00000000u:
  s = sizeof(lbm_uint);
  break;
case LBM_TYPE_I320x28000000u: /* fall through */
case LBM_TYPE_U320x38000000u:
case LBM_TYPE_FLOAT0x68000000u:
  s = 4;
  break;
case LBM_TYPE_I640x48000000u: /* fall through */
case LBM_TYPE_U640x58000000u:
case LBM_TYPE_DOUBLE0x78000000u:
  s = 8;
  break;
}
return s;
1330}

1332static bool_Bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
(void)ix;
(void)val;
return false0;
1336}

1338static const_heap_write_fun const_heap_write = dummy_flash_write;

1340int lbm_const_heap_init(const_heap_write_fun w_fun,
                      lbm_const_heap_t *heap,
                      lbm_uint *addr,
                      lbm_uint  num_words) {
if (((uintptr_t)addr % 4) != 0) return 0;
if ((num_words % 2) != 0) return 0;

if (!lbm_const_heap_mutex_initialized) {
  mutex_init(&lbm_const_heap_mutex);
  lbm_const_heap_mutex_initialized = true1;
}

if (!lbm_mark_mutex_initialized) {
  mutex_init(&lbm_mark_mutex);
  lbm_mark_mutex_initialized = true1;
}

const_heap_write = w_fun;

heap->heap = addr;
heap->size = num_words;
heap->next = 0;

lbm_const_heap_state = heap;
// ref_cell views the lbm_uint array as an lbm_cons_t array
lbm_heaps[1] = (lbm_cons_t*)addr;
return 1;
1367}

1369lbm_flash_status lbm_allocate_const_cell(lbm_value *res) {
lbm_flash_status r = LBM_FLASH_FULL;

mutex_lock(&lbm_const_heap_mutex);
// waste a cell if we have ended up unaligned after writing an array to flash.
if (lbm_const_heap_state->next % 2 == 1) {
  lbm_const_heap_state->next++;
}

if (lbm_const_heap_state &&
    (lbm_const_heap_state->next+1) < lbm_const_heap_state->size) {
  // A cons cell uses two words.
  lbm_value cell = lbm_const_heap_state->next;
  lbm_const_heap_state->next += 2;
  *res = (cell << LBM_ADDRESS_SHIFT2) | LBM_PTR_BIT0x00000001u | LBM_TYPE_CONS0x10000000u | LBM_PTR_TO_CONSTANT_BIT0x04000000u;
  r = LBM_FLASH_WRITE_OK;
}
mutex_unlock(&lbm_const_heap_mutex);
return r;
1388}

1390lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) {
lbm_flash_status r = LBM_FLASH_FULL;

if (lbm_const_heap_state &&
    (lbm_const_heap_state->next + nwords) < lbm_const_heap_state->size) {
  lbm_uint ix = lbm_const_heap_state->next;
  *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
  lbm_const_heap_state->next += nwords;
  r = LBM_FLASH_WRITE_OK;
}
return r;
1401}

1403lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) {

lbm_flash_status r = LBM_FLASH_FULL;

if (lbm_const_heap_state &&
    (lbm_const_heap_state->next + n) < lbm_const_heap_state->size) {
  lbm_uint ix = lbm_const_heap_state->next;

  for (unsigned int i = 0; i < n; i ++) {
    if (!const_heap_write(ix + i, ((lbm_uint*)data)[i]))
      return LBM_FLASH_WRITE_ERROR;
  }
  lbm_const_heap_state->next += n;
  *res = (lbm_uint)&lbm_const_heap_state->heap[ix];
  r = LBM_FLASH_WRITE_OK;
}
return r;
1420}

1422lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) {

if (lbm_const_heap_state) {
  lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap;
  lbm_uint ix = (((lbm_uint)tgt - flash) / 4); // byte address to ix
  if (const_heap_write(ix, val)) {
    return LBM_FLASH_WRITE_OK;
  }
  return LBM_FLASH_WRITE_ERROR;
}
return LBM_FLASH_FULL;
1433}

1435lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) {
lbm_uint addr = lbm_dec_ptr(cell);
if (const_heap_write(addr+1, val))
  return LBM_FLASH_WRITE_OK;
return LBM_FLASH_WRITE_ERROR;
1440}

1442lbm_flash_status write_const_car(lbm_value cell, lbm_value val) {
lbm_uint addr = lbm_dec_ptr(cell);
if (const_heap_write(addr, val))
  return LBM_FLASH_WRITE_OK;
return LBM_FLASH_WRITE_ERROR;
1447}

1449lbm_uint lbm_flash_memory_usage(void) {
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