From 0e62641919cbcc9b01141909902bbfd56debfe06 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Wed, 18 Nov 2009 22:46:23 -0600 Subject: [PATCH] Check in a second program, this time demonstrating basic I/O. Also filter cycles and long byte-strings from print_value() output. Added three new bytecodes to get the sizes of vectors, strings, and structs. --- cat.rla | 84 ++++++++++++++++++++++++++++++++++++++++++++++++ doc/bytecode.txt | 4 +++ gc.c | 44 ++++++++++++++++++++----- interp.c | 12 ++++--- 4 files changed, 131 insertions(+), 13 deletions(-) create mode 100644 cat.rla diff --git a/cat.rla b/cat.rla new file mode 100644 index 0000000..3c5a232 --- /dev/null +++ b/cat.rla @@ -0,0 +1,84 @@ +;(lambda (pathname) +; (let [(fd (posix-open pathname O_RDONLY))] +; (let [(str (make-byte-string 128))] +; (let loop () +; (let [(size (posix-read fd str (byte-string-size str)))] +; (posix-write 1 str size)) +; (loop))))) +#S(#="lambda" + #( + 0 + #="posix-open" + #S(#="template" + ; (lambda (fd) + ; (letrec [(loop (lambda () + ; (let [(size (posix-read fd str (byte-string-size str)))] + ; (posix-write 1 str size)) + ; (loop)))] + ; (loop))) + #( + 128 + #S(#="template" + #(#="posix-read") + "\x80\x81\x83\xff" ; #(f0 f1 f3 ctx) + 2 + "\x00\x80\x29\x41\; (set! f0 (byte-string-size i1)) + \x02\x80\x80\x00\; (set! f0 (cons f0 nil)) + \x02\x80\x41\x80\; (set! f0 (cons i1 f0)) + \x02\x80\x40\x80\; (set! f0 (cons i0 f0)) + \x00\x81\x02\x42"; (set! f1 (unbox i2)) + 0x01 ; g1 + 0x80 ; f0 + 0x81 ; f1 + 0x43 ; i3 + ) + #S(#="template" + ; (letrec [(loop (lambda () + ; (let [(size (posix-read fd str (byte-string-size str)))] + ; (posix-write 1 str size)) + ; (loop)))] + ; ...) + #(1 #="posix-write" 0) + "\x80\x81\x82\x40\x41" ; #(f0 f1 f2 i0 i1) + 2 + "\x00\x81\x03\xfd\; (set! f1 (car argv)) + \x02\x80\x81\x00\; (set! f0 (cons f1 nil)) + \x02\x80\x41\x80\; (set! f0 (cons i1 f0)) + \x02\x80\x01\x80\; (set! f0 (cons g1 f0)) + \x01\x81\x81\x03\; (set! f1 (eq? f1 g3)) + \x80\x81\x00\x80\; (set! f0 (if f1 nil f0)) + \x81\x81\x43\x02"; (set! f1 (if f1 i3 g2)) + 0x81 ; f1 + 0x80 ; f0 + 0x42 ; i2 + 0x44 ; i4 + ) + 0 + ) + "\xfe\xff" ; i0=k, i1=ctx + 5 + "\x00\x80\x03\xfd\; (set! f0 (car argv)) + \x04\x81\x01\x04\; (set! f1 (make-byte-string g1 g4)) + \x00\x83\x18\x83\; (set! f3 (make-box f3)) + \x00\x82\x1b\x02\; (set! f2 (lambda g2)) + \x00\x84\x1b\x03\; (set! f4 (lambda g3)) + \x40\x83\x84\x00"; (set-box! f3 f4) + 0x82 ; f2 + 0x00 ; nil + 0x40 ; i0 + 0x41 ; i1 + ) + ) + #() + 2 + "\x02\x80\x01\x00\; (set! f0 (cons g1 nil)) + \x00\x81\x03\xfd\; (set! f1 (car argv)) + \x02\x80\x81\x80\; (set! f0 (cons f1 f0)) + \x00\x81\x1b\x03"; (set! f1 (lambda g3)) + 0x02 ; g2 + 0x80 ; f0 + 0x81 ; f1 + 0xff ; ctx +) + +; vim:set sw=2 expandtab syntax=: diff --git a/doc/bytecode.txt b/doc/bytecode.txt index c04f33f..ecf236d 100644 --- a/doc/bytecode.txt +++ b/doc/bytecode.txt @@ -33,6 +33,10 @@ unary-expr: up to 255, 1 out, 1 in 22 (set! out (fix- in)) ; two's complement / arithmetic negation 23 (set! out (float- in)) ; floating-point negation + 28 (set! out (vector-size in)) + 29 (set! out (byte-string-size in)) + 2a (set! out (struct-nslots in)) + ; ISO C floating-point 30 (set! out (acos in)) 31 (set! out (asin in)) diff --git a/gc.c b/gc.c index 3a7b003..d08b9c1 100644 --- a/gc.c +++ b/gc.c @@ -911,8 +911,25 @@ void _release_assert(bool expr, const char *str, const char *file, int line) } } -void fprint_value(FILE *f, value_t v) +typedef struct seen_value { + value_t value; + struct seen_value *prev; +} seen_value_t; + +static void _fprint_value(FILE *f, value_t v, seen_value_t *seen) +{ + seen_value_t new_seen = { v, seen }; + + for (seen_value_t *sv = seen; sv; sv = sv->prev) + { + if (v == sv->value) + { + fputs("#", f); + return; + } + } + if (v == NIL) { fputs("nil", f); @@ -936,26 +953,26 @@ void fprint_value(FILE *f, value_t v) else if (is_box(v)) { fputs("#&", f); - fprint_value(f, _get_box(v)->value); + _fprint_value(f, _get_box(v)->value, &new_seen); } else if (is_pair(v)) { fputc('(', f); - fprint_value(f, _get_pair(v)->car); + _fprint_value(f, _get_pair(v)->car, &new_seen); v = _get_pair(v)->cdr; while (is_pair(v)) { fputc(' ', f); - fprint_value(f, _get_pair(v)->car); + _fprint_value(f, _get_pair(v)->car, &new_seen); v = _get_pair(v)->cdr; } if (v != NIL) { fputs(" . ", f); - fprint_value(f, v); + _fprint_value(f, v, &new_seen); } fputc(')', f); @@ -967,7 +984,7 @@ void fprint_value(FILE *f, value_t v) for (size_t i = 0; i < _get_vector(v)->size; ++i) { if (i != 0) fputc(' ', f); - fprint_value(f, _get_vector(v)->elements[i]); + _fprint_value(f, _get_vector(v)->elements[i], &new_seen); } fputc(')', f); @@ -986,6 +1003,12 @@ void fprint_value(FILE *f, value_t v) fputc(str->bytes[i], f); else fprintf(f, "\\x%.2X", (int)str->bytes[i]); + + if (i >= 20) + { + fputs("...", f); + break; + } } fputc('"', f); @@ -1001,7 +1024,7 @@ void fprint_value(FILE *f, value_t v) for (size_t i = 0; i < _get_struct(v)->nslots; ++i) { fputc(' ', f); - fprint_value(f, _get_struct(v)->slots[i]); + _fprint_value(f, _get_struct(v)->slots[i], &new_seen); } fputc(')', f); @@ -1009,7 +1032,7 @@ void fprint_value(FILE *f, value_t v) else if (is_weak_box(v)) { fputs("#W&", f); - fprint_value(f, _get_weak_box(v)->value); + _fprint_value(f, _get_weak_box(v)->value, &new_seen); } else if (is_float(v)) { @@ -1025,6 +1048,11 @@ void fprint_value(FILE *f, value_t v) } } +void fprint_value(FILE *f, value_t v) +{ + _fprint_value(f, v, NULL); +} + void fprint_gc_stats(FILE *f) { if (gc_stats.collections > 0) diff --git a/interp.c b/interp.c index a2d044c..d858b6b 100644 --- a/interp.c +++ b/interp.c @@ -285,17 +285,16 @@ static void run_byte_code(interp_state_t *state) switch (bytes[0]) { - case 0 ... 63: /* expression */ + case 0x00 ... 0x3f: /* expression */ set_output(state, bytes[1], eval_expression(state, bytes[0], bytes[2], bytes[3])); break; - case 64 ... 127: /* statement */ + case 0x40 ... 0x7f: /* statement */ run_statement(state, bytes[0], bytes[1], bytes[2], bytes[3]); break; - case 128 ... 255: /* conditional */ + case 0x80 ... 0xff: /* conditional */ set_output(state, bytes[0], get_input(state, _get_boolean(get_input(state, bytes[1])) - ? bytes[2] - : bytes[3])); + ? bytes[2] : bytes[3])); break; } } @@ -405,6 +404,9 @@ static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uin case 0x21: return fixnum_value(~get_fixnum(ST1)); case 0x22: return fixnum_value(-get_fixnum(ST1)); case 0x23: return make_float(-get_float(ST1)); + case 0x28: return fixnum_value(get_vector(ST1)->size); + case 0x29: return fixnum_value(get_byte_string(ST1)->size); + case 0x2a: return fixnum_value(get_struct(ST1)->nslots); case 0x30: return make_float(acos(get_float(ST1))); case 0x31: return make_float(asin(get_float(ST1))); case 0x32: return make_float(atan(get_float(ST1)));