Add bytecodes to skip the rest of a block based on a condition.

Should simplify error-handling and sequences of primitive tests.
Also, automatically instantiate templates used in the tail-call lambda & cont'n fields.

doc/bytecode.txt

@@ -137,15 +137,19 @@ conditional: 1 out, 3 in
   ; 0x80 <= AA <= 0xf7 (f0-f119)
   AA (set! AA (if in1 in2 in3))      ; in3 if in1 == #f, in2 otherwise
 statement: up to 64 (40..7f), 3 in
+  ; unary statements
+  40 (goto-end-if in1)
+  41 (goto-end-unless in1)
+
   ; binary statements
-  40 (set-box! in in)  ; box value
+  50 (set-box! in1 in2)  ; box value
-  41 (set-car! in in)  ; pair value
+  51 (set-car! in1 in2)  ; pair value
-  42 (set-cdr! in in)  ; pair value
+  52 (set-cdr! in1 in2)  ; pair value
 
   ; ternary statements
-  60 (vector-set!      in in in)  ; vector n value, 0 <= n < nelem
+  60 (vector-set!      in1 in2 in3)  ; vector n value, 0 <= n < nelem
-  61 (byte-string-set! in in in)  ; string n value, 0 <= n < nbytes
+  61 (byte-string-set! in1 in2 in3)  ; string n value, 0 <= n < nbytes
-  62 (struct-set!      in in in)  ; struct n value, 0 <= n < nslots
+  62 (struct-set!      in1 in2 in3)  ; struct n value, 0 <= n < nslots
 
 in:
   nil  (00000000) [g0, always NIL]

interp.c

@@ -300,10 +300,18 @@ static void run_byte_code(interp_state_t *state)
 
     switch (bytes[0])
     {
+      bool cond;
     case 0x00 ... 0x3f: /* expression */
       set_output(state, bytes[1], eval_expression(state, bytes[0], bytes[2], bytes[3]));
       break;
-    case 0x40 ... 0x7f: /* statement */
+    case 0x40 ... 0x41: /* goto-end-if, goto-end-unless */
+      cond = _get_boolean(get_input(state, bytes[1]));
+      if ((bytes[0] & 1) ? !cond : cond)
+      {
+        goto break_for_loop;
+      }
+      break;
+    case 0x42 ... 0x7f: /* statement */
       run_statement(state, bytes[0], bytes[1], bytes[2], bytes[3]);
       break;
     case 0x80 ... 0xff: /* conditional */
@@ -313,6 +321,7 @@ static void run_byte_code(interp_state_t *state)
       break;
     }
   }
+break_for_loop:
 
   unregister_gc_root(&bc_root);
 }
@@ -326,6 +335,10 @@ static void perform_tail_call(interp_state_t *state)
   new_ctx    = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTEXT)));
   new_k      = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTINUATION)));
 
+  /* If new lambda or continuation is a template, instantiate it here. */
+  new_lambda = make_lambda(state, new_lambda);
+  new_k      = make_lambda(state, new_k);
+
   state->lambda.value = new_lambda;
   state->argv.value   = new_argv;
   state->ctx.value    = new_ctx;
@@ -483,7 +496,11 @@ static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uin
 static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint32_t in3)
 {
   ST1 = get_input(state, in1);
-  ST2 = get_input(state, in2);
+
+  if (code >= 0x50)
+  {
+    ST2 = get_input(state, in2);
+  }
 
   if (code >= 0x60)
   {
@@ -492,12 +509,14 @@ static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint
 
   switch (code)
   {
-  case 0x40: get_box(ST1)->value = ST2; WRITE_BARRIER(ST1); break;
+  /* 0x40 and 0x41 (goto-end-if, goto-end-unless) are handled by run_byte_code() directly. */
-  case 0x41: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); break;
+  case 0x50: get_box(ST1)->value = ST2; WRITE_BARRIER(ST1); break;
-  case 0x42: get_pair(ST1)->cdr = ST2; WRITE_BARRIER(ST1); break;
+  case 0x51: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); break;
+  case 0x52: get_pair(ST1)->cdr = ST2; WRITE_BARRIER(ST1); break;
   case 0x60: vector_set(ST1, get_fixnum(ST2), ST3); break;
   case 0x61: byte_string_set(ST1, get_fixnum(ST2), (char)get_fixnum(ST3)); break;
   case 0x62: struct_set(ST1, get_fixnum(ST2), ST3); break;
+  default: release_assert(NOTREACHED("Invalid statement bytecode."));
   }
 }
 

src/lib/math/fact.rla

@@ -52,20 +52,18 @@
       "\x80"
       2
       "\x09\x80\x40\x01\; (set! f0 (fix- i0 g1))
-       \x02\x80\x80\x00\; (set! f0 (cons f0 nil))
+       \x02\x80\x80\x00"; (set! f0 (cons f0 nil))
-       \x00\x81\x1b\x02"; (set! f1 (lambda g2))
       0x03  ; g3
       0x80  ; f0
       0xfe  ; ctx
-      0x81  ; f1
+      0x02  ; g2
     )
   )
   #()
   2
   "\x00\x80\x03\xfd\; (set! f0 (car argv))
    \x0d\x81\x80\x01\; (set! f1 (fix< f0 g1))
-   \x81\x81\x02\x03\; (set! f1 (if f1 g2 g3))
+   \x81\x81\x02\x03"; (set! f1 (if f1 g2 g3))
-   \x00\x81\x1b\x81"; (set! f1 (lambda f1))
   0x81  ; f1
   0x00  ; nil
   0xfe  ; ctx

src/lib/primitive/and.rla

@@ -36,13 +36,12 @@
         )
       )
       "\xff"  ; k
-      2
+      1
-      "\x00\x80\x03\xfd\; (set! f0 (car argv))
+      "\x00\x80\x03\xfd"; (set! f0 (car argv))
-       \x00\x81\x1b\x01"; (set! f1 (lambda g1))
       0x80  ; f0
       0x00  ; nil
       0xfe  ; ctx
-      0x81  ; f1
+      0x01  ; g1
     )
     #t
   )

src/lib/primitive/foldl.rla

@@ -13,17 +13,6 @@
   ;      (lambda () (foldl fn (fn (car lst) init) (cdr lst))
   ;      (lambda () init))))
   #(
-    #S(#="template"
-      ; (lambda () init)
-      #(#f)
-      "\x81" ; f1
-      1
-      "\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
-      0xff  ; k
-      0x80  ; f0
-      0x01  ; g1
-      0x01  ; g1
-    )
     #S(#="template"
       ; (lambda ()
       ;   (let/cc k
@@ -53,26 +42,39 @@
       2
       "\x02\x80\x41\x00\; (set! f0 (cons i1 nil))
        \x00\x81\x03\x42\; (set! f1 (car i2))
-       \x02\x80\x81\x80\; (set! f0 (cons f1 f0))
+       \x02\x80\x81\x80"; (set! f0 (cons f1 f0))
-       \x00\x81\x1b\x01"; (set! f1 (lambda g1))
       0x40  ; i0
       0x80  ; f0
       0xfe  ; ctx
-      0x81  ; f1
+      0x01  ; g1
+    )
+    #S(#="template"
+      ; (lambda () init)
+      #(#f)
+      "\x81" ; f1
+      1
+      "\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
+      0xff  ; k
+      0x80  ; f0
+      0x01  ; g1
+      0x01  ; g1
     )
   )
   #()
-  4
+  6
   "\x00\x80\x03\xfd\; (set! f0 (car argv)) ; f0=fn
    \x00\x82\x04\xfd\; (set! f2 (cdr argv))
    \x00\x81\x03\x82\; (set! f1 (car f2))   ; f1=init
    \x00\x82\x04\x82\; (set! f2 (cdr f2))
    \x00\x82\x03\x82\; (set! f2 (car f2))   ; f2=lst
+   \x00\x84\x01\x01\; (set! f4 g1)
+   \x00\x85\x01\x00\; (set! f5 nil)
    \x00\x83\x0b\x82\; (set! f3 (pair? f2))
-   \x83\x83\x02\x01\; (set! f3 (if f3 g2 g1))
+   \x40\x83\x00\x00\; (goto-end-if f3)
-   \x00\x83\x1b\x83"; (set! f0 (lambda f3))
+   \x00\x84\x01\xff\; (set! f4 k)
-  0x83  ; f0
+   \x02\x85\x81\x00"; (set! f5 (cons f1 nil))
-  0x00  ; nil
+  0x84  ; f4
+  0x85  ; f5
   0xfe  ; ctx
   0xff  ; k
 )

src/lib/primitive/foldr.rla

@@ -15,17 +15,6 @@
   ;                     (foldr fn init (cdr lst))))
   ;      (lambda () init))))
   #(
-    #S(#="template"
-      ; (lambda () init)
-      #(#f)
-      "\x81" ; f1
-      1
-      "\x02\x80\x40\x00"; (set! f0 (cons i0 nil))
-      0xff  ; k
-      0x80  ; f0
-      0x01  ; g1
-      0x01  ; g1
-    )
     #S(#="template"
       ; (lambda ()
       ;   (let/cc k
@@ -50,31 +39,33 @@
         #=0  ; foldr
       )
       "\x80\x81\x82" ; f0=fn f1=init f2=lst
-      4
+      3
       "\x00\x80\x04\x42\; (set! f0 (cdr i2))
        \x00\x81\x03\x42\; (set! f1 (car i2))
-       \x00\x82\x1b\x01\; (set! f2 (lambda g1))
+       \x02\x82\x80\x00\; (set! f2 (cons f0 nil))
-       \x02\x83\x80\x00\; (set! f3 (cons f0 nil))
+       \x02\x82\x41\x82\; (set! f2 (cons i1 f2))
-       \x02\x83\x41\x83\; (set! f3 (cons i1 f3))
+       \x02\x82\x40\x82"; (set! f2 (cons i0 f2))
-       \x02\x83\x40\x83"; (set! f3 (cons i0 f3))
       0x02  ; g2
-      0x83  ; f3
-      0xfe  ; ctx
       0x82  ; f2
+      0xfe  ; ctx
+      0x01  ; g1
     )
   )
   #()
-  4
+  6
   "\x00\x80\x03\xfd\; (set! f0 (car argv)) ; f0=fn
    \x00\x82\x04\xfd\; (set! f2 (cdr argv))
    \x00\x81\x03\x82\; (set! f1 (car f2))   ; f1=init
    \x00\x82\x04\x82\; (set! f2 (cdr f2))
    \x00\x82\x03\x82\; (set! f2 (car f2))   ; f2=lst
+   \x00\x84\x01\x01\; (set! f4 g1)
+   \x00\x85\x01\x00\; (set! f5 nil)
    \x00\x83\x0b\x82\; (set! f3 (pair? f2))
-   \x83\x83\x02\x01\; (set! f3 (if f3 g2 g1))
+   \x40\x83\x00\x00\; (goto-end-if f3)
-   \x00\x83\x1b\x83"; (set! f3 (lambda f3))
+   \x00\x84\x01\xff\; (set! f4 k)
-  0x83  ; f3
+   \x02\x85\x81\x00"; (set! f5 (cons f1 nil))
-  0x00  ; nil
+  0x84  ; f4
+  0x85  ; f5
   0xfe  ; ctx
   0xff  ; k
 )