Merge commit '857e9549f9d02d1832627403ac61f236dc87755e'

This commit is contained in:
Benjamin Vedder 2023-02-16 10:48:34 +01:00
commit a024c2c3cb
4 changed files with 1047 additions and 1426 deletions

View File

@ -28,68 +28,7 @@
#ifdef __cplusplus
extern "C" {
#endif
void fundamental_add(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_sub(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_mul(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_div(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_mod(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_eq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_not_eq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_numeq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_num_not_eq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_lt(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_gt(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_leq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_geq(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_not(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_gc(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_self(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_set_mailbox_size(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_cons(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_car(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_cdr(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_list(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_append(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_undefine(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_array_read(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_array_write(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_array_create(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_array_size(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_array_clear(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_symbol_to_string(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_string_to_symbol(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_symbol_to_uint(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_uint_to_symbol(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_set_car(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_set_cdr(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_set_ix(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_assoc(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_acons(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_set_assoc(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_cossa(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_ix(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_i(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_i32(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_u(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_u32(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_float(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_i64(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_u64(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_double(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_to_byte(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_shl(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_shr(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_bitwise_and(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_bitwise_or(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_bitwise_xor(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_bitwise_not(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_custom_destruct(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_type_of(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_list_length(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_range(lbm_value *args, lbm_uint nargs, eval_context_t *ctx);
void fundamental_reg_event_handler(lbm_value *args, lbm_uint argn, eval_context_t *ctx);
extern const fundamental_fun fundamental_table[];
bool struct_eq(lbm_value a, lbm_value b);
#ifdef __cplusplus
}

View File

@ -200,6 +200,9 @@
#define SYM_EXIT_ERROR 0x20B
#define SYM_MAP 0x20C
#define SYM_REVERSE 0x20D
#define APPLY_FUNS_END 0x20D
#define FUNDAMENTALS_START 0x20E
#define SYM_ADD 0x20E
#define SYM_SUB 0x20F
#define SYM_MUL 0x210
@ -260,8 +263,8 @@
#define SYM_LIST_LENGTH 0x247
#define SYM_RANGE 0x248
#define SYM_REG_EVENT_HANDLER 0x249
#define FUNDAMENTALS_END 0x249
#define APPLY_FUNS_END 0x249
#define SPECIAL_SYMBOLS_START 0

View File

@ -2017,66 +2017,6 @@ static const apply_fun fun_table[] =
apply_error,
apply_map,
apply_reverse,
fundamental_add,
fundamental_sub,
fundamental_mul,
fundamental_div,
fundamental_mod,
fundamental_eq,
fundamental_not_eq,
fundamental_numeq,
fundamental_num_not_eq,
fundamental_lt,
fundamental_gt,
fundamental_leq,
fundamental_geq,
fundamental_not,
fundamental_gc,
fundamental_self,
fundamental_set_mailbox_size,
fundamental_cons,
fundamental_car,
fundamental_cdr,
fundamental_list,
fundamental_append,
fundamental_undefine,
fundamental_array_read,
fundamental_array_write,
fundamental_array_create,
fundamental_array_size,
fundamental_array_clear,
fundamental_symbol_to_string,
fundamental_string_to_symbol,
fundamental_symbol_to_uint,
fundamental_uint_to_symbol,
fundamental_set_car,
fundamental_set_cdr,
fundamental_set_ix,
fundamental_assoc,
fundamental_acons,
fundamental_set_assoc,
fundamental_cossa,
fundamental_ix,
fundamental_to_i,
fundamental_to_i32,
fundamental_to_u,
fundamental_to_u32,
fundamental_to_float,
fundamental_to_i64,
fundamental_to_u64,
fundamental_to_double,
fundamental_to_byte,
fundamental_shl,
fundamental_shr,
fundamental_bitwise_and,
fundamental_bitwise_or,
fundamental_bitwise_xor,
fundamental_bitwise_not,
fundamental_custom_destruct,
fundamental_type_of,
fundamental_list_length,
fundamental_range,
fundamental_reg_event_handler
};
/***************************************************/
@ -2114,13 +2054,25 @@ static void application(eval_context_t *ctx, lbm_value *fun_args, lbm_uint arg_c
ctx->app_cont = true;
} else if (lbm_type_of(fun) == LBM_TYPE_SYMBOL) {
/* eval_cps specific operations */
lbm_uint sym_val = lbm_dec_sym(fun) - APPLY_FUNS_START;
lbm_uint fun_val = lbm_dec_sym(fun);
lbm_uint apply_val = fun_val - APPLY_FUNS_START;
lbm_uint fund_val = fun_val - FUNDAMENTALS_START;
if (sym_val <= (APPLY_FUNS_END - APPLY_FUNS_START)) {
fun_table[sym_val](&fun_args[1], arg_count, ctx);
if (apply_val <= (APPLY_FUNS_END - APPLY_FUNS_START)) {
fun_table[apply_val](&fun_args[1], arg_count, ctx);
} else if (fund_val <= (FUNDAMENTALS_END - FUNDAMENTALS_START)) {
lbm_value res;
WITH_GC(res, fundamental_table[fund_val](&fun_args[1], arg_count, ctx));
if (lbm_is_error(res)) {
error_ctx(res);
return;
}
lbm_stack_drop(&ctx->K, arg_count+1);
ctx->app_cont = true;
ctx->r = res;
} else {
// It may be an extension
extension_fptr f = lbm_get_extension(lbm_dec_sym(fun));
extension_fptr f = lbm_get_extension(fun_val);
if (f == NULL) {
error_ctx(ENC_SYM_EERROR);
return;

File diff suppressed because it is too large Load Diff