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.
This commit is contained in:
parent
c1a0850bcf
commit
0e62641919
|
|
@ -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=:
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
44
gc.c
44
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("#<cycle>", 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)
|
||||
|
|
|
|||
12
interp.c
12
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)));
|
||||
|
|
|
|||
Loading…
Reference in New Issue