mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 14:49:18 +02:00
fixing tail-call bug when the new frame is larger.
allowing (error x) for any object x. vm tracing is now a compile-time option with -DDEBUG_VM.
This commit is contained in:
Alex Shinn
parent
b207ef5604
commit
ca9e391ee3
7 changed files with 52 additions and 58 deletions
6
Makefile
6
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 $@ $^
|
||||
|
|
|
|||
27
debug.c
27
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<top; i++) {
|
||||
sexp_printf(out, "%s %02d: ", ((i==fp) ? "*" : " "), i);
|
||||
|
|
|
|||
14
eval.c
14
eval.c
|
|
@ -242,6 +242,7 @@ static sexp sexp_make_context(sexp *stack, sexp env) {
|
|||
sexp_context_pos(res) = 0;
|
||||
sexp_context_top(res) = 0;
|
||||
sexp_context_tailp(res) = 0;
|
||||
sexp_context_tracep(res) = 0;
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -251,6 +252,7 @@ static sexp sexp_child_context(sexp context, sexp lambda) {
|
|||
sexp_context_lambda(ctx) = lambda;
|
||||
sexp_context_env(ctx) = sexp_context_env(context);
|
||||
sexp_context_top(ctx) = sexp_context_top(context);
|
||||
sexp_context_tracep(ctx) = sexp_context_tracep(context);
|
||||
return ctx;
|
||||
}
|
||||
|
||||
|
|
@ -991,8 +993,13 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
|
|||
sexp_sint_t i, j, k, fp=top-4;
|
||||
|
||||
loop:
|
||||
/* print_stack(stack, top, fp, env_global_ref(env, the_cur_err_symbol, SEXP_FALSE)); */
|
||||
/* fprintf(stderr, "%s\n", (*ip<=71)?reverse_opcode_names[*ip]:"UNKNOWN"); */
|
||||
#ifdef DEBUG_VM
|
||||
if (sexp_context_tracep(context)) {
|
||||
sexp_print_stack(stack, top, fp,
|
||||
env_global_ref(env, the_cur_err_symbol, SEXP_FALSE));
|
||||
fprintf(stderr, "%s\n", (*ip<=71)?reverse_opcode_names[*ip]:"UNKNOWN");
|
||||
}
|
||||
#endif
|
||||
switch (*ip++) {
|
||||
case OP_NOOP:
|
||||
fprintf(stderr, "<<<NOOP>>>\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<i; k++)
|
||||
stack[fp-j+k] = stack[top-1-i+k];
|
||||
top = fp+i-j+1;
|
||||
fp = sexp_unbox_integer(stack[fp+3]);
|
||||
fp = sexp_unbox_integer(tmp2);
|
||||
goto make_call;
|
||||
case OP_CALL:
|
||||
if (top >= INIT_STACK_SIZE)
|
||||
|
|
|
|||
1
main.c
1
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);
|
||||
|
|
|
|||
57
sexp.c
57
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;
|
||||
}
|
||||
|
|
|
|||
3
sexp.h
3
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 ****************************/
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue