Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/lbm_c_interop.c	Lines:	46	137	33.6 %
Date:	2024-12-26 17:59:19	Branches:	16	78	20.5 %


/*
    Copyright 2022 Joel Svensson    svenssonjoel@yahoo.se

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include "lbm_c_interop.h"

/****************************************************/
/* Interface for loading and running programs and   */
/* expressions                                      */

lbm_cid eval_cps_load_and_eval(lbm_char_channel_t *tokenizer, bool program, bool incremental, char *name) {

  lbm_value stream;

  if (!lift_char_channel(tokenizer, &stream)) {
    return -1;
  }

  if (lbm_type_of(stream) == LBM_TYPE_SYMBOL) {
    // TODO: Check what should be done.
    return -1;
  }

  lbm_value read_mode = ENC_SYM_READ;
  if (program) {
    if (incremental) {
      read_mode = ENC_SYM_READ_AND_EVAL_PROGRAM;
    } else {
      read_mode = ENC_SYM_READ_PROGRAM;
    }
  }
  /*
   read-eval-program finishes with the result of the final expression in
   the program. This should not be passed to eval-program as it is most likely
   not a program. Even if it is a program, its not one we want to evaluate.
  */

  /* LISP ZONE */
  lbm_value launcher = lbm_cons(stream, ENC_SYM_NIL);
  launcher = lbm_cons(read_mode, launcher);
  lbm_value evaluator;
  lbm_value start_prg;
  if (read_mode == ENC_SYM_READ) {
    evaluator = lbm_cons(launcher, ENC_SYM_NIL);
    evaluator = lbm_cons(ENC_SYM_EVAL, evaluator);
    start_prg = lbm_cons(evaluator, ENC_SYM_NIL);
  } else if (read_mode == ENC_SYM_READ_PROGRAM) {
    evaluator = lbm_cons(launcher, ENC_SYM_NIL);
    evaluator = lbm_cons(ENC_SYM_EVAL_PROGRAM, evaluator);
    start_prg = lbm_cons(evaluator, ENC_SYM_NIL);
  } else { // ENC_SYM_READ_AND_EVAL_PROGRAM
    evaluator = launcher; // dummy so check below passes
    start_prg = lbm_cons(launcher, ENC_SYM_NIL);
  }

  /* LISP ZONE ENDS */

  if (lbm_type_of(launcher) != LBM_TYPE_CONS ||
      lbm_type_of(evaluator) != LBM_TYPE_CONS ||
      lbm_type_of(start_prg) != LBM_TYPE_CONS ) {
    return -1;
  }
  return lbm_create_ctx(start_prg, ENC_SYM_NIL, 256, name);
}

lbm_cid eval_cps_load_and_define(lbm_char_channel_t *tokenizer, char *symbol, bool program) {

  lbm_value stream;

  if (!lift_char_channel(tokenizer, &stream)) {
    return -1;
  }

  if (lbm_type_of(stream) == LBM_TYPE_SYMBOL) {
    return -1;
  }

  lbm_uint sym_id;

  if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
    if (!lbm_add_symbol_base(symbol, &sym_id,false)) { //ram
      return -1;
    }
  }

  /* LISP ZONE */

  lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL));
  launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher);
  lbm_value binding = lbm_cons(launcher, lbm_enc_sym(SYM_NIL));
  binding = lbm_cons(lbm_enc_sym(sym_id), binding);
  lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding);
  definer  = lbm_cons(definer, lbm_enc_sym(SYM_NIL));
  /* LISP ZONE ENDS */

  if (lbm_type_of(launcher) != LBM_TYPE_CONS ||
      lbm_type_of(binding) != LBM_TYPE_CONS ||
      lbm_type_of(definer) != LBM_TYPE_CONS ) {
    return -1;
  }
  return lbm_create_ctx(definer, lbm_enc_sym(SYM_NIL), 256, NULL);
}

lbm_cid lbm_eval_defined(char *symbol, bool program) {

  lbm_uint sym_id;

  if(!lbm_get_symbol_by_name(symbol, &sym_id)) {
    // The symbol does not exist, so it cannot be defined
    return -1;
  }

  lbm_value binding;

  if (!lbm_global_env_lookup(&binding, lbm_enc_sym(sym_id))) {
    return -1;
  }

  /* LISP ZONE */

  lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), lbm_enc_sym(SYM_NIL));
  lbm_value evaluator = launcher;
  evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator);
  lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL));

  /* LISP ZONE ENDS */

  if (lbm_type_of(launcher) != LBM_TYPE_CONS ||
      lbm_type_of(evaluator) != LBM_TYPE_CONS ||
      lbm_type_of(start_prg) != LBM_TYPE_CONS ) {
    return -1;
  }
  return lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256, NULL);
}



lbm_cid lbm_load_and_eval_expression(lbm_char_channel_t *tokenizer) {
  return eval_cps_load_and_eval(tokenizer, false,false, NULL);
}

lbm_cid lbm_load_and_define_expression(lbm_char_channel_t *tokenizer, char *symbol) {
  return eval_cps_load_and_define(tokenizer, symbol, false);
}

lbm_cid lbm_load_and_eval_program(lbm_char_channel_t *tokenizer, char *name) {
  return eval_cps_load_and_eval(tokenizer, true, false, name);
}

lbm_cid lbm_load_and_eval_program_incremental(lbm_char_channel_t *tokenizer, char *name) {
  return eval_cps_load_and_eval(tokenizer, true, true, name);
}

lbm_cid lbm_load_and_define_program(lbm_char_channel_t *tokenizer, char *symbol) {
  return eval_cps_load_and_define(tokenizer, symbol, true);
}

lbm_cid lbm_eval_defined_expression(char *symbol) {
  return lbm_eval_defined(symbol, false);
}

lbm_cid lbm_eval_defined_program(char *symbol) {
  return lbm_eval_defined(symbol, true);
}

int lbm_send_message(lbm_cid cid, lbm_value msg) {
  int res = 0;

  if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {

    int v = lbm_find_receiver_and_send(cid, msg);
    if (v == 0) res = 1;
    else res = 0;
  }
  return res;
}

int lbm_define(char *symbol, lbm_value value) {
  int res = 0;

  lbm_uint sym_id;
  if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
    if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
      if (!lbm_add_symbol_const_base(symbol, &sym_id)) {
        return 0;
      }
    }
    lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
    lbm_value *glob_env = lbm_get_global_env();
    glob_env[ix_key] = lbm_env_set(glob_env[ix_key], lbm_enc_sym(sym_id), value);
  }
  return res;
}

int lbm_undefine(char *symbol) {
  lbm_uint sym_id;
  if (!lbm_get_symbol_by_name(symbol, &sym_id))
    return 0;

  lbm_value *glob_env = lbm_get_global_env();
  lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
  lbm_value new_env = lbm_env_drop_binding(glob_env[ix_key], lbm_enc_sym(sym_id));

  if (new_env == ENC_SYM_NOT_FOUND) return 0;
  glob_env[ix_key] = new_env;
  return 1;
}

int lbm_share_array(lbm_value *value, char *data, lbm_uint num_elt) {
  return lbm_lift_array(value, data, num_elt);
}

static bool share_const_array(lbm_value flash_cell, char *data, lbm_uint num_elt) {
  lbm_array_header_t flash_array_header;
  flash_array_header.size = num_elt;
  flash_array_header.data = (lbm_uint*)data;
  lbm_uint flash_array_header_ptr;
  lbm_flash_status s = lbm_write_const_raw((lbm_uint*)&flash_array_header,
                                           sizeof(lbm_array_header_t) / sizeof(lbm_uint),
                                           &flash_array_header_ptr);
  if (s != LBM_FLASH_WRITE_OK) return false;
  s = write_const_car(flash_cell, flash_array_header_ptr);
  if (s != LBM_FLASH_WRITE_OK) return false;
  s = write_const_cdr(flash_cell, ENC_SYM_ARRAY_TYPE);
  if (s != LBM_FLASH_WRITE_OK) return false;
  return true;
}

int lbm_share_const_array(lbm_value *res, char *flash_ptr, lbm_uint num_elt) {
  lbm_value arr = LBM_PTR_BIT | LBM_TYPE_ARRAY;
  lbm_value flash_arr = 0;
  int r = 0;
  if (request_flash_storage_cell(arr, &flash_arr) == LBM_FLASH_WRITE_OK) {
    if (share_const_array(flash_arr, flash_ptr, num_elt)) {
      *res = flash_arr;
      r = 1;
    }
  }
  return r;
}

int lbm_create_array(lbm_value *value, lbm_uint num_elt) {
  return lbm_heap_allocate_array(value, num_elt);
}


void lbm_clear_env(void) {

  lbm_value *env = lbm_get_global_env();
  for (int i = 0; i < GLOBAL_ENV_ROOTS; i ++) {
    env[i] = ENC_SYM_NIL;
  }
  lbm_perform_gc();
}

// Evaluator should be paused when running this.
// Running gc will reclaim the fv storage.
bool lbm_flatten_env(int index, lbm_uint** data, lbm_uint *size) {
  if (index < 0 || index >= GLOBAL_ENV_ROOTS) return false;
  lbm_value *env = lbm_get_global_env();

  lbm_value fv = flatten_value(env[index]);

  if (lbm_is_symbol(fv)) return false;

  lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(fv);
  *size = array->size;
  *data = array->data;
  return true;
}


Generated by: GCOVR (Version 4.2)

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