From fbe5dc9f215e7014aa8f9d325c1fba939816be03 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 19 Dec 2017 11:35:09 -0800 Subject: altos/scheme: apply also needs to not free value list on lambdas When apply is invoked on any function, the cons in the argument list cannot be immediately freed as they have been passed to the function. That applies to both built-ins as well as lambdas; this patch removes the special ao_scheme_skip_cons_free global and just marks the stack in both cases. Signed-off-by: Keith Packard --- src/scheme/ao_scheme_eval.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'src/scheme/ao_scheme_eval.c') diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c index 907ecf0b..9204ce1a 100644 --- a/src/scheme/ao_scheme_eval.c +++ b/src/scheme/ao_scheme_eval.c @@ -17,7 +17,6 @@ struct ao_scheme_stack *ao_scheme_stack; ao_poly ao_scheme_v; -uint8_t ao_scheme_skip_cons_free; ao_poly ao_scheme_set_cond(struct ao_scheme_cons *c) @@ -265,7 +264,7 @@ ao_scheme_eval_exec(void) DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n"); }); builtin = ao_scheme_poly_builtin(ao_scheme_v); - if (builtin && (builtin->args & AO_SCHEME_FUNC_FREE_ARGS) && !ao_scheme_stack_marked(ao_scheme_stack) && !ao_scheme_skip_cons_free) { + if (builtin && (builtin->args & AO_SCHEME_FUNC_FREE_ARGS) && !ao_scheme_stack_marked(ao_scheme_stack)) { struct ao_scheme_cons *cons = ao_scheme_poly_cons(ao_scheme_stack->values); ao_scheme_stack->values = AO_SCHEME_NIL; ao_scheme_cons_free(cons); @@ -294,7 +293,6 @@ ao_scheme_eval_exec(void) DBGI(".. frame "); DBG_POLY(ao_scheme_frame_poly(ao_scheme_frame_current)); DBG("\n"); break; } - ao_scheme_skip_cons_free = 0; return 1; } @@ -325,7 +323,7 @@ ao_scheme_eval_apply(void) ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->values)->car; DBGI("apply: "); DBG_POLY(ao_scheme_stack->values); DBG ("\n"); ao_scheme_stack->state = eval_exec; - ao_scheme_skip_cons_free = 1; + ao_scheme_stack_mark(ao_scheme_stack); return 1; } @@ -350,7 +348,7 @@ ao_scheme_eval_cond(void) ao_scheme_stack->state = eval_val; } else { ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->sexprs)->car; - if (!ao_scheme_v || ao_scheme_poly_type(ao_scheme_v) != AO_SCHEME_CONS) { + if (!ao_scheme_v || !AO_SCHEME_IS_CONS(ao_scheme_v)) { ao_scheme_error(AO_SCHEME_INVALID, "invalid cond clause"); return 0; } @@ -494,7 +492,7 @@ ao_scheme_eval_macro(void) if (ao_scheme_v == AO_SCHEME_NIL) ao_scheme_abort(); - if (ao_scheme_poly_type(ao_scheme_v) == AO_SCHEME_CONS) { + if (AO_SCHEME_IS_CONS(ao_scheme_v)) { *ao_scheme_poly_cons(ao_scheme_stack->sexprs) = *ao_scheme_poly_cons(ao_scheme_v); ao_scheme_v = ao_scheme_stack->sexprs; DBGI("sexprs rewritten to: "); DBG_POLY(ao_scheme_v); DBG("\n"); -- cgit v1.2.3 From fa6f4b331db9d37da6767005fd375b696485b46b Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 19 Dec 2017 11:43:23 -0800 Subject: altos/scheme: ao_scheme__cons -> ao_scheme_cons Fix the double underscore in this name. Ick. Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 2 +- src/scheme/ao_scheme_builtin.c | 10 +++++----- src/scheme/ao_scheme_cons.c | 2 +- src/scheme/ao_scheme_eval.c | 2 +- src/scheme/ao_scheme_read.c | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) (limited to 'src/scheme/ao_scheme_eval.c') diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index b37e9098..5b31c623 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -646,7 +646,7 @@ struct ao_scheme_cons * ao_scheme_cons_cdr(struct ao_scheme_cons *cons); ao_poly -ao_scheme__cons(ao_poly car, ao_poly cdr); +ao_scheme_cons(ao_poly car, ao_poly cdr); extern struct ao_scheme_cons *ao_scheme_cons_free_list; diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 221570c7..f4dff5bf 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -168,7 +168,7 @@ ao_scheme_do_cons(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; car = ao_scheme_arg(cons, 0); cdr = ao_scheme_arg(cons, 1); - return ao_scheme__cons(car, cdr); + return ao_scheme_cons(car, cdr); } ao_poly @@ -253,10 +253,10 @@ ao_scheme_do_setq(struct ao_scheme_cons *cons) return ao_scheme_error(AO_SCHEME_INVALID, "set! of non-atom %v", name); if (!ao_scheme_atom_ref(name, NULL)) return ao_scheme_error(AO_SCHEME_INVALID, "atom %v not defined", name); - return ao_scheme__cons(_ao_scheme_atom_set, - ao_scheme__cons(ao_scheme__cons(_ao_scheme_atom_quote, - ao_scheme__cons(name, AO_SCHEME_NIL)), - cons->cdr)); + return ao_scheme_cons(_ao_scheme_atom_set, + ao_scheme_cons(ao_scheme_cons(_ao_scheme_atom_quote, + ao_scheme_cons(name, AO_SCHEME_NIL)), + cons->cdr)); } ao_poly diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index 7976250b..d40c2826 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -119,7 +119,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) } ao_poly -ao_scheme__cons(ao_poly car, ao_poly cdr) +ao_scheme_cons(ao_poly car, ao_poly cdr) { return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr)); } diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c index 9204ce1a..edc16a73 100644 --- a/src/scheme/ao_scheme_eval.c +++ b/src/scheme/ao_scheme_eval.c @@ -206,7 +206,7 @@ ao_scheme_eval_formal(void) } /* Append formal to list of values */ - formal = ao_scheme__cons(ao_scheme_v, AO_SCHEME_NIL); + formal = ao_scheme_cons(ao_scheme_v, AO_SCHEME_NIL); if (!formal) return 0; diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c index 721211bc..e93466fc 100644 --- a/src/scheme/ao_scheme_read.c +++ b/src/scheme/ao_scheme_read.c @@ -510,7 +510,7 @@ push_read_stack(int read_state) RDBG_IN(); if (ao_scheme_read_list) { ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons), - ao_scheme__cons(ao_scheme_int_poly(read_state), + ao_scheme_cons(ao_scheme_int_poly(read_state), ao_scheme_cons_poly(ao_scheme_read_stack))); if (!ao_scheme_read_stack) return 0; -- cgit v1.2.3 From 34f998d147d08e966daad1ab76c40906018d3d8d Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 19 Dec 2017 11:51:33 -0800 Subject: altos/scheme: AO_SCHEME_IS_CONS -> ao_scheme_is_cons This inline was already defined; just use it. Also, switch some places to use ao_scheme_is_pair instead as appropriate. Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 2 -- src/scheme/ao_scheme_builtin.c | 4 ++-- src/scheme/ao_scheme_cons.c | 10 +++++----- src/scheme/ao_scheme_eval.c | 4 ++-- src/scheme/ao_scheme_make_const.c | 2 +- 5 files changed, 10 insertions(+), 12 deletions(-) (limited to 'src/scheme/ao_scheme_eval.c') diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 5b31c623..b8e683fb 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -157,8 +157,6 @@ ao_scheme_is_const(ao_poly poly) { #define AO_SCHEME_IS_CONST(a) (ao_scheme_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_const + AO_SCHEME_POOL_CONST) #define AO_SCHEME_IS_POOL(a) (ao_scheme_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_pool + AO_SCHEME_POOL) -#define AO_SCHEME_IS_INT(p) (ao_scheme_poly_base_type(p) == AO_SCHEME_INT) -#define AO_SCHEME_IS_CONS(p) (ao_scheme_poly_base_type(p) == AO_SCHEME_CONS) void * ao_scheme_ref(ao_poly poly); diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index f4dff5bf..84382434 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -856,7 +856,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; v = ao_scheme_arg(cons, 0); - if (v != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(v)) + if (ao_scheme_is_pair(v)) return _ao_scheme_bool_true; return _ao_scheme_bool_false; } @@ -947,7 +947,7 @@ ao_scheme_do_listp(struct ao_scheme_cons *cons) for (;;) { if (v == AO_SCHEME_NIL) return _ao_scheme_bool_true; - if (!AO_SCHEME_IS_CONS(v)) + if (!ao_scheme_is_cons(v)) return _ao_scheme_bool_false; v = ao_scheme_poly_cons(v)->cdr; } diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index d40c2826..1a2de823 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -24,7 +24,7 @@ static void cons_mark(void *addr) ao_scheme_poly_mark(cons->car, 1); if (!cdr) break; - if (!AO_SCHEME_IS_CONS(cdr)) { + if (!ao_scheme_is_cons(cdr)) { ao_scheme_poly_mark(cdr, 0); break; } @@ -58,7 +58,7 @@ static void cons_move(void *addr) cdr = cons->cdr; if (!cdr) break; - if (!AO_SCHEME_IS_CONS(cdr)) { + if (!ao_scheme_is_cons(cdr)) { (void) ao_scheme_poly_move(&cons->cdr, 0); break; } @@ -111,7 +111,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) ao_poly cdr = cons->cdr; if (cdr == AO_SCHEME_NIL) return NULL; - if (!AO_SCHEME_IS_CONS(cdr)) { + if (!ao_scheme_is_cons(cdr)) { (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr); return NULL; } @@ -151,7 +151,7 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons) tail->cdr = ao_scheme_cons_poly(new); tail = new; cdr = cons->cdr; - if (!AO_SCHEME_IS_CONS(cdr)) { + if (!ao_scheme_is_cons(cdr)) { tail->cdr = cdr; break; } @@ -203,7 +203,7 @@ ao_scheme_cons_write(ao_poly c, bool write) written++; cdr = cons->cdr; - if (!AO_SCHEME_IS_CONS(cdr)) { + if (!ao_scheme_is_cons(cdr)) { printf(" . "); ao_scheme_poly_write(cdr, write); break; diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c index edc16a73..91f6a84f 100644 --- a/src/scheme/ao_scheme_eval.c +++ b/src/scheme/ao_scheme_eval.c @@ -348,7 +348,7 @@ ao_scheme_eval_cond(void) ao_scheme_stack->state = eval_val; } else { ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->sexprs)->car; - if (!ao_scheme_v || !AO_SCHEME_IS_CONS(ao_scheme_v)) { + if (!ao_scheme_is_pair(ao_scheme_v)) { ao_scheme_error(AO_SCHEME_INVALID, "invalid cond clause"); return 0; } @@ -492,7 +492,7 @@ ao_scheme_eval_macro(void) if (ao_scheme_v == AO_SCHEME_NIL) ao_scheme_abort(); - if (AO_SCHEME_IS_CONS(ao_scheme_v)) { + if (ao_scheme_is_cons(ao_scheme_v)) { *ao_scheme_poly_cons(ao_scheme_stack->sexprs) = *ao_scheme_poly_cons(ao_scheme_v); ao_scheme_v = ao_scheme_stack->sexprs; DBGI("sexprs rewritten to: "); DBG_POLY(ao_scheme_v); DBG("\n"); diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c index 79ba1bf1..e34792c4 100644 --- a/src/scheme/ao_scheme_make_const.c +++ b/src/scheme/ao_scheme_make_const.c @@ -220,7 +220,7 @@ ao_has_macro(ao_poly p) list = cons->cdr; p = AO_SCHEME_NIL; - while (list != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(list)) { + while (ao_scheme_is_pair(list)) { cons = ao_scheme_poly_cons(list); m = ao_has_macro(cons->car); if (m) { -- cgit v1.2.3