diff --git a/Makefile b/Makefile index 4224566f..eac74288 100644 --- a/Makefile +++ b/Makefile @@ -19,13 +19,13 @@ GC_OBJ=./gc/gc.a cd gc && make test sexp.o: sexp.c sexp.h config.h defaults.h Makefile - gcc -c $(CFLAGS) -o $@ $< + gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $< eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile - gcc -c $(CFLAGS) -o $@ $< + gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $< main.o: main.c eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile - gcc -c $(CFLAGS) -o $@ $< + gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $< libchibisexp.$(SO): sexp.o $(GC_OBJ) gcc $(LDFLAGS) -shared -dynamiclib -o $@ $^ diff --git a/debug.c b/debug.c index 8e0936fa..299b20cc 100644 --- a/debug.c +++ b/debug.c @@ -61,32 +61,7 @@ static sexp sexp_disasm (sexp bc, sexp out) { return SEXP_VOID; } -static void print_bytecode (sexp bc) { - int i; - unsigned char *data = sexp_bytecode_data(bc); - fprintf(stderr, "bytecode @ %p, data @ %p, length = %lu\n", - bc, data, sexp_bytecode_length(bc)); - for (i=0; i+16 < sexp_bytecode_length(bc); i+=8) { - fprintf(stderr, "%02x: %02x %02x %02x %02x %02x %02x %02x %02x ", i, - data[i], data[i+1], data[i+2], data[i+3], - data[i+4], data[i+5], data[i+6], data[i+7]); - i += 8; - fprintf(stderr, "%02x %02x %02x %02x %02x %02x %02x %02x\n", - data[i], data[i+1], data[i+2], data[i+3], - data[i+4], data[i+5], data[i+6], data[i+7]); - } - if (i != sexp_bytecode_length(bc)) { - fprintf(stderr, "%02x:", i); - for ( ; i < sexp_bytecode_length(bc); i++) { - if ((i % 8) == 0 && (i % 16) != 0) - fprintf(stderr, " "); - fprintf(stderr, " %02x", data[i]); - } - fprintf(stderr, "\n"); - } -} - -static void print_stack (sexp *stack, int top, int fp, sexp out) { +static void sexp_print_stack (sexp *stack, int top, int fp, sexp out) { int i; for (i=0; i>>\n"); @@ -1050,6 +1057,7 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) { i = sexp_unbox_integer(_WORD0); /* number of params */ tmp1 = _ARG1; /* procedure to call */ /* save frame info */ + tmp2 = stack[fp+3]; j = sexp_unbox_integer(stack[fp]); ip = ((unsigned char*) sexp_unbox_integer(stack[fp+1])) - sizeof(sexp); cp = stack[fp+2]; @@ -1057,7 +1065,7 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) { for (k=0; k= INIT_STACK_SIZE) diff --git a/main.c b/main.c index 938d2918..1b14ee97 100644 --- a/main.c +++ b/main.c @@ -4,6 +4,7 @@ void repl (sexp context) { sexp obj, res, env, in, out, err; env = sexp_context_env(context); + sexp_context_tracep(context) = 1; in = env_global_ref(env, the_cur_in_symbol, SEXP_FALSE); out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE); err = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE); diff --git a/sexp.c b/sexp.c index 688f6938..531f1b32 100644 --- a/sexp.c +++ b/sexp.c @@ -118,34 +118,43 @@ sexp sexp_range_exception (sexp obj, sexp start, sexp end) { sexp sexp_print_exception (sexp exn, sexp 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); - sexp_write(sexp_exception_line(exn), out); - } - if (sexp_stringp(sexp_exception_file(exn))) { - sexp_write_string(" of file ", out); - sexp_write_string(sexp_string_data(sexp_exception_file(exn)), out); - } - sexp_write_string(": ", out); - sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out); - if (sexp_exception_irritants(exn) - && sexp_pairp(sexp_exception_irritants(exn))) { - 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); + if (sexp_exceptionp(exn)) { + if (sexp_integerp(sexp_exception_line(exn)) + && (sexp_exception_line(exn) > sexp_make_integer(0))) { + sexp_write_string(" on line ", out); + sexp_write(sexp_exception_line(exn), out); + } + if (sexp_stringp(sexp_exception_file(exn))) { + sexp_write_string(" of file ", out); + sexp_write_string(sexp_string_data(sexp_exception_file(exn)), out); + } + sexp_write_string(": ", out); + sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out); + if (sexp_exception_irritants(exn) + && sexp_pairp(sexp_exception_irritants(exn))) { + 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_char('\n', out); + } } + } else { + sexp_write_char('\n', out); } } else { - sexp_write_string("\n", out); + sexp_write_string(": ", out); + if (sexp_stringp(exn)) + sexp_write_string(sexp_string_data(exn), out); + else + sexp_write(exn, out); + sexp_write_char('\n', out); } return SEXP_VOID; } diff --git a/sexp.h b/sexp.h index 4dc7cd9a..9784795f 100644 --- a/sexp.h +++ b/sexp.h @@ -160,7 +160,7 @@ struct sexp_struct { /* compiler state */ struct { sexp bc, lambda, *stack, env; - sexp_uint_t pos, top, depth, tailp; + sexp_uint_t pos, top, depth, tailp, tracep; } context; } value; }; @@ -340,6 +340,7 @@ struct sexp_struct { #define sexp_context_top(x) ((x)->value.context.top) #define sexp_context_lambda(x) ((x)->value.context.lambda) #define sexp_context_tailp(x) ((x)->value.context.tailp) +#define sexp_context_tracep(x) ((x)->value.context.tailp) /****************************** arithmetic ****************************/ diff --git a/syntax-rules.scm b/syntax-rules.scm index 2433718e..f323a979 100644 --- a/syntax-rules.scm +++ b/syntax-rules.scm @@ -168,7 +168,7 @@ (map (lambda (clause) (expand-pattern (car clause) (cadr clause))) forms) - (list (list 'else) (list 'error "no expansion")))))))))) + (list (list 'error "no expansion")))))))))) ;; Local Variables: ;; eval: (put '_lambda 'scheme-indent-function 1)