From 5557f6b87a9b8bc9716de8191f2062a772a6ae6c Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Mon, 14 Nov 2016 21:25:38 -0800 Subject: [PATCH] altos/lisp: Cache freed cons and stack items Track freed cons cells and stack items from the eval process where possible so that they can be re-used without needing to collect. This dramatically reduces the number of collect calls. Signed-off-by: Keith Packard --- src/lisp/ao_lisp.h | 17 +++++++++++ src/lisp/ao_lisp_cons.c | 32 ++++++++++++++++----- src/lisp/ao_lisp_eval.c | 33 +++++++++++++++++---- src/lisp/ao_lisp_lambda.c | 1 + src/lisp/ao_lisp_make_const.c | 54 +++++++++++++++++------------------ src/lisp/ao_lisp_mem.c | 41 ++++++++++++++++++++------ src/lisp/ao_lisp_save.c | 2 +- 7 files changed, 130 insertions(+), 50 deletions(-) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index e90d791a..efd13cf5 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -206,6 +206,7 @@ ao_lisp_stack_poly(struct ao_lisp_stack *stack) } extern struct ao_lisp_stack *ao_lisp_stack; +extern struct ao_lisp_stack *ao_lisp_stack_free_list; extern ao_poly ao_lisp_v; #define AO_LISP_FUNC_LAMBDA 0 @@ -213,6 +214,14 @@ extern ao_poly ao_lisp_v; #define AO_LISP_FUNC_MACRO 2 #define AO_LISP_FUNC_LEXPR 3 +#define AO_LISP_FUNC_FREE_ARGS 0x80 +#define AO_LISP_FUNC_MASK 0x7f + +#define AO_LISP_FUNC_F_LAMBDA (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LAMBDA) +#define AO_LISP_FUNC_F_NLAMBDA (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_NLAMBDA) +#define AO_LISP_FUNC_F_MACRO (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_MACRO) +#define AO_LISP_FUNC_F_LEXPR (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LEXPR) + struct ao_lisp_builtin { uint8_t type; uint8_t args; @@ -390,6 +399,9 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b) } /* memory functions */ + +extern int ao_lisp_collects; + /* returns 1 if the object was already marked */ int ao_lisp_mark(const struct ao_lisp_type *type, void *addr); @@ -439,6 +451,11 @@ extern const struct ao_lisp_type ao_lisp_cons_type; struct ao_lisp_cons * ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr); +extern struct ao_lisp_cons *ao_lisp_cons_free_list; + +void +ao_lisp_cons_free(struct ao_lisp_cons *cons); + void ao_lisp_cons_print(ao_poly); diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c index 311d63ab..d2b60c9a 100644 --- a/src/lisp/ao_lisp_cons.c +++ b/src/lisp/ao_lisp_cons.c @@ -69,23 +69,41 @@ const struct ao_lisp_type ao_lisp_cons_type = { .name = "cons", }; +struct ao_lisp_cons *ao_lisp_cons_free_list; + struct ao_lisp_cons * ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr) { struct ao_lisp_cons *cons; - ao_lisp_poly_stash(0, car); - ao_lisp_cons_stash(0, cdr); - cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons)); - car = ao_lisp_poly_fetch(0); - cdr = ao_lisp_cons_fetch(0); - if (!cons) - return NULL; + if (ao_lisp_cons_free_list) { + cons = ao_lisp_cons_free_list; + ao_lisp_cons_free_list = ao_lisp_poly_cons(cons->cdr); + } else { + ao_lisp_poly_stash(0, car); + ao_lisp_cons_stash(0, cdr); + cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons)); + car = ao_lisp_poly_fetch(0); + cdr = ao_lisp_cons_fetch(0); + if (!cons) + return NULL; + } cons->car = car; cons->cdr = ao_lisp_cons_poly(cdr); return cons; } +void +ao_lisp_cons_free(struct ao_lisp_cons *cons) +{ + while (cons) { + ao_poly cdr = cons->cdr; + cons->cdr = ao_lisp_cons_poly(ao_lisp_cons_free_list); + ao_lisp_cons_free_list = cons; + cons = ao_lisp_poly_cons(cdr); + } +} + void ao_lisp_cons_print(ao_poly c) { diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 04d0e70a..5cc1b75a 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -76,6 +76,8 @@ const struct ao_lisp_type ao_lisp_stack_type = { struct ao_lisp_stack *ao_lisp_stack; ao_poly ao_lisp_v; +struct ao_lisp_stack *ao_lisp_stack_free_list; + ao_poly ao_lisp_set_cond(struct ao_lisp_cons *c) { @@ -97,9 +99,15 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack) static int ao_lisp_stack_push(void) { - struct ao_lisp_stack *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack)); - if (!stack) - return 0; + struct ao_lisp_stack *stack; + if (ao_lisp_stack_free_list) { + stack = ao_lisp_stack_free_list; + ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev); + } else { + stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack)); + if (!stack) + return 0; + } stack->prev = ao_lisp_stack_poly(ao_lisp_stack); stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); stack->list = AO_LISP_NIL; @@ -114,9 +122,15 @@ ao_lisp_stack_push(void) static void ao_lisp_stack_pop(void) { + ao_poly prev; + if (!ao_lisp_stack) return; - ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev); + prev = ao_lisp_stack->prev; + ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list); + ao_lisp_stack_free_list = ao_lisp_stack; + + ao_lisp_stack = ao_lisp_poly_stack(prev); if (ao_lisp_stack) ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame); else @@ -141,7 +155,7 @@ func_type(ao_poly func) return ao_lisp_error(AO_LISP_INVALID, "func is nil"); switch (ao_lisp_poly_type(func)) { case AO_LISP_BUILTIN: - return ao_lisp_poly_builtin(func)->args; + return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK; case AO_LISP_LAMBDA: return ao_lisp_poly_lambda(func)->args; default: @@ -359,12 +373,15 @@ static int ao_lisp_eval_exec(void) { ao_poly v; + struct ao_lisp_builtin *builtin; + DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n"); ao_lisp_stack->sexprs = AO_LISP_NIL; switch (ao_lisp_poly_type(ao_lisp_v)) { case AO_LISP_BUILTIN: ao_lisp_stack->state = eval_val; - v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) ( + builtin = ao_lisp_poly_builtin(ao_lisp_v); + v = ao_lisp_func(builtin) ( ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr)); DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) { struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values); @@ -372,6 +389,10 @@ ao_lisp_eval_exec(void) ao_poly val = ao_lisp_arg(cons, 2); DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n"); }); + builtin = ao_lisp_poly_builtin(ao_lisp_v); + if (builtin->args & AO_LISP_FUNC_FREE_ARGS) + ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values)); + ao_lisp_v = v; DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n"); DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n"); diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index 6020a8b8..0dd8c698 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -168,6 +168,7 @@ ao_lisp_lambda_eval(void) args = ao_lisp_poly_cons(args->cdr); vals = ao_lisp_poly_cons(vals->cdr); } + ao_lisp_cons_free(cons); break; } case AO_LISP_FUNC_LEXPR: diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 6a29f402..178b041e 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -33,42 +33,42 @@ struct builtin_func { }; struct builtin_func funcs[] = { - "eval", AO_LISP_FUNC_LAMBDA, builtin_eval, - "read", AO_LISP_FUNC_LAMBDA, builtin_read, + "eval", AO_LISP_FUNC_F_LAMBDA, builtin_eval, + "read", AO_LISP_FUNC_F_LAMBDA, builtin_read, "lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda, "lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr, "nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda, "macro", AO_LISP_FUNC_NLAMBDA, builtin_macro, - "car", AO_LISP_FUNC_LAMBDA, builtin_car, - "cdr", AO_LISP_FUNC_LAMBDA, builtin_cdr, - "cons", AO_LISP_FUNC_LAMBDA, builtin_cons, - "last", AO_LISP_FUNC_LAMBDA, builtin_last, - "length", AO_LISP_FUNC_LAMBDA, builtin_length, + "car", AO_LISP_FUNC_F_LAMBDA, builtin_car, + "cdr", AO_LISP_FUNC_F_LAMBDA, builtin_cdr, + "cons", AO_LISP_FUNC_F_LAMBDA, builtin_cons, + "last", AO_LISP_FUNC_F_LAMBDA, builtin_last, + "length", AO_LISP_FUNC_F_LAMBDA, builtin_length, "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, - "set", AO_LISP_FUNC_LAMBDA, builtin_set, + "set", AO_LISP_FUNC_F_LAMBDA, builtin_set, "setq", AO_LISP_FUNC_MACRO, builtin_setq, "cond", AO_LISP_FUNC_NLAMBDA, builtin_cond, "progn", AO_LISP_FUNC_NLAMBDA, builtin_progn, "while", AO_LISP_FUNC_NLAMBDA, builtin_while, - "print", AO_LISP_FUNC_LEXPR, builtin_print, - "patom", AO_LISP_FUNC_LEXPR, builtin_patom, - "+", AO_LISP_FUNC_LEXPR, builtin_plus, - "-", AO_LISP_FUNC_LEXPR, builtin_minus, - "*", AO_LISP_FUNC_LEXPR, builtin_times, - "/", AO_LISP_FUNC_LEXPR, builtin_divide, - "%", AO_LISP_FUNC_LEXPR, builtin_mod, - "=", AO_LISP_FUNC_LEXPR, builtin_equal, - "<", AO_LISP_FUNC_LEXPR, builtin_less, - ">", AO_LISP_FUNC_LEXPR, builtin_greater, - "<=", AO_LISP_FUNC_LEXPR, builtin_less_equal, - ">=", AO_LISP_FUNC_LEXPR, builtin_greater_equal, - "pack", AO_LISP_FUNC_LAMBDA, builtin_pack, - "unpack", AO_LISP_FUNC_LAMBDA, builtin_unpack, - "flush", AO_LISP_FUNC_LAMBDA, builtin_flush, - "delay", AO_LISP_FUNC_LAMBDA, builtin_delay, - "led", AO_LISP_FUNC_LEXPR, builtin_led, - "save", AO_LISP_FUNC_LAMBDA, builtin_save, - "restore", AO_LISP_FUNC_LAMBDA, builtin_restore, + "print", AO_LISP_FUNC_F_LEXPR, builtin_print, + "patom", AO_LISP_FUNC_F_LEXPR, builtin_patom, + "+", AO_LISP_FUNC_F_LEXPR, builtin_plus, + "-", AO_LISP_FUNC_F_LEXPR, builtin_minus, + "*", AO_LISP_FUNC_F_LEXPR, builtin_times, + "/", AO_LISP_FUNC_F_LEXPR, builtin_divide, + "%", AO_LISP_FUNC_F_LEXPR, builtin_mod, + "=", AO_LISP_FUNC_F_LEXPR, builtin_equal, + "<", AO_LISP_FUNC_F_LEXPR, builtin_less, + ">", AO_LISP_FUNC_F_LEXPR, builtin_greater, + "<=", AO_LISP_FUNC_F_LEXPR, builtin_less_equal, + ">=", AO_LISP_FUNC_F_LEXPR, builtin_greater_equal, + "pack", AO_LISP_FUNC_F_LAMBDA, builtin_pack, + "unpack", AO_LISP_FUNC_F_LAMBDA, builtin_unpack, + "flush", AO_LISP_FUNC_F_LAMBDA, builtin_flush, + "delay", AO_LISP_FUNC_F_LAMBDA, builtin_delay, + "led", AO_LISP_FUNC_F_LEXPR, builtin_led, + "save", AO_LISP_FUNC_F_LAMBDA, builtin_save, + "restore", AO_LISP_FUNC_F_LAMBDA, builtin_restore, }; #define N_FUNC (sizeof funcs / sizeof funcs[0]) diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c index 08b5bac0..e7ece960 100644 --- a/src/lisp/ao_lisp_mem.c +++ b/src/lisp/ao_lisp_mem.c @@ -43,7 +43,6 @@ uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4 #if DBG_MEM int dbg_move_depth; int dbg_mem = DBG_MEM_START; -int dbg_collects = 0; int dbg_validate = 0; struct ao_lisp_record { @@ -212,6 +211,13 @@ static const struct ao_lisp_root ao_lisp_root[] = { #define AO_LISP_ROOT (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0])) +static const void ** const ao_lisp_cache[] = { + (const void **) &ao_lisp_cons_free_list, + (const void **) &ao_lisp_stack_free_list, +}; + +#define AO_LISP_CACHE (sizeof (ao_lisp_cache) / sizeof (ao_lisp_cache[0])) + #define AO_LISP_BUSY_SIZE ((AO_LISP_POOL + 31) / 32) static uint8_t ao_lisp_busy[AO_LISP_BUSY_SIZE]; @@ -229,14 +235,16 @@ struct ao_lisp_chunk { }; }; -#define AO_LISP_NCHUNK 32 +#define AO_LISP_NCHUNK 64 static struct ao_lisp_chunk ao_lisp_chunk[AO_LISP_NCHUNK]; /* Offset of an address within the pool. */ static inline uint16_t pool_offset(void *addr) { +#if DBG_MEM if (!AO_LISP_IS_POOL(addr)) ao_lisp_abort(); +#endif return ((uint8_t *) addr) - ao_lisp_pool; } @@ -246,8 +254,10 @@ static inline uint16_t pool_offset(void *addr) { * These are used in the chunk code. */ static inline ao_poly pool_poly(void *addr) { +#if DBG_MEM if (!AO_LISP_IS_POOL(addr)) ao_lisp_abort(); +#endif return ((uint8_t *) addr) - AO_LISP_POOL_BASE; } @@ -306,8 +316,10 @@ note_chunk(uint16_t addr, uint16_t size) for (i = 0; i < AO_LISP_NCHUNK; i++) { if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) { +#if DBG_MEM if (ao_lisp_chunk[i].size != size) ao_lisp_abort(); +#endif return; } if (ao_lisp_chunk[i].old_addr > addr) { @@ -339,7 +351,7 @@ walk(int (*visit_addr)(const struct ao_lisp_type *type, void **addr), memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy)); memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note)); ao_lisp_cons_noted = 0; - for (i = 0; i < AO_LISP_ROOT; i++) { + for (i = 0; i < (int) AO_LISP_ROOT; i++) { if (ao_lisp_root[i].type) { void **a = ao_lisp_root[i].addr, *v; if (a && (v = *a)) { @@ -416,6 +428,8 @@ ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons) return ao_lisp_poly_mark(*p, do_note_cons); } +int ao_lisp_collects; + void ao_lisp_collect(void) { @@ -427,10 +441,15 @@ ao_lisp_collect(void) int moved; struct ao_lisp_record *mark_record = NULL, *move_record = NULL; - ++dbg_collects; - MDBG_MOVE("collect %d\n", dbg_collects); + MDBG_MOVE("collect %d\n", ao_lisp_collects); marked = moved = 0; #endif + + ++ao_lisp_collects; + + /* Clear references to all caches */ + for (i = 0; i < (int) AO_LISP_CACHE; i++) + *ao_lisp_cache[i] = NULL; chunk_low = 0; top = 0; for (;;) { @@ -462,8 +481,10 @@ ao_lisp_collect(void) if (ao_lisp_chunk[i].old_addr > top) break; +#if DBG_MEM if (ao_lisp_chunk[i].old_addr != top) ao_lisp_abort(); +#endif top += size; MDBG_MOVE("chunk %d %d not moving\n", @@ -585,8 +606,10 @@ ao_lisp_poly_mark(ao_poly p, uint8_t do_note_cons) if (type == AO_LISP_OTHER) { type = ao_lisp_other_type(ao_lisp_poly_other(p)); +#if DBG_MEM if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type) ao_lisp_abort(); +#endif } lisp_type = ao_lisp_types[ao_lisp_poly_type(p)]; @@ -622,6 +645,8 @@ ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref) if (!AO_LISP_IS_POOL(addr)) return 1; + (void) type; + MDBG_MOVE("move memory %d\n", MDBG_OFFSET(addr)); addr = move_map(addr); if (addr != *ref) { @@ -682,8 +707,10 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons) if (type == AO_LISP_OTHER) { type = ao_lisp_other_type(move_map(ao_lisp_poly_other(p))); +#if DBG_MEM if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type) ao_lisp_abort(); +#endif } lisp_type = ao_lisp_types[type]; @@ -795,8 +822,6 @@ ao_lisp_alloc(int size) void ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons) { - if (save_cons[id] != NULL) - ao_lisp_abort(); save_cons[id] = cons; } @@ -811,8 +836,6 @@ ao_lisp_cons_fetch(int id) void ao_lisp_string_stash(int id, char *string) { - if (save_cons[id] != NULL) - ao_lisp_abort(); save_string[id] = string; } diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c index 030846b7..d5f28e7d 100644 --- a/src/lisp/ao_lisp_save.c +++ b/src/lisp/ao_lisp_save.c @@ -27,7 +27,7 @@ ao_lisp_save(struct ao_lisp_cons *cons) os->atoms = ao_lisp_atom_poly(ao_lisp_atoms); os->globals = ao_lisp_frame_poly(ao_lisp_frame_global); os->const_checksum = ao_lisp_const_checksum; - os->const_checksum_inv = ~ao_lisp_const_checksum; + os->const_checksum_inv = (uint16_t) ~ao_lisp_const_checksum; if (ao_lisp_os_save()) return _ao_lisp_atom_t; -- 2.30.2