/* Set on type when the frame escapes the lambda */
#define AO_SCHEME_FRAME_MARK 0x80
-#define AO_SCHEME_FRAME_PRINT 0x40
static inline int ao_scheme_frame_marked(struct ao_scheme_frame *f) {
return f->type & AO_SCHEME_FRAME_MARK;
};
#define AO_SCHEME_STACK_MARK 0x80 /* set on type when a reference has been taken */
-#define AO_SCHEME_STACK_PRINT 0x40 /* stack is being printed */
static inline int ao_scheme_stack_marked(struct ao_scheme_stack *s) {
return s->type & AO_SCHEME_STACK_MARK;
int
ao_scheme_print_mark_addr(void *addr);
-int
-ao_scheme_print_mark_poly(ao_poly poly);
+void
+ao_scheme_print_clear_addr(void *addr);
/* Notes that printing has started */
void
ao_scheme_print_start(void);
-/* Notes that printing has ended */
-void
+/* Notes that printing has ended, returns 1 if printing is still happening */
+int
ao_scheme_print_stop(void);
#define AO_SCHEME_COLLECT_FULL 1
extern const struct ao_scheme_type ao_scheme_bool_type;
void
-ao_scheme_bool_write(ao_poly v);
+ao_scheme_bool_write(ao_poly v, bool write);
#ifdef AO_SCHEME_MAKE_CONST
extern struct ao_scheme_bool *ao_scheme_true, *ao_scheme_false;
ao_scheme_cons_free(struct ao_scheme_cons *cons);
void
-ao_scheme_cons_write(ao_poly);
-
-void
-ao_scheme_cons_display(ao_poly);
+ao_scheme_cons_write(ao_poly, bool write);
int
ao_scheme_cons_length(struct ao_scheme_cons *cons);
ao_scheme_string_unpack(struct ao_scheme_string *a);
void
-ao_scheme_string_write(ao_poly s);
-
-void
-ao_scheme_string_display(ao_poly s);
+ao_scheme_string_write(ao_poly s, bool write);
/* atom */
extern const struct ao_scheme_type ao_scheme_atom_type;
extern struct ao_scheme_frame *ao_scheme_frame_current;
void
-ao_scheme_atom_write(ao_poly a);
+ao_scheme_atom_write(ao_poly a, bool write);
struct ao_scheme_atom *
ao_scheme_string_to_atom(struct ao_scheme_string *string);
/* int */
void
-ao_scheme_int_write(ao_poly i);
+ao_scheme_int_write(ao_poly i, bool write);
#ifdef AO_SCHEME_FEATURE_BIGINT
int32_t
}
void
-ao_scheme_bigint_write(ao_poly i);
+ao_scheme_bigint_write(ao_poly i, bool write);
extern const struct ao_scheme_type ao_scheme_bigint_type;
/* vector */
void
-ao_scheme_vector_write(ao_poly v);
-
-void
-ao_scheme_vector_display(ao_poly v);
+ao_scheme_vector_write(ao_poly v, bool write);
struct ao_scheme_vector *
ao_scheme_vector_alloc(uint16_t length, ao_poly fill);
extern const struct ao_scheme_type ao_scheme_vector_type;
/* prim */
-void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p);
-void (*ao_scheme_poly_display_func(ao_poly p))(ao_poly p);
-
-static inline void
-ao_scheme_poly_write(ao_poly p) { (*ao_scheme_poly_write_func(p))(p); }
+void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write);
static inline void
-ao_scheme_poly_display(ao_poly p) { (*ao_scheme_poly_display_func(p))(p); }
+ao_scheme_poly_write(ao_poly p, bool write) { (*ao_scheme_poly_write_func(p))(p, write); }
int
ao_scheme_poly_mark(ao_poly p, uint8_t note_cons);
extern const struct ao_scheme_type ao_scheme_float_type;
void
-ao_scheme_float_write(ao_poly p);
+ao_scheme_float_write(ao_poly p, bool write);
ao_poly
ao_scheme_float_get(float value);
/* builtin */
void
-ao_scheme_builtin_write(ao_poly b);
+ao_scheme_builtin_write(ao_poly b, bool write);
extern const struct ao_scheme_type ao_scheme_builtin_type;
ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val);
void
-ao_scheme_frame_write(ao_poly p);
+ao_scheme_frame_write(ao_poly p, bool write);
void
ao_scheme_frame_init(void);
ao_scheme_lambda_new(ao_poly cons);
void
-ao_scheme_lambda_write(ao_poly lambda);
+ao_scheme_lambda_write(ao_poly lambda, bool write);
ao_poly
ao_scheme_lambda_eval(void);
extern struct ao_scheme_stack *ao_scheme_stack;
extern struct ao_scheme_stack *ao_scheme_stack_free_list;
+extern int ao_scheme_frame_print_indent;
+
void
ao_scheme_stack_reset(struct ao_scheme_stack *stack);
ao_scheme_stack_clear(void);
void
-ao_scheme_stack_write(ao_poly stack);
+ao_scheme_stack_write(ao_poly stack, bool write);
ao_poly
ao_scheme_stack_eval(void);
void
ao_scheme_printf(const char *format, ...);
-void
-ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last);
-
-void
-ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame);
-
ao_poly
ao_scheme_error(int error, const char *format, ...);
#define DBG_RESET() (ao_scheme_stack_depth = 0)
#define DBG(...) ao_scheme_printf(__VA_ARGS__)
#define DBGI(...) do { printf("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0)
-#define DBG_CONS(a) ao_scheme_cons_write(ao_scheme_cons_poly(a))
-#define DBG_POLY(a) ao_scheme_poly_write(a)
+#define DBG_CONS(a) ao_scheme_cons_write(ao_scheme_cons_poly(a), true)
+#define DBG_POLY(a) ao_scheme_poly_write(a, true)
#define OFFSET(a) ((a) ? (int) ((uint8_t *) a - ao_scheme_pool) : -1)
-#define DBG_STACK() ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack))
+#define DBG_STACK() ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true)
static inline void
ao_scheme_frames_dump(void)
{
}
void
-ao_scheme_atom_write(ao_poly a)
+ao_scheme_atom_write(ao_poly a, bool write)
{
struct ao_scheme_atom *atom = ao_scheme_poly_atom(a);
+ (void) write;
printf("%s", atom->name);
}
};
void
-ao_scheme_bool_write(ao_poly v)
+ao_scheme_bool_write(ao_poly v, bool write)
{
struct ao_scheme_bool *b = ao_scheme_poly_bool(v);
+ (void) write;
if (b->value)
printf("#t");
else
#endif
void
-ao_scheme_builtin_write(ao_poly b)
+ao_scheme_builtin_write(ao_poly b, bool write)
{
struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b);
+ (void) write;
printf("%s", ao_scheme_builtin_name(builtin->func));
}
ao_poly val = AO_SCHEME_NIL;
while (cons) {
val = cons->car;
- ao_scheme_poly_write(val);
+ ao_scheme_poly_write(val, true);
cons = ao_scheme_cons_cdr(cons);
if (cons)
printf(" ");
ao_poly val = AO_SCHEME_NIL;
while (cons) {
val = cons->car;
- ao_scheme_poly_display(val);
+ ao_scheme_poly_write(val, false);
cons = ao_scheme_cons_cdr(cons);
}
return _ao_scheme_bool_true;
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_poly_type(v) == AO_SCHEME_CONS)
+ if (v != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(v))
return _ao_scheme_bool_true;
return _ao_scheme_bool_false;
}
for (;;) {
if (v == AO_SCHEME_NIL)
return _ao_scheme_bool_true;
- if (ao_scheme_poly_type(v) != AO_SCHEME_CONS)
+ if (!AO_SCHEME_IS_CONS(v))
return _ao_scheme_bool_false;
v = ao_scheme_poly_cons(v)->cdr;
}
ao_poly cdr = cons->cdr;
if (cdr == AO_SCHEME_NIL)
return NULL;
- if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
+ if (!AO_SCHEME_IS_CONS(cdr)) {
(void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
return NULL;
}
tail->cdr = ao_scheme_cons_poly(new);
tail = new;
cdr = cons->cdr;
- if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
+ if (!AO_SCHEME_IS_CONS(cdr)) {
tail->cdr = cdr;
break;
}
}
void
-ao_scheme_cons_write(ao_poly c)
+ao_scheme_cons_write(ao_poly c, bool write)
{
struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
+ struct ao_scheme_cons *clear = cons;
ao_poly cdr;
- int first = 1;
+ int written = 0;
ao_scheme_print_start();
printf("(");
while (cons) {
- if (!first)
+ if (written != 0)
printf(" ");
+
+ /* Note if there's recursion in printing. Not
+ * as good as actual references, but at least
+ * we don't infinite loop...
+ */
if (ao_scheme_print_mark_addr(cons)) {
printf("...");
break;
}
- ao_scheme_poly_write(cons->car);
+
+ ao_scheme_poly_write(cons->car, write);
+
+ /* keep track of how many pairs have been printed */
+ written++;
+
cdr = cons->cdr;
- if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
- cons = ao_scheme_poly_cons(cdr);
- first = 0;
- } else {
+ if (!AO_SCHEME_IS_CONS(cdr)) {
printf(" . ");
- ao_scheme_poly_write(cdr);
- cons = NULL;
+ ao_scheme_poly_write(cdr, write);
+ break;
}
+ cons = ao_scheme_poly_cons(cdr);
}
printf(")");
- ao_scheme_print_stop();
-}
-void
-ao_scheme_cons_display(ao_poly c)
-{
- struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
- ao_poly cdr;
-
- ao_scheme_print_start();
- while (cons) {
- if (ao_scheme_print_mark_addr(cons)) {
- printf("...");
- break;
- }
- ao_scheme_poly_display(cons->car);
+ if (ao_scheme_print_stop()) {
- cdr = cons->cdr;
- if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
- cons = ao_scheme_poly_cons(cdr);
- else {
- ao_scheme_poly_display(cdr);
- cons = NULL;
+ /* If we're still printing, clear the print marks on
+ * all printed pairs
+ */
+ while (written--) {
+ ao_scheme_print_clear_addr(clear);
+ clear = ao_scheme_poly_cons(clear->cdr);
}
}
- ao_scheme_print_stop();
}
int
#include "ao_scheme.h"
#include <stdarg.h>
-void
-ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last)
-{
- int first = 1;
- printf("\t\t%s(", name);
- if (ao_scheme_poly_type(poly) == AO_SCHEME_CONS) {
- if (poly) {
- while (poly) {
- struct ao_scheme_cons *cons = ao_scheme_poly_cons(poly);
- if (!first)
- printf("\t\t ");
- else
- first = 0;
- ao_scheme_poly_write(cons->car);
- printf("\n");
- if (poly == last)
- break;
- poly = cons->cdr;
- }
- printf("\t\t )\n");
- } else
- printf(")\n");
- } else {
- ao_scheme_poly_write(poly);
- printf("\n");
- }
-}
-
-static void tabs(int indent)
-{
- while (indent--)
- printf("\t");
-}
-
-void
-ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame)
-{
- int f;
-
- tabs(indent);
- printf ("%s{", name);
- if (frame) {
- struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals);
- 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) {
- tabs(indent);
- printf(" ");
- }
- ao_scheme_poly_write(vals->vals[f].atom);
- printf(" = ");
- ao_scheme_poly_write(vals->vals[f].val);
- printf("\n");
- }
- if (frame->prev)
- ao_scheme_error_frame(indent + 1, "prev: ", ao_scheme_poly_frame(frame->prev));
- frame->type &= ~AO_SCHEME_FRAME_PRINT;
- }
- tabs(indent);
- printf(" }\n");
- } else
- printf ("}\n");
-}
-
void
ao_scheme_vprintf(const char *format, va_list args)
{
if (c == '%') {
switch (c = *format++) {
case 'v':
- ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int));
+ ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), true);
+ break;
+ case 'V':
+ ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), false);
break;
case 'p':
printf("%p", va_arg(args, void *));
ao_scheme_printf("Value: %v\n", ao_scheme_v);
ao_scheme_printf("Frame: %v\n", ao_scheme_frame_poly(ao_scheme_frame_current));
printf("Stack:\n");
- ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack));
+ ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true);
ao_scheme_printf("Globals: %v\n", ao_scheme_frame_poly(ao_scheme_frame_global));
return AO_SCHEME_NIL;
}
#endif
void
-ao_scheme_float_write(ao_poly p)
+ao_scheme_float_write(ao_poly p, bool write)
{
struct ao_scheme_float *f = ao_scheme_poly_float(p);
float v = f->value;
+ (void) write;
if (isnanf(v))
printf("+nan.0");
else if (isinff(v)) {
.name = "frame",
};
+int ao_scheme_frame_print_indent;
+
+static void
+ao_scheme_frame_indent(int extra)
+{
+ int i;
+ putchar('\n');
+ for (i = 0; i < ao_scheme_frame_print_indent+extra; i++)
+ putchar('\t');
+}
+
void
-ao_scheme_frame_write(ao_poly p)
+ao_scheme_frame_write(ao_poly p, bool write)
{
struct ao_scheme_frame *frame = ao_scheme_poly_frame(p);
+ struct ao_scheme_frame *clear = frame;
struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals);
int f;
+ int written = 0;
- printf ("{");
- if (frame) {
- if (frame->type & AO_SCHEME_FRAME_PRINT)
+ ao_scheme_print_start();
+ while (frame) {
+ if (written != 0)
+ printf(", ");
+ if (ao_scheme_print_mark_addr(frame)) {
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;
+ break;
+ }
+
+ putchar('{');
+ written++;
+ for (f = 0; f < frame->num; f++) {
+ ao_scheme_frame_indent(1);
+ ao_scheme_poly_write(vals->vals[f].atom, write);
+ printf(" = ");
+ ao_scheme_poly_write(vals->vals[f].val, write);
+ }
+ frame = ao_scheme_poly_frame(frame->prev);
+ ao_scheme_frame_indent(0);
+ putchar('}');
+ }
+ if (ao_scheme_print_stop()) {
+ while (written--) {
+ ao_scheme_print_clear_addr(clear);
+ clear = ao_scheme_poly_frame(clear->prev);
}
}
- printf("}");
}
static int
#include "ao_scheme.h"
void
-ao_scheme_int_write(ao_poly p)
+ao_scheme_int_write(ao_poly p, bool write)
{
int i = ao_scheme_poly_int(p);
+ (void) write;
printf("%d", i);
}
};
void
-ao_scheme_bigint_write(ao_poly p)
+ao_scheme_bigint_write(ao_poly p, bool write)
{
struct ao_scheme_bigint *bi = ao_scheme_poly_bigint(p);
+ (void) write;
printf("%d", bi->value);
}
#endif /* AO_SCHEME_FEATURE_BIGINT */
};
void
-ao_scheme_lambda_write(ao_poly poly)
+ao_scheme_lambda_write(ao_poly poly, bool write)
{
struct ao_scheme_lambda *lambda = ao_scheme_poly_lambda(poly);
struct ao_scheme_cons *cons = ao_scheme_poly_cons(lambda->code);
printf("%s", ao_scheme_args_name(lambda->args));
while (cons) {
printf(" ");
- ao_scheme_poly_write(cons->car);
+ ao_scheme_poly_write(cons->car, write);
cons = ao_scheme_poly_cons(cons->cdr);
}
printf(")");
list = cons->cdr;
p = AO_SCHEME_NIL;
- while (list != AO_SCHEME_NIL && ao_scheme_poly_type(list) == AO_SCHEME_CONS) {
+ while (list != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(list)) {
cons = ao_scheme_poly_cons(list);
m = ao_has_macro(cons->car);
if (m) {
out = ao_scheme_eval(in);
if (ao_scheme_exception)
return 0;
- ao_scheme_poly_write(out);
+ ao_scheme_poly_write(out, true);
putchar ('\n');
}
return 1;
if (val != AO_SCHEME_NIL) {
printf("error: function %s contains unresolved macro: ",
ao_scheme_poly_atom(vals->vals[f].atom)->name);
- ao_scheme_poly_write(val);
+ ao_scheme_poly_write(val, true);
printf("\n");
exit(1);
}
#endif
if (!AO_SCHEME_IS_POOL(addr))
- return 1;
+ return 0;
if (!ao_scheme_print_cleared) {
ao_scheme_print_cleared = 1;
return 0;
}
-int
-ao_scheme_print_mark_poly(ao_poly p)
+void
+ao_scheme_print_clear_addr(void *addr)
{
- uint8_t type = ao_scheme_poly_base_type(p);
+ int offset;
- if (type == AO_SCHEME_INT)
- return 1;
- return ao_scheme_print_mark_addr(ao_scheme_ref(p));
+#if DBG_MEM
+ if (ao_scheme_collecting)
+ ao_scheme_abort();
+#endif
+
+ if (!AO_SCHEME_IS_POOL(addr))
+ return;
+
+ if (!ao_scheme_print_cleared)
+ return;
+ offset = pool_offset(addr);
+ clear(ao_scheme_busy, offset);
}
/* Notes that printing has started */
ao_scheme_printing++;
}
-/* Notes that printing has ended */
-void
+/* Notes that printing has ended. Returns 1 if printing is still going on */
+int
ao_scheme_print_stop(void)
{
ao_scheme_printing--;
- if (ao_scheme_printing == 0)
- ao_scheme_print_cleared = 0;
+ if (ao_scheme_printing != 0)
+ return 1;
+ ao_scheme_print_cleared = 0;
+ return 0;
}
#include "ao_scheme.h"
-struct ao_scheme_funcs {
- void (*write)(ao_poly);
- void (*display)(ao_poly);
-};
+static void ao_scheme_invalid_write(ao_poly p, bool write) {
+ printf("??? type %d poly 0x%04x ???", ao_scheme_poly_type (p), p);
+ (void) write;
+ ao_scheme_abort();
+}
-static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = {
- [AO_SCHEME_CONS] = {
- .write = ao_scheme_cons_write,
- .display = ao_scheme_cons_display,
- },
+static void (*const ao_scheme_write_funcs[AO_SCHEME_NUM_TYPE]) (ao_poly p, bool write) = {
+ [AO_SCHEME_CONS] = ao_scheme_cons_write,
#ifdef AO_SCHEME_FEATURE_BIGINT
- [AO_SCHEME_BIGINT] = {
- .write = ao_scheme_bigint_write,
- .display = ao_scheme_bigint_write,
- },
+ [AO_SCHEME_BIGINT] = ao_scheme_bigint_write,
#endif
- [AO_SCHEME_INT] = {
- .write = ao_scheme_int_write,
- .display = ao_scheme_int_write,
- },
- [AO_SCHEME_ATOM] = {
- .write = ao_scheme_atom_write,
- .display = ao_scheme_atom_write,
- },
- [AO_SCHEME_BUILTIN] = {
- .write = ao_scheme_builtin_write,
- .display = ao_scheme_builtin_write,
- },
- [AO_SCHEME_FRAME] = {
- .write = ao_scheme_frame_write,
- .display = ao_scheme_frame_write,
- },
- [AO_SCHEME_FRAME_VALS] = {
- .write = NULL,
- .display = NULL,
- },
- [AO_SCHEME_LAMBDA] = {
- .write = ao_scheme_lambda_write,
- .display = ao_scheme_lambda_write,
- },
- [AO_SCHEME_STACK] = {
- .write = ao_scheme_stack_write,
- .display = ao_scheme_stack_write,
- },
- [AO_SCHEME_BOOL] = {
- .write = ao_scheme_bool_write,
- .display = ao_scheme_bool_write,
- },
- [AO_SCHEME_STRING] = {
- .write = ao_scheme_string_write,
- .display = ao_scheme_string_display,
- },
+ [AO_SCHEME_INT] = ao_scheme_int_write,
+ [AO_SCHEME_ATOM] = ao_scheme_atom_write,
+ [AO_SCHEME_BUILTIN] = ao_scheme_builtin_write,
+ [AO_SCHEME_FRAME] = ao_scheme_frame_write,
+ [AO_SCHEME_FRAME_VALS] = ao_scheme_invalid_write,
+ [AO_SCHEME_LAMBDA] = ao_scheme_lambda_write,
+ [AO_SCHEME_STACK] = ao_scheme_stack_write,
+ [AO_SCHEME_BOOL] = ao_scheme_bool_write,
+ [AO_SCHEME_STRING] = ao_scheme_string_write,
#ifdef AO_SCHEME_FEATURE_FLOAT
- [AO_SCHEME_FLOAT] = {
- .write = ao_scheme_float_write,
- .display = ao_scheme_float_write,
- },
+ [AO_SCHEME_FLOAT] = ao_scheme_float_write,
#endif
#ifdef AO_SCHEME_FEATURE_VECTOR
- [AO_SCHEME_VECTOR] = {
- .write = ao_scheme_vector_write,
- .display = ao_scheme_vector_display
- },
+ [AO_SCHEME_VECTOR] = ao_scheme_vector_write,
#endif
};
-static void ao_scheme_invalid_write(ao_poly p) {
- printf("??? 0x%04x ???", p);
- ao_scheme_abort();
-}
-
-static const struct ao_scheme_funcs ao_scheme_invalid_funcs = {
- .write = ao_scheme_invalid_write,
- .display = ao_scheme_invalid_write,
-};
-
-static const struct ao_scheme_funcs *
-funcs(ao_poly p)
+void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write)
{
uint8_t type = ao_scheme_poly_type(p);
if (type < AO_SCHEME_NUM_TYPE)
- return &ao_scheme_funcs[type];
- return &ao_scheme_invalid_funcs;
-}
-
-void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p)
-{
- return funcs(p)->write;
-}
-
-void (*ao_scheme_poly_display_func(ao_poly p))(ao_poly p)
-{
- return funcs(p)->display;
+ return ao_scheme_write_funcs[type];
+ return ao_scheme_invalid_write;
}
void *
break;
ao_scheme_exception = 0;
} else {
- ao_scheme_poly_write(out);
+ ao_scheme_poly_write(out, true);
putchar ('\n');
}
}
}
void
-ao_scheme_stack_write(ao_poly poly)
+ao_scheme_stack_write(ao_poly poly, bool write)
{
- struct ao_scheme_stack *s = ao_scheme_poly_stack(poly);
+ struct ao_scheme_stack *s = ao_scheme_poly_stack(poly);
+ struct ao_scheme_stack *clear = s;
+ int written = 0;
+ (void) write;
+ ao_scheme_print_start();
+ ao_scheme_frame_print_indent += 2;
while (s) {
- if (s->type & AO_SCHEME_STACK_PRINT) {
+ if (ao_scheme_print_mark_addr(s)) {
printf("[recurse...]");
- return;
+ break;
}
- s->type |= AO_SCHEME_STACK_PRINT;
+ written++;
printf("\t[\n");
- printf("\t\texpr: "); ao_scheme_poly_write(s->list); printf("\n");
- printf("\t\tstate: %s\n", ao_scheme_state_names[s->state]);
- ao_scheme_error_poly ("values: ", s->values, s->values_tail);
- ao_scheme_error_poly ("sexprs: ", s->sexprs, AO_SCHEME_NIL);
- ao_scheme_error_frame(2, "frame: ", ao_scheme_poly_frame(s->frame));
+ ao_scheme_printf("\t\texpr: %v\n", s->list);
+ ao_scheme_printf("\t\tvalues: %v\n", s->values);
+ ao_scheme_printf("\t\tframe: %v\n", s->frame);
printf("\t]\n");
- s->type &= ~AO_SCHEME_STACK_PRINT;
s = ao_scheme_poly_stack(s->prev);
}
+ ao_scheme_frame_print_indent -= 2;
+ if (ao_scheme_print_stop()) {
+ while (written--) {
+ ao_scheme_print_clear_addr(clear);
+ clear = ao_scheme_poly_stack(clear->prev);
+ }
+ }
}
/*
}
void
-ao_scheme_string_write(ao_poly p)
+ao_scheme_string_write(ao_poly p, bool write)
{
struct ao_scheme_string *s = ao_scheme_poly_string(p);
char *sval = s->val;
char c;
- putchar('"');
- while ((c = *sval++)) {
- switch (c) {
- case '\n':
- printf ("\\n");
- break;
- case '\r':
- printf ("\\r");
- break;
- case '\t':
- printf ("\\t");
- break;
- default:
- if (c < ' ')
- printf("\\%03o", c);
- else
- putchar(c);
- break;
+ if (write) {
+ putchar('"');
+ while ((c = *sval++)) {
+ switch (c) {
+ case '\n':
+ printf ("\\n");
+ break;
+ case '\r':
+ printf ("\\r");
+ break;
+ case '\t':
+ printf ("\\t");
+ break;
+ default:
+ if (c < ' ')
+ printf("\\%03o", c);
+ else
+ putchar(c);
+ break;
+ }
}
+ putchar('"');
+ } else {
+ while ((c = *sval++))
+ putchar(c);
}
- putchar('"');
-}
-
-void
-ao_scheme_string_display(ao_poly p)
-{
- struct ao_scheme_string *s = ao_scheme_poly_string(p);
- char *sval = s->val;
- char c;
-
- while ((c = *sval++))
- putchar(c);
}
}
void
-ao_scheme_vector_write(ao_poly v)
+ao_scheme_vector_write(ao_poly v, bool write)
{
struct ao_scheme_vector *vector = ao_scheme_poly_vector(v);
unsigned int i;
+ int was_marked = 0;
ao_scheme_print_start();
- if (ao_scheme_print_mark_addr(vector))
+ was_marked = ao_scheme_print_mark_addr(vector);
+ if (was_marked) {
printf ("...");
- else {
+ } else {
printf("#(");
for (i = 0; i < vector->length; i++) {
if (i != 0)
printf(" ");
- ao_scheme_poly_write(vector->vals[i]);
+ ao_scheme_poly_write(vector->vals[i], write);
}
printf(")");
}
- ao_scheme_print_stop();
-}
-
-void
-ao_scheme_vector_display(ao_poly v)
-{
- struct ao_scheme_vector *vector = ao_scheme_poly_vector(v);
- unsigned int i;
-
- ao_scheme_print_start();
- if (ao_scheme_print_mark_addr(vector))
- printf ("...");
- else {
- for (i = 0; i < vector->length; i++)
- ao_scheme_poly_display(vector->vals[i]);
- }
+ if (ao_scheme_print_stop() && !was_marked)
+ ao_scheme_print_clear_addr(vector);
}
static int32_t
projects / fw / altos / commitdiff