From 9af5279e6f628dd0ba1cd7f6ca94f86c5845b5c8 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 16 Mar 2009 19:26:06 +0900 Subject: [PATCH] fixing stack offsets for mutated variables --- eval.c | 31 ++++++++++++++++--------------- sexp.c | 20 +++++++++++++++----- tests/test05-letrec.scm | 6 +++--- tests/test06-mutation.scm | 1 - 4 files changed, 34 insertions(+), 24 deletions(-) diff --git a/eval.c b/eval.c index 9279dbf2..9da6bb0e 100644 --- a/eval.c +++ b/eval.c @@ -608,15 +608,14 @@ sexp make_opcode_procedure(sexp op, sexp_uint_t i, sexp e) { } sexp compile(sexp params, sexp obj, sexp e, sexp fv, sexp sv, int done_p) { - sexp_uint_t i=0, d=0, define_ok=1, core; - sexp_sint_t j=0; + sexp_uint_t i=0, j=0, d=0, define_ok=1, core; sexp bc = (sexp) SEXP_ALLOC(sexp_sizeof(bytecode)+INIT_BCODE_SIZE); sexp sv2 = set_vars(e, params, obj, SEXP_NULL), internals=SEXP_NULL, ls; bc->tag = SEXP_BYTECODE; sexp_bytecode_length(bc) = INIT_BCODE_SIZE; /* box mutable vars */ - for (ls=params; sexp_pairp(ls); ls=sexp_cdr(ls)) { - if ((j = sexp_list_index(sv2, sexp_car(ls))) >= 0) { + for (ls=params, j=0; sexp_pairp(ls); ls=sexp_cdr(ls), j++) { + if (sexp_list_index(sv2, sexp_car(ls)) >= 0) { emit_push(&bc, &i, SEXP_NULL); emit(&bc, &i, OP_STACK_REF); emit_word(&bc, &i, j+5); @@ -795,19 +794,21 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { case OP_EOFP: _ARG1 = sexp_make_boolean(_ARG1 == SEXP_EOF); break; case OP_CAR: - if (! sexp_pairp(_ARG1)) sexp_raise("not a pair", sexp_list1(_ARG1)); + if (! sexp_pairp(_ARG1)) sexp_raise("car: not a pair", sexp_list1(_ARG1)); _ARG1 = sexp_car(_ARG1); break; case OP_CDR: - if (! sexp_pairp(_ARG1)) sexp_raise("not a pair", sexp_list1(_ARG1)); + if (! sexp_pairp(_ARG1)) sexp_raise("cdr: not a pair", sexp_list1(_ARG1)); _ARG1 = sexp_cdr(_ARG1); break; case OP_SET_CAR: - if (! sexp_pairp(_ARG1)) sexp_raise("not a pair", sexp_list1(_ARG1)); + if (! sexp_pairp(_ARG1)) + sexp_raise("set-car!: not a pair", sexp_list1(_ARG1)); sexp_car(_ARG1) = _ARG2; _ARG2 = SEXP_UNDEF; top--; break; case OP_SET_CDR: - if (! sexp_pairp(_ARG1)) sexp_raise("not a pair", sexp_list1(_ARG1)); + if (! sexp_pairp(_ARG1)) + sexp_raise("set-cdr!: not a pair", sexp_list1(_ARG1)); sexp_cdr(_ARG1) = _ARG2; _ARG2 = SEXP_UNDEF; top--; @@ -827,7 +828,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_add(sexp_integer_to_flonum(_ARG1), _ARG2); #endif - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("+: not a number", sexp_list2(_ARG1, _ARG2)); top--; break; case OP_SUB: @@ -841,7 +842,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_sub(sexp_integer_to_flonum(_ARG1), _ARG2); #endif - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("-: not a number", sexp_list2(_ARG1, _ARG2)); top--; break; case OP_MUL: @@ -855,7 +856,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_mul(sexp_integer_to_flonum(_ARG1), _ARG2); #endif - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("*: not a number", sexp_list2(_ARG1, _ARG2)); top--; break; case OP_DIV: @@ -870,7 +871,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { else if (sexp_integerp(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_div(sexp_integer_to_flonum(_ARG1), _ARG2); #endif - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("/: not a number", sexp_list2(_ARG1, _ARG2)); top--; break; case OP_QUOT: @@ -878,14 +879,14 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { _ARG2 = sexp_fx_div(_ARG1, _ARG2); top--; } - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("quotient: not a number", sexp_list2(_ARG1, _ARG2)); break; case OP_MOD: if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) { _ARG2 = sexp_fx_mod(_ARG1, _ARG2); top--; } - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("modulo: not a number", sexp_list2(_ARG1, _ARG2)); break; case OP_NEG: if (sexp_integerp(_ARG1)) @@ -894,7 +895,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) { else if (sexp_flonump(_ARG1)) _ARG1 = sexp_make_flonum(-sexp_flonum_value(_ARG1)); #endif - else sexp_raise("not a number", sexp_list2(_ARG1, _ARG2)); + else sexp_raise("-: not a number", sexp_list1(_ARG1)); break; case OP_LT: _ARG2 = sexp_make_boolean(_ARG1 < _ARG2); diff --git a/sexp.c b/sexp.c index e6580236..ba515524 100644 --- a/sexp.c +++ b/sexp.c @@ -92,7 +92,8 @@ sexp sexp_make_exception(sexp kind, sexp message, sexp irritants, } sexp sexp_print_exception(sexp exn, sexp out) { - sexp_write_string("error", out); + sexp ls; + sexp_write_string("ERROR", out); if (sexp_integerp(sexp_exception_line(exn)) && sexp_exception_line(exn) > sexp_make_integer(0)) { sexp_write_string(" on line ", out); @@ -104,11 +105,20 @@ sexp sexp_print_exception(sexp exn, sexp out) { } sexp_write_string(": ", out); sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out); - sexp_write_string("\n", out); if (sexp_pairp(sexp_exception_irritants(exn))) { - sexp_write_string(" irritants: ", out); - sexp_write(sexp_exception_irritants(exn), out); - sexp_write_string("\n", out); + if (sexp_nullp(sexp_cdr(sexp_exception_irritants(exn)))) { + sexp_write_string(": ", out); + sexp_write(sexp_car(sexp_exception_irritants(exn)), out); + sexp_write_string("\n", out); + } else { + sexp_write_string("\n", out); + for (ls=sexp_exception_irritants(exn); + sexp_pairp(ls); ls=sexp_cdr(ls)) { + sexp_write_string(" ", out); + sexp_write(sexp_car(ls), out); + sexp_write_string("\n", out); + } + } } return SEXP_UNDEF; } diff --git a/tests/test05-letrec.scm b/tests/test05-letrec.scm index 62b1e078..fd3a9fa2 100644 --- a/tests/test05-letrec.scm +++ b/tests/test05-letrec.scm @@ -16,11 +16,11 @@ ((lambda (even? odd?) (set! even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) (set! odd? (lambda (n) (if (zero? n) #f (even? (- n 1))))) - (write (even? 1000)) + (write (even? 100)) (newline) - (write (even? 1001)) + (write (even? 101)) (newline) - (write (odd? 1000)) + (write (odd? 100)) (newline) ) 'even 'odd) diff --git a/tests/test06-mutation.scm b/tests/test06-mutation.scm index 7be0f055..8dacb7fb 100644 --- a/tests/test06-mutation.scm +++ b/tests/test06-mutation.scm @@ -7,4 +7,3 @@ (set! e 10000) (write (+ e (* c 1000) (* a 100) (* b 10) d)) (newline))) -