mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-05 18:30:24 -08:00
Code Issues Projects Releases Packages Wiki Activity

[nucl] fix the compiled code size and cleanup the dictionary

Browse source 
Previously we've wrongly estimated that the vector with opcodes has the same
length as the number of words, but:

CALLW takes an argument denoting the index of the function on data stack
PUSHQ takes an argument denoting the index of the literal on data stack

Moreover rename some dictionary entries for more descriptive names and add a new
word .V that prints values stored in the environment.
This commit is contained in:
Daniel Kochmański 2025-06-04 10:03:03 +02:00
parent d7d446bfff
commit 3b25b8c8b4
1 changed files with 30 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

48
src/c/nucl.c
View file

@ -878,7 +878,21 @@ cl_object nucl_word_print_stack(int narg) {
return size;
}
cl_object nucl_word_pop_print(int narg) {
cl_object nucl_word_print_values(int narg) {
const cl_env_ptr the_env = ecl_process_env();
cl_index ssize = the_env->nvalues, idx;
cl_object size = ecl_make_fixnum(ssize);
nucl_write_cstr("[");
nucl_write_object(size);
nucl_write_cstr("] ");
for(idx=0; idx<ssize; idx++) {
nucl_write_object(the_env->values[idx]);
nucl_write_cstr(" ");
}
return size;
}
cl_object nucl_word_pop_and_print(int narg) {
const cl_env_ptr the_env = ecl_process_env();
cl_index ssize = ECL_STACK_INDEX(the_env);
/* INV the first element 0 is always present. */
@ -893,15 +907,11 @@ cl_object nucl_word_pop_print(int narg) {
}
}
cl_object nucl_word_test(int narg) {
nucl_write_cstr("Test call\n");
return ECL_NIL;
}
ecl_def_function(_nucl_word_print_dictionary, nucl_word_print_dictionary, static, const);
ecl_def_function(_nucl_word_print_stack, nucl_word_print_stack, static, const);
ecl_def_function(_nucl_word_print_values, nucl_word_print_values, static, const);
ecl_def_function(_nucl_word_ps, nucl_word_print_stack, static, const);
ecl_def_function(_nucl_word_pd, nucl_word_print_dictionary, static, const);
ecl_def_function(_nucl_word_dp, nucl_word_pop_print, static, const);
ecl_def_function(_nucl_word_tt, nucl_word_test, static, const);
ecl_def_function(_nucl_word_pop_and_print, nucl_word_pop_and_print, static, const);
/* Our dictionary is based on symbols. Each symbol in a dictionary has a name
and a value. We may need to rethink it at some point. */
@ -1013,10 +1023,10 @@ static cl_object nucl_dictionary_default_entries[] = {
make_code_entry("STEPCALL", OP_STEPCALL),
make_code_entry("STEPOUT", OP_STEPOUT),
/* indirect words */
make_dict_entry(".D", _nucl_word_pd),
make_dict_entry(".S", _nucl_word_ps),
make_dict_entry(".", _nucl_word_dp),
make_dict_entry(",", _nucl_word_tt),
make_dict_entry(".D", _nucl_word_print_dictionary),
make_dict_entry(".S", _nucl_word_print_stack),
make_dict_entry(".V", _nucl_word_print_values),
make_dict_entry(".", _nucl_word_pop_and_print),
NULL,
};
@ -1039,9 +1049,9 @@ nucl_compile_definition(void)
{
/* The compilation (for now) is really trivial. When we encounter:
- opcode -- insert this opcode directly
- symbol -- CALLW (takes value from data and calls it)
- object -- PUSHQ (takes value from data and push on stack)
- opcode -- insert this opcode directly | 1 opcode
- symbol -- CALLW (takes value from data and calls it) | 2 opcodes
- object -- PUSHQ (takes value from data and push on stack) | 2 opcodes
Opcodes are also represented here by symbols, but have a flag set that
denotes that they may be threaded directly. Symbols denote functions that
@ -1050,8 +1060,10 @@ nucl_compile_definition(void)
cl_object frame = nucl_stack_frame();
cl_object word = nucl_alloc_bytecodes(), value;
cl_index size = nucl_frame_size(frame), idx = 0, dat = 0;
cl_index code_size = 2*size+1 ; /* large enough, a bit wasteful */
cl_opcode *code = ecl_alloc(code_size * sizeof(cl_opcode));
cl_object data = ecl_make_stack(0);
cl_opcode *code = ecl_alloc((size+1) * sizeof(cl_opcode));
/* Compute the necessary code size */
loop_across_frame_fifo(elt, frame) {
switch(ecl_t_of(elt)) {
case t_symbol:
@ -1075,7 +1087,7 @@ nucl_compile_definition(void)
} end_loop_across_frame();
code[idx++] = OP_EXIT;
nucl_stack_clear();
word->bytecodes.code_size = size;
word->bytecodes.code_size = code_size;
word->bytecodes.code = ecl_cast_ptr(char*,code);
word->bytecodes.data = data;
word->bytecodes.entry = _nucl_word_dispatch;