From ed1f7b79abc7400a54b35fbf62c9db6855f9129a Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 19 Dec 2017 12:39:20 -0800 Subject: [PATCH] altos/scheme: Replace per-type indexed stash with poly stash heap Instead of having a random set of stash arrays with explicit indices used by callers, just have a general heap. Less error prone, and less code. Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 72 +++++++++++++++++++------- src/scheme/ao_scheme_atom.c | 4 +- src/scheme/ao_scheme_builtin.c | 16 +++--- src/scheme/ao_scheme_cons.c | 20 ++++---- src/scheme/ao_scheme_frame.c | 16 +++--- src/scheme/ao_scheme_lambda.c | 8 +-- src/scheme/ao_scheme_mem.c | 93 ++++++++-------------------------- src/scheme/ao_scheme_stack.c | 12 ++--- src/scheme/ao_scheme_string.c | 32 ++++++------ src/scheme/ao_scheme_vector.c | 8 +-- 10 files changed, 132 insertions(+), 149 deletions(-) diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 5cae0bda..d4c9bc05 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -595,38 +595,72 @@ ao_scheme_cons_check(struct ao_scheme_cons *cons); #endif void -ao_scheme_cons_stash(int id, struct ao_scheme_cons *cons); +ao_scheme_poly_stash(ao_poly poly); -struct ao_scheme_cons * -ao_scheme_cons_fetch(int id); +ao_poly +ao_scheme_poly_fetch(void); -void -ao_scheme_poly_stash(int id, ao_poly poly); +static inline void +ao_scheme_cons_stash(struct ao_scheme_cons *cons) { + ao_scheme_poly_stash(ao_scheme_cons_poly(cons)); +} -ao_poly -ao_scheme_poly_fetch(int id); +static inline struct ao_scheme_cons * +ao_scheme_cons_fetch(void) { + return ao_scheme_poly_cons(ao_scheme_poly_fetch()); +} -void -ao_scheme_string_stash(int id, struct ao_scheme_string *string); +static inline void +ao_scheme_atom_stash(struct ao_scheme_atom *atom) { + ao_scheme_poly_stash(ao_scheme_atom_poly(atom)); +} -struct ao_scheme_string * -ao_scheme_string_fetch(int id); +static inline struct ao_scheme_atom * +ao_scheme_atom_fetch(void) { + return ao_scheme_poly_atom(ao_scheme_poly_fetch()); +} + +static inline void +ao_scheme_string_stash(struct ao_scheme_string *string) { + ao_scheme_poly_stash(ao_scheme_string_poly(string)); +} +static inline struct ao_scheme_string * +ao_scheme_string_fetch(void) { + return ao_scheme_poly_string(ao_scheme_poly_fetch()); +} + +#ifdef AO_SCHEME_FEATURE_VECTOR static inline void -ao_scheme_stack_stash(int id, struct ao_scheme_stack *stack) { - ao_scheme_poly_stash(id, ao_scheme_stack_poly(stack)); +ao_scheme_vector_stash(struct ao_scheme_vector *vector) { + ao_scheme_poly_stash(ao_scheme_vector_poly(vector)); +} + +static inline struct ao_scheme_vector * +ao_scheme_vector_fetch(void) { + return ao_scheme_poly_vector(ao_scheme_poly_fetch()); +} +#endif + +static inline void +ao_scheme_stack_stash(struct ao_scheme_stack *stack) { + ao_scheme_poly_stash(ao_scheme_stack_poly(stack)); } static inline struct ao_scheme_stack * -ao_scheme_stack_fetch(int id) { - return ao_scheme_poly_stack(ao_scheme_poly_fetch(id)); +ao_scheme_stack_fetch(void) { + return ao_scheme_poly_stack(ao_scheme_poly_fetch()); } -void -ao_scheme_frame_stash(int id, struct ao_scheme_frame *frame); +static inline void +ao_scheme_frame_stash(struct ao_scheme_frame *frame) { + ao_scheme_poly_stash(ao_scheme_frame_poly(frame)); +} -struct ao_scheme_frame * -ao_scheme_frame_fetch(int id); +static inline struct ao_scheme_frame * +ao_scheme_frame_fetch(void) { + return ao_scheme_poly_frame(ao_scheme_poly_fetch()); +} /* bool */ diff --git a/src/scheme/ao_scheme_atom.c b/src/scheme/ao_scheme_atom.c index 8989cefd..c72a2b27 100644 --- a/src/scheme/ao_scheme_atom.c +++ b/src/scheme/ao_scheme_atom.c @@ -107,9 +107,9 @@ ao_scheme_string_to_atom(struct ao_scheme_string *string) if (atom) return atom; - ao_scheme_string_stash(0, string); + ao_scheme_string_stash(string); atom = ao_scheme_alloc(name_size(string->val)); - string = ao_scheme_string_fetch(0); + string = ao_scheme_string_fetch(); ao_scheme_atom_init(atom, string->val); return atom; } diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 84382434..81fd9010 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -321,7 +321,7 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) if (cons == orig_cons) { ret = car; - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); if (cons->cdr == AO_SCHEME_NIL) { switch (op) { case builtin_minus: @@ -349,7 +349,7 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) break; } } - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) { int32_t r = ao_scheme_poly_integer(ret, NULL); int32_t c = ao_scheme_poly_integer(car, NULL); @@ -413,9 +413,9 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) default: break; } - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_integer_poly(r); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); #ifdef AO_SCHEME_FEATURE_FLOAT } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) { float r, c; @@ -442,16 +442,16 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) default: break; } - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_float_get(r); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); #endif } else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) { - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret), ao_scheme_poly_string(car))); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); if (!ret) return ret; } diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index 1a2de823..a9ff5acd 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -92,11 +92,11 @@ ao_scheme_cons_cons(ao_poly car, ao_poly cdr) cons = ao_scheme_cons_free_list; ao_scheme_cons_free_list = ao_scheme_poly_cons(cons->cdr); } else { - ao_scheme_poly_stash(0, car); - ao_scheme_poly_stash(1, cdr); + ao_scheme_poly_stash(car); + ao_scheme_poly_stash(cdr); cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); - cdr = ao_scheme_poly_fetch(1); - car = ao_scheme_poly_fetch(0); + cdr = ao_scheme_poly_fetch(); + car = ao_scheme_poly_fetch(); if (!cons) return NULL; } @@ -134,13 +134,13 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons) struct ao_scheme_cons *new; ao_poly cdr; - ao_scheme_cons_stash(0, cons); - ao_scheme_cons_stash(1, head); - ao_scheme_poly_stash(0, ao_scheme_cons_poly(tail)); + ao_scheme_cons_stash(cons); + ao_scheme_cons_stash(head); + ao_scheme_cons_stash(tail); new = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); - cons = ao_scheme_cons_fetch(0); - head = ao_scheme_cons_fetch(1); - tail = ao_scheme_poly_cons(ao_scheme_poly_fetch(0)); + tail = ao_scheme_cons_fetch(); + head = ao_scheme_cons_fetch(); + cons = ao_scheme_cons_fetch(); if (!new) return AO_SCHEME_NIL; new->car = cons->car; diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c index a7e5153f..16da62fb 100644 --- a/src/scheme/ao_scheme_frame.c +++ b/src/scheme/ao_scheme_frame.c @@ -250,9 +250,9 @@ ao_scheme_frame_new(int num) frame->num = 0; frame->prev = AO_SCHEME_NIL; frame->vals = AO_SCHEME_NIL; - ao_scheme_frame_stash(0, frame); + ao_scheme_frame_stash(frame); vals = ao_scheme_frame_vals_new(num); - frame = ao_scheme_frame_fetch(0); + frame = ao_scheme_frame_fetch(); if (!vals) return NULL; frame->vals = ao_scheme_frame_vals_poly(vals); @@ -296,9 +296,9 @@ ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num) if (new_num == frame->num) return frame; - ao_scheme_frame_stash(0, frame); + ao_scheme_frame_stash(frame); new_vals = ao_scheme_frame_vals_new(new_num); - frame = ao_scheme_frame_fetch(0); + frame = ao_scheme_frame_fetch(); if (!new_vals) return NULL; vals = ao_scheme_poly_frame_vals(frame->vals); @@ -331,11 +331,11 @@ ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val) if (!ref) { int f = frame->num; - ao_scheme_poly_stash(0, atom); - ao_scheme_poly_stash(1, val); + ao_scheme_poly_stash(atom); + ao_scheme_poly_stash(val); frame = ao_scheme_frame_realloc(frame, f + 1); - val = ao_scheme_poly_fetch(1); - atom = ao_scheme_poly_fetch(0); + val = ao_scheme_poly_fetch(); + atom = ao_scheme_poly_fetch(); if (!frame) return AO_SCHEME_NIL; ao_scheme_frame_bind(frame, frame->num - 1, atom, val); diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c index e8ce0710..e818d7b0 100644 --- a/src/scheme/ao_scheme_lambda.c +++ b/src/scheme/ao_scheme_lambda.c @@ -89,9 +89,9 @@ ao_scheme_lambda_alloc(struct ao_scheme_cons *code, int args) } } - ao_scheme_cons_stash(0, code); + ao_scheme_cons_stash(code); lambda = ao_scheme_alloc(sizeof (struct ao_scheme_lambda)); - code = ao_scheme_cons_fetch(0); + code = ao_scheme_cons_fetch(); if (!lambda) return AO_SCHEME_NIL; @@ -160,9 +160,9 @@ ao_scheme_lambda_eval(void) return ao_scheme_error(AO_SCHEME_INVALID, "need at least %d args, got %d", args_wanted, args_provided); } - ao_scheme_poly_stash(1, varargs); + ao_scheme_poly_stash(varargs); next_frame = ao_scheme_frame_new(args_wanted + (varargs != AO_SCHEME_NIL)); - varargs = ao_scheme_poly_fetch(1); + varargs = ao_scheme_poly_fetch(); if (!next_frame) return AO_SCHEME_NIL; diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c index 55872b62..c9215072 100644 --- a/src/scheme/ao_scheme_mem.c +++ b/src/scheme/ao_scheme_mem.c @@ -184,43 +184,34 @@ struct ao_scheme_root { void **addr; }; -static struct ao_scheme_cons *save_cons[2]; -static struct ao_scheme_string *save_string[2]; -static struct ao_scheme_frame *save_frame[1]; -static ao_poly save_poly[3]; +#define AO_SCHEME_NUM_STASH 6 +static ao_poly stash_poly[AO_SCHEME_NUM_STASH]; +static int stash_poly_ptr; static const struct ao_scheme_root ao_scheme_root[] = { { - .type = &ao_scheme_cons_type, - .addr = (void **) &save_cons[0], - }, - { - .type = &ao_scheme_cons_type, - .addr = (void **) &save_cons[1], - }, - { - .type = &ao_scheme_string_type, - .addr = (void **) &save_string[0], + .type = NULL, + .addr = (void **) (void *) &stash_poly[0] }, { - .type = &ao_scheme_string_type, - .addr = (void **) &save_string[1], + .type = NULL, + .addr = (void **) (void *) &stash_poly[1] }, { - .type = &ao_scheme_frame_type, - .addr = (void **) &save_frame[0], + .type = NULL, + .addr = (void **) (void *) &stash_poly[2] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[0] + .addr = (void **) (void *) &stash_poly[3] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[1] + .addr = (void **) (void *) &stash_poly[4] }, { .type = NULL, - .addr = (void **) (void *) &save_poly[2] + .addr = (void **) (void *) &stash_poly[5] }, { .type = &ao_scheme_atom_type, @@ -991,63 +982,21 @@ ao_scheme_alloc(int size) } void -ao_scheme_cons_stash(int id, struct ao_scheme_cons *cons) -{ - assert(save_cons[id] == 0); - save_cons[id] = cons; -} - -struct ao_scheme_cons * -ao_scheme_cons_fetch(int id) -{ - struct ao_scheme_cons *cons = save_cons[id]; - save_cons[id] = NULL; - return cons; -} - -void -ao_scheme_poly_stash(int id, ao_poly poly) +ao_scheme_poly_stash(ao_poly p) { - assert(save_poly[id] == AO_SCHEME_NIL); - save_poly[id] = poly; + assert(stash_poly_ptr < AO_SCHEME_NUM_STASH); + stash_poly[stash_poly_ptr++] = p; } ao_poly -ao_scheme_poly_fetch(int id) -{ - ao_poly poly = save_poly[id]; - save_poly[id] = AO_SCHEME_NIL; - return poly; -} - -void -ao_scheme_string_stash(int id, struct ao_scheme_string *string) +ao_scheme_poly_fetch(void) { - assert(save_string[id] == NULL); - save_string[id] = string; -} + ao_poly p; -struct ao_scheme_string * -ao_scheme_string_fetch(int id) -{ - struct ao_scheme_string *string = save_string[id]; - save_string[id] = NULL; - return string; -} - -void -ao_scheme_frame_stash(int id, struct ao_scheme_frame *frame) -{ - assert(save_frame[id] == NULL); - save_frame[id] = frame; -} - -struct ao_scheme_frame * -ao_scheme_frame_fetch(int id) -{ - struct ao_scheme_frame *frame = save_frame[id]; - save_frame[id] = NULL; - return frame; + assert (stash_poly_ptr > 0); + p = stash_poly[--stash_poly_ptr]; + stash_poly[stash_poly_ptr] = AO_SCHEME_NIL; + return p; } int diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c index e29e2b68..863df3ca 100644 --- a/src/scheme/ao_scheme_stack.c +++ b/src/scheme/ao_scheme_stack.c @@ -199,13 +199,13 @@ ao_scheme_stack_copy(struct ao_scheme_stack *old) struct ao_scheme_stack *n, *prev = NULL; while (old) { - ao_scheme_stack_stash(0, old); - ao_scheme_stack_stash(1, new); - ao_scheme_stack_stash(2, prev); + ao_scheme_stack_stash(old); + ao_scheme_stack_stash(new); + ao_scheme_stack_stash(prev); n = ao_scheme_stack_new(); - prev = ao_scheme_stack_fetch(2); - new = ao_scheme_stack_fetch(1); - old = ao_scheme_stack_fetch(0); + prev = ao_scheme_stack_fetch(); + new = ao_scheme_stack_fetch(); + old = ao_scheme_stack_fetch(); if (!n) return NULL; diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index b00ef276..dfc74966 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -60,9 +60,9 @@ ao_scheme_string_copy(struct ao_scheme_string *a) int alen = strlen(a->val); struct ao_scheme_string *r; - ao_scheme_string_stash(0, a); + ao_scheme_string_stash(a); r = ao_scheme_string_alloc(alen); - a = ao_scheme_string_fetch(0); + a = ao_scheme_string_fetch(); if (!r) return NULL; strcpy(r->val, a->val); @@ -87,9 +87,9 @@ ao_scheme_atom_to_string(struct ao_scheme_atom *a) int alen = strlen(a->name); struct ao_scheme_string *r; - ao_scheme_poly_stash(0, ao_scheme_atom_poly(a)); + ao_scheme_atom_stash(a); r = ao_scheme_string_alloc(alen); - a = ao_scheme_poly_atom(ao_scheme_poly_fetch(0)); + a = ao_scheme_atom_fetch(); if (!r) return NULL; strcpy(r->val, a->name); @@ -103,11 +103,11 @@ ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b) int blen = strlen(b->val); struct ao_scheme_string *r; - ao_scheme_string_stash(0, a); - ao_scheme_string_stash(1, b); + ao_scheme_string_stash(a); + ao_scheme_string_stash(b); r = ao_scheme_string_alloc(alen + blen); - a = ao_scheme_string_fetch(0); - b = ao_scheme_string_fetch(1); + b = ao_scheme_string_fetch(); + a = ao_scheme_string_fetch(); if (!r) return NULL; strcpy(r->val, a->val); @@ -123,9 +123,9 @@ ao_scheme_string_pack(struct ao_scheme_cons *cons) int len; len = ao_scheme_cons_length(cons); - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); r = ao_scheme_string_alloc(len); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); if (!r) return AO_SCHEME_NIL; rval = r->val; @@ -151,13 +151,13 @@ ao_scheme_string_unpack(struct ao_scheme_string *a) for (i = 0; (c = a->val[i]); i++) { struct ao_scheme_cons *n; - ao_scheme_cons_stash(0, cons); - ao_scheme_cons_stash(1, tail); - ao_scheme_string_stash(0, a); + ao_scheme_cons_stash(cons); + ao_scheme_cons_stash(tail); + ao_scheme_string_stash(a); n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL); - a = ao_scheme_string_fetch(0); - cons = ao_scheme_cons_fetch(0); - tail = ao_scheme_cons_fetch(1); + a = ao_scheme_string_fetch(); + tail = ao_scheme_cons_fetch(); + cons = ao_scheme_cons_fetch(); if (!n) { cons = NULL; diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c index 419d6765..afdc89a8 100644 --- a/src/scheme/ao_scheme_vector.c +++ b/src/scheme/ao_scheme_vector.c @@ -145,9 +145,9 @@ ao_scheme_list_to_vector(struct ao_scheme_cons *cons) if (ao_scheme_exception) return NULL; - ao_scheme_cons_stash(0, cons); + ao_scheme_cons_stash(cons); vector = ao_scheme_vector_alloc(length, AO_SCHEME_NIL); - cons = ao_scheme_cons_fetch(0); + cons = ao_scheme_cons_fetch(); if (!vector) return NULL; i = 0; @@ -166,9 +166,9 @@ ao_scheme_vector_to_list(struct ao_scheme_vector *vector) struct ao_scheme_cons *cons = NULL; for (i = length; i-- > 0;) { - ao_scheme_poly_stash(2, ao_scheme_vector_poly(vector)); + ao_scheme_vector_stash(vector); cons = ao_scheme_cons_cons(vector->vals[i], ao_scheme_cons_poly(cons)); - vector = ao_scheme_poly_vector(ao_scheme_poly_fetch(2)); + vector = ao_scheme_vector_fetch(); if (!cons) return NULL; } -- 2.30.2