rusefi
/
bldc
mirror of https://github.com/rusefi/bldc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Squashed 'lispBM/lispBM/' changes from 3bb13f0f..6deae379 

6deae379 Merge branch 'master' of github.com:svenssonjoel/lispBM
087437b4 update callcc to use lbm_memory for continuation creation rather than list

git-subtree-dir: lispBM/lispBM
git-subtree-split: 6deae3798fb770fdc971ce8d2f2cc32a3bc1b3dd
This commit is contained in:
Benjamin Vedder 2022-04-01 15:10:24 +02:00
parent 3ee22f5a3c
commit 219cd6a05f
2 changed files with 40 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
include/heap.h
View File

@ -788,6 +788,12 @@ static inline bool lbm_is_number(lbm_value x) {
(t == LBM_TYPE_DOUBLE)); (t == LBM_TYPE_DOUBLE));
} }
static inline bool lbm_is_array(lbm_value x) {
return (lbm_type_of(x) == LBM_TYPE_ARRAY &&
lbm_type_of(lbm_cdr(x)) == LBM_TYPE_SYMBOL &&
lbm_dec_sym(lbm_cdr(x)) == SYM_ARRAY_TYPE);
}
static inline bool lbm_is_char(lbm_value x) { static inline bool lbm_is_char(lbm_value x) {
lbm_uint t = lbm_type_of(x); lbm_uint t = lbm_type_of(x);
return (t == LBM_TYPE_CHAR); return (t == LBM_TYPE_CHAR);

45
src/eval_cps.c
View File

@ -1195,16 +1195,32 @@ static inline void eval_closure(eval_context_t *ctx) {
static inline void eval_callcc(eval_context_t *ctx) { static inline void eval_callcc(eval_context_t *ctx) {
lbm_value continuation = NIL; //lbm_value continuation = NIL;
for (int i = (int)ctx->K.sp; i > 0; i --) { lbm_value cont_array;
CONS_WITH_GC(continuation, ctx->K.data[i-1], continuation, continuation); #ifndef LBM64
if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp, LBM_TYPE_U32)) {
gc(NIL,NIL);
if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp, LBM_TYPE_U32)) {
error_ctx(lbm_enc_sym(SYM_MERROR));
return;
} }
}
#else
if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp, LBM_TYPE_U64)) {
gc(NIL,NIL);
if (!lbm_heap_allocate_array(&cont_array, ctx->K.sp, LBM_TYPE_U32)) {
error_ctx(lbm_enc_sym(SYM_MERROR));
return;
}
}
#endif
lbm_value acont = NIL; lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(cont_array);
CONS_WITH_GC(acont, continuation, acont, continuation); memcpy(arr->data, ctx->K.data, ctx->K.sp * sizeof(lbm_uint));
CONS_WITH_GC(acont, lbm_enc_sym(SYM_CONT), acont, acont);
lbm_value acont;
CONS_WITH_GC(acont, lbm_enc_sym(SYM_CONT), cont_array, cont_array);
/* Create an application */ /* Create an application */
lbm_value fun_arg = lbm_car(lbm_cdr(ctx->curr_exp)); lbm_value fun_arg = lbm_car(lbm_cdr(ctx->curr_exp));
@ -1572,13 +1588,20 @@ static inline void cont_application(eval_context_t *ctx) {
lbm_value fun = fun_args[0]; lbm_value fun = fun_args[0];
if (lbm_is_continuation(fun)) { if (lbm_is_continuation(fun)) {
lbm_value c = lbm_car(lbm_cdr(fun)); /* should be the continuation */ lbm_value c = lbm_cdr(fun); /* should be the continuation */
if (!lbm_is_array(c)) {
error_ctx(lbm_enc_sym(SYM_FATAL_ERROR));
return;
}
lbm_value arg = fun_args[1]; lbm_value arg = fun_args[1];
lbm_stack_clear(&ctx->K); lbm_stack_clear(&ctx->K);
while (lbm_type_of(c) == LBM_TYPE_CONS) {
lbm_push(&ctx->K, lbm_car(c)); lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(c);
c = lbm_cdr(c);
} ctx->K.sp = arr->size;
memcpy(ctx->K.data, arr->data, arr->size * sizeof(lbm_uint));
ctx->r = arg; ctx->r = arg;
ctx->app_cont = true; ctx->app_cont = true;
return; return;