src/heap.c

Bug Summary

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

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

clang -cc1 -cc1 -triple i386-pc-linux-gnu -analyze -disable-free -clear-ast-before-backend -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 pic -pic-level 2 -pic-is-pie -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu i686 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/home/joels/Current/lispbm -resource-dir /usr/lib/llvm-14/lib/clang/14.0.0 -I ./include -I ./include/extensions -I platform/linux/include -D _PRELUDE -internal-isystem /usr/lib/llvm-14/lib/clang/14.0.0/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/11/../../../../x86_64-linux-gnu/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -std=c99 -fdebug-compilation-dir=/home/joels/Current/lispbm -ferror-limit 19 -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /home/joels/Current/lispbm/test_reports/version_0.23.0/scan-build/2024-03-09-191247-1858527-1 -x c src/heap.c

src/heap.c

→

1/*
  Copyright 2018, 2020, 2022, 2023 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, lbm_enc_sym(SYM_RAW_I_TYPE0x31));
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, lbm_enc_sym(SYM_RAW_U_TYPE0x32));
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, lbm_enc_sym(SYM_RAW_F_TYPE0x33));
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}

127lbm_value lbm_enc_i64(int64_t x) {
128#ifndef LBM64
lbm_value res = lbm_enc_sym(SYM_MERROR0x23);
lbm_uint* storage = lbm_memory_allocate(2);
if (storage) {
  res = lbm_cons((lbm_uint)storage, lbm_enc_sym(SYM_IND_I_TYPE0x34));
  if (lbm_type_of(res) != LBM_TYPE_SYMBOL0x00000000u) {
    memcpy(storage,&x, 8);
    res = lbm_set_ptr_type(res, LBM_TYPE_I640x48000000u);
  }
}
return res;
139#else
lbm_value u = lbm_cons((uint64_t)x, lbm_enc_sym(SYM_RAW_I_TYPE0x31));
if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
return lbm_set_ptr_type(u, LBM_TYPE_I640x48000000u);
143#endif
144}

146lbm_value lbm_enc_u64(uint64_t x) {
147#ifndef LBM64
lbm_value res = lbm_enc_sym(SYM_MERROR0x23);
uint8_t* storage = lbm_malloc(sizeof(uint64_t));
if (storage) {
  res = lbm_cons((lbm_uint)storage, lbm_enc_sym(SYM_IND_U_TYPE0x35));
  if (lbm_type_of(res) != LBM_TYPE_SYMBOL0x00000000u) {
    memcpy(storage,&x, sizeof(uint64_t));
    res = lbm_set_ptr_type(res, LBM_TYPE_U640x58000000u);
  }
}
return res;
158#else
lbm_value u = lbm_cons(x, lbm_enc_sym(SYM_RAW_U_TYPE0x32));
if (lbm_type_of(u) == LBM_TYPE_SYMBOL0x00000000u) return u;
return lbm_set_ptr_type(u, LBM_TYPE_U640x58000000u);
162#endif
163}

165lbm_value lbm_enc_double(double x) {
166#ifndef LBM64
lbm_value res = lbm_enc_sym(SYM_MERROR0x23);
lbm_uint* storage = lbm_memory_allocate(2);
if (storage) {
  res = lbm_cons((lbm_uint)storage, lbm_enc_sym(SYM_IND_F_TYPE0x36));
  if (lbm_type_of(res) != LBM_TYPE_SYMBOL0x00000000u) {
    memcpy(storage,&x, 8);
    res = lbm_set_ptr_type(res, LBM_TYPE_DOUBLE0x78000000u);
  }
}
return res;
177#else
lbm_uint t;
memcpy(&t, &x, sizeof(double));
lbm_value f = lbm_cons(t, lbm_enc_sym(SYM_RAW_F_TYPE0x33));
if (lbm_type_of(f) == LBM_TYPE_SYMBOL0x00000000u) return f;
return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE0x78000000u);
183#endif
184}

186float lbm_dec_float(lbm_value x) {
187#ifndef LBM64
float f_tmp;
lbm_uint tmp = lbm_car(x);
memcpy(&f_tmp, &tmp, sizeof(float));
return f_tmp;
192#else
uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT4);
float f_tmp;
memcpy(&f_tmp, &tmp, sizeof(float));
return f_tmp;
197#endif
198}

200double lbm_dec_double(lbm_value x) {
201#ifndef LBM64
double d;
uint32_t *data = (uint32_t*)lbm_car(x);
if (data == NULL((void*)0)) return 0; // no good way to report error from here currently.
memcpy(&d, data, sizeof(double));
return d;
207#else
double f_tmp;
lbm_uint tmp = lbm_car(x);
memcpy(&f_tmp, &tmp, sizeof(double));
return f_tmp;
212#endif
213}

215uint64_t lbm_dec_u64(lbm_value x) {
216#ifndef LBM64
uint64_t u;
uint32_t *data = (uint32_t*)lbm_car(x);
if (data == NULL((void*)0)) return 0;
memcpy(&u, data, 8);
return u;
222#else
return (uint64_t)lbm_car(x);
224#endif
225}

227int64_t lbm_dec_i64(lbm_value x) {
228#ifndef LBM64
int64_t i;
uint32_t *data = (uint32_t*)lbm_car(x);
if (data == NULL((void*)0)) return 0;
memcpy(&i, data, 8);
return i;
234#else
return (int64_t)lbm_car(x);
236#endif
237}

239char *lbm_dec_str(lbm_value val) {
char *res = 0;
if (lbm_is_array_r(val)) {
  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
  if (array) {
      res = (char *)array->data;
  }
}
return res;
248}

250lbm_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;
257}

259lbm_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;
265}

267uint8_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;
289}

291uint32_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;
312}

314int32_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;
337}

339int64_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;
361}

363uint64_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;
385}

387float 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;
410}

412double 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;
435}

437/****************************************************/
438/* HEAP MANAGEMENT                                  */

440static 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;
461}

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

468static 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;
484}

486void 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;
491}

493int 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);
509}

511lbm_uint lbm_heap_num_free(void) {
return lbm_heap_state.heap_size - lbm_heap_state.num_alloc;
513}

515lbm_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_cons_t *rc = lbm_ref_cell(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;
}
else if ((lbm_type_of(res) == LBM_TYPE_SYMBOL0x00000000u) &&
         (lbm_dec_sym(res) == SYM_NIL0x0)) {
  // all is as it should be (but no free cells)
  return ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
}
// Unreachable, unless something very wrong
return ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
541}

543lbm_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);
565}

567lbm_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);
589}

591lbm_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;
597}

599lbm_uint lbm_heap_num_allocated(void) {
return lbm_heap_state.num_alloc;
601}
602lbm_uint lbm_heap_size(void) {
return lbm_heap_state.heap_size;
604}

606lbm_uint lbm_heap_size_bytes(void) {
return lbm_heap_state.heap_bytes;
608}

610void lbm_get_heap_state(lbm_heap_state_t *res) {
*res = lbm_heap_state;
612}

614lbm_uint lbm_get_gc_stack_max(void) {
return lbm_heap_state.gc_stack.max_sp;
616}

618lbm_uint lbm_get_gc_stack_size(void) {
return lbm_heap_state.gc_stack.size;
620}

622#ifdef USE_GC_PTR_REV
623static 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);
626}

628void 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);
682}

684#else
685extern eval_context_t *ctx_running;
686void lbm_gc_mark_phase(lbm_value root) {

lbm_stack_t *s = &lbm_heap_state.gc_stack;
s->data[s->sp++] = root;

while (!lbm_stack_is_empty(s)) {
4
←
Calling 'lbm_stack_is_empty'→
8
←
Returning from 'lbm_stack_is_empty'→
9
←
Loop condition is true.  Entering loop body→
  lbm_value curr;
  lbm_pop(s, &curr);

mark_shortcut:
  if (!lbm_is_ptr(curr) || (curr & LBM_PTR_TO_CONSTANT_BIT0x04000000u)) {
10
←
Assuming the condition is false→
11
←
Assuming the condition is false→
12
←
Taking false branch→
    continue;
  }

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

  if (lbm_get_gc_mark(cell->cdr))  continue;
13
←
Assuming the condition is false→
14
←
Taking false branch→
  cell->cdr = lbm_set_gc_mark(cell->cdr);
  lbm_heap_state.gc_marked ++;

  lbm_value t_ptr = lbm_type_of(curr);

  if (t_ptr >= LBM_NON_CONS_POINTER_TYPE_FIRST0x20000000u &&
15
←
Assuming 't_ptr' is < LBM_NON_CONS_POINTER_TYPE_FIRST→
      t_ptr <= LBM_NON_CONS_POINTER_TYPE_LAST0xAC000000u) continue;

  if (cell->car == ENC_SYM_CONT(((0x10E) << 4) | 0x00000000u)) {
16
←
Assuming the condition is true→
17
←
Taking true branch→
    lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(cell->cdr);
18
←
Calling 'lbm_car'→
24
←
Returning from 'lbm_car'→
25
←
'arr' initialized to a null pointer value→
    lbm_value *arrdata = (lbm_value *)arr->data;
26
←
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'arr')
    for (lbm_uint i = 0; i < arr->size / 4; i ++) {
      if (lbm_is_ptr(arrdata[i]) &&
          !((arrdata[i] & LBM_CONTINUATION_INTERNAL0xF8000001u) == LBM_CONTINUATION_INTERNAL0xF8000001u)) {
        if (!lbm_push (s, arrdata[i])) {
          lbm_critical_error();
        }
      }
    }
  }
  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
}
732}
733#endif

735//Environments are proper lists with a 2 element list stored in each car.
736void 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;
}
749}


752void 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_LAST0xAC000000u &&
        pt_v < lbm_heap_state.heap_size) {
      lbm_gc_mark_phase(aux_data[i]);
    }
  }
}
764}

766void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) {
for (lbm_uint i = 0; i < num_roots; i ++) {
1
Assuming 'i' is < 'num_roots'→
2
←
Loop condition is true.  Entering loop body→
  lbm_gc_mark_phase(roots[i]);
3
←
Calling 'lbm_gc_mark_phase'→
}
770}

772// Sweep moves non-marked heap objects to the free list.
773int 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(lbm_dec_sym(heap[i].cdr)) {

      case SYM_IND_I_TYPE0x34: /* fall through */
      case SYM_IND_U_TYPE0x35:
      case SYM_IND_F_TYPE0x36:
        lbm_memory_free((lbm_uint*)heap[i].car);
        break;
      case SYM_ARRAY_TYPE0x30:{
        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 SYM_CHANNEL_TYPE0x37:{
        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 SYM_CUSTOM_TYPE0x38: {
        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;
827}

829void lbm_gc_state_inc(void) {
lbm_heap_state.gc_num ++;
lbm_heap_state.gc_recovered = 0;
lbm_heap_state.gc_marked = 0;
833}

835// construct, alter and break apart
836lbm_value lbm_cons(lbm_value car, lbm_value cdr) {
return lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, car, cdr);
838}

840lbm_value lbm_car(lbm_value c){

if (lbm_is_ptr(c) ){
19
←
Assuming the condition is false→
  lbm_cons_t *cell = lbm_ref_cell(c);
  return cell->car;
}

if (lbm_type_of(c) == LBM_TYPE_SYMBOL0x00000000u &&
20
←
Assuming the condition is true→
22
←
Taking true branch→
    lbm_dec_sym(c) == SYM_NIL0x0) {
21
←
Assuming the condition is true→
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
23
←
Returning zero→
}

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

855lbm_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(tmp) && lbm_dec_sym(tmp) == SYM_NIL0x0) {
    return tmp;
  }
} else if (lbm_is_symbol(c) && lbm_dec_sym(c) == SYM_NIL0x0) {
  return c;
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
871}


874lbm_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(tmp) && lbm_dec_sym(tmp) == SYM_NIL0x0) {
    return tmp;
  }
} else if (lbm_is_symbol(c) && lbm_dec_sym(c) == SYM_NIL0x0) {
  return c;
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
890}

892lbm_value lbm_cdr(lbm_value c){

if (lbm_type_of(c) == LBM_TYPE_SYMBOL0x00000000u &&
    lbm_dec_sym(c) == SYM_NIL0x0) {
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // if nil, return nil.
}

if (lbm_is_ptr(c)) {
  lbm_cons_t *cell = lbm_ref_cell(c);
  return cell->cdr;
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
904}

906lbm_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(c) && lbm_dec_sym(c) == SYM_NIL0x0) {
  return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
}
return ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u);
918}

920int 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;
929}

931int 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;
939}

941int 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;
950}

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

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

963/* calculate the length of a list and check that each element
 fullfills the predicate pred */
965unsigned 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;
976}

978/* reverse a proper list */
979lbm_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;
996}

998lbm_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;
1012}


1015lbm_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.
}
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;
1037}

1039// Append for proper lists only
1040// Destructive update of list1.
1041lbm_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);
1055}

1057lbm_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;
1065}

1067lbm_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);
}
1086}



1090// Arrays are part of the heap module because their lifespan is managed
1091// by the garbage collector. The data in the array is not stored
1092// in the "heap of cons cells".
1093int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){

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

array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / sizeof(lbm_uint));

if (array == NULL((void*)0)) {
  *res = ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u);
  return 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;
}
memset(array->data, 0, size);
array->size = size;

// allocating a cell for array's heap-presence
lbm_value cell  = lbm_heap_allocate_cell(LBM_TYPE_ARRAY0x80000000u, (lbm_uint) array, ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u));

*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);
  return 0;
}

lbm_heap_state.num_alloc_arrays ++;

return 1;
1128}

1130// Convert a C array into an lbm_array.
1131// if the array is in LBM_MEMORY, the lifetime will be managed by the GC.
1132int 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)) {
  *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;
1157}

1159lbm_int lbm_heap_array_get_size(lbm_value arr) {

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;
1170}

1172const 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);
  if (header == NULL((void*)0)) {
    return r;
  }
  r = (uint8_t*)header->data;
}
return r;
1182}

1184uint8_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);
  if (header == NULL((void*)0)) {
    return r;
  }
  r = (uint8_t*)header->data;
}
return r;
1194}


1197/* 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
1212*/

1214int 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;
1233}

1235lbm_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;
1258}

1260static bool_Bool dummy_flash_write(lbm_uint ix, lbm_uint val) {
(void)ix;
(void)val;
return false0;
1264}

1266static const_heap_write_fun const_heap_write = dummy_flash_write;

1268int 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;
1295}

1297lbm_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;
1316}

1318lbm_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;
1335}

1337lbm_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;
1342}

1344lbm_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;
1349}

1351lbm_uint lbm_flash_memory_usage(void) {
return lbm_const_heap_state->next;
1353}

←

./include/stack.h

1/** \file stack.h */
2/*
3    Copyright 2019 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#ifndef STACK_H_
19#define STACK_H_
20 
21 
22#include <stdlib.h>
23#include <stdint.h>
24#include <stdbool.h>
25#include <stdio.h>
26 
27#include "lbm_types.h"
28 
29#ifdef __cplusplus
30extern "C" {
31#endif
32 
33typedef struct {
34  lbm_uint* data;
35  lbm_uint sp;
36  lbm_uint size;
37  lbm_uint max_sp;
38} lbm_stack_t;
39 
40/** Allocate a stack on the symbols and arrays memory.
41 *  lbm_memory_init must have been run before this function or it will fail.
42 * \param s Pointer to an lbm_stack_t to initialize.
43 * \param stack_size Size in 32 bit words of stack to allocate.
44 * \return 1 on success and 0 on failure.
45 */
46int lbm_stack_allocate(lbm_stack_t *s, lbm_uint stack_size);
47/** Create a stack in a statically allocated array.
48 *
49 * \param s Pointer to an lbm_stack_t to initialize.
50 * \param data Pointer to array of 32 bit words to use as the stack storage.
51 * \param size Size in number of 32 bit words.
52 * \return 1
53 */
54int lbm_stack_create(lbm_stack_t *s, lbm_uint* data, lbm_uint size);
55/** Free a stack allocated on the lispbm_memory.
56 *
57 * \param s Pointer to lbm_stack_t to free.
58 */
59void lbm_stack_free(lbm_stack_t *s);
60/** Sets the stack SP to 0.
61 *
62 * \param s Stack to clear.
63 */
64void lbm_stack_clear(lbm_stack_t *s);
65/** Get a pointer to the nth element (from the top) of a stack.
66 *
67 * \param s Stack.
68 * \param n Index.
69 * \return Pointer into the stack or NULL.
70 */
71lbm_uint *lbm_get_stack_ptr(lbm_stack_t *s, lbm_uint n);
72/** Drop n elements (from the top) of a stack.
73 *
74 * \param s Stack to drop elements from.
75 * \param n Number of elements to drop.
76 * \return 1 on Success and 0 on failure.
77 */
78int lbm_stack_drop(lbm_stack_t *s, lbm_uint n);
79 
80/** Reserve place for n elements on the stack and
81 *  move the stack pointer to the new top.
82 * \param s Stack to reserve values on
83 * \param n Number of values to reserve
84 * \return Pointer into stack position of reserver value 0 or NULL
85 *         on failure
86 */
87lbm_uint *lbm_stack_reserve(lbm_stack_t *s, lbm_uint n);
88/** Push an element onto a stack.
89 *
90 * \param s Stack to push a value onto.
91 * \param val Value to push to the stack.
92 * \return 1 on success and 0 on failure (stack is full).
93 */
94int lbm_push(lbm_stack_t *s, lbm_uint val);
95/** Pop a value from a stack.
96 *
97 * \param s Stack to pop a value from.
98 * \param val Pointer to an lbm_value to store the pop:ed value int.
99 * \return 1 on success and 0 on failure (stack is empty).
100 */
101int lbm_pop(lbm_stack_t *s, lbm_uint *val);
102 
103/** Check if a stack is empty.
104 *
105 * \param s Stack to check.
106 * \return 1 if stack is empty otherwise 0.
107 */
108static inline int lbm_stack_is_empty(lbm_stack_t *s) {
109  if (s->sp == 0) return 1;
5
←
Assuming field 'sp' is not equal to 0→
6
←
Taking false branch→
110  return 0;
7
←
Returning zero, which participates in a condition later→
111}
112 
113/** Push 2 values to a stack.
114 *
115 * \param s Stack to push values onto.
116 * \param val0 Is pushed first.
117 * \param val1 Is pushed last.
118 * \return 1 on success and 0 on failure (stack is full).
119 */
120int lbm_push_2(lbm_stack_t *s, lbm_uint val0, lbm_uint val1);
121 
122/** Pop 2 values from a stack.
123 *
124 * \param s Stack to pop values from.
125 * \param r0 Pointer to lbm_value where the first pop:ed value will be stored.
126 * \param r1 Pointer to lbm_value where the seconds pop:ed value will be stored.
127 * \return 1 on success and 0 on failure (stack is empty).
128 */
129int lbm_pop_2(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1);
130 
131/** Pop 3 values from a stack.
132 *
133 * \param s Stack to pop values from.
134 * \param r0
135 * \param r1
136 * \param r2
137 * \return 1 on success and 0 on failure (stack is empty).
138 */
139int lbm_pop_3(lbm_stack_t *s, lbm_uint *r0, lbm_uint *r1, lbm_uint *r2);
140 
141#ifdef __cplusplus
142}
143#endif
144#endif