X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_frame.c;h=e4da279bcd0b4fdfcfa88678b6206ddb78a21698;hb=16061947d4376b41e596d87f97ec53ec29d17644;hp=e5d481e75d3e5b25068346d11959b0f3a5856c17;hpb=2f8fce1cf6ce4bd12a836cc8ee15f4edbc95c95e;p=fw%2Faltos diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c index e5d481e7..e4da279b 100644 --- a/src/scheme/ao_scheme_frame.c +++ b/src/scheme/ao_scheme_frame.c @@ -36,13 +36,12 @@ frame_vals_mark(void *addr) for (f = 0; f < vals->size; f++) { struct ao_scheme_val *v = &vals->vals[f]; + ao_scheme_poly_mark(v->atom, 0); ao_scheme_poly_mark(v->val, 0); - MDBG_MOVE("frame mark atom %s %d val %d at %d ", + MDBG_MOVE("frame mark atom %s %d val %d at %d\n", ao_scheme_poly_atom(v->atom)->name, MDBG_OFFSET(ao_scheme_ref(v->atom)), MDBG_OFFSET(ao_scheme_ref(v->val)), f); - MDBG_DO(ao_scheme_poly_write(v->val)); - MDBG_DO(printf("\n")); } } @@ -84,10 +83,11 @@ frame_mark(void *addr) struct ao_scheme_frame *frame = addr; for (;;) { + struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); + MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame)); - if (!AO_SCHEME_IS_POOL(frame)) - break; - ao_scheme_poly_mark(frame->vals, 0); + if (!ao_scheme_mark_memory(&ao_scheme_frame_vals_type, vals)) + frame_vals_mark(vals); frame = ao_scheme_poly_frame(frame->prev); MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame)); if (!frame) @@ -103,13 +103,17 @@ frame_move(void *addr) struct ao_scheme_frame *frame = addr; for (;;) { - struct ao_scheme_frame *prev; - int ret; + struct ao_scheme_frame *prev; + struct ao_scheme_frame_vals *vals; + int ret; MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame)); - if (!AO_SCHEME_IS_POOL(frame)) - break; - ao_scheme_poly_move(&frame->vals, 0); + vals = ao_scheme_poly_frame_vals(frame->vals); + if (!ao_scheme_move_memory(&ao_scheme_frame_vals_type, (void **) &vals)) + frame_vals_move(vals); + if (vals != ao_scheme_poly_frame_vals(frame->vals)) + frame->vals = ao_scheme_frame_vals_poly(vals); + prev = ao_scheme_poly_frame(frame->prev); if (!prev) break; @@ -133,32 +137,54 @@ const struct ao_scheme_type ao_scheme_frame_type = { .name = "frame", }; +int ao_scheme_frame_print_indent; + +static void +ao_scheme_frame_indent(FILE *out, int extra) +{ + int i; + putc('\n', out); + for (i = 0; i < ao_scheme_frame_print_indent+extra; i++) + putc('\t', out); +} + void -ao_scheme_frame_write(ao_poly p) +ao_scheme_frame_write(FILE *out, ao_poly p, bool write) { struct ao_scheme_frame *frame = ao_scheme_poly_frame(p); - struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); + struct ao_scheme_frame *clear = frame; int f; + int written = 0; + + ao_scheme_print_start(); + while (frame) { + struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); + + if (written != 0) + fputs(", ", out); + if (ao_scheme_print_mark_addr(frame)) { + fputs("recurse...", out); + break; + } - printf ("{"); - if (frame) { - if (frame->type & AO_SCHEME_FRAME_PRINT) - printf("recurse..."); - else { - frame->type |= AO_SCHEME_FRAME_PRINT; - for (f = 0; f < frame->num; f++) { - if (f != 0) - printf(", "); - ao_scheme_poly_write(vals->vals[f].atom); - printf(" = "); - ao_scheme_poly_write(vals->vals[f].val); - } - if (frame->prev) - ao_scheme_poly_write(frame->prev); - frame->type &= ~AO_SCHEME_FRAME_PRINT; + putc('{', out); + written++; + for (f = 0; f < frame->num; f++) { + ao_scheme_frame_indent(out, 1); + ao_scheme_poly_write(out, vals->vals[f].atom, write); + fputs(" = ", out); + ao_scheme_poly_write(out, vals->vals[f].val, write); + } + frame = ao_scheme_poly_frame(frame->prev); + ao_scheme_frame_indent(out, 0); + putc('}', out); + } + if (ao_scheme_print_stop()) { + while (written--) { + ao_scheme_print_clear_addr(clear); + clear = ao_scheme_poly_frame(clear->prev); } } - printf("}"); } static int @@ -225,9 +251,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); @@ -271,9 +297,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); @@ -306,11 +332,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); @@ -319,6 +345,41 @@ ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val) return val; } +#ifdef AO_SCHEME_FEATURE_UNDEF +ao_poly +ao_scheme_frame_del(struct ao_scheme_frame *frame, ao_poly atom) +{ + struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals); + int l = ao_scheme_frame_find(frame, frame->num, atom); + int f = frame->num; + struct ao_scheme_frame *moved_frame; + + if (l >= frame->num) + return _ao_scheme_bool_false; + + if (vals->vals[l].atom != atom) + return _ao_scheme_bool_false; + + /* squash the deleted entry */ + memmove(&vals->vals[l], + &vals->vals[l+1], + (f - l) * sizeof (struct ao_scheme_val)); + + /* allocate a smaller vals array */ + ao_scheme_frame_stash(frame); + moved_frame = ao_scheme_frame_realloc(frame, f - 1); + frame = ao_scheme_frame_fetch(); + + /* + * We couldn't allocate a smaller frame, so just + * ignore the last value in the array + */ + if (!moved_frame) + frame->num = f - 1; + return _ao_scheme_bool_true; +} +#endif + struct ao_scheme_frame *ao_scheme_frame_global; struct ao_scheme_frame *ao_scheme_frame_current;