Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/extensions/runtime_extensions.c	Lines:	104	113	92.0 %
Date:	2024-12-26 17:59:19	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;
}

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