Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/extensions/runtime_extensions.c	Lines:	106	121	87.6 %
Date:	2025-01-19 11:10:47	Branches:	28	40	70.0 %


/*
    Copyright 2023, 2024 Joel Svensson        svenssonjoel@yahoo.se

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

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

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

#include <lbm_memory.h>
#include <heap.h>
#include <eval_cps.h>
#include <extensions.h>
#include <lbm_utils.h>
#include <lbm_version.h>
#include <env.h>

#ifdef FULL_RTS_LIB
static lbm_uint sym_heap_size;
static lbm_uint sym_heap_bytes;
static lbm_uint sym_num_alloc_cells;
static lbm_uint sym_num_alloc_arrays;
static lbm_uint sym_num_gc;
static lbm_uint sym_num_gc_marked;
static lbm_uint sym_num_gc_recovered_cells;
static lbm_uint sym_num_gc_recovered_arrays;
static lbm_uint sym_num_least_free;
static lbm_uint sym_num_last_free;
#endif

lbm_value ext_eval_set_quota(lbm_value *args, lbm_uint argn) {
  LBM_CHECK_ARGN_NUMBER(1);
  uint32_t q = lbm_dec_as_u32(args[0]);
  lbm_set_eval_step_quota(q);
  return ENC_SYM_TRUE;
}

lbm_value ext_hide_trapped_error(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  lbm_set_hide_trapped_error(true);
  return ENC_SYM_TRUE;
}

lbm_value ext_show_trapped_error(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  lbm_set_hide_trapped_error(false);
  return ENC_SYM_TRUE;
}

#ifdef FULL_RTS_LIB
lbm_value ext_memory_num_free(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  lbm_uint n = lbm_memory_num_free();
  return lbm_enc_i((lbm_int)n);
}

lbm_value ext_memory_longest_free(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  lbm_uint n = lbm_memory_longest_free();
  return lbm_enc_i((lbm_int)n);
}

lbm_value ext_memory_size(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  lbm_uint n = lbm_memory_num_words();
  return lbm_enc_i((lbm_int)n);
}

lbm_value ext_memory_word_size(lbm_value *args, lbm_uint argn) {
  (void)args;
  (void)argn;
  return lbm_enc_i((lbm_int)sizeof(lbm_uint));
}

lbm_value ext_lbm_version(lbm_value *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  lbm_value version = lbm_heap_allocate_list_init(3,
                                                  lbm_enc_i(LBM_MAJOR_VERSION),
                                                  lbm_enc_i(LBM_MINOR_VERSION),
                                                  lbm_enc_i(LBM_PATCH_VERSION));
  return version;
}

lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {

  lbm_value res = ENC_SYM_TERROR;

  lbm_heap_state_t hs;
  lbm_get_heap_state(&hs);

  if (argn == 1 &&
      lbm_is_symbol(args[0])) {
    lbm_uint s = lbm_dec_sym(args[0]);
    if (s == sym_heap_size) {
      res = lbm_enc_u(hs.heap_size);
    } else if (s == sym_heap_bytes) {
      res = lbm_enc_u(hs.heap_bytes);
    } else if (s == sym_num_alloc_cells) {
      res = lbm_enc_u(hs.num_alloc);
    } else if (s == sym_num_alloc_arrays) {
      res = lbm_enc_u(hs.num_alloc_arrays);
    } else if (s == sym_num_gc) {
      res = lbm_enc_u(hs.gc_num);
    } else if (s == sym_num_gc_marked) {
      res = lbm_enc_u(hs.gc_marked);
    } else if (s == sym_num_gc_recovered_cells) {
      res = lbm_enc_u(hs.gc_recovered);
    } else if (s == sym_num_gc_recovered_arrays) {
      res = lbm_enc_u(hs.gc_recovered_arrays);
    } else if (s == sym_num_least_free) {
      res = lbm_enc_u(hs.gc_least_free);
    } else if (s == sym_num_last_free) {
      res = lbm_enc_u(hs.gc_last_free);
    } else {
      res = ENC_SYM_NIL;
    }
  }
  return res;
}

lbm_value ext_env_get(lbm_value *args, lbm_uint argn) {
  if (argn == 1 && lbm_is_number(args[0])) {
    lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
    return lbm_get_global_env()[ix];
  }
  return ENC_SYM_TERROR;
}

lbm_value ext_local_env_get(lbm_value *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  eval_context_t *ctx = lbm_get_current_context();
  return ctx->curr_env;
}

lbm_value ext_env_set(lbm_value *args, lbm_uint argn) {
  if (argn == 2 && lbm_is_number(args[0])) {
    lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
    lbm_value *glob_env = lbm_get_global_env();
    glob_env[ix] = args[1];
    return ENC_SYM_TRUE;
  }
  return ENC_SYM_NIL;
}

lbm_value ext_set_gc_stack_size(lbm_value *args, lbm_uint argn) {
  if (argn == 1) {
    if (lbm_is_number(args[0])) {
      uint32_t n = lbm_dec_as_u32(args[0]);
      lbm_uint *new_stack = lbm_malloc(n * sizeof(lbm_uint));
      if (new_stack) {
        lbm_free(lbm_heap_state.gc_stack.data);
        lbm_heap_state.gc_stack.data = new_stack;
        lbm_heap_state.gc_stack.size = n;
        lbm_heap_state.gc_stack.sp = 0;  // should already be 0
        return ENC_SYM_TRUE;
      }
      return ENC_SYM_MERROR;
    }
  }
  return ENC_SYM_TERROR;
}

lbm_value ext_is_64bit(lbm_value *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  #ifndef LBM64
  return ENC_SYM_NIL;
  #else
  return ENC_SYM_TRUE;
  #endif
}

lbm_value ext_symbol_table_size(lbm_uint *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  return lbm_enc_u(lbm_get_symbol_table_size());
}

lbm_value ext_symbol_table_size_flash(lbm_uint *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  return lbm_enc_u(lbm_get_symbol_table_size_flash());
}

lbm_value ext_symbol_table_size_names(lbm_uint *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  return lbm_enc_u(lbm_get_symbol_table_size_names());
}

lbm_value ext_symbol_table_size_names_flash(lbm_uint *args, lbm_uint argn) {
  (void) args;
  (void) argn;
  return lbm_enc_u(lbm_get_symbol_table_size_names_flash());
}

#endif

void lbm_runtime_extensions_init(void) {

#ifdef FULL_RTS_LIB
    lbm_add_symbol_const("get-heap-size", &sym_heap_size);
    lbm_add_symbol_const("get-heap-bytes", &sym_heap_bytes);
    lbm_add_symbol_const("get-num-alloc-cells", &sym_num_alloc_cells);
    lbm_add_symbol_const("get-num-alloc-arrays", &sym_num_alloc_arrays);
    lbm_add_symbol_const("get-gc-num", &sym_num_gc);
    lbm_add_symbol_const("get-gc-num-marked", &sym_num_gc_marked);
    lbm_add_symbol_const("get-gc-num-recovered-cells", &sym_num_gc_recovered_cells);
    lbm_add_symbol_const("get-gc-num-recovered-arrays", &sym_num_gc_recovered_arrays);
    lbm_add_symbol_const("get-gc-num-least-free", &sym_num_least_free);
    lbm_add_symbol_const("get-gc-num-last-free", &sym_num_last_free);
#endif

#ifndef FULL_RTS_LIB
    lbm_add_extension("set-eval-quota", ext_eval_set_quota);
    lbm_add_extension("hide-trapped-error", ext_hide_trapped_error);
    lbm_add_extension("show-trapped-error", ext_show_trapped_error);
#else
    lbm_add_extension("set-eval-quota", ext_eval_set_quota);
    lbm_add_extension("hide-trapped-error", ext_hide_trapped_error);
    lbm_add_extension("show-trapped-error", ext_show_trapped_error);
    lbm_add_extension("mem-num-free", ext_memory_num_free);
    lbm_add_extension("mem-longest-free", ext_memory_longest_free);
    lbm_add_extension("mem-size", ext_memory_size);
    lbm_add_extension("word-size", ext_memory_word_size);
    lbm_add_extension("lbm-version", ext_lbm_version);
    lbm_add_extension("lbm-heap-state", ext_lbm_heap_state);
    lbm_add_extension("env-get", ext_env_get);
    lbm_add_extension("env-set", ext_env_set);
    lbm_add_extension("local-env-get", ext_local_env_get);
    lbm_add_extension("set-gc-stack-size", ext_set_gc_stack_size);
    lbm_add_extension("is-64bit", ext_is_64bit);
    lbm_add_extension("symtab-size", ext_symbol_table_size);
    lbm_add_extension("symtab-size-flash", ext_symbol_table_size_flash);
    lbm_add_extension("symtab-size-names", ext_symbol_table_size_names);
    lbm_add_extension("symtab-size-names-flash", ext_symbol_table_size_names_flash);
#endif
}


Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1			/*
2			Copyright 2023, 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 <heap.h>
20			#include <eval_cps.h>
21			#include <extensions.h>
22			#include <lbm_utils.h>
23			#include <lbm_version.h>
24			#include <env.h>
25
26			#ifdef FULL_RTS_LIB
27			static lbm_uint sym_heap_size;
28			static lbm_uint sym_heap_bytes;
29			static lbm_uint sym_num_alloc_cells;
30			static lbm_uint sym_num_alloc_arrays;
31			static lbm_uint sym_num_gc;
32			static lbm_uint sym_num_gc_marked;
33			static lbm_uint sym_num_gc_recovered_cells;
34			static lbm_uint sym_num_gc_recovered_arrays;
35			static lbm_uint sym_num_least_free;
36			static lbm_uint sym_num_last_free;
37			#endif
38
39		28	lbm_value ext_eval_set_quota(lbm_value *args, lbm_uint argn) {
40	✗✓	28	LBM_CHECK_ARGN_NUMBER(1);
41		28	uint32_t q = lbm_dec_as_u32(args[0]);
42		28	lbm_set_eval_step_quota(q);
43		28	return ENC_SYM_TRUE;
44			}
45
46			lbm_value ext_hide_trapped_error(lbm_value *args, lbm_uint argn) {
47			(void)args;
48			(void)argn;
49			lbm_set_hide_trapped_error(true);
50			return ENC_SYM_TRUE;
51			}
52
53			lbm_value ext_show_trapped_error(lbm_value *args, lbm_uint argn) {
54			(void)args;
55			(void)argn;
56			lbm_set_hide_trapped_error(false);
57			return ENC_SYM_TRUE;
58			}
59
60			#ifdef FULL_RTS_LIB
61		1064	lbm_value ext_memory_num_free(lbm_value *args, lbm_uint argn) {
62			(void)args;
63			(void)argn;
64		1064	lbm_uint n = lbm_memory_num_free();
65		1064	return lbm_enc_i((lbm_int)n);
66			}
67
68		112	lbm_value ext_memory_longest_free(lbm_value *args, lbm_uint argn) {
69			(void)args;
70			(void)argn;
71		112	lbm_uint n = lbm_memory_longest_free();
72		112	return lbm_enc_i((lbm_int)n);
73			}
74
75		28	lbm_value ext_memory_size(lbm_value *args, lbm_uint argn) {
76			(void)args;
77			(void)argn;
78		28	lbm_uint n = lbm_memory_num_words();
79		28	return lbm_enc_i((lbm_int)n);
80			}
81
82		308	lbm_value ext_memory_word_size(lbm_value *args, lbm_uint argn) {
83			(void)args;
84			(void)argn;
85		308	return lbm_enc_i((lbm_int)sizeof(lbm_uint));
86			}
87
88		28	lbm_value ext_lbm_version(lbm_value *args, lbm_uint argn) {
89			(void) args;
90			(void) argn;
91		28	lbm_value version = lbm_heap_allocate_list_init(3,
92			lbm_enc_i(LBM_MAJOR_VERSION),
93			lbm_enc_i(LBM_MINOR_VERSION),
94			lbm_enc_i(LBM_PATCH_VERSION));
95		28	return version;
96			}
97
98		252	lbm_value ext_lbm_heap_state(lbm_value *args, lbm_uint argn) {
99
100		252	lbm_value res = ENC_SYM_TERROR;
101
102			lbm_heap_state_t hs;
103		252	lbm_get_heap_state(&hs);
104
105	✓✗✓✗	504	if (argn == 1 &&
106		252	lbm_is_symbol(args[0])) {
107		252	lbm_uint s = lbm_dec_sym(args[0]);
108	✓✓	252	if (s == sym_heap_size) {
109		28	res = lbm_enc_u(hs.heap_size);
110	✓✓	224	} else if (s == sym_heap_bytes) {
111		28	res = lbm_enc_u(hs.heap_bytes);
112	✓✓	196	} else if (s == sym_num_alloc_cells) {
113		28	res = lbm_enc_u(hs.num_alloc);
114	✗✓	168	} else if (s == sym_num_alloc_arrays) {
115			res = lbm_enc_u(hs.num_alloc_arrays);
116	✓✓	168	} else if (s == sym_num_gc) {
117		28	res = lbm_enc_u(hs.gc_num);
118	✓✓	140	} else if (s == sym_num_gc_marked) {
119		28	res = lbm_enc_u(hs.gc_marked);
120	✓✓	112	} else if (s == sym_num_gc_recovered_cells) {
121		28	res = lbm_enc_u(hs.gc_recovered);
122	✓✓	84	} else if (s == sym_num_gc_recovered_arrays) {
123		28	res = lbm_enc_u(hs.gc_recovered_arrays);
124	✓✓	56	} else if (s == sym_num_least_free) {
125		28	res = lbm_enc_u(hs.gc_least_free);
126	✓✗	28	} else if (s == sym_num_last_free) {
127		28	res = lbm_enc_u(hs.gc_last_free);
128			} else {
129			res = ENC_SYM_NIL;
130			}
131			}
132		252	return res;
133			}
134
135		672	lbm_value ext_env_get(lbm_value *args, lbm_uint argn) {
136	✓✗✓✗	672	if (argn == 1 && lbm_is_number(args[0])) {
137		672	lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
138		672	return lbm_get_global_env()[ix];
139			}
140			return ENC_SYM_TERROR;
141			}
142
143			lbm_value ext_local_env_get(lbm_value *args, lbm_uint argn) {
144			(void) args;
145			(void) argn;
146			eval_context_t *ctx = lbm_get_current_context();
147			return ctx->curr_env;
148			}
149
150		56	lbm_value ext_env_set(lbm_value *args, lbm_uint argn) {
151	✓✗✓✗	56	if (argn == 2 && lbm_is_number(args[0])) {
152		56	lbm_uint ix = lbm_dec_as_u32(args[0]) & GLOBAL_ENV_MASK;
153		56	lbm_value *glob_env = lbm_get_global_env();
154		56	glob_env[ix] = args[1];
155		56	return ENC_SYM_TRUE;
156			}
157			return ENC_SYM_NIL;
158			}
159
160		168	lbm_value ext_set_gc_stack_size(lbm_value *args, lbm_uint argn) {
161	✓✗	168	if (argn == 1) {
162	✓✗	168	if (lbm_is_number(args[0])) {
163		168	uint32_t n = lbm_dec_as_u32(args[0]);
164		168	lbm_uint new_stack = lbm_malloc(n sizeof(lbm_uint));
165	✓✗	168	if (new_stack) {
166		168	lbm_free(lbm_heap_state.gc_stack.data);
167		168	lbm_heap_state.gc_stack.data = new_stack;
168		168	lbm_heap_state.gc_stack.size = n;
169		168	lbm_heap_state.gc_stack.sp = 0; // should already be 0
170		168	return ENC_SYM_TRUE;
171			}
172			return ENC_SYM_MERROR;
173			}
174			}
175			return ENC_SYM_TERROR;
176			}
177
178		280	lbm_value ext_is_64bit(lbm_value *args, lbm_uint argn) {
179			(void) args;
180			(void) argn;
181			#ifndef LBM64
182		280	return ENC_SYM_NIL;
183			#else
184			return ENC_SYM_TRUE;
185			#endif
186			}
187
188		28	lbm_value ext_symbol_table_size(lbm_uint *args, lbm_uint argn) {
189			(void) args;
190			(void) argn;
191		28	return lbm_enc_u(lbm_get_symbol_table_size());
192			}
193
194		28	lbm_value ext_symbol_table_size_flash(lbm_uint *args, lbm_uint argn) {
195			(void) args;
196			(void) argn;
197		28	return lbm_enc_u(lbm_get_symbol_table_size_flash());
198			}
199
200		28	lbm_value ext_symbol_table_size_names(lbm_uint *args, lbm_uint argn) {
201			(void) args;
202			(void) argn;
203		28	return lbm_enc_u(lbm_get_symbol_table_size_names());
204			}
205
206		28	lbm_value ext_symbol_table_size_names_flash(lbm_uint *args, lbm_uint argn) {
207			(void) args;
208			(void) argn;
209		28	return lbm_enc_u(lbm_get_symbol_table_size_names_flash());
210			}
211
212			#endif
213
214		21588	void lbm_runtime_extensions_init(void) {
215
216			#ifdef FULL_RTS_LIB
217		21588	lbm_add_symbol_const("get-heap-size", &sym_heap_size);
218		21588	lbm_add_symbol_const("get-heap-bytes", &sym_heap_bytes);
219		21588	lbm_add_symbol_const("get-num-alloc-cells", &sym_num_alloc_cells);
220		21588	lbm_add_symbol_const("get-num-alloc-arrays", &sym_num_alloc_arrays);
221		21588	lbm_add_symbol_const("get-gc-num", &sym_num_gc);
222		21588	lbm_add_symbol_const("get-gc-num-marked", &sym_num_gc_marked);
223		21588	lbm_add_symbol_const("get-gc-num-recovered-cells", &sym_num_gc_recovered_cells);
224		21588	lbm_add_symbol_const("get-gc-num-recovered-arrays", &sym_num_gc_recovered_arrays);
225		21588	lbm_add_symbol_const("get-gc-num-least-free", &sym_num_least_free);
226		21588	lbm_add_symbol_const("get-gc-num-last-free", &sym_num_last_free);
227			#endif
228
229			#ifndef FULL_RTS_LIB
230			lbm_add_extension("set-eval-quota", ext_eval_set_quota);
231			lbm_add_extension("hide-trapped-error", ext_hide_trapped_error);
232			lbm_add_extension("show-trapped-error", ext_show_trapped_error);
233			#else
234		21588	lbm_add_extension("set-eval-quota", ext_eval_set_quota);
235		21588	lbm_add_extension("hide-trapped-error", ext_hide_trapped_error);
236		21588	lbm_add_extension("show-trapped-error", ext_show_trapped_error);
237		21588	lbm_add_extension("mem-num-free", ext_memory_num_free);
238		21588	lbm_add_extension("mem-longest-free", ext_memory_longest_free);
239		21588	lbm_add_extension("mem-size", ext_memory_size);
240		21588	lbm_add_extension("word-size", ext_memory_word_size);
241		21588	lbm_add_extension("lbm-version", ext_lbm_version);
242		21588	lbm_add_extension("lbm-heap-state", ext_lbm_heap_state);
243		21588	lbm_add_extension("env-get", ext_env_get);
244		21588	lbm_add_extension("env-set", ext_env_set);
245		21588	lbm_add_extension("local-env-get", ext_local_env_get);
246		21588	lbm_add_extension("set-gc-stack-size", ext_set_gc_stack_size);
247		21588	lbm_add_extension("is-64bit", ext_is_64bit);
248		21588	lbm_add_extension("symtab-size", ext_symbol_table_size);
249		21588	lbm_add_extension("symtab-size-flash", ext_symbol_table_size_flash);
250		21588	lbm_add_extension("symtab-size-names", ext_symbol_table_size_names);
251		21588	lbm_add_extension("symtab-size-names-flash", ext_symbol_table_size_names_flash);
252			#endif
253		21588	}