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"));
}
}
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)
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;
.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
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);
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);
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);
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;