diff --git a/doc/bytecode.txt b/doc/bytecode.txt index 41beaf4..0d6fa94 100644 --- a/doc/bytecode.txt +++ b/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 - 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] diff --git a/interp.c b/interp.c index 5795b6c..18d90e5 100644 --- a/interp.c +++ b/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.")); } } diff --git a/src/lib/math/fact.rla b/src/lib/math/fact.rla index 45455e9..fbea33c 100755 --- a/src/lib/math/fact.rla +++ b/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)) - \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 diff --git a/src/lib/primitive/and.rla b/src/lib/primitive/and.rla index 01bc86f..4daf725 100644 --- a/src/lib/primitive/and.rla +++ b/src/lib/primitive/and.rla @@ -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 ) diff --git a/src/lib/primitive/foldl.rla b/src/lib/primitive/foldl.rla index 3f5bfa3..f02457c 100644 --- a/src/lib/primitive/foldl.rla +++ b/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)) - \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 ) diff --git a/src/lib/primitive/foldr.rla b/src/lib/primitive/foldr.rla index 1003816..69d1126 100644 --- a/src/lib/primitive/foldr.rla +++ b/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\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 )