src/eval_cps.c

Bug Summary

File:	eval_cps.c
Warning:	line 4600, column 19 Access to field 'size' results in a dereference of a null pointer (loaded from variable 'src_arr')

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

clang -cc1 -triple i386-pc-linux-gnu -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name 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 static -mthread-model posix -mframe-pointer=none -fmath-errno -fno-rounding-math -masm-verbose -mconstructor-aliases -target-cpu i686 -dwarf-column-info -fno-split-dwarf-inlining -debugger-tuning=gdb -resource-dir /usr/lib/llvm-10/lib/clang/10.0.0 -I ./include -I ./include/extensions -I platform/linux/include -D _PRELUDE -internal-isystem /usr/local/include -internal-isystem /usr/lib/llvm-10/lib/clang/10.0.0/include -internal-externc-isystem /usr/include/i386-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -std=c99 -fdebug-compilation-dir /home/joels/Current/lispbm -ferror-limit 19 -fmessage-length 0 -fgnuc-version=4.2.1 -fobjc-runtime=gcc -fdiagnostics-show-option -vectorize-loops -vectorize-slp -analyzer-output=html -faddrsig -o /home/joels/Current/lispbm/test_reports/version_0.26.0/scan-build/2024-08-06-173222-124214-1 -x c src/eval_cps.c

src/eval_cps.c

→

1/*
  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>
39#include <stdarg.h>

41static jmp_buf error_jmp_buf;
42static jmp_buf critical_error_jmp_buf;

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

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

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

101#define FM_NEED_GC-1       -1
102#define FM_NO_MATCH-2      -2
103#define FM_PATTERN_ERROR-3 -3

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

111#define FB_OK0             0
112#define FB_TYPE_ERROR-1    -1

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

128static lbm_value lbm_error_suspect;
129static bool_Bool lbm_error_has_suspect = false0;
130#ifdef LBM_ALWAYS_GC

132#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));                  \
}

139#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));                  \
}

147#else

149#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 */   \
}
159#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 */   \
}

171#endif

173typedef struct {
eval_context_t *first;
eval_context_t *last;
176} eval_context_queue_t;

178#ifdef CLEAN_UP_CLOSURES
179static lbm_value clean_cl_env_symbol = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
180#endif

182static int gc(void);
183static void error_ctx(lbm_value);
184static void error_at_ctx(lbm_value err_val, lbm_value at);
185static void enqueue_ctx(eval_context_queue_t *q, eval_context_t *ctx);
186static bool_Bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail);

188// The currently executing context.
189eval_context_t *ctx_running = NULL((void*)0);
190volatile bool_Bool  lbm_system_sleeping = false0;

192static volatile bool_Bool gc_requested = false0;
193void lbm_request_gc(void) {
gc_requested = true1;
195}

197/*
 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.
208*/

210#define EVAL_CPS_DEFAULT_STACK_SIZE256 256
211#define EVAL_CPS_MIN_SLEEP200 200
212#define EVAL_STEPS_QUOTA10   10

214static volatile uint32_t eval_steps_refill = EVAL_STEPS_QUOTA10;
215static uint32_t eval_steps_quota = EVAL_STEPS_QUOTA10;

217void lbm_set_eval_step_quota(uint32_t quota) {
eval_steps_refill = quota;
219}

221static uint32_t          eval_cps_run_state = EVAL_CPS_STATE_DEAD8;
222static volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_NONE0;
223static volatile uint32_t eval_cps_next_state_arg = 0;
224static volatile bool_Bool     eval_cps_state_changed = false0;

226static void usleep_nonsense(uint32_t us) {
(void) us;
228}

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

236static uint32_t timestamp_nonsense(void) {
return 0;
238}

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

245static void ctx_done_nonsense(eval_context_t *ctx) {
(void) ctx;
247}

249static void critical_nonsense(void) {
return;
251}

253static void (*critical_error_callback)(void) = critical_nonsense;
254static void (*usleep_callback)(uint32_t) = usleep_nonsense;
255static uint32_t (*timestamp_us_callback)(void) = timestamp_nonsense;
256static void (*ctx_done_callback)(eval_context_t *) = ctx_done_nonsense;
257static int (*printf_callback)(const char *, ...) = printf_nonsense;
258static bool_Bool (*dynamic_load_callback)(const char *, const char **) = dynamic_load_nonsense;

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

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

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

275void 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;
278}

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

285void 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;
288}

290static volatile lbm_event_t *lbm_events = NULL((void*)0);
291static unsigned int lbm_events_head = 0;
292static unsigned int lbm_events_tail = 0;
293static unsigned int lbm_events_max  = 0;
294static bool_Bool         lbm_events_full = false0;
295static mutex_t      lbm_events_mutex;
296static bool_Bool         lbm_events_mutex_initialized = false0;
297static volatile lbm_cid  lbm_event_handler_pid = -1;

299lbm_cid lbm_get_event_handler_pid(void) {
return lbm_event_handler_pid;
301}

303void lbm_set_event_handler_pid(lbm_cid pid) {
lbm_event_handler_pid = pid;
305}

307bool_Bool lbm_event_handler_exists(void) {
return(lbm_event_handler_pid > 0);
309}


312static 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;
330}

332bool_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);
334}

336bool_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;
347}

349bool_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;
354}

356static 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;
367}

369bool_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;
377}

379static bool_Bool              eval_running = false0;
380static volatile bool_Bool     blocking_extension = false0;
381static mutex_t           blocking_extension_mutex;
382static bool_Bool              blocking_extension_mutex_initialized = false0;
383static lbm_uint          blocking_extension_timeout_us = 0;
384static bool_Bool              blocking_extension_timeout = false0;

386static uint32_t          is_atomic = 0;

388/* Process queues */
389static eval_context_queue_t blocked  = {NULL((void*)0), NULL((void*)0)};
390static eval_context_queue_t queue    = {NULL((void*)0), NULL((void*)0)};

392/* one mutex for all queue operations */
393mutex_t qmutex;
394bool_Bool    qmutex_initialized = false0;


397// MODES
398static volatile bool_Bool lbm_verbose = false0;

400void lbm_toggle_verbose(void) {
lbm_verbose = !lbm_verbose;
402}

404void lbm_set_verbose(bool_Bool verbose) {
lbm_verbose = verbose;
406}

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

415eval_context_t *lbm_get_current_context(void) {
return ctx_running;
417}

419/****************************************************/
420/* Utilities used locally in this file              */

422static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember) {
423#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;
433#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;
445#endif
446}

448static 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.
455}

457// pop_stack_ptr is safe when no GC is performed and
458// the values of the stack will be dropped.
459static 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.
466}

468static inline 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.
476}

478static 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));
}
487}

489static void lift_array_flash(lbm_value flash_cell, bool_Bool bytearray,  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));
lbm_uint t = bytearray ? ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u) : ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u);
handle_flash_status(write_const_cdr(flash_cell, t));
501}

503static 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));
}
513}

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

527static 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));
536}

538static 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));
552}

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

556#ifdef LBM_ALWAYS_GC
gc();
if (lbm_heap_num_free() < 4) {
  error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
}
561#else
if (lbm_heap_num_free() < 4) {
  gc();
  if (lbm_heap_num_free() < 4) {
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
  }
}
568#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;
589}

591// Allocate a binding and attach it to a list (if so desired)
592static lbm_value allocate_binding(lbm_value key, lbm_value val, lbm_value the_cdr) {
if (lbm_heap_num_free() < 2) {
  lbm_gc_mark_phase(key);
  lbm_gc_mark_phase(val);
  lbm_gc_mark_phase(the_cdr);
  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;
614}

616#define CLO_PARAMS0 0
617#define CLO_BODY1   1
618#define CLO_ENV2    2
619#define LOOP_BINDS0 0
620#define LOOP_COND1  1
621#define LOOP_BODY2  2

623// (a b c) -> [a b c]
624static lbm_value 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 {
    res[i] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  }
}
return curr; // Rest of list is returned here.
635}

637static 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;
652}

654// block_current_ctx blocks a context until it is
655// woken up externally or a timeout period of time passes.
656static 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);
663}

665lbm_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);
  }
}
685}

687/****************************************************/
688/* Error message creation                           */

690#define ERROR_MESSAGE_BUFFER_SIZE_BYTES256 256

692void 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);
  }
}
716}

718void 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);
778}

780/****************************************************/
781/* Tokenizing and parsing                           */

783bool_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;
808}

810bool_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;
817}


820/****************************************************/
821/* Queue functions                                  */

823static 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;
}
831}

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

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

845static 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;
}
857}

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

865static 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);
875}

877static 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;
916}

918/* End execution of the running context. */
919static 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);
936}

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

944bool_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;
969}

971void lbm_set_error_suspect(lbm_value suspect) {
lbm_error_suspect = suspect;
lbm_error_has_suspect = true1;
974}

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

982// Not possible to CONS_WITH_GC in error_ctx_base (potential loop)
983static 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)0x01) {
  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)) {
      lbm_find_receiver_and_send(ctx_running->parent, msg);
      goto error_ctx_base_done;
    }
  }
}
if ((ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP_UNROLL_RETURN(uint32_t)0x10) &&
    (err_val != ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u))) {
  lbm_uint v;
  while (ctx_running->K.sp > 0) {
    lbm_pop(&ctx_running->K, &v);
    if (v == EXCEPTION_HANDLER(((48) << 2) | 0xF8000001u)) {
      lbm_value *sptr = get_stack_ptr(ctx_running, 2);
      lbm_set_car(sptr[0], ENC_SYM_EXIT_ERROR(((0x3000C) << 4) | 0x00000000u));
      stack_reserve(ctx_running, 1)[0] = EXCEPTION_HANDLER(((48) << 2) | 0xF8000001u);
      ctx_running->app_cont = true1;
      ctx_running->r = err_val;
      longjmp(error_jmp_buf, 1);
    }
  }
  err_val = ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u);
}
print_error_message(err_val,
                    has_at,
                    at,
                    row,
                    column,
                    ctx_running->row0,
                    ctx_running->row1);
error_ctx_base_done:
ctx_running->r = err_val;
finish_ctx();
longjmp(error_jmp_buf, 1);
1027}

1029static void error_at_ctx(lbm_value err_val, lbm_value at) {
error_ctx_base(err_val, true1, at, 0, 0);
1031}

1033static void error_ctx(lbm_value err_val) {
error_ctx_base(err_val, false0, 0, 0, 0);
1035}

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

1041void lbm_critical_error(void) {
longjmp(critical_error_jmp_buf, 1);
1043}

1045// successfully finish a context
1046static void ok_ctx(void) {
if (ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP(uint32_t)0x01) {
  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();
1056}

1058static 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;
1075}

1077static 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 */
1095#ifndef LBM64
      t_diff = (0xFFFFFFFF - curr->timestamp) + t_now;
1097#else
      t_diff = (0xFFFFFFFFFFFFFFFF - curr->timestamp) + t_now;
1099#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;
}
1135}

1137static 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);
1151}

1153static 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;
1247}

1249lbm_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)0x00,
                             name);
1257}

1259bool_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;
1278}

1280static 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 --;
1286}

1288static 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;
1297}

1299/* Advance execution to the next expression in the program */
1300static void advance_ctx(eval_context_t *ctx) {
if (lbm_is_cons(ctx->program)) {
  stack_reserve(ctx, 1)[0] = 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();
  }
}
1310}

1312bool_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);
1314}

1316bool_Bool lbm_unblock_ctx_r(lbm_cid cid) {
mutex_lock(&blocking_extension_mutex);
bool_Bool r = false0;
eval_context_t *found = NULL((void*)0);
mutex_lock(&qmutex);
found = lookup_ctx_nm(&blocked, cid);
if (found) {
  drop_ctx_nm(&blocked,found);
  enqueue_ctx_nm(&queue,found);
  r = true1;
}
mutex_unlock(&qmutex);
mutex_unlock(&blocking_extension_mutex);
return r;
1330}

1332// unblock unboxed is also safe for rmbr:ed things.
1333bool_Bool lbm_unblock_ctx_unboxed(lbm_cid cid, lbm_value unboxed) {
mutex_lock(&blocking_extension_mutex);
bool_Bool r = false0;
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)) {
    get_stack_ptr(found, 1)[0] = TERMINATE(((28) << 2) | 0xF8000001u); // replace TOS
    found->app_cont = true1;
  }
  enqueue_ctx_nm(&queue,found);
  r = true1;
}
mutex_unlock(&qmutex);
mutex_unlock(&blocking_extension_mutex);
return r;
1352}

1354static bool_Bool lbm_block_ctx_base(bool_Bool timeout, float t_s) {
mutex_lock(&blocking_extension_mutex);
blocking_extension = true1;
if (timeout) {
  blocking_extension_timeout_us = S_TO_US(t_s)(lbm_uint)((t_s) * 1000000);
  blocking_extension_timeout = true1;
} else {
  blocking_extension_timeout = false0;
}
return true1;
1364}

1366void lbm_block_ctx_from_extension_timeout(float s) {
lbm_block_ctx_base(true1, s);
1368}

1370void lbm_block_ctx_from_extension(void) {
lbm_block_ctx_base(false0, 0);
1372}

1374// todo: May need to pop rmbrs from stack, if present.
1375// Suspect that the letting the discard cont run is really not a problem.
1376// Either way will be quite confusing what happens to allocated things when undoing block.
1377void lbm_undo_block_ctx_from_extension(void) {
blocking_extension = false0;
blocking_extension_timeout_us = 0;
blocking_extension_timeout = false0;
mutex_unlock(&blocking_extension_mutex);
1382}

1384lbm_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);
1421}

1423/* Pattern matching is currently implemented as a recursive
 function and make use of stack relative to the size of
 expressions that are being matched. */
1426static 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 (bindertype) {
  case ENC_SYM_MATCH_ANY(((0x41) << 4) | 0x00000000u):
    if ( var == ENC_SYM_DONTCARE(((0x9) << 4) | 0x00000000u)) {
      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;
}

if (lbm_is_symbol(p)) {
  if (p == ENC_SYM_DONTCARE(((0x9) << 4) | 0x00000000u)) 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);
1476}

1478// Find match is not very picky about syntax.
1479// A completely malformed recv form is most likely to
1480// just return no_match.
1481static 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;
1508}

1510/****************************************************/
1511/* Garbage collection                               */

1513static 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);
1521}

1523static 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);

1549#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
1551#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;
1560}

1562int lbm_perform_gc(void) {
return gc();
1564}

1566/****************************************************/
1567/* Evaluation functions                             */


1570static 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);
  }
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = ctx->curr_exp;
  sptr[1] = ctx->curr_env;
  sptr[2] = 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));
    }
  }

  // Here, chan has either been assigned or execution has terminated.
  
  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;
}
1617}

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

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

1629static 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));
}
1646}

1648static 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_reserve(ctx, 1)[0] = EXIT_ATOMIC(((14) << 2) | 0xF8000001u);
is_atomic ++;
eval_progn(ctx);
1656}

1658/* (call-cc (lambda (k) .... ))  */
1659static void eval_callcc(eval_context_t *ctx) {
lbm_value cont_array;
if (!lbm_heap_allocate_lisp_array(&cont_array, ctx->K.sp)) {
  gc();
  if (!lbm_heap_allocate_lisp_array(&cont_array, ctx->K.sp)) {
    error_ctx(ENC_SYM_MERROR(((0x23) << 4) | 0x00000000u));
    return; // dead return but static analysis doesn't know :)
  }
}
lbm_array_header_t *arr = (lbm_array_header_t*)get_car(cont_array);
memcpy(arr->data, ctx->K.data, ctx->K.sp * sizeof(lbm_uint));

lbm_value acont = cons_with_gc(ENC_SYM_CONT(((0x10E) << 4) | 0x00000000u), cont_array, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
lbm_value arg_list = cons_with_gc(acont, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
// Go directly into application evaluation without passing go
lbm_uint *sptr = stack_reserve(ctx, 3);
sptr[0] = ctx->curr_env;
sptr[1] = arg_list;
sptr[2] = APPLICATION_START(((10) << 2) | 0xF8000001u);
ctx->curr_exp = get_cadr(ctx->curr_exp);
1679}

1681// (define sym exp)
1682#define KEY1 1
1683#define VAL2 2
1684static void eval_define(eval_context_t *ctx) {
lbm_value parts[3];
lbm_value rest = extract_n(ctx->curr_exp, parts, 3);
lbm_uint *sptr = stack_reserve(ctx, 2);
if (lbm_is_symbol(parts[KEY1]) && lbm_is_symbol_nil(rest)) {
  lbm_uint sym_val = lbm_dec_sym(parts[KEY1]);
  sptr[0] = parts[KEY1];
  if (sym_val >= RUNTIME_SYMBOLS_START0x40000) {
    sptr[1] = SET_GLOBAL_ENV(((1) << 2) | 0xF8000001u);
    if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x02) {
      stack_reserve(ctx, 1)[0] = MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u);
    }
    ctx->curr_exp = parts[VAL2];
    return;
  }
}
error_at_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u), ctx->curr_exp);
1701}


1704/* Eval lambda is cheating, a lot! It does this
 for performance reasons. The cheats are that
 1. When  closure is created, a reference to the local env
 in which the lambda was evaluated is added to the closure.
 Ideally it should have created a list of free variables in the function
 and then looked up the values of these creating a new environment.
 2. The global env is considered global constant. As there is no copying
 of environment bindings into the closure, undefine may break closures.

 Correct closure creation is a lot more expensive than what happens here.
 However, one can try to write programs in such a way that closures are created
 seldomly. If one does that the space-usage benefits of "correct" closures
 may outweigh the performance gain of "incorrect" ones.

 some obscure programs such as test_setq_local_closure.lisp does not
 work properly due to this cheating.
*/
1721// (lambda param-list body-exp) -> (closure param-list body-exp env)
1722static void eval_lambda(eval_context_t *ctx) {
lbm_value vals[3];
extract_n(ctx->curr_exp, vals, 3);
ctx->r = allocate_closure(vals[1],vals[2], ctx->curr_env);
1726#ifdef CLEAN_UP_CLOSURES
lbm_uint sym_id  = 0;
if (clean_cl_env_symbol) {
  lbm_value tail = cons_with_gc(ctx->r, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_value app = cons_with_gc(clean_cl_env_symbol, tail, tail);
  ctx->curr_exp = app;
} else if (lbm_get_symbol_by_name("clean-cl-env", &sym_id)) {
  clean_cl_env_symbol = lbm_enc_sym(sym_id);
  lbm_value tail = cons_with_gc(ctx->r, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u), ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
  lbm_value app = cons_with_gc(clean_cl_env_symbol, tail, tail);
  ctx->curr_exp = app;
} else {
  ctx->app_cont = true1;
}
1740#else
ctx->app_cont = true1;
1742#endif
1743}

1745// (if cond-expr then-expr else-expr)
1746static void eval_if(eval_context_t *ctx) {
lbm_value cdr = get_cdr(ctx->curr_exp);
lbm_value *sptr = stack_reserve(ctx, 3);
sptr[0] = get_cdr(cdr);
sptr[1] = ctx->curr_env;
sptr[2] = IF(((3) << 2) | 0xF8000001u);
ctx->curr_exp = get_car(cdr);
1753}

1755// (cond (cond-expr-1 expr-1)
1756//         ...
1757//       (cond-expr-N expr-N))
1758static void eval_cond(eval_context_t *ctx) {
lbm_value cond1[2];
lbm_value rest_conds = extract_n(ctx->curr_exp, cond1, 2);

// end recursion at (cond )
if (lbm_is_symbol_nil(cond1[1])) {
  ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  ctx->app_cont = true1;
} else {
  // Cond is one of the few places where a bit of syntax checking takes place at runtime..
  // Maybe dont bother?
  lbm_uint len = lbm_list_length(cond1[1]);
  if (len != 2) {
    lbm_set_error_reason("Incorrect syntax in cond");
    error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
  }
  lbm_value cond_expr[2];
  extract_n(cond1[1], cond_expr, 2);
  lbm_value rest;
  WITH_GC(rest, lbm_heap_allocate_list_init(2,(rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { gc
(); (rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } }
                                            cond_expr[1], // Then branch(rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { gc
(); (rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } }
                                            cons_with_gc(ENC_SYM_COND, rest_conds , ENC_SYM_NIL)))(rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { gc
(); (rest) = (lbm_heap_allocate_list_init(2, cond_expr[1], cons_with_gc
((((0x110) << 4) | 0x00000000u), rest_conds , (((0x0) <<
 4) | 0x00000000u)))); if (lbm_is_symbol_merror((rest))) { error_ctx
((((0x23) << 4) | 0x00000000u)); } };
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = rest;
  sptr[1] = ctx->curr_env;
  sptr[2] = IF(((3) << 2) | 0xF8000001u);
  ctx->curr_exp = cond_expr[0]; //condition;
}
1786}

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

1793// Create a named location in an environment to later receive a value.
1794static binding_location_status create_binding_location_internal(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_internal(get_car(key), env);
  if (r == BL_OK) {
    r = create_binding_location_internal(get_cdr(key), env);
  }
  return r;
}
return BL_OK;
1818}

1820static void create_binding_location(lbm_value key, lbm_value *env) {

lbm_value env_tmp = *env;
binding_location_status r = create_binding_location_internal(key, &env_tmp);
if (r != BL_OK) {
  if (r == BL_NO_MEMORY) {
    env_tmp = *env;
    lbm_gc_mark_phase(env_tmp);
    gc();
    r = create_binding_location_internal(key, &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 = env_tmp;
1843}

1845static 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 car_curr, cdr_curr;
  get_car_and_cdr(curr, &car_curr, &cdr_curr);
  lbm_value key = get_car(car_curr);
  create_binding_location(key, &new_env_tmp);
  env = new_env_tmp;
  curr = cdr_curr;
}

lbm_value car_binds;
lbm_value cdr_binds;
get_car_and_cdr(binds, &car_binds, &cdr_binds);
lbm_value key_val[2];
extract_n(car_binds, key_val, 2);

lbm_uint *sptr = stack_reserve(ctx, 5);
sptr[0] = exp;
sptr[1] = cdr_binds;
sptr[2] = env;
sptr[3] = key_val[0];
sptr[4] = BIND_TO_KEY_REST(((2) << 2) | 0xF8000001u);
ctx->curr_exp = key_val[1];
ctx->curr_env = env;
1879}

1881// (var x (...)) - local binding inside of an progn
1882// var has to take, place root-level nesting within progn.
1883// (progn ... (var a 10) ...) OK!
1884// (progn ... (something (var a 10)) ... ) NOT OK!
1885/* progn stack
 sp-4 : env
 sp-3 : 0
 sp-2 : rest
 sp-1 : PROGN_REST
1890*/
1891static void eval_var(eval_context_t *ctx) {

if (ctx->K.sp >= 4) { // Possibly in 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 args = get_cdr(ctx->curr_exp);
  lbm_value key = get_car(args);
  create_binding_location(key, &new_env);
  ctx->K.data[sp-4] = new_env;

  lbm_value v_exp = get_cadr(args);
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = new_env;
  sptr[1] = key;
  sptr[2] = PROGN_VAR(((29) << 2) | 0xF8000001u);
  // Activating the new environment before the evaluation of the value to be bound,
  // means that other variables with same name will be shadowed already in the value
  // body.
  // The way closures work, the var-variable needs to be in scope during val evaluation
  // for a recursive closure to be possible.
  ctx->curr_env = new_env;
  ctx->curr_exp = v_exp;
  return;
  }
}
lbm_set_error_reason((char*)lbm_error_str_var_outside_progn);
error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
1927}

1929// (setq x (...)) - same as (set 'x (...)) or (setvar 'x (...))
1930static void eval_setq(eval_context_t *ctx) {
lbm_value parts[3];
extract_n(ctx->curr_exp, parts, 3);
lbm_value *sptr = stack_reserve(ctx, 3);
sptr[0] = ctx->curr_env;
sptr[1] = parts[1];
sptr[2] = SETQ(((30) << 2) | 0xF8000001u);
ctx->curr_exp = parts[2];
1938}

1940static void eval_move_to_flash(eval_context_t *ctx) {
lbm_value args = get_cdr(ctx->curr_exp);
lbm_value *sptr = stack_reserve(ctx,2);
sptr[0] = args;
sptr[1] = MOVE_TO_FLASH(((31) << 2) | 0xF8000001u);
ctx->app_cont = true1;
1946}

1948// (loop list-of-local-bindings
1949//       condition-exp
1950//       body-exp)
1951static 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);
lbm_value *sptr = stack_reserve(ctx, 3);
sptr[0] = parts[LOOP_BODY2];
sptr[1] = parts[LOOP_COND1];
sptr[2] = LOOP_CONDITION(((42) << 2) | 0xF8000001u);
let_bind_values_eval(parts[LOOP_BINDS0], parts[LOOP_COND1], env, ctx);
1960}

1962/* (trap expression)
*
* suggested use:
* (match (trap expression)
*   ((exit-error (? err)) (error-handler err))
*   ((exit-ok    (? v))   (value-handler v)))
*/
1969static void eval_trap(eval_context_t *ctx) {

lbm_value expr = get_cadr(ctx->curr_exp);
lbm_value retval;
WITH_GC(retval, lbm_heap_allocate_list(2))(retval) = (lbm_heap_allocate_list(2)); if (lbm_is_symbol_merror
((retval))) { gc(); (retval) = (lbm_heap_allocate_list(2)); if
 (lbm_is_symbol_merror((retval))) { error_ctx((((0x23) <<
 4) | 0x00000000u)); } };
lbm_set_car(retval, ENC_SYM_EXIT_OK(((0x3000B) << 4) | 0x00000000u)); // Assume things will go well.
lbm_uint *sptr = stack_reserve(ctx,3);
sptr[0] = retval;
sptr[1] = ctx->flags;
sptr[2] = EXCEPTION_HANDLER(((48) << 2) | 0xF8000001u);
ctx->flags |= EVAL_CPS_CONTEXT_FLAG_TRAP_UNROLL_RETURN(uint32_t)0x10;
ctx->curr_exp = expr;
1981}

1983// (let list-of-binding s
1984//      body-exp)
1985static void eval_let(eval_context_t *ctx) {
lbm_value env      = ctx->curr_env;
lbm_value parts[3];
extract_n(ctx->curr_exp, parts, 3);
let_bind_values_eval(parts[1], parts[2], env, ctx);
1990}

1992// (and exp0 ... expN)
1993static 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 {
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = ctx->curr_env;
  sptr[1] = get_cdr(rest);
  sptr[2] = AND(((6) << 2) | 0xF8000001u);
  ctx->curr_exp = get_car(rest);
}
2005}

2007// (or exp0 ... expN)
2008static 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 {
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = ctx->curr_env;
  sptr[1] = get_cdr(rest);
  sptr[2] = OR(((7) << 2) | 0xF8000001u);
  ctx->curr_exp = get_car(rest);
}
2020}

2022// Pattern matching
2023// format:
2024// (match e (pattern body)
2025//          (pattern body)
2026//          ...  )
2027//
2028// There can be an optional pattern guard:
2029// (match e (pattern guard body)
2030//          ... )
2031// a guard is a boolean expression.
2032// Guards make match, pattern matching more complicated
2033// than the recv pattern matching and requires staged execution
2034// via the continuation system rather than a while loop over a list.
2035static 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);
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = cdr_rest;
  sptr[1] = ctx->curr_env;
  sptr[2] = MATCH(((9) << 2) | 0xF8000001u);
}
2051}

2053static 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;
2099}

2101static 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_cadr(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);
2113}

2115// Receive
2116// (recv (pattern expr)
2117//       (pattern expr))
2118static 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);
2126}

2128/*********************************************************/
2129/*  Continuation functions                               */

2131/* cont_set_global_env
 sp-1 : Key-symbol
*/
2134static 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;
2154}

2156static void cont_resume(eval_context_t *ctx) {
lbm_pop_2(&ctx->K, &ctx->curr_env, &ctx->curr_exp);
2158}

2160static 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);
ctx->curr_exp = rest_car;
ctx->curr_env = env;
if (lbm_is_symbol_nil(rest_cdr)) {
  // allow for tail recursion
  lbm_stack_drop(&ctx->K, 3);
} else {
  sptr[2] = rest_cdr;
  stack_reserve(ctx, 1)[0] = PROGN_REST(((4) << 2) | 0xF8000001u);
}
2177}

2179static 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) {
  lbm_value *sptr = stack_reserve(ctx, 2);
  sptr[0] = lbm_enc_i(cid);
  sptr[1] = 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;
}
2205}

2207static 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
2226}

2228static 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));
}
2240}

2242static 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);

  // If we are inside a reader, its settings are stored.
  sptr[0] = lbm_enc_u(ctx->flags);  // flags stored.
  sptr[1] = chan;
  lbm_value  *rptr = stack_reserve(ctx,1);
  rptr[0] = READ_DONE(((20) << 2) | 0xF8000001u);

  // Each reader starts in a fresh situation
  ctx->flags &= ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK((uint32_t)0x02 | (uint32_t)0x04 | (uint32_t)0x08);

  if (program) {
    if (incremental) {
      ctx->flags |= EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x08;
      lbm_value  *rptr1 = stack_reserve(ctx,3);
      rptr1[0] = chan;
      rptr1[1] = ctx->curr_env;
      rptr1[2] = READ_EVAL_CONTINUE(((17) << 2) | 0xF8000001u);
    } else {
      ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x08;
      lbm_value  *rptr1 = stack_reserve(ctx,4);
      rptr1[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
      rptr1[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
      rptr1[2] = chan;
      rptr1[3] = READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u);
    }
  }
  rptr = stack_reserve(ctx,3); // reuse of variable rptr
  rptr[0] = chan;
  rptr[1] = lbm_enc_u(1);
  rptr[2] = 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));
}
2293}

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

2299static void apply_read_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
apply_read_base(args,nargs,ctx,true1,true1);
2301}

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

2307static 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)0x01)
    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;
2365}

2367static 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)0x00);
2369}

2371static 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)0x01);
2373}

2375static 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));
}
2388}

2390static 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));
}
2403}

2405static 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_value *sptr = get_stack_ptr(ctx, 2);
  sptr[0] = lbm_enc_i(cid);
  sptr[1] = 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));
}
2417}

2419/* (eval expr)
 (eval env expr) */
2421static 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);
2432}

2434static 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_reserve(ctx, 1)[0] = 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));
}
2469}

2471static 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));
}
2488}

2490static 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();
2497}

2499static 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));
2506}

2508// (map f arg-list)
2509static 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);
  sptr[0] = t;     // reuse stack space
  sptr[1] = ctx->curr_env;
  sptr[2] = elt;
  lbm_value *rptr = stack_reserve(ctx,4);
  rptr[0] = elt;
  rptr[1] = appli;
  rptr[2] = appli_0;
  rptr[3] = MAP(((26) << 2) | 0xF8000001u);
  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));
}
2549}

2551static 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));
}
2568}

2570static 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));
2589}

2591static 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));
2612}

2614static 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));
2648}

2650// (merge comparator list1 list2)
2651static 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_cadr(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));
2742}

2744// (sort comparator list)
2745static 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_cadr(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));
2837}

2839static 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;
2852}

2854/* (rotate list-expr dist/dir-expr) */
2855static void apply_rotate(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_list(args[0]) && lbm_is_number(args[1])) {
  int len = -1;
  lbm_value ls = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
  WITH_GC(ls, lbm_list_copy(&len, args[0]))(ls) = (lbm_list_copy(&len, args[0])); if (lbm_is_symbol_merror
((ls))) { gc(); (ls) = (lbm_list_copy(&len, args[0])); if
 (lbm_is_symbol_merror((ls))) { error_ctx((((0x23) << 4
) | 0x00000000u)); } };
  int dist = lbm_dec_as_i32(args[1]);
  if (len > 0 && dist != 0) {
    int d = dist;
    if (dist > 0) {
      ls = lbm_list_destructive_reverse(ls);
    } else {
      d = -dist;
    }

    lbm_value start = ls;
    lbm_value end = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
    lbm_value curr = start;
    while (lbm_is_cons(curr)) {
      end = curr;
      curr = get_cdr(curr);
    }

    for (int i = 0; i < d; i ++) {
      lbm_value a = start;
      start = lbm_cdr(start);
      lbm_set_cdr(a, ENC_SYM_NIL(((0x0) << 4) | 0x00000000u));
      lbm_set_cdr(end, a);
      end = a;
    }
    ls = start;
    if (dist > 0) {
      ls = lbm_list_destructive_reverse(ls);
    }
  }
  lbm_stack_drop(&ctx->K, nargs+1);
  ctx->app_cont = true1;
  ctx->r = ls;
  return;
}
error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
2895}

2897/***************************************************/
2898/* Application lookup table                        */

2900typedef void (*apply_fun)(lbm_value *, lbm_uint, eval_context_t *);
2901static 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,
 apply_rotate,
};

2928/***************************************************/
2929/* Application of function that takes arguments    */
2930/* passed over the stack.                          */

2932static 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);

  ctx->app_cont = true1;
  ctx->r = ext_res;

  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);
  }
}  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;
}
2979}

2981static 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 = lbm_is_symbol_nil(args);
bool_Bool p_nil = lbm_is_symbol_nil(cdr_params);

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_reserve(ctx,1)[0] = CLOSURE_ARGS(((13) << 2) | 0xF8000001u);
  ctx->curr_exp = 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 if (p_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_reserve(ctx,1)[0] = CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u);
  ctx->curr_exp = get_car(args);
  ctx->curr_env = arg_env;
}  else {
  lbm_set_error_reason((char*)lbm_error_str_num_args);
  error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
}
3024}


3027static 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_reserve(ctx,1)[0] = CLOSURE_ARGS_REST(((45) << 2) | 0xF8000001u);
  sptr[3] = get_cdr(args);
  ctx->curr_exp = get_car(args);
  ctx->curr_env = arg_env;
}
3062}

3064static 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;
  lbm_value *rptr = stack_reserve(ctx,2);
  rptr[0] = count + (1 << LBM_VAL_SHIFT4);
  rptr[1] = 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);
}
3088}

3090static 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 {
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = env;
  sptr[1] = get_cdr(rest);
  sptr[2] = AND(((6) << 2) | 0xF8000001u);
  ctx->curr_env = env;
  ctx->curr_exp = get_car(rest);
}
3108}

3110static 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 {
  lbm_value *sptr = stack_reserve(ctx, 3);
  sptr[0] = env;
  sptr[1] = get_cdr(rest);
  sptr[2] = OR(((7) << 2) | 0xF8000001u);
  ctx->curr_exp = get_car(rest);
  ctx->curr_env = env;
}
3128}

3130static 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;
3144}

3146static 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 car_rest = get_car(rest);
  lbm_value key_val[2];
  extract_n(car_rest, key_val, 2);

  sptr[1] = get_cdr(rest);
  sptr[3] = key_val[0];
  stack_reserve(ctx,1)[0] = BIND_TO_KEY_REST(((2) << 2) | 0xF8000001u);
  ctx->curr_exp = key_val[1];
  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);
}
3175}

3177static void cont_if(eval_context_t *ctx) {

lbm_value arg = ctx->r;

lbm_value *sptr = pop_stack_ptr(ctx, 2);

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

3191static 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_reserve(ctx,1)[0] = 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));
}
3257}

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

3264static 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_reserve(ctx,1)[0] = 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;
}
3289}

3291static 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;
}
3307}

3309static void cont_terminate(eval_context_t *ctx) {
error_ctx(ctx->r);
3311}

3313static void cont_loop(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 2);
stack_reserve(ctx,1)[0] = LOOP_CONDITION(((42) << 2) | 0xF8000001u);
ctx->curr_exp = sptr[1];
3317}

3319static 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_reserve(ctx,1)[0] = LOOP(((41) << 2) | 0xF8000001u);
ctx->curr_exp = sptr[0];
3328}

3330static 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_reserve(ctx,1)[0] = MERGE_REST(((43) << 2) | 0xF8000001u);
ctx->curr_exp = cmp_body;
ctx->curr_env = cmp_env;
3411}

3413// merge_layer stack contents
3414// s[sp-9] = cmp
3415// s[sp-8] = cmp_env
3416// s[sp-7] = par1
3417// s[sp-6] = par2
3418// s[sp-5] = acc - first cell
3419// s[sp-4] = acc - last cell
3420// s[sp-3] = rest;
3421// s[sp-2] = layer
3422// s[sp-1] = length or original list
3423//
3424// ctx->r merged sublist
3425static void cont_merge_layer(eval_context_t *ctx) {
lbm_uint *sptr = get_stack_ptr(ctx, 9);
lbm_int layer = lbm_dec_i(sptr[7]);
lbm_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_reserve(ctx,1)[0] = 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;
3539}

3541/****************************************************/
3542/*   READER                                         */

3544static 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);
}
3599}

3601/* cont_read_next_token
 sp-2 : Stream
 sp-1 : Grab row
3604*/
3605static 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_reserve(ctx,1)[0] = 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);
    lbm_value *rptr = stack_reserve(ctx,5);
    rptr[0] = stream;
    rptr[1] = READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u);
    rptr[2] = stream;
    rptr[3] = lbm_enc_u(0);
    rptr[4] = 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);
    lbm_value *rptr = stack_reserve(ctx, 3);
    rptr[0] = stream;
    rptr[1] = lbm_enc_u(0);
    rptr[2] = 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;
    lbm_value *rptr = stack_reserve(ctx, 2);
    rptr[0] = lbm_enc_u(0);
    rptr[1] = 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);
    lbm_value *rptr = stack_reserve(ctx,2);
    rptr[0] = stream;
    rptr[1] = 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: /* fall through */
  case TOKCONSTEND15u:
  case TOKCONSTSYMSTR16u: {
    if (match == TOKCONSTSTART14u)  ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x02;
    if (match == TOKCONSTEND15u)    ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_CONST(uint32_t)0x02;
    if (match == TOKCONSTSYMSTR16u) ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS(uint32_t)0x04;
    sptr[0] = stream;
    sptr[1] = lbm_enc_u(0);
    stack_reserve(ctx,1)[0] = 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;
  lbm_value *rptr = stack_reserve(ctx, 2);
  rptr[0] = lbm_enc_u(0);
  rptr[1] = 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));
      return; // dead return but static analysis does not know that.
    }
  }
  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 (n > 4 &&
        tokpar_sym_str[0] == 'e' &&
        tokpar_sym_str[1] == 'x' &&
        tokpar_sym_str[2] == 't' &&
        tokpar_sym_str[3] == '-') {
      lbm_uint ext_id;
      lbm_uint ext_name_len = (lbm_uint)n + 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)0x04 &&
          ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ(uint32_t)0x08) {
        r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id, true1); //flash
         if (!r) {
          lbm_set_error_reason((char*)lbm_error_str_flash_error);
          error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
        }
      } else {
        r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false0); //ram
        if (!r) {
          gc();
          r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false0); //ram
        }
      }
    }
    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_reserve(ctx,1)[0] = READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u);
  yield_ctx(EVAL_CPS_MIN_SLEEP200);
  return;
}
read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
3921}

3923static 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;
  lbm_value *rptr = stack_reserve(ctx, 4);
  rptr[0] = lbm_enc_u(initial_size);
  rptr[1] = lbm_enc_u(0);
  rptr[2] = stream;
  rptr[3] = 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));
}
3967}

3969static 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);
  lbm_value *rptr = stack_reserve(ctx, 4);
  rptr[0] = READ_APPEND_ARRAY(((25) << 2) | 0xF8000001u);
  rptr[1] = stream;
  rptr[2] = lbm_enc_u(0);
  rptr[3] = READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u);
  ctx->app_cont = true1;
} else if (lbm_is_symbol(ctx->r) && ctx->r == ENC_SYM_CLOSEBRACK(((0x81) << 4) | 0x00000000u)) {
  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));
}
4011}

4013static 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(ctx->r) {
  case ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u):
    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 ENC_SYM_DOT(((0x76) << 4) | 0x00000000u): {
    lbm_value *rptr = stack_reserve(ctx, 4);
    rptr[0] = READ_DOT_TERMINATE(((19) << 2) | 0xF8000001u);
    rptr[1] = stream;
    rptr[2] = lbm_enc_u(0);
    rptr[3] = 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.
lbm_value *rptr = stack_reserve(ctx, 4);
rptr[0] = READ_APPEND_CONTINUE(((16) << 2) | 0xF8000001u);
rptr[1] = stream;
rptr[2] = lbm_enc_u(0);
rptr[3] = READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u);
ctx->app_cont = true1;
4070}

4072static 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(ctx->r) {
  case ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u):
    ctx->app_cont = true1;
    return;
  case ENC_SYM_DOT(((0x76) << 4) | 0x00000000u): {
    // This case is a bit mysterious.
    // A dot, may in reality be an error in this location.
    lbm_value *rptr = stack_reserve(ctx, 4);
    rptr[0] = READ_DOT_TERMINATE(((19) << 2) | 0xF8000001u);
    rptr[1] = stream;
    rptr[2] = lbm_enc_u(0);
    rptr[3] = READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u);
    ctx->app_cont = true1;
  } return;
  }
}

lbm_value *rptr = stack_reserve(ctx, 6);
rptr[0] = stream;
rptr[1] = env;
rptr[2] = READ_EVAL_CONTINUE(((17) << 2) | 0xF8000001u);
rptr[3] = stream;
rptr[4] = lbm_enc_u(1);
rptr[5] = READ_NEXT_TOKEN(((15) << 2) | 0xF8000001u);
rptr[6] = lbm_enc_u(ctx->flags);
rptr[7] = POP_READER_FLAGS(((47) << 2) | 0xF8000001u);
ctx->curr_env = env;
ctx->curr_exp = ctx->r;
4114}

4116static 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 &&
    ctx->r == ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u)) {
  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));
}
4136}

4138static 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 &&
    (ctx->r == ENC_SYM_CLOSEPAR(((0x71) << 4) | 0x00000000u) ||
     ctx->r == ENC_SYM_DOT(((0x76) << 4) | 0x00000000u))) {
  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;
    lbm_value *rptr = stack_reserve(ctx, 6);
    rptr[0] = stream;
    rptr[1] = ctx->r;
    rptr[2] = READ_EXPECT_CLOSEPAR(((18) << 2) | 0xF8000001u);
    rptr[3] = stream;
    rptr[4] = lbm_enc_u(0);
    rptr[5] = 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));
  }
}
4176}

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

uint32_t flags = lbm_dec_as_u32(f_val);
ctx->flags &= ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK((uint32_t)0x02 | (uint32_t)0x04 | (uint32_t)0x08);
ctx->flags |= (flags & EVAL_CPS_CONTEXT_READER_FLAGS_MASK((uint32_t)0x02 | (uint32_t)0x04 | (uint32_t)0x08));

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

4206static 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;
4213}

4215static 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;
4220}

4222static 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;
4227}

4229static void cont_application_start(eval_context_t *ctx) {

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

if (lbm_is_symbol(ctx->r)) {
  stack_reserve(ctx,1)[0] = 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]);
    lbm_value *reserved = stack_reserve(ctx, 4);

    if (!a_nil && !p_nil) {
      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;
    } else if (a_nil && p_nil) {
      // No params, No args
      lbm_stack_drop(&ctx->K, 6);
      ctx->curr_exp = cl[CLO_BODY1];
      ctx->curr_env = cl[CLO_ENV2];
    } else 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]);
      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;
    } else {
      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_lisp_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));
}
4353}

4355static 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;
4360}

4362static void cont_progn_var(eval_context_t* ctx) {

lbm_value key;
lbm_value env;

lbm_pop_2(&ctx->K, &key, &env);

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

ctx->app_cont = true1;
4375}

4377static 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;
4385}

4387lbm_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;
4399}

4401static 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.
  lbm_value *rptr = stack_reserve(ctx, 2);
  rptr[0] = rest;
  rptr[1] = MOVE_TO_FLASH(((31) << 2) | 0xF8000001u);
  if (lbm_is_ptr(val) &&
      (!(val & LBM_PTR_TO_CONSTANT_BIT0x04000000u))) {
    lbm_value * rptr1 = stack_reserve(ctx, 3);
    rptr1[0] = first_arg;
    rptr1[1] = SET_GLOBAL_ENV(((1) << 2) | 0xF8000001u);
    rptr1[2] = MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u);
    ctx->r = val;
  }
  ctx->app_cont = true1;
  return;
}
error_ctx(ENC_SYM_EERROR(((0x22) << 4) | 0x00000000u));
4434}

4436static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {

lbm_value val = ctx->r;

if (lbm_is_cons(val)) {
  lbm_value *rptr = stack_reserve(ctx, 5);
  rptr[0] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // fst cell of list
  rptr[1] = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u); // last cell of list
  rptr[2] = get_cdr(val);
  rptr[3] = MOVE_LIST_TO_FLASH(((33) << 2) | 0xF8000001u);
  rptr[4] = 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)) {
  lbm_cons_t *ref = lbm_ref_cell(val);
  if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL0x00000000u) {
    switch (ref->cdr) {
    case ENC_SYM_RAW_I_TYPE(((0x31) << 4) | 0x00000000u): /* fall through */
    case ENC_SYM_RAW_U_TYPE(((0x32) << 4) | 0x00000000u):
    case ENC_SYM_RAW_F_TYPE(((0x33) << 4) | 0x00000000u): {
lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
      handle_flash_status(write_const_car(flash_cell, ref->car));
      handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
ctx->r = flash_cell;
    } break;
    case ENC_SYM_IND_I_TYPE(((0x34) << 4) | 0x00000000u): /* fall through */
    case ENC_SYM_IND_U_TYPE(((0x35) << 4) | 0x00000000u):
    case ENC_SYM_IND_F_TYPE(((0x36) << 4) | 0x00000000u): {
4474#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));
lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
      handle_flash_status(write_const_car(flash_cell, flash_ptr));
      handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
ctx->r = flash_cell;
4485#else
      // There are no indirect types in LBM64
      error_ctx(ENC_SYM_FATAL_ERROR(((0x26) << 4) | 0x00000000u));
4488#endif
    } break;
    case ENC_SYM_LISPARRAY_TYPE(((0x39) << 4) | 0x00000000u): {
      lbm_array_header_t *arr = (lbm_array_header_t*)ref->car;
      lbm_uint size = arr->size / sizeof(lbm_uint);
      lbm_uint flash_addr;
      lbm_value *arrdata = (lbm_value *)arr->data;
lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
      handle_flash_status(lbm_allocate_const_raw(size, &flash_addr));
      lift_array_flash(flash_cell,
                       false0,
                       (char *)flash_addr,
                       arr->size);
      // Move array contents to flash recursively
      lbm_value *rptr = stack_reserve(ctx, 5);
      rptr[0] = flash_cell;
      rptr[1] = lbm_enc_u(0);
      rptr[2] = val;
      rptr[3] = MOVE_ARRAY_ELTS_TO_FLASH(((46) << 2) | 0xF8000001u);
      rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u);
      ctx->r = arrdata[0];
      ctx->app_cont = true1;
      return;
    }
    case ENC_SYM_ARRAY_TYPE(((0x30) << 4) | 0x00000000u): {
      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));
lbm_value flash_cell = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
      lift_array_flash(flash_cell,
                       true1,
                       (char *)flash_arr,
                       arr->size);
ctx->r = flash_cell;
    } break;
    case ENC_SYM_CHANNEL_TYPE(((0x37) << 4) | 0x00000000u): /* fall through */
    case ENC_SYM_CUSTOM_TYPE(((0x38) << 4) | 0x00000000u):
      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->app_cont = true1;
  return;
}
ctx->r = val;
ctx->app_cont = true1;
4539}

4541static 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];


lbm_value new_lst = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
// Allocate element ptr storage after storing the element to flash. 
handle_flash_status(request_flash_storage_cell(lbm_enc_cons_ptr(LBM_PTR_NULL(0x03FFFFFCu >> 2)), &new_lst)); 

if (lbm_is_symbol_nil(fst)) {
  lst = new_lst;
  fst = new_lst;
  handle_flash_status(write_const_car(lst, ctx->r));
} else {
  handle_flash_status(write_const_cdr(lst, new_lst)); // low before high
  handle_flash_status(write_const_car(new_lst, ctx->r));
  lst = new_lst;	
}

if (lbm_is_cons(val)) {
  sptr[0] = fst;
  sptr[1] = lst;//rest_cell;
  sptr[2] = get_cdr(val);
  lbm_value *rptr = stack_reserve(ctx, 2);
  rptr[0] = MOVE_LIST_TO_FLASH(((33) << 2) | 0xF8000001u);
  rptr[1] = 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_reserve(ctx, 1)[0] = MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u);
  ctx->r =  val;
}
ctx->app_cont = true1;
4582}

4584static 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;
4592}

4594static void cont_move_array_elts_to_flash(eval_context_t *ctx) {
lbm_value *sptr = get_stack_ptr(ctx, 3);
// sptr[2] = source array in RAM
// sptr[1] = current index
// sptr[0] = target array in flash
lbm_array_header_t *src_arr = (lbm_array_header_t*)get_car(sptr[2]);
1
Calling 'get_car'→
10
←
Returning from 'get_car'→
11
←
'src_arr' initialized to a null pointer value→
lbm_uint size = src_arr->size / sizeof(lbm_uint);
12
←
Access to field 'size' results in a dereference of a null pointer (loaded from variable 'src_arr')
lbm_value *srcdata = (lbm_value *)src_arr->data;

lbm_array_header_t *tgt_arr = (lbm_array_header_t*)get_car(sptr[0]);
lbm_uint *tgtdata = (lbm_value *)tgt_arr->data;
lbm_uint ix = lbm_dec_as_u32(sptr[1]);
handle_flash_status(lbm_const_write(&tgtdata[ix], ctx->r));
if (ix >= size-1) {
  ctx->r = sptr[0];
  lbm_stack_drop(&ctx->K, 3);
  ctx->app_cont = true1;
  return;
}
sptr[1] = lbm_enc_u(ix + 1);
lbm_value *rptr = stack_reserve(ctx, 2);
rptr[0] = MOVE_ARRAY_ELTS_TO_FLASH(((46) << 2) | 0xF8000001u);
rptr[1] = MOVE_VAL_TO_FLASH_DISPATCH(((32) << 2) | 0xF8000001u);
ctx->r = srcdata[ix+1];
ctx->app_cont = true1;
return;
4620}

4622static void cont_qq_expand_start(eval_context_t *ctx) {
lbm_value *rptr = stack_reserve(ctx, 2);
rptr[0] = ctx->r;
rptr[1] = QQ_EXPAND(((36) << 2) | 0xF8000001u);
ctx->r = ENC_SYM_NIL(((0x0) << 4) | 0x00000000u);
ctx->app_cont = true1;
4628}

4630lbm_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));
4636}

4638bool_Bool is_append(lbm_value a) {
return (lbm_is_cons(a) &&
        lbm_is_symbol(get_car(a)) &&
        (get_car(a) == ENC_SYM_APPEND(((0x20015) << 4) | 0x00000000u)));
4642}

4644lbm_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_cadr(front);
  lbm_value b = get_cadr(back);
  return quote_it(lbm_list_append(f, b));
}

if (is_append(back) &&
    lbm_is_quoted_list(get_cadr(back)) &&
     lbm_is_quoted_list(front)) {
  lbm_value ql = get_cadr(back);
  lbm_value f = get_cadr(front);
  lbm_value b = get_cadr(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));
4678}

4680/* Bawden's qq-expand implementation
4681(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)))
*/
4695static 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 &&
      car_val == ENC_SYM_COMMA(((0x73) << 4) | 0x00000000u)) {
    ctx->r = append(ctx->r, get_car(cdr_val));
    ctx->app_cont = true1;
  } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
             car_val == ENC_SYM_COMMAAT(((0x74) << 4) | 0x00000000u)) {
    error_ctx(ENC_SYM_RERROR(((0x20) << 4) | 0x00000000u));
  } else {
    lbm_value *rptr = stack_reserve(ctx, 6);
    rptr[0] = ctx->r;
    rptr[1] = QQ_APPEND(((37) << 2) | 0xF8000001u);
    rptr[2] = cdr_val;
    rptr[3] = QQ_EXPAND(((36) << 2) | 0xF8000001u);
    rptr[4] = car_val;
    rptr[5] = 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;
}
}
4729}

4731static 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;
4736}

4738/* Bawden's qq-expand-list implementation
4739(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))))
4753*/

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

ctx->app_cont = true1;
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 &&
      car_val == ENC_SYM_COMMA(((0x73) << 4) | 0x00000000u)) {
    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);
    return;
  } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL0x00000000u &&
             car_val == ENC_SYM_COMMAAT(((0x74) << 4) | 0x00000000u)) {
    ctx->r = get_car(cdr_val);
    return;
  } else {
    lbm_value *rptr = stack_reserve(ctx, 7);
    rptr[0] = QQ_LIST(((39) << 2) | 0xF8000001u);
    rptr[1] = ctx->r;
    rptr[2] = QQ_APPEND(((37) << 2) | 0xF8000001u);
    rptr[3] = cdr_val;
    rptr[4] = QQ_EXPAND(((36) << 2) | 0xF8000001u);
    rptr[5] = car_val;
    rptr[6] = QQ_EXPAND_LIST(((38) << 2) | 0xF8000001u);
    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);
}
}
4794}

4796static 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;
4802}

4804static void cont_kill(eval_context_t *ctx) {
(void) ctx;
finish_ctx();
4807}

4809static void cont_pop_reader_flags(eval_context_t *ctx) {
lbm_value flags;
lbm_pop(&ctx->K, &flags);
ctx->flags = ctx->flags & ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK((uint32_t)0x02 | (uint32_t)0x04 | (uint32_t)0x08);
ctx->flags |= (lbm_dec_as_u32(flags) & EVAL_CPS_CONTEXT_READER_FLAGS_MASK((uint32_t)0x02 | (uint32_t)0x04 | (uint32_t)0x08));
// r is unchanged.
ctx->app_cont = true1;
4816}

4818static void cont_exception_handler(eval_context_t *ctx) {
lbm_value *sptr = pop_stack_ptr(ctx, 2);
lbm_value retval = sptr[0];
lbm_value flags = sptr[1];
lbm_set_car(get_cdr(retval), ctx->r);
ctx->flags = flags;
ctx->r = retval;
ctx->app_cont = true1;
4826}

4828/*********************************************************/
4829/* Continuations table                                   */
4830typedef void (*cont_fun)(eval_context_t *);

4832static const cont_fun continuations[NUM_CONTINUATIONS49] =
{ 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,
  cont_move_array_elts_to_flash,
  cont_pop_reader_flags,
  cont_exception_handler
};

4884/*********************************************************/
4885/* Evaluators lookup table (special forms)               */
4886typedef void (*evaluator_fun)(eval_context_t *);

4888static 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,
 eval_trap
};


4916/*********************************************************/
4917/* Evaluator step function                               */

4919static void evaluation_step(void){
eval_context_t *ctx = ctx_running;
4921#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
4923#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_CONTINUATIONS49) {
    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;
4966}

4968void 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;
4972}

4974void 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;
4978}

4980void 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;
4983}

4985void 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;
4988}

4990uint32_t lbm_get_eval_state(void) {
return eval_cps_run_state;
4992}

4994// Will wake up thread that is sleeping as well.
4995// Not sure this is good behavior.
4996static 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)) {
    get_stack_ptr(found, 1)[0] = TERMINATE(((28) << 2) | 0xF8000001u); // replace TOS
    found->app_cont = true1;
  }
  found->r = v;
  enqueue_ctx_nm(&queue,found);
}
mutex_unlock(&qmutex);
5011}

5013static 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;
5023}

5025static 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;
5042}

5044static 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;
  }
}
5066}

5068/* 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. */
5072void 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;
        }
      }
    }
  }
}
5141}

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

5147lbm_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));
5149}

5151int 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;
5182}

5184bool_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;
5199}

←

./include/heap.h

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