GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/lbm_c_interop.c
Date: 2025-10-28 15:15:18
Exec Total Coverage
Lines: 143 143 100.0%
Functions: 20 20 100.0%
Branches: 58 82 70.7%
Line Branch Exec Source
1 /*
2 Copyright 2022, 2025 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_c_interop.h"
19
20 /* Utility */
21
22 66489 static bool lift_char_channel(lbm_char_channel_t *chan , lbm_value *res) {
23 66489 lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CHANNEL, (lbm_uint) chan, ENC_SYM_CHANNEL_TYPE);
24 66489 bool rval = false;
25
1/2
✓ Branch 0 taken 66489 times.
✗ Branch 1 not taken.
 66489 if (cell != ENC_SYM_MERROR) {
26 66489 *res = cell;
27 66489 rval = true;
28 }
29 66489 return rval;
30 }
31
32
33
34 /****************************************************/
35 /* Interface for loading and running programs and */
36 /* expressions */
37
38 66485 lbm_cid eval_cps_load_and_eval(lbm_char_channel_t *tokenizer, bool program, bool incremental, char *name) {
39
40 lbm_value stream;
41 66485 lbm_cid cid = -1;
42
1/2
✓ Branch 0 taken 66485 times.
✗ Branch 1 not taken.
 66485 if (lift_char_channel(tokenizer, &stream)) {
43 66485 lbm_value read_mode = ENC_SYM_READ;
44
2/2
✓ Branch 0 taken 66475 times.
✓ Branch 1 taken 10 times.
 66485 if (program) {
45
2/2
✓ Branch 0 taken 33415 times.
✓ Branch 1 taken 33060 times.
 66475 if (incremental) {
46 33415 read_mode = ENC_SYM_READ_AND_EVAL_PROGRAM;
47 } else {
48 33060 read_mode = ENC_SYM_READ_PROGRAM;
49 }
50 }
51 /*
52 read-eval-program finishes with the result of the final expression in
53 the program. This should not be passed to eval-program as it is most likely
54 not a program. Even if it is a program, its not one we want to evaluate.
55 */
56
57 /* LISP ZONE */
58 66485 lbm_value launcher = lbm_cons(stream, ENC_SYM_NIL);
59 66485 launcher = lbm_cons(read_mode, launcher);
60 lbm_value evaluator;
61 lbm_value start_prg;
62
2/2
✓ Branch 0 taken 10 times.
✓ Branch 1 taken 66475 times.
 66485 if (read_mode == ENC_SYM_READ) {
63 10 evaluator = lbm_cons(launcher, ENC_SYM_NIL);
64 10 evaluator = lbm_cons(ENC_SYM_EVAL, evaluator);
65 10 start_prg = lbm_cons(evaluator, ENC_SYM_NIL);
66
2/2
✓ Branch 0 taken 33060 times.
✓ Branch 1 taken 33415 times.
 66475 } else if (read_mode == ENC_SYM_READ_PROGRAM) {
67 33060 evaluator = lbm_cons(launcher, ENC_SYM_NIL);
68 33060 evaluator = lbm_cons(ENC_SYM_EVAL_PROGRAM, evaluator);
69 33060 start_prg = lbm_cons(evaluator, ENC_SYM_NIL);
70 } else { // ENC_SYM_READ_AND_EVAL_PROGRAM
71 33415 evaluator = launcher; // dummy so check below passes
72 33415 start_prg = lbm_cons(launcher, ENC_SYM_NIL);
73 }
74
75 /* LISP ZONE ENDS */
76
77
2/4
✓ Branch 0 taken 66485 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 66485 times.
✗ Branch 3 not taken.
 132970 if (lbm_type_of(launcher) == LBM_TYPE_CONS &&
78
1/2
✓ Branch 0 taken 66485 times.
✗ Branch 1 not taken.
 132970 lbm_type_of(evaluator) == LBM_TYPE_CONS &&
79 66485 lbm_type_of(start_prg) == LBM_TYPE_CONS ) {
80 66485 cid = lbm_create_ctx(start_prg, ENC_SYM_NIL, 256, name);
81 }
82 }
83 66485 return cid;
84 }
85
86 4 lbm_cid eval_cps_load_and_define(lbm_char_channel_t *tokenizer, char *symbol, bool program) {
87 lbm_value stream;
88 4 lbm_cid cid = -1;
89
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
 4 if (lift_char_channel(tokenizer, &stream)) {
90 lbm_uint sym_id;
91
2/4
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4 times.
✗ Branch 3 not taken.
 8 if (lbm_get_symbol_by_name(symbol, &sym_id) ||
92 4 lbm_add_symbol_base(symbol, &sym_id)) {
93 /* LISP ZONE */
94 4 lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL));
95
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
 4 launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
96 4 lbm_value binding = lbm_cons(launcher, lbm_enc_sym(SYM_NIL));
97 4 binding = lbm_cons(lbm_enc_sym(sym_id), binding);
98 4 lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding);
99 4 definer = lbm_cons(definer, lbm_enc_sym(SYM_NIL));
100 /* LISP ZONE ENDS */
101
102
2/4
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4 times.
✗ Branch 3 not taken.
 8 if (lbm_type_of(launcher) == LBM_TYPE_CONS &&
103
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
 8 lbm_type_of(binding) == LBM_TYPE_CONS &&
104 4 lbm_type_of(definer) == LBM_TYPE_CONS ) {
105 4 cid = lbm_create_ctx(definer, lbm_enc_sym(SYM_NIL), 256, NULL);
106 }
107 }
108 }
109 4 return cid;
110 }
111
112 5 lbm_cid lbm_eval_defined(char *symbol, bool program) {
113
114 lbm_uint sym_id;
115 lbm_value binding;
116 5 lbm_cid cid = -1;
117
3/4
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 3 times.
✗ Branch 3 not taken.
 8 if (lbm_get_symbol_by_name(symbol, &sym_id) &&
118 3 lbm_global_env_lookup(&binding, lbm_enc_sym(sym_id))) {
119
120 /* LISP ZONE */
121 3 lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), lbm_enc_sym(SYM_NIL));
122 3 lbm_value evaluator = launcher;
123
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 2 times.
 3 evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
124 3 lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL));
125 /* LISP ZONE ENDS */
126
127
2/4
✓ Branch 0 taken 3 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3 times.
✗ Branch 3 not taken.
 6 if (lbm_type_of(launcher) == LBM_TYPE_CONS &&
128
1/2
✓ Branch 0 taken 3 times.
✗ Branch 1 not taken.
 6 lbm_type_of(evaluator) == LBM_TYPE_CONS &&
129 3 lbm_type_of(start_prg) == LBM_TYPE_CONS ) {
130 3 cid = lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256, NULL);
131 }
132 }
133 5 return cid;
134 }
135
136
137
138 10 lbm_cid lbm_load_and_eval_expression(lbm_char_channel_t *tokenizer) {
139 10 return eval_cps_load_and_eval(tokenizer, false,false, NULL);
140 }
141
142 2 lbm_cid lbm_load_and_define_expression(lbm_char_channel_t *tokenizer, char *symbol) {
143 2 return eval_cps_load_and_define(tokenizer, symbol, false);
144 }
145
146 33060 lbm_cid lbm_load_and_eval_program(lbm_char_channel_t *tokenizer, char *name) {
147 33060 return eval_cps_load_and_eval(tokenizer, true, false, name);
148 }
149
150 33415 lbm_cid lbm_load_and_eval_program_incremental(lbm_char_channel_t *tokenizer, char *name) {
151 33415 return eval_cps_load_and_eval(tokenizer, true, true, name);
152 }
153
154 2 lbm_cid lbm_load_and_define_program(lbm_char_channel_t *tokenizer, char *symbol) {
155 2 return eval_cps_load_and_define(tokenizer, symbol, true);
156 }
157
158 3 lbm_cid lbm_eval_defined_expression(char *symbol) {
159 3 return lbm_eval_defined(symbol, false);
160 }
161
162 2 lbm_cid lbm_eval_defined_program(char *symbol) {
163 2 return lbm_eval_defined(symbol, true);
164 }
165
166 2 int lbm_send_message(lbm_cid cid, lbm_value msg) {
167 2 int res = 0;
168
169
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
 2 if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
170
171
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 if (lbm_find_receiver_and_send(cid, msg)) {
172 1 res = 1;
173 }
174 }
175 2 return res;
176 }
177
178 17 int lbm_define(char *symbol, lbm_value value) {
179 17 int res = 0;
180
2/2
✓ Branch 0 taken 16 times.
✓ Branch 1 taken 1 times.
 17 if (symbol) {
181 lbm_uint sym_id;
182
2/2
✓ Branch 0 taken 15 times.
✓ Branch 1 taken 1 times.
 16 if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
183
3/4
✓ Branch 0 taken 14 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 14 times.
✗ Branch 3 not taken.
 29 if (lbm_get_symbol_by_name(symbol, &sym_id) ||
184 14 lbm_add_symbol_const_base(symbol, &sym_id, false)) {
185 15 lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
186 15 lbm_value *glob_env = lbm_get_global_env();
187 15 glob_env[ix_key] = lbm_env_set(glob_env[ix_key], lbm_enc_sym(sym_id), value);
188 15 res = 1;
189 }
190 }
191 }
192 17 return res;
193 }
194
195 6 int lbm_undefine(char *symbol) {
196 lbm_uint sym_id;
197 6 int res = 0;
198
4/4
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 3 times.
✓ Branch 3 taken 2 times.
 6 if (symbol && lbm_get_symbol_by_name(symbol, &sym_id)) {
199
200 3 lbm_value *glob_env = lbm_get_global_env();
201 3 lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
202 3 lbm_value new_env = lbm_env_drop_binding(glob_env[ix_key], lbm_enc_sym(sym_id));
203
204
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
 3 if (new_env != ENC_SYM_NOT_FOUND) {
205 2 glob_env[ix_key] = new_env;
206 2 res = 1;
207 }
208 }
209 6 return res;
210 }
211
212 3 int lbm_share_array(lbm_value *value, char *data, lbm_uint num_elt) {
213 3 return lbm_lift_array(value, data, num_elt);
214 }
215
216 168 static bool share_array_const(lbm_value flash_cell, char *data, lbm_uint num_elt) {
217 lbm_array_header_t flash_array_header;
218 168 flash_array_header.size = num_elt;
219 168 flash_array_header.data = (lbm_uint*)data;
220 lbm_uint flash_array_header_ptr;
221 168 lbm_flash_status s = lbm_write_const_raw((lbm_uint*)&flash_array_header,
222 sizeof(lbm_array_header_t) / sizeof(lbm_uint),
223 &flash_array_header_ptr);
224
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 168 times.
 168 if (s != LBM_FLASH_WRITE_OK) return false;
225 168 s = write_const_car(flash_cell, flash_array_header_ptr);
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 168 times.
 168 if (s != LBM_FLASH_WRITE_OK) return false;
227 168 s = write_const_cdr(flash_cell, ENC_SYM_ARRAY_TYPE);
228
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 168 times.
 168 if (s != LBM_FLASH_WRITE_OK) return false;
229 168 return true;
230 }
231
232 168 int lbm_share_array_const(lbm_value *res, char *flash_ptr, lbm_uint num_elt) {
233 168 lbm_value arr = LBM_PTR_BIT | LBM_TYPE_ARRAY;
234 168 lbm_value flash_arr = 0;
235 168 int r = 0;
236
1/2
✓ Branch 0 taken 168 times.
✗ Branch 1 not taken.
 168 if (request_flash_storage_cell(arr, &flash_arr) == LBM_FLASH_WRITE_OK) {
237
1/2
✓ Branch 0 taken 168 times.
✗ Branch 1 not taken.
 168 if (share_array_const(flash_arr, flash_ptr, num_elt)) {
238 168 *res = flash_arr;
239 168 r = 1;
240 }
241 }
242 168 return r;
243 }
244
245 // TODO: There is no NULL check in lbm_heap_allocate_array.
246 // Users must provide a valid pointer.
247 415148 int lbm_create_array(lbm_value *value, lbm_uint num_elt) {
248 415148 return lbm_heap_allocate_array(value, num_elt);
249 }
250
251
252 1 void lbm_clear_env(void) {
253
254 1 lbm_value *env = lbm_get_global_env();
255
2/2
✓ Branch 0 taken 32 times.
✓ Branch 1 taken 1 times.
 33 for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
256 32 env[i] = ENC_SYM_NIL;
257 }
258 1 lbm_perform_gc();
259 1 }
260
261 // Evaluator should be paused when running this.
262 // Running gc will reclaim the fv storage.
263 3 bool lbm_flatten_env(int index, lbm_uint** data, lbm_uint *size) {
264
4/4
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 1 times.
 3 if (index < 0 || index >= GLOBAL_ENV_ROOTS) return false;
265 1 lbm_value *env = lbm_get_global_env();
266
267 1 lbm_value fv = flatten_value(env[index]);
268
269
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 if (lbm_is_symbol(fv)) return false;
270
271 1 lbm_array_header_t *array = lbm_dec_array_r(fv);
272 1 bool rval = false;
273
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 if (array) {
274 1 *size = array->size;
275 1 *data = array->data;
276 1 rval = true;
277 }
278 1 return rval;
279 }
280