diff options
| -rw-r--r-- | src/scheme/ao_scheme.h | 65 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_atom.c | 3 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_bool.c | 3 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_builtin.c | 11 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_cons.c | 62 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_error.c | 74 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_float.c | 3 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_frame.c | 55 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_int.c | 6 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_lambda.c | 4 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_make_const.c | 6 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_mem.c | 33 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_poly.c | 103 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_rep.c | 2 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_stack.c | 31 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_string.c | 56 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_vector.c | 28 |
17 files changed, 213 insertions, 332 deletions
diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 0881721b..b37e9098 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -249,7 +249,6 @@ struct ao_scheme_bigint { /* 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; @@ -301,7 +300,6 @@ struct ao_scheme_stack { }; #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; @@ -567,15 +565,15 @@ ao_scheme_alloc(int size); 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 @@ -628,7 +626,7 @@ ao_scheme_frame_fetch(int id); 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; @@ -656,10 +654,7 @@ void 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); @@ -689,10 +684,7 @@ ao_poly 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; @@ -702,7 +694,7 @@ extern struct ao_scheme_frame *ao_scheme_frame_global; 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); @@ -724,7 +716,7 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val); /* 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 @@ -740,7 +732,7 @@ ao_scheme_integer_typep(uint8_t 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; @@ -760,10 +752,7 @@ ao_scheme_integer_typep(uint8_t t) /* 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); @@ -783,14 +772,10 @@ ao_scheme_vector_to_list(struct ao_scheme_vector *vector); 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); @@ -818,7 +803,7 @@ ao_scheme_set_cond(struct ao_scheme_cons *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); @@ -836,7 +821,7 @@ ao_scheme_number_typep(uint8_t t) /* 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; @@ -895,7 +880,7 @@ ao_poly 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); @@ -909,7 +894,7 @@ struct ao_scheme_lambda * 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); @@ -920,6 +905,8 @@ extern const struct ao_scheme_type ao_scheme_stack_type; 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); @@ -933,7 +920,7 @@ void 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); @@ -946,12 +933,6 @@ ao_scheme_vprintf(const char *format, va_list args); 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, ...); @@ -974,10 +955,10 @@ int ao_scheme_stack_depth; #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) { diff --git a/src/scheme/ao_scheme_atom.c b/src/scheme/ao_scheme_atom.c index 745c32fe..8989cefd 100644 --- a/src/scheme/ao_scheme_atom.c +++ b/src/scheme/ao_scheme_atom.c @@ -188,8 +188,9 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val) } 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); } diff --git a/src/scheme/ao_scheme_bool.c b/src/scheme/ao_scheme_bool.c index c1e880ca..88970667 100644 --- a/src/scheme/ao_scheme_bool.c +++ b/src/scheme/ao_scheme_bool.c @@ -38,10 +38,11 @@ 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) { struct ao_scheme_bool *b = ao_scheme_poly_bool(v); + (void) write; if (b->value) printf("#t"); else diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 9a823f6a..221570c7 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -84,9 +84,10 @@ ao_scheme_args_name(uint8_t args) #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)); } @@ -287,7 +288,7 @@ ao_scheme_do_write(struct ao_scheme_cons *cons) 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(" "); @@ -301,7 +302,7 @@ ao_scheme_do_display(struct ao_scheme_cons *cons) 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; @@ -855,7 +856,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) 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; } @@ -946,7 +947,7 @@ ao_scheme_do_listp(struct ao_scheme_cons *cons) 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; } diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c index 0b3cbf80..7976250b 100644 --- a/src/scheme/ao_scheme_cons.c +++ b/src/scheme/ao_scheme_cons.c @@ -111,7 +111,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons) 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; } @@ -151,7 +151,7 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons) 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; } @@ -175,59 +175,53 @@ ao_scheme_cons_free(struct ao_scheme_cons *cons) } 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 diff --git a/src/scheme/ao_scheme_error.c b/src/scheme/ao_scheme_error.c index c015c76a..6a71ca51 100644 --- a/src/scheme/ao_scheme_error.c +++ b/src/scheme/ao_scheme_error.c @@ -16,73 +16,6 @@ #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) { char c; @@ -91,7 +24,10 @@ 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 *)); @@ -133,7 +69,7 @@ ao_scheme_error(int error, const char *format, ...) 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; } diff --git a/src/scheme/ao_scheme_float.c b/src/scheme/ao_scheme_float.c index b75289d7..d8501548 100644 --- a/src/scheme/ao_scheme_float.c +++ b/src/scheme/ao_scheme_float.c @@ -46,11 +46,12 @@ const struct ao_scheme_type ao_scheme_float_type = { #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)) { diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c index 3f4c9157..46f941e6 100644 --- a/src/scheme/ao_scheme_frame.c +++ b/src/scheme/ao_scheme_frame.c @@ -142,32 +142,53 @@ const struct ao_scheme_type ao_scheme_frame_type = { .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 diff --git a/src/scheme/ao_scheme_int.c b/src/scheme/ao_scheme_int.c index 4fcf4931..01b571c0 100644 --- a/src/scheme/ao_scheme_int.c +++ b/src/scheme/ao_scheme_int.c @@ -15,9 +15,10 @@ #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); } @@ -76,10 +77,11 @@ const struct ao_scheme_type ao_scheme_bigint_type = { }; 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 */ diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c index be87f4d1..e8ce0710 100644 --- a/src/scheme/ao_scheme_lambda.c +++ b/src/scheme/ao_scheme_lambda.c @@ -50,7 +50,7 @@ const struct ao_scheme_type ao_scheme_lambda_type = { }; 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); @@ -59,7 +59,7 @@ ao_scheme_lambda_write(ao_poly poly) 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(")"); diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c index 51bb1269..79ba1bf1 100644 --- a/src/scheme/ao_scheme_make_const.c +++ b/src/scheme/ao_scheme_make_const.c @@ -220,7 +220,7 @@ ao_has_macro(ao_poly p) 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) { @@ -280,7 +280,7 @@ ao_scheme_read_eval_abort(void) 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; @@ -446,7 +446,7 @@ main(int argc, char **argv) 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); } diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c index 94275451..a336fdfe 100644 --- a/src/scheme/ao_scheme_mem.c +++ b/src/scheme/ao_scheme_mem.c @@ -1061,7 +1061,7 @@ ao_scheme_print_mark_addr(void *addr) #endif if (!AO_SCHEME_IS_POOL(addr)) - return 1; + return 0; if (!ao_scheme_print_cleared) { ao_scheme_print_cleared = 1; @@ -1074,14 +1074,23 @@ ao_scheme_print_mark_addr(void *addr) 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 */ @@ -1091,11 +1100,13 @@ ao_scheme_print_start(void) 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; } diff --git a/src/scheme/ao_scheme_poly.c b/src/scheme/ao_scheme_poly.c index 70e577a2..25ac6d67 100644 --- a/src/scheme/ao_scheme_poly.c +++ b/src/scheme/ao_scheme_poly.c @@ -14,100 +14,41 @@ #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 * diff --git a/src/scheme/ao_scheme_rep.c b/src/scheme/ao_scheme_rep.c index 5b94d940..b35ba5b8 100644 --- a/src/scheme/ao_scheme_rep.c +++ b/src/scheme/ao_scheme_rep.c @@ -30,7 +30,7 @@ ao_scheme_read_eval_print(void) break; ao_scheme_exception = 0; } else { - ao_scheme_poly_write(out); + ao_scheme_poly_write(out, true); putchar ('\n'); } } diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c index e062a093..e29e2b68 100644 --- a/src/scheme/ao_scheme_stack.c +++ b/src/scheme/ao_scheme_stack.c @@ -158,26 +158,35 @@ ao_scheme_stack_clear(void) } 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); + } + } } /* diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index e18a8e85..b00ef276 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -173,42 +173,36 @@ ao_scheme_string_unpack(struct ao_scheme_string *a) } 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); } diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c index ff2067e2..419d6765 100644 --- a/src/scheme/ao_scheme_vector.c +++ b/src/scheme/ao_scheme_vector.c @@ -73,39 +73,27 @@ ao_scheme_vector_alloc(uint16_t length, ao_poly fill) } 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 |