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.
This commit is contained in:
parent
6dd02a5d6e
commit
f542fa2bd5
|
|
@ -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
|
||||
41 (set-car! in in) ; pair value
|
||||
42 (set-cdr! in in) ; pair value
|
||||
50 (set-box! in1 in2) ; box value
|
||||
51 (set-car! in1 in2) ; pair value
|
||||
52 (set-cdr! in1 in2) ; pair value
|
||||
|
||||
; ternary statements
|
||||
60 (vector-set! in in in) ; vector n value, 0 <= n < nelem
|
||||
61 (byte-string-set! in in in) ; string n value, 0 <= n < nbytes
|
||||
62 (struct-set! in in in) ; struct n value, 0 <= n < nslots
|
||||
60 (vector-set! in1 in2 in3) ; vector n value, 0 <= n < nelem
|
||||
61 (byte-string-set! in1 in2 in3) ; string n value, 0 <= n < nbytes
|
||||
62 (struct-set! in1 in2 in3) ; struct n value, 0 <= n < nslots
|
||||
|
||||
in:
|
||||
nil (00000000) [g0, always NIL]
|
||||
|
|
|
|||
29
interp.c
29
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;
|
||||
case 0x41: get_pair(ST1)->car = ST2; WRITE_BARRIER(ST1); break;
|
||||
case 0x42: get_pair(ST1)->cdr = ST2; WRITE_BARRIER(ST1); break;
|
||||
/* 0x40 and 0x41 (goto-end-if, goto-end-unless) are handled by run_byte_code() directly. */
|
||||
case 0x50: get_box(ST1)->value = 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."));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -52,20 +52,18 @@
|
|||
"\x80"
|
||||
2
|
||||
"\x09\x80\x40\x01\; (set! f0 (fix- i0 g1))
|
||||
\x02\x80\x80\x00\; (set! f0 (cons f0 nil))
|
||||
\x00\x81\x1b\x02"; (set! f1 (lambda g2))
|
||||
\x02\x80\x80\x00"; (set! f0 (cons f0 nil))
|
||||
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))
|
||||
\x00\x81\x1b\x81"; (set! f1 (lambda f1))
|
||||
\x81\x81\x02\x03"; (set! f1 (if f1 g2 g3))
|
||||
0x81 ; f1
|
||||
0x00 ; nil
|
||||
0xfe ; ctx
|
||||
|
|
|
|||
|
|
@ -36,13 +36,12 @@
|
|||
)
|
||||
)
|
||||
"\xff" ; k
|
||||
2
|
||||
"\x00\x80\x03\xfd\; (set! f0 (car argv))
|
||||
\x00\x81\x1b\x01"; (set! f1 (lambda g1))
|
||||
1
|
||||
"\x00\x80\x03\xfd"; (set! f0 (car argv))
|
||||
0x80 ; f0
|
||||
0x00 ; nil
|
||||
0xfe ; ctx
|
||||
0x81 ; f1
|
||||
0x01 ; g1
|
||||
)
|
||||
#t
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
\x00\x81\x1b\x01"; (set! f1 (lambda g1))
|
||||
\x02\x80\x81\x80"; (set! f0 (cons f1 f0))
|
||||
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))
|
||||
\x00\x83\x1b\x83"; (set! f0 (lambda f3))
|
||||
0x83 ; f0
|
||||
0x00 ; nil
|
||||
\x40\x83\x00\x00\; (goto-end-if f3)
|
||||
\x00\x84\x01\xff\; (set! f4 k)
|
||||
\x02\x85\x81\x00"; (set! f5 (cons f1 nil))
|
||||
0x84 ; f4
|
||||
0x85 ; f5
|
||||
0xfe ; ctx
|
||||
0xff ; k
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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\x83\x80\x00\; (set! f3 (cons f0 nil))
|
||||
\x02\x83\x41\x83\; (set! f3 (cons i1 f3))
|
||||
\x02\x83\x40\x83"; (set! f3 (cons i0 f3))
|
||||
\x02\x82\x80\x00\; (set! f2 (cons f0 nil))
|
||||
\x02\x82\x41\x82\; (set! f2 (cons i1 f2))
|
||||
\x02\x82\x40\x82"; (set! f2 (cons i0 f2))
|
||||
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))
|
||||
\x00\x83\x1b\x83"; (set! f3 (lambda f3))
|
||||
0x83 ; f3
|
||||
0x00 ; nil
|
||||
\x40\x83\x00\x00\; (goto-end-if f3)
|
||||
\x00\x84\x01\xff\; (set! f4 k)
|
||||
\x02\x85\x81\x00"; (set! f5 (cons f1 nil))
|
||||
0x84 ; f4
|
||||
0x85 ; f5
|
||||
0xfe ; ctx
|
||||
0xff ; k
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in New Issue