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

@@ -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=:

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))

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)

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[2] : bytes[3]));
-                             : 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)));