GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/eval_cps.c
Date: 2024-11-05 17:11:09
Exec Total Coverage
Lines: 2750 3202 85.9%
Functions: 188 215 87.4%
Branches: 849 1295 65.6%
Line Branch Exec Source
1 /*
2 Copyright 2018, 2020 - 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
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"
33
34 #ifdef VISUALIZE_HEAP
35 #include "heap_vis.h"
36 #endif
37
38 #include <setjmp.h>
39 #include <stdarg.h>
40
41 static jmp_buf error_jmp_buf;
42 static jmp_buf critical_error_jmp_buf;
43
44 #define S_TO_US(X) (lbm_uint)((X) * 1000000)
45
46 #define DEC_CONTINUATION(x) (((x) & ~LBM_CONTINUATION_INTERNAL) >> LBM_ADDRESS_SHIFT)
47 #define IS_CONTINUATION(x) (((x) & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)
48 #define CONTINUATION(x) (((x) << LBM_ADDRESS_SHIFT) | LBM_CONTINUATION_INTERNAL)
49
50 #define DONE CONTINUATION(0)
51 #define SET_GLOBAL_ENV CONTINUATION(1)
52 #define BIND_TO_KEY_REST CONTINUATION(2)
53 #define IF CONTINUATION(3)
54 #define PROGN_REST CONTINUATION(4)
55 #define APPLICATION_ARGS CONTINUATION(5)
56 #define AND CONTINUATION(6)
57 #define OR CONTINUATION(7)
58 #define WAIT CONTINUATION(8)
59 #define MATCH CONTINUATION(9)
60 #define APPLICATION_START CONTINUATION(10)
61 #define EVAL_R CONTINUATION(11)
62 #define RESUME CONTINUATION(12)
63 #define CLOSURE_ARGS CONTINUATION(13)
64 #define EXIT_ATOMIC CONTINUATION(14)
65 #define READ_NEXT_TOKEN CONTINUATION(15)
66 #define READ_APPEND_CONTINUE CONTINUATION(16)
67 #define READ_EVAL_CONTINUE CONTINUATION(17)
68 #define READ_EXPECT_CLOSEPAR CONTINUATION(18)
69 #define READ_DOT_TERMINATE CONTINUATION(19)
70 #define READ_DONE CONTINUATION(20)
71 #define READ_START_ARRAY CONTINUATION(21)
72 #define READ_APPEND_ARRAY CONTINUATION(22)
73 #define MAP CONTINUATION(23)
74 #define MATCH_GUARD CONTINUATION(24)
75 #define TERMINATE CONTINUATION(25)
76 #define PROGN_VAR CONTINUATION(26)
77 #define SETQ CONTINUATION(27)
78 #define MOVE_TO_FLASH CONTINUATION(28)
79 #define MOVE_VAL_TO_FLASH_DISPATCH CONTINUATION(29)
80 #define MOVE_LIST_TO_FLASH CONTINUATION(30)
81 #define CLOSE_LIST_IN_FLASH CONTINUATION(31)
82 #define QQ_EXPAND_START CONTINUATION(32)
83 #define QQ_EXPAND CONTINUATION(33)
84 #define QQ_APPEND CONTINUATION(34)
85 #define QQ_EXPAND_LIST CONTINUATION(35)
86 #define QQ_LIST CONTINUATION(36)
87 #define KILL CONTINUATION(37)
88 #define LOOP CONTINUATION(38)
89 #define LOOP_CONDITION CONTINUATION(39)
90 #define MERGE_REST CONTINUATION(40)
91 #define MERGE_LAYER CONTINUATION(41)
92 #define CLOSURE_ARGS_REST CONTINUATION(42)
93 #define MOVE_ARRAY_ELTS_TO_FLASH CONTINUATION(43)
94 #define POP_READER_FLAGS CONTINUATION(44)
95 #define EXCEPTION_HANDLER CONTINUATION(45)
96 #define RECV_TO CONTINUATION(46)
97 #define WRAP_RESULT CONTINUATION(47)
98 #define NUM_CONTINUATIONS 48
99
100 #define FM_NEED_GC -1
101 #define FM_NO_MATCH -2
102 #define FM_PATTERN_ERROR -3
103
104 typedef enum {
105 BL_OK = 0,
106 BL_NO_MEMORY,
107 BL_INCORRECT_KEY
108 } binding_location_status;
109
110 #define FB_OK 0
111 #define FB_TYPE_ERROR -1
112
113 const char* lbm_error_str_parse_eof = "End of parse stream.";
114 const char* lbm_error_str_parse_dot = "Incorrect usage of '.'.";
115 const char* lbm_error_str_parse_close = "Expected closing parenthesis.";
116 const char* lbm_error_str_num_args = "Incorrect number of arguments.";
117 const char* lbm_error_str_forbidden_in_atomic = "Operation is forbidden in an atomic block.";
118 const char* lbm_error_str_no_number = "Argument(s) must be a number.";
119 const char* lbm_error_str_not_a_boolean = "Argument must be t or nil (true or false).";
120 const char* lbm_error_str_incorrect_arg = "Incorrect argument.";
121 const char* lbm_error_str_var_outside_progn = "Usage of var outside of progn.";
122 const char* lbm_error_str_flash_not_possible = "Value cannot be written to flash.";
123 const char* lbm_error_str_flash_error = "Error writing to flash.";
124 const char* lbm_error_str_flash_full = "Flash memory is full.";
125 const char* lbm_error_str_variable_not_bound = "Variable not bound.";
126 const char* lbm_error_str_read_no_mem = "Out of memory while reading.";
127
128 static lbm_value lbm_error_suspect;
129 static bool lbm_error_has_suspect = false;
130 #ifdef LBM_ALWAYS_GC
131
132 #define WITH_GC(y, x) \
133 gc(); \
134 (y) = (x); \
135 if (lbm_is_symbol_merror((y))) { \
136 error_ctx(ENC_SYM_MERROR); \
137 }
138
139 #define WITH_GC_RMBR_1(y, x, r) \
140 lbm_gc_mark_phase(r); \
141 gc(); \
142 (y) = (x); \
143 if (lbm_is_symbol_merror((y))) { \
144 error_ctx(ENC_SYM_MERROR); \
145 }
146
147 #else
148
149 #define WITH_GC(y, x) \
150 (y) = (x); \
151 if (lbm_is_symbol_merror((y))) { \
152 gc(); \
153 (y) = (x); \
154 if (lbm_is_symbol_merror((y))) { \
155 error_ctx(ENC_SYM_MERROR); \
156 } \
157 /* continue executing statements below */ \
158 }
159 #define WITH_GC_RMBR_1(y, x, r) \
160 (y) = (x); \
161 if (lbm_is_symbol_merror((y))) { \
162 lbm_gc_mark_phase(r); \
163 gc(); \
164 (y) = (x); \
165 if (lbm_is_symbol_merror((y))) { \
166 error_ctx(ENC_SYM_MERROR); \
167 } \
168 /* continue executing statements below */ \
169 }
170
171 #endif
172
173 /**************************************************************/
174 /* */
175 typedef struct {
176 eval_context_t *first;
177 eval_context_t *last;
178 } eval_context_queue_t;
179
180 #ifdef CLEAN_UP_CLOSURES
181 static lbm_value clean_cl_env_symbol = ENC_SYM_NIL;
182 #endif
183
184 static int gc(void);
185 static void error_ctx(lbm_value);
186 static void error_at_ctx(lbm_value err_val, lbm_value at);
187 static void enqueue_ctx(eval_context_queue_t *q, eval_context_t *ctx);
188 static bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail);
189
190 // The currently executing context.
191 eval_context_t *ctx_running = NULL;
192 volatile bool lbm_system_sleeping = false;
193
194 static volatile bool gc_requested = false;
195 4368 void lbm_request_gc(void) {
196 4368 gc_requested = true;
197 4368 }
198
199 /*
200 On ChibiOs the CH_CFG_ST_FREQUENCY setting in chconf.h sets the
201 resolution of the timer used for sleep operations. If this is set
202 to 10KHz the resolution is 100us.
203
204 The CH_CFG_ST_TIMEDELTA specifies the minimum number of ticks that
205 can be safely specified in a timeout directive (wonder if that
206 means sleep-period). The timedelta is set to 2.
207
208 If I have understood these correctly it means that the minimum
209 sleep duration possible is 2 * 100us = 200us.
210 */
211
212 #define EVAL_CPS_DEFAULT_STACK_SIZE 256
213 #define EVAL_CPS_MIN_SLEEP 200
214 #define EVAL_STEPS_QUOTA 10
215
216 static volatile uint32_t eval_steps_refill = EVAL_STEPS_QUOTA;
217 static uint32_t eval_steps_quota = EVAL_STEPS_QUOTA;
218
219 28 void lbm_set_eval_step_quota(uint32_t quota) {
220 28 eval_steps_refill = quota;
221 28 }
222
223 static uint32_t eval_cps_run_state = EVAL_CPS_STATE_DEAD;
224 static volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_NONE;
225 static volatile uint32_t eval_cps_next_state_arg = 0;
226 static volatile bool eval_cps_state_changed = false;
227
228 ✗ static void usleep_nonsense(uint32_t us) {
229 (void) us;
230 ✗ }
231
232 ✗ static bool dynamic_load_nonsense(const char *sym, const char **code) {
233 (void) sym;
234 (void) code;
235 ✗ return false;
236 }
237
238 ✗ static uint32_t timestamp_nonsense(void) {
239 ✗ return 0;
240 }
241
242 ✗ static int printf_nonsense(const char *fmt, ...) {
243 (void) fmt;
244 ✗ return 0;
245 }
246
247 ✗ static void ctx_done_nonsense(eval_context_t *ctx) {
248 (void) ctx;
249 ✗ }
250
251 ✗ static void critical_nonsense(void) {
252 ✗ return;
253 }
254
255 ✗ static void user_callback_nonsense(void *arg) {
256 (void) arg;
257 ✗ return;
258 }
259
260 static void (*critical_error_callback)(void) = critical_nonsense;
261 static void (*usleep_callback)(uint32_t) = usleep_nonsense;
262 static uint32_t (*timestamp_us_callback)(void) = timestamp_nonsense;
263 static void (*ctx_done_callback)(eval_context_t *) = ctx_done_nonsense;
264 static int (*printf_callback)(const char *, ...) = printf_nonsense;
265 static bool (*dynamic_load_callback)(const char *, const char **) = dynamic_load_nonsense;
266 static void (*user_callback)(void *) = user_callback_nonsense;
267
268 ✗ void lbm_set_user_callback(void (*fptr)(void *)) {
269 ✗ if (fptr == NULL) user_callback = user_callback_nonsense;
270 ✗ else user_callback = fptr;
271 ✗ }
272
273 21504 void lbm_set_critical_error_callback(void (*fptr)(void)) {
274
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) critical_error_callback = critical_nonsense;
275 21504 else critical_error_callback = fptr;
276 21504 }
277
278 21504 void lbm_set_usleep_callback(void (*fptr)(uint32_t)) {
279
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) usleep_callback = usleep_nonsense;
280 21504 else usleep_callback = fptr;
281 21504 }
282
283 21504 void lbm_set_timestamp_us_callback(uint32_t (*fptr)(void)) {
284
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) timestamp_us_callback = timestamp_nonsense;
285 21504 else timestamp_us_callback = fptr;
286 21504 }
287
288 21504 void lbm_set_ctx_done_callback(void (*fptr)(eval_context_t *)) {
289
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) ctx_done_callback = ctx_done_nonsense;
290 21504 else ctx_done_callback = fptr;
291 21504 }
292
293 21504 void lbm_set_printf_callback(int (*fptr)(const char*, ...)){
294
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) printf_callback = printf_nonsense;
295 21504 else printf_callback = fptr;
296 21504 }
297
298 21504 void lbm_set_dynamic_load_callback(bool (*fptr)(const char *, const char **)) {
299
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (fptr == NULL) dynamic_load_callback = dynamic_load_nonsense;
300 21504 else dynamic_load_callback = fptr;
301 21504 }
302
303 static volatile lbm_event_t *lbm_events = NULL;
304 static unsigned int lbm_events_head = 0;
305 static unsigned int lbm_events_tail = 0;
306 static unsigned int lbm_events_max = 0;
307 static bool lbm_events_full = false;
308 static mutex_t lbm_events_mutex;
309 static bool lbm_events_mutex_initialized = false;
310 static volatile lbm_cid lbm_event_handler_pid = -1;
311
312 ✗ lbm_cid lbm_get_event_handler_pid(void) {
313 ✗ return lbm_event_handler_pid;
314 }
315
316 224 void lbm_set_event_handler_pid(lbm_cid pid) {
317 224 lbm_event_handler_pid = pid;
318 224 }
319
320 ✗ bool lbm_event_handler_exists(void) {
321 ✗ return(lbm_event_handler_pid > 0);
322 }
323
324
325 6549 static bool event_internal(lbm_event_type_t event_type, lbm_uint parameter, lbm_uint buf_ptr, lbm_uint buf_len) {
326 6549 bool r = false;
327
1/2
✓ Branch 0 taken 6549 times.
✗ Branch 1 not taken.
 6549 if (lbm_events) {
328 6549 mutex_lock(&lbm_events_mutex);
329
1/2
✓ Branch 0 taken 6549 times.
✗ Branch 1 not taken.
 6549 if (!lbm_events_full) {
330 lbm_event_t event;
331 6549 event.type = event_type;
332 6549 event.parameter = parameter;
333 6549 event.buf_ptr = buf_ptr;
334 6549 event.buf_len = buf_len;
335 6549 lbm_events[lbm_events_head] = event;
336 6549 lbm_events_head = (lbm_events_head + 1) % lbm_events_max;
337 6549 lbm_events_full = lbm_events_head == lbm_events_tail;
338 6549 r = true;
339 }
340 6549 mutex_unlock(&lbm_events_mutex);
341 }
342 6549 return r;
343 }
344
345 ✗ bool lbm_event_define(lbm_value key, lbm_flat_value_t *fv) {
346 ✗ return event_internal(LBM_EVENT_DEFINE, key, (lbm_uint)fv->buf, fv->buf_size);
347 }
348
349 ✗ bool lbm_event_run_user_callback(void *arg) {
350 ✗ return event_internal(LBM_EVENT_RUN_USER_CALLBACK, (lbm_uint)arg, 0, 0);
351 }
352
353 ✗ bool lbm_event_unboxed(lbm_value unboxed) {
354 ✗ lbm_uint t = lbm_type_of(unboxed);
355 ✗ if (t == LBM_TYPE_SYMBOL ||
356 ✗ t == LBM_TYPE_I ||
357 ✗ t == LBM_TYPE_U ||
358 t == LBM_TYPE_CHAR) {
359 ✗ if (lbm_event_handler_pid > 0) {
360 ✗ return event_internal(LBM_EVENT_FOR_HANDLER, 0, (lbm_uint)unboxed, 0);
361 }
362 }
363 ✗ return false;
364 }
365
366 6465 bool lbm_event(lbm_flat_value_t *fv) {
367
1/2
✓ Branch 0 taken 6465 times.
✗ Branch 1 not taken.
 6465 if (lbm_event_handler_pid > 0) {
368 6465 return event_internal(LBM_EVENT_FOR_HANDLER, 0, (lbm_uint)fv->buf, fv->buf_size);
369 }
370 ✗ return false;
371 }
372
373 93309903 static bool lbm_event_pop(lbm_event_t *event) {
374 93309903 mutex_lock(&lbm_events_mutex);
375
3/4
✓ Branch 0 taken 93303360 times.
✓ Branch 1 taken 6543 times.
✓ Branch 2 taken 93303360 times.
✗ Branch 3 not taken.
 93309903 if (lbm_events_head == lbm_events_tail && !lbm_events_full) {
376 93303360 mutex_unlock(&lbm_events_mutex);
377 93303360 return false;
378 }
379 6543 *event = lbm_events[lbm_events_tail];
380 6543 lbm_events_tail = (lbm_events_tail + 1) % lbm_events_max;
381 6543 lbm_events_full = false;
382 6543 mutex_unlock(&lbm_events_mutex);
383 6543 return true;
384 }
385
386 ✗ bool lbm_event_queue_is_empty(void) {
387 ✗ mutex_lock(&lbm_events_mutex);
388 ✗ bool empty = false;
389 ✗ if (lbm_events_head == lbm_events_tail && !lbm_events_full) {
390 ✗ empty = true;
391 }
392 ✗ mutex_unlock(&lbm_events_mutex);
393 ✗ return empty;
394 }
395
396 static bool eval_running = false;
397 static volatile bool blocking_extension = false;
398 static mutex_t blocking_extension_mutex;
399 static bool blocking_extension_mutex_initialized = false;
400 static lbm_uint blocking_extension_timeout_us = 0;
401 static bool blocking_extension_timeout = false;
402
403 static bool is_atomic = false;
404
405 /* Process queues */
406 static eval_context_queue_t blocked = {NULL, NULL};
407 static eval_context_queue_t queue = {NULL, NULL};
408
409 /* one mutex for all queue operations */
410 mutex_t qmutex;
411 bool qmutex_initialized = false;
412
413
414 // MODES
415 static volatile bool lbm_verbose = false;
416
417 ✗ void lbm_toggle_verbose(void) {
418 ✗ lbm_verbose = !lbm_verbose;
419 ✗ }
420
421 21504 void lbm_set_verbose(bool verbose) {
422 21504 lbm_verbose = verbose;
423 21504 }
424
425 1064 lbm_cid lbm_get_current_cid(void) {
426
1/2
✓ Branch 0 taken 1064 times.
✗ Branch 1 not taken.
 1064 if (ctx_running)
427 1064 return ctx_running->id;
428 else
429 ✗ return -1;
430 }
431
432 ✗ eval_context_t *lbm_get_current_context(void) {
433 ✗ return ctx_running;
434 }
435
436 /****************************************************/
437 /* Utilities used locally in this file */
438
439 381108 static inline lbm_array_header_t *assume_array(lbm_value a){
440 381108 return (lbm_array_header_t*)lbm_ref_cell(a)->car;
441 }
442
443 4388815 static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember) {
444 #ifdef LBM_ALWAYS_GC
445 lbm_value always_gc_roots[3] = {head, tail, remember};
446 lbm_gc_mark_roots(always_gc_roots,3);
447 gc();
448 #endif
449 4388815 lbm_value res = lbm_heap_state.freelist;
450
2/2
✓ Branch 1 taken 1136 times.
✓ Branch 2 taken 4387679 times.
 4388815 if (lbm_is_symbol_nil(res)) {
451 1136 lbm_value roots[3] = {head, tail, remember};
452 1136 lbm_gc_mark_roots(roots,3);
453 1136 gc();
454 1136 res = lbm_heap_state.freelist;
455
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 1136 times.
 1136 if (lbm_is_symbol_nil(res)) {
456 ✗ error_ctx(ENC_SYM_MERROR);
457 }
458 }
459 4388815 lbm_uint heap_ix = lbm_dec_ptr(res);
460 4388815 lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr;
461 4388815 lbm_heap_state.num_alloc++;
462 4388815 lbm_heap_state.heap[heap_ix].car = head;
463 4388815 lbm_heap_state.heap[heap_ix].cdr = tail;
464 4388815 res = lbm_set_ptr_type(res, LBM_TYPE_CONS);
465 4388815 return res;
466 }
467
468 469422969 static lbm_uint *get_stack_ptr(eval_context_t *ctx, unsigned int n) {
469
1/2
✓ Branch 0 taken 469422969 times.
✗ Branch 1 not taken.
 469422969 if (n <= ctx->K.sp) {
470 469422969 lbm_uint index = ctx->K.sp - n;
471 469422969 return &ctx->K.data[index];
472 }
473 ✗ error_ctx(ENC_SYM_STACK_ERROR);
474 ✗ return 0; // dead code cannot be reached, but C compiler doesn't realise.
475 }
476
477 // pop_stack_ptr is safe when no GC is performed and
478 // the values of the stack will be dropped.
479 21770558 static lbm_uint *pop_stack_ptr(eval_context_t *ctx, unsigned int n) {
480
1/2
✓ Branch 0 taken 21770558 times.
✗ Branch 1 not taken.
 21770558 if (n <= ctx->K.sp) {
481 21770558 ctx->K.sp -= n;
482 21770558 return &ctx->K.data[ctx->K.sp];
483 }
484 ✗ error_ctx(ENC_SYM_STACK_ERROR);
485 ✗ return 0; // dead code cannot be reached, but C compiler doesn't realise.
486 }
487
488 493953969 static inline lbm_uint *stack_reserve(eval_context_t *ctx, unsigned int n) {
489
1/2
✓ Branch 0 taken 493953969 times.
✗ Branch 1 not taken.
 493953969 if (ctx->K.sp + n < ctx->K.size) {
490 493953969 lbm_uint *ptr = &ctx->K.data[ctx->K.sp];
491 493953969 ctx->K.sp += n;
492 493953969 return ptr;
493 }
494 ✗ error_ctx(ENC_SYM_STACK_ERROR);
495 ✗ return 0; // dead code cannot be reached, but C compiler doesn't realise.
496 }
497
498 7196 static void handle_flash_status(lbm_flash_status s) {
499
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 7196 times.
 7196 if ( s == LBM_FLASH_FULL) {
500 ✗ lbm_set_error_reason((char*)lbm_error_str_flash_full);
501 ✗ error_ctx(ENC_SYM_EERROR);
502 }
503
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 7196 times.
 7196 if (s == LBM_FLASH_WRITE_ERROR) {
504 ✗ lbm_set_error_reason((char*)lbm_error_str_flash_error);
505 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
506 }
507 7196 }
508
509 84 static void lift_array_flash(lbm_value flash_cell, bool bytearray, char *data, lbm_uint num_elt) {
510
511 lbm_array_header_t flash_array_header;
512 84 flash_array_header.size = num_elt;
513 84 flash_array_header.data = (lbm_uint*)data;
514 84 lbm_uint flash_array_header_ptr = 0;
515 84 handle_flash_status(lbm_write_const_raw((lbm_uint*)&flash_array_header,
516 sizeof(lbm_array_header_t) / sizeof(lbm_uint),
517 &flash_array_header_ptr));
518 84 handle_flash_status(write_const_car(flash_cell, flash_array_header_ptr));
519
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 28 times.
 84 lbm_uint t = bytearray ? ENC_SYM_ARRAY_TYPE : ENC_SYM_LISPARRAY_TYPE;
520 84 handle_flash_status(write_const_cdr(flash_cell, t));
521 84 }
522
523 119719430 static void get_car_and_cdr(lbm_value a, lbm_value *a_car, lbm_value *a_cdr) {
524
2/2
✓ Branch 1 taken 119401770 times.
✓ Branch 2 taken 317660 times.
 119719430 if (lbm_is_ptr(a)) {
525 119401770 lbm_cons_t *cell = lbm_ref_cell(a);
526 119401770 *a_car = cell->car;
527 119401770 *a_cdr = cell->cdr;
528
1/2
✓ Branch 1 taken 317660 times.
✗ Branch 2 not taken.
 317660 } else if (lbm_is_symbol_nil(a)) {
529 317660 *a_car = *a_cdr = ENC_SYM_NIL;
530 } else {
531 ✗ *a_car = *a_cdr = ENC_SYM_NIL;
532 ✗ error_ctx(ENC_SYM_TERROR);
533 }
534 119719430 }
535
536 /* car cdr caar cadr replacements that are evaluator safe. */
537 114792407 static lbm_value get_car(lbm_value a) {
538
1/2
✓ Branch 1 taken 114792407 times.
✗ Branch 2 not taken.
 114792407 if (lbm_is_ptr(a)) {
539 114792407 lbm_cons_t *cell = lbm_ref_cell(a);
540 114792407 return cell->car;
541 ✗ } else if (lbm_is_symbol_nil(a)) {
542 ✗ return a;
543 }
544 ✗ error_ctx(ENC_SYM_TERROR);
545 ✗ return(ENC_SYM_TERROR);
546 }
547
548 139607711 static lbm_value get_cdr(lbm_value a) {
549
1/2
✓ Branch 1 taken 139607711 times.
✗ Branch 2 not taken.
 139607711 if (lbm_is_ptr(a)) {
550 139607711 lbm_cons_t *cell = lbm_ref_cell(a);
551 139607711 return cell->cdr;
552 ✗ } else if (lbm_is_symbol_nil(a)) {
553 ✗ return a;
554 }
555 ✗ error_ctx(ENC_SYM_TERROR);
556 ✗ return(ENC_SYM_TERROR);
557 }
558
559 27381229 static lbm_value get_cadr(lbm_value a) {
560
1/2
✓ Branch 1 taken 27381229 times.
✗ Branch 2 not taken.
 27381229 if (lbm_is_ptr(a)) {
561 27381229 lbm_cons_t *cell = lbm_ref_cell(a);
562 27381229 lbm_value tmp = cell->cdr;
563
2/2
✓ Branch 1 taken 27370953 times.
✓ Branch 2 taken 10276 times.
 27381229 if (lbm_is_ptr(tmp)) {
564 27370953 return lbm_ref_cell(tmp)->car;
565
1/2
✓ Branch 1 taken 10276 times.
✗ Branch 2 not taken.
 10276 } else if (lbm_is_symbol_nil(tmp)) {
566 10276 return tmp;
567 }
568 ✗ } else if (lbm_is_symbol_nil(a)) {
569 ✗ return a;
570 }
571 ✗ error_ctx(ENC_SYM_TERROR);
572 ✗ return(ENC_SYM_TERROR);
573 }
574
575 11984 static lbm_value allocate_closure(lbm_value params, lbm_value body, lbm_value env) {
576
577 #ifdef LBM_ALWAYS_GC
578 gc();
579 if (lbm_heap_num_free() < 4) {
580 error_ctx(ENC_SYM_MERROR);
581 }
582 #else
583
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 11984 times.
 11984 if (lbm_heap_num_free() < 4) {
584 ✗ gc();
585 ✗ if (lbm_heap_num_free() < 4) {
586 ✗ error_ctx(ENC_SYM_MERROR);
587 }
588 }
589 #endif
590 // The freelist will always contain just plain heap-cells.
591 // So dec_ptr is sufficient.
592 11984 lbm_value res = lbm_heap_state.freelist;
593
1/2
✓ Branch 1 taken 11984 times.
✗ Branch 2 not taken.
 11984 if (lbm_type_of(res) == LBM_TYPE_CONS) {
594 11984 lbm_cons_t *heap = lbm_heap_state.heap;
595 11984 lbm_uint ix = lbm_dec_ptr(res);
596 11984 heap[ix].car = ENC_SYM_CLOSURE;
597 11984 ix = lbm_dec_ptr(heap[ix].cdr);
598 11984 heap[ix].car = params;
599 11984 ix = lbm_dec_ptr(heap[ix].cdr);
600 11984 heap[ix].car = body;
601 11984 ix = lbm_dec_ptr(heap[ix].cdr);
602 11984 heap[ix].car = env;
603 11984 lbm_heap_state.freelist = heap[ix].cdr;
604 11984 heap[ix].cdr = ENC_SYM_NIL;
605 11984 lbm_heap_state.num_alloc+=4;
606 } else {
607 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
608 }
609 11984 return res;
610 }
611
612 // Allocate a binding and attach it to a list (if so desired)
613 60008839 static lbm_value allocate_binding(lbm_value key, lbm_value val, lbm_value the_cdr) {
614 #ifdef LBM_ALWAYS_GC
615 lbm_gc_mark_phase(key);
616 lbm_gc_mark_phase(val);
617 lbm_gc_mark_phase(the_cdr);
618 gc();
619 if (lbm_heap_num_free() < 2) {
620 error_ctx(ENC_SYM_MERROR);
621 }
622 #else
623
2/2
✓ Branch 1 taken 83306 times.
✓ Branch 2 taken 59925533 times.
 60008839 if (lbm_heap_num_free() < 2) {
624 83306 lbm_gc_mark_phase(key);
625 83306 lbm_gc_mark_phase(val);
626 83306 lbm_gc_mark_phase(the_cdr);
627 83306 gc();
628
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 83278 times.
 83306 if (lbm_heap_num_free() < 2) {
629 28 error_ctx(ENC_SYM_MERROR);
630 }
631 }
632 #endif
633 60008811 lbm_cons_t* heap = lbm_heap_state.heap;
634 60008811 lbm_value binding_cell = lbm_heap_state.freelist;
635 60008811 lbm_uint binding_cell_ix = lbm_dec_ptr(binding_cell);
636 60008811 lbm_value list_cell = heap[binding_cell_ix].cdr;
637 60008811 lbm_uint list_cell_ix = lbm_dec_ptr(list_cell);
638 60008811 lbm_heap_state.freelist = heap[list_cell_ix].cdr;
639 60008811 lbm_heap_state.num_alloc += 2;
640 60008811 heap[binding_cell_ix].car = key;
641 60008811 heap[binding_cell_ix].cdr = val;
642 60008811 heap[list_cell_ix].car = binding_cell;
643 60008811 heap[list_cell_ix].cdr = the_cdr;
644 60008811 return list_cell;
645 }
646
647 #define CLO_PARAMS 0
648 #define CLO_BODY 1
649 #define CLO_ENV 2
650 #define LOOP_BINDS 0
651 #define LOOP_COND 1
652 #define LOOP_BODY 2
653
654 // (a b c) -> [a b c]
655 57801985 static lbm_value extract_n(lbm_value curr, lbm_value *res, unsigned int n) {
656
2/2
✓ Branch 0 taken 161160603 times.
✓ Branch 1 taken 57801985 times.
 218962588 for (unsigned int i = 0; i < n; i ++) {
657
2/2
✓ Branch 1 taken 161160575 times.
✓ Branch 2 taken 28 times.
 161160603 if (lbm_is_ptr(curr)) {
658 161160575 lbm_cons_t *cell = lbm_ref_cell(curr);
659 161160575 res[i] = cell->car;
660 161160575 curr = cell->cdr;
661 } else {
662 28 res[i] = ENC_SYM_NIL;
663 }
664 }
665 57801985 return curr; // Rest of list is returned here.
666 }
667
668 73274797 static void call_fundamental(lbm_uint fundamental, lbm_value *args, lbm_uint arg_count, eval_context_t *ctx) {
669 lbm_value res;
670 #ifdef LBM_ALWAYS_GC
671 gc();
672 #endif
673 73274797 res = fundamental_table[fundamental](args, arg_count, ctx);
674
2/2
✓ Branch 1 taken 215974 times.
✓ Branch 2 taken 73058823 times.
 73274797 if (lbm_is_error(res)) {
675
2/2
✓ Branch 1 taken 211382 times.
✓ Branch 2 taken 4592 times.
 215974 if (lbm_is_symbol_merror(res)) {
676 211382 gc();
677 211382 res = fundamental_table[fundamental](args, arg_count, ctx);
678 }
679
2/2
✓ Branch 1 taken 4656 times.
✓ Branch 2 taken 211318 times.
 215974 if (lbm_is_error(res)) {
680 4656 error_at_ctx(res, lbm_enc_sym(FUNDAMENTAL_SYMBOLS_START | fundamental));
681 }
682 }
683 73270141 lbm_stack_drop(&ctx->K, arg_count+1);
684 73270141 ctx->app_cont = true;
685 73270141 ctx->r = res;
686 73270141 }
687
688 28 static void atomic_error(void) {
689 28 is_atomic = false;
690 28 lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
691 28 error_ctx(ENC_SYM_EERROR);
692 ✗ }
693
694 // block_current_ctx blocks a context until it is
695 // woken up externally or a timeout period of time passes.
696 // Blocking while in an atomic block would have bad consequences.
697 3204 static void block_current_ctx(uint32_t state, lbm_uint sleep_us, bool do_cont) {
698
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3204 times.
 3204 if (is_atomic) atomic_error();
699 3204 ctx_running->timestamp = timestamp_us_callback();
700 3204 ctx_running->sleep_us = sleep_us;
701 3204 ctx_running->state = state;
702 3204 ctx_running->app_cont = do_cont;
703 3204 enqueue_ctx(&blocked, ctx_running);
704 3204 ctx_running = NULL;
705 3204 }
706
707 126 lbm_flash_status lbm_write_const_array_padded(uint8_t *data, lbm_uint n, lbm_uint *res) {
708 126 lbm_uint full_words = n / sizeof(lbm_uint);
709 126 lbm_uint n_mod = n % sizeof(lbm_uint);
710
711
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 70 times.
 126 if (n_mod == 0) { // perfect fit.
712 56 return lbm_write_const_raw((lbm_uint*)data, full_words, res);
713 } else {
714 70 lbm_uint last_word = 0;
715 70 memcpy(&last_word, &data[full_words * sizeof(lbm_uint)], n_mod);
716
2/2
✓ Branch 0 taken 14 times.
✓ Branch 1 taken 56 times.
 70 if (full_words >= 1) {
717 14 lbm_flash_status s = lbm_write_const_raw((lbm_uint*)data, full_words, res);
718
1/2
✓ Branch 0 taken 14 times.
✗ Branch 1 not taken.
 14 if ( s == LBM_FLASH_WRITE_OK) {
719 lbm_uint dummy;
720 14 s = lbm_write_const_raw(&last_word, 1, &dummy);
721 }
722 14 return s;
723 } else {
724 56 return lbm_write_const_raw(&last_word, 1, res);
725 }
726 }
727 }
728
729 /****************************************************/
730 /* Error message creation */
731
732 #define ERROR_MESSAGE_BUFFER_SIZE_BYTES 256
733
734 8 void print_environments(char *buf, unsigned int size) {
735
736 8 lbm_value curr_l = ctx_running->curr_env;
737 8 printf_callback("\tCurrent local environment:\n");
738
2/2
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 8 times.
 12 while (lbm_type_of(curr_l) == LBM_TYPE_CONS) {
739 4 lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_l));
740 4 lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_l)));
741 4 printf_callback("\t%s = %s\n", buf, buf+(size/2));
742 4 curr_l = lbm_cdr(curr_l);
743 }
744 8 printf_callback("\n\n");
745 8 printf_callback("\tCurrent global environment:\n");
746 8 lbm_value *glob_env = lbm_get_global_env();
747
748
2/2
✓ Branch 0 taken 256 times.
✓ Branch 1 taken 8 times.
 264 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
749 256 lbm_value curr_g = glob_env[i];;
750
2/2
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 256 times.
 264 while (lbm_type_of(curr_g) == LBM_TYPE_CONS) {
751
752 8 lbm_print_value(buf, (size/2) - 1, lbm_caar(curr_g));
753 8 lbm_print_value(buf + (size/2),size/2, lbm_cdr(lbm_car(curr_g)));
754 8 printf_callback("\t%s = %s\n", buf, buf+(size/2));
755 8 curr_g = lbm_cdr(curr_g);
756 }
757 }
758 8 }
759
760 8 void print_error_message(lbm_value error,
761 bool has_at,
762 lbm_value at,
763 unsigned int row,
764 unsigned int col,
765 lbm_int row0,
766 lbm_int row1,
767 lbm_int cid,
768 char *name) {
769
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 if (!printf_callback) return;
770
771 /* try to allocate a lbm_print_value buffer on the lbm_memory */
772 8 char *buf = lbm_malloc_reserve(ERROR_MESSAGE_BUFFER_SIZE_BYTES);
773
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 if (!buf) {
774 ✗ printf_callback("Error: Not enough free memory to create a human readable error message\n");
775 ✗ return;
776 }
777
778 8 lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, error);
779 8 printf_callback( "*** Error: %s\n", buf);
780
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 if (name) {
781 ✗ printf_callback( "*** ctx: %d \"%s\"\n", cid, name);
782 } else {
783 8 printf_callback( "*** ctx: %d\n", cid);
784 }
785
1/2
✓ Branch 0 taken 8 times.
✗ Branch 1 not taken.
 8 if (has_at) {
786 8 lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, at);
787 8 printf_callback("*** In: %s\n",buf);
788
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 if (lbm_error_has_suspect) {
789 ✗ lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, lbm_error_suspect);
790 ✗ lbm_error_has_suspect = false;
791 ✗ printf_callback("*** At: %s\n", buf);
792 } else {
793 8 lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
794 8 printf_callback("*** After: %s\n",buf);
795 }
796 } else {
797 ✗ lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
798 ✗ printf_callback("*** Near: %s\n",buf);
799 }
800
801 8 printf_callback("\n");
802
803
2/4
✓ Branch 1 taken 8 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
 8 if (lbm_is_symbol(error) &&
804 error == ENC_SYM_RERROR) {
805 ✗ printf_callback("*** Line: %u\n", row);
806 ✗ printf_callback("*** Column: %u\n", col);
807
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 } else if (row0 >= 0) {
808 ✗ if (row1 < 0) printf_callback("*** Starting at row: %d\n", row0);
809 ✗ else printf_callback("*** Between row %d and %d\n", row0, row1);
810 }
811
812 8 printf_callback("\n");
813
814
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
 8 if (ctx_running->error_reason) {
815 ✗ printf_callback("Reason:\n %s\n\n", ctx_running->error_reason);
816 }
817
1/2
✓ Branch 0 taken 8 times.
✗ Branch 1 not taken.
 8 if (lbm_verbose) {
818 8 lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
819 8 printf_callback(" Current intermediate result: %s\n\n", buf);
820
821 8 print_environments(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES);
822 8 printf_callback("\n\n");
823
824 8 printf_callback(" Stack:\n");
825
2/2
✓ Branch 0 taken 184 times.
✓ Branch 1 taken 8 times.
 192 for (unsigned int i = 0; i < ctx_running->K.sp; i ++) {
826 184 lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->K.data[i]);
827 184 printf_callback(" %s\n", buf);
828 }
829 }
830 8 lbm_free(buf);
831 }
832
833 /****************************************************/
834 /* Tokenizing and parsing */
835
836 310014 bool create_string_channel(char *str, lbm_value *res, lbm_value dep) {
837
838 310014 lbm_char_channel_t *chan = NULL;
839 310014 lbm_string_channel_state_t *st = NULL;
840
841 310014 st = (lbm_string_channel_state_t*)lbm_malloc(sizeof(lbm_string_channel_state_t));
842
2/2
✓ Branch 0 taken 1018 times.
✓ Branch 1 taken 308996 times.
 310014 if (st == NULL) {
843 1018 return false;
844 }
845 308996 chan = (lbm_char_channel_t*)lbm_malloc(sizeof(lbm_char_channel_t));
846
2/2
✓ Branch 0 taken 268 times.
✓ Branch 1 taken 308728 times.
 308996 if (chan == NULL) {
847 268 lbm_free(st);
848 268 return false;
849 }
850
851 308728 lbm_create_string_char_channel(st, chan, str);
852 308728 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CHANNEL, (lbm_uint) chan, ENC_SYM_CHANNEL_TYPE);
853
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 308728 times.
 308728 if (cell == ENC_SYM_MERROR) {
854 ✗ lbm_free(st);
855 ✗ lbm_free(chan);
856 ✗ return false;
857 }
858
859 308728 lbm_char_channel_set_dependency(chan, dep);
860
861 308728 *res = cell;
862 308728 return true;
863 }
864
865 21504 bool lift_char_channel(lbm_char_channel_t *chan , lbm_value *res) {
866 21504 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CHANNEL, (lbm_uint) chan, ENC_SYM_CHANNEL_TYPE);
867
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21504 times.
 21504 if (cell == ENC_SYM_MERROR) {
868 ✗ return false;
869 }
870 21504 *res = cell;
871 21504 return true;
872 }
873
874
875 /****************************************************/
876 /* Queue functions */
877
878 695424 static void queue_iterator_nm(eval_context_queue_t *q, ctx_fun f, void *arg1, void *arg2) {
879 eval_context_t *curr;
880 695424 curr = q->first;
881
882
2/2
✓ Branch 0 taken 13326 times.
✓ Branch 1 taken 695424 times.
 708750 while (curr != NULL) {
883 13326 f(curr, arg1, arg2);
884 13326 curr = curr->next;
885 }
886 695424 }
887
888 84 void lbm_running_iterator(ctx_fun f, void *arg1, void *arg2){
889 84 mutex_lock(&qmutex);
890 84 queue_iterator_nm(&queue, f, arg1, arg2);
891 84 mutex_unlock(&qmutex);
892 84 }
893
894 84 void lbm_blocked_iterator(ctx_fun f, void *arg1, void *arg2){
895 84 mutex_lock(&qmutex);
896 84 queue_iterator_nm(&blocked, f, arg1, arg2);
897 84 mutex_unlock(&qmutex);
898 84 }
899
900 91255609 static void enqueue_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {
901
2/2
✓ Branch 0 taken 88251337 times.
✓ Branch 1 taken 3004272 times.
 91255609 if (q->last == NULL) {
902 88251337 ctx->prev = NULL;
903 88251337 ctx->next = NULL;
904 88251337 q->first = ctx;
905 88251337 q->last = ctx;
906 } else {
907 3004272 ctx->prev = q->last;
908 3004272 ctx->next = NULL;
909 3004272 q->last->next = ctx;
910 3004272 q->last = ctx;
911 }
912 91255609 }
913
914 56951 static void enqueue_ctx(eval_context_queue_t *q, eval_context_t *ctx) {
915 56951 mutex_lock(&qmutex);
916 56951 enqueue_ctx_nm(q,ctx);
917 56951 mutex_unlock(&qmutex);
918 56951 }
919
920 17538 static eval_context_t *lookup_ctx_nm(eval_context_queue_t *q, lbm_cid cid) {
921 eval_context_t *curr;
922 17538 curr = q->first;
923
2/2
✓ Branch 0 taken 4199 times.
✓ Branch 1 taken 13339 times.
 17538 while (curr != NULL) {
924
1/2
✓ Branch 0 taken 4199 times.
✗ Branch 1 not taken.
 4199 if (curr->id == cid) {
925 4199 return curr;
926 }
927 ✗ curr = curr->next;
928 }
929 13339 return NULL;
930 }
931
932 3175 static bool drop_ctx_nm(eval_context_queue_t *q, eval_context_t *ctx) {
933
934 3175 bool res = false;
935
2/4
✓ Branch 0 taken 3175 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 3175 times.
 3175 if (q->first == NULL || q->last == NULL) {
936 ✗ if (!(q->last == NULL && q->first == NULL)) {
937 /* error state that should not happen */
938 ✗ return res;
939 }
940 /* Queue is empty */
941 ✗ return res;
942 }
943
944 3175 eval_context_t *curr = q->first;
945
1/2
✓ Branch 0 taken 3175 times.
✗ Branch 1 not taken.
 3175 while (curr) {
946
1/2
✓ Branch 0 taken 3175 times.
✗ Branch 1 not taken.
 3175 if (curr->id == ctx->id) {
947 3175 res = true;
948 3175 eval_context_t *tmp = curr->next;
949
1/2
✓ Branch 0 taken 3175 times.
✗ Branch 1 not taken.
 3175 if (curr->prev == NULL) {
950
2/2
✓ Branch 0 taken 3161 times.
✓ Branch 1 taken 14 times.
 3175 if (curr->next == NULL) {
951 3161 q->last = NULL;
952 3161 q->first = NULL;
953 } else {
954 14 q->first = tmp;
955 14 tmp->prev = NULL;
956 }
957 } else { /* curr->prev != NULL */
958 ✗ if (curr->next == NULL) {
959 ✗ q->last = curr->prev;
960 ✗ q->last->next = NULL;
961 } else {
962 ✗ curr->prev->next = tmp;
963 ✗ tmp->prev = curr->prev;
964 }
965 }
966 3175 break;
967 }
968 ✗ curr = curr->next;
969 }
970 3175 return res;
971 }
972
973 /* End execution of the running context. */
974 22312 static void finish_ctx(void) {
975
976
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22312 times.
 22312 if (!ctx_running) {
977 ✗ return;
978 }
979 /* Drop the continuation stack immediately to free up lbm_memory */
980 22312 lbm_stack_free(&ctx_running->K);
981 22312 ctx_done_callback(ctx_running);
982
983 22312 lbm_free(ctx_running->name); //free name if in LBM_MEM
984 22312 lbm_memory_free((lbm_uint*)ctx_running->error_reason); //free error_reason if in LBM_MEM
985
986 22312 lbm_memory_free((lbm_uint*)ctx_running->mailbox);
987 22312 lbm_memory_free((lbm_uint*)ctx_running);
988 22312 ctx_running = NULL;
989 }
990
991 140 static void context_exists(eval_context_t *ctx, void *cid, void *b) {
992
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 112 times.
 140 if (ctx->id == *(lbm_cid*)cid) {
993 28 *(bool*)b = true;
994 }
995 140 }
996
997 1232 void lbm_set_error_suspect(lbm_value suspect) {
998 1232 lbm_error_suspect = suspect;
999 1232 lbm_error_has_suspect = true;
1000 1232 }
1001
1002 1232 void lbm_set_error_reason(char *error_str) {
1003
1/2
✓ Branch 0 taken 1232 times.
✗ Branch 1 not taken.
 1232 if (ctx_running != NULL) {
1004 1232 ctx_running->error_reason = error_str;
1005 }
1006 1232 }
1007
1008 // Not possible to CONS_WITH_GC in error_ctx_base (potential loop)
1009 8128 static void error_ctx_base(lbm_value err_val, bool has_at, lbm_value at, unsigned int row, unsigned int column) {
1010
1011
2/2
✓ Branch 0 taken 196 times.
✓ Branch 1 taken 7932 times.
 8128 if (ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP) {
1012
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 196 times.
 196 if (lbm_heap_num_free() < 3) {
1013 ✗ gc();
1014 }
1015
1016
1/2
✓ Branch 1 taken 196 times.
✗ Branch 2 not taken.
 196 if (lbm_heap_num_free() >= 3) {
1017 196 lbm_value msg = lbm_cons(err_val, ENC_SYM_NIL);
1018 196 msg = lbm_cons(lbm_enc_i(ctx_running->id), msg);
1019 196 msg = lbm_cons(ENC_SYM_EXIT_ERROR, msg);
1020
1/2
✓ Branch 1 taken 196 times.
✗ Branch 2 not taken.
 196 if (!lbm_is_symbol_merror(msg)) {
1021 196 lbm_find_receiver_and_send(ctx_running->parent, msg);
1022 196 goto error_ctx_base_done;
1023 }
1024 }
1025 }
1026
3/4
✓ Branch 0 taken 7924 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 7924 times.
✗ Branch 3 not taken.
 7932 if ((ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP_UNROLL_RETURN) &&
1027 (err_val != ENC_SYM_FATAL_ERROR)) {
1028 lbm_uint v;
1029
1/2
✓ Branch 0 taken 28476 times.
✗ Branch 1 not taken.
 28476 while (ctx_running->K.sp > 0) {
1030 28476 lbm_pop(&ctx_running->K, &v);
1031
2/2
✓ Branch 0 taken 7924 times.
✓ Branch 1 taken 20552 times.
 28476 if (v == EXCEPTION_HANDLER) {
1032 7924 lbm_value *sptr = get_stack_ptr(ctx_running, 2);
1033 7924 lbm_set_car(sptr[0], ENC_SYM_EXIT_ERROR);
1034 7924 stack_reserve(ctx_running, 1)[0] = EXCEPTION_HANDLER;
1035 7924 ctx_running->app_cont = true;
1036 7924 ctx_running->r = err_val;
1037 7924 longjmp(error_jmp_buf, 1);
1038 }
1039 }
1040 ✗ err_val = ENC_SYM_FATAL_ERROR;
1041 }
1042 8 print_error_message(err_val,
1043 has_at,
1044 at,
1045 row,
1046 column,
1047 8 ctx_running->row0,
1048 8 ctx_running->row1,
1049 8 ctx_running->id,
1050 8 ctx_running->name);
1051 204 error_ctx_base_done:
1052 204 ctx_running->r = err_val;
1053 204 finish_ctx();
1054 204 longjmp(error_jmp_buf, 1);
1055 }
1056
1057 7988 static void error_at_ctx(lbm_value err_val, lbm_value at) {
1058 7988 error_ctx_base(err_val, true, at, 0, 0);
1059 ✗ }
1060
1061 140 static void error_ctx(lbm_value err_val) {
1062 140 error_ctx_base(err_val, false, 0, 0, 0);
1063 ✗ }
1064
1065 ✗ static void read_error_ctx(unsigned int row, unsigned int column) {
1066 ✗ error_ctx_base(ENC_SYM_RERROR, false, 0, row, column);
1067 ✗ }
1068
1069 ✗ void lbm_critical_error(void) {
1070 ✗ longjmp(critical_error_jmp_buf, 1);
1071 }
1072
1073 // successfully finish a context
1074 22108 static void ok_ctx(void) {
1075
2/2
✓ Branch 0 taken 140 times.
✓ Branch 1 taken 21968 times.
 22108 if (ctx_running->flags & EVAL_CPS_CONTEXT_FLAG_TRAP) {
1076 lbm_value msg;
1077
1/4
✗ Branch 3 not taken.
✓ Branch 4 taken 140 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
 140 WITH_GC(msg, lbm_heap_allocate_list_init(3,
1078 ENC_SYM_EXIT_OK,
1079 lbm_enc_i(ctx_running->id),
1080 ctx_running->r));
1081 140 lbm_find_receiver_and_send(ctx_running->parent, msg);
1082 }
1083 22108 finish_ctx();
1084 22108 }
1085
1086 93303360 static eval_context_t *dequeue_ctx_nm(eval_context_queue_t *q) {
1087
2/2
✓ Branch 0 taken 2082248 times.
✓ Branch 1 taken 91221112 times.
 93303360 if (q->last == NULL) {
1088 2082248 return NULL;
1089 }
1090 // q->first should only be NULL if q->last is.
1091 91221112 eval_context_t *res = q->first;
1092
1093
2/2
✓ Branch 0 taken 88219176 times.
✓ Branch 1 taken 3001936 times.
 91221112 if (q->first == q->last) { // One thing in queue
1094 88219176 q->first = NULL;
1095 88219176 q->last = NULL;
1096 } else {
1097 3001936 q->first = q->first->next;
1098 3001936 q->first->prev = NULL;
1099 }
1100 91221112 res->prev = NULL;
1101 91221112 res->next = NULL;
1102 91221112 return res;
1103 }
1104
1105 93303360 static void wake_up_ctxs_nm(void) {
1106 lbm_uint t_now;
1107
1108
1/2
✓ Branch 0 taken 93303360 times.
✗ Branch 1 not taken.
 93303360 if (timestamp_us_callback) {
1109 93303360 t_now = timestamp_us_callback();
1110 } else {
1111 ✗ t_now = 0;
1112 }
1113
1114 93303360 eval_context_queue_t *q = &blocked;
1115 93303360 eval_context_t *curr = q->first;
1116
1117
2/2
✓ Branch 0 taken 3332936 times.
✓ Branch 1 taken 93303360 times.
 96636296 while (curr != NULL) {
1118 lbm_uint t_diff;
1119 3332936 eval_context_t *next = curr->next;
1120
2/2
✓ Branch 0 taken 3101737 times.
✓ Branch 1 taken 231199 times.
 3332936 if (LBM_IS_STATE_WAKE_UP_WAKABLE(curr->state)) {
1121
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3101737 times.
 3101737 if ( curr->timestamp > t_now) {
1122 /* There was an overflow on the counter */
1123 #ifndef LBM64
1124 ✗ t_diff = (0xFFFFFFFF - curr->timestamp) + t_now;
1125 #else
1126 t_diff = (0xFFFFFFFFFFFFFFFF - curr->timestamp) + t_now;
1127 #endif
1128 } else {
1129 3101737 t_diff = t_now - curr->timestamp;
1130 }
1131
1132
2/2
✓ Branch 0 taken 31179 times.
✓ Branch 1 taken 3070558 times.
 3101737 if (t_diff >= curr->sleep_us) {
1133 31179 eval_context_t *wake_ctx = curr;
1134
2/2
✓ Branch 0 taken 31137 times.
✓ Branch 1 taken 42 times.
 31179 if (curr == q->last) {
1135
2/2
✓ Branch 0 taken 2280 times.
✓ Branch 1 taken 28857 times.
 31137 if (curr->prev) {
1136 2280 q->last = curr->prev;
1137 2280 q->last->next = NULL;
1138 } else {
1139 28857 q->first = NULL;
1140 28857 q->last = NULL;
1141 }
1142
1/2
✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
 42 } else if (curr->prev == NULL) {
1143 42 q->first = curr->next;
1144 42 q->first->prev = NULL;
1145 } else {
1146 ✗ curr->prev->next = curr->next;
1147 ✗ if (curr->next) {
1148 ✗ curr->next->prev = curr->prev;
1149 }
1150 }
1151 31179 wake_ctx->next = NULL;
1152 31179 wake_ctx->prev = NULL;
1153
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 31151 times.
 31179 if (LBM_IS_STATE_TIMEOUT(curr->state)) {
1154 28 mailbox_add_mail(wake_ctx, ENC_SYM_TIMEOUT);
1155 28 wake_ctx->r = ENC_SYM_TIMEOUT;
1156 }
1157 31179 wake_ctx->state = LBM_THREAD_STATE_READY;
1158 31179 enqueue_ctx_nm(&queue, wake_ctx);
1159 }
1160 }
1161 3332936 curr = next;
1162 }
1163 93303360 }
1164
1165 31235 static void yield_ctx(lbm_uint sleep_us) {
1166
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 31207 times.
 31235 if (is_atomic) atomic_error();
1167
1/2
✓ Branch 0 taken 31207 times.
✗ Branch 1 not taken.
 31207 if (timestamp_us_callback) {
1168 31207 ctx_running->timestamp = timestamp_us_callback();
1169 31207 ctx_running->sleep_us = sleep_us;
1170 31207 ctx_running->state = LBM_THREAD_STATE_SLEEPING;
1171 } else {
1172 ✗ ctx_running->timestamp = 0;
1173 ✗ ctx_running->sleep_us = 0;
1174 ✗ ctx_running->state = LBM_THREAD_STATE_SLEEPING;
1175 }
1176 31207 ctx_running->r = ENC_SYM_TRUE;
1177 31207 ctx_running->app_cont = true;
1178 31207 enqueue_ctx(&blocked,ctx_running);
1179 31207 ctx_running = NULL;
1180 31207 }
1181
1182 22568 static 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) {
1183
1184
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 22568 times.
 22568 if (!lbm_is_cons(program)) return -1;
1185
1186 22568 eval_context_t *ctx = NULL;
1187 #ifdef LBM_ALWAYS_GC
1188 {
1189 lbm_uint roots[2] = {program, env};
1190 lbm_gc_mark_roots(roots, 2);
1191 gc();
1192 }
1193 #endif
1194 22568 ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
1195
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22568 times.
 22568 if (ctx == NULL) {
1196 ✗ lbm_uint roots[2] = {program, env};
1197 ✗ lbm_gc_mark_roots(roots, 2);
1198 ✗ gc();
1199 ✗ ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
1200 }
1201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22568 times.
 22568 if (ctx == NULL) return -1;
1202 #ifdef LBM_ALWAYS_GC
1203 {
1204 lbm_uint roots[2] = {program, env};
1205 lbm_gc_mark_roots(roots, 2);
1206 gc();
1207 }
1208 #endif
1209
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 22540 times.
 22568 if (!lbm_stack_allocate(&ctx->K, stack_size)) {
1210 28 lbm_uint roots[2] = {program, env};
1211 28 lbm_gc_mark_roots(roots, 2);
1212 28 gc();
1213
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 28 if (!lbm_stack_allocate(&ctx->K, stack_size)) {
1214 28 lbm_memory_free((lbm_uint*)ctx);
1215 28 return -1;
1216 }
1217 }
1218
1219 22540 lbm_value *mailbox = NULL;
1220 #ifdef LBM_ALWAYS_GC
1221 {
1222 lbm_uint roots[2] = {program, env};
1223 lbm_gc_mark_roots(roots, 2);
1224 gc();
1225 }
1226 #endif
1227 22540 mailbox = (lbm_value*)lbm_memory_allocate(EVAL_CPS_DEFAULT_MAILBOX_SIZE);
1228
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22540 times.
 22540 if (mailbox == NULL) {
1229 ✗ lbm_value roots[2] = {program, env};
1230 ✗ lbm_gc_mark_roots(roots,2);
1231 ✗ gc();
1232 ✗ mailbox = (lbm_value *)lbm_memory_allocate(EVAL_CPS_DEFAULT_MAILBOX_SIZE);
1233 }
1234
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 22540 times.
 22540 if (mailbox == NULL) {
1235 ✗ lbm_stack_free(&ctx->K);
1236 ✗ lbm_memory_free((lbm_uint*)ctx);
1237 ✗ return -1;
1238 }
1239
1240 // TODO: Limit names to 19 chars + 1 char for 0? (or something similar).
1241
2/2
✓ Branch 0 taken 140 times.
✓ Branch 1 taken 22400 times.
 22540 if (name) {
1242 140 lbm_uint name_len = strlen(name) + 1;
1243 #ifdef LBM_ALWAYS_GC
1244 {
1245 lbm_uint roots[2] = {program, env};
1246 lbm_gc_mark_roots(roots, 2);
1247 gc();
1248 }
1249 #endif
1250 140 ctx->name = lbm_malloc(name_len);
1251
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 140 times.
 140 if (ctx->name == NULL) {
1252 ✗ lbm_value roots[2] = {program, env};
1253 ✗ lbm_gc_mark_roots(roots, 2);
1254 ✗ gc();
1255 ✗ ctx->name = lbm_malloc(name_len);
1256 }
1257
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 140 times.
 140 if (ctx->name == NULL) {
1258 ✗ lbm_stack_free(&ctx->K);
1259 ✗ lbm_memory_free((lbm_uint*)mailbox);
1260 ✗ lbm_memory_free((lbm_uint*)ctx);
1261 ✗ return -1;
1262 }
1263 140 memcpy(ctx->name, name, name_len);
1264 } else {
1265 22400 ctx->name = NULL;
1266 }
1267
1268 22540 lbm_int cid = lbm_memory_address_to_ix((lbm_uint*)ctx);
1269
1270 22540 ctx->program = lbm_cdr(program);
1271 22540 ctx->curr_exp = lbm_car(program);
1272 22540 ctx->curr_env = env;
1273 22540 ctx->r = ENC_SYM_NIL;
1274 22540 ctx->error_reason = NULL;
1275 22540 ctx->mailbox = mailbox;
1276 22540 ctx->mailbox_size = EVAL_CPS_DEFAULT_MAILBOX_SIZE;
1277 22540 ctx->flags = context_flags;
1278 22540 ctx->num_mail = 0;
1279 22540 ctx->app_cont = false;
1280 22540 ctx->timestamp = 0;
1281 22540 ctx->sleep_us = 0;
1282 22540 ctx->state = LBM_THREAD_STATE_READY;
1283 22540 ctx->prev = NULL;
1284 22540 ctx->next = NULL;
1285
1286 22540 ctx->row0 = -1;
1287 22540 ctx->row1 = -1;
1288
1289 22540 ctx->id = cid;
1290 22540 ctx->parent = parent;
1291
1292
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 22540 times.
 22540 if (!lbm_push(&ctx->K, DONE)) {
1293 ✗ lbm_memory_free((lbm_uint*)ctx->mailbox);
1294 ✗ lbm_stack_free(&ctx->K);
1295 ✗ lbm_memory_free((lbm_uint*)ctx);
1296 ✗ return -1;
1297 }
1298
1299 22540 enqueue_ctx(&queue,ctx);
1300
1301 22540 return ctx->id;
1302 }
1303
1304 21504 lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, lbm_uint stack_size, char *name) {
1305 // Creates a parentless context.
1306 21504 return lbm_create_ctx_parent(program,
1307 env,
1308 stack_size,
1309 -1,
1310 EVAL_CPS_CONTEXT_FLAG_NOTHING,
1311 name);
1312 }
1313
1314 140 bool lbm_mailbox_change_size(eval_context_t *ctx, lbm_uint new_size) {
1315
1316 140 lbm_value *mailbox = NULL;
1317 #ifdef LBM_ALWAYS_GC
1318 gc();
1319 #endif
1320 140 mailbox = (lbm_value*)lbm_memory_allocate(new_size);
1321
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 112 times.
 140 if (mailbox == NULL) {
1322 28 gc();
1323 28 mailbox = (lbm_value *)lbm_memory_allocate(new_size);
1324 }
1325
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 112 times.
 140 if (mailbox == NULL) {
1326 28 return false;
1327 }
1328
1329
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
 112 for (lbm_uint i = 0; i < ctx->num_mail; i ++ ) {
1330 ✗ mailbox[i] = ctx->mailbox[i];
1331 }
1332 112 lbm_memory_free(ctx->mailbox);
1333 112 ctx->mailbox = mailbox;
1334 112 ctx->mailbox_size = (uint32_t)new_size;
1335 112 return true;
1336 }
1337
1338 6132 static void mailbox_remove_mail(eval_context_t *ctx, lbm_uint ix) {
1339
1340
2/2
✓ Branch 0 taken 15959 times.
✓ Branch 1 taken 6132 times.
 22091 for (lbm_uint i = ix; i < ctx->num_mail-1; i ++) {
1341 15959 ctx->mailbox[i] = ctx->mailbox[i+1];
1342 }
1343 6132 ctx->num_mail --;
1344 6132 }
1345
1346 7028 static bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail) {
1347
1348
2/2
✓ Branch 0 taken 588 times.
✓ Branch 1 taken 6440 times.
 7028 if (ctx->num_mail >= ctx->mailbox_size) {
1349 588 mailbox_remove_mail(ctx, 0);
1350 }
1351
1352 7028 ctx->mailbox[ctx->num_mail] = mail;
1353 7028 ctx->num_mail ++;
1354 7028 return true;
1355 }
1356
1357 /**************************************************************
1358 * Advance execution to the next expression in the program.
1359 * Assumes programs are not malformed. Apply_eval_program
1360 * ensures programs are lists ending in nil. The reader
1361 * ensures this likewise.
1362 *************************************************************/
1363 64623 static void advance_ctx(eval_context_t *ctx) {
1364
2/2
✓ Branch 0 taken 42598 times.
✓ Branch 1 taken 22025 times.
 64623 if (ctx->program) { // fast not-nil check, assume cons if not nil.
1365 42598 stack_reserve(ctx, 1)[0] = DONE;
1366 42598 lbm_cons_t *cell = lbm_ref_cell(ctx->program);
1367 42598 ctx->curr_exp = cell->car;
1368 42598 ctx->program = cell->cdr;
1369 42598 ctx->curr_env = ENC_SYM_NIL;
1370 } else {
1371
1/2
✓ Branch 0 taken 22025 times.
✗ Branch 1 not taken.
 22025 if (ctx_running == ctx) { // This should always be the case because of odd historical reasons.
1372 22025 ok_ctx();
1373 }
1374 }
1375 64623 }
1376
1377 84 bool lbm_unblock_ctx(lbm_cid cid, lbm_flat_value_t *fv) {
1378 84 return event_internal(LBM_EVENT_UNBLOCK_CTX, (lbm_uint)cid, (lbm_uint)fv->buf, fv->buf_size);
1379 }
1380
1381 28 bool lbm_unblock_ctx_r(lbm_cid cid) {
1382 28 mutex_lock(&blocking_extension_mutex);
1383 28 bool r = false;
1384 28 eval_context_t *found = NULL;
1385 28 mutex_lock(&qmutex);
1386 28 found = lookup_ctx_nm(&blocked, cid);
1387
2/4
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
✗ Branch 3 not taken.
 28 if (found && (LBM_IS_STATE_UNBLOCKABLE(found->state))) {
1388 28 drop_ctx_nm(&blocked,found);
1389 28 found->state = LBM_THREAD_STATE_READY;
1390 28 enqueue_ctx_nm(&queue,found);
1391 28 r = true;
1392 }
1393 28 mutex_unlock(&qmutex);
1394 28 mutex_unlock(&blocking_extension_mutex);
1395 28 return r;
1396 }
1397
1398 // unblock unboxed is also safe for rmbr:ed things.
1399 ✗ bool lbm_unblock_ctx_unboxed(lbm_cid cid, lbm_value unboxed) {
1400 ✗ mutex_lock(&blocking_extension_mutex);
1401 ✗ bool r = false;
1402 ✗ eval_context_t *found = NULL;
1403 ✗ mutex_lock(&qmutex);
1404 ✗ found = lookup_ctx_nm(&blocked, cid);
1405 ✗ if (found && (LBM_IS_STATE_UNBLOCKABLE(found->state))) {
1406 ✗ drop_ctx_nm(&blocked,found);
1407 ✗ found->r = unboxed;
1408 ✗ if (lbm_is_error(unboxed)) {
1409 ✗ get_stack_ptr(found, 1)[0] = TERMINATE; // replace TOS
1410 ✗ found->app_cont = true;
1411 }
1412 ✗ found->state = LBM_THREAD_STATE_READY;
1413 ✗ enqueue_ctx_nm(&queue,found);
1414 ✗ r = true;
1415 }
1416 ✗ mutex_unlock(&qmutex);
1417 ✗ mutex_unlock(&blocking_extension_mutex);
1418 ✗ return r;
1419 }
1420
1421 112 static bool lbm_block_ctx_base(bool timeout, float t_s) {
1422 112 mutex_lock(&blocking_extension_mutex);
1423 112 blocking_extension = true;
1424
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
 112 if (timeout) {
1425 ✗ blocking_extension_timeout_us = S_TO_US(t_s);
1426 ✗ blocking_extension_timeout = true;
1427 } else {
1428 112 blocking_extension_timeout = false;
1429 }
1430 112 return true;
1431 }
1432
1433 ✗ void lbm_block_ctx_from_extension_timeout(float s) {
1434 ✗ lbm_block_ctx_base(true, s);
1435 ✗ }
1436
1437 112 void lbm_block_ctx_from_extension(void) {
1438 112 lbm_block_ctx_base(false, 0);
1439 112 }
1440
1441 // todo: May need to pop rmbrs from stack, if present.
1442 // Suspect that the letting the discard cont run is really not a problem.
1443 // Either way will be quite confusing what happens to allocated things when undoing block.
1444 ✗ void lbm_undo_block_ctx_from_extension(void) {
1445 ✗ blocking_extension = false;
1446 ✗ blocking_extension_timeout_us = 0;
1447 ✗ blocking_extension_timeout = false;
1448 ✗ mutex_unlock(&blocking_extension_mutex);
1449 ✗ }
1450
1451 #define LBM_RECEIVER_FOUND 0
1452 #define LBM_RECEIVER_FOUND_MAIL_DELIVERY_FAILED -1
1453 #define LBM_RECEIVER_NOT_FOUND -2
1454
1455 10127 int lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) {
1456 10127 mutex_lock(&qmutex);
1457 10127 eval_context_t *found = NULL;
1458
1459 10127 found = lookup_ctx_nm(&blocked, cid);
1460
2/2
✓ Branch 0 taken 2994 times.
✓ Branch 1 taken 7133 times.
 10127 if (found) {
1461
2/2
✓ Branch 0 taken 2980 times.
✓ Branch 1 taken 14 times.
 2994 if (LBM_IS_STATE_RECV(found->state)) { // only if unblock receivers here.
1462 2980 drop_ctx_nm(&blocked,found);
1463 2980 found->state = LBM_THREAD_STATE_READY;
1464 2980 enqueue_ctx_nm(&queue,found);
1465 }
1466
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 2994 times.
 2994 if (!mailbox_add_mail(found, msg)) {
1467 ✗ mutex_unlock(&qmutex);
1468 ✗ return LBM_RECEIVER_FOUND_MAIL_DELIVERY_FAILED;
1469 }
1470 2994 mutex_unlock(&qmutex);
1471 2994 return LBM_RECEIVER_FOUND;
1472 }
1473
1474 7133 found = lookup_ctx_nm(&queue, cid);
1475
2/2
✓ Branch 0 taken 1010 times.
✓ Branch 1 taken 6123 times.
 7133 if (found) {
1476
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 1010 times.
 1010 if (!mailbox_add_mail(found, msg)) {
1477 ✗ mutex_unlock(&qmutex);
1478 ✗ return LBM_RECEIVER_FOUND_MAIL_DELIVERY_FAILED;
1479 }
1480 1010 mutex_unlock(&qmutex);
1481 1010 return LBM_RECEIVER_FOUND;
1482 }
1483
1484 /* check the current context */
1485
3/4
✓ Branch 0 taken 6123 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 2996 times.
✓ Branch 3 taken 3127 times.
 6123 if (ctx_running && ctx_running->id == cid) {
1486
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 2996 times.
 2996 if (!mailbox_add_mail(ctx_running, msg)) {
1487 ✗ mutex_unlock(&qmutex);
1488 ✗ return LBM_RECEIVER_FOUND_MAIL_DELIVERY_FAILED;
1489 }
1490 2996 mutex_unlock(&qmutex);
1491 2996 return LBM_RECEIVER_FOUND;
1492 }
1493 3127 mutex_unlock(&qmutex);
1494 3127 return LBM_RECEIVER_NOT_FOUND;
1495 }
1496
1497 // a match binder looks like (? x) or (? _) for example.
1498 // It is a list of two elements where the first is a ? and the second is a symbol.
1499 23336 static inline lbm_value get_match_binder_variable(lbm_value exp) {
1500 23336 lbm_value var = ENC_SYM_NIL; // 0 false
1501
2/2
✓ Branch 1 taken 15552 times.
✓ Branch 2 taken 7784 times.
 23336 if (lbm_is_cons(exp)) {
1502 15552 lbm_cons_t *e_cell = lbm_ref_cell(exp);
1503 15552 lbm_value bt = e_cell->car;
1504
3/4
✓ Branch 0 taken 8804 times.
✓ Branch 1 taken 6748 times.
✓ Branch 3 taken 8804 times.
✗ Branch 4 not taken.
 15552 if (bt == ENC_SYM_MATCH_ANY && lbm_is_cons(e_cell->cdr)) {
1505 8804 var = lbm_ref_cell(e_cell->cdr)->car;
1506 }
1507 }
1508 23336 return var;
1509 }
1510
1511 /* Pattern matching is currently implemented as a recursive
1512 function and make use of stack relative to the size of
1513 expressions that are being matched. */
1514 23336 static bool match(lbm_value p, lbm_value e, lbm_value *env, bool *gc) {
1515 23336 bool r = false;
1516 23336 lbm_value var = get_match_binder_variable(p);
1517
2/2
✓ Branch 0 taken 8804 times.
✓ Branch 1 taken 14532 times.
 23336 if (var) {
1518 8804 lbm_value binding = lbm_cons(var, e);
1519
2/2
✓ Branch 1 taken 8792 times.
✓ Branch 2 taken 12 times.
 8804 if (lbm_is_cons(binding)) {
1520 8792 lbm_value new_env = lbm_cons(binding, *env);
1521
1/2
✓ Branch 1 taken 8792 times.
✗ Branch 2 not taken.
 8792 if (lbm_is_cons(new_env)) {
1522 8792 *env = new_env;
1523 8792 r = true;
1524 }
1525 }
1526 8804 *gc = !r;
1527
2/2
✓ Branch 1 taken 6104 times.
✓ Branch 2 taken 8428 times.
 14532 } else if (lbm_is_symbol(p)) {
1528
2/2
✓ Branch 0 taken 1344 times.
✓ Branch 1 taken 4760 times.
 6104 if (p == ENC_SYM_DONTCARE) r = true;
1529 4760 else r = (p == e);
1530
4/4
✓ Branch 1 taken 6748 times.
✓ Branch 2 taken 1680 times.
✓ Branch 4 taken 5628 times.
✓ Branch 5 taken 1120 times.
 8428 } else if (lbm_is_cons(p) && lbm_is_cons(e) ) {
1531 5628 lbm_cons_t *p_cell = lbm_ref_cell(p);
1532 5628 lbm_cons_t *e_cell = lbm_ref_cell(e);
1533 5628 lbm_value headp = p_cell->car;
1534 5628 lbm_value tailp = p_cell->cdr;
1535 5628 lbm_value heade = e_cell->car;
1536 5628 lbm_value taile = e_cell->cdr;
1537 5628 r = match(headp, heade, env, gc);
1538
4/4
✓ Branch 0 taken 4984 times.
✓ Branch 1 taken 644 times.
✓ Branch 3 taken 4844 times.
✓ Branch 4 taken 140 times.
 5628 r = r && match (tailp, taile, env, gc);
1539 } else {
1540 2800 r = struct_eq(p, e);
1541 }
1542 23336 return r;
1543 }
1544
1545 // Find match is not very picky about syntax.
1546 // A completely malformed recv form is most likely to
1547 // just return no_match.
1548 5546 static int find_match(lbm_value plist, lbm_value *earr, lbm_uint num, lbm_value *e, lbm_value *env) {
1549
1550 // A pattern list is a list of pattern, expression lists.
1551 // ( (p1 e1) (p2 e2) ... (pn en))
1552 5546 lbm_value curr_p = plist;
1553 5546 int n = 0;
1554 5546 bool gc = false;
1555
2/2
✓ Branch 0 taken 6060 times.
✓ Branch 1 taken 2 times.
 6062 for (int i = 0; i < (int)num; i ++ ) {
1556 6060 lbm_value curr_e = earr[i];
1557
2/2
✓ Branch 1 taken 6788 times.
✓ Branch 2 taken 516 times.
 7304 while (!lbm_is_symbol_nil(curr_p)) {
1558 6788 lbm_value me = get_car(curr_p);
1559
2/2
✓ Branch 2 taken 5544 times.
✓ Branch 3 taken 1244 times.
 6788 if (match(get_car(me), curr_e, env, &gc)) {
1560
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5544 times.
 5544 if (gc) return FM_NEED_GC;
1561 5544 *e = get_cadr(me);
1562
1563
1/2
✗ Branch 3 not taken.
✓ Branch 4 taken 5544 times.
 5544 if (!lbm_is_symbol_nil(get_cadr(get_cdr(me)))) {
1564 ✗ return FM_PATTERN_ERROR;
1565 }
1566 5544 return n;
1567 }
1568 1244 curr_p = get_cdr(curr_p);
1569 }
1570 516 curr_p = plist; /* search all patterns against next exp */
1571 516 n ++;
1572 }
1573
1574 2 return FM_NO_MATCH;
1575 }
1576
1577 /****************************************************/
1578 /* Garbage collection */
1579
1580 360786 static void mark_context(eval_context_t *ctx, void *arg1, void *arg2) {
1581 (void) arg1;
1582 (void) arg2;
1583 360786 lbm_value roots[3] = {ctx->curr_exp, ctx->program, ctx->r };
1584 360786 lbm_gc_mark_env(ctx->curr_env);
1585 360786 lbm_gc_mark_roots(roots, 3);
1586 360786 lbm_gc_mark_roots(ctx->mailbox, ctx->num_mail);
1587 360786 lbm_gc_mark_aux(ctx->K.data, ctx->K.sp);
1588 360786 }
1589
1590 347628 static int gc(void) {
1591
2/2
✓ Branch 0 taken 347600 times.
✓ Branch 1 taken 28 times.
 347628 if (ctx_running) {
1592 347600 ctx_running->state = ctx_running->state | LBM_THREAD_STATE_GC_BIT;
1593 }
1594
1595 347628 gc_requested = false;
1596 347628 lbm_gc_state_inc();
1597
1598 // The freelist should generally be NIL when GC runs.
1599 347628 lbm_nil_freelist();
1600 347628 lbm_value *env = lbm_get_global_env();
1601
2/2
✓ Branch 0 taken 11124096 times.
✓ Branch 1 taken 347628 times.
 11471724 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
1602 11124096 lbm_gc_mark_env(env[i]);
1603 }
1604
1605 347628 mutex_lock(&qmutex); // Lock the queues.
1606 // Any concurrent messing with the queues
1607 // while doing GC cannot possibly be good.
1608 347628 queue_iterator_nm(&queue, mark_context, NULL, NULL);
1609 347628 queue_iterator_nm(&blocked, mark_context, NULL, NULL);
1610
1611
2/2
✓ Branch 0 taken 347600 times.
✓ Branch 1 taken 28 times.
 347628 if (ctx_running) {
1612 347600 mark_context(ctx_running, NULL, NULL);
1613 }
1614 347628 mutex_unlock(&qmutex);
1615
1616 #ifdef VISUALIZE_HEAP
1617 heap_vis_gen_image();
1618 #endif
1619
1620 347628 int r = lbm_gc_sweep_phase();
1621 347628 lbm_heap_new_freelist_length();
1622
1623
2/2
✓ Branch 0 taken 347600 times.
✓ Branch 1 taken 28 times.
 347628 if (ctx_running) {
1624 347600 ctx_running->state = ctx_running->state & ~LBM_THREAD_STATE_GC_BIT;
1625 }
1626 347628 return r;
1627 }
1628
1629 13812 int lbm_perform_gc(void) {
1630 13812 return gc();
1631 }
1632
1633 /****************************************************/
1634 /* Evaluation functions */
1635
1636
1637 224401179 static void eval_symbol(eval_context_t *ctx) {
1638 224401179 lbm_uint s = lbm_dec_sym(ctx->curr_exp);
1639
2/2
✓ Branch 0 taken 145525530 times.
✓ Branch 1 taken 78875649 times.
 224401179 if (s >= RUNTIME_SYMBOLS_START) {
1640 145525530 lbm_value res = ENC_SYM_NIL;
1641
4/4
✓ Branch 1 taken 26044664 times.
✓ Branch 2 taken 119480866 times.
✓ Branch 3 taken 26039820 times.
✓ Branch 4 taken 4844 times.
 171570194 if (lbm_env_lookup_b(&res, ctx->curr_exp, ctx->curr_env) ||
1642 26044664 lbm_global_env_lookup(&res, ctx->curr_exp)) {
1643 145520686 ctx->r = res;
1644 145520686 ctx->app_cont = true;
1645 145520686 return;
1646 }
1647 // Dynamic load attempt
1648 // Only symbols of kind RUNTIME can be dynamically loaded.
1649 4844 const char *sym_str = lbm_get_name_by_symbol(s);
1650 4844 const char *code_str = NULL;
1651
2/2
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 4788 times.
 4844 if (!dynamic_load_callback(sym_str, &code_str)) {
1652 56 error_at_ctx(ENC_SYM_NOT_FOUND, ctx->curr_exp);
1653 }
1654 4788 lbm_value *sptr = stack_reserve(ctx, 3);
1655 4788 sptr[0] = ctx->curr_exp;
1656 4788 sptr[1] = ctx->curr_env;
1657 4788 sptr[2] = RESUME;
1658
1659 4788 lbm_value chan = ENC_SYM_NIL;
1660 #ifdef LBM_ALWAYS_GC
1661 gc();
1662 #endif
1663
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 4788 times.
 4788 if (!create_string_channel((char *)code_str, &chan, ENC_SYM_NIL)) {
1664 ✗ gc();
1665 ✗ if (!create_string_channel((char *)code_str, &chan, ENC_SYM_NIL)) {
1666 ✗ error_ctx(ENC_SYM_MERROR);
1667 }
1668 }
1669
1670 // Here, chan has either been assigned or execution has terminated.
1671
1672 lbm_value loader;
1673
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 4788 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
 4788 WITH_GC_RMBR_1(loader, lbm_heap_allocate_list_init(2,
1674 ENC_SYM_READ,
1675 chan), chan);
1676 lbm_value evaluator;
1677
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 4788 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
 4788 WITH_GC_RMBR_1(evaluator, lbm_heap_allocate_list_init(2,
1678 ENC_SYM_EVAL,
1679 loader), loader);
1680 4788 ctx->curr_exp = evaluator;
1681 4788 ctx->curr_env = ENC_SYM_NIL; // dynamics should be evaluable in empty local env
1682 } else {
1683 //special symbols and extensions can be handled the same way.
1684 78875649 ctx->r = ctx->curr_exp;
1685 78875649 ctx->app_cont = true;
1686 }
1687 }
1688
1689 // (quote e) => e
1690 4659807 static void eval_quote(eval_context_t *ctx) {
1691 4659807 ctx->r = get_cadr(ctx->curr_exp);
1692 4659807 ctx->app_cont = true;
1693 4659807 }
1694
1695 // a => a
1696 96774157 static void eval_selfevaluating(eval_context_t *ctx) {
1697 96774157 ctx->r = ctx->curr_exp;
1698 96774157 ctx->app_cont = true;
1699 96774157 }
1700
1701 // (progn e1 ... en)
1702 14309592 static void eval_progn(eval_context_t *ctx) {
1703 14309592 lbm_value exps = get_cdr(ctx->curr_exp);
1704
1705
2/2
✓ Branch 1 taken 14309564 times.
✓ Branch 2 taken 28 times.
 14309592 if (lbm_is_cons(exps)) {
1706 14309564 lbm_cons_t *cell = lbm_ref_cell(exps); // already checked that it's cons.
1707 14309564 ctx->curr_exp = cell->car;
1708
2/2
✓ Branch 1 taken 11507408 times.
✓ Branch 2 taken 2802156 times.
 14309564 if (lbm_is_cons(cell->cdr)) { // malformed progn not ending in nil is tolerated
1709 11507408 lbm_uint *sptr = stack_reserve(ctx, 4);
1710 11507408 sptr[0] = ctx->curr_env; // env to restore between expressions in progn
1711 11507408 sptr[1] = lbm_enc_u(0); // Has env been copied (needed for progn local bindings)
1712 11507408 sptr[2] = cell->cdr; // Requirement: sptr[2] is a cons.
1713 11507408 sptr[3] = PROGN_REST;
1714 }
1715
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 28 } else if (lbm_is_symbol_nil(exps)) { // Empty progn is nil
1716 28 ctx->r = ENC_SYM_NIL;
1717 28 ctx->app_cont = true;
1718 } else {
1719 ✗ error_ctx(ENC_SYM_EERROR);
1720 }
1721 14309592 }
1722
1723 // (atomic e1 ... en)
1724 252 static void eval_atomic(eval_context_t *ctx) {
1725
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 252 times.
 252 if (is_atomic) atomic_error();
1726 252 stack_reserve(ctx, 1)[0] = EXIT_ATOMIC;
1727 252 is_atomic = true;
1728 252 eval_progn(ctx);
1729 252 }
1730
1731 /* (call-cc (lambda (k) .... )) */
1732 364 static void eval_callcc(eval_context_t *ctx) {
1733 lbm_value cont_array;
1734 364 lbm_uint *sptr0 = stack_reserve(ctx, 1);
1735
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 364 times.
 364 sptr0[0] = is_atomic ? ENC_SYM_TRUE : ENC_SYM_NIL;
1736 #ifdef LBM_ALWAYS_GC
1737 gc();
1738 #endif
1739
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 364 times.
 364 if (!lbm_heap_allocate_lisp_array(&cont_array, ctx->K.sp)) {
1740 ✗ gc();
1741 ✗ lbm_heap_allocate_lisp_array(&cont_array, ctx->K.sp);
1742 }
1743
1/2
✓ Branch 1 taken 364 times.
✗ Branch 2 not taken.
 364 if (lbm_is_ptr(cont_array)) {
1744 364 lbm_array_header_t *arr = assume_array(cont_array);
1745 364 memcpy(arr->data, ctx->K.data, ctx->K.sp * sizeof(lbm_uint));
1746 // The stored stack contains the is_atomic flag.
1747 // This flag is overwritten in the following execution path.
1748
1749 364 lbm_value acont = cons_with_gc(ENC_SYM_CONT, cont_array, ENC_SYM_NIL);
1750 364 lbm_value arg_list = cons_with_gc(acont, ENC_SYM_NIL, ENC_SYM_NIL);
1751 // Go directly into application evaluation without passing go
1752 364 lbm_uint *sptr = stack_reserve(ctx, 2);
1753 364 sptr0[0] = ctx->curr_env;
1754 364 sptr[0] = arg_list;
1755 364 sptr[1] = APPLICATION_START;
1756 364 ctx->curr_exp = get_cadr(ctx->curr_exp);
1757 } else {
1758 // failed to create continuation array.
1759 ✗ error_ctx(ENC_SYM_MERROR);
1760 }
1761 364 }
1762
1763 // (define sym exp)
1764 #define KEY 1
1765 #define VAL 2
1766 4267340 static void eval_define(eval_context_t *ctx) {
1767 lbm_value parts[3];
1768 4267340 lbm_value rest = extract_n(ctx->curr_exp, parts, 3);
1769 4267340 lbm_uint *sptr = stack_reserve(ctx, 2);
1770
2/4
✓ Branch 1 taken 4267340 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 4267340 times.
✗ Branch 5 not taken.
 4267340 if (lbm_is_symbol(parts[KEY]) && lbm_is_symbol_nil(rest)) {
1771 4267340 lbm_uint sym_val = lbm_dec_sym(parts[KEY]);
1772 4267340 sptr[0] = parts[KEY];
1773
1/2
✓ Branch 0 taken 4267340 times.
✗ Branch 1 not taken.
 4267340 if (sym_val >= RUNTIME_SYMBOLS_START) {
1774 4267340 sptr[1] = SET_GLOBAL_ENV;
1775
2/2
✓ Branch 0 taken 14 times.
✓ Branch 1 taken 4267326 times.
 4267340 if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST) {
1776 14 stack_reserve(ctx, 1)[0] = MOVE_VAL_TO_FLASH_DISPATCH;
1777 }
1778 4267340 ctx->curr_exp = parts[VAL];
1779 4267340 return;
1780 }
1781 }
1782 ✗ error_at_ctx(ENC_SYM_EERROR, ctx->curr_exp);
1783 }
1784
1785
1786 /* Eval lambda is cheating, a lot! It does this
1787 for performance reasons. The cheats are that
1788 1. When closure is created, a reference to the local env
1789 in which the lambda was evaluated is added to the closure.
1790 Ideally it should have created a list of free variables in the function
1791 and then looked up the values of these creating a new environment.
1792 2. The global env is considered global constant. As there is no copying
1793 of environment bindings into the closure, undefine may break closures.
1794
1795 Correct closure creation is a lot more expensive than what happens here.
1796 However, one can try to write programs in such a way that closures are created
1797 seldomly. If one does that the space-usage benefits of "correct" closures
1798 may outweigh the performance gain of "incorrect" ones.
1799
1800 some obscure programs such as test_setq_local_closure.lisp does not
1801 work properly due to this cheating.
1802 */
1803 // (lambda param-list body-exp) -> (closure param-list body-exp env)
1804 11984 static void eval_lambda(eval_context_t *ctx) {
1805 lbm_value vals[3];
1806 11984 extract_n(ctx->curr_exp, vals, 3);
1807 11984 ctx->r = allocate_closure(vals[1],vals[2], ctx->curr_env);
1808 #ifdef CLEAN_UP_CLOSURES
1809 lbm_uint sym_id = 0;
1810 if (clean_cl_env_symbol) {
1811 lbm_value tail = cons_with_gc(ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
1812 lbm_value app = cons_with_gc(clean_cl_env_symbol, tail, tail);
1813 ctx->curr_exp = app;
1814 } else if (lbm_get_symbol_by_name("clean-cl-env", &sym_id)) {
1815 clean_cl_env_symbol = lbm_enc_sym(sym_id);
1816 lbm_value tail = cons_with_gc(ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
1817 lbm_value app = cons_with_gc(clean_cl_env_symbol, tail, tail);
1818 ctx->curr_exp = app;
1819 } else {
1820 ctx->app_cont = true;
1821 }
1822 #else
1823 11984 ctx->app_cont = true;
1824 #endif
1825 11984 }
1826
1827 // (if cond-expr then-expr else-expr)
1828 21761100 static void eval_if(eval_context_t *ctx) {
1829 21761100 lbm_value cdr = get_cdr(ctx->curr_exp);
1830 21761100 lbm_value *sptr = stack_reserve(ctx, 3);
1831 21761100 sptr[0] = get_cdr(cdr);
1832 21761100 sptr[1] = ctx->curr_env;
1833 21761100 sptr[2] = IF;
1834 21761100 ctx->curr_exp = get_car(cdr);
1835 21761100 }
1836
1837 // (cond (cond-expr-1 expr-1)
1838 // ...
1839 // (cond-expr-N expr-N))
1840 1316 static void eval_cond(eval_context_t *ctx) {
1841 lbm_value cond1[2];
1842 1316 lbm_value rest_conds = extract_n(ctx->curr_exp, cond1, 2);
1843
1844 // end recursion at (cond )
1845
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 1288 times.
 1316 if (lbm_is_symbol_nil(cond1[1])) {
1846 28 ctx->r = ENC_SYM_NIL;
1847 28 ctx->app_cont = true;
1848 } else {
1849 // Cond is one of the few places where a bit of syntax checking takes place at runtime..
1850 // Maybe dont bother?
1851 1288 lbm_uint len = lbm_list_length(cond1[1]);
1852
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1288 times.
 1288 if (len != 2) {
1853 ✗ lbm_set_error_reason("Incorrect syntax in cond");
1854 ✗ error_ctx(ENC_SYM_EERROR);
1855 }
1856 lbm_value cond_expr[2];
1857 1288 extract_n(cond1[1], cond_expr, 2);
1858 lbm_value rest;
1859
1/4
✗ Branch 3 not taken.
✓ Branch 4 taken 1288 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
 1288 WITH_GC(rest, lbm_heap_allocate_list_init(2,
1860 cond_expr[1], // Then branch
1861 cons_with_gc(ENC_SYM_COND, rest_conds , ENC_SYM_NIL)));
1862 1288 lbm_value *sptr = stack_reserve(ctx, 3);
1863 1288 sptr[0] = rest;
1864 1288 sptr[1] = ctx->curr_env;
1865 1288 sptr[2] = IF;
1866 1288 ctx->curr_exp = cond_expr[0]; //condition;
1867 }
1868 1316 }
1869
1870 11364 static void eval_app_cont(eval_context_t *ctx) {
1871 11364 lbm_stack_drop(&ctx->K, 1);
1872 11364 ctx->app_cont = true;
1873 11364 }
1874
1875 // Create a named location in an environment to later receive a value.
1876 40969534 static binding_location_status create_binding_location_internal(lbm_value key, lbm_value *env) {
1877
2/2
✓ Branch 1 taken 26935440 times.
✓ Branch 2 taken 14034094 times.
 40969534 if (lbm_type_of(key) == LBM_TYPE_SYMBOL) { // default case
1878
4/4
✓ Branch 0 taken 24132054 times.
✓ Branch 1 taken 2803386 times.
✓ Branch 2 taken 2806722 times.
✓ Branch 3 taken 21325332 times.
 26935440 if (key == ENC_SYM_NIL || key == ENC_SYM_DONTCARE) return BL_OK;
1879 lbm_value binding;
1880 lbm_value new_env_tmp;
1881 21325332 binding = lbm_cons(key, ENC_SYM_PLACEHOLDER);
1882 21325332 new_env_tmp = lbm_cons(binding, *env);
1883
4/4
✓ Branch 1 taken 21314458 times.
✓ Branch 2 taken 10874 times.
✓ Branch 4 taken 10782 times.
✓ Branch 5 taken 21303676 times.
 21325332 if (lbm_is_symbol(binding) || lbm_is_symbol(new_env_tmp)) {
1884 21656 return BL_NO_MEMORY;
1885 }
1886 21303676 *env = new_env_tmp;
1887
1/2
✓ Branch 1 taken 14034094 times.
✗ Branch 2 not taken.
 14034094 } else if (lbm_is_cons(key)) { // deconstruct case
1888 14034094 int r = create_binding_location_internal(get_car(key), env);
1889
2/2
✓ Branch 0 taken 14027470 times.
✓ Branch 1 taken 6624 times.
 14034094 if (r == BL_OK) {
1890 14027470 r = create_binding_location_internal(get_cdr(key), env);
1891 }
1892 14034094 return r;
1893 }
1894 21303676 return BL_OK;
1895 }
1896
1897 12886314 static void create_binding_location(lbm_value key, lbm_value *env) {
1898
1899 12886314 lbm_value env_tmp = *env;
1900 #ifdef LBM_ALWAYS_GC
1901 lbm_gc_mark_phase(env_tmp);
1902 gc();
1903 #endif
1904 12886314 binding_location_status r = create_binding_location_internal(key, &env_tmp);
1905
2/2
✓ Branch 0 taken 12864658 times.
✓ Branch 1 taken 21656 times.
 12886314 if (r != BL_OK) {
1906
1/2
✓ Branch 0 taken 21656 times.
✗ Branch 1 not taken.
 21656 if (r == BL_NO_MEMORY) {
1907 21656 env_tmp = *env;
1908 21656 lbm_gc_mark_phase(env_tmp);
1909 21656 gc();
1910 21656 r = create_binding_location_internal(key, &env_tmp);
1911 }
1912
1/4
✓ Branch 0 taken 21656 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 21656 switch(r) {
1913 21656 case BL_OK:
1914 21656 break;
1915 ✗ case BL_NO_MEMORY:
1916 ✗ error_ctx(ENC_SYM_MERROR);
1917 ✗ break;
1918 ✗ case BL_INCORRECT_KEY:
1919 ✗ error_ctx(ENC_SYM_TERROR);
1920 ✗ break;
1921 }
1922 12864658 }
1923 12886314 *env = env_tmp;
1924 12886314 }
1925
1926 12128844 static void let_bind_values_eval(lbm_value binds, lbm_value exp, lbm_value env, eval_context_t *ctx) {
1927
1/2
✓ Branch 1 taken 12128844 times.
✗ Branch 2 not taken.
 12128844 if (lbm_is_cons(binds)) {
1928 // Preallocate binding locations.
1929 12128844 lbm_value curr = binds;
1930
2/2
✓ Branch 1 taken 12242748 times.
✓ Branch 2 taken 12128844 times.
 24371592 while (lbm_is_cons(curr)) {
1931 12242748 lbm_value new_env_tmp = env;
1932 12242748 lbm_cons_t *cell = lbm_ref_cell(curr); // already checked that cons.
1933 12242748 lbm_value car_curr = cell->car;
1934 12242748 lbm_value cdr_curr = cell->cdr;
1935 12242748 lbm_value key = get_car(car_curr);
1936 12242748 create_binding_location(key, &new_env_tmp);
1937 12242748 env = new_env_tmp;
1938 12242748 curr = cdr_curr;
1939 }
1940
1941 12128844 lbm_cons_t *cell = lbm_ref_cell(binds); // already checked that cons.
1942 12128844 lbm_value car_binds = cell->car;
1943 12128844 lbm_value cdr_binds = cell->cdr;
1944 lbm_value key_val[2];
1945 12128844 extract_n(car_binds, key_val, 2);
1946
1947 12128844 lbm_uint *sptr = stack_reserve(ctx, 5);
1948 12128844 sptr[0] = exp;
1949 12128844 sptr[1] = cdr_binds;
1950 12128844 sptr[2] = env;
1951 12128844 sptr[3] = key_val[0];
1952 12128844 sptr[4] = BIND_TO_KEY_REST;
1953 12128844 ctx->curr_exp = key_val[1];
1954 12128844 ctx->curr_env = env;
1955 } else {
1956 ✗ ctx->curr_exp = exp;
1957 }
1958 12128844 }
1959
1960 // (var x (...)) - local binding inside of an progn
1961 // var has to take, place root-level nesting within progn.
1962 // (progn ... (var a 10) ...) OK!
1963 // (progn ... (something (var a 10)) ... ) NOT OK!
1964 /* progn stack
1965 sp-4 : env
1966 sp-3 : 0
1967 sp-2 : rest
1968 sp-1 : PROGN_REST
1969 */
1970 643566 static void eval_var(eval_context_t *ctx) {
1971
1/2
✓ Branch 0 taken 643566 times.
✗ Branch 1 not taken.
 643566 if (ctx->K.sp >= 4) { // Possibly in progn
1972 643566 lbm_value sv = ctx->K.data[ctx->K.sp - 1];
1973
2/4
✓ Branch 0 taken 643566 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 643566 times.
✗ Branch 3 not taken.
 643566 if (IS_CONTINUATION(sv) && (sv == PROGN_REST)) {
1974 643566 lbm_uint sp = ctx->K.sp;
1975 643566 uint32_t is_copied = lbm_dec_as_u32(ctx->K.data[sp-3]);
1976
2/2
✓ Branch 0 taken 631918 times.
✓ Branch 1 taken 11648 times.
 643566 if (is_copied == 0) {
1977 lbm_value env;
1978
3/4
✓ Branch 2 taken 376 times.
✓ Branch 3 taken 631542 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 376 times.
 631918 WITH_GC(env, lbm_env_copy_spine(ctx->K.data[sp-4]));
1979 631918 ctx->K.data[sp-3] = lbm_enc_u(1);
1980 631918 ctx->K.data[sp-4] = env;
1981 }
1982 643566 lbm_value new_env = ctx->K.data[sp-4];
1983 643566 lbm_value args = get_cdr(ctx->curr_exp);
1984 643566 lbm_value key = get_car(args);
1985
1986 643566 create_binding_location(key, &new_env);
1987
1988 643566 ctx->K.data[sp-4] = new_env;
1989
1990 643566 lbm_value v_exp = get_cadr(args);
1991 643566 lbm_value *sptr = stack_reserve(ctx, 3);
1992 643566 sptr[0] = new_env;
1993 643566 sptr[1] = key;
1994 643566 sptr[2] = PROGN_VAR;
1995 // Activating the new environment before the evaluation of the value to be bound.
1996 // This would normally shadow the existing value, but create_binding_location sets
1997 // the binding to be $placeholder, which is ignored when looking up the value.
1998 // The way closures work, the var-variable needs to be in scope during val
1999 // evaluation for a recursive closure to be possible.
2000 643566 ctx->curr_env = new_env;
2001 643566 ctx->curr_exp = v_exp;
2002 643566 return;
2003 }
2004 }
2005 ✗ lbm_set_error_reason((char*)lbm_error_str_var_outside_progn);
2006 ✗ error_ctx(ENC_SYM_EERROR);
2007 }
2008
2009 // (setq x (...)) - same as (set 'x (...)) or (setvar 'x (...))
2010 // does not error when given incorrect number of arguments.
2011 1775494 static void eval_setq(eval_context_t *ctx) {
2012 lbm_value parts[3];
2013 1775494 extract_n(ctx->curr_exp, parts, 3);
2014 1775494 lbm_value *sptr = stack_reserve(ctx, 3);
2015 1775494 sptr[0] = ctx->curr_env;
2016 1775494 sptr[1] = parts[1];
2017 1775494 sptr[2] = SETQ;
2018 1775494 ctx->curr_exp = parts[2];
2019 1775494 }
2020
2021 364 static void eval_move_to_flash(eval_context_t *ctx) {
2022 364 lbm_value args = get_cdr(ctx->curr_exp);
2023 364 lbm_value *sptr = stack_reserve(ctx,2);
2024 364 sptr[0] = args;
2025 364 sptr[1] = MOVE_TO_FLASH;
2026 364 ctx->app_cont = true;
2027 364 }
2028
2029 // (loop list-of-local-bindings
2030 // condition-exp
2031 // body-exp)
2032 280 static void eval_loop(eval_context_t *ctx) {
2033 280 lbm_value env = ctx->curr_env;
2034 lbm_value parts[3];
2035 280 extract_n(get_cdr(ctx->curr_exp), parts, 3);
2036 280 lbm_value *sptr = stack_reserve(ctx, 3);
2037 280 sptr[0] = parts[LOOP_BODY];
2038 280 sptr[1] = parts[LOOP_COND];
2039 280 sptr[2] = LOOP_CONDITION;
2040 280 let_bind_values_eval(parts[LOOP_BINDS], parts[LOOP_COND], env, ctx);
2041 280 }
2042
2043 /* (trap expression)
2044 *
2045 * suggested use:
2046 * (match (trap expression)
2047 * ((exit-error (? err)) (error-handler err))
2048 * ((exit-ok (? v)) (value-handler v)))
2049 */
2050 8092 static void eval_trap(eval_context_t *ctx) {
2051
2052 8092 lbm_value expr = get_cadr(ctx->curr_exp);
2053 lbm_value retval;
2054
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 8092 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 8092 WITH_GC(retval, lbm_heap_allocate_list(2));
2055 8092 lbm_set_car(retval, ENC_SYM_EXIT_OK); // Assume things will go well.
2056 8092 lbm_uint *sptr = stack_reserve(ctx,3);
2057 8092 sptr[0] = retval;
2058 8092 sptr[1] = ctx->flags;
2059 8092 sptr[2] = EXCEPTION_HANDLER;
2060 8092 ctx->flags |= EVAL_CPS_CONTEXT_FLAG_TRAP_UNROLL_RETURN;
2061 8092 ctx->curr_exp = expr;
2062 8092 }
2063
2064 // (let list-of-binding s
2065 // body-exp)
2066 12128564 static void eval_let(eval_context_t *ctx) {
2067 12128564 lbm_value env = ctx->curr_env;
2068 lbm_value parts[3];
2069 12128564 extract_n(ctx->curr_exp, parts, 3);
2070 12128564 let_bind_values_eval(parts[1], parts[2], env, ctx);
2071 12128564 }
2072
2073 // (and exp0 ... expN)
2074 1981980 static void eval_and(eval_context_t *ctx) {
2075 1981980 lbm_value rest = get_cdr(ctx->curr_exp);
2076
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 1981952 times.
 1981980 if (lbm_is_symbol_nil(rest)) {
2077 28 ctx->app_cont = true;
2078 28 ctx->r = ENC_SYM_TRUE;
2079 } else {
2080 1981952 lbm_value *sptr = stack_reserve(ctx, 3);
2081 1981952 sptr[0] = ctx->curr_env;
2082 1981952 sptr[1] = get_cdr(rest);
2083 1981952 sptr[2] = AND;
2084 1981952 ctx->curr_exp = get_car(rest);
2085 }
2086 1981980 }
2087
2088 // (or exp0 ... expN)
2089 7224 static void eval_or(eval_context_t *ctx) {
2090 7224 lbm_value rest = get_cdr(ctx->curr_exp);
2091
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 7196 times.
 7224 if (lbm_is_symbol_nil(rest)) {
2092 28 ctx->app_cont = true;
2093 28 ctx->r = ENC_SYM_NIL;
2094 } else {
2095 7196 lbm_value *sptr = stack_reserve(ctx, 3);
2096 7196 sptr[0] = ctx->curr_env;
2097 7196 sptr[1] = get_cdr(rest);
2098 7196 sptr[2] = OR;
2099 7196 ctx->curr_exp = get_car(rest);
2100 }
2101 7224 }
2102
2103 // Pattern matching
2104 // format:
2105 // (match e (pattern body)
2106 // (pattern body)
2107 // ... )
2108 //
2109 // There can be an optional pattern guard:
2110 // (match e (pattern guard body)
2111 // ... )
2112 // a guard is a boolean expression.
2113 // Guards make match, pattern matching more complicated
2114 // than the recv pattern matching and requires staged execution
2115 // via the continuation system rather than a while loop over a list.
2116 3052 static void eval_match(eval_context_t *ctx) {
2117
2118 3052 lbm_value rest = get_cdr(ctx->curr_exp);
2119
1/2
✓ Branch 1 taken 3052 times.
✗ Branch 2 not taken.
 3052 if (lbm_is_cons(rest)) {
2120 3052 lbm_cons_t *cell = lbm_ref_cell(rest);
2121 3052 lbm_value cdr_rest = cell->cdr;
2122 3052 ctx->curr_exp = cell->car;
2123 3052 lbm_value *sptr = stack_reserve(ctx, 3);
2124 3052 sptr[0] = cdr_rest;
2125 3052 sptr[1] = ctx->curr_env;
2126 3052 sptr[2] = MATCH;
2127 } else {
2128 // syntax error to not include at least one pattern
2129 ✗ error_ctx(ENC_SYM_EERROR);
2130 }
2131 3052 }
2132
2133 8636 static void receive_base(eval_context_t *ctx, lbm_value pats, float timeout_time, bool timeout) {
2134
2/2
✓ Branch 0 taken 3090 times.
✓ Branch 1 taken 5546 times.
 8636 if (ctx->num_mail == 0) {
2135
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 3062 times.
 3090 if (timeout) {
2136 28 block_current_ctx(LBM_THREAD_STATE_RECV_TO, S_TO_US(timeout_time), false);
2137 } else {
2138 3062 block_current_ctx(LBM_THREAD_STATE_RECV_BL,0,false);
2139 }
2140 } else {
2141 5546 lbm_value *msgs = ctx->mailbox;
2142 5546 lbm_uint num = ctx->num_mail;
2143
2144
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 5546 times.
 5546 if (lbm_is_symbol_nil(pats)) {
2145 /* A receive statement without any patterns */
2146 ✗ ctx->app_cont = true;
2147 ✗ ctx->r = ENC_SYM_NIL;
2148 } else {
2149 /* The common case */
2150 lbm_value e;
2151 5546 lbm_value new_env = ctx->curr_env;
2152 #ifdef LBM_ALWAYS_GC
2153 lbm_gc_mark_phase(pats); // Needed in recv-to case
2154 gc();
2155 #endif
2156 5546 int n = find_match(pats, msgs, num, &e, &new_env);
2157
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5546 times.
 5546 if (n == FM_NEED_GC) {
2158 ✗ lbm_gc_mark_phase(pats); // Needed in recv-to case
2159 ✗ gc();
2160 ✗ new_env = ctx->curr_env;
2161 ✗ n = find_match(pats, msgs, num, &e, &new_env);
2162 ✗ if (n == FM_NEED_GC) {
2163 ✗ error_ctx(ENC_SYM_MERROR);
2164 }
2165 }
2166
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5546 times.
 5546 if (n == FM_PATTERN_ERROR) {
2167 ✗ lbm_set_error_reason("Incorrect pattern format for recv");
2168 ✗ error_at_ctx(ENC_SYM_EERROR,pats);
2169
2/2
✓ Branch 0 taken 5544 times.
✓ Branch 1 taken 2 times.
 5546 } else if (n >= 0 ) { /* Match */
2170 5544 mailbox_remove_mail(ctx, (lbm_uint)n);
2171 5544 ctx->curr_env = new_env;
2172 5544 ctx->curr_exp = e;
2173 } else { /* No match go back to sleep */
2174 2 ctx->r = ENC_SYM_NO_MATCH;
2175
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
 2 if (timeout) {
2176 ✗ block_current_ctx(LBM_THREAD_STATE_RECV_TO,S_TO_US(timeout_time),false);
2177 } else {
2178 2 block_current_ctx(LBM_THREAD_STATE_RECV_BL, 0,false);
2179 }
2180 }
2181 }
2182 }
2183 8636 return;
2184 }
2185
2186 // Receive-timeout
2187 // (recv-to timeout (pattern expr)
2188 // (pattern expr))
2189 84 static void eval_receive_timeout(eval_context_t *ctx) {
2190
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 84 times.
 84 if (is_atomic) atomic_error();
2191 84 lbm_value timeout_val = get_cadr(ctx->curr_exp);
2192 84 lbm_value *sptr = stack_reserve(ctx, 2);
2193 84 sptr[0] = get_cdr(get_cdr(ctx->curr_exp));
2194 84 sptr[1] = RECV_TO;
2195 84 ctx->curr_exp = timeout_val;
2196 84 }
2197
2198 // Receive
2199 // (recv (pattern expr)
2200 // (pattern expr))
2201 8552 static void eval_receive(eval_context_t *ctx) {
2202
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 8552 times.
 8552 if (is_atomic) atomic_error();
2203 8552 lbm_value pats = get_cdr(ctx->curr_exp);
2204 8552 receive_base(ctx, pats, 0, false);
2205 8552 }
2206
2207 /*********************************************************/
2208 /* Continuation functions */
2209
2210 // cont_set_global_env:
2211 //
2212 // s[sp-1] = Key-symbol
2213 //
2214 // ctx->r = Value
2215 4267844 static void cont_set_global_env(eval_context_t *ctx){
2216
2217 lbm_value key;
2218 4267844 lbm_value val = ctx->r;
2219
2220 4267844 lbm_pop(&ctx->K, &key);
2221 4267844 lbm_uint dec_key = lbm_dec_sym(key);
2222 4267844 lbm_uint ix_key = dec_key & GLOBAL_ENV_MASK;
2223 4267844 lbm_value *global_env = lbm_get_global_env();
2224 4267844 lbm_uint orig_env = global_env[ix_key];
2225 lbm_value new_env;
2226 // A key is a symbol and should not need to be remembered.
2227
3/4
✓ Branch 2 taken 2230 times.
✓ Branch 3 taken 4265614 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 2230 times.
 4267844 WITH_GC(new_env, lbm_env_set(orig_env,key,val));
2228
2229 4267844 global_env[ix_key] = new_env;
2230 4267844 ctx->r = val;
2231
2232 4267844 ctx->app_cont = true;
2233
2234 4267844 return;
2235 }
2236
2237 // cont_resume:
2238 //
2239 // s[sp-2] = Expression
2240 // s[sp-1] = Environment
2241 //
2242 // ctx->r = Irrelevant.
2243 4788 static void cont_resume(eval_context_t *ctx) {
2244 4788 lbm_pop_2(&ctx->K, &ctx->curr_env, &ctx->curr_exp);
2245 4788 }
2246
2247 // cont_progn_rest:
2248 //
2249 // s[sp-3] = Environment to evaluate each expression in.
2250 // s[sp-2] = Flag indicating if env has been copied.
2251 // s[sp-1] = list of expressions to evaluate.
2252 //
2253 // ctx->r = Result of last evaluated expression.
2254 13861452 static void cont_progn_rest(eval_context_t *ctx) {
2255 13861452 lbm_value *sptr = get_stack_ptr(ctx, 3);
2256
2257 13861452 lbm_value env = sptr[0];
2258 // eval_progn and cont_progn_rest both ensure that sptr[2] is a list
2259 // whenever cont_progn_rest is called.
2260
2261 13861452 lbm_cons_t *rest_cell = lbm_ref_cell(sptr[2]);
2262 13861452 lbm_value rest_cdr = rest_cell->cdr;
2263 13861452 ctx->curr_exp = rest_cell->car;;
2264 13861452 ctx->curr_env = env;
2265
2/2
✓ Branch 1 taken 2354307 times.
✓ Branch 2 taken 11507145 times.
 13861452 if (lbm_is_cons(rest_cdr)) {
2266 2354307 sptr[2] = rest_cdr; // Requirement: rest_cdr is a cons
2267 2354307 stack_reserve(ctx, 1)[0] = PROGN_REST;
2268 } else {
2269 // Nothing is pushed to stack for final element in progn. (tail-call req)
2270 11507145 lbm_stack_drop(&ctx->K, 3);
2271 }
2272 13861452 }
2273
2274 84 static void cont_wait(eval_context_t *ctx) {
2275
2276 lbm_value cid_val;
2277 84 lbm_pop(&ctx->K, &cid_val);
2278 84 lbm_cid cid = (lbm_cid)lbm_dec_i(cid_val);
2279
2280 84 bool exists = false;
2281
2282 84 lbm_blocked_iterator(context_exists, &cid, &exists);
2283 84 lbm_running_iterator(context_exists, &cid, &exists);
2284
2285
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 84 times.
 84 if (ctx_running->id == cid) {
2286 ✗ exists = true;
2287 }
2288
2289
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 56 times.
 84 if (exists) {
2290 28 lbm_value *sptr = stack_reserve(ctx, 2);
2291 28 sptr[0] = lbm_enc_i(cid);
2292 28 sptr[1] = WAIT;
2293 28 ctx->r = ENC_SYM_TRUE;
2294 28 ctx->app_cont = true;
2295 28 yield_ctx(50000);
2296 } else {
2297 56 ctx->r = ENC_SYM_TRUE;
2298 56 ctx->app_cont = true;
2299 }
2300 84 }
2301
2302 1775788 static lbm_value perform_setvar(lbm_value key, lbm_value val, lbm_value env) {
2303
2304 1775788 lbm_uint s = lbm_dec_sym(key);
2305
2/2
✓ Branch 0 taken 1775760 times.
✓ Branch 1 taken 28 times.
 1775788 if (s >= RUNTIME_SYMBOLS_START) {
2306 1775760 lbm_value new_env = lbm_env_modify_binding(env, key, val);
2307
3/4
✓ Branch 1 taken 841372 times.
✓ Branch 2 taken 934388 times.
✓ Branch 3 taken 841372 times.
✗ Branch 4 not taken.
 1775760 if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
2308 841372 lbm_uint ix_key = lbm_dec_sym(key) & GLOBAL_ENV_MASK;
2309 841372 lbm_value *glob_env = lbm_get_global_env();
2310 841372 new_env = lbm_env_modify_binding(glob_env[ix_key], key, val);
2311 841372 glob_env[ix_key] = new_env;
2312 }
2313
3/4
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 1775732 times.
✓ Branch 3 taken 28 times.
✗ Branch 4 not taken.
 1775760 if (lbm_is_symbol(new_env) && new_env == ENC_SYM_NOT_FOUND) {
2314 28 lbm_set_error_reason((char*)lbm_error_str_variable_not_bound);
2315 28 error_at_ctx(ENC_SYM_NOT_FOUND, key);
2316 }
2317 1775732 return val;
2318 }
2319 28 error_at_ctx(ENC_SYM_EERROR, ENC_SYM_SETVAR);
2320 ✗ return ENC_SYM_NIL; // unreachable
2321 }
2322
2323 420 static void apply_setvar(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2324
4/4
✓ Branch 0 taken 364 times.
✓ Branch 1 taken 56 times.
✓ Branch 3 taken 308 times.
✓ Branch 4 taken 56 times.
 420 if (nargs == 2 && lbm_is_symbol(args[0])) {
2325 lbm_value res;
2326
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 308 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 308 WITH_GC(res, perform_setvar(args[0], args[1], ctx->curr_env));
2327 308 ctx->r = args[1];
2328 308 lbm_stack_drop(&ctx->K, nargs+1);
2329 308 ctx->app_cont = true;
2330 } else {
2331
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 56 times.
 112 if (nargs == 2) lbm_set_error_reason((char*)lbm_error_str_incorrect_arg);
2332 56 else lbm_set_error_reason((char*)lbm_error_str_num_args);
2333 112 error_at_ctx(ENC_SYM_EERROR, ENC_SYM_SETVAR);
2334 }
2335 308 }
2336
2337
2338 #define READING_EXPRESSION ((0 << LBM_VAL_SHIFT) | LBM_TYPE_U)
2339 #define READING_PROGRAM ((1 << LBM_VAL_SHIFT) | LBM_TYPE_U)
2340 #define READING_PROGRAM_INCREMENTALLY ((2 << LBM_VAL_SHIFT) | LBM_TYPE_U)
2341
2342 330260 static void apply_read_base(lbm_value *args, lbm_uint nargs, eval_context_t *ctx, bool program, bool incremental) {
2343
2/2
✓ Branch 0 taken 330232 times.
✓ Branch 1 taken 28 times.
 330260 if (nargs == 1) {
2344 330232 lbm_value chan = ENC_SYM_NIL;
2345
2/2
✓ Branch 1 taken 303940 times.
✓ Branch 2 taken 26292 times.
 330232 if (lbm_type_of_functional(args[0]) == LBM_TYPE_ARRAY) {
2346 #ifdef LBM_ALWAYS_GC
2347 gc();
2348 #endif
2349
2/2
✓ Branch 2 taken 1286 times.
✓ Branch 3 taken 302654 times.
 303940 if (!create_string_channel(lbm_dec_str(args[0]), &chan, args[0])) {
2350 1286 gc();
2351
1/2
✗ Branch 2 not taken.
✓ Branch 3 taken 1286 times.
 1286 if (!create_string_channel(lbm_dec_str(args[0]), &chan, args[0])) {
2352 ✗ error_ctx(ENC_SYM_MERROR);
2353 }
2354 }
2355
1/2
✓ Branch 1 taken 26292 times.
✗ Branch 2 not taken.
 26292 } else if (lbm_type_of(args[0]) == LBM_TYPE_CHANNEL) {
2356 26292 chan = args[0];
2357 // Streaming transfers can freeze the evaluator if the stream is cut while
2358 // the reader is reading inside of an atomic block.
2359 // It is generally not advisable to read in an atomic block but now it is also
2360 // enforced in the case where it can cause problems.
2361
3/4
✓ Branch 2 taken 10752 times.
✓ Branch 3 taken 15540 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 10752 times.
 26292 if (lbm_channel_may_block(lbm_dec_channel(chan)) && is_atomic) {
2362 ✗ lbm_set_error_reason((char*)lbm_error_str_forbidden_in_atomic);
2363 ✗ is_atomic = false;
2364 ✗ error_ctx(ENC_SYM_EERROR);
2365 }
2366 } else {
2367 ✗ error_ctx(ENC_SYM_EERROR);
2368 }
2369 330232 lbm_value *sptr = get_stack_ptr(ctx, 2);
2370
2371 // If we are inside a reader, its settings are stored.
2372 330232 sptr[0] = lbm_enc_u(ctx->flags); // flags stored.
2373 330232 sptr[1] = chan;
2374 330232 lbm_value *rptr = stack_reserve(ctx,2);
2375
3/4
✓ Branch 0 taken 297052 times.
✓ Branch 1 taken 33180 times.
✓ Branch 2 taken 297052 times.
✗ Branch 3 not taken.
 330232 if (!program && !incremental) {
2376 297052 rptr[0] = READING_EXPRESSION;
2377
3/4
✓ Branch 0 taken 33180 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 11144 times.
✓ Branch 3 taken 22036 times.
 33180 } else if (program && !incremental) {
2378 11144 rptr[0] = READING_PROGRAM;
2379
2/4
✓ Branch 0 taken 22036 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 22036 times.
✗ Branch 3 not taken.
 22036 } else if (program && incremental) {
2380 22036 rptr[0] = READING_PROGRAM_INCREMENTALLY;
2381 } // the last combo is illegal
2382 330232 rptr[1] = READ_DONE;
2383
2384 // Each reader starts in a fresh situation
2385 330232 ctx->flags &= ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK;
2386 330232 ctx->r = ENC_SYM_NIL; // set r to a known state.
2387
2388
2/2
✓ Branch 0 taken 33180 times.
✓ Branch 1 taken 297052 times.
 330232 if (program) {
2389
2/2
✓ Branch 0 taken 22036 times.
✓ Branch 1 taken 11144 times.
 33180 if (incremental) {
2390 22036 ctx->flags |= EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ;
2391 22036 lbm_value *rptr1 = stack_reserve(ctx,3);
2392 22036 rptr1[0] = chan;
2393 22036 rptr1[1] = ctx->curr_env;
2394 22036 rptr1[2] = READ_EVAL_CONTINUE;
2395 } else {
2396 11144 ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ;
2397 11144 lbm_value *rptr1 = stack_reserve(ctx,4);
2398 11144 rptr1[0] = ENC_SYM_NIL;
2399 11144 rptr1[1] = ENC_SYM_NIL;
2400 11144 rptr1[2] = chan;
2401 11144 rptr1[3] = READ_APPEND_CONTINUE;
2402 }
2403 }
2404 330232 rptr = stack_reserve(ctx,3); // reuse of variable rptr
2405 330232 rptr[0] = chan;
2406 330232 rptr[1] = lbm_enc_u(1);
2407 330232 rptr[2] = READ_NEXT_TOKEN;
2408 330232 ctx->app_cont = true;
2409 } else {
2410 28 lbm_set_error_reason((char*)lbm_error_str_num_args);
2411 28 error_ctx(ENC_SYM_EERROR);
2412 }
2413 330232 }
2414
2415 11172 static void apply_read_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2416 11172 apply_read_base(args,nargs,ctx,true,false);
2417 11144 }
2418
2419 22036 static void apply_read_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2420 22036 apply_read_base(args,nargs,ctx,true,true);
2421 22036 }
2422
2423 297052 static void apply_read(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2424 297052 apply_read_base(args,nargs,ctx,false,false);
2425 297052 }
2426
2427 1064 static void apply_spawn_base(lbm_value *args, lbm_uint nargs, eval_context_t *ctx, uint32_t context_flags) {
2428
2429 1064 lbm_uint stack_size = EVAL_CPS_DEFAULT_STACK_SIZE;
2430 1064 lbm_uint closure_pos = 0;
2431 1064 char *name = NULL;
2432 // allowed arguments:
2433 // (spawn opt-name opt-stack-size closure arg1 ... argN)
2434
2435
3/4
✓ Branch 0 taken 1064 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 840 times.
✓ Branch 3 taken 224 times.
 2128 if (nargs >= 1 &&
2436 1064 lbm_is_closure(args[0])) {
2437 840 closure_pos = 0;
2438
3/4
✓ Branch 0 taken 224 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 84 times.
✓ Branch 3 taken 140 times.
 448 } else if (nargs >= 2 &&
2439
1/2
✓ Branch 1 taken 84 times.
✗ Branch 2 not taken.
 308 lbm_is_number(args[0]) &&
2440 84 lbm_is_closure(args[1])) {
2441 84 stack_size = lbm_dec_as_u32(args[0]);
2442 84 closure_pos = 1;
2443
2/4
✓ Branch 0 taken 140 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
✗ Branch 3 not taken.
 280 } else if (nargs >= 2 &&
2444
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
 280 lbm_is_array_r(args[0]) &&
2445 140 lbm_is_closure(args[1])) {
2446 ✗ name = lbm_dec_str(args[0]);
2447 ✗ closure_pos = 1;
2448
2/4
✓ Branch 0 taken 140 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
✗ Branch 3 not taken.
 280 } else if (nargs >= 3 &&
2449
1/2
✓ Branch 1 taken 140 times.
✗ Branch 2 not taken.
 280 lbm_is_array_r(args[0]) &&
2450
1/2
✓ Branch 1 taken 140 times.
✗ Branch 2 not taken.
 280 lbm_is_number(args[1]) &&
2451 140 lbm_is_closure(args[2])) {
2452 140 stack_size = lbm_dec_as_u32(args[1]);
2453 140 closure_pos = 2;
2454 140 name = lbm_dec_str(args[0]);
2455 } else {
2456 ✗ if (context_flags & EVAL_CPS_CONTEXT_FLAG_TRAP)
2457 ✗ error_at_ctx(ENC_SYM_TERROR,ENC_SYM_SPAWN_TRAP);
2458 else
2459 ✗ error_at_ctx(ENC_SYM_TERROR,ENC_SYM_SPAWN);
2460 }
2461
2462 lbm_value cl[3];
2463 1064 extract_n(get_cdr(args[closure_pos]), cl, 3);
2464 1064 lbm_value curr_param = cl[CLO_PARAMS];
2465 1064 lbm_value clo_env = cl[CLO_ENV];
2466 1064 lbm_uint i = closure_pos + 1;
2467
3/4
✓ Branch 1 taken 756 times.
✓ Branch 2 taken 1064 times.
✓ Branch 3 taken 756 times.
✗ Branch 4 not taken.
 1820 while (lbm_is_cons(curr_param) && i <= nargs) {
2468 756 lbm_value entry = cons_with_gc(get_car(curr_param), args[i], clo_env);
2469 756 lbm_value aug_env = cons_with_gc(entry, clo_env,ENC_SYM_NIL);
2470 756 clo_env = aug_env;
2471 756 curr_param = get_cdr(curr_param);
2472 756 i ++;
2473 }
2474
2475 1064 lbm_stack_drop(&ctx->K, nargs+1);
2476
2477 1064 lbm_value program = cons_with_gc(cl[CLO_BODY], ENC_SYM_NIL, clo_env);
2478
2479 1064 lbm_cid cid = lbm_create_ctx_parent(program,
2480 clo_env,
2481 stack_size,
2482 lbm_get_current_cid(),
2483 context_flags,
2484 name);
2485 1064 ctx->r = lbm_enc_i(cid);
2486 1064 ctx->app_cont = true;
2487
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 1036 times.
 1064 if (cid == -1) error_ctx(ENC_SYM_MERROR); // Kill parent and signal out of memory.
2488 1036 }
2489
2490 728 static void apply_spawn(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2491 728 apply_spawn_base(args,nargs,ctx, EVAL_CPS_CONTEXT_FLAG_NOTHING);
2492 700 }
2493
2494 336 static void apply_spawn_trap(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2495 336 apply_spawn_base(args,nargs,ctx, EVAL_CPS_CONTEXT_FLAG_TRAP);
2496 336 }
2497
2498 28400 static void apply_yield(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2499
2/4
✓ Branch 0 taken 28400 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 28400 times.
✗ Branch 4 not taken.
 56800 if (nargs == 1 && lbm_is_number(args[0])) {
2500 28400 lbm_uint ts = lbm_dec_as_u32(args[0]);
2501 28400 lbm_stack_drop(&ctx->K, nargs+1);
2502 28400 yield_ctx(ts);
2503 } else {
2504 ✗ lbm_set_error_reason((char*)lbm_error_str_no_number);
2505 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_YIELD);
2506 }
2507 28400 }
2508
2509 2127 static void apply_sleep(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2510
2/4
✓ Branch 0 taken 2127 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 2127 times.
✗ Branch 4 not taken.
 4226 if (nargs == 1 && lbm_is_number(args[0])) {
2511 2127 lbm_uint ts = (lbm_uint)(1000000.0f * lbm_dec_as_float(args[0]));
2512 2127 lbm_stack_drop(&ctx->K, nargs+1);
2513 2127 yield_ctx(ts);
2514 } else {
2515 ✗ lbm_set_error_reason((char*)lbm_error_str_no_number);
2516 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_SLEEP);
2517 }
2518 2099 }
2519
2520 56 static void apply_wait(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2521
2/4
✓ Branch 0 taken 56 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 56 times.
✗ Branch 4 not taken.
 112 if (nargs == 1 && lbm_type_of(args[0]) == LBM_TYPE_I) {
2522 56 lbm_cid cid = (lbm_cid)lbm_dec_i(args[0]);
2523 56 lbm_value *sptr = get_stack_ptr(ctx, 2);
2524 56 sptr[0] = lbm_enc_i(cid);
2525 56 sptr[1] = WAIT;
2526 56 ctx->r = ENC_SYM_TRUE;
2527 56 ctx->app_cont = true;
2528 56 yield_ctx(50000);
2529 } else {
2530 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_WAIT);
2531 }
2532 56 }
2533
2534 /* (eval expr)
2535 (eval env expr) */
2536 3181472 static void apply_eval(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2537
1/2
✓ Branch 0 taken 3181472 times.
✗ Branch 1 not taken.
 3181472 if ( nargs == 1) {
2538 3181472 ctx->curr_exp = args[0];
2539 ✗ } else if (nargs == 2) {
2540 ✗ ctx->curr_exp = args[1];
2541 ✗ ctx->curr_env = args[0];
2542 } else {
2543 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
2544 ✗ error_at_ctx(ENC_SYM_EERROR, ENC_SYM_EVAL);
2545 }
2546 3181472 lbm_stack_drop(&ctx->K, nargs+1);
2547 3181472 }
2548
2549 11368 static void apply_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2550 11368 int prg_pos = 0;
2551
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 11368 times.
 11368 if (nargs == 2) {
2552 ✗ prg_pos = 1;
2553 ✗ ctx->curr_env = args[0]; // No check that args[0] is an actual env.
2554 }
2555
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 11368 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 11368 if (nargs == 1 || nargs == 2) {
2556 11368 lbm_value prg = args[prg_pos]; // No check that this is a program.
2557 lbm_value app_cont;
2558 lbm_value app_cont_prg;
2559 lbm_value new_prg;
2560 lbm_value prg_copy;
2561
2562 11368 int len = -1;
2563
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 11368 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 11368 WITH_GC(prg_copy, lbm_list_copy(&len, prg));
2564 11368 lbm_stack_drop(&ctx->K, nargs+1);
2565 // There is always a continuation (DONE).
2566 // If ctx->program is nil, the stack should contain DONE.
2567 // after adding an intermediate done for prg, stack becomes DONE, DONE.
2568 11368 app_cont = cons_with_gc(ENC_SYM_APP_CONT, ENC_SYM_NIL, prg_copy);
2569 11368 app_cont_prg = cons_with_gc(app_cont, ENC_SYM_NIL, prg_copy);
2570 11368 new_prg = lbm_list_append(app_cont_prg, ctx->program);
2571 11368 new_prg = lbm_list_append(prg_copy, new_prg);
2572 // new_prg is guaranteed to be a cons cell or nil
2573 // even if the eval-program application is syntactically broken.
2574 11368 stack_reserve(ctx, 1)[0] = DONE;
2575 11368 ctx->program = get_cdr(new_prg);
2576 11368 ctx->curr_exp = get_car(new_prg);
2577 } else {
2578 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
2579 ✗ error_at_ctx(ENC_SYM_EERROR, ENC_SYM_EVAL_PROGRAM);
2580 }
2581 11368 }
2582
2583 3332 static void apply_send(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2584
1/2
✓ Branch 0 taken 3332 times.
✗ Branch 1 not taken.
 3332 if (nargs == 2) {
2585
1/2
✓ Branch 1 taken 3332 times.
✗ Branch 2 not taken.
 3332 if (lbm_type_of(args[0]) == LBM_TYPE_I) {
2586 3332 lbm_cid cid = (lbm_cid)lbm_dec_i(args[0]);
2587 3332 lbm_value msg = args[1];
2588 3332 int r = lbm_find_receiver_and_send(cid, msg);
2589 /* return the status */
2590 3332 lbm_stack_drop(&ctx->K, nargs+1);
2591
1/2
✓ Branch 0 taken 3332 times.
✗ Branch 1 not taken.
 3332 ctx->r = r == 0 ? ENC_SYM_TRUE : ENC_SYM_NIL;
2592 3332 ctx->app_cont = true;
2593 } else {
2594 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_SEND);
2595 }
2596 } else {
2597 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
2598 ✗ error_at_ctx(ENC_SYM_EERROR, ENC_SYM_SEND);
2599 }
2600 3332 }
2601
2602 ✗ static void apply_ok(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2603 ✗ lbm_value ok_val = ENC_SYM_TRUE;
2604 ✗ if (nargs >= 1) {
2605 ✗ ok_val = args[0];
2606 }
2607 ✗ ctx->r = ok_val;
2608 ✗ ok_ctx();
2609 ✗ }
2610
2611 28 static void apply_error(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2612 (void) ctx;
2613 28 lbm_value err_val = ENC_SYM_EERROR;
2614
1/2
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
 28 if (nargs >= 1) {
2615 28 err_val = args[0];
2616 }
2617 28 error_at_ctx(err_val, ENC_SYM_EXIT_ERROR);
2618 ✗ }
2619
2620 // (map f arg-list)
2621 728 static void apply_map(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2622
3/4
✓ Branch 0 taken 728 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 616 times.
✓ Branch 4 taken 112 times.
 728 if (nargs == 2 && lbm_is_cons(args[1])) {
2623 616 lbm_value *sptr = get_stack_ptr(ctx, 3);
2624
2625 616 lbm_value f = args[0];
2626 616 lbm_cons_t *args1_cell = lbm_ref_cell(args[1]);
2627 616 lbm_value h = args1_cell->car;
2628 616 lbm_value t = args1_cell->cdr;
2629
2630 lbm_value appli_1;
2631 lbm_value appli;
2632
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 616 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 616 WITH_GC(appli_1, lbm_heap_allocate_list(2));
2633
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 616 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
 616 WITH_GC_RMBR_1(appli, lbm_heap_allocate_list(2), appli_1);
2634
2635 616 lbm_value appli_0 = get_cdr(appli_1);
2636
2637 616 lbm_set_car_and_cdr(appli_0, h, ENC_SYM_NIL);
2638 616 lbm_set_car(appli_1, ENC_SYM_QUOTE);
2639
2640 616 lbm_set_car_and_cdr(get_cdr(appli), appli_1, ENC_SYM_NIL);
2641 616 lbm_set_car(appli, f);
2642
2643 616 lbm_value elt = cons_with_gc(ctx->r, ENC_SYM_NIL, appli);
2644 616 sptr[0] = t; // reuse stack space
2645 616 sptr[1] = ctx->curr_env;
2646 616 sptr[2] = elt;
2647 616 lbm_value *rptr = stack_reserve(ctx,4);
2648 616 rptr[0] = elt;
2649 616 rptr[1] = appli;
2650 616 rptr[2] = appli_0;
2651 616 rptr[3] = MAP;
2652 616 ctx->curr_exp = appli;
2653
2/4
✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 112 times.
✗ Branch 4 not taken.
 112 } else if (nargs == 2 && lbm_is_symbol_nil(args[1])) {
2654 112 lbm_stack_drop(&ctx->K, 3);
2655 112 ctx->r = ENC_SYM_NIL;
2656 112 ctx->app_cont = true;
2657 } else {
2658 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
2659 ✗ error_at_ctx(ENC_SYM_EERROR, ENC_SYM_MAP);
2660 }
2661 728 }
2662
2663 140 static void apply_reverse(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2664
2/4
✓ Branch 0 taken 140 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 140 times.
✗ Branch 4 not taken.
 140 if (nargs == 1 && lbm_is_list(args[0])) {
2665 140 lbm_value curr = args[0];
2666
2667 140 lbm_value new_list = ENC_SYM_NIL;
2668
2/2
✓ Branch 1 taken 3192 times.
✓ Branch 2 taken 140 times.
 3332 while (lbm_is_cons(curr)) {
2669 3192 lbm_cons_t *curr_cell = lbm_ref_cell(curr); // known cons.
2670 3192 lbm_value tmp = cons_with_gc(curr_cell->car, new_list, ENC_SYM_NIL);
2671 3192 new_list = tmp;
2672 3192 curr = curr_cell->cdr;
2673 }
2674 140 lbm_stack_drop(&ctx->K, 2);
2675 140 ctx->r = new_list;
2676 140 ctx->app_cont = true;
2677 } else {
2678 ✗ lbm_set_error_reason("Reverse requires a list argument");
2679 ✗ error_at_ctx(ENC_SYM_EERROR, ENC_SYM_REVERSE);
2680 }
2681 140 }
2682
2683 34622 static void apply_flatten(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2684
2/2
✓ Branch 0 taken 34594 times.
✓ Branch 1 taken 28 times.
 34622 if (nargs == 1) {
2685 #ifdef LBM_ALWAYS_GC
2686 gc();
2687 #endif
2688 34594 lbm_value v = flatten_value(args[0]);
2689
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 34592 times.
 34594 if ( v == ENC_SYM_MERROR) {
2690 2 gc();
2691 2 v = flatten_value(args[0]);
2692 }
2693
2694
2/2
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 34538 times.
 34594 if (lbm_is_symbol(v)) {
2695 56 error_at_ctx(v, ENC_SYM_FLATTEN);
2696 } else {
2697 34538 lbm_stack_drop(&ctx->K, 2);
2698 34538 ctx->r = v;
2699 34538 ctx->app_cont = true;
2700 }
2701 34538 return;
2702 }
2703 28 error_at_ctx(ENC_SYM_TERROR, ENC_SYM_FLATTEN);
2704 }
2705
2706 34510 static void apply_unflatten(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2707
2/4
✓ Branch 0 taken 34510 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 34510 times.
✗ Branch 4 not taken.
 34510 if(nargs == 1 && lbm_type_of(args[0]) == LBM_TYPE_ARRAY) {
2708 lbm_array_header_t *array;
2709 34510 array = (lbm_array_header_t *)get_car(args[0]);
2710
2711 lbm_flat_value_t fv;
2712 34510 fv.buf = (uint8_t*)array->data;
2713 34510 fv.buf_size = array->size;
2714 34510 fv.buf_pos = 0;
2715
2716 lbm_value res;
2717
2718 34510 ctx->r = ENC_SYM_NIL;
2719
1/2
✓ Branch 1 taken 34510 times.
✗ Branch 2 not taken.
 34510 if (lbm_unflatten_value(&fv, &res)) {
2720 34510 ctx->r = res;
2721 }
2722 34510 lbm_stack_drop(&ctx->K, 2);
2723 34510 ctx->app_cont = true;
2724 34510 return;
2725 }
2726 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_UNFLATTEN);
2727 }
2728
2729 83 static void apply_kill(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2730
2/4
✓ Branch 0 taken 83 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 83 times.
✗ Branch 4 not taken.
 83 if (nargs == 2 && lbm_is_number(args[0])) {
2731 83 lbm_cid cid = lbm_dec_as_i32(args[0]);
2732
2733
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 83 times.
 83 if (ctx->id == cid) {
2734 ✗ ctx->r = args[1];
2735 ✗ finish_ctx();
2736 ✗ return;
2737 }
2738 83 mutex_lock(&qmutex);
2739 83 eval_context_t *found = NULL;
2740 83 found = lookup_ctx_nm(&blocked, cid);
2741
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 83 times.
 83 if (found)
2742 ✗ drop_ctx_nm(&blocked, found);
2743 else
2744 83 found = lookup_ctx_nm(&queue, cid);
2745
1/2
✓ Branch 0 taken 83 times.
✗ Branch 1 not taken.
 83 if (found)
2746 83 drop_ctx_nm(&queue, found);
2747
2748
1/2
✓ Branch 0 taken 83 times.
✗ Branch 1 not taken.
 83 if (found) {
2749 83 found->K.data[found->K.sp - 1] = KILL;
2750 83 found->r = args[1];
2751 83 found->app_cont = true;
2752 83 found->state = LBM_THREAD_STATE_READY;
2753 83 enqueue_ctx_nm(&queue,found);
2754 83 ctx->r = ENC_SYM_TRUE;
2755 } else {
2756 ✗ ctx->r = ENC_SYM_NIL;
2757 }
2758 83 lbm_stack_drop(&ctx->K, 3);
2759 83 ctx->app_cont = true;
2760 83 mutex_unlock(&qmutex);
2761 83 return;
2762 }
2763 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_KILL);
2764 }
2765
2766 282828 static lbm_value cmp_to_clo(lbm_value cmp) {
2767 lbm_value closure;
2768
3/4
✓ Branch 2 taken 300 times.
✓ Branch 3 taken 282528 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 300 times.
 282828 WITH_GC(closure, lbm_heap_allocate_list(4));
2769 282828 lbm_set_car(closure, ENC_SYM_CLOSURE);
2770 282828 lbm_value cl1 = lbm_cdr(closure);
2771 lbm_value par;
2772
3/4
✓ Branch 2 taken 576 times.
✓ Branch 3 taken 282252 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 576 times.
 282828 WITH_GC_RMBR_1(par, lbm_heap_allocate_list_init(2, symbol_x, symbol_y), closure);
2773 282828 lbm_set_car(cl1, par);
2774 282828 lbm_value cl2 = lbm_cdr(cl1);
2775 lbm_value body;
2776
3/4
✓ Branch 2 taken 3634 times.
✓ Branch 3 taken 279194 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 3634 times.
 282828 WITH_GC_RMBR_1(body, lbm_heap_allocate_list_init(3, cmp, symbol_x, symbol_y), closure);
2777 282828 lbm_set_car(cl2, body);
2778 282828 lbm_value cl3 = lbm_cdr(cl2);
2779 282828 lbm_set_car(cl3, ENC_SYM_NIL);
2780 282828 return closure;
2781 }
2782
2783 // (merge comparator list1 list2)
2784 420 static void apply_merge(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2785
3/6
✓ Branch 0 taken 420 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 420 times.
✗ Branch 4 not taken.
✓ Branch 6 taken 420 times.
✗ Branch 7 not taken.
 420 if (nargs == 3 && lbm_is_list(args[1]) && lbm_is_list(args[2])) {
2786
2787
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 392 times.
 420 if (!lbm_is_closure(args[0])) {
2788 28 args[0] = cmp_to_clo(args[0]);
2789 }
2790
2791 // Copy input lists for functional behaviour at top-level
2792 // merge itself is in-place in the copied lists.
2793 lbm_value a;
2794 lbm_value b;
2795 420 int len_a = -1;
2796 420 int len_b = -1;
2797
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 420 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 420 WITH_GC(a, lbm_list_copy(&len_a, args[1]));
2798
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 420 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
 420 WITH_GC_RMBR_1(b, lbm_list_copy(&len_b, args[2]), a);
2799
2800
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 364 times.
 420 if (len_a == 0) {
2801 56 ctx->r = b;
2802 56 lbm_stack_drop(&ctx->K, 4);
2803 56 ctx->app_cont = true;
2804 56 return;
2805 }
2806
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 308 times.
 364 if (len_b == 0) {
2807 56 ctx->r = a;
2808 56 lbm_stack_drop(&ctx->K, 4);
2809 56 ctx->app_cont = true;
2810 56 return;
2811 }
2812
2813 308 args[1] = a; // keep safe by replacing the original on stack.
2814 308 args[2] = b;
2815
2816 308 lbm_value a_1 = a;
2817 308 lbm_value a_rest = lbm_cdr(a);
2818 308 lbm_value b_1 = b;
2819 308 lbm_value b_rest = lbm_cdr(b);
2820
2821 lbm_value cl[3]; // Comparator closure
2822 308 extract_n(lbm_cdr(args[0]), cl, 3);
2823 308 lbm_value cmp_env = cl[CLO_ENV];
2824 308 lbm_value par1 = ENC_SYM_NIL;
2825 308 lbm_value par2 = ENC_SYM_NIL;
2826 308 lbm_uint len = lbm_list_length(cl[CLO_PARAMS]);
2827
1/2
✓ Branch 0 taken 308 times.
✗ Branch 1 not taken.
 308 if (len == 2) {
2828 308 par1 = get_car(cl[CLO_PARAMS]);
2829 308 par2 = get_cadr(cl[CLO_PARAMS]);
2830 lbm_value new_env0;
2831 lbm_value new_env;
2832
1/4
✗ Branch 3 not taken.
✓ Branch 4 taken 308 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
 308 WITH_GC(new_env0, lbm_env_set(cmp_env, par1, lbm_car(a_1)));
2833
1/4
✗ Branch 3 not taken.
✓ Branch 4 taken 308 times.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
 308 WITH_GC_RMBR_1(new_env, lbm_env_set(new_env0, par2, lbm_car(b_1)),new_env0);
2834 308 cmp_env = new_env;
2835 } else {
2836 ✗ error_at_ctx(ENC_SYM_TERROR, args[0]);
2837 }
2838 308 lbm_set_cdr(a_1, b_1);
2839 308 lbm_set_cdr(b_1, ENC_SYM_NIL);
2840 308 lbm_value cmp = cl[CLO_BODY];
2841
2842 308 lbm_stack_drop(&ctx->K, 4); // TODO: Optimize drop 4 alloc 10 into alloc 6
2843 308 lbm_uint *sptr = stack_reserve(ctx, 10);
2844 308 sptr[0] = ENC_SYM_NIL; // head of merged list
2845 308 sptr[1] = ENC_SYM_NIL; // last of merged list
2846 308 sptr[2] = a_1;
2847 308 sptr[3] = a_rest;
2848 308 sptr[4] = b_rest;
2849 308 sptr[5] = cmp;
2850 308 sptr[6] = cmp_env;
2851 308 sptr[7] = par1;
2852 308 sptr[8] = par2;
2853 308 sptr[9] = MERGE_REST;
2854 308 ctx->curr_exp = cl[CLO_BODY];
2855 308 ctx->curr_env = cmp_env;
2856 308 return;
2857 }
2858 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_MERGE);
2859 }
2860
2861 // (sort comparator list)
2862 283136 static void apply_sort(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2863
2/4
✓ Branch 0 taken 283136 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 283136 times.
✗ Branch 4 not taken.
 283136 if (nargs == 2 && lbm_is_list(args[1])) {
2864
2865
2/2
✓ Branch 1 taken 282800 times.
✓ Branch 2 taken 336 times.
 283136 if (!lbm_is_closure(args[0])) {
2866 282800 args[0] = cmp_to_clo(args[0]);
2867 }
2868
2869 283136 int len = -1;
2870 lbm_value list_copy;
2871
3/4
✓ Branch 2 taken 138 times.
✓ Branch 3 taken 282998 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 138 times.
 283136 WITH_GC(list_copy, lbm_list_copy(&len, args[1]));
2872
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 283108 times.
 283136 if (len <= 1) {
2873 28 lbm_stack_drop(&ctx->K, 3);
2874 28 ctx->r = list_copy;
2875 28 ctx->app_cont = true;
2876 28 return;
2877 }
2878
2879 283108 args[1] = list_copy; // Keep safe, original replaced on stack.
2880
2881 // Take the headmost 2, 1-element sublists.
2882 283108 lbm_value a = list_copy;
2883 283108 lbm_value b = lbm_cdr(a);
2884 283108 lbm_value rest = lbm_cdr(b);
2885 // Do not terminate b. keep rest of list safe from GC in the following
2886 // closure extraction.
2887 //lbm_set_cdr(a, b); // This is void
2888
2889 lbm_value cl[3]; // Comparator closure
2890 283108 extract_n(lbm_cdr(args[0]), cl, 3);
2891 283108 lbm_value cmp_env = cl[CLO_ENV];
2892 283108 lbm_value par1 = ENC_SYM_NIL;
2893 283108 lbm_value par2 = ENC_SYM_NIL;
2894 283108 lbm_uint cl_len = lbm_list_length(cl[CLO_PARAMS]);
2895
1/2
✓ Branch 0 taken 283108 times.
✗ Branch 1 not taken.
 283108 if (cl_len == 2) {
2896 283108 par1 = get_car(cl[CLO_PARAMS]);
2897 283108 par2 = get_cadr(cl[CLO_PARAMS]);
2898 lbm_value new_env0;
2899 lbm_value new_env;
2900
3/4
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 283106 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
 283108 WITH_GC(new_env0, lbm_env_set(cmp_env, par1, lbm_car(a)));
2901
3/4
✓ Branch 3 taken 16 times.
✓ Branch 4 taken 283092 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 16 times.
 283108 WITH_GC_RMBR_1(new_env, lbm_env_set(new_env0, par2, lbm_car(b)), new_env0);
2902 283108 cmp_env = new_env;
2903 } else {
2904 ✗ error_at_ctx(ENC_SYM_TERROR, args[0]);
2905 }
2906 283108 lbm_value cmp = cl[CLO_BODY];
2907
2908 // Terminate the comparator argument list.
2909 283108 lbm_set_cdr(b, ENC_SYM_NIL);
2910
2911 283108 lbm_stack_drop(&ctx->K, 3); //TODO: optimize drop 3, alloc 20 into alloc 17
2912 283108 lbm_uint *sptr = stack_reserve(ctx, 20);
2913 283108 sptr[0] = cmp;
2914 283108 sptr[1] = cmp_env;
2915 283108 sptr[2] = par1;
2916 283108 sptr[3] = par2;
2917 283108 sptr[4] = ENC_SYM_NIL; // head of merged accumulation of sublists
2918 283108 sptr[5] = ENC_SYM_NIL; // last of merged accumulation of sublists
2919 283108 sptr[6] = rest;
2920 283108 sptr[7] = lbm_enc_i(1);
2921 283108 sptr[8] = lbm_enc_i(len); //TODO: 28 bit i vs 32 bit i
2922 283108 sptr[9] = MERGE_LAYER;
2923 283108 sptr[10] = ENC_SYM_NIL; // head of merged sublist
2924 283108 sptr[11] = ENC_SYM_NIL; // last of merged sublist
2925 283108 sptr[12] = a;
2926 283108 sptr[13] = ENC_SYM_NIL; // no a_rest, 1 element lists in layer 1.
2927 283108 sptr[14] = ENC_SYM_NIL; // no b_rest, 1 element lists in layer 1.
2928 283108 sptr[15] = cmp;
2929 283108 sptr[16] = cmp_env;
2930 283108 sptr[17] = par1;
2931 283108 sptr[18] = par2;
2932 283108 sptr[19] = MERGE_REST;
2933 283108 ctx->curr_exp = cmp;
2934 283108 ctx->curr_env = cmp_env;
2935 283108 return;
2936 }
2937 ✗ error_ctx(ENC_SYM_TERROR);
2938 }
2939
2940 616308 static void apply_rest_args(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2941 lbm_value res;
2942
2/2
✓ Branch 1 taken 616280 times.
✓ Branch 2 taken 28 times.
 616308 if (lbm_env_lookup_b(&res, ENC_SYM_REST_ARGS, ctx->curr_env)) {
2943
3/4
✓ Branch 0 taken 56140 times.
✓ Branch 1 taken 560140 times.
✓ Branch 3 taken 56140 times.
✗ Branch 4 not taken.
 616280 if (nargs == 1 && lbm_is_number(args[0])) {
2944 56140 int32_t ix = lbm_dec_as_i32(args[0]);
2945 56140 res = lbm_index_list(res, ix);
2946 }
2947 616280 ctx->r = res;
2948 } else {
2949 28 ctx->r = ENC_SYM_NIL;
2950 }
2951 616308 lbm_stack_drop(&ctx->K, nargs+1);
2952 616308 ctx->app_cont = true;
2953 616308 }
2954
2955 /* (rotate list-expr dist/dir-expr) */
2956 84 static void apply_rotate(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
2957
3/6
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 84 times.
✗ Branch 4 not taken.
✓ Branch 6 taken 84 times.
✗ Branch 7 not taken.
 84 if (nargs == 2 && lbm_is_list(args[0]) && lbm_is_number(args[1])) {
2958 84 int len = -1;
2959 lbm_value ls;
2960
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 84 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 84 WITH_GC(ls, lbm_list_copy(&len, args[0]));
2961 84 int dist = lbm_dec_as_i32(args[1]);
2962
3/4
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 56 times.
✗ Branch 3 not taken.
 84 if (len > 0 && dist != 0) {
2963 56 int d = dist;
2964
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 28 times.
 56 if (dist > 0) {
2965 28 ls = lbm_list_destructive_reverse(ls);
2966 } else {
2967 28 d = -dist;
2968 }
2969
2970 56 lbm_value start = ls;
2971 56 lbm_value end = ENC_SYM_NIL;
2972 56 lbm_value curr = start;
2973
2/2
✓ Branch 1 taken 252 times.
✓ Branch 2 taken 56 times.
 308 while (lbm_is_cons(curr)) {
2974 252 end = curr;
2975 252 curr = get_cdr(curr);
2976 }
2977
2978
2/2
✓ Branch 0 taken 112 times.
✓ Branch 1 taken 56 times.
 168 for (int i = 0; i < d; i ++) {
2979 112 lbm_value a = start;
2980 112 start = lbm_cdr(start);
2981 112 lbm_set_cdr(a, ENC_SYM_NIL);
2982 112 lbm_set_cdr(end, a);
2983 112 end = a;
2984 }
2985 56 ls = start;
2986
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 28 times.
 56 if (dist > 0) {
2987 28 ls = lbm_list_destructive_reverse(ls);
2988 }
2989 }
2990 84 lbm_stack_drop(&ctx->K, nargs+1);
2991 84 ctx->app_cont = true;
2992 84 ctx->r = ls;
2993 84 return;
2994 }
2995 ✗ error_ctx(ENC_SYM_EERROR);
2996 }
2997
2998 /***************************************************/
2999 /* Application lookup table */
3000
3001 typedef void (*apply_fun)(lbm_value *, lbm_uint, eval_context_t *);
3002 static const apply_fun fun_table[] =
3003 {
3004 apply_setvar,
3005 apply_read,
3006 apply_read_program,
3007 apply_read_eval_program,
3008 apply_spawn,
3009 apply_spawn_trap,
3010 apply_yield,
3011 apply_wait,
3012 apply_eval,
3013 apply_eval_program,
3014 apply_send,
3015 apply_ok,
3016 apply_error,
3017 apply_map,
3018 apply_reverse,
3019 apply_flatten,
3020 apply_unflatten,
3021 apply_kill,
3022 apply_sleep,
3023 apply_merge,
3024 apply_sort,
3025 apply_rest_args,
3026 apply_rotate,
3027 };
3028
3029 /***************************************************/
3030 /* Application of function that takes arguments */
3031 /* passed over the stack. */
3032
3033 77988536 static void application(eval_context_t *ctx, lbm_value *fun_args, lbm_uint arg_count) {
3034 /* If arriving here, we know that the fun is a symbol.
3035 * and can be a built in operation or an extension.
3036 */
3037 77988536 lbm_value fun = fun_args[0];
3038
3039 77988536 lbm_uint fun_val = lbm_dec_sym(fun);
3040 77988536 lbm_uint fun_kind = SYMBOL_KIND(fun_val);
3041
3042
3/4
✓ Branch 0 taken 185181 times.
✓ Branch 1 taken 73274797 times.
✓ Branch 2 taken 4528558 times.
✗ Branch 3 not taken.
 77988536 switch (fun_kind) {
3043 185181 case SYMBOL_KIND_EXTENSION: {
3044 185181 extension_fptr f = extension_table[SYMBOL_IX(fun_val)].fptr;
3045
3046 lbm_value ext_res;
3047
3/4
✓ Branch 2 taken 126 times.
✓ Branch 3 taken 185055 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 126 times.
 185181 WITH_GC(ext_res, f(&fun_args[1], arg_count));
3048
2/2
✓ Branch 1 taken 2996 times.
✓ Branch 2 taken 182185 times.
 185181 if (lbm_is_error(ext_res)) { //Error other than merror
3049 2996 error_at_ctx(ext_res, fun);
3050 }
3051 182185 lbm_stack_drop(&ctx->K, arg_count + 1);
3052
3053 182185 ctx->app_cont = true;
3054 182185 ctx->r = ext_res;
3055
3056
2/2
✓ Branch 0 taken 112 times.
✓ Branch 1 taken 182073 times.
 182185 if (blocking_extension) {
3057
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
 112 if (is_atomic) {
3058 // Check atomic_error explicitly so that the mutex
3059 // can be released if there is an error.
3060 ✗ blocking_extension = false;
3061 ✗ mutex_unlock(&blocking_extension_mutex);
3062 ✗ atomic_error();
3063 }
3064 112 blocking_extension = false;
3065
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
 112 if (blocking_extension_timeout) {
3066 ✗ blocking_extension_timeout = false;
3067 ✗ block_current_ctx(LBM_THREAD_STATE_TIMEOUT, blocking_extension_timeout_us,true);
3068 } else {
3069 112 block_current_ctx(LBM_THREAD_STATE_BLOCKED, 0,true);
3070 }
3071 112 mutex_unlock(&blocking_extension_mutex);
3072 }
3073 182185 } break;
3074 73274797 case SYMBOL_KIND_FUNDAMENTAL:
3075 73274797 call_fundamental(SYMBOL_IX(fun_val), &fun_args[1], arg_count, ctx);
3076 73270141 break;
3077 4528558 case SYMBOL_KIND_APPFUN:
3078 4528558 fun_table[SYMBOL_IX(fun_val)](&fun_args[1], arg_count, ctx);
3079 4528250 break;
3080 ✗ default:
3081 // Symbols that are "special" but not in the way caught above
3082 // ends up here.
3083 ✗ lbm_set_error_reason("Symbol does not represent a function");
3084 ✗ error_at_ctx(ENC_SYM_EERROR,fun_args[0]);
3085 ✗ break;
3086 }
3087 77980576 }
3088
3089 59420587 static void cont_closure_application_args(eval_context_t *ctx) {
3090 59420587 lbm_uint* sptr = get_stack_ptr(ctx, 5);
3091
3092 59420587 lbm_value arg_env = (lbm_value)sptr[0];
3093 59420587 lbm_value exp = (lbm_value)sptr[1];
3094 59420587 lbm_value clo_env = (lbm_value)sptr[2];
3095 59420587 lbm_value params = (lbm_value)sptr[3];
3096 59420587 lbm_value args = (lbm_value)sptr[4];
3097
3098 lbm_value car_params, cdr_params;
3099 59420587 get_car_and_cdr(params, &car_params, &cdr_params);
3100
3101 59420587 bool a_nil = lbm_is_symbol_nil(args);
3102 59420587 bool p_nil = lbm_is_symbol_nil(cdr_params);
3103
3104 59420587 lbm_value binder = allocate_binding(car_params, ctx->r, clo_env);
3105
3106
4/4
✓ Branch 0 taken 33238100 times.
✓ Branch 1 taken 26182459 times.
✓ Branch 2 taken 33209876 times.
✓ Branch 3 taken 28224 times.
 59420559 if (!a_nil && !p_nil) {
3107 lbm_value car_args, cdr_args;
3108 33209876 get_car_and_cdr(args, &car_args, &cdr_args);
3109 33209876 sptr[2] = binder;
3110 33209876 sptr[3] = cdr_params;
3111 33209876 sptr[4] = cdr_args;
3112 33209876 stack_reserve(ctx,1)[0] = CLOSURE_ARGS;
3113 33209876 ctx->curr_exp = car_args;
3114 33209876 ctx->curr_env = arg_env;
3115
3/4
✓ Branch 0 taken 26182459 times.
✓ Branch 1 taken 28224 times.
✓ Branch 2 taken 26182459 times.
✗ Branch 3 not taken.
 26210683 } else if (a_nil && p_nil) {
3116 // Arguments and parameters match up in number
3117 26182459 lbm_stack_drop(&ctx->K, 5);
3118 26182459 ctx->curr_env = binder;
3119 26182459 ctx->curr_exp = exp;
3120
1/2
✓ Branch 0 taken 28224 times.
✗ Branch 1 not taken.
 28224 } else if (p_nil) {
3121 28224 lbm_value rest_binder = allocate_binding(ENC_SYM_REST_ARGS, ENC_SYM_NIL, binder);
3122 28224 sptr[2] = rest_binder;
3123 28224 sptr[3] = get_cdr(args);
3124 28224 sptr[4] = get_car(rest_binder); // last element of rest_args so far
3125 28224 stack_reserve(ctx,1)[0] = CLOSURE_ARGS_REST;
3126 28224 ctx->curr_exp = get_car(args);
3127 28224 ctx->curr_env = arg_env;
3128 } else {
3129 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
3130 ✗ error_ctx(ENC_SYM_EERROR);
3131 }
3132 59420559 }
3133
3134
3135 5797008 static void cont_closure_args_rest(eval_context_t *ctx) {
3136 5797008 lbm_uint* sptr = get_stack_ptr(ctx, 5);
3137 5797008 lbm_value arg_env = (lbm_value)sptr[0];
3138 5797008 lbm_value exp = (lbm_value)sptr[1];
3139 5797008 lbm_value clo_env = (lbm_value)sptr[2];
3140 5797008 lbm_value args = (lbm_value)sptr[3];
3141 5797008 lbm_value last = (lbm_value)sptr[4];
3142 5797008 lbm_cons_t* heap = lbm_heap_state.heap;
3143 #ifdef LBM_ALWAYS_GC
3144 gc();
3145 #endif
3146 5797008 lbm_value binding = lbm_heap_state.freelist;
3147
2/2
✓ Branch 0 taken 7498 times.
✓ Branch 1 taken 5789510 times.
 5797008 if (binding == ENC_SYM_NIL) {
3148 7498 gc();
3149 7498 binding = lbm_heap_state.freelist;
3150
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 7498 times.
 7498 if (binding == ENC_SYM_NIL) error_ctx(ENC_SYM_MERROR);
3151 }
3152 5797008 lbm_uint binding_ix = lbm_dec_ptr(binding);
3153 5797008 lbm_heap_state.freelist = heap[binding_ix].cdr;
3154 5797008 lbm_heap_state.num_alloc += 1;
3155 5797008 heap[binding_ix].car = ctx->r;
3156 5797008 heap[binding_ix].cdr = ENC_SYM_NIL;
3157
3158
3159 5797008 lbm_set_cdr(last, binding);
3160 5797008 sptr[4] = binding;
3161
3162
2/2
✓ Branch 0 taken 588252 times.
✓ Branch 1 taken 5208756 times.
 5797008 if (args == ENC_SYM_NIL) {
3163 588252 lbm_stack_drop(&ctx->K, 5);
3164 588252 ctx->curr_env = clo_env;
3165 588252 ctx->curr_exp = exp;
3166 } else {
3167 5208756 stack_reserve(ctx,1)[0] = CLOSURE_ARGS_REST;
3168 5208756 sptr[3] = get_cdr(args);
3169 5208756 ctx->curr_exp = get_car(args);
3170 5208756 ctx->curr_env = arg_env;
3171 }
3172 5797008 }
3173
3174 247664290 static void cont_application_args(eval_context_t *ctx) {
3175 247664290 lbm_uint *sptr = get_stack_ptr(ctx, 3);
3176
3177 247664290 lbm_value env = sptr[0];
3178 247664290 lbm_value rest = sptr[1];
3179 247664290 lbm_value count = sptr[2];
3180
3181 247664290 ctx->curr_env = env;
3182 247664290 sptr[0] = ctx->r; // Function 1st then Arguments
3183
2/2
✓ Branch 1 taken 169675754 times.
✓ Branch 2 taken 77988536 times.
 247664290 if (lbm_is_cons(rest)) {
3184 169675754 lbm_cons_t *cell = lbm_ref_cell(rest);
3185 169675754 sptr[1] = env;
3186 169675754 sptr[2] = cell->cdr;
3187 169675754 lbm_value *rptr = stack_reserve(ctx,2);
3188 169675754 rptr[0] = count + (1 << LBM_VAL_SHIFT);
3189 169675754 rptr[1] = APPLICATION_ARGS;
3190 169675754 ctx->curr_exp = cell->car;
3191 } else {
3192 // No more arguments
3193 77988536 lbm_stack_drop(&ctx->K, 2);
3194 77988536 lbm_uint nargs = lbm_dec_u(count);
3195 77988536 lbm_value *args = get_stack_ptr(ctx, (uint32_t)(nargs + 1));
3196 77988536 application(ctx,args, nargs);
3197 }
3198 247656330 }
3199
3200 3985688 static void cont_and(eval_context_t *ctx) {
3201 lbm_value env;
3202 lbm_value rest;
3203 3985688 lbm_value arg = ctx->r;
3204 3985688 lbm_pop_2(&ctx->K, &rest, &env);
3205
2/2
✓ Branch 1 taken 280056 times.
✓ Branch 2 taken 3705632 times.
 3985688 if (lbm_is_symbol_nil(arg)) {
3206 280056 ctx->app_cont = true;
3207 280056 ctx->r = ENC_SYM_NIL;
3208
2/2
✓ Branch 1 taken 1701896 times.
✓ Branch 2 taken 2003736 times.
 3705632 } else if (lbm_is_symbol_nil(rest)) {
3209 1701896 ctx->app_cont = true;
3210 } else {
3211 2003736 lbm_value *sptr = stack_reserve(ctx, 3);
3212 2003736 sptr[0] = env;
3213 2003736 sptr[1] = get_cdr(rest);
3214 2003736 sptr[2] = AND;
3215 2003736 ctx->curr_env = env;
3216 2003736 ctx->curr_exp = get_car(rest);
3217 }
3218 3985688 }
3219
3220 15988 static void cont_or(eval_context_t *ctx) {
3221 lbm_value env;
3222 lbm_value rest;
3223 15988 lbm_value arg = ctx->r;
3224 15988 lbm_pop_2(&ctx->K, &rest, &env);
3225
2/2
✓ Branch 1 taken 840 times.
✓ Branch 2 taken 15148 times.
 15988 if (!lbm_is_symbol_nil(arg)) {
3226 840 ctx->app_cont = true;
3227
2/2
✓ Branch 1 taken 6356 times.
✓ Branch 2 taken 8792 times.
 15148 } else if (lbm_is_symbol_nil(rest)) {
3228 6356 ctx->app_cont = true;
3229 6356 ctx->r = ENC_SYM_NIL;
3230 } else {
3231 8792 lbm_value *sptr = stack_reserve(ctx, 3);
3232 8792 sptr[0] = env;
3233 8792 sptr[1] = get_cdr(rest);
3234 8792 sptr[2] = OR;
3235 8792 ctx->curr_exp = get_car(rest);
3236 8792 ctx->curr_env = env;
3237 }
3238 15988 }
3239
3240 40888386 static int fill_binding_location(lbm_value key, lbm_value value, lbm_value env) {
3241
2/2
✓ Branch 1 taken 26887350 times.
✓ Branch 2 taken 14001036 times.
 40888386 if (lbm_type_of(key) == LBM_TYPE_SYMBOL) {
3242
2/2
✓ Branch 0 taken 2800112 times.
✓ Branch 1 taken 24087238 times.
 26887350 if (key == ENC_SYM_DONTCARE) return FB_OK;
3243 24087238 lbm_env_modify_binding(env,key,value);
3244 24087238 return FB_OK;
3245
2/4
✓ Branch 1 taken 14001036 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 14001036 times.
✗ Branch 4 not taken.
 28002072 } else if (lbm_is_cons(key) &&
3246 14001036 lbm_is_cons(value)) {
3247 14001036 int r = fill_binding_location(get_car(key), get_car(value), env);
3248
1/2
✓ Branch 0 taken 14001036 times.
✗ Branch 1 not taken.
 14001036 if (r == FB_OK) {
3249 14001036 r = fill_binding_location(get_cdr(key), get_cdr(value), env);
3250 }
3251 14001036 return r;
3252 }
3253 ✗ return FB_TYPE_ERROR;
3254 }
3255
3256 12242748 static void cont_bind_to_key_rest(eval_context_t *ctx) {
3257
3258 12242748 lbm_value *sptr = get_stack_ptr(ctx, 4);
3259
3260 12242748 lbm_value rest = sptr[1];
3261 12242748 lbm_value env = sptr[2];
3262 12242748 lbm_value key = sptr[3];
3263
3264
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 12242748 times.
 12242748 if (fill_binding_location(key, ctx->r, env) < 0) {
3265 ✗ lbm_set_error_reason("Incorrect type of name/key in let-binding");
3266 ✗ error_at_ctx(ENC_SYM_TERROR, key);
3267 }
3268
3269
2/2
✓ Branch 1 taken 113904 times.
✓ Branch 2 taken 12128844 times.
 12242748 if (lbm_is_cons(rest)) {
3270 113904 lbm_value car_rest = get_car(rest);
3271 lbm_value key_val[2];
3272 113904 extract_n(car_rest, key_val, 2);
3273
3274 113904 sptr[1] = get_cdr(rest);
3275 113904 sptr[3] = key_val[0];
3276 113904 stack_reserve(ctx,1)[0] = BIND_TO_KEY_REST;
3277 113904 ctx->curr_exp = key_val[1];
3278 113904 ctx->curr_env = env;
3279 } else {
3280 // Otherwise evaluate the expression in the populated env
3281 12128844 ctx->curr_exp = sptr[0];
3282 12128844 ctx->curr_env = env;
3283 12128844 lbm_stack_drop(&ctx->K, 4);
3284 }
3285 12242748 }
3286
3287 21762382 static void cont_if(eval_context_t *ctx) {
3288
3289 21762382 lbm_value arg = ctx->r;
3290
3291 21762382 lbm_value *sptr = pop_stack_ptr(ctx, 2);
3292
3293 21762382 ctx->curr_env = sptr[1];
3294
2/2
✓ Branch 1 taken 21739056 times.
✓ Branch 2 taken 23326 times.
 21762382 if (lbm_is_symbol_nil(arg)) {
3295 21739056 ctx->curr_exp = get_cadr(sptr[0]); // else branch
3296 } else {
3297 23326 ctx->curr_exp = get_car(sptr[0]); // then branch
3298 }
3299 21762382 }
3300
3301 5936 static void cont_match(eval_context_t *ctx) {
3302 5936 lbm_value e = ctx->r;
3303 5936 bool do_gc = false;
3304
3305 5936 lbm_uint *sptr = get_stack_ptr(ctx, 2);
3306 5936 lbm_value patterns = (lbm_value)sptr[0];
3307 5936 lbm_value orig_env = (lbm_value)sptr[1]; // restore enclosing environment.
3308 5936 lbm_value new_env = orig_env;
3309
3310
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 5936 times.
 5936 if (lbm_is_symbol_nil(patterns)) {
3311 // no more patterns
3312 ✗ lbm_stack_drop(&ctx->K, 2);
3313 ✗ ctx->r = ENC_SYM_NO_MATCH;
3314 ✗ ctx->app_cont = true;
3315
1/2
✓ Branch 1 taken 5936 times.
✗ Branch 2 not taken.
 5936 } else if (lbm_is_cons(patterns)) {
3316 5936 lbm_value match_case = get_car(patterns);
3317 5936 lbm_value pattern = get_car(match_case);
3318 5936 lbm_value n1 = get_cadr(match_case);
3319 5936 lbm_value n2 = get_cadr(get_cdr(match_case));
3320 lbm_value body;
3321 5936 bool check_guard = false;
3322
2/2
✓ Branch 1 taken 4676 times.
✓ Branch 2 taken 1260 times.
 5936 if (lbm_is_symbol_nil(n2)) { // TODO: Not a very robust check.
3323 4676 body = n1;
3324 } else {
3325 1260 body = n2;
3326 1260 check_guard = true;
3327 }
3328 #ifdef LBM_ALWAYS_GC
3329 gc();
3330 #endif
3331 5936 bool is_match = match(pattern, e, &new_env, &do_gc);
3332
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5936 times.
 5936 if (do_gc) {
3333 ✗ gc();
3334 ✗ do_gc = false;
3335 ✗ new_env = orig_env;
3336 ✗ is_match = match(pattern, e, &new_env, &do_gc);
3337 ✗ if (do_gc) {
3338 ✗ error_ctx(ENC_SYM_MERROR);
3339 }
3340 }
3341
2/2
✓ Branch 0 taken 3528 times.
✓ Branch 1 taken 2408 times.
 5936 if (is_match) {
3342
2/2
✓ Branch 0 taken 1260 times.
✓ Branch 1 taken 2268 times.
 3528 if (check_guard) {
3343 1260 lbm_value *rptr = stack_reserve(ctx,5);
3344 1260 sptr[0] = get_cdr(patterns);
3345 1260 sptr[1] = ctx->curr_env;
3346 1260 rptr[0] = MATCH;
3347 1260 rptr[1] = new_env;
3348 1260 rptr[2] = body;
3349 1260 rptr[3] = e;
3350 1260 rptr[4] = MATCH_GUARD;
3351 1260 ctx->curr_env = new_env;
3352 1260 ctx->curr_exp = n1; // The guard
3353 } else {
3354 2268 lbm_stack_drop(&ctx->K, 2);
3355 2268 ctx->curr_env = new_env;
3356 2268 ctx->curr_exp = body;
3357 }
3358 } else {
3359 // set up for checking of next pattern
3360 2408 sptr[0] = get_cdr(patterns);
3361 2408 sptr[1] = orig_env;
3362 2408 stack_reserve(ctx,1)[0] = MATCH;
3363 // leave r unaltered
3364 2408 ctx->app_cont = true;
3365 }
3366 } else {
3367 ✗ error_at_ctx(ENC_SYM_TERROR, ENC_SYM_MATCH);
3368 }
3369 5936 }
3370
3371 224 static void cont_exit_atomic(eval_context_t *ctx) {
3372 224 is_atomic = false; // atomic blocks cannot nest!
3373 224 ctx->app_cont = true;
3374 224 }
3375
3376 // cont_map:
3377 //
3378 // sptr[0]: s[sp-6] = Rest of the input list.
3379 // sptr[1]: s[sp-5] = Environment to restore for the eval of each application.
3380 // sptr[2]: s[sp-4] = Result list.
3381 // sptr[3]: s[sp-3] = Cell that goes into result list after being populated with application result.
3382 // sptr[4]: s[sp-2] = Ref to application.
3383 // sptr[5]: s[sp-1] = Ref to application argument.
3384 //
3385 // ctx->r = eval result of previous application.
3386 2016 static void cont_map(eval_context_t *ctx) {
3387 2016 lbm_value *sptr = get_stack_ptr(ctx, 6);
3388
3389 2016 lbm_value ls = sptr[0];
3390 2016 lbm_value env = sptr[1];
3391 2016 lbm_value t = sptr[3];
3392 2016 lbm_set_car(t, ctx->r); // update car field tailmost position.
3393
2/2
✓ Branch 1 taken 1400 times.
✓ Branch 2 taken 616 times.
 2016 if (lbm_is_cons(ls)) {
3394 1400 lbm_cons_t *cell = lbm_ref_cell(ls); // already checked that cons.
3395 1400 lbm_value next = cell->car;
3396 1400 lbm_value rest = cell->cdr;
3397 1400 sptr[0] = rest;
3398 1400 stack_reserve(ctx,1)[0] = MAP;
3399 1400 lbm_set_car(sptr[5], next); // new arguments
3400
3401 1400 lbm_value elt = cons_with_gc(ENC_SYM_NIL, ENC_SYM_NIL, ENC_SYM_NIL);
3402 1400 lbm_set_cdr(t, elt);
3403 1400 sptr[3] = elt; // (r1 ... rN . (nil . nil))
3404 1400 ctx->curr_exp = sptr[4];
3405 1400 ctx->curr_env = env;
3406 } else {
3407 616 ctx->r = sptr[2]; //head of result list
3408 616 ctx->curr_env = env;
3409 616 lbm_stack_drop(&ctx->K, 6);
3410 616 ctx->app_cont = true;
3411 }
3412 2016 }
3413
3414 1260 static void cont_match_guard(eval_context_t *ctx) {
3415
2/2
✓ Branch 1 taken 476 times.
✓ Branch 2 taken 784 times.
 1260 if (lbm_is_symbol_nil(ctx->r)) {
3416 lbm_value e;
3417 476 lbm_pop(&ctx->K, &e);
3418 476 lbm_stack_drop(&ctx->K, 2);
3419 476 ctx->r = e;
3420 476 ctx->app_cont = true;
3421 } else {
3422 lbm_value body;
3423 lbm_value env;
3424 784 lbm_stack_drop(&ctx->K, 1);
3425 784 lbm_pop_2(&ctx->K, &body, &env);
3426 784 lbm_stack_drop(&ctx->K, 3);
3427 784 ctx->curr_env = env;
3428 784 ctx->curr_exp = body;
3429 }
3430 1260 }
3431
3432 28 static void cont_terminate(eval_context_t *ctx) {
3433 28 error_ctx(ctx->r);
3434 ✗ }
3435
3436 925148 static void cont_loop(eval_context_t *ctx) {
3437 925148 lbm_value *sptr = get_stack_ptr(ctx, 2);
3438 925148 stack_reserve(ctx,1)[0] = LOOP_CONDITION;
3439 925148 ctx->curr_exp = sptr[1];
3440 925148 }
3441
3442 925428 static void cont_loop_condition(eval_context_t *ctx) {
3443
2/2
✓ Branch 1 taken 280 times.
✓ Branch 2 taken 925148 times.
 925428 if (lbm_is_symbol_nil(ctx->r)) {
3444 280 lbm_stack_drop(&ctx->K, 2);
3445 280 ctx->app_cont = true; // A loop returns nil? Makes sense to me... but in general?
3446 280 return;
3447 }
3448 925148 lbm_value *sptr = get_stack_ptr(ctx, 2);
3449 925148 stack_reserve(ctx,1)[0] = LOOP;
3450 925148 ctx->curr_exp = sptr[0];
3451 }
3452
3453 8791580 static void cont_merge_rest(eval_context_t *ctx) {
3454 8791580 lbm_uint *sptr = get_stack_ptr(ctx, 9);
3455
3456 // If comparator returns true (result is in ctx->r):
3457 // "a" should be moved to the last element position in merged list.
3458 // A new element from "a_rest" should be moved into comparator argument 1 pos.
3459 // else
3460 // "b" should be moved to last element position in merged list.
3461 // A new element from "b_rest" should be moved into comparator argument 2 pos.
3462 //
3463 // If a_rest or b_rest is NIL:
3464 // we are done, the remaining elements of
3465 // non_nil list should be appended to merged list.
3466 // else
3467 // Set up for a new comparator evaluation and recurse.
3468 8791580 lbm_value a = sptr[2];
3469 8791580 lbm_value b = lbm_cdr(a);
3470 8791580 lbm_set_cdr(a, ENC_SYM_NIL); // terminate 1 element list
3471
3472
2/2
✓ Branch 0 taken 5102216 times.
✓ Branch 1 taken 3689364 times.
 8791580 if (ctx->r == ENC_SYM_NIL) { // Comparison false
3473
3474
2/2
✓ Branch 0 taken 1983576 times.
✓ Branch 1 taken 3118640 times.
 5102216 if (sptr[0] == ENC_SYM_NIL) {
3475 1983576 sptr[0] = b;
3476 1983576 sptr[1] = b;
3477 } else {
3478 3118640 lbm_set_cdr(sptr[1], b);
3479 3118640 sptr[1] = b;
3480 }
3481
2/2
✓ Branch 0 taken 2549456 times.
✓ Branch 1 taken 2552760 times.
 5102216 if (sptr[4] == ENC_SYM_NIL) {
3482 2549456 lbm_set_cdr(a, sptr[3]);
3483 2549456 lbm_set_cdr(sptr[1], a);
3484 2549456 ctx->r = sptr[0];
3485 2549456 lbm_stack_drop(&ctx->K, 9);
3486 2549456 ctx->app_cont = true;
3487 2549456 return;
3488 } else {
3489 2552760 b = sptr[4];
3490 2552760 sptr[4] = lbm_cdr(sptr[4]);
3491 2552760 lbm_set_cdr(b, ENC_SYM_NIL);
3492 }
3493 } else {
3494
2/2
✓ Branch 0 taken 1134812 times.
✓ Branch 1 taken 2554552 times.
 3689364 if (sptr[0] == ENC_SYM_NIL) {
3495 1134812 sptr[0] = a;
3496 1134812 sptr[1] = a;
3497 } else {
3498 2554552 lbm_set_cdr(sptr[1], a);
3499 2554552 sptr[1] = a;
3500 }
3501
3502
2/2
✓ Branch 0 taken 568932 times.
✓ Branch 1 taken 3120432 times.
 3689364 if (sptr[3] == ENC_SYM_NIL) {
3503 568932 lbm_set_cdr(b, sptr[4]);
3504 568932 lbm_set_cdr(sptr[1], b);
3505 568932 ctx->r = sptr[0];
3506 568932 lbm_stack_drop(&ctx->K, 9);
3507 568932 ctx->app_cont = true;
3508 568932 return;
3509 } else {
3510 3120432 a = sptr[3];
3511 3120432 sptr[3] = lbm_cdr(sptr[3]);
3512 3120432 lbm_set_cdr(a, ENC_SYM_NIL);
3513 }
3514 }
3515 5673192 lbm_set_cdr(a, b);
3516 5673192 sptr[2] = a;
3517
3518 5673192 lbm_value par1 = sptr[7];
3519 5673192 lbm_value par2 = sptr[8];
3520 5673192 lbm_value cmp_body = sptr[5];
3521 5673192 lbm_value cmp_env = sptr[6];
3522 // Environment should be preallocated already at this point
3523 // and the operations below should never need GC.
3524 5673192 lbm_value new_env0 = lbm_env_set(cmp_env, par1, lbm_car(a));
3525 5673192 lbm_value new_env = lbm_env_set(new_env0, par2, lbm_car(b));
3526
2/4
✓ Branch 1 taken 5673192 times.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 5673192 times.
 5673192 if (lbm_is_symbol(new_env0) || lbm_is_symbol(new_env)) {
3527 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
3528 }
3529 5673192 cmp_env = new_env;
3530
3531 5673192 stack_reserve(ctx,1)[0] = MERGE_REST;
3532 5673192 ctx->curr_exp = cmp_body;
3533 5673192 ctx->curr_env = cmp_env;
3534 }
3535
3536 // merge_layer stack contents
3537 // s[sp-9] = cmp
3538 // s[sp-8] = cmp_env
3539 // s[sp-7] = par1
3540 // s[sp-6] = par2
3541 // s[sp-5] = acc - first cell
3542 // s[sp-4] = acc - last cell
3543 // s[sp-3] = rest;
3544 // s[sp-2] = layer
3545 // s[sp-1] = length or original list
3546 //
3547 // ctx->r merged sublist
3548 3401272 static void cont_merge_layer(eval_context_t *ctx) {
3549 3401272 lbm_uint *sptr = get_stack_ptr(ctx, 9);
3550 3401272 lbm_int layer = lbm_dec_i(sptr[7]);
3551 3401272 lbm_int len = lbm_dec_i(sptr[8]);
3552
3553 3401272 lbm_value r_curr = ctx->r;
3554
1/2
✓ Branch 1 taken 13620600 times.
✗ Branch 2 not taken.
 13620600 while (lbm_is_cons(r_curr)) {
3555 13620600 lbm_value next = lbm_cdr(r_curr);
3556
2/2
✓ Branch 0 taken 3401272 times.
✓ Branch 1 taken 10219328 times.
 13620600 if (next == ENC_SYM_NIL) {
3557 3401272 break;
3558 }
3559 10219328 r_curr = next;
3560 }
3561
3562
2/2
✓ Branch 0 taken 1132348 times.
✓ Branch 1 taken 2268924 times.
 3401272 if (sptr[4] == ENC_SYM_NIL) {
3563 1132348 sptr[4] = ctx->r;
3564 1132348 sptr[5] = r_curr;
3565 } else {
3566 2268924 lbm_set_cdr(sptr[5], ctx->r); // accumulate merged sublists.
3567 2268924 sptr[5] = r_curr;
3568 }
3569
3570 3401272 lbm_value layer_rest = sptr[6];
3571 // switch layer or done ?
3572
2/2
✓ Branch 0 taken 1132348 times.
✓ Branch 1 taken 2268924 times.
 3401272 if (layer_rest == ENC_SYM_NIL) {
3573
2/2
✓ Branch 0 taken 283108 times.
✓ Branch 1 taken 849240 times.
 1132348 if (layer * 2 >= len) {
3574 283108 ctx->r = sptr[4];
3575 283108 ctx->app_cont = true;
3576 283108 lbm_stack_drop(&ctx->K, 9);
3577 283108 return;
3578 } else {
3579 // Setup for merges of the next layer
3580 849240 layer = layer * 2;
3581 849240 sptr[7] = lbm_enc_i(layer);
3582 849240 layer_rest = sptr[4]; // continue on the accumulation of all sublists.
3583 849240 sptr[5] = ENC_SYM_NIL;
3584 849240 sptr[4] = ENC_SYM_NIL;
3585 }
3586 }
3587 // merge another sublist based on current layer.
3588 3118164 lbm_value a_list = layer_rest;
3589 // build sublist a
3590 3118164 lbm_value curr = layer_rest;
3591
2/2
✓ Branch 0 taken 4543028 times.
✓ Branch 1 taken 3118052 times.
 7661080 for (int i = 0; i < layer-1; i ++) {
3592
2/2
✓ Branch 1 taken 4542916 times.
✓ Branch 2 taken 112 times.
 4543028 if (lbm_is_cons(curr)) {
3593 4542916 curr = lbm_cdr(curr);
3594 } else {
3595 112 break;
3596 }
3597 }
3598 3118164 layer_rest = lbm_cdr(curr);
3599 3118164 lbm_set_cdr(curr, ENC_SYM_NIL); //terminate sublist.
3600
3601 3118164 lbm_value b_list = layer_rest;
3602 // build sublist b
3603 3118164 curr = layer_rest;
3604
2/2
✓ Branch 0 taken 3407796 times.
✓ Branch 1 taken 2552004 times.
 5959800 for (int i = 0; i < layer-1; i ++) {
3605
2/2
✓ Branch 1 taken 2841636 times.
✓ Branch 2 taken 566160 times.
 3407796 if (lbm_is_cons(curr)) {
3606 2841636 curr = lbm_cdr(curr);
3607 } else {
3608 566160 break;
3609 }
3610 }
3611 3118164 layer_rest = lbm_cdr(curr);
3612 3118164 lbm_set_cdr(curr, ENC_SYM_NIL); //terminate sublist.
3613
3614 3118164 sptr[6] = layer_rest;
3615
3616
2/2
✓ Branch 0 taken 283192 times.
✓ Branch 1 taken 2834972 times.
 3118164 if (b_list == ENC_SYM_NIL) {
3617 283192 stack_reserve(ctx,1)[0] = MERGE_LAYER;
3618 283192 ctx->r = a_list;
3619 283192 ctx->app_cont = true;
3620 283192 return;
3621 }
3622 // Set up for a merge of sublists.
3623
3624 2834972 lbm_value a_rest = lbm_cdr(a_list);
3625 2834972 lbm_value b_rest = lbm_cdr(b_list);
3626 2834972 lbm_value a = a_list;
3627 2834972 lbm_value b = b_list;
3628 2834972 lbm_set_cdr(a, b);
3629 // Terminating the b list would be incorrect here
3630 // if there was any chance that the environment update below
3631 // performs GC.
3632 2834972 lbm_set_cdr(b, ENC_SYM_NIL);
3633
3634 2834972 lbm_value cmp_body = sptr[0];
3635 2834972 lbm_value cmp_env = sptr[1];
3636 2834972 lbm_value par1 = sptr[2];
3637 2834972 lbm_value par2 = sptr[3];
3638 // Environment should be preallocated already at this point
3639 // and the operations below should never need GC.
3640 2834972 lbm_value new_env0 = lbm_env_set(cmp_env, par1, lbm_car(a));
3641 2834972 lbm_value new_env = lbm_env_set(cmp_env, par2, lbm_car(b));
3642
2/4
✓ Branch 1 taken 2834972 times.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2834972 times.
 2834972 if (lbm_is_symbol(new_env0) || lbm_is_symbol(new_env)) {
3643 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
3644 }
3645 2834972 cmp_env = new_env;
3646
3647 2834972 lbm_uint *merge_cont = stack_reserve(ctx, 11);
3648 2834972 merge_cont[0] = MERGE_LAYER;
3649 2834972 merge_cont[1] = ENC_SYM_NIL;
3650 2834972 merge_cont[2] = ENC_SYM_NIL;
3651 2834972 merge_cont[3] = a;
3652 2834972 merge_cont[4] = a_rest;
3653 2834972 merge_cont[5] = b_rest;
3654 2834972 merge_cont[6] = cmp_body;
3655 2834972 merge_cont[7] = cmp_env;
3656 2834972 merge_cont[8] = par1;
3657 2834972 merge_cont[9] = par2;
3658 2834972 merge_cont[10] = MERGE_REST;
3659 2834972 ctx->curr_exp = cmp_body;
3660 2834972 ctx->curr_env = cmp_env;
3661 2834972 return;
3662 }
3663
3664 /****************************************************/
3665 /* READER */
3666
3667 33172 static void read_finish(lbm_char_channel_t *str, eval_context_t *ctx) {
3668
3669 /* Tokenizer reached "end of file"
3670 The parser could be in a state where it needs
3671 more tokens to correctly finish an expression.
3672
3673 Four cases
3674 1. The program / expression is malformed and the context should die.
3675 2. We are finished reading a program and should close off the
3676 internal representation with a closing parenthesis. Then
3677 apply continuation.
3678 3. We are finished reading an expression and should
3679 apply the continuation
3680 4. We are finished read-and-evaluating
3681
3682 In case 2, we should find the READ_DONE at sp - 5.
3683 In case 3, we should find the READ_DONE at sp - 1.
3684 In case 4, we should find the READ_DONE at sp - 4.
3685
3686 case 3 should not end up here, but rather end up in
3687 cont_read_done.
3688 */
3689
3690
2/2
✓ Branch 1 taken 10662 times.
✓ Branch 2 taken 22510 times.
 33172 if (lbm_is_symbol(ctx->r)) {
3691 10662 lbm_uint sym_val = lbm_dec_sym(ctx->r);
3692
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 10662 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 10662 if (sym_val >= TOKENIZER_SYMBOLS_START &&
3693 sym_val <= TOKENIZER_SYMBOLS_END) {
3694 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
3695 }
3696 }
3697
3698
3/4
✓ Branch 0 taken 33172 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 22028 times.
✓ Branch 3 taken 11144 times.
 33172 if (ctx->K.sp > 4 && (ctx->K.data[ctx->K.sp - 4] == READ_DONE) &&
3699
1/2
✓ Branch 0 taken 22028 times.
✗ Branch 1 not taken.
 22028 (ctx->K.data[ctx->K.sp - 5] == READING_PROGRAM_INCREMENTALLY)) {
3700 /* read and evaluate is done */
3701 lbm_value env;
3702 lbm_value s;
3703 lbm_value sym;
3704 22028 lbm_pop_3(&ctx->K, &sym, &env, &s);
3705 22028 ctx->curr_env = env;
3706 22028 ctx->app_cont = true; // Program evaluated and result is in ctx->r.
3707
2/4
✓ Branch 0 taken 11144 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 11144 times.
✗ Branch 3 not taken.
 11144 } else if (ctx->K.sp > 5 && (ctx->K.data[ctx->K.sp - 5] == READ_DONE) &&
3708
1/2
✓ Branch 0 taken 11144 times.
✗ Branch 1 not taken.
 11144 (ctx->K.data[ctx->K.sp - 6] == READING_PROGRAM)) {
3709 /* successfully finished reading a program (CASE 2) */
3710 11144 ctx->r = ENC_SYM_CLOSEPAR;
3711 11144 ctx->app_cont = true;
3712 } else {
3713 ✗ if (lbm_channel_row(str) == 1 && lbm_channel_column(str) == 1) {
3714 // (read "") evaluates to nil.
3715 ✗ ctx->r = ENC_SYM_NIL;
3716 ✗ ctx->app_cont = true;
3717 } else {
3718 ✗ lbm_channel_reader_close(str);
3719 ✗ lbm_set_error_reason((char*)lbm_error_str_parse_eof);
3720 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
3721 }
3722 }
3723 33172 }
3724
3725 /* cont_read_next_token
3726 sp-2 : Stream
3727 sp-1 : Grab row
3728 */
3729 5698919 static void cont_read_next_token(eval_context_t *ctx) {
3730 5698919 lbm_value *sptr = get_stack_ptr(ctx, 2);
3731 5698919 lbm_value stream = sptr[0];
3732 5698919 lbm_value grab_row0 = sptr[1];
3733
3734 5698919 lbm_char_channel_t *chan = lbm_dec_channel(stream);
3735
2/4
✓ Branch 0 taken 5698919 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 5698919 times.
 5698919 if (chan == NULL || chan->state == NULL) {
3736 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
3737 }
3738
3739
4/4
✓ Branch 1 taken 5287742 times.
✓ Branch 2 taken 411177 times.
✓ Branch 4 taken 11872 times.
✓ Branch 5 taken 5275870 times.
 5698919 if (!lbm_channel_more(chan) && lbm_channel_is_empty(chan)) {
3740 11872 lbm_stack_drop(&ctx->K, 2);
3741 11872 read_finish(chan, ctx);
3742 5698919 return;
3743 }
3744 /* Eat whitespace and comments */
3745
2/2
✓ Branch 1 taken 617 times.
✓ Branch 2 taken 5686430 times.
 5687047 if (!tok_clean_whitespace(chan)) {
3746 617 sptr[0] = stream;
3747 617 sptr[1] = lbm_enc_u(0);
3748 617 stack_reserve(ctx,1)[0] = READ_NEXT_TOKEN;
3749 617 yield_ctx(EVAL_CPS_MIN_SLEEP);
3750 617 return;
3751 }
3752 /* After eating whitespace we may be at end of file/stream */
3753
4/4
✓ Branch 1 taken 5276258 times.
✓ Branch 2 taken 410172 times.
✓ Branch 4 taken 21300 times.
✓ Branch 5 taken 5254958 times.
 5686430 if (!lbm_channel_more(chan) && lbm_channel_is_empty(chan)) {
3754 21300 lbm_stack_drop(&ctx->K, 2);
3755 21300 read_finish(chan, ctx);
3756 21300 return;
3757 }
3758
3759
2/2
✓ Branch 1 taken 377987 times.
✓ Branch 2 taken 5287143 times.
 5665130 if (lbm_dec_u(grab_row0)) {
3760 377987 ctx->row0 = (int32_t)lbm_channel_row(chan);
3761 377987 ctx->row1 = -1; // a new start, end is unknown
3762 }
3763
3764 /* Attempt to extract tokens from the character stream */
3765 5665130 int n = 0;
3766 5665130 lbm_value res = ENC_SYM_NIL;
3767 5665130 unsigned int string_len = 0;
3768
3769 /*
3770 * SYNTAX
3771 */
3772 uint32_t match;
3773 5665130 n = tok_syntax(chan, &match);
3774
2/2
✓ Branch 0 taken 1403190 times.
✓ Branch 1 taken 4261940 times.
 5665130 if (n > 0) {
3775
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 1403190 times.
 1403190 if (!lbm_channel_drop(chan, (unsigned int)n)) {
3776 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
3777 }
3778 1403190 ctx->app_cont = true;
3779
14/15
✓ Branch 0 taken 665923 times.
✓ Branch 1 taken 665923 times.
✓ Branch 2 taken 3248 times.
✓ Branch 3 taken 3248 times.
✓ Branch 4 taken 6216 times.
✓ Branch 5 taken 1008 times.
✓ Branch 6 taken 27216 times.
✓ Branch 7 taken 5012 times.
✓ Branch 8 taken 56 times.
✓ Branch 9 taken 13860 times.
✓ Branch 10 taken 6832 times.
✓ Branch 11 taken 2296 times.
✓ Branch 12 taken 2296 times.
✓ Branch 13 taken 56 times.
✗ Branch 14 not taken.
 1403190 switch(match) {
3780 665923 case TOKOPENPAR: {
3781 665923 sptr[0] = ENC_SYM_NIL;
3782 665923 sptr[1] = ENC_SYM_NIL;
3783 665923 lbm_value *rptr = stack_reserve(ctx,5);
3784 665923 rptr[0] = stream;
3785 665923 rptr[1] = READ_APPEND_CONTINUE;
3786 665923 rptr[2] = stream;
3787 665923 rptr[3] = lbm_enc_u(0);
3788 665923 rptr[4] = READ_NEXT_TOKEN;
3789 665923 ctx->r = ENC_SYM_OPENPAR;
3790 665923 } return;
3791 665923 case TOKCLOSEPAR: {
3792 665923 lbm_stack_drop(&ctx->K, 2);
3793 665923 ctx->r = ENC_SYM_CLOSEPAR;
3794 665923 } return;
3795 3248 case TOKOPENBRACK: {
3796 3248 sptr[0] = stream;
3797 3248 sptr[1] = READ_START_ARRAY;
3798 3248 lbm_value *rptr = stack_reserve(ctx, 3);
3799 3248 rptr[0] = stream;
3800 3248 rptr[1] = lbm_enc_u(0);
3801 3248 rptr[2] = READ_NEXT_TOKEN;
3802 3248 ctx->r = ENC_SYM_OPENBRACK;
3803 3248 } return;
3804 3248 case TOKCLOSEBRACK:
3805 3248 lbm_stack_drop(&ctx->K, 2);
3806 3248 ctx->r = ENC_SYM_CLOSEBRACK;
3807 3248 return;
3808 6216 case TOKDOT:
3809 6216 lbm_stack_drop(&ctx->K, 2);
3810 6216 ctx->r = ENC_SYM_DOT;
3811 6216 return;
3812 1008 case TOKDONTCARE:
3813 1008 lbm_stack_drop(&ctx->K, 2);
3814 1008 ctx->r = ENC_SYM_DONTCARE;
3815 1008 return;
3816 27216 case TOKQUOTE:
3817 27216 sptr[0] = ENC_SYM_QUOTE;
3818 27216 sptr[1] = WRAP_RESULT;
3819 27216 break;
3820 5012 case TOKBACKQUOTE: {
3821 5012 sptr[0] = QQ_EXPAND_START;
3822 5012 sptr[1] = stream;
3823 5012 lbm_value *rptr = stack_reserve(ctx, 2);
3824 5012 rptr[0] = lbm_enc_u(0);
3825 5012 rptr[1] = READ_NEXT_TOKEN;
3826 5012 ctx->app_cont = true;
3827 5012 } return;
3828 56 case TOKCOMMAAT:
3829 56 sptr[0] = ENC_SYM_COMMAAT;
3830 56 sptr[1] = WRAP_RESULT;
3831 56 break;
3832 13860 case TOKCOMMA:
3833 13860 sptr[0] = ENC_SYM_COMMA;
3834 13860 sptr[1] = WRAP_RESULT;
3835 13860 break;
3836 6832 case TOKMATCHANY:
3837 6832 lbm_stack_drop(&ctx->K, 2);
3838 6832 ctx->r = ENC_SYM_MATCH_ANY;
3839 6832 return;
3840 2296 case TOKOPENCURL: {
3841 2296 sptr[0] = ENC_SYM_NIL;
3842 2296 sptr[1] = ENC_SYM_NIL;
3843 2296 lbm_value *rptr = stack_reserve(ctx,2);
3844 2296 rptr[0] = stream;
3845 2296 rptr[1] = READ_APPEND_CONTINUE;
3846 2296 ctx->r = ENC_SYM_PROGN;
3847 2296 } return;
3848 2296 case TOKCLOSECURL:
3849 2296 lbm_stack_drop(&ctx->K, 2);
3850 2296 ctx->r = ENC_SYM_CLOSEPAR;
3851 2296 return;
3852 56 case TOKCONSTSTART: /* fall through */
3853 case TOKCONSTEND: {
3854
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 28 times.
 56 if (match == TOKCONSTSTART) ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST;
3855
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 28 times.
 56 if (match == TOKCONSTEND) ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_CONST;
3856 56 sptr[0] = stream;
3857 56 sptr[1] = lbm_enc_u(0);
3858 56 stack_reserve(ctx,1)[0] = READ_NEXT_TOKEN;
3859 56 ctx->app_cont = true;
3860 56 } return;
3861 ✗ default:
3862 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
3863 }
3864 // read next token
3865 41132 lbm_value *rptr = stack_reserve(ctx, 3);
3866 41132 rptr[0] = stream;
3867 41132 rptr[1] = lbm_enc_u(0);
3868 41132 rptr[2] = READ_NEXT_TOKEN;
3869 41132 ctx->app_cont = true;
3870 41132 return;
3871
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4261940 times.
 4261940 } else if (n < 0) goto retry_token;
3872
3873 /*
3874 * STRING
3875 */
3876 4261940 n = tok_string(chan, &string_len);
3877
2/2
✓ Branch 0 taken 9380 times.
✓ Branch 1 taken 4252560 times.
 4261940 if (n >= 2) {
3878 9380 lbm_channel_drop(chan, (unsigned int)n);
3879 #ifdef LBM_ALWAYS_GC
3880 gc();
3881 #endif
3882
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 9380 times.
 9380 if (!lbm_heap_allocate_array(&res, (unsigned int)(string_len+1))) {
3883 ✗ gc();
3884 ✗ lbm_heap_allocate_array(&res, (unsigned int)(string_len+1));
3885 }
3886
1/2
✓ Branch 1 taken 9380 times.
✗ Branch 2 not taken.
 9380 if (lbm_is_ptr(res)) {
3887 9380 lbm_array_header_t *arr = assume_array(res);
3888 9380 char *data = (char*)arr->data;
3889 9380 memset(data,0, string_len + 1);
3890 9380 memcpy(data, tokpar_sym_str, string_len);
3891 9380 lbm_stack_drop(&ctx->K, 2);
3892 9380 ctx->r = res;
3893 9380 ctx->app_cont = true;
3894 9380 return;
3895 } else {
3896 ✗ error_ctx(ENC_SYM_MERROR);
3897 }
3898
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4252560 times.
 4252560 } else if (n < 0) goto retry_token;
3899
3900 /*
3901 * FLOAT
3902 */
3903 token_float f_val;
3904 4252560 n = tok_double(chan, &f_val);
3905
2/2
✓ Branch 0 taken 13076 times.
✓ Branch 1 taken 4239484 times.
 4252560 if (n > 0) {
3906 13076 lbm_channel_drop(chan, (unsigned int) n);
3907
2/3
✓ Branch 0 taken 10052 times.
✓ Branch 1 taken 3024 times.
✗ Branch 2 not taken.
 13076 switch(f_val.type) {
3908 10052 case TOKTYPEF32:
3909
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 10052 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 10052 WITH_GC(res, lbm_enc_float((float)f_val.value));
3910 10052 break;
3911 3024 case TOKTYPEF64:
3912 3024 res = lbm_enc_double(f_val.value);
3913 3024 break;
3914 ✗ default:
3915 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
3916 }
3917 13076 lbm_stack_drop(&ctx->K, 2);
3918 13076 ctx->r = res;
3919 13076 ctx->app_cont = true;
3920 13076 return;
3921
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4239484 times.
 4239484 } else if (n < 0) goto retry_token;
3922
3923 /*
3924 * INTEGER
3925 */
3926 token_int int_result;
3927 4239484 n = tok_integer(chan, &int_result);
3928
2/2
✓ Branch 0 taken 3356807 times.
✓ Branch 1 taken 882677 times.
 4239484 if (n > 0) {
3929 3356807 lbm_channel_drop(chan, (unsigned int)n);
3930
7/8
✓ Branch 0 taken 2212 times.
✓ Branch 1 taken 3335751 times.
✓ Branch 2 taken 3500 times.
✓ Branch 3 taken 3668 times.
✓ Branch 4 taken 4480 times.
✓ Branch 5 taken 3780 times.
✓ Branch 6 taken 3416 times.
✗ Branch 7 not taken.
 3356807 switch(int_result.type) {
3931 2212 case TOKTYPEBYTE:
3932
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2212 times.
 2212 res = lbm_enc_char((uint8_t)(int_result.negative ? -int_result.value : int_result.value));
3933 2212 break;
3934 3335751 case TOKTYPEI:
3935
2/2
✓ Branch 0 taken 1456 times.
✓ Branch 1 taken 3334295 times.
 3335751 res = lbm_enc_i((lbm_int)(int_result.negative ? -int_result.value : int_result.value));
3936 3335751 break;
3937 3500 case TOKTYPEU:
3938
2/2
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 3444 times.
 3500 res = lbm_enc_u((lbm_uint)(int_result.negative ? -int_result.value : int_result.value));
3939 3500 break;
3940 3668 case TOKTYPEI32:
3941
3/8
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 3612 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3668 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
 3668 WITH_GC(res, lbm_enc_i32((int32_t)(int_result.negative ? -int_result.value : int_result.value)));
3942 3668 break;
3943 4480 case TOKTYPEU32:
3944
3/8
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 4424 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 4480 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
 4480 WITH_GC(res,lbm_enc_u32((uint32_t)(int_result.negative ? -int_result.value : int_result.value)));
3945 4480 break;
3946 3780 case TOKTYPEI64:
3947
3/8
✓ Branch 0 taken 84 times.
✓ Branch 1 taken 3696 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3780 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
 3780 WITH_GC(res,lbm_enc_i64((int64_t)(int_result.negative ? -int_result.value : int_result.value)));
3948 3780 break;
3949 3416 case TOKTYPEU64:
3950
3/8
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 3360 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3416 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
 3416 WITH_GC(res,lbm_enc_u64((uint64_t)(int_result.negative ? -int_result.value : int_result.value)));
3951 3416 break;
3952 ✗ default:
3953 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
3954 }
3955 3356807 lbm_stack_drop(&ctx->K, 2);
3956 3356807 ctx->r = res;
3957 3356807 ctx->app_cont = true;
3958 3356807 return;
3959
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 882677 times.
 882677 } else if (n < 0) goto retry_token;
3960
3961 /*
3962 * SYMBOL
3963 */
3964 882677 n = tok_symbol(chan);
3965
2/2
✓ Branch 0 taken 882502 times.
✓ Branch 1 taken 175 times.
 882677 if (n > 0) {
3966 882502 lbm_channel_drop(chan, (unsigned int) n);
3967 lbm_uint symbol_id;
3968
2/2
✓ Branch 1 taken 99358 times.
✓ Branch 2 taken 783144 times.
 882502 if (!lbm_get_symbol_by_name(tokpar_sym_str, &symbol_id)) {
3969 99358 int r = 0;
3970
2/2
✓ Branch 0 taken 23646 times.
✓ Branch 1 taken 75712 times.
 99358 if (n > 4 &&
3971
2/2
✓ Branch 0 taken 378 times.
✓ Branch 1 taken 23268 times.
 23646 tokpar_sym_str[0] == 'e' &&
3972
2/2
✓ Branch 0 taken 42 times.
✓ Branch 1 taken 336 times.
 378 tokpar_sym_str[1] == 'x' &&
3973
1/2
✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
 42 tokpar_sym_str[2] == 't' &&
3974
2/2
✓ Branch 0 taken 14 times.
✓ Branch 1 taken 28 times.
 56 tokpar_sym_str[3] == '-') {
3975 lbm_uint ext_id;
3976 14 lbm_uint ext_name_len = (lbm_uint)n + 1;
3977 #ifdef LBM_ALWAYS_GC
3978 gc();
3979 #endif
3980 14 char *ext_name = lbm_malloc(ext_name_len);
3981
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 14 times.
 14 if (!ext_name) {
3982 ✗ gc();
3983 ✗ ext_name = lbm_malloc(ext_name_len);
3984 }
3985
1/2
✓ Branch 0 taken 14 times.
✗ Branch 1 not taken.
 14 if (ext_name) {
3986 14 memcpy(ext_name, tokpar_sym_str, ext_name_len);
3987 14 r = lbm_add_extension(ext_name, lbm_extensions_default);
3988
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 14 times.
 14 if (!lbm_lookup_extension_id(ext_name, &ext_id)) {
3989 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
3990 }
3991 14 symbol_id = ext_id;
3992 } else {
3993 ✗ error_ctx(ENC_SYM_MERROR);
3994 }
3995 } else {
3996
2/2
✓ Branch 0 taken 140 times.
✓ Branch 1 taken 99204 times.
 99344 if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST &&
3997
2/2
✓ Branch 0 taken 70 times.
✓ Branch 1 taken 70 times.
 140 ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ) {
3998 70 r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id, true); //flash
3999
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 70 times.
 70 if (!r) {
4000 ✗ lbm_set_error_reason((char*)lbm_error_str_flash_error);
4001 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4002 }
4003 } else {
4004 #ifdef LBM_ALWAYS_GC
4005 gc();
4006 #endif
4007 99274 r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
4008
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 99274 times.
 99274 if (!r) {
4009 ✗ gc();
4010 ✗ r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
4011 }
4012 }
4013 }
4014
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 99358 times.
 99358 if (!r) {
4015 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
4016 }
4017 }
4018 882502 lbm_stack_drop(&ctx->K, 2);
4019 882502 ctx->r = lbm_enc_sym(symbol_id);
4020 882502 ctx->app_cont = true;
4021 882502 return;
4022
2/2
✓ Branch 0 taken 7 times.
✓ Branch 1 taken 168 times.
 175 } else if (n == TOKENIZER_NEED_MORE) {
4023 7 goto retry_token;
4024
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 168 times.
 168 } else if (n <= TOKENIZER_STRING_ERROR) {
4025 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
4026 }
4027
4028 /*
4029 * CHAR
4030 */
4031 char c_val;
4032 168 n = tok_char(chan, &c_val);
4033
1/2
✓ Branch 0 taken 168 times.
✗ Branch 1 not taken.
 168 if(n > 0) {
4034 168 lbm_channel_drop(chan,(unsigned int) n);
4035 168 lbm_stack_drop(&ctx->K, 2);
4036 168 ctx->r = lbm_enc_char((uint8_t)c_val);
4037 168 ctx->app_cont = true;
4038 168 return;
4039 ✗ }else if (n < 0) goto retry_token;
4040
4041 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
4042
4043 7 retry_token:
4044
1/2
✓ Branch 0 taken 7 times.
✗ Branch 1 not taken.
 7 if (n == TOKENIZER_NEED_MORE) {
4045 7 sptr[0] = stream;
4046 7 sptr[1] = lbm_enc_u(0);
4047 7 stack_reserve(ctx,1)[0] = READ_NEXT_TOKEN;
4048 7 yield_ctx(EVAL_CPS_MIN_SLEEP);
4049 7 return;
4050 }
4051 ✗ read_error_ctx(lbm_channel_row(chan), lbm_channel_column(chan));
4052 }
4053
4054 3248 static void cont_read_start_array(eval_context_t *ctx) {
4055 3248 lbm_value *sptr = get_stack_ptr(ctx, 1);
4056 3248 lbm_value stream = sptr[0];
4057
4058 3248 lbm_char_channel_t *str = lbm_dec_channel(stream);
4059
2/4
✓ Branch 0 taken 3248 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 3248 times.
 3248 if (str == NULL || str->state == NULL) {
4060 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4061 }
4062
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3248 times.
 3248 if (ctx->r == ENC_SYM_CLOSEBRACK) {
4063 lbm_value array;
4064
4065 ✗ if (!lbm_heap_allocate_array(&array, 0)) {
4066 ✗ gc();
4067 ✗ if (!lbm_heap_allocate_array(&array, 0)) {
4068 ✗ lbm_set_error_reason((char*)lbm_error_str_read_no_mem);
4069 ✗ lbm_channel_reader_close(str);
4070 ✗ error_ctx(ENC_SYM_FATAL_ERROR); // Terminates ctx
4071 }
4072 }
4073 ✗ lbm_stack_drop(&ctx->K, 1);
4074 ✗ ctx->r = array;
4075 ✗ ctx->app_cont = true;
4076
1/2
✓ Branch 1 taken 3248 times.
✗ Branch 2 not taken.
 3248 } else if (lbm_is_number(ctx->r)) {
4077 #ifdef LBM_ALWAYS_GC
4078 gc();
4079 #endif
4080 3248 lbm_uint num_free = lbm_memory_longest_free();
4081 3248 lbm_uint initial_size = (lbm_uint)((float)num_free * 0.9);
4082
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3248 times.
 3248 if (initial_size == 0) {
4083 ✗ gc();
4084 ✗ num_free = lbm_memory_longest_free();
4085 ✗ initial_size = (lbm_uint)((float)num_free * 0.9);
4086 ✗ if (initial_size == 0) {
4087 ✗ lbm_channel_reader_close(str);
4088 ✗ error_ctx(ENC_SYM_MERROR);
4089 }
4090 }
4091 lbm_value array;
4092 3248 initial_size = sizeof(lbm_uint) * initial_size;
4093
4094 // Keep in mind that this allocation can fail for both
4095 // lbm_memory and heap reasons.
4096
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 3248 times.
 3248 if (!lbm_heap_allocate_array(&array, initial_size)) {
4097 ✗ gc();
4098 ✗ if (!lbm_heap_allocate_array(&array, initial_size)) {
4099 ✗ lbm_set_error_reason((char*)lbm_error_str_read_no_mem);
4100 ✗ lbm_channel_reader_close(str);
4101 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4102 // NOTE: If array is not created evaluation ends here.
4103 // Static analysis seems unaware.
4104 }
4105 }
4106
4107 3248 sptr[0] = array;
4108 3248 lbm_value *rptr = stack_reserve(ctx, 4);
4109 3248 rptr[0] = lbm_enc_u(initial_size);
4110 3248 rptr[1] = lbm_enc_u(0);
4111 3248 rptr[2] = stream;
4112 3248 rptr[3] = READ_APPEND_ARRAY;
4113 3248 ctx->app_cont = true;
4114 } else {
4115 ✗ lbm_channel_reader_close(str);
4116 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4117 }
4118 3248 }
4119
4120 371000 static void cont_read_append_array(eval_context_t *ctx) {
4121 371000 lbm_uint *sptr = get_stack_ptr(ctx, 4);
4122
4123 371000 lbm_value array = sptr[0];
4124 371000 lbm_value size = lbm_dec_as_u32(sptr[1]);
4125 371000 lbm_value ix = lbm_dec_as_u32(sptr[2]);
4126 371000 lbm_value stream = sptr[3];
4127
4128
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 371000 times.
 371000 if (ix >= (size - 1)) {
4129 ✗ error_ctx(ENC_SYM_MERROR);
4130 }
4131
4132 // if sptr[0] is not an array something is very very wrong.
4133 // Not robust against a garbage on stack. But how would garbage get onto stack?
4134 371000 lbm_array_header_t *arr = assume_array(array);
4135
2/2
✓ Branch 1 taken 367752 times.
✓ Branch 2 taken 3248 times.
 371000 if (lbm_is_number(ctx->r)) {
4136 367752 ((uint8_t*)arr->data)[ix] = (uint8_t)lbm_dec_as_u32(ctx->r);
4137
4138 367752 sptr[2] = lbm_enc_u(ix + 1);
4139 367752 lbm_value *rptr = stack_reserve(ctx, 4);
4140 367752 rptr[0] = READ_APPEND_ARRAY;
4141 367752 rptr[1] = stream;
4142 367752 rptr[2] = lbm_enc_u(0);
4143 367752 rptr[3] = READ_NEXT_TOKEN;
4144 367752 ctx->app_cont = true;
4145
2/4
✓ Branch 1 taken 3248 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 3248 times.
✗ Branch 4 not taken.
 3248 } else if (lbm_is_symbol(ctx->r) && ctx->r == ENC_SYM_CLOSEBRACK) {
4146 3248 lbm_uint array_size = ix / sizeof(lbm_uint);
4147
4148
2/2
✓ Branch 0 taken 2436 times.
✓ Branch 1 taken 812 times.
 3248 if (ix % sizeof(lbm_uint) != 0) {
4149 2436 array_size = array_size + 1;
4150 }
4151 3248 lbm_memory_shrink((lbm_uint*)arr->data, array_size);
4152 3248 arr->size = ix;
4153 3248 lbm_stack_drop(&ctx->K, 4);
4154 3248 ctx->r = array;
4155 3248 ctx->app_cont = true;
4156 } else {
4157 ✗ error_ctx(ENC_SYM_TERROR);
4158 }
4159 371000 }
4160
4161 4882062 static void cont_read_append_continue(eval_context_t *ctx) {
4162 4882062 lbm_value *sptr = get_stack_ptr(ctx, 3);
4163
4164 4882062 lbm_value first_cell = sptr[0];
4165 4882062 lbm_value last_cell = sptr[1];
4166 4882062 lbm_value stream = sptr[2];
4167
4168 4882062 lbm_char_channel_t *str = lbm_dec_channel(stream);
4169
2/4
✓ Branch 0 taken 4882062 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 4882062 times.
 4882062 if (str == NULL || str->state == NULL) {
4170 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4171 }
4172
4173
2/2
✓ Branch 1 taken 1527173 times.
✓ Branch 2 taken 3354889 times.
 4882062 if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL) {
4174
4175
3/3
✓ Branch 0 taken 673147 times.
✓ Branch 1 taken 6216 times.
✓ Branch 2 taken 847810 times.
 1527173 switch(ctx->r) {
4176 673147 case ENC_SYM_CLOSEPAR:
4177
2/2
✓ Branch 1 taken 670487 times.
✓ Branch 2 taken 2660 times.
 673147 if (lbm_type_of(last_cell) == LBM_TYPE_CONS) {
4178 670487 lbm_set_cdr(last_cell, ENC_SYM_NIL); // terminate the list
4179 670487 ctx->r = first_cell;
4180 } else {
4181 2660 ctx->r = ENC_SYM_NIL;
4182 }
4183 673147 lbm_stack_drop(&ctx->K, 3);
4184 /* Skip reading another token and apply the continuation */
4185 673147 ctx->app_cont = true;
4186 673147 return;
4187 6216 case ENC_SYM_DOT: {
4188 6216 lbm_value *rptr = stack_reserve(ctx, 4);
4189 6216 rptr[0] = READ_DOT_TERMINATE;
4190 6216 rptr[1] = stream;
4191 6216 rptr[2] = lbm_enc_u(0);
4192 6216 rptr[3] = READ_NEXT_TOKEN;
4193 6216 ctx->app_cont = true;
4194 6216 } return;
4195 }
4196 }
4197 4202699 lbm_value new_cell = cons_with_gc(ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
4198
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 4202699 times.
 4202699 if (lbm_is_symbol_merror(new_cell)) {
4199 ✗ lbm_channel_reader_close(str);
4200 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4201 ✗ return;
4202 }
4203
2/2
✓ Branch 1 taken 3525996 times.
✓ Branch 2 taken 676703 times.
 4202699 if (lbm_type_of(last_cell) == LBM_TYPE_CONS) {
4204 3525996 lbm_set_cdr(last_cell, new_cell);
4205 3525996 last_cell = new_cell;
4206 } else {
4207 676703 first_cell = last_cell = new_cell;
4208 }
4209 4202699 sptr[0] = first_cell;
4210 4202699 sptr[1] = last_cell;
4211 4202699 sptr[2] = stream; // unchanged.
4212 4202699 lbm_value *rptr = stack_reserve(ctx, 4);
4213 4202699 rptr[0] = READ_APPEND_CONTINUE;
4214 4202699 rptr[1] = stream;
4215 4202699 rptr[2] = lbm_enc_u(0);
4216 4202699 rptr[3] = READ_NEXT_TOKEN;
4217 4202699 ctx->app_cont = true;
4218 }
4219
4220 69817 static void cont_read_eval_continue(eval_context_t *ctx) {
4221 lbm_value env;
4222 lbm_value stream;
4223 69817 lbm_pop_2(&ctx->K, &env, &stream);
4224
4225 69817 lbm_char_channel_t *str = lbm_dec_channel(stream);
4226
2/4
✓ Branch 0 taken 69817 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 69817 times.
✗ Branch 3 not taken.
 69817 if (str && str->state) {
4227 69817 ctx->row1 = (lbm_int)str->row(str);
4228
2/2
✓ Branch 1 taken 5600 times.
✓ Branch 2 taken 64217 times.
 69817 if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL) {
4229
1/3
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 5600 times.
 5600 switch(ctx->r) {
4230 ✗ case ENC_SYM_CLOSEPAR:
4231 ✗ ctx->app_cont = true;
4232 ✗ return;
4233 ✗ case ENC_SYM_DOT:
4234 // A dot here is a syntax error.
4235 ✗ lbm_set_error_reason((char*)lbm_error_str_parse_dot);
4236 ✗ read_error_ctx(lbm_channel_row(str),lbm_channel_column(str));
4237 ✗ return;
4238 }
4239 }
4240 69817 lbm_value *rptr = stack_reserve(ctx, 8);
4241 69817 rptr[0] = stream;
4242 69817 rptr[1] = env;
4243 69817 rptr[2] = READ_EVAL_CONTINUE;
4244 69817 rptr[3] = stream;
4245 69817 rptr[4] = lbm_enc_u(1);
4246 69817 rptr[5] = READ_NEXT_TOKEN;
4247 69817 rptr[6] = lbm_enc_u(ctx->flags);
4248 69817 rptr[7] = POP_READER_FLAGS;
4249
4250 69817 ctx->curr_env = env;
4251 69817 ctx->curr_exp = ctx->r;
4252 } else {
4253 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4254 }
4255 }
4256
4257 6216 static void cont_read_expect_closepar(eval_context_t *ctx) {
4258 lbm_value res;
4259 lbm_value stream;
4260
4261 6216 lbm_pop_2(&ctx->K, &res, &stream);
4262
4263 6216 lbm_char_channel_t *str = lbm_dec_channel(stream);
4264
2/4
✓ Branch 0 taken 6216 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6216 times.
 6216 if (str == NULL || str->state == NULL) {
4265 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4266 }
4267
4268
1/2
✓ Branch 1 taken 6216 times.
✗ Branch 2 not taken.
 6216 if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL &&
4269
1/2
✓ Branch 0 taken 6216 times.
✗ Branch 1 not taken.
 6216 ctx->r == ENC_SYM_CLOSEPAR) {
4270 6216 ctx->r = res;
4271 6216 ctx->app_cont = true;
4272 } else {
4273 ✗ lbm_channel_reader_close(str);
4274 ✗ lbm_set_error_reason((char*)lbm_error_str_parse_close);
4275 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4276 }
4277 6216 }
4278
4279 6216 static void cont_read_dot_terminate(eval_context_t *ctx) {
4280 6216 lbm_value *sptr = get_stack_ptr(ctx, 3);
4281
4282 6216 lbm_value first_cell = sptr[0];
4283 6216 lbm_value last_cell = sptr[1];
4284 6216 lbm_value stream = sptr[2];
4285
4286 6216 lbm_char_channel_t *str = lbm_dec_channel(stream);
4287
2/4
✓ Branch 0 taken 6216 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6216 times.
 6216 if (str == NULL || str->state == NULL) {
4288 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4289 }
4290
4291 6216 lbm_stack_drop(&ctx->K ,3);
4292
4293
2/2
✓ Branch 1 taken 1736 times.
✓ Branch 2 taken 4480 times.
 6216 if (lbm_type_of(ctx->r) == LBM_TYPE_SYMBOL &&
4294
1/2
✓ Branch 0 taken 1736 times.
✗ Branch 1 not taken.
 1736 (ctx->r == ENC_SYM_CLOSEPAR ||
4295
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1736 times.
 1736 ctx->r == ENC_SYM_DOT)) {
4296 ✗ lbm_channel_reader_close(str);
4297 ✗ lbm_set_error_reason((char*)lbm_error_str_parse_dot);
4298 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4299 } else {
4300
1/2
✓ Branch 1 taken 6216 times.
✗ Branch 2 not taken.
 6216 if (lbm_is_cons(last_cell)) {
4301 6216 lbm_set_cdr(last_cell, ctx->r);
4302 6216 ctx->r = first_cell;
4303 6216 lbm_value *rptr = stack_reserve(ctx, 6);
4304 6216 rptr[0] = stream;
4305 6216 rptr[1] = ctx->r;
4306 6216 rptr[2] = READ_EXPECT_CLOSEPAR;
4307 6216 rptr[3] = stream;
4308 6216 rptr[4] = lbm_enc_u(0);
4309 6216 rptr[5] = READ_NEXT_TOKEN;
4310 6216 ctx->app_cont = true;
4311 } else {
4312 ✗ lbm_channel_reader_close(str);
4313 ✗ lbm_set_error_reason((char*)lbm_error_str_parse_dot);
4314 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4315 }
4316 }
4317 6216 }
4318
4319 330223 static void cont_read_done(eval_context_t *ctx) {
4320 lbm_value stream;
4321 lbm_value f_val;
4322 lbm_value reader_mode;
4323 330223 lbm_pop_3(&ctx->K, &reader_mode, &stream, &f_val);
4324
4325 330223 uint32_t flags = lbm_dec_as_u32(f_val);
4326 330223 ctx->flags &= ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK;
4327 330223 ctx->flags |= (flags & EVAL_CPS_CONTEXT_READER_FLAGS_MASK);
4328
4329 330223 lbm_char_channel_t *str = lbm_dec_channel(stream);
4330
2/4
✓ Branch 0 taken 330223 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 330223 times.
 330223 if (str == NULL || str->state == NULL) {
4331 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4332 }
4333
4334 330223 lbm_channel_reader_close(str);
4335
2/2
✓ Branch 1 taken 22335 times.
✓ Branch 2 taken 307888 times.
 330223 if (lbm_is_symbol(ctx->r)) {
4336 22335 lbm_uint sym_val = lbm_dec_sym(ctx->r);
4337
3/4
✓ Branch 0 taken 11676 times.
✓ Branch 1 taken 10659 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 11676 times.
 22335 if (sym_val >= TOKENIZER_SYMBOLS_START &&
4338 sym_val <= TOKENIZER_SYMBOLS_END) {
4339 ✗ read_error_ctx(lbm_channel_row(str), lbm_channel_column(str));
4340 }
4341 }
4342 330223 ctx->row0 = -1;
4343 330223 ctx->row1 = -1;
4344 330223 ctx->app_cont = true;
4345 330223 }
4346
4347 41132 static void cont_wrap_result(eval_context_t *ctx) {
4348 lbm_value cell;
4349 lbm_value wrapper;
4350 41132 lbm_pop(&ctx->K, &wrapper);
4351
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 41132 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 41132 WITH_GC(cell, lbm_heap_allocate_list_init(2,
4352 wrapper,
4353 ctx->r));
4354 41132 ctx->r = cell;
4355 41132 ctx->app_cont = true;
4356 41132 }
4357
4358 105083425 static void cont_application_start(eval_context_t *ctx) {
4359
4360 /* sptr[0] = env
4361 * sptr[1] = args
4362 * ctx->r = function
4363 */
4364
4365
2/2
✓ Branch 1 taken 77988578 times.
✓ Branch 2 taken 27094847 times.
 105083425 if (lbm_is_symbol(ctx->r)) {
4366 77988578 stack_reserve(ctx,1)[0] = lbm_enc_u(0);
4367 77988578 cont_application_args(ctx);
4368
1/2
✓ Branch 1 taken 27094847 times.
✗ Branch 2 not taken.
 27094847 } else if (lbm_is_cons(ctx->r)) {
4369 27094847 lbm_uint *sptr = get_stack_ptr(ctx, 2);
4370 27094847 lbm_value args = (lbm_value)sptr[1];
4371
3/4
✓ Branch 1 taken 27088491 times.
✓ Branch 2 taken 196 times.
✓ Branch 3 taken 6160 times.
✗ Branch 4 not taken.
 27094847 switch (get_car(ctx->r)) {
4372 27088491 case ENC_SYM_CLOSURE: {
4373 lbm_value cl[3];
4374 27088491 extract_n(get_cdr(ctx->r), cl, 3);
4375 27088491 lbm_value arg_env = (lbm_value)sptr[0];
4376 lbm_value arg0, arg_rest;
4377 27088491 get_car_and_cdr(args, &arg0, &arg_rest);
4378 27088491 sptr[1] = cl[CLO_BODY];
4379 27088491 bool a_nil = lbm_is_symbol_nil(args);
4380 27088491 bool p_nil = lbm_is_symbol_nil(cl[CLO_PARAMS]);
4381 27088491 lbm_value *reserved = stack_reserve(ctx, 4);
4382
4383
4/4
✓ Branch 0 taken 26770831 times.
✓ Branch 1 taken 317660 times.
✓ Branch 2 taken 26210803 times.
✓ Branch 3 taken 560028 times.
 27088491 if (!a_nil && !p_nil) {
4384 26210803 reserved[0] = cl[CLO_ENV];
4385 26210803 reserved[1] = cl[CLO_PARAMS];
4386 26210803 reserved[2] = arg_rest;
4387 26210803 reserved[3] = CLOSURE_ARGS;
4388 26210803 ctx->curr_exp = arg0;
4389 26210803 ctx->curr_env = arg_env;
4390
3/4
✓ Branch 0 taken 317660 times.
✓ Branch 1 taken 560028 times.
✓ Branch 2 taken 317660 times.
✗ Branch 3 not taken.
 877688 } else if (a_nil && p_nil) {
4391 // No params, No args
4392 317660 lbm_stack_drop(&ctx->K, 6);
4393 317660 ctx->curr_exp = cl[CLO_BODY];
4394 317660 ctx->curr_env = cl[CLO_ENV];
4395
1/2
✓ Branch 0 taken 560028 times.
✗ Branch 1 not taken.
 560028 } else if (p_nil) {
4396 560028 reserved[1] = get_cdr(args); // protect cdr(args) from allocate_binding
4397 560028 ctx->curr_exp = get_car(args); // protect car(args) from allocate binding
4398 560028 ctx->curr_env = arg_env;
4399 560028 lbm_value rest_binder = allocate_binding(ENC_SYM_REST_ARGS, ENC_SYM_NIL, cl[CLO_ENV]);
4400 560028 reserved[0] = rest_binder;
4401 560028 reserved[2] = get_car(rest_binder);
4402 560028 reserved[3] = CLOSURE_ARGS_REST;
4403 } else {
4404 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
4405 ✗ error_at_ctx(ENC_SYM_EERROR, ctx->r);
4406 }
4407 27088491 } break;
4408 196 case ENC_SYM_CONT:{
4409 /* Continuation created using call-cc.
4410 * ((SYM_CONT . cont-array) arg0 )
4411 */
4412 196 lbm_value c = get_cdr(ctx->r); /* should be the continuation array*/
4413
4414
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 196 times.
 196 if (!lbm_is_lisp_array_r(c)) {
4415 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4416 }
4417
4418 196 lbm_uint arg_count = lbm_list_length(args);
4419
2/3
✓ Branch 0 taken 56 times.
✓ Branch 1 taken 140 times.
✗ Branch 2 not taken.
 196 lbm_value arg = ENC_SYM_NIL;
4420 switch (arg_count) {
4421 56 case 0:
4422 56 arg = ENC_SYM_NIL;
4423 56 break;
4424 140 case 1:
4425 140 arg = get_car(args);
4426 140 break;
4427 ✗ default:
4428 ✗ lbm_set_error_reason((char*)lbm_error_str_num_args);
4429 ✗ error_ctx(ENC_SYM_EERROR);
4430 }
4431 196 lbm_stack_clear(&ctx->K);
4432
4433 196 lbm_array_header_t *arr = assume_array(c);
4434 196 ctx->K.sp = arr->size / sizeof(lbm_uint);
4435 196 memcpy(ctx->K.data, arr->data, arr->size);
4436
4437 lbm_value atomic;
4438 196 lbm_pop(&ctx->K, &atomic);
4439 196 is_atomic = atomic ? 1 : 0;
4440
4441 196 ctx->curr_exp = arg;
4442 196 break;
4443 }
4444 6160 case ENC_SYM_MACRO:{
4445 /*
4446 * Perform macro expansion.
4447 * Macro expansion is really just evaluation in an
4448 * environment augmented with the unevaluated expressions passed
4449 * as arguments.
4450 */
4451 6160 lbm_value env = (lbm_value)sptr[0];
4452
4453 6160 lbm_value curr_param = get_cadr(ctx->r);
4454 6160 lbm_value curr_arg = args;
4455 6160 lbm_value expand_env = env;
4456
3/4
✓ Branch 1 taken 18564 times.
✓ Branch 2 taken 6160 times.
✓ Branch 3 taken 18564 times.
✗ Branch 4 not taken.
 43288 while (lbm_is_cons(curr_param) &&
4457 18564 lbm_is_cons(curr_arg)) {
4458 18564 lbm_cons_t *param_cell = lbm_ref_cell(curr_param); // already checked that cons.
4459 18564 lbm_cons_t *arg_cell = lbm_ref_cell(curr_arg);
4460 18564 lbm_value car_curr_param = param_cell->car;
4461 18564 lbm_value cdr_curr_param = param_cell->cdr;
4462 18564 lbm_value car_curr_arg = arg_cell->car;
4463 18564 lbm_value cdr_curr_arg = arg_cell->cdr;
4464
4465 18564 lbm_value entry = cons_with_gc(car_curr_param, car_curr_arg, expand_env);
4466 18564 lbm_value aug_env = cons_with_gc(entry, expand_env,ENC_SYM_NIL);
4467 18564 expand_env = aug_env;
4468
4469 18564 curr_param = cdr_curr_param;
4470 18564 curr_arg = cdr_curr_arg;
4471 }
4472 /* Two rounds of evaluation is performed.
4473 * First to instantiate the arguments into the macro body.
4474 * Second to evaluate the resulting program.
4475 */
4476 6160 sptr[1] = EVAL_R;
4477 6160 lbm_value exp = get_cadr(get_cdr(ctx->r));
4478 6160 ctx->curr_exp = exp;
4479 6160 ctx->curr_env = expand_env;
4480 6160 } break;
4481 ✗ default:
4482 ✗ error_ctx(ENC_SYM_EERROR);
4483 }
4484 } else {
4485 ✗ error_ctx(ENC_SYM_EERROR);
4486 }
4487 105081857 }
4488
4489 6160 static void cont_eval_r(eval_context_t* ctx) {
4490 lbm_value env;
4491 6160 lbm_pop(&ctx->K, &env);
4492 6160 ctx->curr_exp = ctx->r;
4493 6160 ctx->curr_env = env;
4494 6160 }
4495
4496 643566 static void cont_progn_var(eval_context_t* ctx) {
4497
4498 lbm_value key;
4499 lbm_value env;
4500
4501 643566 lbm_pop_2(&ctx->K, &key, &env);
4502
4503
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 643566 times.
 643566 if (fill_binding_location(key, ctx->r, env) < 0) {
4504 ✗ lbm_set_error_reason("Incorrect type of name/key in let-binding");
4505 ✗ error_at_ctx(ENC_SYM_TERROR, key);
4506 }
4507
4508 643566 ctx->app_cont = true;
4509 643566 }
4510
4511 1775480 static void cont_setq(eval_context_t *ctx) {
4512 lbm_value sym;
4513 lbm_value env;
4514 1775480 lbm_pop_2(&ctx->K, &sym, &env);
4515 lbm_value res;
4516
1/4
✗ Branch 2 not taken.
✓ Branch 3 taken 1775424 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
 1775480 WITH_GC(res, perform_setvar(sym, ctx->r, env));
4517 1775424 ctx->r = res;
4518 1775424 ctx->app_cont = true;
4519 1775424 }
4520
4521 2408 lbm_flash_status request_flash_storage_cell(lbm_value val, lbm_value *res) {
4522
4523 lbm_value flash_cell;
4524 2408 lbm_flash_status s = lbm_allocate_const_cell(&flash_cell);
4525
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2408 times.
 2408 if (s != LBM_FLASH_WRITE_OK)
4526 ✗ return s;
4527 2408 lbm_value new_val = val;
4528 2408 new_val &= ~LBM_PTR_VAL_MASK; // clear the value part of the ptr
4529 2408 new_val |= (flash_cell & LBM_PTR_VAL_MASK);
4530 2408 new_val |= LBM_PTR_TO_CONSTANT_BIT;
4531 2408 *res = new_val;
4532 2408 return s;
4533 }
4534
4535 840 static void cont_move_to_flash(eval_context_t *ctx) {
4536
4537 lbm_value args;
4538 840 lbm_pop(&ctx->K, &args);
4539
4540
2/2
✓ Branch 1 taken 364 times.
✓ Branch 2 taken 476 times.
 840 if (lbm_is_symbol_nil(args)) {
4541 // Done looping over arguments. return true.
4542 364 ctx->r = ENC_SYM_TRUE;
4543 364 ctx->app_cont = true;
4544 840 return;
4545 }
4546
4547 lbm_value first_arg, rest;
4548 476 get_car_and_cdr(args, &first_arg, &rest);
4549
4550 lbm_value val;
4551
2/4
✓ Branch 1 taken 476 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 476 times.
✗ Branch 5 not taken.
 476 if (lbm_is_symbol(first_arg) && lbm_global_env_lookup(&val, first_arg)) {
4552 // Prepare to copy the rest of the arguments when done with first.
4553 476 lbm_value *rptr = stack_reserve(ctx, 2);
4554 476 rptr[0] = rest;
4555 476 rptr[1] = MOVE_TO_FLASH;
4556
1/2
✓ Branch 1 taken 476 times.
✗ Branch 2 not taken.
 476 if (lbm_is_ptr(val) &&
4557
1/2
✓ Branch 0 taken 476 times.
✗ Branch 1 not taken.
 476 (!(val & LBM_PTR_TO_CONSTANT_BIT))) {
4558 476 lbm_value * rptr1 = stack_reserve(ctx, 3);
4559 476 rptr1[0] = first_arg;
4560 476 rptr1[1] = SET_GLOBAL_ENV;
4561 476 rptr1[2] = MOVE_VAL_TO_FLASH_DISPATCH;
4562 476 ctx->r = val;
4563 }
4564 476 ctx->app_cont = true;
4565 476 return;
4566 }
4567 ✗ error_ctx(ENC_SYM_EERROR);
4568 }
4569
4570 3388 static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
4571
4572 3388 lbm_value val = ctx->r;
4573
4574
2/2
✓ Branch 1 taken 798 times.
✓ Branch 2 taken 2590 times.
 3388 if (lbm_is_cons(val)) {
4575 798 lbm_value *rptr = stack_reserve(ctx, 5);
4576 798 rptr[0] = ENC_SYM_NIL; // fst cell of list
4577 798 rptr[1] = ENC_SYM_NIL; // last cell of list
4578 798 rptr[2] = get_cdr(val);
4579 798 rptr[3] = MOVE_LIST_TO_FLASH;
4580 798 rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH;
4581 798 ctx->r = get_car(val);
4582 798 ctx->app_cont = true;
4583 798 return;
4584 }
4585
4586
3/4
✓ Branch 1 taken 280 times.
✓ Branch 2 taken 2310 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 280 times.
 2590 if (lbm_is_ptr(val) && (val & LBM_PTR_TO_CONSTANT_BIT)) {
4587 ✗ ctx->r = val;
4588 ✗ ctx->app_cont = true;
4589 ✗ return;
4590 }
4591
4592
2/2
✓ Branch 1 taken 280 times.
✓ Branch 2 taken 2310 times.
 2590 if (lbm_is_ptr(val)) {
4593 280 lbm_cons_t *ref = lbm_ref_cell(val);
4594
1/2
✓ Branch 1 taken 280 times.
✗ Branch 2 not taken.
 280 if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL) {
4595
4/6
✓ Branch 0 taken 140 times.
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 56 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
 280 switch (ref->cdr) {
4596 140 case ENC_SYM_RAW_I_TYPE: /* fall through */
4597 case ENC_SYM_RAW_U_TYPE:
4598 case ENC_SYM_RAW_F_TYPE: {
4599 140 lbm_value flash_cell = ENC_SYM_NIL;
4600 140 handle_flash_status(request_flash_storage_cell(val, &flash_cell));
4601 140 handle_flash_status(write_const_car(flash_cell, ref->car));
4602 140 handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
4603 140 ctx->r = flash_cell;
4604 140 } break;
4605 56 case ENC_SYM_IND_I_TYPE: /* fall through */
4606 case ENC_SYM_IND_U_TYPE:
4607 case ENC_SYM_IND_F_TYPE: {
4608 #ifndef LBM64
4609 /* 64 bit values are in lbm mem on 32bit platforms. */
4610 56 lbm_uint *lbm_mem_ptr = (lbm_uint*)ref->car;
4611 lbm_uint flash_ptr;
4612
4613 56 handle_flash_status(lbm_write_const_raw(lbm_mem_ptr, 2, &flash_ptr));
4614 56 lbm_value flash_cell = ENC_SYM_NIL;
4615 56 handle_flash_status(request_flash_storage_cell(val, &flash_cell));
4616 56 handle_flash_status(write_const_car(flash_cell, flash_ptr));
4617 56 handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
4618 56 ctx->r = flash_cell;
4619 #else
4620 // There are no indirect types in LBM64
4621 error_ctx(ENC_SYM_FATAL_ERROR);
4622 #endif
4623 56 } break;
4624 28 case ENC_SYM_LISPARRAY_TYPE: {
4625 28 lbm_array_header_t *arr = (lbm_array_header_t*)ref->car;
4626 28 lbm_uint size = arr->size / sizeof(lbm_uint);
4627 28 lbm_uint flash_addr = 0;
4628 28 lbm_value *arrdata = (lbm_value *)arr->data;
4629 28 lbm_value flash_cell = ENC_SYM_NIL;
4630 28 handle_flash_status(request_flash_storage_cell(val, &flash_cell));
4631 28 handle_flash_status(lbm_allocate_const_raw(size, &flash_addr));
4632 28 lift_array_flash(flash_cell,
4633 false,
4634 (char *)flash_addr,
4635 arr->size);
4636 // Move array contents to flash recursively
4637 28 lbm_value *rptr = stack_reserve(ctx, 5);
4638 28 rptr[0] = flash_cell;
4639 28 rptr[1] = lbm_enc_u(0);
4640 28 rptr[2] = val;
4641 28 rptr[3] = MOVE_ARRAY_ELTS_TO_FLASH;
4642 28 rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH;
4643 28 ctx->r = arrdata[0];
4644 28 ctx->app_cont = true;
4645 28 return;
4646 }
4647 56 case ENC_SYM_ARRAY_TYPE: {
4648 56 lbm_array_header_t *arr = (lbm_array_header_t*)ref->car;
4649 // arbitrary address: flash_arr.
4650 56 lbm_uint flash_arr = 0;
4651 56 handle_flash_status(lbm_write_const_array_padded((uint8_t*)arr->data, arr->size, &flash_arr));
4652 56 lbm_value flash_cell = ENC_SYM_NIL;
4653 56 handle_flash_status(request_flash_storage_cell(val, &flash_cell));
4654 56 lift_array_flash(flash_cell,
4655 true,
4656 (char *)flash_arr,
4657 arr->size);
4658 56 ctx->r = flash_cell;
4659 56 } break;
4660 ✗ case ENC_SYM_CHANNEL_TYPE: /* fall through */
4661 case ENC_SYM_CUSTOM_TYPE:
4662 ✗ lbm_set_error_reason((char *)lbm_error_str_flash_not_possible);
4663 ✗ error_ctx(ENC_SYM_EERROR);
4664 }
4665 252 } else {
4666 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
4667 }
4668 252 ctx->app_cont = true;
4669 252 return;
4670 }
4671 2310 ctx->r = val;
4672 2310 ctx->app_cont = true;
4673 }
4674
4675 2016 static void cont_move_list_to_flash(eval_context_t *ctx) {
4676
4677 // ctx->r holds the value that should go in car
4678
4679 2016 lbm_value *sptr = get_stack_ptr(ctx, 3);
4680
4681 2016 lbm_value fst = sptr[0];
4682 2016 lbm_value lst = sptr[1];
4683 2016 lbm_value val = sptr[2];
4684
4685
4686 2016 lbm_value new_lst = ENC_SYM_NIL;
4687 // Allocate element ptr storage after storing the element to flash.
4688 2016 handle_flash_status(request_flash_storage_cell(lbm_enc_cons_ptr(LBM_PTR_NULL), &new_lst));
4689
4690
2/2
✓ Branch 1 taken 798 times.
✓ Branch 2 taken 1218 times.
 2016 if (lbm_is_symbol_nil(fst)) {
4691 798 lst = new_lst;
4692 798 fst = new_lst;
4693 798 handle_flash_status(write_const_car(lst, ctx->r));
4694 } else {
4695 1218 handle_flash_status(write_const_cdr(lst, new_lst)); // low before high
4696 1218 handle_flash_status(write_const_car(new_lst, ctx->r));
4697 1218 lst = new_lst;
4698 }
4699
4700
2/2
✓ Branch 1 taken 1218 times.
✓ Branch 2 taken 798 times.
 2016 if (lbm_is_cons(val)) {
4701 1218 sptr[0] = fst;
4702 1218 sptr[1] = lst;//rest_cell;
4703 1218 sptr[2] = get_cdr(val);
4704 1218 lbm_value *rptr = stack_reserve(ctx, 2);
4705 1218 rptr[0] = MOVE_LIST_TO_FLASH;
4706 1218 rptr[1] = MOVE_VAL_TO_FLASH_DISPATCH;
4707 1218 ctx->r = get_car(val);
4708 } else {
4709 798 sptr[0] = fst;
4710 798 sptr[1] = lst;
4711 798 sptr[2] = CLOSE_LIST_IN_FLASH;
4712 798 stack_reserve(ctx, 1)[0] = MOVE_VAL_TO_FLASH_DISPATCH;
4713 798 ctx->r = val;
4714 }
4715 2016 ctx->app_cont = true;
4716 2016 }
4717
4718 798 static void cont_close_list_in_flash(eval_context_t *ctx) {
4719 lbm_value fst;
4720 lbm_value lst;
4721 798 lbm_pop_2(&ctx->K, &lst, &fst);
4722 798 lbm_value val = ctx->r;
4723 798 handle_flash_status(write_const_cdr(lst, val));
4724 798 ctx->r = fst;
4725 798 ctx->app_cont = true;
4726 798 }
4727
4728 84 static void cont_move_array_elts_to_flash(eval_context_t *ctx) {
4729 84 lbm_value *sptr = get_stack_ptr(ctx, 3);
4730 // sptr[2] = source array in RAM
4731 // sptr[1] = current index
4732 // sptr[0] = target array in flash
4733 84 lbm_array_header_t *src_arr = assume_array(sptr[2]);
4734 84 lbm_uint size = src_arr->size / sizeof(lbm_uint);
4735 84 lbm_value *srcdata = (lbm_value *)src_arr->data;
4736
4737 84 lbm_array_header_t *tgt_arr = assume_array(sptr[0]);
4738 84 lbm_uint *tgtdata = (lbm_value *)tgt_arr->data;
4739 84 lbm_uint ix = lbm_dec_as_u32(sptr[1]);
4740 84 handle_flash_status(lbm_const_write(&tgtdata[ix], ctx->r));
4741
2/2
✓ Branch 0 taken 28 times.
✓ Branch 1 taken 56 times.
 84 if (ix >= size-1) {
4742 28 ctx->r = sptr[0];
4743 28 lbm_stack_drop(&ctx->K, 3);
4744 28 ctx->app_cont = true;
4745 28 return;
4746 }
4747 56 sptr[1] = lbm_enc_u(ix + 1);
4748 56 lbm_value *rptr = stack_reserve(ctx, 2);
4749 56 rptr[0] = MOVE_ARRAY_ELTS_TO_FLASH;
4750 56 rptr[1] = MOVE_VAL_TO_FLASH_DISPATCH;
4751 56 ctx->r = srcdata[ix+1];
4752 56 ctx->app_cont = true;
4753 56 return;
4754 }
4755
4756 5012 static void cont_qq_expand_start(eval_context_t *ctx) {
4757 5012 lbm_value *rptr = stack_reserve(ctx, 2);
4758 5012 rptr[0] = ctx->r;
4759 5012 rptr[1] = QQ_EXPAND;
4760 5012 ctx->r = ENC_SYM_NIL;
4761 5012 ctx->app_cont = true;
4762 5012 }
4763
4764 10164 lbm_value quote_it(lbm_value qquoted) {
4765
3/4
✓ Branch 1 taken 9716 times.
✓ Branch 2 taken 448 times.
✓ Branch 3 taken 9716 times.
✗ Branch 4 not taken.
 19880 if (lbm_is_symbol(qquoted) &&
4766 19432 lbm_is_special(qquoted)) return qquoted;
4767
4768 448 lbm_value val = cons_with_gc(qquoted, ENC_SYM_NIL, ENC_SYM_NIL);
4769 448 return cons_with_gc(ENC_SYM_QUOTE, val, ENC_SYM_NIL);
4770 }
4771
4772 37632 bool is_append(lbm_value a) {
4773
1/2
✓ Branch 1 taken 37576 times.
✗ Branch 2 not taken.
 75208 return (lbm_is_cons(a) &&
4774
4/4
✓ Branch 0 taken 37576 times.
✓ Branch 1 taken 56 times.
✓ Branch 4 taken 18592 times.
✓ Branch 5 taken 18984 times.
 75208 lbm_is_symbol(get_car(a)) &&
4775 37576 (get_car(a) == ENC_SYM_APPEND));
4776 }
4777
4778 63308 lbm_value append(lbm_value front, lbm_value back) {
4779
2/2
✓ Branch 1 taken 34132 times.
✓ Branch 2 taken 29176 times.
 63308 if (lbm_is_symbol_nil(front)) return back;
4780
2/2
✓ Branch 1 taken 9716 times.
✓ Branch 2 taken 19460 times.
 29176 if (lbm_is_symbol_nil(back)) return front;
4781
4782
4/4
✓ Branch 1 taken 10332 times.
✓ Branch 2 taken 9128 times.
✓ Branch 3 taken 448 times.
✓ Branch 4 taken 9884 times.
 29792 if (lbm_is_quoted_list(front) &&
4783 10332 lbm_is_quoted_list(back)) {
4784 448 lbm_value f = get_cadr(front);
4785 448 lbm_value b = get_cadr(back);
4786 448 return quote_it(lbm_list_append(f, b));
4787 }
4788
4789
4/4
✓ Branch 1 taken 9492 times.
✓ Branch 2 taken 9520 times.
✓ Branch 3 taken 392 times.
✓ Branch 4 taken 9100 times.
 28504 if (is_append(back) &&
4790
1/2
✓ Branch 2 taken 392 times.
✗ Branch 3 not taken.
 9884 lbm_is_quoted_list(get_cadr(back)) &&
4791 392 lbm_is_quoted_list(front)) {
4792 392 lbm_value ql = get_cadr(back);
4793 392 lbm_value f = get_cadr(front);
4794 392 lbm_value b = get_cadr(ql);
4795
4796 392 lbm_value v = lbm_list_append(f, b);
4797 392 lbm_set_car(get_cdr(ql), v);
4798 392 return back;
4799 }
4800
4801
2/2
✓ Branch 1 taken 9100 times.
✓ Branch 2 taken 9520 times.
 18620 if (is_append(back)) {
4802 9100 back = get_cdr(back);
4803 9100 lbm_value new = cons_with_gc(front, back, ENC_SYM_NIL);
4804 9100 return cons_with_gc(ENC_SYM_APPEND, new, ENC_SYM_NIL);
4805 }
4806
4807 lbm_value t0, t1;
4808
4809 9520 t0 = cons_with_gc(back, ENC_SYM_NIL, front);
4810 9520 t1 = cons_with_gc(front, t0, ENC_SYM_NIL);
4811 9520 return cons_with_gc(ENC_SYM_APPEND, t1, ENC_SYM_NIL);
4812 }
4813
4814 /* Bawden's qq-expand implementation
4815 (define (qq-expand x)
4816 (cond ((tag-comma? x)
4817 (tag-data x))
4818 ((tag-comma-atsign? x)
4819 (error "Illegal"))
4820 ((tag-backquote? x)
4821 (qq-expand
4822 (qq-expand (tag-data x))))
4823 ((pair? x)
4824 `(append
4825 ,(qq-expand-list (car x))
4826 ,(qq-expand (cdr x))))
4827 (else `',x)))
4828 */
4829 34188 static void cont_qq_expand(eval_context_t *ctx) {
4830 lbm_value qquoted;
4831 34188 lbm_pop(&ctx->K, &qquoted);
4832
4833
2/2
✓ Branch 1 taken 24472 times.
✓ Branch 2 taken 9716 times.
 34188 switch(lbm_type_of(qquoted)) {
4834 24472 case LBM_TYPE_CONS: {
4835 24472 lbm_value car_val = get_car(qquoted);
4836 24472 lbm_value cdr_val = get_cdr(qquoted);
4837
4/4
✓ Branch 1 taken 5040 times.
✓ Branch 2 taken 19432 times.
✓ Branch 3 taken 28 times.
✓ Branch 4 taken 5012 times.
 24472 if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
4838 car_val == ENC_SYM_COMMA) {
4839 28 ctx->r = append(ctx->r, get_car(cdr_val));
4840 28 ctx->app_cont = true;
4841
3/4
✓ Branch 1 taken 5012 times.
✓ Branch 2 taken 19432 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5012 times.
 24444 } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
4842 car_val == ENC_SYM_COMMAAT) {
4843 ✗ error_ctx(ENC_SYM_RERROR);
4844 } else {
4845 24444 lbm_value *rptr = stack_reserve(ctx, 6);
4846 24444 rptr[0] = ctx->r;
4847 24444 rptr[1] = QQ_APPEND;
4848 24444 rptr[2] = cdr_val;
4849 24444 rptr[3] = QQ_EXPAND;
4850 24444 rptr[4] = car_val;
4851 24444 rptr[5] = QQ_EXPAND_LIST;
4852 24444 ctx->app_cont = true;
4853 24444 ctx->r = ENC_SYM_NIL;
4854 }
4855
4856 24472 } break;
4857 9716 default: {
4858 9716 lbm_value res = quote_it(qquoted);
4859 9716 ctx->r = append(ctx->r, res);
4860 9716 ctx->app_cont = true;
4861 }
4862 }
4863 34188 }
4864
4865 29176 static void cont_qq_append(eval_context_t *ctx) {
4866 lbm_value head;
4867 29176 lbm_pop(&ctx->K, &head);
4868 29176 ctx->r = append(head, ctx->r);
4869 29176 ctx->app_cont = true;
4870 29176 }
4871
4872 /* Bawden's qq-expand-list implementation
4873 (define (qq-expand-list x)
4874 (cond ((tag-comma? x)
4875 `(list ,(tag-data x)))
4876 ((tag-comma-atsign? x)
4877 (tag-data x))
4878 ((tag-backquote? x)
4879 (qq-expand-list
4880 (qq-expand (tag-data x))))
4881 ((pair? x)
4882 `(list
4883 (append
4884 ,(qq-expand-list (car x))
4885 ,(qq-expand (cdr x)))))
4886 (else `'(,x))))
4887 */
4888
4889 29176 static void cont_qq_expand_list(eval_context_t* ctx) {
4890 lbm_value l;
4891 29176 lbm_pop(&ctx->K, &l);
4892
4893 29176 ctx->app_cont = true;
4894
2/2
✓ Branch 1 taken 18620 times.
✓ Branch 2 taken 10556 times.
 29176 switch(lbm_type_of(l)) {
4895 18620 case LBM_TYPE_CONS: {
4896 18620 lbm_value car_val = get_car(l);
4897 18620 lbm_value cdr_val = get_cdr(l);
4898
3/4
✓ Branch 1 taken 18620 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 13832 times.
✓ Branch 4 taken 4788 times.
 18620 if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
4899 car_val == ENC_SYM_COMMA) {
4900 13832 lbm_value tl = cons_with_gc(get_car(cdr_val), ENC_SYM_NIL, ENC_SYM_NIL);
4901 13832 lbm_value tmp = cons_with_gc(ENC_SYM_LIST, tl, ENC_SYM_NIL);
4902 13832 ctx->r = append(ctx->r, tmp);
4903 13888 return;
4904
3/4
✓ Branch 1 taken 4788 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 56 times.
✓ Branch 4 taken 4732 times.
 4788 } else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
4905 car_val == ENC_SYM_COMMAAT) {
4906 56 ctx->r = get_car(cdr_val);
4907 56 return;
4908 } else {
4909 4732 lbm_value *rptr = stack_reserve(ctx, 7);
4910 4732 rptr[0] = QQ_LIST;
4911 4732 rptr[1] = ctx->r;
4912 4732 rptr[2] = QQ_APPEND;
4913 4732 rptr[3] = cdr_val;
4914 4732 rptr[4] = QQ_EXPAND;
4915 4732 rptr[5] = car_val;
4916 4732 rptr[6] = QQ_EXPAND_LIST;
4917 4732 ctx->r = ENC_SYM_NIL;
4918 }
4919
4920 4732 } break;
4921 10556 default: {
4922 10556 lbm_value a_list = cons_with_gc(l, ENC_SYM_NIL, ENC_SYM_NIL);
4923 10556 lbm_value tl = cons_with_gc(a_list, ENC_SYM_NIL, ENC_SYM_NIL);
4924 10556 lbm_value tmp = cons_with_gc(ENC_SYM_QUOTE, tl, ENC_SYM_NIL);
4925 10556 ctx->r = append(ctx->r, tmp);
4926 }
4927 }
4928 }
4929
4930 4732 static void cont_qq_list(eval_context_t *ctx) {
4931 4732 lbm_value val = ctx->r;
4932 4732 lbm_value apnd_app = cons_with_gc(val, ENC_SYM_NIL, ENC_SYM_NIL);
4933 4732 lbm_value tmp = cons_with_gc(ENC_SYM_LIST, apnd_app, ENC_SYM_NIL);
4934 4732 ctx->r = tmp;
4935 4732 ctx->app_cont = true;
4936 4732 }
4937
4938 83 static void cont_kill(eval_context_t *ctx) {
4939 (void) ctx;
4940 83 ok_ctx();
4941 83 }
4942
4943 69811 static void cont_pop_reader_flags(eval_context_t *ctx) {
4944 lbm_value flags;
4945 69811 lbm_pop(&ctx->K, &flags);
4946 69811 ctx->flags = ctx->flags & ~EVAL_CPS_CONTEXT_READER_FLAGS_MASK;
4947 69811 ctx->flags |= (lbm_dec_as_u32(flags) & EVAL_CPS_CONTEXT_READER_FLAGS_MASK);
4948 // r is unchanged.
4949 69811 ctx->app_cont = true;
4950 69811 }
4951
4952 8092 static void cont_exception_handler(eval_context_t *ctx) {
4953 8092 lbm_value *sptr = pop_stack_ptr(ctx, 2);
4954 8092 lbm_value retval = sptr[0];
4955 8092 lbm_value flags = sptr[1];
4956 8092 lbm_set_car(get_cdr(retval), ctx->r);
4957 8092 ctx->flags = (uint32_t)flags;
4958 8092 ctx->r = retval;
4959 8092 ctx->app_cont = true;
4960 8092 }
4961
4962 84 static void cont_recv_to(eval_context_t *ctx) {
4963 84 lbm_value *sptr = pop_stack_ptr(ctx, 1);
4964 84 lbm_value pats = sptr[0];
4965
4966
1/2
✓ Branch 1 taken 84 times.
✗ Branch 2 not taken.
 84 if (lbm_is_number(ctx->r)) {
4967 84 float timeout_time = lbm_dec_as_float(ctx->r);
4968 84 receive_base(ctx, pats, timeout_time, true);
4969 } else {
4970 ✗ error_ctx(ENC_SYM_TERROR);
4971 }
4972 84 }
4973
4974 /*********************************************************/
4975 /* Continuations table */
4976 typedef void (*cont_fun)(eval_context_t *);
4977
4978 static const cont_fun continuations[NUM_CONTINUATIONS] =
4979 { advance_ctx, // CONT_DONE
4980 cont_set_global_env,
4981 cont_bind_to_key_rest,
4982 cont_if,
4983 cont_progn_rest,
4984 cont_application_args,
4985 cont_and,
4986 cont_or,
4987 cont_wait,
4988 cont_match,
4989 cont_application_start,
4990 cont_eval_r,
4991 cont_resume,
4992 cont_closure_application_args,
4993 cont_exit_atomic,
4994 cont_read_next_token,
4995 cont_read_append_continue,
4996 cont_read_eval_continue,
4997 cont_read_expect_closepar,
4998 cont_read_dot_terminate,
4999 cont_read_done,
5000 cont_read_start_array,
5001 cont_read_append_array,
5002 cont_map,
5003 cont_match_guard,
5004 cont_terminate,
5005 cont_progn_var,
5006 cont_setq,
5007 cont_move_to_flash,
5008 cont_move_val_to_flash_dispatch,
5009 cont_move_list_to_flash,
5010 cont_close_list_in_flash,
5011 cont_qq_expand_start,
5012 cont_qq_expand,
5013 cont_qq_append,
5014 cont_qq_expand_list,
5015 cont_qq_list,
5016 cont_kill,
5017 cont_loop,
5018 cont_loop_condition,
5019 cont_merge_rest,
5020 cont_merge_layer,
5021 cont_closure_args_rest,
5022 cont_move_array_elts_to_flash,
5023 cont_pop_reader_flags,
5024 cont_exception_handler,
5025 cont_recv_to,
5026 cont_wrap_result,
5027 };
5028
5029 /*********************************************************/
5030 /* Evaluators lookup table (special forms) */
5031 typedef void (*evaluator_fun)(eval_context_t *);
5032
5033 static const evaluator_fun evaluators[] =
5034 {
5035 eval_quote,
5036 eval_define,
5037 eval_progn,
5038 eval_lambda,
5039 eval_if,
5040 eval_let,
5041 eval_and,
5042 eval_or,
5043 eval_match,
5044 eval_receive,
5045 eval_receive_timeout,
5046 eval_callcc,
5047 eval_atomic,
5048 eval_selfevaluating, // macro
5049 eval_selfevaluating, // cont
5050 eval_selfevaluating, // closure
5051 eval_cond,
5052 eval_app_cont,
5053 eval_var,
5054 eval_setq,
5055 eval_move_to_flash,
5056 eval_loop,
5057 eval_trap
5058 };
5059
5060
5061 /*********************************************************/
5062 /* Evaluator step function */
5063
5064 912095313 static void evaluation_step(void){
5065 912095313 eval_context_t *ctx = ctx_running;
5066 #ifdef VISUALIZE_HEAP
5067 heap_vis_gen_image();
5068 #endif
5069
5070
2/2
✓ Branch 0 taken 424256740 times.
✓ Branch 1 taken 487838573 times.
 912095313 if (ctx->app_cont) {
5071 lbm_value k;
5072 424256740 lbm_pop(&ctx->K, &k);
5073 424256740 ctx->app_cont = false;
5074
5075 424256740 lbm_uint decoded_k = DEC_CONTINUATION(k);
5076
5077
1/2
✓ Branch 0 taken 424256740 times.
✗ Branch 1 not taken.
 424256740 if (decoded_k < NUM_CONTINUATIONS) {
5078 424256740 continuations[decoded_k](ctx);
5079 } else {
5080 ✗ error_ctx(ENC_SYM_FATAL_ERROR);
5081 }
5082 424248668 return;
5083 }
5084
5085
2/2
✓ Branch 1 taken 224401179 times.
✓ Branch 2 taken 263437394 times.
 487838573 if (lbm_is_symbol(ctx->curr_exp)) {
5086 224401179 eval_symbol(ctx);
5087 224401123 return;
5088 }
5089
2/2
✓ Branch 1 taken 168910153 times.
✓ Branch 2 taken 94527241 times.
 263437394 if (lbm_is_cons(ctx->curr_exp)) {
5090 168910153 lbm_cons_t *cell = lbm_ref_cell(ctx->curr_exp);
5091 168910153 lbm_value h = cell->car;
5092
4/4
✓ Branch 1 taken 166667913 times.
✓ Branch 2 taken 2242240 times.
✓ Branch 3 taken 63827035 times.
✓ Branch 4 taken 102840878 times.
 168910153 if (lbm_is_symbol(h) && ((h & ENC_SPECIAL_FORMS_MASK) == ENC_SPECIAL_FORMS_BIT)) {
5093 63827035 lbm_uint eval_index = lbm_dec_sym(h) & SPECIAL_FORMS_INDEX_MASK;
5094 63827035 evaluators[eval_index](ctx);
5095 63827035 return;
5096 }
5097 /*
5098 * At this point head can be anything. It should evaluate
5099 * into a form that can be applied (closure, symbol, ...) though.
5100 */
5101 105083118 lbm_value *reserved = stack_reserve(ctx, 3);
5102 105083118 reserved[0] = ctx->curr_env;
5103 105083118 reserved[1] = cell->cdr;
5104 105083118 reserved[2] = APPLICATION_START;
5105 105083118 ctx->curr_exp = h; // evaluate the function
5106 105083118 return;
5107 }
5108
5109 94527241 eval_selfevaluating(ctx);
5110 94527241 return;
5111 }
5112
5113
5114 // Reset has a built in pause.
5115 // so after reset, continue.
5116 ✗ void lbm_reset_eval(void) {
5117 ✗ eval_cps_next_state_arg = 0;
5118 ✗ eval_cps_next_state = EVAL_CPS_STATE_RESET;
5119 ✗ if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true;
5120 ✗ }
5121
5122 21496 void lbm_pause_eval(void ) {
5123 21496 eval_cps_next_state_arg = 0;
5124 21496 eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
5125
1/2
✓ Branch 0 taken 21496 times.
✗ Branch 1 not taken.
 21496 if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true;
5126 21496 }
5127
5128 21504 void lbm_pause_eval_with_gc(uint32_t num_free) {
5129 21504 eval_cps_next_state_arg = num_free;
5130 21504 eval_cps_next_state = EVAL_CPS_STATE_PAUSED;
5131
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true;
5132 21504 }
5133
5134 21504 void lbm_continue_eval(void) {
5135 21504 eval_cps_next_state = EVAL_CPS_STATE_RUNNING;
5136
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true;
5137 21504 }
5138
5139 ✗ void lbm_kill_eval(void) {
5140 ✗ eval_cps_next_state = EVAL_CPS_STATE_KILL;
5141 ✗ if (eval_cps_next_state != eval_cps_run_state) eval_cps_state_changed = true;
5142 ✗ }
5143
5144 146498 uint32_t lbm_get_eval_state(void) {
5145 146498 return eval_cps_run_state;
5146 }
5147
5148 // Only unblocks threads that are unblockable.
5149 // A sleeping thread is not unblockable.
5150 84 static void handle_event_unblock_ctx(lbm_cid cid, lbm_value v) {
5151 84 eval_context_t *found = NULL;
5152 84 mutex_lock(&qmutex);
5153
5154 84 found = lookup_ctx_nm(&blocked, cid);
5155
2/4
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 84 times.
✗ Branch 3 not taken.
 84 if (found && LBM_IS_STATE_UNBLOCKABLE(found->state)){
5156 84 drop_ctx_nm(&blocked,found);
5157
2/2
✓ Branch 1 taken 28 times.
✓ Branch 2 taken 56 times.
 84 if (lbm_is_error(v)) {
5158 28 get_stack_ptr(found, 1)[0] = TERMINATE; // replace TOS
5159 28 found->app_cont = true;
5160 }
5161 84 found->r = v;
5162 84 found->state = LBM_THREAD_STATE_READY;
5163 84 enqueue_ctx_nm(&queue,found);
5164 }
5165 84 mutex_unlock(&qmutex);
5166 84 }
5167
5168 ✗ static void handle_event_define(lbm_value key, lbm_value val) {
5169 ✗ lbm_uint dec_key = lbm_dec_sym(key);
5170 ✗ lbm_uint ix_key = dec_key & GLOBAL_ENV_MASK;
5171 ✗ lbm_value *global_env = lbm_get_global_env();
5172 ✗ lbm_uint orig_env = global_env[ix_key];
5173 lbm_value new_env;
5174 // A key is a symbol and should not need to be remembered.
5175 ✗ WITH_GC(new_env, lbm_env_set(orig_env,key,val));
5176
5177 ✗ global_env[ix_key] = new_env;
5178 ✗ }
5179
5180 6543 static lbm_value get_event_value(lbm_event_t *e) {
5181 lbm_value v;
5182
1/2
✓ Branch 0 taken 6543 times.
✗ Branch 1 not taken.
 6543 if (e->buf_len > 0) {
5183 lbm_flat_value_t fv;
5184 6543 fv.buf = (uint8_t*)e->buf_ptr;
5185 6543 fv.buf_size = e->buf_len;
5186 6543 fv.buf_pos = 0;
5187
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 6543 times.
 6543 if (!lbm_unflatten_value(&fv, &v)) {
5188 ✗ lbm_set_flags(LBM_FLAG_HANDLER_EVENT_DELIVERY_FAILED);
5189 ✗ v = ENC_SYM_EERROR;
5190 }
5191 // Free the flat value buffer. GC is unaware of its existence.
5192 6543 lbm_free(fv.buf);
5193 } else {
5194 ✗ v = (lbm_value)e->buf_ptr;
5195 }
5196 6543 return v;
5197 }
5198
5199 93303359 static void process_events(void) {
5200
5201
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 93303359 times.
 93303359 if (!lbm_events) {
5202 ✗ return;
5203 }
5204
5205 lbm_event_t e;
5206
2/2
✓ Branch 0 taken 6543 times.
✓ Branch 1 taken 93303359 times.
 186613261 while (lbm_event_pop(&e)) {
5207 6543 lbm_value event_val = get_event_value(&e);
5208
2/5
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6459 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
 6543 switch(e.type) {
5209 84 case LBM_EVENT_UNBLOCK_CTX:
5210 84 handle_event_unblock_ctx((lbm_cid)e.parameter, event_val);
5211 84 break;
5212 ✗ case LBM_EVENT_DEFINE:
5213 ✗ handle_event_define((lbm_value)e.parameter, event_val);
5214 ✗ break;
5215 6459 case LBM_EVENT_FOR_HANDLER:
5216
1/2
✓ Branch 0 taken 6459 times.
✗ Branch 1 not taken.
 6459 if (lbm_event_handler_pid >= 0) {
5217 6459 lbm_find_receiver_and_send(lbm_event_handler_pid, event_val);
5218 }
5219 6459 break;
5220 ✗ case LBM_EVENT_RUN_USER_CALLBACK:
5221 ✗ user_callback((void*)e.parameter);
5222 ✗ break;
5223 }
5224 93309902 }
5225 }
5226
5227 /* eval_cps_run can be paused
5228 I think it would be better use a mailbox for
5229 communication between other threads and the run_eval
5230 but for now a set of variables will be used. */
5231 21504 void lbm_run_eval(void){
5232
5233
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 21504 times.
 21504 if (setjmp(critical_error_jmp_buf) > 0) {
5234 ✗ printf_callback("GC stack overflow!\n");
5235 ✗ critical_error_callback();
5236 // terminate evaluation thread.
5237 ✗ return;
5238 }
5239
5240 21504 setjmp(error_jmp_buf);
5241
5242
2/2
✓ Branch 0 taken 79657 times.
✓ Branch 1 taken 37847 times.
 117504 while (eval_running) {
5243
4/4
✓ Branch 0 taken 59739 times.
✓ Branch 1 taken 19918 times.
✓ Branch 2 taken 29615 times.
✓ Branch 3 taken 30124 times.
 79657 if (eval_cps_state_changed || eval_cps_run_state == EVAL_CPS_STATE_PAUSED) {
5244 50042 eval_cps_state_changed = false;
5245
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 28538 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 21504 times.
 50042 switch (eval_cps_next_state) {
5246 ✗ case EVAL_CPS_STATE_RESET:
5247 ✗ if (eval_cps_run_state != EVAL_CPS_STATE_RESET) {
5248 ✗ is_atomic = false;
5249 ✗ blocked.first = NULL;
5250 ✗ blocked.last = NULL;
5251 ✗ queue.first = NULL;
5252 ✗ queue.last = NULL;
5253 ✗ ctx_running = NULL;
5254 ✗ eval_steps_quota = eval_steps_refill;
5255 ✗ eval_cps_run_state = EVAL_CPS_STATE_RESET;
5256 ✗ if (blocking_extension) {
5257 ✗ blocking_extension = false;
5258 ✗ mutex_unlock(&blocking_extension_mutex);
5259 }
5260 }
5261 ✗ usleep_callback(EVAL_CPS_MIN_SLEEP);
5262 ✗ continue;
5263 28538 case EVAL_CPS_STATE_PAUSED:
5264
1/1
✓ Branch 0 taken 43000 times.
 28538 if (eval_cps_run_state != EVAL_CPS_STATE_PAUSED) {
5265
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 43000 times.
 43000 if (lbm_heap_num_free() < eval_cps_next_state_arg) {
5266 ✗ gc();
5267 }
5268 43000 eval_cps_next_state_arg = 0;
5269 43000 eval_cps_run_state = EVAL_CPS_STATE_PAUSED;
5270 }
5271 28538 usleep_callback(EVAL_CPS_MIN_SLEEP);
5272 44889 continue;
5273 ✗ case EVAL_CPS_STATE_KILL:
5274 ✗ eval_cps_run_state = EVAL_CPS_STATE_DEAD;
5275 ✗ eval_running = false;
5276 ✗ continue;
5277 21504 default: // running state
5278 21504 eval_cps_run_state = eval_cps_next_state;
5279 21504 break;
5280 }
5281 29615 }
5282 while (true) {
5283
4/4
✓ Branch 0 taken 914243520 times.
✓ Branch 1 taken 91198863 times.
✓ Branch 2 taken 912095313 times.
✓ Branch 3 taken 2148207 times.
 1005442383 if (eval_steps_quota && ctx_running) {
5284 912095313 eval_steps_quota--;
5285 912095313 evaluation_step();
5286 } else {
5287
2/2
✓ Branch 0 taken 42983 times.
✓ Branch 1 taken 93304087 times.
 93347070 if (eval_cps_state_changed) break;
5288 93304087 eval_steps_quota = eval_steps_refill;
5289
2/2
✓ Branch 0 taken 93303359 times.
✓ Branch 1 taken 728 times.
 93304087 if (!is_atomic) {
5290
2/2
✓ Branch 0 taken 96 times.
✓ Branch 1 taken 93303263 times.
 93303359 if (gc_requested) {
5291 96 gc();
5292 }
5293 93303359 process_events();
5294 93303359 mutex_lock(&qmutex);
5295
2/2
✓ Branch 0 taken 91164304 times.
✓ Branch 1 taken 2139055 times.
 93303359 if (ctx_running) {
5296 91164304 enqueue_ctx_nm(&queue, ctx_running);
5297 91164304 ctx_running = NULL;
5298 }
5299 93303359 wake_up_ctxs_nm();
5300 93303359 ctx_running = dequeue_ctx_nm(&queue);
5301 93303359 mutex_unlock(&qmutex);
5302
2/2
✓ Branch 0 taken 2082247 times.
✓ Branch 1 taken 91221112 times.
 93303359 if (!ctx_running) {
5303 2082247 lbm_system_sleeping = true;
5304 //Fixed sleep interval to poll events regularly.
5305 2082247 usleep_callback(EVAL_CPS_MIN_SLEEP);
5306 2082239 lbm_system_sleeping = false;
5307 }
5308 }
5309 }
5310 }
5311 }
5312 }
5313
5314 ✗ lbm_cid lbm_eval_program(lbm_value lisp) {
5315 ✗ return lbm_create_ctx(lisp, ENC_SYM_NIL, 256, NULL);
5316 }
5317
5318 ✗ lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) {
5319 ✗ return lbm_create_ctx(lisp, ENC_SYM_NIL, stack_size, NULL);
5320 }
5321
5322 21504 int lbm_eval_init() {
5323
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (!qmutex_initialized) {
5324 21504 mutex_init(&qmutex);
5325 21504 qmutex_initialized = true;
5326 }
5327
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (!lbm_events_mutex_initialized) {
5328 21504 mutex_init(&lbm_events_mutex);
5329 21504 lbm_events_mutex_initialized = true;
5330 }
5331
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (!blocking_extension_mutex_initialized) {
5332 21504 mutex_init(&blocking_extension_mutex);
5333 21504 blocking_extension_mutex_initialized = true;
5334 }
5335
5336 21504 mutex_lock(&qmutex);
5337 21504 mutex_lock(&lbm_events_mutex);
5338
5339 21504 blocked.first = NULL;
5340 21504 blocked.last = NULL;
5341 21504 queue.first = NULL;
5342 21504 queue.last = NULL;
5343 21504 ctx_running = NULL;
5344
5345 21504 eval_cps_run_state = EVAL_CPS_STATE_RUNNING;
5346
5347 21504 mutex_unlock(&lbm_events_mutex);
5348 21504 mutex_unlock(&qmutex);
5349
5350
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 21504 times.
 21504 if (!lbm_init_env()) return 0;
5351 21504 eval_running = true;
5352 21504 return 1;
5353 }
5354
5355 21504 bool lbm_eval_init_events(unsigned int num_events) {
5356
5357 21504 mutex_lock(&lbm_events_mutex);
5358 21504 lbm_events = (lbm_event_t*)lbm_malloc(num_events * sizeof(lbm_event_t));
5359 21504 bool r = false;
5360
1/2
✓ Branch 0 taken 21504 times.
✗ Branch 1 not taken.
 21504 if (lbm_events) {
5361 21504 lbm_events_max = num_events;
5362 21504 lbm_events_head = 0;
5363 21504 lbm_events_tail = 0;
5364 21504 lbm_events_full = false;
5365 21504 lbm_event_handler_pid = -1;
5366 21504 r = true;
5367 }
5368 21504 mutex_unlock(&lbm_events_mutex);
5369 21504 return r;
5370 }
5371