src/eval_cps.c

Bug Summary

File:	eval_cps.c
Warning:	line 1715, column 10 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 eval_cps.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/eval_cps.c

src/eval_cps.c

→

/*
  Copyright 2018, 2020 - 2024 Joel Svensson    svenssonjoel@yahoo.se

  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/>.
16*/

18#include <lbm_memory.h>
19#include <lbm_types.h>
20#include "symrepr.h"
21#include "heap.h"
22#include "env.h"
23#include "eval_cps.h"
24#include "stack.h"
25#include "fundamental.h"
26#include "extensions.h"
27#include "tokpar.h"
28#include "lbm_channel.h"
29#include "print.h"
30#include "platform_mutex.h"
31#include "lbm_flat_value.h"
32#include "lbm_flags.h"

34#ifdef VISUALIZE_HEAP
35#include "heap_vis.h"
36#endif

38#include <setjmp.h>

40static jmp_buf error_jmp_buf;
41static jmp_buf critical_error_jmp_buf;

43#define S_TO_US(X)(lbm_uint)((X) * 1000000) (lbm_uint)((X) * 1000000)

45#define DEC_CONTINUATION(x)(((x) & ~0xF8000001u) >> 2) (((x) & ~LBM_CONTINUATION_INTERNAL0xF8000001u) >> LBM_ADDRESS_SHIFT2)
46#define IS_CONTINUATION(x)(((x) & 0xF8000001u) == 0xF8000001u) (((x) & LBM_CONTINUATION_INTERNAL0xF8000001u) == LBM_CONTINUATION_INTERNAL0xF8000001u)
47#define CONTINUATION(x)(((x) << 2) | 0xF8000001u) (((x) << LBM_ADDRESS_SHIFT2) | LBM_CONTINUATION_INTERNAL0xF8000001u)

49#define DONE(((0) << 2) | 0xF8000001u)                  CONTINUATION(0)(((0) << 2) | 0xF8000001u)
50#define SET_GLOBAL_ENV(((1) << 2) | 0xF8000001u)        CONTINUATION(1)(((1) << 2) | 0xF8000001u)
51#define BIND_TO_KEY_REST(((2) << 2) | 0xF8000001u)      CONTINUATION(2)(((2) << 2) | 0xF8000001u)
52#define IF(((3) << 2) | 0xF8000001u)                    CONTINUATION(3)(((3) << 2) | 0xF8000001u)
53#define PROGN_REST(((4) << 2) | 0xF8000001u)            CONTINUATION(4)(((4) << 2) | 0xF8000001u)
54#define APPLICATION_ARGS(((5) << 2) | 0xF8000001u)      CONTINUATION(5)(((5) << 2) | 0xF8000001u)
55#define AND(((6) << 2) | 0xF8000001u)                   CONTINUATION(6)(((6) << 2) | 0xF8000001u)
56#define OR(((7) << 2) | 0xF8000001u)                    CONTINUATION(7)(((7) << 2) | 0xF8000001u)
57#define WAIT(((8) << 2) | 0xF8000001u)                  CONTINUATION(8)(((8) << 2) | 0xF8000001u)
58#define MATCH(((9) << 2) | 0xF8000001u)                 CONTINUATION(9)(((9) << 2) | 0xF8000001u)
59#define APPLICATION_START(((10) << 2) | 0xF8000001u)     CONTINUATION(10)(((10) << 2) | 0xF8000001u)
60#define EVAL_R(((11) << 2) | 0xF8000001u)                CONTINUATION(11)(((11) << 2) | 0xF8000001u)
61#define RESUME(((12) << 2) | 0xF8000001u)                CONTINUATION(12)(((12) << 2) | 0xF8000001u)
62#define CLOSURE_ARGS(((13) << 2) | 0xF8000001u)          CONTINUATION(13)(((13) << 2) | 0xF8000001u)
63#define EXIT_ATOMIC(((14) << 2) | 0xF8000001u)           CONTINUATION(14)(((14) << 2) | 0xF8000001u)
64#define READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u)       CONTINUATION(15)(((15) << 2) | 0xF8000001u)
65#define READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u)  CONTINUATION(16)(((16) << 2) | 0xF8000001u)
66#define READ_EVAL_CONTINUE(((17) << 2) | 0xF8000001u)    CONTINUATION(17)(((17) << 2) | 0xF8000001u)
67#define READ_EXPECT_CLOSEPAR(((18) << 2) | 0xF8000001u)  CONTINUATION(18)(((18) << 2) | 0xF8000001u)
68#define READ_DOT_TERMINATE(((19) << 2) | 0xF8000001u)    CONTINUATION(19)(((19) << 2) | 0xF8000001u)
69#define READ_DONE(((20) << 2) | 0xF8000001u)             CONTINUATION(20)(((20) << 2) | 0xF8000001u)
70#define READ_QUOTE_RESULT(((21) << 2) | 0xF8000001u)     CONTINUATION(21)(((21) << 2) | 0xF8000001u)
71#define READ_COMMAAT_RESULT(((22) << 2) | 0xF8000001u)   CONTINUATION(22)(((22) << 2) | 0xF8000001u)
72#define READ_COMMA_RESULT(((23) << 2) | 0xF8000001u)     CONTINUATION(23)(((23) << 2) | 0xF8000001u)
73#define READ_START_ARRAY(((24) << 2) | 0xF8000001u)      CONTINUATION(24)(((24) << 2) | 0xF8000001u)
74#define READ_APPEND_ARRAY(((25) << 2) | 0xF8000001u)     CONTINUATION(25)(((25) << 2) | 0xF8000001u)
75#define MAP(((26) << 2) | 0xF8000001u)                   CONTINUATION(26)(((26) << 2) | 0xF8000001u)
76#define MATCH_GUARD(((27) << 2) | 0xF8000001u)           CONTINUATION(27)(((27) << 2) | 0xF8000001u)
77#define TERMINATE(((28) << 2) | 0xF8000001u)             CONTINUATION(28)(((28) << 2) | 0xF8000001u)
78#define PROGN_VAR(((29) << 2) | 0xF8000001u)             CONTINUATION(29)(((29) << 2) | 0xF8000001u)
79#define SETQ(((30) << 2) | 0xF8000001u)                  CONTINUATION(30)(((30) << 2) | 0xF8000001u)
80#define MOVE_TO_FLASH(((31) << 2) | 0xF8000001u)         CONTINUATION(31)(((31) << 2) | 0xF8000001u)
81#define MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u) CONTINUATION(32)(((32) << 2) | 0xF8000001u)
82#define MOVE_LIST_TO_FLASH(((33) << 2) | 0xF8000001u)    CONTINUATION(33)(((33) << 2) | 0xF8000001u)
83#define CLOSE_LIST_IN_FLASH(((34) << 2) | 0xF8000001u)   CONTINUATION(34)(((34) << 2) | 0xF8000001u)
84#define QQ_EXPAND_START(((35) << 2) | 0xF8000001u)       CONTINUATION(35)(((35) << 2) | 0xF8000001u)
85#define QQ_EXPAND(((36) << 2) | 0xF8000001u)             CONTINUATION(36)(((36) << 2) | 0xF8000001u)
86#define QQ_APPEND(((37) << 2) | 0xF8000001u)             CONTINUATION(37)(((37) << 2) | 0xF8000001u)
87#define QQ_EXPAND_LIST(((38) << 2) | 0xF8000001u)        CONTINUATION(38)(((38) << 2) | 0xF8000001u)
88#define QQ_LIST(((39) << 2) | 0xF8000001u)               CONTINUATION(39)(((39) << 2) | 0xF8000001u)
89#define KILL(((40) << 2) | 0xF8000001u)                  CONTINUATION(40)(((40) << 2) | 0xF8000001u)
90#define LOOP(((41) << 2) | 0xF8000001u)                  CONTINUATION(41)(((41) << 2) | 0xF8000001u)
91#define LOOP_CONDITION(((42) << 2) | 0xF8000001u)        CONTINUATION(42)(((42) << 2) | 0xF8000001u)
92#define MERGE_REST(((43) << 2) | 0xF8000001u)            CONTINUATION(43)(((43) << 2) | 0xF8000001u)
93#define MERGE_LAYER(((44) << 2) | 0xF8000001u)           CONTINUATION(44)(((44) << 2) | 0xF8000001u)
94#define CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u)     CONTINUATION(45)(((45) << 2) | 0xF8000001u)
95#define NUM_CONTINUATIONS46     46

97#define FM_NEED_GC-1       -1
98#define FM_NO_MATCH-2      -2
99#define FM_PATTERN_ERROR-3 -3

101typedef enum {
BL_OK = 0,
BL_NO_MEMORY,
BL_INCORRECT_KEY
105} binding_location_status;

107#define FB_OK0             0
108#define FB_TYPE_ERROR-1    -1

110const char* lbm_error_str_parse_eof = "End of parse stream.";
111const char* lbm_error_str_parse_dot = "Incorrect usage of '.'.";
112const char* lbm_error_str_parse_close = "Expected closing parenthesis.";
113const char* lbm_error_str_num_args = "Incorrect number of arguments.";
114const char* lbm_error_str_forbidden_in_atomic = "Operation is forbidden in an atomic block.";
115const char* lbm_error_str_no_number = "Argument(s) must be a number.";
116const char* lbm_error_str_not_a_boolean = "Argument must be t or nil (true or false).";
117const char* lbm_error_str_incorrect_arg = "Incorrect argument.";
118const char* lbm_error_str_var_outside_progn = "Usage of var outside of progn.";
119const char* lbm_error_str_flash_not_possible = "Value cannot be written to flash.";
120const char* lbm_error_str_flash_error = "Error writing to flash.";
121const char* lbm_error_str_flash_full = "Flash memory is full.";
122const char* lbm_error_str_variable_not_bound = "Variable not bound.";

124static lbm_value lbm_error_suspect;
125static bool_Bool lbm_error_has_suspect = false0;
126#ifdef LBM_ALWAYS_GC

128#define WITH_GC(y, x)(y) = (x); if (lbm_is_symbol_merror((y))) { gc(); (y) = (x); if
 (lbm_is_symbol_merror((y))) { error_ctx((((0x23) << 4)
 | 0x00000000u)); } }                           \
gc();                                         \
(y) = (x);                                    \
if (lbm_is_symbol_merror((y))) {              \
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));                  \
}

135#define WITH_GC_RMBR_1(y, x, r)(y) = (x); if (lbm_is_symbol_merror((y))) { lbm_gc_mark_phase
(r); gc(); (y) = (x); if (lbm_is_symbol_merror((y))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } }                 \
lbm_gc_mark_phase(r);                         \
gc();                                         \
(y) = (x);                                    \
if (lbm_is_symbol_merror((y))) {              \
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));                  \
}

143#else

145#define WITH_GC(y, x)(y) = (x); if (lbm_is_symbol_merror((y))) { gc(); (y) = (x); if
 (lbm_is_symbol_merror((y))) { error_ctx((((0x23) << 4)
 | 0x00000000u)); } }                           \
(y) = (x);                                    \
if (lbm_is_symbol_merror((y))) {              \
  gc();                                       \
  (y) = (x);                                  \
  if (lbm_is_symbol_merror((y))) {            \
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));                \
  }                                           \
  /* continue executing statements below */   \
}
155#define WITH_GC_RMBR_1(y, x, r)(y) = (x); if (lbm_is_symbol_merror((y))) { lbm_gc_mark_phase
(r); gc(); (y) = (x); if (lbm_is_symbol_merror((y))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } }                 \
(y) = (x);                                    \
if (lbm_is_symbol_merror((y))) {              \
  lbm_gc_mark_phase(r);                       \
  gc();                                       \
  (y) = (x);                                  \
  if (lbm_is_symbol_merror((y))) {            \
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));                \
  }                                           \
  /* continue executing statements below */   \
}

167#endif

169typedef struct {
eval_context_t *first;
eval_context_t *last;
172} eval_context_queue_t;

174static int gc(void);
175static void error_ctx(lbm_value);
176static void error_at_ctx(lbm_value err_val, lbm_value at);
177static void enqueue_ctx(eval_context_queue_t *q, eval_context_t *ctx);
178static bool_Bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail);

180// The currently executing context.
181eval_context_t *ctx_running = NULL((void*)0);
182volatile bool_Bool  lbm_system_sleeping = false0;

184static volatile bool_Bool gc_requested = false0;
185void lbm_request_gc(void) {
gc_requested = true1;
187}

189/*
 On ChibiOs the CH_CFG_ST_FREQUENCY setting in chconf.h sets the
 resolution of the timer used for sleep operations.  If this is set
 to 10KHz the resolution is 100us.

 The CH_CFG_ST_TIMEDELTA specifies the minimum number of ticks that
 can be safely specified in a timeout directive (wonder if that
 means sleep-period). The timedelta is set to 2.

 If I have understood these correctly it means that the minimum
 sleep duration possible is 2 * 100us = 200us.
200*/

202#define EVAL_CPS_DEFAULT_STACK_SIZE256 256
203#define EVAL_CPS_MIN_SLEEP200 200
204#define EVAL_STEPS_QUOTA10   10

206static volatile uint32_t eval_steps_refill = EVAL_STEPS_QUOTA10;
207static uint32_t eval_steps_quota = EVAL_STEPS_QUOTA10;

209void lbm_set_eval_step_quota(uint32_t quota) {
eval_steps_refill = quota;
211}

213static uint32_t          eval_cps_run_state = EVAL_CPS_STATE_DEAD8;
214static volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_NONE0;
215static volatile uint32_t eval_cps_next_state_arg = 0;
216static volatile bool_Bool     eval_cps_state_changed = false0;

218static void usleep_nonsense(uint32_t us) {
(void) us;
220}

222static bool_Bool dynamic_load_nonsense(const char *sym, const char **code) {
(void) sym;
(void) code;
return false0;
226}

228static uint32_t timestamp_nonsense(void) {
return 0;
230}

232static int printf_nonsense(const char *fmt, ...) {
(void) fmt;
return 0;
235}

237static void ctx_done_nonsense(eval_context_t *ctx) {
(void) ctx;
239}

241static void critical_nonsense(void) {
return;
243}

245static void (*critical_error_callback)(void) = critical_nonsense;
246static void (*usleep_callback)(uint32_t) = usleep_nonsense;
247static uint32_t (*timestamp_us_callback)(void) = timestamp_nonsense;
248static void (*ctx_done_callback)(eval_context_t *) = ctx_done_nonsense;
249static int (*printf_callback)(const char *, ...) = printf_nonsense;
250static bool_Bool (*dynamic_load_callback)(const char *, const char **) = dynamic_load_nonsense;

252void lbm_set_critical_error_callback(void (*fptr)(void)) {
if (fptr == NULL((void*)0)) critical_error_callback = critical_nonsense;
else critical_error_callback = fptr;
255}

257void lbm_set_usleep_callback(void (*fptr)(uint32_t)) {
if (fptr == NULL((void*)0)) usleep_callback = usleep_nonsense;
else usleep_callback = fptr;
260}

262void lbm_set_timestamp_us_callback(uint32_t (*fptr)(void)) {
if (fptr == NULL((void*)0)) timestamp_us_callback = timestamp_nonsense;
else timestamp_us_callback = fptr;
265}

267void lbm_set_ctx_done_callback(void (*fptr)(eval_context_t *)) {
if (fptr == NULL((void*)0)) ctx_done_callback = ctx_done_nonsense;
else ctx_done_callback = fptr;
270}

272void lbm_set_printf_callback(int (*fptr)(const char*, ...)){
if (fptr == NULL((void*)0)) printf_callback = printf_nonsense;
else printf_callback = fptr;
275}

277void lbm_set_dynamic_load_callback(bool_Bool (*fptr)(const char *, const char **)) {
if (fptr == NULL((void*)0)) dynamic_load_callback = dynamic_load_nonsense;
else  dynamic_load_callback = fptr;
280}

282static volatile lbm_event_t *lbm_events = NULL((void*)0);
283static unsigned int lbm_events_head = 0;
284static unsigned int lbm_events_tail = 0;
285static unsigned int lbm_events_max  = 0;
286static bool_Bool         lbm_events_full = false0;
287static mutex_t      lbm_events_mutex;
288static bool_Bool         lbm_events_mutex_initialized = false0;
289static volatile lbm_cid  lbm_event_handler_pid = -1;

291lbm_cid lbm_get_event_handler_pid(void) {
return lbm_event_handler_pid;
293}

295void lbm_set_event_handler_pid(lbm_cid pid) {
lbm_event_handler_pid = pid;
297}

299bool_Bool lbm_event_handler_exists(void) {
return(lbm_event_handler_pid > 0);
301}


304static bool_Bool event_internal(lbm_event_type_t event_type, lbm_uint parameter, lbm_uint buf_ptr, lbm_uint buf_len) {
bool_Bool r = false0;
if (lbm_events) {
  mutex_lock(&lbm_events_mutex);
  if (!lbm_events_full) {
    lbm_event_t event;
    event.type = event_type;
    event.parameter = parameter;
    event.buf_ptr = buf_ptr;
    event.buf_len = buf_len;
    lbm_events[lbm_events_head] = event;
    lbm_events_head = (lbm_events_head + 1) % lbm_events_max;
    lbm_events_full = lbm_events_head == lbm_events_tail;
    r = true1;
  }
  mutex_unlock(&lbm_events_mutex);
}
return r;
322}

324bool_Bool lbm_event_define(lbm_value key, lbm_flat_value_t *fv) {
return event_internal(LBM_EVENT_DEFINE, key, (lbm_uint)fv->buf, fv->buf_size);
326}

328bool_Bool lbm_event_unboxed(lbm_value unboxed) {
lbm_uint t = lbm_type_of(unboxed);
if (t == LBM_TYPE_SYMBOL0x00000000u ||
    t == LBM_TYPE_I0x00000008u ||
    t == LBM_TYPE_U0x0000000Cu ||
    t == LBM_TYPE_CHAR0x00000004u) {
  if (lbm_event_handler_pid > 0) {
    return event_internal(LBM_EVENT_FOR_HANDLER, 0, (lbm_uint)unboxed, 0);
  }
}
return false0;
339}

341bool_Bool lbm_event(lbm_flat_value_t *fv) {
if (lbm_event_handler_pid > 0) {
  return event_internal(LBM_EVENT_FOR_HANDLER, 0, (lbm_uint)fv->buf, fv->buf_size);
}
return false0;
346}

348static bool_Bool lbm_event_pop(lbm_event_t *event) {
mutex_lock(&lbm_events_mutex);
if (lbm_events_head == lbm_events_tail && !lbm_events_full) {
  mutex_unlock(&lbm_events_mutex);
  return false0;
}
*event = lbm_events[lbm_events_tail];
lbm_events_tail = (lbm_events_tail + 1) % lbm_events_max;
lbm_events_full = false0;
mutex_unlock(&lbm_events_mutex);
return true1;
359}

361bool_Bool lbm_event_queue_is_empty(void) {
mutex_lock(&lbm_events_mutex);
bool_Bool empty = false0;
if (lbm_events_head == lbm_events_tail && !lbm_events_full) {
  empty = true1;
}
mutex_unlock(&lbm_events_mutex);
return empty;
369}

371static bool_Bool              eval_running = false0;
372static volatile bool_Bool     blocking_extension = false0;
373static mutex_t           blocking_extension_mutex;
374static bool_Bool              blocking_extension_mutex_initialized = false0;
375static lbm_uint          blocking_extension_timeout_us = 0;
376static bool_Bool              blocking_extension_timeout = false0;

378static uint32_t          is_atomic = 0;

380/* Process queues */
381static eval_context_queue_t blocked  = {NULL((void*)0), NULL((void*)0)};
382static eval_context_queue_t queue    = {NULL((void*)0), NULL((void*)0)};

384/* one mutex for all queue operations */
385mutex_t qmutex;
386bool_Bool    qmutex_initialized = false0;


389// MODES
390static volatile bool_Bool lbm_verbose = false0;

392void lbm_toggle_verbose(void) {
lbm_verbose = !lbm_verbose;
394}

396void lbm_set_verbose(bool_Bool verbose) {
lbm_verbose = verbose;
398}

400lbm_cid lbm_get_current_cid(void) {
if (ctx_running)
  return ctx_running->id;
else
  return -1;
405}

407eval_context_t *lbm_get_current_context(void) {
return ctx_running;
409}

411/****************************************************/
412/* Utilities used locally in this file              */

414static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember) {
415#ifdef LBM_ALWAYS_GC
lbm_value roots[3] = {head, tail, remember};
lbm_gc_mark_roots(roots, 3);
gc();
lbm_value res = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, head, tail);
res = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, head, tail);
if (lbm_is_symbol_merror(res)) {
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
}
return res;
425#else
lbm_value res = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, head, tail);
if (lbm_is_symbol_merror(res)) {
  lbm_value roots[3] = {head, tail, remember};
  lbm_gc_mark_roots(roots,3);
  gc();
  res = lbm_heap_allocate_cell(LBM_TYPE_CONS0x10000000u, head, tail);
  if (lbm_is_symbol_merror(res)) {
      error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}
return res;
437#endif
438}

440static lbm_uint *get_stack_ptr(eval_context_t *ctx, unsigned int n) {
if (n <= ctx->K.sp) {
  lbm_uint index = ctx->K.sp - n;
  return &ctx->K.data[index];
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
return 0; // dead code cannot be reached, but C compiler doesn't realise.
447}

449// pop_stack_ptr is safe when no GC is performed and
450// the values of the stack will be dropped.
451static lbm_uint *pop_stack_ptr(eval_context_t *ctx, unsigned int n) {
if (n <= ctx->K.sp) {
  ctx->K.sp -= n;
  return &ctx->K.data[ctx->K.sp];
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
return 0; // dead code cannot be reached, but C compiler doesn't realise.
458}

460static lbm_uint *stack_reserve(eval_context_t *ctx, unsigned int n) {
if (ctx->K.sp + n < ctx->K.size) {
  lbm_uint *ptr = &ctx->K.data[ctx->K.sp];
  ctx->K.sp += n;
  return ptr;
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
return 0; // dead code cannot be reached, but C compiler doesn't realise.
468}

470static void handle_flash_status(lbm_flash_status s) {
if ( s == LBM_FLASH_FULL) {
  lbm_set_error_reason((char*)lbm_error_str_flash_full);
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
if (s == LBM_FLASH_WRITE_ERROR) {
  lbm_set_error_reason((char*)lbm_error_str_flash_error);
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}
479}

481static void lift_array_flash(lbm_value flash_cell, char *data, lbm_uint num_elt) {

lbm_array_header_t flash_array_header;
flash_array_header.size = num_elt;
flash_array_header.data = (lbm_uint*)data;
lbm_uint flash_array_header_ptr;
handle_flash_status(lbm_write_const_raw((lbm_uint*)&flash_array_header,
                                        sizeof(lbm_array_header_t) / sizeof(lbm_uint),
                                        &flash_array_header_ptr));
handle_flash_status(write_const_car(flash_cell, flash_array_header_ptr));
handle_flash_status(write_const_cdr(flash_cell, ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u)));
492}

494static void stack_push(lbm_stack_t *s, lbm_uint val) {
if (s->sp < s->size) {
  s->data[s->sp++] = val;
  if (s->sp > s->max_sp) s->max_sp = s->sp;
  return;
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
501}

503static void stack_push_2(lbm_stack_t *s, lbm_uint v1, lbm_uint v2) {
if (s->sp + 1 < s->size) {
  lbm_uint *t = &s->data[s->sp];
  t[0] = v1;
  t[1] = v2;
  s->sp += 2;
  if (s->sp > s->max_sp) s->max_sp = s->sp;
  return;
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
513}

515static void stack_push_3(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3) {
if (s->sp + 2 < s->size) {
  lbm_uint *t = &s->data[s->sp];
  t[0] = v1;
  t[1] = v2;
  t[2] = v3;
  s->sp += 3;
  if (s->sp > s->max_sp) s->max_sp = s->sp;
  return;
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
526}

528static void stack_push_4(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4) {
if (s->sp + 3 < s->size) {
  lbm_uint *t = &s->data[s->sp];
  t[0] = v1;
  t[1] = v2;
  t[2] = v3;
  t[3] = v4;
  s->sp += 4;
  if (s->sp > s->max_sp) s->max_sp = s->sp;
  return;
}
error_ctx(ENC_SYM_STACK_ERROR(((0x27) << 4) | 0x00000000u));
540}

542static void get_car_and_cdr(lbm_value a, lbm_value *a_car, lbm_value *a_cdr) {
if (lbm_is_ptr(a)) {
  lbm_cons_t *cell = lbm_ref_cell(a);
  *a_car = cell->car;
  *a_cdr = cell->cdr;
} else if (lbm_is_symbol_nil(a)) {
  *a_car = *a_cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else {
  error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
}
552}

554/* car cdr caar cadr replacements that are evaluator safe. */
555static lbm_value get_car(lbm_value a) {
if (lbm_is_ptr(a)) {
6
←
Assuming the condition is false→
7
←
Taking false branch→
  lbm_cons_t *cell = lbm_ref_cell(a);
  return cell->car;
} else if (lbm_is_symbol_nil(a)) {
8
←
Calling 'lbm_is_symbol_nil'→
11
←
Returning from 'lbm_is_symbol_nil'→
12
←
Taking true branch→
  return a;
13
←
Returning zero (loaded from 'a')→
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
return(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
564}

566static lbm_value get_cdr(lbm_value a) {
if (lbm_is_ptr(a)) {
  lbm_cons_t *cell = lbm_ref_cell(a);
  return cell->cdr;
} else if (lbm_is_symbol_nil(a)) {
  return a;
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
return(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
575}

577static lbm_value get_caar(lbm_value a) {
if (lbm_is_ptr(a)) {
  lbm_cons_t *cell = lbm_ref_cell(a);
  lbm_value tmp = cell->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(a)) {
  return a;
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
return(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
591}

593static lbm_value get_cadr(lbm_value a) {
if (lbm_is_ptr(a)) {
  lbm_cons_t *cell = lbm_ref_cell(a);
  lbm_value tmp = cell->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(a)) {
  return a;
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
return(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
607}

609static lbm_value get_cddr(lbm_value a) {
if (lbm_is_ptr(a)) {
  lbm_cons_t *cell = lbm_ref_cell(a);
  lbm_value tmp = cell->cdr;
  if (lbm_is_ptr(tmp)) {
    return lbm_ref_cell(tmp)->cdr;
  } else if (lbm_is_symbol_nil(tmp)) {
    return tmp;
  }
} else if (lbm_is_symbol_nil(a)) {
  return a;
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
return(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
623}

625static lbm_value allocate_closure(lbm_value params, lbm_value body, lbm_value env) {

627#ifdef LBM_ALWAYS_GC
gc();
if (lbm_heap_num_free() < 4) {
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
}
632#else
if (lbm_heap_num_free() < 4) {
  gc();
  if (lbm_heap_num_free() < 4) {
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}
639#endif
// The freelist will always contain just plain heap-cells.
// So dec_ptr is sufficient.
lbm_value res = lbm_heap_state.freelist;
if (lbm_type_of(res) == LBM_TYPE_CONS0x10000000u) {
  lbm_cons_t *heap = lbm_heap_state.heap;
  lbm_uint ix = lbm_dec_ptr(res);
  heap[ix].car = ENC_SYM_CLOSURE(((0x10F) << 4) | 0x00000000u);
  ix = lbm_dec_ptr(heap[ix].cdr);
  heap[ix].car = params;
  ix = lbm_dec_ptr(heap[ix].cdr);
  heap[ix].car = body;
  ix = lbm_dec_ptr(heap[ix].cdr);
  heap[ix].car = env;
  lbm_heap_state.freelist = heap[ix].cdr;
  heap[ix].cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_heap_state.num_alloc+=4;
} else {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}
return res;
660}

662// Allocate a binding and attach it to a list (if so desired)
663static lbm_value allocate_binding(lbm_value key, lbm_value val, lbm_value the_cdr) {
if (lbm_heap_num_free() < 2) {
  gc();
  if (lbm_heap_num_free() < 2) {
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}
lbm_cons_t* heap = lbm_heap_state.heap;
lbm_value binding_cell = lbm_heap_state.freelist;
lbm_uint binding_cell_ix = lbm_dec_ptr(binding_cell);
lbm_value list_cell = heap[binding_cell_ix].cdr;
lbm_uint list_cell_ix = lbm_dec_ptr(list_cell);
lbm_heap_state.freelist = heap[list_cell_ix].cdr;
lbm_heap_state.num_alloc += 2;
heap[binding_cell_ix].car = key;
heap[binding_cell_ix].cdr = val;
heap[list_cell_ix].car = binding_cell;
heap[list_cell_ix].cdr = the_cdr;
return list_cell;
682}

684#define CLO_PARAMS0 0
685#define CLO_BODY1   1
686#define CLO_ENV2    2
687#define LOOP_BINDS0 0
688#define LOOP_COND1  1
689#define LOOP_BODY2  2

691// (closure params exp env) -> [params, exp, env])
692static void extract_n(lbm_value curr, lbm_value *res, unsigned int n) {
for (unsigned int i = 0; i < n; i ++) {
  if (lbm_is_ptr(curr)) {
    lbm_cons_t *cell = lbm_ref_cell(curr);
    res[i] = cell->car;
    curr = cell->cdr;
  } else {
    error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
  }
}
702}

704static void call_fundamental(lbm_uint fundamental, lbm_value *args, lbm_uint arg_count, eval_context_t *ctx) {
lbm_value res;
res = fundamental_table[fundamental](args, arg_count, ctx);
if (lbm_is_error(res)) {
  if (lbm_is_symbol_merror(res)) {
    gc();
    res = fundamental_table[fundamental](args, arg_count, ctx);
  }
  if (lbm_is_error(res)) {
    error_at_ctx(res, lbm_enc_sym(FUNDAMENTAL_SYMBOLS_START0x20000 | fundamental));
  }
}
lbm_stack_drop(&ctx->K, arg_count+1);
ctx->app_cont = true1;
ctx->r = res;
719}

721// block_current_ctx blocks a context until it is
722// woken up externally or a timeout period of time passes.
723static void block_current_ctx(uint32_t state, lbm_uint sleep_us,  bool_Bool do_cont) {
ctx_running->timestamp = timestamp_us_callback();
ctx_running->sleep_us = sleep_us;
ctx_running->state  = state;
ctx_running->app_cont = do_cont;
enqueue_ctx(&blocked, ctx_running);
ctx_running = NULL((void*)0);
730}

732lbm_flash_status lbm_write_const_array_padded(uint8_t *data, lbm_uint n, lbm_uint *res) {
lbm_uint full_words = n / sizeof(lbm_uint);
lbm_uint n_mod = n % sizeof(lbm_uint);

if (n_mod == 0) { // perfect fit.
  return lbm_write_const_raw((lbm_uint*)data, full_words, res);
} else {
  lbm_uint last_word = 0;
  memcpy(&last_word, &data[full_words * sizeof(lbm_uint)], n_mod);
  if (full_words >= 1) {
    lbm_flash_status s = lbm_write_const_raw((lbm_uint*)data, full_words, res);
    if ( s == LBM_FLASH_WRITE_OK) {
      lbm_uint dummy;
      s = lbm_write_const_raw(&last_word, 1, &dummy);
    }
    return s;
  } else {
    return lbm_write_const_raw(&last_word, 1, res);
  }
}
752}

754/****************************************************/
755/* Error message creation                           */

757#define ERROR_MESSAGE_BUFFER_SIZE_BYTES256 256

759void print_environments(char *buf, unsigned int size) {

lbm_value curr_l = ctx_running->curr_env;
printf_callback("\tCurrent local environment:\n");
while (lbm_type_of(curr_l) == LBM_TYPE_CONS0x10000000u) {
  lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_l));
  lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_l)));
  printf_callback("\t%s = %s\n", buf, buf+(size/2));
  curr_l = lbm_cdr(curr_l);
}
printf_callback("\n\n");
printf_callback("\tCurrent global environment:\n");
lbm_value *glob_env = lbm_get_global_env();

for (int i = 0; i < GLOBAL_ENV_ROOTS32; i ++) {
  lbm_value curr_g = glob_env[i];;
  while (lbm_type_of(curr_g) == LBM_TYPE_CONS0x10000000u) {

    lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
    lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
    printf_callback("\t%s = %s\n", buf, buf+(size/2));
    curr_g = lbm_cdr(curr_g);
  }
}
783}

785void print_error_message(lbm_value error, bool_Bool has_at, lbm_value at, unsigned int row, unsigned int col, lbm_int row0, lbm_int row1) {
if (!printf_callback) return;

/* try to allocate a lbm_print_value buffer on the lbm_memory */
char *buf = lbm_malloc_reserve(ERROR_MESSAGE_BUFFER_SIZE_BYTES256);
if (!buf) {
  printf_callback("Error: Not enough free memory to create a human readable error message\n");
  return;
}

lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, error);
printf_callback(  "***   Error: %s\n", buf);
if (has_at) {
  lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, at);
  printf_callback("***   In:    %s\n",buf);
  if (lbm_error_has_suspect) {
    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, lbm_error_suspect);
    lbm_error_has_suspect = false0;
    printf_callback("***   At:    %s\n", buf);
  } else {
    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, ctx_running->curr_exp);
    printf_callback("***   After: %s\n",buf);
  }
} else {
  lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, ctx_running->curr_exp);
  printf_callback("***   Near:  %s\n",buf);
}

printf_callback("\n");

if (lbm_is_symbol(error) &&
    error == ENC_SYM_RERROR(((0x20) << 4) | 0x00000000u)) {
  printf_callback("***   Line:   %u\n", row);
  printf_callback("***   Column: %u\n", col);
} else if (row0 != -1 || row1 != -1 ) {
  printf_callback("***   Between rows: (-1 unknown) \n");
  printf_callback("***     Start: %d\n", (int32_t)row0);
  printf_callback("***     End:   %d\n", (int32_t)row1);
}

printf_callback("\n");

if (ctx_running->error_reason) {
  printf_callback("Reason:\n   %s\n\n", ctx_running->error_reason);
}
if (lbm_verbose) {
  lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, ctx_running->curr_exp);
  printf_callback("   In context: %d\n", ctx_running->id);
  printf_callback("   Current intermediate result: %s\n\n", buf);

  print_environments(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256);
  printf_callback("\n\n");

  printf_callback("   Stack:\n");
  for (unsigned int i = 0; i < ctx_running->K.sp; i ++) {
    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES256, ctx_running->K.data[i]);
    printf_callback("     %s\n", buf);
  }
}
lbm_free(buf);
845}

847/****************************************************/
848/* Tokenizing and parsing                           */

850bool_Bool create_string_channel(char *str, lbm_value *res) {

lbm_char_channel_t *chan = NULL((void*)0);
lbm_string_channel_state_t *st = NULL((void*)0);

st = (lbm_string_channel_state_t*)lbm_memory_allocate(sizeof(lbm_string_channel_state_t) / sizeof(lbm_uint) +1);
if (st == NULL((void*)0)) {
  return false0;
}
chan = (lbm_char_channel_t*)lbm_memory_allocate(sizeof(lbm_char_channel_t) / sizeof(lbm_uint) + 1);
if (chan == NULL((void*)0)) {
  lbm_memory_free((lbm_uint*)st);
  return false0;
}

lbm_create_string_char_channel(st, chan, str);
lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CHANNEL0x90000000u, (lbm_uint) chan, ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u));
if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) {
  lbm_memory_free((lbm_uint*)st);
  lbm_memory_free((lbm_uint*)chan);
  return false0;
}

*res = cell;
return true1;
875}

877bool_Bool lift_char_channel(lbm_char_channel_t *chan , lbm_value *res) {
lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CHANNEL0x90000000u, (lbm_uint) chan, ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u));
if (lbm_type_of(cell) == LBM_TYPE_SYMBOL0x00000000u) {
  return false0;
}
*res = cell;
return true1;
884}


887/****************************************************/
888/* Queue functions                                  */

890static void queue_iterator_nm(eval_context_queue_t *q, ctx_fun f, void *arg1, void *arg2) {
eval_context_t *curr;
curr = q->first;

while (curr != NULL((void*)0)) {
  f(curr, arg1, arg2);
  curr = curr->next;
}
898}

900void lbm_running_iterator(ctx_fun f, void *arg1, void *arg2){
mutex_lock(&qmutex);
queue_iterator_nm(&queue, f, arg1, arg2);
mutex_unlock(&qmutex);
904}

906void lbm_blocked_iterator(ctx_fun f, void *arg1, void *arg2){
mutex_lock(&qmutex);
queue_iterator_nm(&blocked, f, arg1, arg2);
mutex_unlock(&qmutex);
910}

912static void enqueue_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {
if (q->last == NULL((void*)0)) {
  ctx->prev = NULL((void*)0);
  ctx->next = NULL((void*)0);
  q->first = ctx;
  q->last  = ctx;
} else {
  ctx->prev = q->last;
  ctx->next = NULL((void*)0);
  q->last->next = ctx;
  q->last = ctx;
}
924}

926static void enqueue_ctx(eval_context_queue_t *q, eval_context_t *ctx) {
mutex_lock(&qmutex);
enqueue_ctx_nm(q,ctx);
mutex_unlock(&qmutex);
930}

932static eval_context_t *lookup_ctx_nm(eval_context_queue_t *q, lbm_cid cid) {
eval_context_t *curr;
curr = q->first;
while (curr != NULL((void*)0)) {
  if (curr->id == cid) {
    return curr;
  }
  curr = curr->next;
}
return NULL((void*)0);
942}

944static bool_Bool drop_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {

bool_Bool res = false0;
if (q->first == NULL((void*)0) || q->last == NULL((void*)0)) {
  if (!(q->last == NULL((void*)0) && q->first == NULL((void*)0))) {
    /* error state that should not happen */
    return res;
  }
  /* Queue is empty */
  return res;
}

eval_context_t *curr = q->first;
while (curr) {
  if (curr->id == ctx->id) {
    res = true1;
    eval_context_t *tmp = curr->next;
    if (curr->prev == NULL((void*)0)) {
      if (curr->next == NULL((void*)0)) {
        q->last = NULL((void*)0);
        q->first = NULL((void*)0);
      } else {
        q->first = tmp;
        tmp->prev = NULL((void*)0);
      }
    } else { /* curr->prev != NULL */
      if (curr->next == NULL((void*)0)) {
        q->last = curr->prev;
        q->last->next = NULL((void*)0);
      } else {
        curr->prev->next = tmp;
        tmp->prev = curr->prev;
      }
    }
    break;
  }
  curr = curr->next;
}
return res;
983}

985/* End execution of the running context. */
986static void finish_ctx(void) {

if (!ctx_running) {
  return;
}
/* Drop the continuation stack immediately to free up lbm_memory */
lbm_stack_free(&ctx_running->K);
ctx_done_callback(ctx_running);
if (lbm_memory_ptr_inside((lbm_uint*)ctx_running->name)) {
  lbm_free(ctx_running->name);
}
if (lbm_memory_ptr_inside((lbm_uint*)ctx_running->error_reason)) {
  lbm_memory_free((lbm_uint*)ctx_running->error_reason);
}
lbm_memory_free((lbm_uint*)ctx_running->mailbox);
lbm_memory_free((lbm_uint*)ctx_running);
ctx_running = NULL((void*)0);
1003}

1005static void context_exists(eval_context_t *ctx, void *cid, void *b) {
if (ctx->id == *(lbm_cid*)cid) {
  *(bool_Bool*)b = true1;
}
1009}

1011bool_Bool lbm_wait_ctx(lbm_cid cid, lbm_uint timeout_ms) {

bool_Bool exists;
uint32_t i = 0;

do {
  exists = false0;
  lbm_blocked_iterator(context_exists, &cid, &exists);
  lbm_running_iterator(context_exists, &cid, &exists);

  if (ctx_running &&
      ctx_running->id == cid) {
    exists = true1;
  }

  if (exists) {
     if (usleep_callback) {
       usleep_callback(1000);
     }
     if (timeout_ms > 0) i ++;
  }
} while (exists && i < timeout_ms);

if (exists) return false0;
return true1;
1036}

1038void lbm_set_error_suspect(lbm_value suspect) {
lbm_error_suspect = suspect;
lbm_error_has_suspect = true1;
1041}

1043void lbm_set_error_reason(char *error_str) {
if (ctx_running != NULL((void*)0)) {
  ctx_running->error_reason = error_str;
}
1047}

1049// Not possible to CONS_WITH_GC in error_ctx_base (potential loop)
1050static void error_ctx_base(lbm_value err_val, bool_Bool has_at, lbm_value at, unsigned int row, unsigned int column) {

if (ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP(uint32_t)0x1) {
  if (lbm_heap_num_free() < 3) {
    gc();
  }

  if (lbm_heap_num_free() >= 3) {
    lbm_value msg = lbm_cons(err_val, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
    msg = lbm_cons(lbm_enc_i(ctx_running->id), msg);
    msg = lbm_cons(ENC_SYM_EXIT_ERROR(((0x3000C) << 4) | 0x00000000u), msg);
    if (lbm_is_symbol_merror(msg)) {
      // If this happens something is pretty seriously wrong.
      print_error_message(err_val,
                          has_at,
                          at,
                          row,
                          column,
                          ctx_running->row0,
                          ctx_running->row1);
    } else {
      lbm_find_receiver_and_send(ctx_running->parent, msg);
    }
  }
} else {
  print_error_message(err_val,
                      has_at,
                      at,
                      row,
                      column,
                      ctx_running->row0,
                      ctx_running->row1);
}
ctx_running->r = err_val;
finish_ctx();
longjmp(error_jmp_buf, 1);
1086}

1088static void error_at_ctx(lbm_value err_val, lbm_value at) {
error_ctx_base(err_val, true1, at, 0, 0);
1090}

1092static void error_ctx(lbm_value err_val) {
error_ctx_base(err_val, false0, 0, 0, 0);
1094}

1096static void read_error_ctx(unsigned int row, unsigned int column) {
error_ctx_base(ENC_SYM_RERROR(((0x20) << 4) | 0x00000000u), false0, 0, row, column);
1098}

1100void lbm_critical_error(void) {
longjmp(critical_error_jmp_buf, 1);
1102}

1104// successfully finish a context
1105static void ok_ctx(void) {
if (ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP(uint32_t)0x1) {
  lbm_value msg;
  WITH_GC(msg, lbm_heap_allocate_list_init(3,(msg) = (lbm_heap_allocate_list_init(3, (((0x3000B) << 4
) | 0x00000000u), lbm_enc_i(ctx_running->id), ctx_running->
r)); if (lbm_is_symbol_merror((msg))) { gc(); (msg) = (lbm_heap_allocate_list_init
(3, (((0x3000B) << 4) | 0x00000000u), lbm_enc_i(ctx_running
->id), ctx_running->r)); if (lbm_is_symbol_merror((msg)
)) { error_ctx((((0x23) << 4) | 0x00000000u)); } }
                                           ENC_SYM_EXIT_OK,(msg) = (lbm_heap_allocate_list_init(3, (((0x3000B) << 4
) | 0x00000000u), lbm_enc_i(ctx_running->id), ctx_running->
r)); if (lbm_is_symbol_merror((msg))) { gc(); (msg) = (lbm_heap_allocate_list_init
(3, (((0x3000B) << 4) | 0x00000000u), lbm_enc_i(ctx_running
->id), ctx_running->r)); if (lbm_is_symbol_merror((msg)
)) { error_ctx((((0x23) << 4) | 0x00000000u)); } }
                                           lbm_enc_i(ctx_running->id),(msg) = (lbm_heap_allocate_list_init(3, (((0x3000B) << 4
) | 0x00000000u), lbm_enc_i(ctx_running->id), ctx_running->
r)); if (lbm_is_symbol_merror((msg))) { gc(); (msg) = (lbm_heap_allocate_list_init
(3, (((0x3000B) << 4) | 0x00000000u), lbm_enc_i(ctx_running
->id), ctx_running->r)); if (lbm_is_symbol_merror((msg)
)) { error_ctx((((0x23) << 4) | 0x00000000u)); } }
                                           ctx_running->r))(msg) = (lbm_heap_allocate_list_init(3, (((0x3000B) << 4
) | 0x00000000u), lbm_enc_i(ctx_running->id), ctx_running->
r)); if (lbm_is_symbol_merror((msg))) { gc(); (msg) = (lbm_heap_allocate_list_init
(3, (((0x3000B) << 4) | 0x00000000u), lbm_enc_i(ctx_running
->id), ctx_running->r)); if (lbm_is_symbol_merror((msg)
)) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
  lbm_find_receiver_and_send(ctx_running->parent, msg);
}
finish_ctx();
1115}

1117static eval_context_t *dequeue_ctx_nm(eval_context_queue_t *q) {
if (q->last == NULL((void*)0)) {
  return NULL((void*)0);
}
// q->first should only be NULL if q->last is.
eval_context_t *res = q->first;

if (q->first == q->last) { // One thing in queue
  q->first = NULL((void*)0);
  q->last  = NULL((void*)0);
 } else {
  q->first = q->first->next;
  q->first->prev = NULL((void*)0);
}
res->prev = NULL((void*)0);
res->next = NULL((void*)0);
return res;
1134}

1136static void wake_up_ctxs_nm(void) {
lbm_uint t_now;

if (timestamp_us_callback) {
  t_now = timestamp_us_callback();
} else {
  t_now = 0;
}

eval_context_queue_t *q = &blocked;
eval_context_t *curr = q->first;

while (curr != NULL((void*)0)) {
  lbm_uint t_diff;
  eval_context_t *next = curr->next;
  if (curr->state != LBM_THREAD_STATE_BLOCKED(uint32_t)1) {
    if ( curr->timestamp > t_now) {
      /* There was an overflow on the counter */
1154#ifndef LBM64
      t_diff = (0xFFFFFFFF - curr->timestamp) + t_now;
1156#else
      t_diff = (0xFFFFFFFFFFFFFFFF - curr->timestamp) + t_now;
1158#endif
    } else {
      t_diff = t_now - curr->timestamp;
    }

    if (t_diff >= curr->sleep_us) {
      eval_context_t *wake_ctx = curr;
      if (curr == q->last) {
        if (curr->prev) {
          q->last = curr->prev;
          q->last->next = NULL((void*)0);
        } else {
          q->first = NULL((void*)0);
          q->last = NULL((void*)0);
        }
      } else if (curr->prev == NULL((void*)0)) {
        q->first = curr->next;
        q->first->prev = NULL((void*)0);
      } else {
        curr->prev->next = curr->next;
        if (curr->next) {
          curr->next->prev = curr->prev;
        }
      }
      wake_ctx->next = NULL((void*)0);
      wake_ctx->prev = NULL((void*)0);
      if (curr->state == LBM_THREAD_STATE_TIMEOUT(uint32_t)2) {
        mailbox_add_mail(wake_ctx, ENC_SYM_TIMEOUT(((0xA) << 4) | 0x00000000u));
        wake_ctx->r = ENC_SYM_TIMEOUT(((0xA) << 4) | 0x00000000u);
      }
      wake_ctx->state = LBM_THREAD_STATE_READY(uint32_t)0;
      enqueue_ctx_nm(&queue, wake_ctx);
    }
  }
  curr = next;
}
1194}

1196static void yield_ctx(lbm_uint sleep_us) {
if (timestamp_us_callback) {
  ctx_running->timestamp = timestamp_us_callback();
  ctx_running->sleep_us = sleep_us;
  ctx_running->state = LBM_THREAD_STATE_SLEEPING(uint32_t)3;
} else {
  ctx_running->timestamp = 0;
  ctx_running->sleep_us = 0;
  ctx_running->state = LBM_THREAD_STATE_SLEEPING(uint32_t)3;
}
ctx_running->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
ctx_running->app_cont = true1;
enqueue_ctx(&blocked,ctx_running);
ctx_running = NULL((void*)0);
1210}

1212static lbm_cid lbm_create_ctx_parent(lbm_value program, lbm_value env, lbm_uint stack_size, lbm_cid parent, uint32_t context_flags, char *name) {

if (!lbm_is_cons(program)) return -1;

eval_context_t *ctx = NULL((void*)0);

ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
if (ctx == NULL((void*)0)) {
  lbm_uint roots[2] = {program, env};
  lbm_gc_mark_roots(roots, 2);
  gc();
  ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
}
if (ctx == NULL((void*)0)) return -1;

if (!lbm_stack_allocate(&ctx->K, stack_size)) {
  lbm_uint roots[2] = {program, env};
  lbm_gc_mark_roots(roots, 2);
  gc();
  if (!lbm_stack_allocate(&ctx->K, stack_size)) {
    lbm_memory_free((lbm_uint*)ctx);
    return -1;
  }
}

lbm_value *mailbox = NULL((void*)0);
mailbox = (lbm_value*)lbm_memory_allocate(EVAL_CPS_DEFAULT_MAILBOX_SIZE10);
if (mailbox == NULL((void*)0)) {
  lbm_value roots[2] = {program, env};
  lbm_gc_mark_roots(roots,2);
  gc();
  mailbox = (lbm_value *)lbm_memory_allocate(EVAL_CPS_DEFAULT_MAILBOX_SIZE10);
}
if (mailbox == NULL((void*)0)) {
  lbm_stack_free(&ctx->K);
  lbm_memory_free((lbm_uint*)ctx);
  return -1;
}

// TODO: Limit names to 19 chars + 1 char for 0? (or something similar).
if (name) {
  lbm_uint name_len = strlen(name) + 1;
  ctx->name = lbm_malloc(strlen(name) + 1);
  if (ctx->name == NULL((void*)0)) {
    lbm_value roots[2] = {program, env};
    lbm_gc_mark_roots(roots, 2);
    gc();
    ctx->name = lbm_malloc(strlen(name) + 1);
  }
  if (ctx->name == NULL((void*)0)) {
    lbm_stack_free(&ctx->K);
    lbm_memory_free((lbm_uint*)mailbox);
    lbm_memory_free((lbm_uint*)ctx);
    return -1;
  }
  memcpy(ctx->name, name, name_len+1);
} else {
   ctx->name = NULL((void*)0);
}

lbm_int cid = lbm_memory_address_to_ix((lbm_uint*)ctx);

ctx->program = lbm_cdr(program);
ctx->curr_exp = lbm_car(program);
ctx->curr_env = env;
ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
ctx->error_reason = NULL((void*)0);
ctx->mailbox = mailbox;
ctx->mailbox_size = EVAL_CPS_DEFAULT_MAILBOX_SIZE10;
ctx->flags = context_flags;
ctx->num_mail = 0;
ctx->app_cont = false0;
ctx->timestamp = 0;
ctx->sleep_us = 0;
ctx->state = LBM_THREAD_STATE_READY(uint32_t)0;
ctx->prev = NULL((void*)0);
ctx->next = NULL((void*)0);

ctx->row0 = -1;
ctx->row1 = -1;

ctx->id = cid;
ctx->parent = parent;

if (!lbm_push(&ctx->K, DONE(((0) << 2) | 0xF8000001u))) {
  lbm_memory_free((lbm_uint*)ctx->mailbox);
  lbm_stack_free(&ctx->K);
  lbm_memory_free((lbm_uint*)ctx);
  return -1;
}

enqueue_ctx(&queue,ctx);

return ctx->id;
1306}

1308lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size, char *name) {
// Creates a parentless context.
return lbm_create_ctx_parent(program,
                             env,
                             stack_size,
                             -1,
                             EVAL_CPS_CONTEXT_FLAG_NOTHING(uint32_t)0x0,
                             name);
1316}

1318bool_Bool lbm_mailbox_change_size(eval_context_t *ctx, lbm_uint new_size) {

lbm_value *mailbox = NULL((void*)0);
mailbox = (lbm_value*)lbm_memory_allocate(new_size);
if (mailbox == NULL((void*)0)) {
  gc();
  mailbox = (lbm_value *)lbm_memory_allocate(new_size);
}
if (mailbox == NULL((void*)0)) {
  return false0;
}

for (lbm_uint i = 0; i < ctx->num_mail; i ++ ) {
  mailbox[i] = ctx->mailbox[i];
}
lbm_memory_free(ctx->mailbox);
ctx->mailbox = mailbox;
ctx->mailbox_size = (uint32_t)new_size;
return true1;
1337}

1339static void mailbox_remove_mail(eval_context_t *ctx, lbm_uint ix) {

for (lbm_uint i = ix; i < ctx->num_mail-1; i ++) {
  ctx->mailbox[i] = ctx->mailbox[i+1];
}
ctx->num_mail --;
1345}

1347static bool_Bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail) {

if (ctx->num_mail >= ctx->mailbox_size) {
  mailbox_remove_mail(ctx, 0);
}

ctx->mailbox[ctx->num_mail] = mail;
ctx->num_mail ++;
return true1;
1356}

1358/* Advance execution to the next expression in the program */
1359static void advance_ctx(eval_context_t *ctx) {
if (lbm_is_cons(ctx->program)) {
  stack_push(&ctx->K, DONE(((0) << 2) | 0xF8000001u));
  get_car_and_cdr(ctx->program, &ctx->curr_exp, &ctx->program);
  ctx->curr_env = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else {
  if (ctx_running == ctx) {  // This should always be the case because of odd historical reasons.
    ok_ctx();
  }
}
1369}

1371bool_Bool lbm_unblock_ctx(lbm_cid cid, lbm_flat_value_t *fv) {
return event_internal(LBM_EVENT_UNBLOCK_CTX, (lbm_uint)cid, (lbm_uint)fv->buf, fv->buf_size);
1373}

1375bool_Bool lbm_unblock_ctx_unboxed(lbm_cid cid, lbm_value unboxed) {
mutex_lock(&blocking_extension_mutex);
bool_Bool r = false0;
lbm_uint t = lbm_type_of(unboxed);
if (t == LBM_TYPE_SYMBOL0x00000000u ||
    t == LBM_TYPE_I0x00000008u ||
    t == LBM_TYPE_U0x0000000Cu ||
    t == LBM_TYPE_CHAR0x00000004u) {

  eval_context_t *found = NULL((void*)0);
  mutex_lock(&qmutex);
  found = lookup_ctx_nm(&blocked, cid);
  if (found) {
    drop_ctx_nm(&blocked,found);
    found->r = unboxed;
    if (lbm_is_error(unboxed)) {
      lbm_value trash;
      lbm_pop(&found->K, &trash);     // Destructively make sure there is room on stack.
      lbm_push(&found->K, TERMINATE(((28) << 2) | 0xF8000001u));
      found->app_cont = true1;
    }
    enqueue_ctx_nm(&queue,found);
    r = true1;
  }
  mutex_unlock(&qmutex);
}
mutex_unlock(&blocking_extension_mutex);
return r;
1403}

1405void lbm_block_ctx_from_extension_timeout(float s) {
mutex_lock(&blocking_extension_mutex);
blocking_extension = true1;
blocking_extension_timeout_us = S_TO_US(s)(lbm_uint)((s) * 1000000);
blocking_extension_timeout = true1;
1410}
1411void lbm_block_ctx_from_extension(void) {
mutex_lock(&blocking_extension_mutex);
blocking_extension = true1;
blocking_extension_timeout_us = 0;
blocking_extension_timeout = false0;
1416}

1418void lbm_undo_block_ctx_from_extension(void) {
blocking_extension = false0;
blocking_extension_timeout_us = 0;
blocking_extension_timeout = false0;
mutex_unlock(&blocking_extension_mutex);
1423}

1425lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
mutex_lock(&qmutex);
eval_context_t *found = NULL((void*)0);
bool_Bool found_blocked = false0;

found = lookup_ctx_nm(&blocked, cid);
if (found) found_blocked = true1;

if (found == NULL((void*)0)) {
  found = lookup_ctx_nm(&queue, cid);
}

if (found) {
  if (!mailbox_add_mail(found, msg)) {
    mutex_unlock(&qmutex);
    return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }

  if (found_blocked){
    drop_ctx_nm(&blocked,found);
    enqueue_ctx_nm(&queue,found);
  }
  mutex_unlock(&qmutex);
  return ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
}

/* check the current context */
if (ctx_running && ctx_running->id == cid) {
  if (!mailbox_add_mail(ctx_running, msg)) {
    mutex_unlock(&qmutex);
    return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }
  mutex_unlock(&qmutex);
  return ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
}
mutex_unlock(&qmutex);
return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
1462}

1464/* Pattern matching is currently implemented as a recursive
 function and make use of stack relative to the size of
 expressions that are being matched. */
1467static bool_Bool match(lbm_value p, lbm_value e, lbm_value *env, bool_Bool *gc) {

lbm_value binding;

if (lbm_is_match_binder(p)) {
  lbm_value var = get_cadr(p);
  lbm_value bindertype = get_car(p);

  if (!lbm_is_symbol(var)) return false0;

  switch (lbm_dec_sym(bindertype)) {
  case SYM_MATCH_ANY0x41:
    if (lbm_dec_sym(var) == SYM_DONTCARE0x9) {
      return true1;
    }
    break;
  default: /* this should be an error case */
    return false0;
  }
  binding = lbm_cons(var, e);
  if ( lbm_type_of(binding) == LBM_TYPE_SYMBOL0x00000000u ) {
    *gc = true1;
    return false0;
  }
  *env = lbm_cons(binding, *env);
  if ( lbm_type_of(*env) == LBM_TYPE_SYMBOL0x00000000u ) {
    *gc = true1;
    return false0;
  }
  return true1;
}

/* Comma-qualification experiment. */
if (lbm_is_comma_qualified_symbol(p)) {
  lbm_value sym = get_cadr(p);
  lbm_value val = lbm_env_lookup(sym, *env);
  if (lbm_is_symbol(SYM_NOT_FOUND0x24)) {
    return false0;
  }
  return struct_eq(val, e);
}

if (lbm_is_symbol(p)) {
  if (lbm_dec_sym(p) == SYM_DONTCARE0x9) return true1;
  return (p == e);
}
if (lbm_is_cons(p) &&
    lbm_is_cons(e) ) {

  lbm_value headp, tailp;
  lbm_value heade, taile;
  get_car_and_cdr(p, &headp, &tailp);
  get_car_and_cdr(e, &heade, &taile); // Static analysis warns, but execution does not
                                      // past this point unless head and tail get initialized.
  if (!match(headp, heade, env, gc)) {
    return false0;
  }
  return match (tailp, taile, env, gc);
}
return struct_eq(p, e);
1527}

1529// Find match is not very picky about syntax.
1530// A completely malformed recv form is most likely to
1531// just return no_match.
1532static int find_match(lbm_value plist, lbm_value *earr, lbm_uint num, lbm_value *e, lbm_value *env) {

// A pattern list is a list of pattern, expression lists.
// ( (p1 e1) (p2 e2) ... (pn en))
lbm_value curr_p = plist;
int n = 0;
bool_Bool gc = false0;
for (int i = 0; i < (int)num; i ++ ) {
  lbm_value curr_e = earr[i];
  while (!lbm_is_symbol_nil(curr_p)) {
    lbm_value me = get_car(curr_p);
    if (match(get_car(me), curr_e, env, &gc)) {
      if (gc) return FM_NEED_GC-1;
      *e = get_cadr(me);

      if (!lbm_is_symbol_nil(get_cadr(get_cdr(me)))) {
        return FM_PATTERN_ERROR-3;
      }
      return n;
    }
    curr_p = get_cdr(curr_p);
  }
  curr_p = plist;       /* search all patterns against next exp */
  n ++;
}

return FM_NO_MATCH-2;
1559}

1561/****************************************************/
1562/* Garbage collection                               */

1564static void mark_context(eval_context_t *ctx, void *arg1, void *arg2) {
(void) arg1;
(void) arg2;
lbm_value roots[3] = {ctx->curr_exp, ctx->program, ctx->r };
lbm_gc_mark_env(ctx->curr_env);
lbm_gc_mark_roots(roots, 3);
lbm_gc_mark_roots(ctx->mailbox, ctx->num_mail);
lbm_gc_mark_aux(ctx->K.data, ctx->K.sp);
1572}

1574static int gc(void) {
if (ctx_running) {
  ctx_running->state = ctx_running->state | LBM_THREAD_STATE_GC_BIT(uint32_t)(1 << 31);
}

gc_requested = false0;
lbm_gc_state_inc();

// The freelist should generally be NIL when GC runs.
lbm_nil_freelist();
lbm_value *env = lbm_get_global_env();
for (int i = 0; i < GLOBAL_ENV_ROOTS32; i ++) {
  lbm_gc_mark_env(env[i]);
}

mutex_lock(&qmutex); // Lock the queues.
                     // Any concurrent messing with the queues
                     // while doing GC cannot possibly be good.
queue_iterator_nm(&queue, mark_context, NULL((void*)0), NULL((void*)0));
queue_iterator_nm(&blocked, mark_context, NULL((void*)0), NULL((void*)0));

if (ctx_running) {
  mark_context(ctx_running, NULL((void*)0), NULL((void*)0));
}
mutex_unlock(&qmutex);

1600#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
1602#endif

int r = lbm_gc_sweep_phase();
lbm_heap_new_freelist_length();

if (ctx_running) {
  ctx_running->state = ctx_running->state & ~LBM_THREAD_STATE_GC_BIT(uint32_t)(1 << 31);
}
return r;
1611}

1613int lbm_perform_gc(void) {
return gc();
1615}

1617/****************************************************/
1618/* Evaluation functions                             */


1621static void eval_symbol(eval_context_t *ctx) {
lbm_uint s = lbm_dec_sym(ctx->curr_exp);
if (s >= RUNTIME_SYMBOLS_START0x40000) {
  lbm_value res = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  if (lbm_env_lookup_b(&res, ctx->curr_exp, ctx->curr_env) ||
      lbm_global_env_lookup(&res, ctx->curr_exp)) {
    ctx->r =  res;
    ctx->app_cont = true1;
    return;
  }
  // Dynamic load attempt
  // Only symbols of kind RUNTIME can be dynamically loaded.
  const char *sym_str = lbm_get_name_by_symbol(s);
  const char *code_str = NULL((void*)0);
  if (!dynamic_load_callback(sym_str, &code_str)) {
    error_at_ctx(ENC_SYM_NOT_FOUND(((0x24) << 4) | 0x00000000u), ctx->curr_exp);
  }
  stack_push_3(&ctx->K, ctx->curr_exp, ctx->curr_env, RESUME(((12) << 2) | 0xF8000001u));

  lbm_value chan;
  if (!create_string_channel((char *)code_str, &chan)) {
    gc();
    if (!create_string_channel((char *)code_str, &chan)) {
      error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
    }
  }

  lbm_value loader;
  WITH_GC_RMBR_1(loader, lbm_heap_allocate_list_init(2,(loader) = (lbm_heap_allocate_list_init(2, (((0x30001) <<
 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror((loader)
)) { lbm_gc_mark_phase(chan); gc(); (loader) = (lbm_heap_allocate_list_init
(2, (((0x30001) << 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror
((loader))) { error_ctx((((0x23) << 4) | 0x00000000u));
 } }
                                                     ENC_SYM_READ,(loader) = (lbm_heap_allocate_list_init(2, (((0x30001) <<
 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror((loader)
)) { lbm_gc_mark_phase(chan); gc(); (loader) = (lbm_heap_allocate_list_init
(2, (((0x30001) << 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror
((loader))) { error_ctx((((0x23) << 4) | 0x00000000u));
 } }
                                                     chan), chan)(loader) = (lbm_heap_allocate_list_init(2, (((0x30001) <<
 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror((loader)
)) { lbm_gc_mark_phase(chan); gc(); (loader) = (lbm_heap_allocate_list_init
(2, (((0x30001) << 4) | 0x00000000u), chan)); if (lbm_is_symbol_merror
((loader))) { error_ctx((((0x23) << 4) | 0x00000000u));
 } };
  lbm_value evaluator;
  WITH_GC_RMBR_1(evaluator, lbm_heap_allocate_list_init(2,(evaluator) = (lbm_heap_allocate_list_init(2, (((0x30008) <<
 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror((evaluator
))) { lbm_gc_mark_phase(loader); gc(); (evaluator) = (lbm_heap_allocate_list_init
(2, (((0x30008) << 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror
((evaluator))) { error_ctx((((0x23) << 4) | 0x00000000u
)); } }
                                                        ENC_SYM_EVAL,(evaluator) = (lbm_heap_allocate_list_init(2, (((0x30008) <<
 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror((evaluator
))) { lbm_gc_mark_phase(loader); gc(); (evaluator) = (lbm_heap_allocate_list_init
(2, (((0x30008) << 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror
((evaluator))) { error_ctx((((0x23) << 4) | 0x00000000u
)); } }
                                                        loader), loader)(evaluator) = (lbm_heap_allocate_list_init(2, (((0x30008) <<
 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror((evaluator
))) { lbm_gc_mark_phase(loader); gc(); (evaluator) = (lbm_heap_allocate_list_init
(2, (((0x30008) << 4) | 0x00000000u), loader)); if (lbm_is_symbol_merror
((evaluator))) { error_ctx((((0x23) << 4) | 0x00000000u
)); } };
  ctx->curr_exp = evaluator;
  ctx->curr_env = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // dynamics should be evaluable in empty local env
} else {
  //special symbols and extensions can be handled the same way.
  ctx->r = ctx->curr_exp;
  ctx->app_cont = true1;
}
1663}

1665static void eval_quote(eval_context_t *ctx) {
ctx->r = get_cadr(ctx->curr_exp);
ctx->app_cont = true1;
1668}

1670static void eval_selfevaluating(eval_context_t *ctx) {
ctx->r = ctx->curr_exp;
ctx->app_cont = true1;
1673}

1675static void eval_progn(eval_context_t *ctx) {
lbm_value exps = get_cdr(ctx->curr_exp);

if (lbm_is_cons(exps)) {
  lbm_uint *sptr = stack_reserve(ctx, 4);
  sptr[0] = ctx->curr_env; // env to restore between expressions in progn
  sptr[1] = lbm_enc_u(0);   // Has env been copied (needed for progn local bindings)
  sptr[3] = PROGN_REST(((4) << 2) | 0xF8000001u);
  get_car_and_cdr(exps, &ctx->curr_exp, &sptr[2]);
  if (lbm_is_symbol(sptr[2])) /* The only symbol it can be is nil */
    lbm_stack_drop(&ctx->K, 4);
} else if (lbm_is_symbol_nil(exps)) {
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  ctx->app_cont = true1;
} else {
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
1692}

1694static void eval_atomic(eval_context_t *ctx) {
if (is_atomic) {
  lbm_set_error_reason("Atomic blocks cannot be nested!");
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}

stack_push(&ctx->K, EXIT_ATOMIC(((14) << 2) | 0xF8000001u));
is_atomic ++;
eval_progn(ctx);
1703}


1706static void eval_callcc(eval_context_t *ctx) {
lbm_value cont_array;
if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp * sizeof(lbm_uint))) {
1
Value assigned to 'cont_array'→
2
←
Assuming the condition is false→
3
←
Taking false branch→
  gc();
  if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp * sizeof(lbm_uint))) {
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}
lbm_array_header_t *arr = (lbm_array_header_t*)get_car(cont_array);
4
←
Passing value via 1st parameter 'a'→
5
←
Calling 'get_car'→
14
←
Returning from 'get_car'→
15
←
'arr' initialized to a null pointer value→
memcpy(arr->data, ctx->K.data, ctx->K.sp * sizeof(lbm_uint));
16
←
Access to field 'data' results in a dereference of a null pointer (loaded from variable 'arr')

lbm_value acont = cons_with_gc(ENC_SYM_CONT(((0x10E) << 4) | 0x00000000u), cont_array, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));

/* Create an application */
lbm_value fun_arg = get_cadr(ctx->curr_exp);
lbm_value app;
WITH_GC_RMBR_1(app, lbm_heap_allocate_list_init(2,(app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if (
lbm_is_symbol_merror((app))) { lbm_gc_mark_phase(acont); gc()
; (app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if
 (lbm_is_symbol_merror((app))) { error_ctx((((0x23) << 4
) | 0x00000000u)); } }
                                                fun_arg,(app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if (
lbm_is_symbol_merror((app))) { lbm_gc_mark_phase(acont); gc()
; (app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if
 (lbm_is_symbol_merror((app))) { error_ctx((((0x23) << 4
) | 0x00000000u)); } }
                                                acont), acont)(app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if (
lbm_is_symbol_merror((app))) { lbm_gc_mark_phase(acont); gc()
; (app) = (lbm_heap_allocate_list_init(2, fun_arg, acont)); if
 (lbm_is_symbol_merror((app))) { error_ctx((((0x23) << 4
) | 0x00000000u)); } };

ctx->curr_exp = app;
1727}

1729// (define sym exp)
1730static void eval_define(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value key, rest_args;
get_car_and_cdr(args, &key, &rest_args);
lbm_value val_exp, rest_val;
get_car_and_cdr(rest_args, &val_exp, &rest_val);
lbm_uint *sptr = stack_reserve(ctx, 2);

if (lbm_is_symbol(key) && lbm_is_symbol_nil(rest_val)) {
  lbm_uint sym_val = lbm_dec_sym(key);

  sptr[0] = key;

  if (sym_val >= RUNTIME_SYMBOLS_START0x40000) {
    sptr[1] = SET_GLOBAL_ENV(((1) << 2) | 0xF8000001u);
    if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x2) {
      stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u));
    }
    ctx->curr_exp = val_exp;
    return;
  }
}
error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ctx->curr_exp);
1753}

1755// (lambda param-list body-exp) -> (closure param-list body-exp env)
1756static void eval_lambda(eval_context_t *ctx) {
lbm_value cdr = get_cdr(ctx->curr_exp);
ctx->r = allocate_closure(get_car(cdr), get_cadr(cdr), ctx->curr_env);
ctx->app_cont = true1;
1760}

1762// (if cond-expr then-expr else-expr)
1763static void eval_if(eval_context_t *ctx) {

lbm_value cdr = get_cdr(ctx->curr_exp);
lbm_value exp, cddr;
get_car_and_cdr(cdr, &exp, &cddr);

lbm_uint *sptr = stack_reserve(ctx, 4);
sptr[0] = get_cadr(cddr); // else_branch
sptr[1] = get_car(cddr); // then_branch
sptr[2] = ctx->curr_env;
sptr[3] = IF(((3) << 2) | 0xF8000001u);
ctx->curr_exp = exp;
1775}

1777// (cond (cond-expr-1 expr-1)
1778//         ...
1779//       (cond-expr-N expr-N))
1780static void eval_cond(eval_context_t *ctx) {
lbm_value cond1 = get_cadr(ctx->curr_exp);

if (lbm_is_symbol_nil(cond1)) {
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  ctx->app_cont = true1;
} else {
  lbm_uint len = lbm_list_length(cond1);
  if (len != 2) {
    lbm_set_error_reason("Incorrect syntax in cond");
    error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
  }
  lbm_value condition = get_car(cond1);
  lbm_value body = get_cadr(cond1);
  lbm_value rest;
  rest = cons_with_gc(ENC_SYM_COND(((0x110) << 4) | 0x00000000u), get_cddr(ctx->curr_exp), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_uint *sptr = stack_reserve(ctx, 4);
  sptr[0] = rest;
  sptr[1] = body;
  sptr[2] = ctx->curr_env;
  sptr[3] = IF(((3) << 2) | 0xF8000001u);
  ctx->curr_exp = condition;
}
1803}

1805static void eval_app_cont(eval_context_t *ctx) {
lbm_stack_drop(&ctx->K, 1);
ctx->app_cont = true1;
1808}

1810// (var x (...)) - local binding inside of an progn
1811static void eval_var(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value sym = get_car(args);
lbm_value v_exp = get_cadr(args);
stack_push_2(&ctx->K, sym, PROGN_VAR(((29) << 2) | 0xF8000001u));
ctx->curr_exp = v_exp;
1817}

1819// (setq x (...)) - same as (set 'x (...)) or (setvar 'x (...))
1820static void eval_setq(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value sym = get_car(args);
lbm_value v_exp = get_cadr(args);
stack_push_3(&ctx->K, ctx->curr_env, sym, SETQ(((30) << 2) | 0xF8000001u));
ctx->curr_exp = v_exp;
1826}

1828static void eval_move_to_flash(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
stack_push_2(&ctx->K, args, MOVE_TO_FLASH(((31) << 2) | 0xF8000001u));
ctx->app_cont = true1;
1832}

1834// Create a named location in an environment to later receive a value.
1835static binding_location_status create_binding_location(lbm_value key, lbm_value *env) {

if (lbm_is_symbol(key) &&
    (key == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u) ||
     key == ENC_SYM_DONTCARE(((0x9) << 4) | 0x00000000u)))
  return BL_OK;

if (lbm_type_of(key) == LBM_TYPE_SYMBOL0x00000000u) { // default case
  lbm_value binding;
  lbm_value new_env_tmp;
  binding = lbm_cons(key, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  new_env_tmp = lbm_cons(binding, *env);
  if (lbm_is_symbol(binding) || lbm_is_symbol(new_env_tmp)) {
    return BL_NO_MEMORY;
  }
  *env = new_env_tmp;
} else if (lbm_is_cons(key)) { // deconstruct case
  int r = create_binding_location(get_car(key), env);
  if (r == BL_OK) {
    r = create_binding_location(get_cdr(key), env);
  }
  return r;
}
return BL_OK;
1859}

1861static void let_bind_values_eval(lbm_value binds, lbm_value exp, lbm_value env, eval_context_t *ctx) {

if (!lbm_is_cons(binds)) {
  // binds better be nil or there is a programmer error.
  ctx->curr_exp = exp;
  return;
}

// Preallocate binding locations.
lbm_value curr = binds;
while (lbm_is_cons(curr)) {
  lbm_value new_env_tmp = env;
  lbm_value key = get_caar(curr);
  binding_location_status r = create_binding_location(key, &new_env_tmp);
  if (r != BL_OK) {
    if (r == BL_NO_MEMORY) {
      new_env_tmp = env;
      lbm_gc_mark_phase(env);
      gc();
      r = create_binding_location(key, &new_env_tmp);
    }
    switch(r) {
    case BL_OK:
      break;
    case BL_NO_MEMORY:
      error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
      break;
    case BL_INCORRECT_KEY:
      error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
      break;
    }
  }
  env = new_env_tmp;
  curr = get_cdr(curr);
}

lbm_value key0 = get_caar(binds);
lbm_value val0_exp = get_cadr(get_car(binds));

lbm_uint *sptr = stack_reserve(ctx, 5);
sptr[0] = exp;
sptr[1] = get_cdr(binds);
sptr[2] = env;
sptr[3] = key0;
sptr[4] = BIND_TO_KEY_REST(((2) << 2) | 0xF8000001u);
ctx->curr_exp = val0_exp;
ctx->curr_env = env;
1908}

1910// (loop list-of-local-bindings
1911//       condition-exp
1912//       body-exp)
1913static void eval_loop(eval_context_t *ctx) {
lbm_value env              = ctx->curr_env;
lbm_value parts[3];
extract_n(get_cdr(ctx->curr_exp), parts, 3);
stack_push_3(&ctx->K, parts[LOOP_BODY2], parts[LOOP_COND1], LOOP_CONDITION(((42) << 2) | 0xF8000001u));
let_bind_values_eval(parts[LOOP_BINDS0], parts[LOOP_COND1], env, ctx);
1919}

1921// (let list-of-bindings
1922//      body-exp)
1923static void eval_let(eval_context_t *ctx) {
lbm_value env      = ctx->curr_env;
lbm_value binds    = get_cadr(ctx->curr_exp); // key value pairs.
lbm_value exp      = get_cadr(get_cdr(ctx->curr_exp)); // exp to evaluate in the new env.
let_bind_values_eval(binds, exp, env, ctx);
1928}

1930// (and exp0 ... expN)
1931static void eval_and(eval_context_t *ctx) {
lbm_value rest = get_cdr(ctx->curr_exp);
if (lbm_is_symbol_nil(rest)) {
  ctx->app_cont = true1;
  ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
} else {
  stack_push_3(&ctx->K, ctx->curr_env, get_cdr(rest), AND(((6) << 2) | 0xF8000001u));
  ctx->curr_exp = get_car(rest);
}
1940}

1942// (or exp0 ... expN)
1943static void eval_or(eval_context_t *ctx) {
lbm_value rest = get_cdr(ctx->curr_exp);
if (lbm_is_symbol_nil(rest)) {
  ctx->app_cont = true1;
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else {
  stack_push_3(&ctx->K, ctx->curr_env, get_cdr(rest), OR(((7) << 2) | 0xF8000001u));
  ctx->curr_exp = get_car(rest);
}
1952}

1954// Pattern matching
1955// format:
1956// (match e (pattern body)
1957//          (pattern body)
1958//          ...  )
1959//
1960// There can be an optional pattern guard:
1961// (match e (pattern guard body)
1962//          ... )
1963// a guard is a boolean expression.
1964// Guards make match, pattern matching more complicated
1965// than the recv pattern matching and requires staged execution
1966// via the continuation system rather than a while loop over a list.
1967static void eval_match(eval_context_t *ctx) {

lbm_value rest = get_cdr(ctx->curr_exp);
if (lbm_type_of(rest) == LBM_TYPE_SYMBOL0x00000000u &&
    rest == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  // Someone wrote the program (match)
  ctx->app_cont = true1;
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else {
  lbm_value cdr_rest;
  get_car_and_cdr(rest, &ctx->curr_exp, &cdr_rest);
  stack_push_3(&ctx->K, cdr_rest, ctx->curr_env, MATCH(((9) << 2) | 0xF8000001u));
}
1980}

1982static void receive_base(eval_context_t *ctx, lbm_value pats, float timeout_time, bool_Bool timeout) {
 if (ctx->num_mail == 0) {
   if (timeout) {
     block_current_ctx(LBM_THREAD_STATE_TIMEOUT(uint32_t)2, S_TO_US(timeout_time)(lbm_uint)((timeout_time) * 1000000), false0);
   } else {
     block_current_ctx(LBM_THREAD_STATE_BLOCKED(uint32_t)1,0,false0);
   }
} else {
  lbm_value *msgs = ctx->mailbox;
  lbm_uint  num   = ctx->num_mail;

  if (lbm_is_symbol_nil(pats)) {
    /* A receive statement without any patterns */
    ctx->app_cont = true1;
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  } else {
    /* The common case */
    lbm_value e;
    lbm_value new_env = ctx->curr_env;
    int n = find_match(pats, msgs, num, &e, &new_env);
    if (n == FM_NEED_GC-1) {
      gc();
      new_env = ctx->curr_env;
      n = find_match(pats, msgs, num, &e, &new_env);
      if (n == FM_NEED_GC-1) {
        error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
      }
    }
    if (n == FM_PATTERN_ERROR-3) {
      lbm_set_error_reason("Incorrect pattern format for recv");
      error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u),pats);
    } else if (n >= 0 ) { /* Match */
      mailbox_remove_mail(ctx, (lbm_uint)n);
      ctx->curr_env = new_env;
      ctx->curr_exp = e;
    } else { /* No match  go back to sleep */
      ctx->r = ENC_SYM_NO_MATCH(((0x40) << 4) | 0x00000000u);
      if (timeout) {
        block_current_ctx(LBM_THREAD_STATE_TIMEOUT(uint32_t)2,S_TO_US(timeout_time)(lbm_uint)((timeout_time) * 1000000),false0);
      } else {
        block_current_ctx(LBM_THREAD_STATE_BLOCKED(uint32_t)1, 0,false0);
      }
    }
  }
}
return;
2028}

2030static void eval_receive_timeout(eval_context_t *ctx) {
if (is_atomic) {
  lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
lbm_value timeout_val = get_car(get_cdr(ctx->curr_exp));
if (!lbm_is_number(timeout_val)) {
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
float timeout_time = lbm_dec_as_float(timeout_val);
lbm_value pats = get_cdr(get_cdr(ctx->curr_exp));
receive_base(ctx, pats, timeout_time, true1);
2042}

2044// Receive
2045// (recv (pattern expr)
2046//       (pattern expr))
2047static void eval_receive(eval_context_t *ctx) {

if (is_atomic) {
  lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ctx->curr_exp);
}
lbm_value pats = get_cdr(ctx->curr_exp);
receive_base(ctx, pats, 0, false0);
2055}

2057/*********************************************************/
2058/*  Continuation functions                               */

2060/* cont_set_global_env
 sp-1 : Key-symbol
*/
2063static void cont_set_global_env(eval_context_t *ctx){

lbm_value key;
lbm_value val = ctx->r;

lbm_pop(&ctx->K, &key);
lbm_uint dec_key = lbm_dec_sym(key);
lbm_uint ix_key  = dec_key & GLOBAL_ENV_MASK0x1F;
lbm_value *global_env = lbm_get_global_env();
lbm_uint orig_env = global_env[ix_key];
lbm_value new_env;
// A key is a symbol and should not need to be remembered.
WITH_GC(new_env, lbm_env_set(orig_env,key,val))(new_env) = (lbm_env_set(orig_env,key,val)); if (lbm_is_symbol_merror
((new_env))) { gc(); (new_env) = (lbm_env_set(orig_env,key,val
)); if (lbm_is_symbol_merror((new_env))) { error_ctx((((0x23)
 << 4) | 0x00000000u)); } };

global_env[ix_key] = new_env;
ctx->r = val;

ctx->app_cont = true1;

return;
2083}

2085static void cont_resume(eval_context_t *ctx) {
lbm_value exp;
lbm_value env;
lbm_pop_2(&ctx->K, &env, &exp);
ctx->curr_exp = exp;
ctx->curr_env = env;
2091}

2093static void cont_progn_rest(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 3);

lbm_value rest = sptr[2];
lbm_value env  = sptr[0];

lbm_value rest_car, rest_cdr;
get_car_and_cdr(rest, &rest_car, &rest_cdr);
if (lbm_is_symbol_nil(rest_cdr)) {
  // allow for tail recursion
  ctx->curr_exp = rest_car;
  ctx->curr_env = env;
  lbm_stack_drop(&ctx->K, 3);
} else {
  sptr[2] = rest_cdr;
  stack_push(&ctx->K, PROGN_REST(((4) << 2) | 0xF8000001u));
  ctx->curr_exp = rest_car;
  ctx->curr_env = env;
}
2112}

2114static void cont_wait(eval_context_t *ctx) {

lbm_value cid_val;
lbm_pop(&ctx->K, &cid_val);
lbm_cid cid = (lbm_cid)lbm_dec_i(cid_val);

bool_Bool exists = false0;

lbm_blocked_iterator(context_exists, &cid, &exists);
lbm_running_iterator(context_exists, &cid, &exists);

if (ctx_running->id == cid) {
  exists = true1;
}

if (exists) {
  stack_push_2(&ctx->K, lbm_enc_i(cid), WAIT(((8) << 2) | 0xF8000001u));
  ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  ctx->app_cont = true1;
  yield_ctx(50000);
} else {
  ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  ctx->app_cont = true1;
}
2138}

2140static lbm_value perform_setvar(lbm_value key, lbm_value val, lbm_value env) {

lbm_uint s = lbm_dec_sym(key);
if (s >= RUNTIME_SYMBOLS_START0x40000) {
  lbm_value new_env = lbm_env_modify_binding(env, key, val);
  if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND(((0x24) << 4) | 0x00000000u)) {
    lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK0x1F;
    lbm_value *glob_env = lbm_get_global_env();
    new_env = lbm_env_modify_binding(glob_env[ix_key], key, val);
    glob_env[ix_key] = new_env;
  }
  if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND(((0x24) << 4) | 0x00000000u)) {
    lbm_set_error_reason((char*)lbm_error_str_variable_not_bound);
    error_at_ctx(ENC_SYM_NOT_FOUND(((0x24) << 4) | 0x00000000u), key);
  }
  return val;
}
error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_SETVAR(((0x30000) << 4) | 0x00000000u));
return ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // unreachable
2159}

2161static void apply_setvar(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_symbol(args[0])) {
  lbm_value res;
  WITH_GC(res, perform_setvar(args[0], args[1], ctx->curr_env))(res) = (perform_setvar(args[0], args[1], ctx->curr_env));
 if (lbm_is_symbol_merror((res))) { gc(); (res) = (perform_setvar
(args[0], args[1], ctx->curr_env)); if (lbm_is_symbol_merror
((res))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
  ctx->r = args[1];
  lbm_stack_drop(&ctx->K, nargs+1);
  ctx->app_cont = true1;
} else {
  if (nargs == 2) lbm_set_error_reason((char*)lbm_error_str_incorrect_arg);
  else lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_SETVAR(((0x30000) << 4) | 0x00000000u));
}
2173}

2175static void apply_read_base(lbm_value *args, lbm_uint nargs, eval_context_t *ctx, bool_Bool program, bool_Bool incremental) {
if (nargs == 1) {
  lbm_value chan = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  if (lbm_type_of_functional(args[0]) == LBM_TYPE_ARRAY0x80000000u) {
    if (!create_string_channel(lbm_dec_str(args[0]), &chan)) {
      gc();
      if (!create_string_channel(lbm_dec_str(args[0]), &chan)) {
        error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
      }
    }
  } else if (lbm_type_of(args[0]) == LBM_TYPE_CHANNEL0x90000000u) {
    chan = args[0];
  } else {
    error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
  }
  lbm_value *sptr = get_stack_ptr(ctx, 2);

  //sptr[0] = Restore context flag to incremental read?
  //          TRUE -> set incremental
  //          NIL  -> set non-incremental
  if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x8) {
    sptr[0] = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  } else {
    sptr[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }
  sptr[1] = chan;
  stack_push(&ctx->K, READ_DONE(((20) << 2) | 0xF8000001u));

  if (program) {
    if (incremental) {
      stack_push_3(&ctx->K, chan, ctx->curr_env, READ_EVAL_CONTINUE(((17) << 2) | 0xF8000001u));
    } else {
      stack_push_4(&ctx->K, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), chan, READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u));
    }
  }
  stack_push_3(&ctx->K, chan, lbm_enc_u(1), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
  ctx->app_cont = true1;
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
2216}

2218static void apply_read_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
apply_read_base(args,nargs,ctx,true1,false0);
2220}

2222static void apply_read_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
ctx->flags |= EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x8;
apply_read_base(args,nargs,ctx,true1,true1);
2225}

2227static void apply_read(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
apply_read_base(args,nargs,ctx,false0,false0);
2229}

2231static void apply_spawn_base(lbm_value *args, lbm_uint nargs, eval_context_t *ctx, uint32_t context_flags) {

lbm_uint stack_size = EVAL_CPS_DEFAULT_STACK_SIZE256;
lbm_uint closure_pos = 0;
char *name = NULL((void*)0);

if (nargs >= 1 &&
    lbm_is_closure(args[0])) {
  closure_pos = 0;
} else if (nargs >= 2 &&
    lbm_is_number(args[0]) &&
    lbm_is_closure(args[1])) {
  stack_size = lbm_dec_as_u32(args[0]);
  closure_pos = 1;
} else if (nargs >= 2 &&
           lbm_is_array_r(args[0]) &&
           lbm_is_closure(args[1])) {
  name = lbm_dec_str(args[0]);
  closure_pos = 1;
}else if (nargs >= 3 &&
           lbm_is_array_r(args[0]) &&
           lbm_is_number(args[1]) &&
           lbm_is_closure(args[2])) {
  stack_size = lbm_dec_as_u32(args[1]);
  closure_pos = 2;
  name = lbm_dec_str(args[0]);
} else {
  if (context_flags & EVAL_CPS_CONTEXT_FLAG_TRAP(uint32_t)0x1)
    error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u),ENC_SYM_SPAWN_TRAP(((0x30005) << 4) | 0x00000000u));
  else
    error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u),ENC_SYM_SPAWN(((0x30004) << 4) | 0x00000000u));
}

lbm_value cl[3];
extract_n(get_cdr(args[closure_pos]), cl, 3);
lbm_value curr_param = cl[CLO_PARAMS0];
lbm_value clo_env    = cl[CLO_ENV2];
lbm_uint i = closure_pos + 1;
while (lbm_is_cons(curr_param) && i <= nargs) {
  lbm_value entry = cons_with_gc(get_car(curr_param), args[i], clo_env);
  lbm_value aug_env = cons_with_gc(entry, clo_env,ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  clo_env = aug_env;
  curr_param = get_cdr(curr_param);
  i ++;
}

lbm_stack_drop(&ctx->K, nargs+1);

lbm_value program = cons_with_gc(cl[CLO_BODY1], ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), clo_env);

lbm_cid cid = lbm_create_ctx_parent(program,
                                    clo_env,
                                    stack_size,
                                    lbm_get_current_cid(),
                                    context_flags,
                                    name);
ctx->r = lbm_enc_i(cid);
ctx->app_cont = true1;
2289}

2291static void apply_spawn(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
apply_spawn_base(args,nargs,ctx, EVAL_CPS_CONTEXT_FLAG_NOTHING(uint32_t)0x0);
2293}

2295static void apply_spawn_trap(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
apply_spawn_base(args,nargs,ctx, EVAL_CPS_CONTEXT_FLAG_TRAP(uint32_t)0x1);
2297}

2299static void apply_yield(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (is_atomic) {
  lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_YIELD(((0x30006) << 4) | 0x00000000u));
}
if (nargs == 1 && lbm_is_number(args[0])) {
  lbm_uint ts = lbm_dec_as_u32(args[0]);
  lbm_stack_drop(&ctx->K, nargs+1);
  yield_ctx(ts);
} else {
  lbm_set_error_reason((char*)lbm_error_str_no_number);
  error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_YIELD(((0x30006) << 4) | 0x00000000u));
}
2312}

2314static void apply_sleep(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (is_atomic) {
  lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_SLEEP(((0x30012) << 4) | 0x00000000u));
}
if (nargs == 1 && lbm_is_number(args[0])) {
  lbm_uint ts = (lbm_uint)(1000000.0f * lbm_dec_as_float(args[0]));
  lbm_stack_drop(&ctx->K, nargs+1);
  yield_ctx(ts);
} else {
  lbm_set_error_reason((char*)lbm_error_str_no_number);
  error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_SLEEP(((0x30012) << 4) | 0x00000000u));
}
2327}

2329static void apply_wait(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 1 && lbm_type_of(args[0]) == LBM_TYPE_I0x00000008u) {
  lbm_cid cid = (lbm_cid)lbm_dec_i(args[0]);
  lbm_stack_drop(&ctx->K, nargs+1);
  stack_push_2(&ctx->K, lbm_enc_i(cid), WAIT(((8) << 2) | 0xF8000001u));
  ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  ctx->app_cont = true1;
  yield_ctx(50000);
} else {
  error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_WAIT(((0x30007) << 4) | 0x00000000u));
}
2340}

2342static void apply_eval(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if ( nargs == 1) {
  ctx->curr_exp = args[0];
} else if (nargs == 2) {
  ctx->curr_exp = args[1];
  ctx->curr_env = args[0];
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_EVAL(((0x30008) << 4) | 0x00000000u));
}
lbm_stack_drop(&ctx->K, nargs+1);
2353}

2355static void apply_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
int prg_pos = 0;
if (nargs == 2) {
  prg_pos = 1;
  ctx->curr_env = args[0];
}
if (nargs == 1 || nargs == 2) {
  lbm_value prg = args[prg_pos];
  lbm_value app_cont;
  lbm_value app_cont_prg;
  lbm_value new_prg;
  lbm_value prg_copy;

  int len = -1;
  WITH_GC(prg_copy, lbm_list_copy(&len, prg))(prg_copy) = (lbm_list_copy(&len, prg)); if (lbm_is_symbol_merror
((prg_copy))) { gc(); (prg_copy) = (lbm_list_copy(&len, prg
)); if (lbm_is_symbol_merror((prg_copy))) { error_ctx((((0x23
) << 4) | 0x00000000u)); } };
  lbm_stack_drop(&ctx->K, nargs+1);

  if (ctx->K.sp > nargs+2) { // if there is a continuation
    app_cont = cons_with_gc(ENC_SYM_APP_CONT(((0x111) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), prg_copy);
    app_cont_prg = cons_with_gc(app_cont, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), prg_copy);
    new_prg = lbm_list_append(app_cont_prg, ctx->program);
    new_prg = lbm_list_append(prg_copy, new_prg);
  } else {
    new_prg = lbm_list_append(prg_copy, ctx->program);
  }
  if (!lbm_is_list(new_prg)) {
    error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_EVAL_PROGRAM(((0x30009) << 4) | 0x00000000u));
  }
  stack_push(&ctx->K, DONE(((0) << 2) | 0xF8000001u));
  ctx->program = get_cdr(new_prg);
  ctx->curr_exp = get_car(new_prg);
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_EVAL_PROGRAM(((0x30009) << 4) | 0x00000000u));
}
2390}

2392static void apply_send(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2) {
  if (lbm_type_of(args[0]) == LBM_TYPE_I0x00000008u) {
    lbm_cid cid = (lbm_cid)lbm_dec_i(args[0]);
    lbm_value msg = args[1];
    lbm_value status = lbm_find_receiver_and_send(cid, msg);
    /* return the status */
    lbm_stack_drop(&ctx->K, nargs+1);
    ctx->r = status;
    ctx->app_cont = true1;
  } else {
    error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_SEND(((0x3000A) << 4) | 0x00000000u));
  }
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_SEND(((0x3000A) << 4) | 0x00000000u));
}
2409}

2411static void apply_ok(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
lbm_value ok_val = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
if (nargs >= 1) {
  ok_val = args[0];
}
ctx->r = ok_val;
ok_ctx();
2418}

2420static void apply_error(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value err_val = ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u);
if (nargs >= 1) {
  err_val = args[0];
}
error_at_ctx(err_val, ENC_SYM_EXIT_ERROR(((0x3000C) << 4) | 0x00000000u));
2427}

2429// (map f arg-list)
2430static void apply_map(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_cons(args[1])) {
  lbm_value *sptr = get_stack_ptr(ctx, 3);

  lbm_value f = args[0];
  lbm_value h = get_car(args[1]);
  lbm_value t = get_cdr(args[1]);

  lbm_value appli_1;
  lbm_value appli;
  WITH_GC(appli_1, lbm_heap_allocate_list(2))(appli_1) = (lbm_heap_allocate_list(2)); if (lbm_is_symbol_merror
((appli_1))) { gc(); (appli_1) = (lbm_heap_allocate_list(2));
 if (lbm_is_symbol_merror((appli_1))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
  WITH_GC_RMBR_1(appli, lbm_heap_allocate_list(2), appli_1)(appli) = (lbm_heap_allocate_list(2)); if (lbm_is_symbol_merror
((appli))) { lbm_gc_mark_phase(appli_1); gc(); (appli) = (lbm_heap_allocate_list
(2)); if (lbm_is_symbol_merror((appli))) { error_ctx((((0x23)
 << 4) | 0x00000000u)); } };

  lbm_value appli_0 = get_cdr(appli_1);

  lbm_set_car_and_cdr(appli_0, h, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_set_car(appli_1, ENC_SYM_QUOTE(((0x100) << 4) | 0x00000000u));

  lbm_set_car_and_cdr(get_cdr(appli), appli_1, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_set_car(appli, f);

  lbm_value elt = cons_with_gc(ctx->r, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), appli);
  stack_push_4(&ctx->K, elt, appli, appli_0, MAP(((26) << 2) | 0xF8000001u));
  sptr[0] = t;     // reuse stack space
  sptr[1] = ctx->curr_env;
  sptr[2] = elt;
  ctx->curr_exp = appli;
} else if (nargs == 2 && lbm_is_symbol_nil(args[1])) {
    lbm_stack_drop(&ctx->K, 3);
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    ctx->app_cont = true1;
    return;
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_MAP(((0x3000D) << 4) | 0x00000000u));
}
2466}

2468static void apply_reverse(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 1 && lbm_is_list(args[0])) {
  lbm_value curr = args[0];

  lbm_value new_list = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  while (lbm_is_cons(curr)) {
    lbm_value tmp = cons_with_gc(get_car(curr), new_list, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
    new_list = tmp;
    curr = get_cdr(curr);
  }
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = new_list;
  ctx->app_cont = true1;
} else {
  lbm_set_error_reason("Reverse requires a list argument");
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ENC_SYM_REVERSE(((0x3000E) << 4) | 0x00000000u));
}
2485}

2487static void apply_flatten(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 1) {

  lbm_value v = flatten_value(args[0]);
  if ( v == ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u)) {
    gc();
    v = flatten_value(args[0]);
  }

  if (lbm_is_symbol(v)) {
    error_at_ctx(v, ENC_SYM_FLATTEN(((0x3000F) << 4) | 0x00000000u));
  } else {
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = v;
    ctx->app_cont = true1;
  }
  return;
}
error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_FLATTEN(((0x3000F) << 4) | 0x00000000u));
2506}

2508static void apply_unflatten(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if(nargs == 1 && lbm_type_of(args[0]) == LBM_TYPE_ARRAY0x80000000u) {
  lbm_array_header_t *array;
  array = (lbm_array_header_t *)get_car(args[0]);

  lbm_flat_value_t fv;
  fv.buf = (uint8_t*)array->data;
  fv.buf_size = array->size;
  fv.buf_pos = 0;

  lbm_value res;

  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  if (lbm_unflatten_value(&fv, &res)) {
    ctx->r =  res;
  }
  lbm_stack_drop(&ctx->K, 2);
  ctx->app_cont = true1;
  return;
}
error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_UNFLATTEN(((0x30010) << 4) | 0x00000000u));
2529}

2531static void apply_kill(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_number(args[0])) {
  lbm_cid cid = lbm_dec_as_i32(args[0]);

  if (ctx->id == cid) {
    ctx->r = args[1];
    finish_ctx();
    return;
  }
  mutex_lock(&qmutex);
  eval_context_t *found = NULL((void*)0);
  found = lookup_ctx_nm(&blocked, cid);
  if (found)
    drop_ctx_nm(&blocked, found);
  else
    found = lookup_ctx_nm(&queue, cid);
  if (found)
    drop_ctx_nm(&queue, found);

  if (found) {
    found->K.data[found->K.sp - 1] = KILL(((40) << 2) | 0xF8000001u);
    found->r = args[1];
    found->app_cont = true1;
    enqueue_ctx_nm(&queue,found);
    ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  } else {
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }
  lbm_stack_drop(&ctx->K, 3);
  ctx->app_cont = true1;
  mutex_unlock(&qmutex);
  return;
}
error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_KILL(((0x30011) << 4) | 0x00000000u));
2565}

2567// (merge comparator list1 list2)
2568static void apply_merge(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 3 && lbm_is_list(args[1]) && lbm_is_list(args[2])) {

  if (!lbm_is_closure(args[0])) {
    lbm_value closure;
    WITH_GC(closure, lbm_heap_allocate_list(4))(closure) = (lbm_heap_allocate_list(4)); if (lbm_is_symbol_merror
((closure))) { gc(); (closure) = (lbm_heap_allocate_list(4));
 if (lbm_is_symbol_merror((closure))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
    lbm_set_car(closure, ENC_SYM_CLOSURE(((0x10F) << 4) | 0x00000000u));
    lbm_value cl1 = lbm_cdr(closure);
    lbm_value par;
    WITH_GC_RMBR_1(par, lbm_heap_allocate_list_init(2, symbol_x, symbol_y), closure)(par) = (lbm_heap_allocate_list_init(2, symbol_x, symbol_y));
 if (lbm_is_symbol_merror((par))) { lbm_gc_mark_phase(closure
); gc(); (par) = (lbm_heap_allocate_list_init(2, symbol_x, symbol_y
)); if (lbm_is_symbol_merror((par))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
    lbm_set_car(cl1, par);
    lbm_value cl2 = lbm_cdr(cl1);
    lbm_value body;
    WITH_GC_RMBR_1(body, lbm_heap_allocate_list_init(3, args[0], symbol_x, symbol_y), closure)(body) = (lbm_heap_allocate_list_init(3, args[0], symbol_x, symbol_y
)); if (lbm_is_symbol_merror((body))) { lbm_gc_mark_phase(closure
); gc(); (body) = (lbm_heap_allocate_list_init(3, args[0], symbol_x
, symbol_y)); if (lbm_is_symbol_merror((body))) { error_ctx((
((0x23) << 4) | 0x00000000u)); } };
    lbm_set_car(cl2, body);
    lbm_value cl3 = lbm_cdr(cl2);
    lbm_set_car(cl3, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));

    // Replace operator on stack with closure and rest of the code is
    // compatible.
    args[0] = closure;
  }

  // Copy input lists for functional behaviour at top-level
  // merge itself is in-place in the copied lists.
  lbm_value a;
  lbm_value b;
  int len_a = -1;
  int len_b = -1;
  WITH_GC(a, lbm_list_copy(&len_a, args[1]))(a) = (lbm_list_copy(&len_a, args[1])); if (lbm_is_symbol_merror
((a))) { gc(); (a) = (lbm_list_copy(&len_a, args[1])); if
 (lbm_is_symbol_merror((a))) { error_ctx((((0x23) << 4)
 | 0x00000000u)); } };
  WITH_GC_RMBR_1(b, lbm_list_copy(&len_b, args[2]), a)(b) = (lbm_list_copy(&len_b, args[2])); if (lbm_is_symbol_merror
((b))) { lbm_gc_mark_phase(a); gc(); (b) = (lbm_list_copy(&
len_b, args[2])); if (lbm_is_symbol_merror((b))) { error_ctx(
(((0x23) << 4) | 0x00000000u)); } };

  if (len_a == 0) {
    ctx->r = b;
    lbm_stack_drop(&ctx->K, 4);
    ctx->app_cont = true1;
    return;
  }
  if (len_b == 0) {
    ctx->r = a;
    lbm_stack_drop(&ctx->K, 4);
    ctx->app_cont = true1;
    return;
  }

  args[1] = a; // keep safe by replacing the original on stack.
  args[2] = b;

  lbm_value a_1 = a;
  lbm_value a_rest = lbm_cdr(a);
  lbm_value b_1 = b;
  lbm_value b_rest = lbm_cdr(b);

  lbm_value cl[3]; // Comparator closure
  extract_n(lbm_cdr(args[0]), cl, 3);
  lbm_value cmp_env = cl[CLO_ENV2];
  lbm_value par1 = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_value par2 = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_uint len = lbm_list_length(cl[CLO_PARAMS0]);
  if (len == 2) {
    par1 = get_car(cl[CLO_PARAMS0]);
    par2 = get_car(get_cdr(cl[CLO_PARAMS0]));
    lbm_value new_env0;
    lbm_value new_env;
    WITH_GC(new_env0, lbm_env_set(cmp_env, par1, lbm_car(a_1)))(new_env0) = (lbm_env_set(cmp_env, par1, lbm_car(a_1))); if (
lbm_is_symbol_merror((new_env0))) { gc(); (new_env0) = (lbm_env_set
(cmp_env, par1, lbm_car(a_1))); if (lbm_is_symbol_merror((new_env0
))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
    WITH_GC_RMBR_1(new_env, lbm_env_set(new_env0, par2, lbm_car(b_1)),new_env0)(new_env) = (lbm_env_set(new_env0, par2, lbm_car(b_1))); if (
lbm_is_symbol_merror((new_env))) { lbm_gc_mark_phase(new_env0
); gc(); (new_env) = (lbm_env_set(new_env0, par2, lbm_car(b_1
))); if (lbm_is_symbol_merror((new_env))) { error_ctx((((0x23
) << 4) | 0x00000000u)); } };
    cmp_env = new_env;
  } else {
    error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), args[0]);
  }
  lbm_set_cdr(a_1, b_1);
  lbm_set_cdr(b_1, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_value cmp = cl[CLO_BODY1];

  lbm_stack_drop(&ctx->K, 4); // TODO: Optimize drop 4 alloc 10 into alloc 6
  lbm_uint *sptr = stack_reserve(ctx, 10);
  sptr[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // head of merged list
  sptr[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // last of merged list
  sptr[2] = a_1;
  sptr[3] = a_rest;
  sptr[4] = b_rest;
  sptr[5] = cmp;
  sptr[6] = cmp_env;
  sptr[7] = par1;
  sptr[8] = par2;
  sptr[9] = MERGE_REST(((43) << 2) | 0xF8000001u);
  ctx->curr_exp = cl[CLO_BODY1];
  ctx->curr_env = cmp_env;
  return;
}
error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_MERGE(((0x30013) << 4) | 0x00000000u));
2659}

2661// (sort comparator list)
2662static void apply_sort(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_list(args[1])) {

  if (!lbm_is_closure(args[0])) {
    lbm_value closure;
    WITH_GC(closure, lbm_heap_allocate_list(4))(closure) = (lbm_heap_allocate_list(4)); if (lbm_is_symbol_merror
((closure))) { gc(); (closure) = (lbm_heap_allocate_list(4));
 if (lbm_is_symbol_merror((closure))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
    lbm_set_car(closure, ENC_SYM_CLOSURE(((0x10F) << 4) | 0x00000000u));
    lbm_value cl1 = lbm_cdr(closure);
    lbm_value par;
    WITH_GC_RMBR_1(par, lbm_heap_allocate_list_init(2, symbol_x, symbol_y), closure)(par) = (lbm_heap_allocate_list_init(2, symbol_x, symbol_y));
 if (lbm_is_symbol_merror((par))) { lbm_gc_mark_phase(closure
); gc(); (par) = (lbm_heap_allocate_list_init(2, symbol_x, symbol_y
)); if (lbm_is_symbol_merror((par))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
    lbm_set_car(cl1, par);
    lbm_value cl2 = lbm_cdr(cl1);
    lbm_value body;
    WITH_GC_RMBR_1(body, lbm_heap_allocate_list_init(3, args[0], symbol_x, symbol_y), closure)(body) = (lbm_heap_allocate_list_init(3, args[0], symbol_x, symbol_y
)); if (lbm_is_symbol_merror((body))) { lbm_gc_mark_phase(closure
); gc(); (body) = (lbm_heap_allocate_list_init(3, args[0], symbol_x
, symbol_y)); if (lbm_is_symbol_merror((body))) { error_ctx((
((0x23) << 4) | 0x00000000u)); } };
    lbm_set_car(cl2, body);
    lbm_value cl3 = lbm_cdr(cl2);
    lbm_set_car(cl3, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));

    // Replace operator on stack with closure and rest of the code is
    // compatible.
    args[0] = closure;
  }

  int len = -1;
  lbm_value list_copy;
  WITH_GC(list_copy, lbm_list_copy(&len, args[1]))(list_copy) = (lbm_list_copy(&len, args[1])); if (lbm_is_symbol_merror
((list_copy))) { gc(); (list_copy) = (lbm_list_copy(&len,
 args[1])); if (lbm_is_symbol_merror((list_copy))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } };
  if (len <= 1) {
    lbm_stack_drop(&ctx->K, 3);
    ctx->r = list_copy;
    ctx->app_cont = true1;
    return;
  }

  args[1] = list_copy; // Keep safe, original replaced on stack.

  // Take the headmost 2, 1-element sublists.
  lbm_value a = list_copy;
  lbm_value b = lbm_cdr(a);
  lbm_value rest = lbm_cdr(b);
  // Do not terminate b. keep rest of list safe from GC in the following
  // closure extraction.
  //lbm_set_cdr(a, b); // This is void

  lbm_value cl[3]; // Comparator closure
  extract_n(lbm_cdr(args[0]), cl, 3);
  lbm_value cmp_env = cl[CLO_ENV2];
  lbm_value par1 = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_value par2 = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  lbm_uint cl_len = lbm_list_length(cl[CLO_PARAMS0]);
  if (cl_len == 2) {
    par1 = get_car(cl[CLO_PARAMS0]);
    par2 = get_car(get_cdr(cl[CLO_PARAMS0]));
    lbm_value new_env0;
    lbm_value new_env;
    WITH_GC(new_env0, lbm_env_set(cmp_env, par1, lbm_car(a)))(new_env0) = (lbm_env_set(cmp_env, par1, lbm_car(a))); if (lbm_is_symbol_merror
((new_env0))) { gc(); (new_env0) = (lbm_env_set(cmp_env, par1
, lbm_car(a))); if (lbm_is_symbol_merror((new_env0))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } };
    WITH_GC_RMBR_1(new_env, lbm_env_set(new_env0, par2, lbm_car(b)), new_env0)(new_env) = (lbm_env_set(new_env0, par2, lbm_car(b))); if (lbm_is_symbol_merror
((new_env))) { lbm_gc_mark_phase(new_env0); gc(); (new_env) =
 (lbm_env_set(new_env0, par2, lbm_car(b))); if (lbm_is_symbol_merror
((new_env))) { error_ctx((((0x23) << 4) | 0x00000000u))
; } };
    cmp_env = new_env;
  } else {
    error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), args[0]);
  }
  lbm_value cmp = cl[CLO_BODY1];

  // Terminate the comparator argument list.
  lbm_set_cdr(b, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));

  lbm_stack_drop(&ctx->K, 3);  //TODO: optimize drop 3, alloc 20 into alloc 17
  lbm_uint *sptr = stack_reserve(ctx, 20);
  sptr[0] = cmp;
  sptr[1] = cmp_env;
  sptr[2] = par1;
  sptr[3] = par2;
  sptr[4] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // head of merged accumulation of sublists
  sptr[5] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // last of merged accumulation of sublists
  sptr[6] = rest;
  sptr[7] = lbm_enc_i(1);
  sptr[8] = lbm_enc_i(len); //TODO: 28 bit i vs 32 bit i
  sptr[9] = MERGE_LAYER(((44) << 2) | 0xF8000001u);
  sptr[10] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // head of merged sublist
  sptr[11] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // last of merged sublist
  sptr[12] = a;
  sptr[13] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // no a_rest, 1 element lists in layer 1.
  sptr[14] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // no b_rest, 1 element lists in layer 1.
  sptr[15] = cmp;
  sptr[16] = cmp_env;
  sptr[17] = par1;
  sptr[18] = par2;
  sptr[19] = MERGE_REST(((43) << 2) | 0xF8000001u);
  ctx->curr_exp = cmp;
  ctx->curr_env = cmp_env;
  return;
}
error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
2754}

2756static void apply_rest_args(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
lbm_value res;
if (lbm_env_lookup_b(&res, ENC_SYM_REST_ARGS(((0x30015) << 4) | 0x00000000u), ctx->curr_env)) {
  if (nargs == 1 && lbm_is_number(args[0])) {
    int32_t ix = lbm_dec_as_i32(args[0]);
    res = lbm_index_list(res, ix);
  }
  ctx->r = res;
} else {
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
}
lbm_stack_drop(&ctx->K, nargs+1);
ctx->app_cont = true1;
2769}

2771/***************************************************/
2772/* Application lookup table                        */

2774typedef void (*apply_fun)(lbm_value *, lbm_uint, eval_context_t *);
2775static const apply_fun fun_table[] =
{
 apply_setvar,
 apply_read,
 apply_read_program,
 apply_read_eval_program,
 apply_spawn,
 apply_spawn_trap,
 apply_yield,
 apply_wait,
 apply_eval,
 apply_eval_program,
 apply_send,
 apply_ok,
 apply_error,
 apply_map,
 apply_reverse,
 apply_flatten,
 apply_unflatten,
 apply_kill,
 apply_sleep,
 apply_merge,
 apply_sort,
 apply_rest_args,
};

2801/***************************************************/
2802/* Application of function that takes arguments    */
2803/* passed over the stack.                          */

2805static void application(eval_context_t *ctx, lbm_value *fun_args, lbm_uint arg_count) {
/* If arriving here, we know that the fun is a symbol.
 *  and can be a built in operation or an extension.
 */
lbm_value fun = fun_args[0];

lbm_uint fun_val = lbm_dec_sym(fun);
lbm_uint fun_kind = SYMBOL_KIND(fun_val)((fun_val) >> 16);

switch (fun_kind) {
case SYMBOL_KIND_EXTENSION1: {
  extension_fptr f = extension_table[SYMBOL_IX(fun_val)((fun_val) & 0xFFFF)].fptr;

  lbm_value ext_res;
  WITH_GC(ext_res, f(&fun_args[1], arg_count))(ext_res) = (f(&fun_args[1], arg_count)); if (lbm_is_symbol_merror
((ext_res))) { gc(); (ext_res) = (f(&fun_args[1], arg_count
)); if (lbm_is_symbol_merror((ext_res))) { error_ctx((((0x23)
 << 4) | 0x00000000u)); } };
  if (lbm_is_error(ext_res)) { //Error other than merror
    error_at_ctx(ext_res, fun);
  }
  lbm_stack_drop(&ctx->K, arg_count + 1);

  if (blocking_extension) {
    blocking_extension = false0;
    if (blocking_extension_timeout) {
      blocking_extension_timeout = false0;
      block_current_ctx(LBM_THREAD_STATE_TIMEOUT(uint32_t)2, blocking_extension_timeout_us,true1);
    } else {
      block_current_ctx(LBM_THREAD_STATE_BLOCKED(uint32_t)1, 0,true1);
    }
    mutex_unlock(&blocking_extension_mutex);
  } else {
    ctx->app_cont = true1;
    ctx->r = ext_res;
  }
}  break;
case SYMBOL_KIND_FUNDAMENTAL2:
  call_fundamental(SYMBOL_IX(fun_val)((fun_val) & 0xFFFF), &fun_args[1], arg_count, ctx);
  break;
case SYMBOL_KIND_APPFUN3:
  fun_table[SYMBOL_IX(fun_val)((fun_val) & 0xFFFF)](&fun_args[1], arg_count, ctx);
  break;
default:
  // Symbols that are "special" but not in the way caught above
  // ends up here.
  lbm_set_error_reason("Symbol does not represent a function");
  error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u),fun_args[0]);
  break;
}
2852}

2854static void cont_closure_application_args(eval_context_t *ctx) {
lbm_uint* sptr = get_stack_ptr(ctx, 5);

lbm_value arg_env = (lbm_value)sptr[0];
lbm_value exp     = (lbm_value)sptr[1];
lbm_value clo_env = (lbm_value)sptr[2];
lbm_value params  = (lbm_value)sptr[3];
lbm_value args    = (lbm_value)sptr[4];

lbm_value car_params, cdr_params;
get_car_and_cdr(params, &car_params, &cdr_params);

bool_Bool a_nil = args == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
bool_Bool p_nil = cdr_params == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);

lbm_value binder = allocate_binding(car_params, ctx->r, clo_env);

if (!a_nil && !p_nil) {
  lbm_value car_args, cdr_args;
  get_car_and_cdr(args, &car_args, &cdr_args);
  sptr[2] = binder;
  sptr[3] = cdr_params;
  sptr[4] = cdr_args;
  stack_push(&ctx->K, CLOSURE_ARGS(((13) << 2) | 0xF8000001u));
  ctx->curr_exp = car_args;
  ctx->curr_env = arg_env;
} else if (p_nil && !a_nil) {
  lbm_value rest_binder = allocate_binding(ENC_SYM_REST_ARGS(((0x30015) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), binder);
  sptr[2] = rest_binder;
  sptr[3] = get_cdr(args);
  sptr[4] = get_car(rest_binder); // last element of rest_args so far
  stack_push(&ctx->K, CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u));
  ctx->curr_exp = get_car(args);
  ctx->curr_env = arg_env;
} else if (a_nil && p_nil) {
  // Arguments and parameters match up in number
  lbm_stack_drop(&ctx->K, 5);
  ctx->curr_env = binder;
  ctx->curr_exp = exp;
} else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
2897}


2900static void cont_closure_args_rest(eval_context_t *ctx) {
lbm_uint* sptr = get_stack_ptr(ctx, 5);
lbm_value arg_env = (lbm_value)sptr[0];
lbm_value exp     = (lbm_value)sptr[1];
lbm_value clo_env = (lbm_value)sptr[2];
lbm_value args    = (lbm_value)sptr[3];
lbm_value last    = (lbm_value)sptr[4];
lbm_cons_t* heap = lbm_heap_state.heap;

lbm_value binding = lbm_heap_state.freelist;
if (binding == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  gc();
  binding = lbm_heap_state.freelist;
  if (binding == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
}
lbm_uint binding_ix = lbm_dec_ptr(binding);
lbm_heap_state.freelist = heap[binding_ix].cdr;
lbm_heap_state.num_alloc += 1;
heap[binding_ix].car = ctx->r;
heap[binding_ix].cdr = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);


lbm_set_cdr(last, binding);
sptr[4] = binding;

if (args == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  lbm_stack_drop(&ctx->K, 5);
  ctx->curr_env = clo_env;
  ctx->curr_exp = exp;
} else {
  stack_push(&ctx->K, CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u));
  sptr[3] = get_cdr(args);
  ctx->curr_exp = get_car(args);
  ctx->curr_env = arg_env;
}
2935}

2937static void cont_application_args(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 3);

lbm_value env = sptr[0];
lbm_value rest = sptr[1];
lbm_value count = sptr[2];

ctx->curr_env = env;
sptr[0] = ctx->r; // Function 1st then Arguments
if (lbm_is_cons(rest)) {
  lbm_cons_t *cell = lbm_ref_cell(rest);
  sptr[1] = env;
  sptr[2] = cell->cdr;
  stack_push_2(&ctx->K, count + (1 << LBM_VAL_SHIFT4), APPLICATION_ARGS(((5) << 2) | 0xF8000001u));
  ctx->curr_exp = cell->car;
} else {
  // No more arguments
  lbm_stack_drop(&ctx->K, 2);
  lbm_uint nargs = lbm_dec_u(count);
  lbm_value *args = get_stack_ptr(ctx, (uint32_t)(nargs + 1));
  application(ctx,args, nargs);
}
2959}

2961static void cont_and(eval_context_t *ctx) {
lbm_value env;
lbm_value rest;
lbm_value arg = ctx->r;
lbm_pop_2(&ctx->K, &rest, &env);
if (lbm_is_symbol_nil(arg)) {
  ctx->app_cont = true1;
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else if (lbm_is_symbol_nil(rest)) {
  ctx->app_cont = true1;
} else {
  stack_push_3(&ctx->K, env, get_cdr(rest), AND(((6) << 2) | 0xF8000001u));
  ctx->curr_env = env;
  ctx->curr_exp = get_car(rest);
}
2976}

2978static void cont_or(eval_context_t *ctx) {
lbm_value env;
lbm_value rest;
lbm_value arg = ctx->r;
lbm_pop_2(&ctx->K, &rest, &env);
if (!lbm_is_symbol_nil(arg)) {
  ctx->app_cont = true1;
} else if (lbm_is_symbol_nil(rest)) {
  ctx->app_cont = true1;
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
} else {
  stack_push_3(&ctx->K, env, get_cdr(rest), OR(((7) << 2) | 0xF8000001u));
  ctx->curr_exp = get_car(rest);
  ctx->curr_env = env;
}
2993}

2995static int fill_binding_location(lbm_value key, lbm_value value, lbm_value env) {
if (lbm_type_of(key) == LBM_TYPE_SYMBOL0x00000000u) {
  if (key == ENC_SYM_DONTCARE(((0x9) << 4) | 0x00000000u)) return FB_OK0;
  lbm_env_modify_binding(env,key,value);
  return FB_OK0;
} else if (lbm_is_cons(key) &&
           lbm_is_cons(value)) {
  int r = fill_binding_location(get_car(key), get_car(value), env);
  if (r == FB_OK0) {
    r = fill_binding_location(get_cdr(key), get_cdr(value), env);
  }
  return r;
}
return FB_TYPE_ERROR-1;
3009}

3011static void cont_bind_to_key_rest(eval_context_t *ctx) {

lbm_value *sptr = get_stack_ptr(ctx, 4);

lbm_value rest = sptr[1];
lbm_value env  = sptr[2];
lbm_value key  = sptr[3];

if (fill_binding_location(key, ctx->r, env) < 0) {
  lbm_set_error_reason("Incorrect type of name/key in let-binding");
  error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), key);
}

if (lbm_is_cons(rest)) {
  lbm_value keyn = get_caar(rest);
  lbm_value valn_exp = get_cadr(get_car(rest));

  sptr[1] = get_cdr(rest);
  sptr[3] = keyn;
  stack_push(&ctx->K, BIND_TO_KEY_REST(((2) << 2) | 0xF8000001u));
  ctx->curr_exp = valn_exp;
  ctx->curr_env = env;
} else {
  // Otherwise evaluate the expression in the populated env
  ctx->curr_exp = sptr[0];
  ctx->curr_env = env;
  lbm_stack_drop(&ctx->K, 4);
}
3039}

3041static void cont_if(eval_context_t *ctx) {

lbm_value arg = ctx->r;

lbm_value *sptr = pop_stack_ptr(ctx, 3);

ctx->curr_env = sptr[2];
if (lbm_is_symbol_nil(arg)) {
  ctx->curr_exp = sptr[0]; // else branch
} else {
  ctx->curr_exp = sptr[1]; // then branch
}
3053}

3055static void cont_match(eval_context_t *ctx) {
lbm_value e = ctx->r;
bool_Bool  do_gc = false0;

lbm_uint *sptr = get_stack_ptr(ctx, 2);
lbm_value patterns = (lbm_value)sptr[0];
lbm_value orig_env = (lbm_value)sptr[1]; // restore enclosing environment.
lbm_value new_env = orig_env;

if (lbm_is_symbol_nil(patterns)) {
  // no more patterns
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = ENC_SYM_NO_MATCH(((0x40) << 4) | 0x00000000u);
  ctx->app_cont = true1;
} else if (lbm_is_cons(patterns)) {
  lbm_value match_case = get_car(patterns);
  lbm_value pattern = get_car(match_case);
  lbm_value n1      = get_cadr(match_case);
  lbm_value n2      = get_cadr(get_cdr(match_case));
  lbm_value body;
  bool_Bool check_guard = false0;
  if (lbm_is_symbol_nil(n2)) { // TODO: Not a very robust check.
    body = n1;
  } else {
    body = n2;
    check_guard = true1;
  }

  bool_Bool is_match = match(pattern, e, &new_env, &do_gc);
  if (do_gc) {
    gc();
    do_gc = false0;
    new_env = orig_env;
    is_match = match(pattern, e, &new_env, &do_gc);
    if (do_gc) {
      error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
    }
  }
  if (is_match) {
    if (check_guard) {
      lbm_value *rptr = stack_reserve(ctx,5);
      sptr[0] = get_cdr(patterns);
      sptr[1] = ctx->curr_env;
      rptr[0] = MATCH(((9) << 2) | 0xF8000001u);
      rptr[1] = new_env;
      rptr[2] = body;
      rptr[3] = e;
      rptr[4] = MATCH_GUARD(((27) << 2) | 0xF8000001u);
      ctx->curr_env = new_env;
      ctx->curr_exp = n1; // The guard
    } else {
      lbm_stack_drop(&ctx->K, 2);
      ctx->curr_env = new_env;
      ctx->curr_exp = body;
    }
  } else {
    // set up for checking of next pattern
    sptr[0] = get_cdr(patterns);
    sptr[1] = orig_env;
    stack_push(&ctx->K, MATCH(((9) << 2) | 0xF8000001u));
    // leave r unaltered
    ctx->app_cont = true1;
  }
} else {
  error_at_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u), ENC_SYM_MATCH(((0x108) << 4) | 0x00000000u));
}
3121}

3123static void cont_exit_atomic(eval_context_t *ctx) {
is_atomic --;
ctx->app_cont = true1;
3126}

3128static void cont_map(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 6);

lbm_value ls  = sptr[0];
lbm_value env = sptr[1];
lbm_value t   = sptr[3];
lbm_set_car(t, ctx->r); // update car field tailmost position.
if (lbm_is_cons(ls)) {
  lbm_value next, rest;
  get_car_and_cdr(ls, &next, &rest);
  sptr[0] = rest;
  stack_push(&ctx->K, MAP(((26) << 2) | 0xF8000001u));
  lbm_set_car(sptr[5], next); // new arguments

  lbm_value elt = cons_with_gc(ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_set_cdr(t, elt);
  sptr[3] = elt;  // (r1 ... rN . (nil . nil))
  ctx->curr_exp = sptr[4];
  ctx->curr_env = env;
} else {
  ctx->r = sptr[2]; //head of result list
  ctx->curr_env = env;
  lbm_stack_drop(&ctx->K, 6);
  ctx->app_cont = true1;
}
3153}

3155static void cont_match_guard(eval_context_t *ctx) {
if (lbm_is_symbol_nil(ctx->r)) {
  lbm_value e;
  lbm_pop(&ctx->K, &e);
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = e;
  ctx->app_cont = true1;
} else {
  lbm_value body;
  lbm_value env;
  lbm_stack_drop(&ctx->K, 1);
  lbm_pop_2(&ctx->K, &body, &env);
  lbm_stack_drop(&ctx->K, 3);
  ctx->curr_env = env;
  ctx->curr_exp = body;
}
3171}

3173static void cont_terminate(eval_context_t *ctx) {
error_ctx(ctx->r);
3175}

3177static void cont_loop(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 2);
stack_push(&ctx->K, LOOP_CONDITION(((42) << 2) | 0xF8000001u));
ctx->curr_exp = sptr[1];
3181}

3183static void cont_loop_condition(eval_context_t *ctx) {
if (lbm_is_symbol_nil(ctx->r)) {
  lbm_stack_drop(&ctx->K, 2);
  ctx->app_cont = true1;  // A loop returns nil? Makes sense to me... but in general?
  return;
}
lbm_value *sptr = get_stack_ptr(ctx, 2);
stack_push(&ctx->K, LOOP(((41) << 2) | 0xF8000001u));
ctx->curr_exp = sptr[0];
3192}

3194static void cont_merge_rest(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 9);

// If comparator returns true (result is in ctx->r):
//   "a" should be moved to the last element position in merged list.
//   A new element from "a_rest" should be moved into comparator argument 1 pos.
// else
//   "b" should be moved to last element position in merged list.
//   A new element from "b_rest" should be moved into comparator argument 2 pos.
//
// If a_rest or b_rest is NIL:
//   we are done, the remaining elements of
//   non_nil list should be appended to merged list.
// else
//   Set up for a new comparator evaluation and recurse.
lbm_value a = sptr[2];
lbm_value b = lbm_cdr(a);
lbm_set_cdr(a, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)); // terminate 1 element list

if (ctx->r == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) { // Comparison false

  if (sptr[0] == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
    sptr[0] = b;
    sptr[1] = b;
  } else {
    lbm_set_cdr(sptr[1], b);
    sptr[1] = b;
  }
  if (sptr[4] == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
    lbm_set_cdr(a, sptr[3]);
    lbm_set_cdr(sptr[1], a);
    ctx->r = sptr[0];
    lbm_stack_drop(&ctx->K, 9);
    ctx->app_cont = true1;
    return;
  } else {
    b = sptr[4];
    sptr[4] = lbm_cdr(sptr[4]);
    lbm_set_cdr(b, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  }
} else {
  if (sptr[0] == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
    sptr[0] = a;
    sptr[1] = a;
  } else {
    lbm_set_cdr(sptr[1], a);
    sptr[1] = a;
  }

  if (sptr[3] == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
    lbm_set_cdr(b, sptr[4]);
    lbm_set_cdr(sptr[1], b);
    ctx->r = sptr[0];
    lbm_stack_drop(&ctx->K, 9);
    ctx->app_cont = true1;
    return;
  } else {
    a = sptr[3];
    sptr[3] = lbm_cdr(sptr[3]);
    lbm_set_cdr(a, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  }
}
lbm_set_cdr(a, b);
sptr[2] = a;

lbm_value par1 = sptr[7];
lbm_value par2 = sptr[8];
lbm_value cmp_body = sptr[5];
lbm_value cmp_env = sptr[6];
// Environment should be preallocated already at this point
// and the operations below should never need GC.
lbm_value new_env0 = lbm_env_set(cmp_env, par1, lbm_car(a));
lbm_value new_env = lbm_env_set(new_env0, par2, lbm_car(b));
if (lbm_is_symbol(new_env0) || lbm_is_symbol(new_env)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}
cmp_env = new_env;

stack_push(&ctx->K, MERGE_REST(((43) << 2) | 0xF8000001u));
ctx->curr_exp = cmp_body;
ctx->curr_env = cmp_env;
3275}

3277// merge_layer stack contents
3278// s[sp-9] = cmp
3279// s[sp-8] = cmp_env
3280// s[sp-7] = par1
3281// s[sp-6] = par2
3282// s[sp-5] = acc - first cell
3283// s[sp-4] = acc - last cell
3284// s[sp-3] = rest;
3285// s[sp-2] = layer
3286// s[sp-1] = length or original list
3287//
3288// ctx->r merged sublist
3289static void cont_merge_layer(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 9);
int layer = lbm_dec_i(sptr[7]);
int len   = lbm_dec_i(sptr[8]);

lbm_value r_curr = ctx->r;
while (lbm_is_cons(r_curr)) {
  lbm_value next = lbm_cdr(r_curr);
  if (next == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
    break;
  }
  r_curr = next;
}

if (sptr[4] == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  sptr[4] = ctx->r;
  sptr[5] = r_curr;
} else {
  lbm_set_cdr(sptr[5], ctx->r); // accumulate merged sublists.
  sptr[5] = r_curr;
}

lbm_value layer_rest = sptr[6];
// switch layer or done ?
if (layer_rest == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  if (layer * 2 >= len) {
    ctx->r = sptr[4];
    ctx->app_cont = true1;
    lbm_stack_drop(&ctx->K, 9);
    return;
  } else {
    // Setup for merges of the next layer
    layer = layer * 2;
    sptr[7] = lbm_enc_i(layer);
    layer_rest = sptr[4]; // continue on the accumulation of all sublists.
    sptr[5] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    sptr[4] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }
}
// merge another sublist based on current layer.
lbm_value a_list = layer_rest;
// build sublist a
lbm_value curr = layer_rest;
for (int i = 0; i < layer-1; i ++) {
  if (lbm_is_cons(curr)) {
    curr = lbm_cdr(curr);
  } else {
    break;
  }
}
layer_rest = lbm_cdr(curr);
lbm_set_cdr(curr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)); //terminate sublist.

lbm_value b_list = layer_rest;
// build sublist b
curr = layer_rest;
for (int i = 0; i < layer-1; i ++) {
  if (lbm_is_cons(curr)) {
    curr = lbm_cdr(curr);
  } else {
    break;
  }
}
layer_rest = lbm_cdr(curr);
lbm_set_cdr(curr, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)); //terminate sublist.

sptr[6] = layer_rest;

if (b_list == ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)) {
  stack_push(&ctx->K, MERGE_LAYER(((44) << 2) | 0xF8000001u));
  ctx->r = a_list;
  ctx->app_cont = true1;
  return;
}
// Set up for a merge of sublists.

lbm_value a_rest = lbm_cdr(a_list);
lbm_value b_rest = lbm_cdr(b_list);
lbm_value a = a_list;
lbm_value b = b_list;
lbm_set_cdr(a, b);
// Terminating the b list would be incorrect here
// if there was any chance that the environment update below
// performs GC.
lbm_set_cdr(b, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));

lbm_value cmp_body = sptr[0];
lbm_value cmp_env = sptr[1];
lbm_value par1 = sptr[2];
lbm_value par2 = sptr[3];
// Environment should be preallocated already at this point
// and the operations below should never need GC.
lbm_value new_env0 = lbm_env_set(cmp_env, par1, lbm_car(a));
lbm_value new_env = lbm_env_set(cmp_env, par2, lbm_car(b));
if (lbm_is_symbol(new_env0) || lbm_is_symbol(new_env)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}
cmp_env = new_env;

lbm_uint *merge_cont = stack_reserve(ctx, 11);
merge_cont[0] = MERGE_LAYER(((44) << 2) | 0xF8000001u);
merge_cont[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
merge_cont[2] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
merge_cont[3] = a;
merge_cont[4] = a_rest;
merge_cont[5] = b_rest;
merge_cont[6] = cmp_body;
merge_cont[7] = cmp_env;
merge_cont[8] = par1;
merge_cont[9] = par2;
merge_cont[10] = MERGE_REST(((43) << 2) | 0xF8000001u);
ctx->curr_exp = cmp_body;
ctx->curr_env = cmp_env;
return;
3403}

3405/****************************************************/
3406/*   READER                                         */

3408static void read_finish(lbm_char_channel_t *str, eval_context_t *ctx) {

/* Tokenizer reached "end of file"
   The parser could be in a state where it needs
   more tokens to correctly finish an expression.

   Three cases
   1. The program / expression is malformed and the context should die.
   2. We are finished reading a program and should close off the
   internal representation with a closing parenthesis. Then
   apply continuation.
   3. We are finished reading an expression and should
   apply the continuation.

   In case 3, we should find the READ_DONE at sp - 1.
   In case 2, we should find the READ_DONE at sp - 5.

*/

if (lbm_is_symbol(ctx->r)) {
  lbm_uint sym_val = lbm_dec_sym(ctx->r);
  if (sym_val >= TOKENIZER_SYMBOLS_START0x70 &&
      sym_val <= TOKENIZER_SYMBOLS_END0x85) {
    read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
  }
}

if (ctx->K.data[ctx->K.sp-1] == READ_DONE(((20) << 2) | 0xF8000001u) &&
    lbm_dec_u(ctx->K.data[ctx->K.sp-3]) == 0) {
  /* successfully finished reading an expression  (CASE 3) */
  ctx->app_cont = true1;
} else if (ctx->K.sp > 4  && ctx->K.data[ctx->K.sp - 4] == READ_DONE(((20) << 2) | 0xF8000001u)) {
  lbm_value env;
  lbm_value s;
  lbm_value sym;
  lbm_pop_3(&ctx->K, &sym, &env, &s);
  ctx->curr_env = env;
  ctx->app_cont = true1; // Program evaluated and result is in ctx->r.
} else if (ctx->K.sp > 5 && ctx->K.data[ctx->K.sp - 5] == READ_DONE(((20) << 2) | 0xF8000001u)) {
  /* successfully finished reading a program  (CASE 2) */
  ctx->r = ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u);
  ctx->app_cont = true1;
} else {
  /* Parsing failed */
  if (lbm_channel_row(str) == 1 &&
      lbm_channel_column(str) == 1 ){
    // eof at empty stream.
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    ctx->app_cont = true1;
  } else {
    lbm_set_error_reason((char*)lbm_error_str_parse_eof);
    read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
  }
  lbm_channel_reader_close(str);
}
3463}

3465/* cont_read_next_token
 sp-2 : Stream
 sp-1 : Grab row
3468*/
3469static void cont_read_next_token(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 2);
lbm_value stream = sptr[0];
lbm_value grab_row0 = sptr[1];

lbm_char_channel_t *chan = lbm_dec_channel(stream);
if (chan == NULL((void*)0) || chan->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

if (!lbm_channel_more(chan) && lbm_channel_is_empty(chan)) {
  lbm_stack_drop(&ctx->K, 2);
  read_finish(chan, ctx);
  return;
}
/* Eat whitespace and comments */
if (!tok_clean_whitespace(chan)) {
  sptr[0] = stream;
  sptr[1] = lbm_enc_u(0);
  stack_push(&ctx->K, READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
  yield_ctx(EVAL_CPS_MIN_SLEEP200);
  return;
}
/* After eating whitespace we may be at end of file/stream */
if (!lbm_channel_more(chan) && lbm_channel_is_empty(chan)) {
  lbm_stack_drop(&ctx->K, 2);
  read_finish(chan, ctx);
  return;
}

if (lbm_dec_u(grab_row0)) {
  ctx->row0 = (int32_t)lbm_channel_row(chan);
}

/* Attempt to extract tokens from the character stream */
int n = 0;
lbm_value res = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
unsigned int string_len = 0;

/*
 * SYNTAX
 */
uint32_t match;
n = tok_syntax(chan, &match);
if (n > 0) {
  if (!lbm_channel_drop(chan, (unsigned int)n)) {
    error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
  }
  ctx->app_cont = true1;
  lbm_uint do_next = 0;
  switch(match) {
  case TOKOPENPAR1u:
    sptr[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    sptr[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    stack_push_2(&ctx->K,
                 stream,
                 READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u));
    stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->r = ENC_SYM_OPENPAR(((0x70) << 4) | 0x00000000u);
    return;
  case TOKCLOSEPAR2u: {
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u);
  } return;
  case TOKOPENBRACK3u:
    sptr[0] = stream;
    sptr[1] = READ_START_ARRAY(((24) << 2) | 0xF8000001u);
    //stack_push_2(&ctx->K, stream, READ_START_ARRAY);
    stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->r = ENC_SYM_OPENBRACK(((0x80) << 4) | 0x00000000u);
    return;
  case TOKCLOSEBRACK4u:
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_CLOSEBRACK(((0x81) << 4) | 0x00000000u);
    return;
  case TOKDOT5u:
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_DOT(((0x76) << 4) | 0x00000000u);
    return;
  case TOKDONTCARE6u:
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_DONTCARE(((0x9) << 4) | 0x00000000u);
    return;
  case TOKQUOTE7u:
    do_next = READ_QUOTE_RESULT(((21) << 2) | 0xF8000001u);
    break;
  case TOKBACKQUOTE8u:
    sptr[0] = QQ_EXPAND_START(((35) << 2) | 0xF8000001u);
    sptr[1] = stream;
    stack_push_2(&ctx->K, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  case TOKCOMMAAT9u:
    do_next = READ_COMMAAT_RESULT(((22) << 2) | 0xF8000001u);
    break;
  case TOKCOMMA10u:
    do_next = READ_COMMA_RESULT(((23) << 2) | 0xF8000001u);
    break;
  case TOKMATCHANY11u:
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_MATCH_ANY(((0x41) << 4) | 0x00000000u);
    return;
  case TOKOPENCURL12u:
    sptr[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    sptr[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    stack_push_2(&ctx->K,
                 stream,
                 READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u));
    ctx->r = ENC_SYM_PROGN(((0x102) << 4) | 0x00000000u);
    return;
  case TOKCLOSECURL13u:
    lbm_stack_drop(&ctx->K, 2);
    ctx->r = ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u);
    return;
  case TOKCONSTSTART14u:
    ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x2;
    sptr[0] = stream;
    sptr[1] = lbm_enc_u(0);
    stack_push(&ctx->K, READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  case TOKCONSTEND15u:
    ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x2;
    sptr[0] = stream;
    sptr[1] = lbm_enc_u(0);
    stack_push(&ctx->K, READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  case TOKCONSTSYMSTR16u:
    ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS(uint32_t)0x4;
    sptr[0] = stream;
    sptr[1] = lbm_enc_u(0);
    stack_push(&ctx->K, READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  default:
    read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
  }
  sptr[0] = do_next;
  sptr[1] = stream;
  stack_push_2(&ctx->K, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
  ctx->app_cont = true1;
  return;
} else if (n < 0) goto retry_token;

/*
 *  STRING
 */
n = tok_string(chan, &string_len);
if (n >= 2) {
  lbm_channel_drop(chan, (unsigned int)n);
  if (!lbm_heap_allocate_array(&res, (unsigned int)(string_len+1))) {
    gc();
    if (!lbm_heap_allocate_array(&res, (unsigned int)(string_len+1))) {
      error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
    }
  }
  lbm_array_header_t *arr = (lbm_array_header_t*)get_car(res);
  char *data = (char*)arr->data;
  memset(data,0, string_len + 1);
  memcpy(data, tokpar_sym_str, string_len);
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = res;
  ctx->app_cont = true1;
  return;
} else if (n < 0) goto retry_token;

/*
 * FLOAT
 */
token_float f_val;
n = tok_double(chan, &f_val);
if (n > 0) {
  lbm_channel_drop(chan, (unsigned int) n);
  switch(f_val.type) {
  case TOKTYPEF32107u:
    WITH_GC(res, lbm_enc_float((float)f_val.value))(res) = (lbm_enc_float((float)f_val.value)); if (lbm_is_symbol_merror
((res))) { gc(); (res) = (lbm_enc_float((float)f_val.value));
 if (lbm_is_symbol_merror((res))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
    break;
  case TOKTYPEF64108u:
    res = lbm_enc_double(f_val.value);
    break;
  default:
    read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
  }
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = res;
  ctx->app_cont = true1;
  return;
} else if (n < 0) goto retry_token;

/*
 * INTEGER
 */
token_int int_result;
n = tok_integer(chan, &int_result);
if (n > 0) {
  lbm_channel_drop(chan, (unsigned int)n);
  switch(int_result.type) {
  case TOKTYPEBYTE100u:
    res = lbm_enc_char((uint8_t)(int_result.negative ? -int_result.value : int_result.value));
    break;
  case TOKTYPEI101u:
    res = lbm_enc_i((lbm_int)(int_result.negative ? -int_result.value : int_result.value));
    break;
  case TOKTYPEU102u:
    res = lbm_enc_u((lbm_uint)(int_result.negative ? -int_result.value : int_result.value));
    break;
  case TOKTYPEI32103u:
    WITH_GC(res, lbm_enc_i32((int32_t)(int_result.negative ? -int_result.value : int_result.value)))(res) = (lbm_enc_i32((int32_t)(int_result.negative ? -int_result
.value : int_result.value))); if (lbm_is_symbol_merror((res))
) { gc(); (res) = (lbm_enc_i32((int32_t)(int_result.negative ?
 -int_result.value : int_result.value))); if (lbm_is_symbol_merror
((res))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
    break;
  case TOKTYPEU32104u:
    WITH_GC(res,lbm_enc_u32((uint32_t)(int_result.negative ? -int_result.value : int_result.value)))(res) = (lbm_enc_u32((uint32_t)(int_result.negative ? -int_result
.value : int_result.value))); if (lbm_is_symbol_merror((res))
) { gc(); (res) = (lbm_enc_u32((uint32_t)(int_result.negative
 ? -int_result.value : int_result.value))); if (lbm_is_symbol_merror
((res))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
    break;
  case TOKTYPEI64105u:
    WITH_GC(res,lbm_enc_i64((int64_t)(int_result.negative ? -int_result.value : int_result.value)))(res) = (lbm_enc_i64((int64_t)(int_result.negative ? -int_result
.value : int_result.value))); if (lbm_is_symbol_merror((res))
) { gc(); (res) = (lbm_enc_i64((int64_t)(int_result.negative ?
 -int_result.value : int_result.value))); if (lbm_is_symbol_merror
((res))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
    break;
  case TOKTYPEU64106u:
    WITH_GC(res,lbm_enc_u64((uint64_t)(int_result.negative ? -int_result.value : int_result.value)))(res) = (lbm_enc_u64((uint64_t)(int_result.negative ? -int_result
.value : int_result.value))); if (lbm_is_symbol_merror((res))
) { gc(); (res) = (lbm_enc_u64((uint64_t)(int_result.negative
 ? -int_result.value : int_result.value))); if (lbm_is_symbol_merror
((res))) { error_ctx((((0x23) << 4) | 0x00000000u)); } };
    break;
  default:
    read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
  }
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = res;
  ctx->app_cont = true1;
  return;
} else if (n < 0) goto retry_token;

/*
 * SYMBOL
 */
n = tok_symbol(chan);
if (n > 0) {
  lbm_channel_drop(chan, (unsigned int) n);
  lbm_uint symbol_id;

  if (lbm_get_symbol_by_name(tokpar_sym_str, &symbol_id)) {
    res = lbm_enc_sym(symbol_id);
  } else {
    int r = 0;
    if (strncmp(tokpar_sym_str,"ext-",4) == 0) {
      lbm_uint ext_id;
      lbm_uint ext_name_len = strlen(tokpar_sym_str)+1;
      char *ext_name = lbm_malloc(ext_name_len);
      if (!ext_name) {
        gc();
        ext_name = lbm_malloc(ext_name_len);
      }
      if (ext_name) {
        memcpy(ext_name, tokpar_sym_str, ext_name_len);
        r = lbm_add_extension(ext_name, lbm_extensions_default);
        if (!lbm_lookup_extension_id(ext_name, &ext_id)) {
          error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
        }
        symbol_id = ext_id;
      } else {
        error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
      }
    } else {
      if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS(uint32_t)0x4 &&
          ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x8) {
        r = lbm_add_symbol_flash(tokpar_sym_str, &symbol_id);
      } else {
        r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
        if (!r) {
          gc();
          r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
        }
      }
    }
    if (r) {
      res = lbm_enc_sym(symbol_id);
    } else {
      read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
    }
  }
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = res;
  ctx->app_cont = true1;
  return;
} else if (n == TOKENIZER_NEED_MORE-1) {
  goto retry_token;
} else if (n <= TOKENIZER_STRING_ERROR-2) {
  read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
}

/*
 * CHAR
 */
char c_val;
n = tok_char(chan, &c_val);
if(n > 0) {
  lbm_channel_drop(chan,(unsigned int) n);
  lbm_stack_drop(&ctx->K, 2);
  ctx->r = lbm_enc_char((uint8_t)c_val);
  ctx->app_cont = true1;
  return;
}else if (n < 0) goto retry_token;

read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));

retry_token:
if (n == TOKENIZER_NEED_MORE-1) {
  sptr[0] = stream;
  sptr[1] = lbm_enc_u(0);
  stack_push(&ctx->K, READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
  yield_ctx(EVAL_CPS_MIN_SLEEP200);
  return;
}
read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
3779}

3781static void cont_read_start_array(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 1);
lbm_value stream = sptr[0];

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

lbm_uint num_free = lbm_memory_longest_free();
lbm_uint initial_size = (lbm_uint)((float)num_free * 0.9);
if (initial_size == 0) {
  gc();
  num_free = lbm_memory_longest_free();
  initial_size = (lbm_uint)((float)num_free * 0.9);
  if (initial_size == 0) {
    lbm_channel_reader_close(str);
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}

if (lbm_is_number(ctx->r)) {
  lbm_value array;
  initial_size = sizeof(lbm_uint) * initial_size;

  if (!lbm_heap_allocate_array(&array, initial_size)) {
    lbm_set_error_reason("Out of memory while reading.");
    lbm_channel_reader_close(str);
    error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
    // NOTE: If array is not created evaluation ends here.
    // Static analysis seems unaware.
  }

  sptr[0] = array;
  stack_push_3(&ctx->K, lbm_enc_u(initial_size), lbm_enc_u(0), stream);
  stack_push(&ctx->K, READ_APPEND_ARRAY(((25) << 2) | 0xF8000001u));
  ctx->app_cont = true1;
} else {
  lbm_channel_reader_close(str);
  read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
}
3822}

3824static void cont_read_append_array(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 4);

lbm_value array  = sptr[0];
lbm_value size   = lbm_dec_as_u32(sptr[1]);
lbm_value ix     = lbm_dec_as_u32(sptr[2]);
lbm_value stream = sptr[3];

if (ix >= (size - 1)) {
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
}

// get_car can return nil. Whose value is 0!
// So static Analysis is right about this being a potential NULL pointer.
// However, if the array was created correcly to begin with, it should be fine.
lbm_value arr_car = get_car(array);
lbm_array_header_t *arr = (lbm_array_header_t*)arr_car;

if (lbm_is_number(ctx->r)) {
  ((uint8_t*)arr->data)[ix] = (uint8_t)lbm_dec_as_u32(ctx->r);

  sptr[2] = lbm_enc_u(ix + 1);
  stack_push_4(&ctx->K, READ_APPEND_ARRAY(((25) << 2) | 0xF8000001u), stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
  ctx->app_cont = true1;
} else if (lbm_is_symbol(ctx->r) && lbm_dec_sym(ctx->r) == SYM_CLOSEBRACK0x81) {
  lbm_uint array_size = ix / sizeof(lbm_uint);

  if (ix % sizeof(lbm_uint) != 0) {
    array_size = array_size + 1;
  }
  lbm_memory_shrink((lbm_uint*)arr->data, array_size);
  arr->size = ix;
  lbm_stack_drop(&ctx->K, 4);
  ctx->r = array;
  ctx->app_cont = true1;
} else {
  error_ctx(ENC_SYM_TERROR(((0x21) << 4) | 0x00000000u));
}
3862}

3864static void cont_read_append_continue(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 3);

lbm_value first_cell = sptr[0];
lbm_value last_cell  = sptr[1];
lbm_value stream     = sptr[2];

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL0x00000000u) {

  switch(lbm_dec_sym(ctx->r)) {
  case SYM_CLOSEPAR0x71:
    if (lbm_type_of(last_cell) == LBM_TYPE_CONS0x10000000u) {
      lbm_set_cdr(last_cell, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u)); // terminate the list
      ctx->r = first_cell;
    } else {
      ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    }
    lbm_stack_drop(&ctx->K, 3);
    /* Skip reading another token and apply the continuation */
    ctx->app_cont = true1;
    return;
  case SYM_DOT0x76:
    stack_push(&ctx->K, READ_DOT_TERMINATE(((19) << 2) | 0xF8000001u));
    stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  }
}
lbm_value new_cell = cons_with_gc(ctx->r, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
if (lbm_is_symbol_merror(new_cell)) {
  lbm_channel_reader_close(str);
  read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
  return;
}
if (lbm_type_of(last_cell) == LBM_TYPE_CONS0x10000000u) {
  lbm_set_cdr(last_cell, new_cell);
  last_cell = new_cell;
} else {
  first_cell = last_cell = new_cell;
}
sptr[0] = first_cell;
sptr[1] = last_cell;
sptr[2] = stream;    // unchanged.
stack_push(&ctx->K, READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u));
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
ctx->app_cont = true1;
3915}

3917static void cont_read_eval_continue(eval_context_t *ctx) {
lbm_value env;
lbm_value stream;
lbm_pop_2(&ctx->K, &env, &stream);

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

ctx->row1 = (lbm_int)str->row(str);

if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL0x00000000u) {

  switch(lbm_dec_sym(ctx->r)) {
  case SYM_CLOSEPAR0x71:
    ctx->app_cont = true1;
    return;
  case SYM_DOT0x76:
    stack_push(&ctx->K, READ_DOT_TERMINATE(((19) << 2) | 0xF8000001u));
    stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    return;
  }
}

stack_push_3(&ctx->K, stream, env, READ_EVAL_CONTINUE(((17) << 2) | 0xF8000001u));
stack_push_3(&ctx->K, stream, lbm_enc_u(1), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));

ctx->curr_env = env;
ctx->curr_exp = ctx->r;
3948}

3950static void cont_read_expect_closepar(eval_context_t *ctx) {
lbm_value res;
lbm_value stream;

lbm_pop_2(&ctx->K, &res, &stream);

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL0x00000000u &&
    lbm_dec_sym(ctx->r) == SYM_CLOSEPAR0x71) {
  ctx->r = res;
  ctx->app_cont = true1;
} else {
  lbm_channel_reader_close(str);
  lbm_set_error_reason((char*)lbm_error_str_parse_close);
  read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
}
3970}

3972static void cont_read_dot_terminate(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 3);

lbm_value first_cell = sptr[0];
lbm_value last_cell  = sptr[1];
lbm_value stream = sptr[2];

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

lbm_stack_drop(&ctx->K ,3);

if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL0x00000000u &&
    (lbm_dec_sym(ctx->r) == SYM_CLOSEPAR0x71 ||
     lbm_dec_sym(ctx->r) == SYM_DOT0x76)) {
  lbm_channel_reader_close(str);
  lbm_set_error_reason((char*)lbm_error_str_parse_dot);
  read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
} else {
  if (lbm_is_cons(last_cell)) {
    lbm_set_cdr(last_cell, ctx->r);
    ctx->r = first_cell;
    stack_push_3(&ctx->K,
                 stream,
                 ctx->r,
                 READ_EXPECT_CLOSEPAR(((18) << 2) | 0xF8000001u));
    stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
  } else {
    lbm_channel_reader_close(str);
    lbm_set_error_reason((char*)lbm_error_str_parse_dot);
    read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
  }
}
4008}

4010static void cont_read_done(eval_context_t *ctx) {
lbm_value stream;
lbm_value restore_incremental;
lbm_pop_2(&ctx->K, &stream ,&restore_incremental);

if (restore_incremental == ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u)) {
  ctx->flags |= EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x8;
} else {
  ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x8;
}

lbm_char_channel_t *str = lbm_dec_channel(stream);
if (str == NULL((void*)0) || str->state == NULL((void*)0)) {
  error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
}

lbm_channel_reader_close(str);
if (lbm_is_symbol(ctx->r)) {
  lbm_uint sym_val = lbm_dec_sym(ctx->r);
  if (sym_val >= TOKENIZER_SYMBOLS_START0x70 &&
      sym_val <= TOKENIZER_SYMBOLS_END0x85) {
    read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
  }
}

ctx->row0 = -1;
ctx->row1 = -1;
ctx->app_cont = true1;
4038}

4040static void cont_read_quote_result(eval_context_t *ctx) {
lbm_value cell;
WITH_GC(cell, lbm_heap_allocate_list_init(2,(cell) = (lbm_heap_allocate_list_init(2, (((0x100) << 4
) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror((cell
))) { gc(); (cell) = (lbm_heap_allocate_list_init(2, (((0x100
) << 4) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror
((cell))) { error_ctx((((0x23) << 4) | 0x00000000u)); }
 }
                                          ENC_SYM_QUOTE,(cell) = (lbm_heap_allocate_list_init(2, (((0x100) << 4
) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror((cell
))) { gc(); (cell) = (lbm_heap_allocate_list_init(2, (((0x100
) << 4) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror
((cell))) { error_ctx((((0x23) << 4) | 0x00000000u)); }
 }
                                          ctx->r))(cell) = (lbm_heap_allocate_list_init(2, (((0x100) << 4
) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror((cell
))) { gc(); (cell) = (lbm_heap_allocate_list_init(2, (((0x100
) << 4) | 0x00000000u), ctx->r)); if (lbm_is_symbol_merror
((cell))) { error_ctx((((0x23) << 4) | 0x00000000u)); }
 };
ctx->r = cell;
ctx->app_cont = true1;
4047}

4049static void cont_read_commaat_result(eval_context_t *ctx) {
lbm_value cell2 = cons_with_gc(ctx->r,ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
lbm_value cell1 = cons_with_gc(ENC_SYM_COMMAAT(((0x74) << 4) | 0x00000000u), cell2, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
ctx->r = cell1;
ctx->app_cont = true1;
4054}

4056static void cont_read_comma_result(eval_context_t *ctx) {
lbm_value cell2 = cons_with_gc(ctx->r,ENC_SYM_NIL(((0x0) << 4) | 0x00000000u),ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
lbm_value cell1 = cons_with_gc(ENC_SYM_COMMA(((0x73) << 4) | 0x00000000u), cell2, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
ctx->r = cell1;
ctx->app_cont = true1;
4061}

4063static void cont_application_start(eval_context_t *ctx) {

/* sptr[0] = env
 * sptr[1] = args
 * ctx->r  = function
 */

if (lbm_is_symbol(ctx->r)) {
  stack_push(&ctx->K, lbm_enc_u(0));
  cont_application_args(ctx);
} else if (lbm_is_cons(ctx->r)) {
  lbm_uint *sptr = get_stack_ptr(ctx, 2);
  lbm_value args = (lbm_value)sptr[1];
  switch (get_car(ctx->r)) {
  case ENC_SYM_CLOSURE(((0x10F) << 4) | 0x00000000u): {
    lbm_value cl[3];
    extract_n(get_cdr(ctx->r), cl, 3);
    lbm_value arg_env = (lbm_value)sptr[0];
    lbm_value arg0, arg_rest;
    get_car_and_cdr(args, &arg0, &arg_rest);
    sptr[1] = cl[CLO_BODY1];
    bool_Bool a_nil = lbm_is_symbol_nil(args);
    bool_Bool p_nil = lbm_is_symbol_nil(cl[CLO_PARAMS0]);

    if (!a_nil && !p_nil) {
      lbm_value *reserved = stack_reserve(ctx, 4);
      reserved[0] = cl[CLO_ENV2];
      reserved[1] = cl[CLO_PARAMS0];
      reserved[2] = arg_rest;
      reserved[3] = CLOSURE_ARGS(((13) << 2) | 0xF8000001u);
      ctx->curr_exp = arg0;
      ctx->curr_env = arg_env;
      return;
    }
    if (a_nil && p_nil) {
        // No params, No args
      lbm_stack_drop(&ctx->K, 2);
      ctx->curr_exp = cl[CLO_BODY1];
      ctx->curr_env = cl[CLO_ENV2];
      return;
    }
    if (p_nil) {
      lbm_value rest_binder = allocate_binding(ENC_SYM_REST_ARGS(((0x30015) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), cl[CLO_ENV2]);
      lbm_value *reserved = stack_reserve(ctx, 4);
      sptr[0] = arg_env;
      sptr[1] = cl[CLO_BODY1];
      reserved[0] = rest_binder;
      reserved[1] = get_cdr(args);
      reserved[2] = get_car(rest_binder);
      reserved[3] = CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u);
      ctx->curr_exp = get_car(args);
      ctx->curr_env = arg_env;
      return;
    }
    lbm_set_error_reason((char*)lbm_error_str_num_args);
    error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ctx->r);
  } break;
  case ENC_SYM_CONT(((0x10E) << 4) | 0x00000000u):{
    /* Continuation created using call-cc.
     * ((SYM_CONT . cont-array) arg0 )
     */
    lbm_value c = get_cdr(ctx->r); /* should be the continuation array*/

    if (!lbm_is_array_r(c)) {
      error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
    }

    lbm_uint arg_count = lbm_list_length(args);
    lbm_value arg = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    switch (arg_count) {
    case 0:
      arg = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
      break;
    case 1:
      arg = get_car(args);
      break;
    default:
      lbm_set_error_reason((char*)lbm_error_str_num_args);
      error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
    }
    lbm_stack_clear(&ctx->K);

    lbm_array_header_t *arr = (lbm_array_header_t*)get_car(c);

    ctx->K.sp = arr->size / sizeof(lbm_uint);
    memcpy(ctx->K.data, arr->data, arr->size);

    ctx->curr_exp = arg;
    break;
  }
  case ENC_SYM_MACRO(((0x10D) << 4) | 0x00000000u):{
    /*
     * Perform macro expansion.
     * Macro expansion is really just evaluation in an
     * environment augmented with the unevaluated expressions passed
     * as arguments.
     */
    lbm_value env = (lbm_value)sptr[0];

    lbm_value curr_param = get_cadr(ctx->r);
    lbm_value curr_arg = args;
    lbm_value expand_env = env;
    while (lbm_is_cons(curr_param) &&
           lbm_is_cons(curr_arg)) {
      lbm_value car_curr_param, cdr_curr_param;
      lbm_value car_curr_arg, cdr_curr_arg;
      get_car_and_cdr(curr_param, &car_curr_param, &cdr_curr_param);
      get_car_and_cdr(curr_arg, &car_curr_arg, &cdr_curr_arg);

      lbm_value entry = cons_with_gc(car_curr_param, car_curr_arg, expand_env);
      lbm_value aug_env = cons_with_gc(entry, expand_env,ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
      expand_env = aug_env;

      curr_param = cdr_curr_param;
      curr_arg   = cdr_curr_arg;
    }
    /* Two rounds of evaluation is performed.
     * First to instantiate the arguments into the macro body.
     * Second to evaluate the resulting program.
     */
    sptr[1] = EVAL_R(((11) << 2) | 0xF8000001u);
    lbm_value exp = get_cadr(get_cdr(ctx->r));
    ctx->curr_exp = exp;
    ctx->curr_env = expand_env;
  } break;
  default:
    error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
  }
} else {
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
4194}

4196static void cont_eval_r(eval_context_t* ctx) {
lbm_value env;
lbm_pop(&ctx->K, &env);
ctx->curr_exp = ctx->r;
ctx->curr_env = env;
4201}

4203/* progn + var stack
 sp-5 : env
 sp-4 : 0
 sp-3 : rest
 sp-2 : PROGN_REST
 sp-1 : symbol
*/
4210static void cont_progn_var(eval_context_t* ctx) {

lbm_value sym;

lbm_pop(&ctx->K, &sym);

if (ctx->K.sp >= 4) { // could potentially be inside of an progn
  lbm_value sv = ctx->K.data[ctx->K.sp - 1];
  if (IS_CONTINUATION(sv)(((sv) & 0xF8000001u) == 0xF8000001u) &&
      (sv == PROGN_REST(((4) << 2) | 0xF8000001u))) {
    lbm_uint  sp = ctx->K.sp;
    uint32_t  is_copied = lbm_dec_as_u32(ctx->K.data[sp - 3]);
    if (is_copied == 0) {
      lbm_value env;
      WITH_GC(env, lbm_env_copy_spine(ctx->K.data[sp - 4]))(env) = (lbm_env_copy_spine(ctx->K.data[sp - 4])); if (lbm_is_symbol_merror
((env))) { gc(); (env) = (lbm_env_copy_spine(ctx->K.data[sp
 - 4])); if (lbm_is_symbol_merror((env))) { error_ctx((((0x23
) << 4) | 0x00000000u)); } };
      ctx->K.data[sp - 3] = lbm_enc_u(1);
      ctx->K.data[sp - 4] = env;
    }
    lbm_value new_env = ctx->K.data[sp - 4];
    lbm_value tmp;
    WITH_GC(tmp, lbm_env_set_functional(new_env, sym, ctx->r))(tmp) = (lbm_env_set_functional(new_env, sym, ctx->r)); if
 (lbm_is_symbol_merror((tmp))) { gc(); (tmp) = (lbm_env_set_functional
(new_env, sym, ctx->r)); if (lbm_is_symbol_merror((tmp))) {
 error_ctx((((0x23) << 4) | 0x00000000u)); } };
    ctx->K.data[ctx->K.sp - 4] = tmp;
    ctx->app_cont = true1; // return to progn body
    return;
  }
}
lbm_set_error_reason((char*)lbm_error_str_var_outside_progn);
error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
4238}

4240static void cont_setq(eval_context_t *ctx) {
lbm_value sym;
lbm_value env;
lbm_pop_2(&ctx->K, &sym, &env);
lbm_value res;
WITH_GC(res, perform_setvar(sym, ctx->r, env))(res) = (perform_setvar(sym, ctx->r, env)); if (lbm_is_symbol_merror
((res))) { gc(); (res) = (perform_setvar(sym, ctx->r, env)
); if (lbm_is_symbol_merror((res))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
ctx->r = res;
ctx->app_cont = true1;
4248}

4250lbm_flash_status request_flash_storage_cell(lbm_value val, lbm_value *res) {

lbm_value flash_cell;
lbm_flash_status s = lbm_allocate_const_cell(&flash_cell);
if (s != LBM_FLASH_WRITE_OK)
  return s;
lbm_value new_val = val;
new_val &= ~LBM_PTR_VAL_MASK0x03FFFFFCu; // clear the value part of the ptr
new_val |= (flash_cell & LBM_PTR_VAL_MASK0x03FFFFFCu);
new_val |= LBM_PTR_TO_CONSTANT_BIT0x04000000u;
*res = new_val;
return s;
4262}

4264static void cont_move_to_flash(eval_context_t *ctx) {

lbm_value args;
lbm_pop(&ctx->K, &args);

if (lbm_is_symbol_nil(args)) {
  // Done looping over arguments. return true.
  ctx->r = ENC_SYM_TRUE(((0x2) << 4) | 0x00000000u);
  ctx->app_cont = true1;
  return;
}

lbm_value first_arg, rest;
get_car_and_cdr(args, &first_arg, &rest);

lbm_value val;
if (lbm_is_symbol(first_arg) && lbm_global_env_lookup(&val, first_arg)) {
  // Prepare to copy the rest of the arguments when done with first.
  stack_push_2(&ctx->K, rest, MOVE_TO_FLASH(((31) << 2) | 0xF8000001u));
  if (lbm_is_ptr(val) &&
      (!(val & LBM_PTR_TO_CONSTANT_BIT0x04000000u))) {
    stack_push_2(&ctx->K, first_arg, SET_GLOBAL_ENV(((1) << 2) | 0xF8000001u));
    stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u));
    ctx->r = val;
  }
  ctx->app_cont = true1;
  return;
}
error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
4293}

4295static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {

lbm_value val = ctx->r;

if (lbm_is_cons(val)) {
  lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  handle_flash_status(request_flash_storage_cell(val, &flash_cell));
  stack_push_4(&ctx->K, flash_cell, flash_cell, get_cdr(val), MOVE_LIST_TO_FLASH(((33) << 2) | 0xF8000001u));
  stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u));
  ctx->r = get_car(val);
  ctx->app_cont = true1;
  return;
}

if (lbm_is_ptr(val) && (val & LBM_PTR_TO_CONSTANT_BIT0x04000000u)) {
  ctx->r = val;
  ctx->app_cont = true1;
  return;
}

if (lbm_is_ptr(val)) {
  // Request a flash storage cell.
  lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  handle_flash_status(request_flash_storage_cell(val, &flash_cell));
  ctx->r = flash_cell;
  lbm_cons_t *ref = lbm_ref_cell(val);
  if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL0x00000000u) {
    switch (lbm_dec_sym(ref->cdr)) {
    case SYM_RAW_I_TYPE0x31: /* fall through */
    case SYM_RAW_U_TYPE0x32:
    case SYM_RAW_F_TYPE0x33:
      handle_flash_status(write_const_car(flash_cell, ref->car));
      handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
      break;
    case SYM_IND_I_TYPE0x34: /* fall through */
    case SYM_IND_U_TYPE0x35:
    case SYM_IND_F_TYPE0x36: {
4332#ifndef LBM64
      /* 64 bit values are in lbm mem on 32bit platforms. */
      lbm_uint *lbm_mem_ptr = (lbm_uint*)ref->car;
      lbm_uint flash_ptr;

      handle_flash_status(lbm_write_const_raw(lbm_mem_ptr, 2, &flash_ptr));
      handle_flash_status(write_const_car(flash_cell, flash_ptr));
      handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
4340#else
      // There are no indirect types in LBM64
      error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
4343#endif
    } break;
    case SYM_ARRAY_TYPE0x30: {
      lbm_array_header_t *arr = (lbm_array_header_t*)ref->car;
      // arbitrary address: flash_arr.
      lbm_uint flash_arr;
      handle_flash_status(lbm_write_const_array_padded((uint8_t*)arr->data, arr->size, &flash_arr));
      lift_array_flash(flash_cell,
                       (char *)flash_arr,
                       arr->size);
    } break;
    case SYM_CHANNEL_TYPE0x37: /* fall through */
    case SYM_CUSTOM_TYPE0x38:
      lbm_set_error_reason((char *)lbm_error_str_flash_not_possible);
      error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
    }
  } else {
    error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
  }
  ctx->r = flash_cell;
  ctx->app_cont = true1;
  return;
}
ctx->r = val;
ctx->app_cont = true1;
4368}

4370static void cont_move_list_to_flash(eval_context_t *ctx) {

// ctx->r holds the value that should go in car

lbm_value *sptr = get_stack_ptr(ctx, 3);

lbm_value fst = sptr[0];
lbm_value lst = sptr[1];
lbm_value val = sptr[2];

handle_flash_status(write_const_car(lst, ctx->r));

if (lbm_is_cons(val)) {
  // prepare cell for rest of list
  lbm_value rest_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  handle_flash_status(request_flash_storage_cell(val, &rest_cell));
  handle_flash_status(write_const_cdr(lst, rest_cell));
  sptr[1] = rest_cell;
  sptr[2] = get_cdr(val);
  stack_push(&ctx->K, MOVE_LIST_TO_FLASH(((33) << 2) | 0xF8000001u));
  stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u));
  ctx->r = get_car(val);
} else {
  sptr[0] = fst;
  sptr[1] = lst;
  sptr[2] = CLOSE_LIST_IN_FLASH(((34) << 2) | 0xF8000001u);
  stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u));
  ctx->r =  val;
}
ctx->app_cont = true1;
4400}

4402static void cont_close_list_in_flash(eval_context_t *ctx) {
lbm_value fst;
lbm_value lst;
lbm_pop_2(&ctx->K, &lst, &fst);
lbm_value val = ctx->r;
handle_flash_status(write_const_cdr(lst, val));
ctx->r = fst;
ctx->app_cont = true1;
4410}

4412static void cont_qq_expand_start(eval_context_t *ctx) {
stack_push_2(&ctx->K, ctx->r, QQ_EXPAND(((36) << 2) | 0xF8000001u));
ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
ctx->app_cont = true1;
4416}

4418lbm_value quote_it(lbm_value qquoted) {
if (lbm_is_symbol(qquoted) &&
    lbm_is_special(qquoted)) return qquoted;

lbm_value val = cons_with_gc(qquoted, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
return cons_with_gc(ENC_SYM_QUOTE(((0x100) << 4) | 0x00000000u), val, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
4424}

4426bool_Bool is_append(lbm_value a) {
return (lbm_is_cons(a) &&
        lbm_is_symbol(get_car(a)) &&
        (lbm_dec_sym(get_car(a)) == SYM_APPEND0x20015));
4430}

4432lbm_value append(lbm_value front, lbm_value back) {
if (lbm_is_symbol_nil(front)) return back;
if (lbm_is_symbol_nil(back)) return front;

if (lbm_is_quoted_list(front) &&
    lbm_is_quoted_list(back)) {
  lbm_value f = get_car(get_cdr(front));
  lbm_value b = get_car(get_cdr(back));
  return quote_it(lbm_list_append(f, b));
}

if (is_append(back) &&
    lbm_is_quoted_list(get_car(get_cdr(back))) &&
     lbm_is_quoted_list(front)) {
  lbm_value ql = get_car(get_cdr(back));
  lbm_value f = get_car(get_cdr(front));
  lbm_value b = get_car(get_cdr(ql));

  lbm_value v = lbm_list_append(f, b);
  lbm_set_car(get_cdr(ql), v);
  return back;
}

if (is_append(back)) {
  back  = get_cdr(back);
  lbm_value new = cons_with_gc(front, back, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  return cons_with_gc(ENC_SYM_APPEND(((0x20015) << 4) | 0x00000000u), new, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
}

lbm_value t0, t1;

t0 = cons_with_gc(back, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), front);
t1 = cons_with_gc(front, t0, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
return cons_with_gc(ENC_SYM_APPEND(((0x20015) << 4) | 0x00000000u), t1, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
4466}

4468/* Bawden's qq-expand implementation
4469(define (qq-expand x)
(cond ((tag-comma? x)
       (tag-data x))
      ((tag-comma-atsign? x)
       (error "Illegal"))
      ((tag-backquote? x)
       (qq-expand
        (qq-expand (tag-data x))))
      ((pair? x)
       `(append
         ,(qq-expand-list (car x))
         ,(qq-expand (cdr x))))
      (else `',x)))
*/
4483static void cont_qq_expand(eval_context_t *ctx) {
lbm_value qquoted;
lbm_pop(&ctx->K, &qquoted);

switch(lbm_type_of(qquoted)) {
case LBM_TYPE_CONS0x10000000u: {
  lbm_value car_val = get_car(qquoted);
  lbm_value cdr_val = get_cdr(qquoted);
  if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
      lbm_dec_sym(car_val) == SYM_COMMA0x73) {
    ctx->r = append(ctx->r, get_car(cdr_val));
    ctx->app_cont = true1;
  } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
             lbm_dec_sym(car_val) == SYM_COMMAAT0x74) {
    error_ctx(ENC_SYM_RERROR(((0x20) << 4) | 0x00000000u));
  } else {
    stack_push_2(&ctx->K, ctx->r,  QQ_APPEND(((37) << 2) | 0xF8000001u));
    stack_push_2(&ctx->K, cdr_val, QQ_EXPAND(((36) << 2) | 0xF8000001u));
    stack_push_2(&ctx->K, car_val, QQ_EXPAND_LIST(((38) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }

} break;
default: {
  lbm_value res = quote_it(qquoted);
  ctx->r = append(ctx->r, res);
  ctx->app_cont = true1;
}
}
4513}

4515static void cont_qq_append(eval_context_t *ctx) {
lbm_value head;
lbm_pop(&ctx->K, &head);
ctx->r = append(head, ctx->r);
ctx->app_cont = true1;
4520}

4522/* Bawden's qq-expand-list implementation
4523(define (qq-expand-list x)
(cond ((tag-comma? x)
       `(list ,(tag-data x)))
      ((tag-comma-atsign? x)
       (tag-data x))
      ((tag-backquote? x)
       (qq-expand-list
        (qq-expand (tag-data x))))
      ((pair? x)
       `(list
         (append
          ,(qq-expand-list (car x))
          ,(qq-expand (cdr x)))))
      (else `'(,x))))
4537*/

4539static void cont_qq_expand_list(eval_context_t* ctx) {
lbm_value l;
lbm_pop(&ctx->K, &l);

switch(lbm_type_of(l)) {
case LBM_TYPE_CONS0x10000000u: {
  lbm_value car_val = get_car(l);
  lbm_value cdr_val = get_cdr(l);
  if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
      lbm_dec_sym(car_val) == SYM_COMMA0x73) {
    lbm_value tl = cons_with_gc(get_car(cdr_val), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
    lbm_value tmp = cons_with_gc(ENC_SYM_LIST(((0x20014) << 4) | 0x00000000u), tl, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
    ctx->r = append(ctx->r, tmp);
    ctx->app_cont = true1;
    return;
  } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
             lbm_dec_sym(car_val) == SYM_COMMAAT0x74) {
    ctx->r = get_car(cdr_val);
    ctx->app_cont = true1;
    return;
  } else {
    stack_push(&ctx->K, QQ_LIST(((39) << 2) | 0xF8000001u));
    stack_push_2(&ctx->K, ctx->r,  QQ_APPEND(((37) << 2) | 0xF8000001u));
    stack_push_2(&ctx->K, cdr_val, QQ_EXPAND(((36) << 2) | 0xF8000001u));
    stack_push_2(&ctx->K, car_val, QQ_EXPAND_LIST(((38) << 2) | 0xF8000001u));
    ctx->app_cont = true1;
    ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }

} break;
default: {
  lbm_value a_list = cons_with_gc(l, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_value tl = cons_with_gc(a_list, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_value tmp = cons_with_gc(ENC_SYM_QUOTE(((0x100) << 4) | 0x00000000u), tl, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  ctx->r = append(ctx->r, tmp);
  ctx->app_cont = true1;
}
}
4577}

4579static void cont_qq_list(eval_context_t *ctx) {
lbm_value val = ctx->r;
lbm_value apnd_app = cons_with_gc(val, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
lbm_value tmp = cons_with_gc(ENC_SYM_LIST(((0x20014) << 4) | 0x00000000u), apnd_app, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
ctx->r = tmp;
ctx->app_cont = true1;
4585}

4587static void cont_kill(eval_context_t *ctx) {
(void) ctx;
finish_ctx();
4590}

4592/*********************************************************/
4593/* Continuations table                                   */
4594typedef void (*cont_fun)(eval_context_t *);

4596static const cont_fun continuations[NUM_CONTINUATIONS46] =
{ advance_ctx,  // CONT_DONE
  cont_set_global_env,
  cont_bind_to_key_rest,
  cont_if,
  cont_progn_rest,
  cont_application_args,
  cont_and,
  cont_or,
  cont_wait,
  cont_match,
  cont_application_start,
  cont_eval_r,
  cont_resume,
  cont_closure_application_args,
  cont_exit_atomic,
  cont_read_next_token,
  cont_read_append_continue,
  cont_read_eval_continue,
  cont_read_expect_closepar,
  cont_read_dot_terminate,
  cont_read_done,
  cont_read_quote_result,
  cont_read_commaat_result,
  cont_read_comma_result,
  cont_read_start_array,
  cont_read_append_array,
  cont_map,
  cont_match_guard,
  cont_terminate,
  cont_progn_var,
  cont_setq,
  cont_move_to_flash,
  cont_move_val_to_flash_dispatch,
  cont_move_list_to_flash,
  cont_close_list_in_flash,
  cont_qq_expand_start,
  cont_qq_expand,
  cont_qq_append,
  cont_qq_expand_list,
  cont_qq_list,
  cont_kill,
  cont_loop,
  cont_loop_condition,
  cont_merge_rest,
  cont_merge_layer,
  cont_closure_args_rest,
};

4645/*********************************************************/
4646/* Evaluators lookup table (special forms)               */
4647typedef void (*evaluator_fun)(eval_context_t *);

4649static const evaluator_fun evaluators[] =
{
 eval_quote,
 eval_define,
 eval_progn,
 eval_lambda,
 eval_if,
 eval_let,
 eval_and,
 eval_or,
 eval_match,
 eval_receive,
 eval_receive_timeout,
 eval_callcc,
 eval_atomic,
 eval_selfevaluating, // macro
 eval_selfevaluating, // cont
 eval_selfevaluating, // closure
 eval_cond,
 eval_app_cont,
 eval_var,
 eval_setq,
 eval_move_to_flash,
 eval_loop,
};


4676/*********************************************************/
4677/* Evaluator step function                               */

4679static void evaluation_step(void){
eval_context_t *ctx = ctx_running;
4681#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
4683#endif

if (ctx->app_cont) {
  lbm_value k;
  lbm_pop(&ctx->K, &k);
  ctx->app_cont = false0;

  lbm_uint decoded_k = DEC_CONTINUATION(k)(((k) & ~0xF8000001u) >> 2);

  if (decoded_k < NUM_CONTINUATIONS46) {
    continuations[decoded_k](ctx);
  } else {
    error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
  }
  return;
}

if (lbm_is_symbol(ctx->curr_exp)) {
  eval_symbol(ctx);
  return;
}
if (lbm_is_cons(ctx->curr_exp)) {
  lbm_cons_t *cell = lbm_ref_cell(ctx->curr_exp);
  lbm_value h = cell->car;
  if (lbm_is_symbol(h) && ((h & ENC_SPECIAL_FORMS_MASK0xFFFFF000) == ENC_SPECIAL_FORMS_BIT0x00001000)) {
    lbm_uint eval_index = lbm_dec_sym(h)  & SPECIAL_FORMS_INDEX_MASK0x000000FF;
    evaluators[eval_index](ctx);
    return;
  }
  /*
   * At this point head can be anything. It should evaluate
   * into a form that can be applied (closure, symbol, ...) though.
   */
  lbm_value *reserved = stack_reserve(ctx, 3);
  reserved[0] = ctx->curr_env;
  reserved[1] = cell->cdr;
  reserved[2] = APPLICATION_START(((10) << 2) | 0xF8000001u);
  ctx->curr_exp = h; // evaluate the function
  return;
}

eval_selfevaluating(ctx);
return;
4726}

4728void lbm_pause_eval(void ) {
eval_cps_next_state_arg = 0;
eval_cps_next_state = EVAL_CPS_STATE_PAUSED1;
if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true1;
4732}

4734void lbm_pause_eval_with_gc(uint32_t num_free) {
eval_cps_next_state_arg = num_free;
eval_cps_next_state = EVAL_CPS_STATE_PAUSED1;
if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true1;
4738}

4740void lbm_continue_eval(void) {
eval_cps_next_state = EVAL_CPS_STATE_RUNNING2;
if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true1;
4743}

4745void lbm_kill_eval(void) {
eval_cps_next_state = EVAL_CPS_STATE_KILL4;
if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true1;
4748}

4750uint32_t lbm_get_eval_state(void) {
return eval_cps_run_state;
4752}

4754// Will wake up thread that is sleeping as well.
4755// Not sure this is good behavior.
4756static void handle_event_unblock_ctx(lbm_cid cid, lbm_value v) {
eval_context_t *found = NULL((void*)0);
mutex_lock(&qmutex);

found = lookup_ctx_nm(&blocked, cid);
if (found) {
  drop_ctx_nm(&blocked,found);
  if (lbm_is_error(v)) {
    lbm_uint trash;
    lbm_pop(&found->K, &trash);
    lbm_push(&found->K, TERMINATE(((28) << 2) | 0xF8000001u));
    found->app_cont = true1;
  }
  found->r = v;
  enqueue_ctx_nm(&queue,found);
}
mutex_unlock(&qmutex);
4773}

4775static void handle_event_define(lbm_value key, lbm_value val) {
lbm_uint dec_key = lbm_dec_sym(key);
lbm_uint ix_key  = dec_key & GLOBAL_ENV_MASK0x1F;
lbm_value *global_env = lbm_get_global_env();
lbm_uint orig_env = global_env[ix_key];
lbm_value new_env;
// A key is a symbol and should not need to be remembered.
WITH_GC(new_env, lbm_env_set(orig_env,key,val))(new_env) = (lbm_env_set(orig_env,key,val)); if (lbm_is_symbol_merror
((new_env))) { gc(); (new_env) = (lbm_env_set(orig_env,key,val
)); if (lbm_is_symbol_merror((new_env))) { error_ctx((((0x23)
 << 4) | 0x00000000u)); } };

global_env[ix_key] = new_env;
4785}

4787static lbm_value get_event_value(lbm_event_t *e) {
lbm_value v;
if (e->buf_len > 0) {
  lbm_flat_value_t fv;
  fv.buf = (uint8_t*)e->buf_ptr;
  fv.buf_size = e->buf_len;
  fv.buf_pos = 0;
  if (!lbm_unflatten_value(&fv, &v)) {
    lbm_set_flags(LBM_FLAG_HANDLER_EVENT_DELIVERY_FAILED(1 << 1));
    v = ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u);
  }
  // Free the flat value buffer. GC is unaware of its existence.
  lbm_free(fv.buf);
} else {
  v = (lbm_value)e->buf_ptr;
}
return v;
4804}

4806static void process_events(void) {

if (!lbm_events) return;
lbm_event_t e;

while (lbm_event_pop(&e)) {

  lbm_value event_val = get_event_value(&e);
  switch(e.type) {
  case LBM_EVENT_UNBLOCK_CTX:
    handle_event_unblock_ctx((lbm_cid)e.parameter, event_val);
    break;
  case LBM_EVENT_DEFINE:
    handle_event_define((lbm_value)e.parameter, event_val);
    break;
  case LBM_EVENT_FOR_HANDLER:
    if (lbm_event_handler_pid >= 0) {
      lbm_find_receiver_and_send(lbm_event_handler_pid, event_val);
    }
    break;
  }
}
4828}

4830/* eval_cps_run can be paused
 I think it would be better use a mailbox for
 communication between other threads and the run_eval
 but for now a set of variables will be used. */
4834void lbm_run_eval(void){

if (setjmp(critical_error_jmp_buf)_setjmp (critical_error_jmp_buf) > 0) {
  printf_callback("GC stack overflow!\n");
  critical_error_callback();
  // terminate evaluation thread.
  return;
}

setjmp(error_jmp_buf)_setjmp (error_jmp_buf);

while (eval_running) {
  if (eval_cps_state_changed  || eval_cps_run_state == EVAL_CPS_STATE_PAUSED1) {
    eval_cps_state_changed = false0;
    switch (eval_cps_next_state) {
    case EVAL_CPS_STATE_PAUSED1:
      if (eval_cps_run_state != EVAL_CPS_STATE_PAUSED1) {
        if (lbm_heap_num_free() < eval_cps_next_state_arg) {
          gc();
        }
        eval_cps_next_state_arg = 0;
      }
      eval_cps_run_state = EVAL_CPS_STATE_PAUSED1;
      usleep_callback(EVAL_CPS_MIN_SLEEP200);
      continue; /* jump back to start of eval_running loop */
    case EVAL_CPS_STATE_KILL4:
      eval_cps_run_state = EVAL_CPS_STATE_DEAD8;
      eval_running = false0;
      continue;
    default: // running state
      eval_cps_run_state = eval_cps_next_state;
      break;
    }
  }
  while (true1) {
    if (eval_steps_quota && ctx_running) {
      eval_steps_quota--;
      evaluation_step();
    } else {
      if (eval_cps_state_changed) break;
      eval_steps_quota = eval_steps_refill;
      if (is_atomic) {
        if (!ctx_running) {
          lbm_set_flags(LBM_FLAG_ATOMIC_MALFUNCTION(1 << 0));
          is_atomic = 0;
        }
      } else {
        if (gc_requested) {
          gc();
        }
        process_events();
        mutex_lock(&qmutex);
        if (ctx_running) {
          enqueue_ctx_nm(&queue, ctx_running);
          ctx_running = NULL((void*)0);
        }
        wake_up_ctxs_nm();
        ctx_running = dequeue_ctx_nm(&queue);
        mutex_unlock(&qmutex);
        if (!ctx_running) {
          lbm_system_sleeping = true1;
          //Fixed sleep interval to poll events regularly.
          usleep_callback(EVAL_CPS_MIN_SLEEP200);
          lbm_system_sleeping = false0;
        }
      }
    }
  }
}
4903}

4905lbm_cid lbm_eval_program(lbm_value lisp) {
return lbm_create_ctx(lisp, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), 256, NULL((void*)0));
4907}

4909lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
return lbm_create_ctx(lisp, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), stack_size, NULL((void*)0));
4911}

4913int lbm_eval_init() {
if (!qmutex_initialized) {
  mutex_init(&qmutex);
  qmutex_initialized = true1;
}
if (!lbm_events_mutex_initialized) {
  mutex_init(&lbm_events_mutex);
  lbm_events_mutex_initialized = true1;
}
if (!blocking_extension_mutex_initialized) {
  mutex_init(&blocking_extension_mutex);
  blocking_extension_mutex_initialized = true1;
}

mutex_lock(&qmutex);
mutex_lock(&lbm_events_mutex);

blocked.first = NULL((void*)0);
blocked.last = NULL((void*)0);
queue.first = NULL((void*)0);
queue.last = NULL((void*)0);
ctx_running = NULL((void*)0);

eval_cps_run_state = EVAL_CPS_STATE_RUNNING2;

mutex_unlock(&lbm_events_mutex);
mutex_unlock(&qmutex);

if (!lbm_init_env()) return 0;
eval_running = true1;
return 1;
4944}

4946bool_Bool lbm_eval_init_events(unsigned int num_events) {

mutex_lock(&lbm_events_mutex);
lbm_events = (lbm_event_t*)lbm_malloc(num_events * sizeof(lbm_event_t));
bool_Bool r = false0;
if (lbm_events) {
  lbm_events_max = num_events;
  lbm_events_head = 0;
  lbm_events_tail = 0;
  lbm_events_full = false0;
  lbm_event_handler_pid = -1;
  r = true1;
}
mutex_unlock(&lbm_events_mutex);
return r;
4961}

←

./include/heap.h

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