mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-19 10:47:33 +02:00
Various fixes for better debug output.
* Associate file/line source info with corresponding bytecode offset. * Fixes for losing source info after macro expansion and simplification. * Fix for showing the source info of the calling procedure of an error.
This commit is contained in:
Alex Shinn
parent
4a8c8a3a75
commit
3e79138e21
8 changed files with 159 additions and 26 deletions
36
eval.c
36
eval.c
|
|
@ -248,6 +248,8 @@ void sexp_shrink_bcode (sexp ctx, sexp_uint_t i) {
|
|||
sexp_bytecode_length(tmp) = i;
|
||||
sexp_bytecode_literals(tmp)
|
||||
= sexp_bytecode_literals(sexp_context_bc(ctx));
|
||||
sexp_bytecode_source(tmp)
|
||||
= sexp_bytecode_source(sexp_context_bc(ctx));
|
||||
memcpy(sexp_bytecode_data(tmp),
|
||||
sexp_bytecode_data(sexp_context_bc(ctx)),
|
||||
i);
|
||||
|
|
@ -265,6 +267,8 @@ void sexp_expand_bcode (sexp ctx, sexp_uint_t size) {
|
|||
= sexp_bytecode_length(sexp_context_bc(ctx))*2;
|
||||
sexp_bytecode_literals(tmp)
|
||||
= sexp_bytecode_literals(sexp_context_bc(ctx));
|
||||
sexp_bytecode_source(tmp)
|
||||
= sexp_bytecode_source(sexp_context_bc(ctx));
|
||||
memcpy(sexp_bytecode_data(tmp),
|
||||
sexp_bytecode_data(sexp_context_bc(ctx)),
|
||||
sexp_bytecode_length(sexp_context_bc(ctx)));
|
||||
|
|
@ -290,6 +294,12 @@ sexp sexp_complete_bytecode (sexp ctx) {
|
|||
else
|
||||
sexp_bytecode_literals(bc) = sexp_list_to_vector(ctx, sexp_bytecode_literals(bc));
|
||||
}
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if (sexp_bytecode_source(bc) && sexp_pairp(sexp_bytecode_source(bc))) {
|
||||
sexp_bytecode_source(bc) = sexp_nreverse(ctx, sexp_bytecode_source(bc));
|
||||
sexp_bytecode_source(bc) = sexp_list_to_vector(ctx, sexp_bytecode_source(bc));
|
||||
}
|
||||
#endif
|
||||
sexp_bless_bytecode(ctx, bc);
|
||||
return bc;
|
||||
}
|
||||
|
|
@ -550,6 +560,7 @@ static sexp analyze_app (sexp ctx, sexp x) {
|
|||
res = tmp;
|
||||
break;
|
||||
} else {
|
||||
sexp_pair_source(res) = sexp_pair_source(x);
|
||||
sexp_car(res) = tmp;
|
||||
}
|
||||
}
|
||||
|
|
@ -575,6 +586,7 @@ static sexp analyze_seq (sexp ctx, sexp ls) {
|
|||
res = analyze(ctx, sexp_car(ls));
|
||||
else {
|
||||
res = sexp_alloc_type(ctx, seq, SEXP_SEQ);
|
||||
sexp_seq_source(res) = sexp_pair_source(ls);
|
||||
tmp = analyze_app(ctx, ls);
|
||||
if (sexp_exceptionp(tmp))
|
||||
res = tmp;
|
||||
|
|
@ -599,10 +611,11 @@ static sexp analyze_var_ref (sexp ctx, sexp x, sexp *varenv) {
|
|||
}
|
||||
cell = sexp_env_cell_create(ctx, env, x, SEXP_UNDEF, varenv);
|
||||
}
|
||||
if (sexp_macrop(sexp_cdr(cell)) || sexp_corep(sexp_cdr(cell)))
|
||||
if (sexp_macrop(sexp_cdr(cell)) || sexp_corep(sexp_cdr(cell))) {
|
||||
res = sexp_compile_error(ctx, "invalid use of syntax as value", x);
|
||||
else
|
||||
} else {
|
||||
res = sexp_make_ref(ctx, x, cell);
|
||||
}
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
|
@ -619,15 +632,17 @@ static sexp analyze_set (sexp ctx, sexp x) {
|
|||
if (sexp_lambdap(sexp_ref_loc(ref)))
|
||||
sexp_insert(ctx, sexp_lambda_sv(sexp_ref_loc(ref)), sexp_ref_name(ref));
|
||||
value = analyze(ctx, sexp_caddr(x));
|
||||
if (sexp_exceptionp(ref))
|
||||
if (sexp_exceptionp(ref)) {
|
||||
res = ref;
|
||||
else if (sexp_exceptionp(value))
|
||||
} else if (sexp_exceptionp(value)) {
|
||||
res = value;
|
||||
else if (sexp_immutablep(sexp_ref_cell(ref))
|
||||
|| (varenv && sexp_immutablep(varenv)))
|
||||
} else if (sexp_immutablep(sexp_ref_cell(ref))
|
||||
|| (varenv && sexp_immutablep(varenv))) {
|
||||
res = sexp_compile_error(ctx, "immutable binding", sexp_cadr(x));
|
||||
else
|
||||
} else {
|
||||
res = sexp_make_set(ctx, ref, value);
|
||||
sexp_set_source(res) = sexp_pair_source(x);
|
||||
}
|
||||
}
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
|
|
@ -712,6 +727,7 @@ static sexp analyze_if (sexp ctx, sexp x) {
|
|||
fail = analyze(ctx, fail_expr);
|
||||
res = (sexp_exceptionp(test) ? test : sexp_exceptionp(pass) ? pass :
|
||||
sexp_exceptionp(fail) ? fail : sexp_make_cnd(ctx, test, pass, fail));
|
||||
if (sexp_cndp(res)) sexp_cnd_source(res) = sexp_pair_source(x);
|
||||
}
|
||||
sexp_gc_release3(ctx);
|
||||
return res;
|
||||
|
|
@ -758,6 +774,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
|
|||
} else {
|
||||
if (sexp_lambdap(value)) sexp_lambda_name(value) = name;
|
||||
res = sexp_make_set(ctx, ref, value);
|
||||
if (sexp_setp(res)) sexp_set_source(res) = sexp_pair_source(x);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -908,8 +925,11 @@ static sexp analyze (sexp ctx, sexp object) {
|
|||
res = sexp_compile_error(ctx, "too many args for opcode", x);
|
||||
} else {
|
||||
res = analyze_app(ctx, sexp_cdr(x));
|
||||
if (! sexp_exceptionp(res))
|
||||
if (! sexp_exceptionp(res)) {
|
||||
sexp_push(ctx, res, op);
|
||||
if (sexp_pairp(res))
|
||||
sexp_pair_source(res) = sexp_pair_source(x);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
res = analyze_app(ctx, x);
|
||||
|
|
|
|||
|
|
@ -48,6 +48,10 @@ enum sexp_opcode_classes {
|
|||
|
||||
SEXP_API struct sexp_opcode_struct* sexp_primitive_opcodes;
|
||||
|
||||
#if SEXP_USE_DEBUG_VM || SEXP_USE_PROFILE_VM || SEXP_USE_STATIC_LIBS
|
||||
SEXP_API const char** sexp_opcode_names;
|
||||
#endif
|
||||
|
||||
/**************************** prototypes ******************************/
|
||||
|
||||
SEXP_API void sexp_scheme_init (void);
|
||||
|
|
|
|||
|
|
@ -33,6 +33,13 @@
|
|||
/* to your needs. */
|
||||
/* #define SEXP_USE_STATIC_LIBS 1 */
|
||||
|
||||
/* uncomment this to disable detailed source info for debugging */
|
||||
/* By default Chibi will associate source info with every */
|
||||
/* bytecode offset. By disabling this only lambda-level source */
|
||||
/* info will be recorded (the line of the opening paren for the */
|
||||
/* lambda). */
|
||||
/* #define SEXP_USE_FULL_SOURCE_INFO 0 */
|
||||
|
||||
/* uncomment this to disable a simplifying optimization pass */
|
||||
/* This performs some simple optimizations such as dead-code */
|
||||
/* elimination, constant-folding, and directly propagating */
|
||||
|
|
@ -309,6 +316,10 @@
|
|||
#define SEXP_USE_STATIC_LIBS 0
|
||||
#endif
|
||||
|
||||
#ifndef SEXP_USE_FULL_SOURCE_INFO
|
||||
#define SEXP_USE_FULL_SOURCE_INFO ! SEXP_USE_NO_FEATURES
|
||||
#endif
|
||||
|
||||
#ifndef SEXP_USE_SIMPLIFY
|
||||
#define SEXP_USE_SIMPLIFY ! SEXP_USE_NO_FEATURES
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* disasm.c -- optional debugging utilities */
|
||||
/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "chibi/eval.h"
|
||||
|
|
@ -30,8 +30,12 @@ static void sexp_write_integer (sexp ctx, sexp_sint_t n, sexp out) {
|
|||
|
||||
static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
|
||||
unsigned char *ip, opcode, i;
|
||||
sexp tmp=NULL;
|
||||
sexp tmp=NULL, src;
|
||||
sexp_sint_t *labels, label=1, off;
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
sexp src_here=NULL;
|
||||
sexp_sint_t src_off=0;
|
||||
#endif
|
||||
|
||||
if (sexp_procedurep(bc)) {
|
||||
bc = sexp_procedure_code(bc);
|
||||
|
|
@ -46,6 +50,8 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
|
|||
return sexp_type_exception(ctx, self, SEXP_OPORT, out);
|
||||
}
|
||||
|
||||
src = sexp_bytecode_source(bc);
|
||||
|
||||
for (i=0; i<(depth*SEXP_DISASM_PAD_WIDTH); i++)
|
||||
sexp_write_char(ctx, ' ', out);
|
||||
sexp_write_string(ctx, " -------------- ", out);
|
||||
|
|
@ -54,6 +60,17 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
|
|||
sexp_write_char(ctx, ' ', out);
|
||||
}
|
||||
sexp_write_pointer(ctx, bc, out);
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if (!(src && sexp_vectorp(src)))
|
||||
src_off = -1;
|
||||
/* if (src) sexp_write(ctx, src, out); */
|
||||
#else
|
||||
if (src && sexp_pair(src)) {
|
||||
sexp_write(ctx, sexp_car(src), out);
|
||||
sexp_write_string(ctx, ":", out);
|
||||
sexp_write(ctx, sexp_cdr(src), out);
|
||||
}
|
||||
#endif
|
||||
sexp_newline(ctx, out);
|
||||
|
||||
/* build a table of labels that are jumped to */
|
||||
|
|
@ -107,13 +124,24 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
|
|||
if (labels[ip - sexp_bytecode_data(bc)] < 10)
|
||||
sexp_write_char(ctx, ' ', out);
|
||||
}
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if ((src_off >= 0)
|
||||
&& ((ip-sexp_bytecode_data(bc))
|
||||
== sexp_unbox_fixnum(
|
||||
sexp_car(sexp_vector_ref(src, sexp_make_fixnum(src_off)))))) {
|
||||
src_here = sexp_cdr(sexp_vector_ref(src, sexp_make_fixnum(src_off)));
|
||||
src_off = src_off < sexp_vector_length(src)-1 ? src_off + 1 : -1;
|
||||
} else {
|
||||
src_here = NULL;
|
||||
}
|
||||
#endif
|
||||
opcode = *ip++;
|
||||
if (opcode*sizeof(char*) < sizeof(reverse_opcode_names)) {
|
||||
if (opcode < SEXP_OP_NUM_OPCODES) {
|
||||
sexp_write_char(ctx, ' ', out);
|
||||
sexp_write_string(ctx, reverse_opcode_names[opcode], out);
|
||||
sexp_write_string(ctx, sexp_opcode_names[opcode], out);
|
||||
sexp_write_char(ctx, ' ', out);
|
||||
} else {
|
||||
sexp_write_string(ctx, " <unknown> ", out);
|
||||
sexp_write_string(ctx, " <invalid> ", out);
|
||||
sexp_write(ctx, sexp_make_fixnum(opcode), out);
|
||||
sexp_write_char(ctx, ' ', out);
|
||||
}
|
||||
|
|
@ -179,6 +207,14 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
|
|||
ip += sizeof(sexp);
|
||||
break;
|
||||
}
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if (src_here && sexp_pairp(src_here)) {
|
||||
sexp_write_string(ctx, " ; ", out);
|
||||
sexp_write(ctx, sexp_car(src_here), out);
|
||||
sexp_write_string(ctx, ":", out);
|
||||
sexp_write(ctx, sexp_cdr(src_here), out);
|
||||
}
|
||||
#endif
|
||||
sexp_write_char(ctx, '\n', out);
|
||||
if ((opcode == SEXP_OP_PUSH || opcode == SEXP_OP_MAKE_PROCEDURE)
|
||||
&& (depth < SEXP_DISASM_MAX_DEPTH)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
static const char* reverse_opcode_names[] =
|
||||
static const char* sexp_opcode_names_[] =
|
||||
{"NOOP", "RAISE", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL",
|
||||
"FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "FCALLN",
|
||||
"JUMP-UNLESS", "JUMP", "PUSH", "RESERVE", "DROP",
|
||||
|
|
@ -20,3 +20,5 @@ static const char* reverse_opcode_names[] =
|
|||
"WRITE-CHAR", "WRITE-STRING", "READ-CHAR", "PEEK-CHAR",
|
||||
"YIELD", "FORCE", "RET", "DONE",
|
||||
};
|
||||
|
||||
const char** sexp_opcode_names = sexp_opcode_names_;
|
||||
|
|
|
|||
|
|
@ -25,8 +25,11 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
|
|||
substs list */
|
||||
app = sexp_list1(ctx, sexp_lambdap(sexp_car(res)) ? sexp_car(res)
|
||||
: (tmp=simplify(ctx, sexp_car(res), substs, lambda)));
|
||||
for (ls1=sexp_cdr(res); sexp_pairp(ls1); ls1=sexp_cdr(ls1))
|
||||
sexp_pair_source(app) = sexp_pair_source(res);
|
||||
for (ls1=sexp_cdr(res); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
|
||||
sexp_push(ctx, app, tmp=simplify(ctx, sexp_car(ls1), substs, lambda));
|
||||
if (sexp_pairp(app)) sexp_pair_source(app) = sexp_pair_source(ls1);
|
||||
}
|
||||
app = sexp_nreverse(ctx, app);
|
||||
/* app now holds a copy of the list, and is the default result
|
||||
(res = app below) if we don't replace it with a simplification */
|
||||
|
|
|
|||
6
sexp.c
6
sexp.c
|
|
@ -1801,6 +1801,12 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
|
|||
sexp_write_string(ctx, "#<procedure ", out);
|
||||
x = sexp_bytecode_name(sexp_procedure_code(obj));
|
||||
sexp_write_one(ctx, sexp_synclop(x) ? sexp_synclo_expr(x): x, out);
|
||||
#if SEXP_USE_DEBUG_VM
|
||||
if (sexp_procedure_source(obj)) {
|
||||
sexp_write_string(ctx, " ", out);
|
||||
sexp_write(ctx, sexp_procedure_source(obj), out);
|
||||
}
|
||||
#endif
|
||||
sexp_write_string(ctx, ">", out);
|
||||
break;
|
||||
case SEXP_TYPE:
|
||||
|
|
|
|||
73
vm.c
73
vm.c
|
|
@ -23,12 +23,25 @@ static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out)
|
|||
}
|
||||
}
|
||||
#else
|
||||
#define sexp_print_stack(ctx, stacl, top, fp, out)
|
||||
#define sexp_print_stack(ctx, stack, top, fp, out)
|
||||
#endif
|
||||
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
static sexp sexp_lookup_source_info (sexp src, int ip) {
|
||||
int i;
|
||||
if (sexp_vectorp(src) && sexp_vector_length(src) > 0) {
|
||||
for (i=1; i<sexp_vector_length(src); i++)
|
||||
if (sexp_unbox_fixnum(sexp_car(sexp_vector_ref(src, sexp_make_fixnum(i)))) > ip)
|
||||
return sexp_cdr(sexp_vector_ref(src, sexp_make_fixnum(i-1)));
|
||||
return sexp_cdr(sexp_vector_ref(src, sexp_make_fixnum(sexp_vector_length(src)-1)));
|
||||
}
|
||||
return SEXP_FALSE;
|
||||
}
|
||||
#endif
|
||||
|
||||
void sexp_stack_trace (sexp ctx, sexp out) {
|
||||
int i, fp=sexp_context_last_fp(ctx);
|
||||
sexp self, bc, ls, *stack=sexp_stack_data(sexp_context_stack(ctx));
|
||||
sexp self, bc, src, *stack=sexp_stack_data(sexp_context_stack(ctx));
|
||||
if (! sexp_oportp(out))
|
||||
out = sexp_current_error_port(ctx);
|
||||
for (i=fp; i>4; i=sexp_unbox_fixnum(stack[i+3])) {
|
||||
|
|
@ -40,14 +53,19 @@ void sexp_stack_trace (sexp ctx, sexp out) {
|
|||
sexp_write(ctx, sexp_bytecode_name(bc), out);
|
||||
else
|
||||
sexp_write_string(ctx, "<anonymous>", out);
|
||||
if ((ls=sexp_bytecode_source(bc)) && sexp_pairp(ls)) {
|
||||
if (sexp_fixnump(sexp_cdr(ls)) && (sexp_cdr(ls) >= SEXP_ZERO)) {
|
||||
src = sexp_bytecode_source(bc);
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if (sexp_vectorp(src))
|
||||
src = sexp_lookup_source_info(src, sexp_unbox_fixnum(stack[i+3]));
|
||||
#endif
|
||||
if (sexp_pairp(src)) {
|
||||
if (sexp_fixnump(sexp_cdr(src)) && (sexp_cdr(src) >= SEXP_ZERO)) {
|
||||
sexp_write_string(ctx, " on line ", out);
|
||||
sexp_write(ctx, sexp_cdr(ls), out);
|
||||
sexp_write(ctx, sexp_cdr(src), out);
|
||||
}
|
||||
if (sexp_stringp(sexp_car(ls))) {
|
||||
if (sexp_stringp(sexp_car(src))) {
|
||||
sexp_write_string(ctx, " of file ", out);
|
||||
sexp_write_string(ctx, sexp_string_data(sexp_car(ls)), out);
|
||||
sexp_write_string(ctx, sexp_string_data(sexp_car(src)), out);
|
||||
}
|
||||
}
|
||||
sexp_write_char(ctx, '\n', out);
|
||||
|
|
@ -88,6 +106,27 @@ void sexp_emit_return (sexp ctx) {
|
|||
sexp_emit(ctx, SEXP_OP_RET);
|
||||
}
|
||||
|
||||
static void sexp_push_source (sexp ctx, sexp source) {
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
sexp src, bc = sexp_context_bc(ctx);
|
||||
sexp_gc_var1(tmp);
|
||||
if (source && sexp_pairp(source)) {
|
||||
src = sexp_bytecode_source(bc);
|
||||
if (!src) src = sexp_bytecode_source(bc) = SEXP_NULL;
|
||||
if (!sexp_pairp(src)
|
||||
|| sexp_context_pos(ctx) > sexp_unbox_fixnum(sexp_caar(src))) {
|
||||
sexp_gc_preserve1(ctx, tmp);
|
||||
tmp = sexp_cons(ctx, sexp_make_fixnum(sexp_context_pos(ctx)), source);
|
||||
if (sexp_pairp(tmp)) {
|
||||
tmp = sexp_cons(ctx, tmp, src);
|
||||
if (sexp_pairp(tmp)) sexp_bytecode_source(bc) = tmp;
|
||||
}
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static sexp_sint_t sexp_context_make_label (sexp ctx) {
|
||||
sexp_sint_t label;
|
||||
sexp_context_align_pos(ctx);
|
||||
|
|
@ -120,6 +159,7 @@ static void generate_drop_prev (sexp ctx, sexp prev) {
|
|||
static void generate_seq (sexp ctx, sexp name, sexp loc, sexp lam, sexp app) {
|
||||
sexp head=app, tail=sexp_cdr(app);
|
||||
sexp_uint_t tailp = sexp_context_tailp(ctx);
|
||||
sexp_push_source(ctx, sexp_pair_source(app));
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
for ( ; sexp_pairp(tail); head=tail, tail=sexp_cdr(tail))
|
||||
if (sexp_pointerp(sexp_car(head)) && (! sexp_litp(sexp_car(head)))) {
|
||||
|
|
@ -133,6 +173,7 @@ static void generate_seq (sexp ctx, sexp name, sexp loc, sexp lam, sexp app) {
|
|||
|
||||
static void generate_cnd (sexp ctx, sexp name, sexp loc, sexp lam, sexp cnd) {
|
||||
sexp_sint_t label1, label2, tailp=sexp_context_tailp(ctx);
|
||||
sexp_push_source(ctx, sexp_cnd_source(cnd));
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
sexp_generate(ctx, name, loc, lam, sexp_cnd_test(cnd));
|
||||
sexp_context_tailp(ctx) = tailp;
|
||||
|
|
@ -173,6 +214,7 @@ static void generate_non_global_ref (sexp ctx, sexp name, sexp cell,
|
|||
|
||||
static void generate_ref (sexp ctx, sexp ref, int unboxp) {
|
||||
sexp lam;
|
||||
sexp_push_source(ctx, sexp_ref_source(ref));
|
||||
if (! sexp_lambdap(sexp_ref_loc(ref))) {
|
||||
/* global ref */
|
||||
if (unboxp) {
|
||||
|
|
@ -191,6 +233,7 @@ static void generate_ref (sexp ctx, sexp ref, int unboxp) {
|
|||
|
||||
static void generate_set (sexp ctx, sexp set) {
|
||||
sexp ref = sexp_set_var(set), lambda;
|
||||
sexp_push_source(ctx, sexp_set_source(set));
|
||||
/* compile the value */
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
if (sexp_lambdap(sexp_set_value(set))) {
|
||||
|
|
@ -425,6 +468,7 @@ static void generate_tail_jump (sexp ctx, sexp name, sexp loc, sexp lam, sexp ap
|
|||
#endif
|
||||
|
||||
static void generate_app (sexp ctx, sexp name, sexp loc, sexp lam, sexp app) {
|
||||
sexp_push_source(ctx, sexp_pair_source(app));
|
||||
if (sexp_opcodep(sexp_car(app)))
|
||||
generate_opcode_app(ctx, app);
|
||||
#if SEXP_USE_TAIL_JUMPS
|
||||
|
|
@ -535,6 +579,7 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd
|
|||
fv = sexp_lambda_fv(lambda);
|
||||
ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx), 0, 0);
|
||||
sexp_context_lambda(ctx2) = lambda;
|
||||
tmp = sexp_cons(ctx2, SEXP_ZERO, sexp_lambda_source(lambda));
|
||||
/* allocate space for local vars */
|
||||
k = sexp_unbox_fixnum(sexp_length(ctx, sexp_lambda_locals(lambda)));
|
||||
if (k > 0) {
|
||||
|
|
@ -572,7 +617,9 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd
|
|||
len = sexp_length(ctx2, sexp_lambda_params(lambda));
|
||||
bc = sexp_complete_bytecode(ctx2);
|
||||
sexp_bytecode_name(bc) = sexp_lambda_name(lambda);
|
||||
#if ! SEXP_USE_FULL_SOURCE_INFO
|
||||
sexp_bytecode_source(bc) = sexp_lambda_source(lambda);
|
||||
#endif
|
||||
if (sexp_nullp(fv)) {
|
||||
/* shortcut, no free vars */
|
||||
tmp = sexp_make_vector(ctx2, SEXP_ZERO, SEXP_VOID);
|
||||
|
|
@ -820,11 +867,11 @@ static sexp sexp_reset_vm_profile (sexp ctx, sexp self, sexp_sint_t n) {
|
|||
static sexp sexp_print_vm_profile (sexp ctx, sexp self, sexp_sint_t n) {
|
||||
int i, j;
|
||||
for (i=0; i<SEXP_OP_NUM_OPCODES; i++)
|
||||
fprintf(stderr, "%s %lu\n", reverse_opcode_names[i], profile1[i]);
|
||||
fprintf(stderr, "%s %lu\n", sexp_opcode_names[i], profile1[i]);
|
||||
for (i=0; i<SEXP_OP_NUM_OPCODES; i++)
|
||||
for (j=0; j<SEXP_OP_NUM_OPCODES; j++)
|
||||
fprintf(stderr, "%s %s %lu\n", reverse_opcode_names[i],
|
||||
reverse_opcode_names[j], profile2[i][j]);
|
||||
fprintf(stderr, "%s %s %lu\n", sexp_opcode_names[i],
|
||||
sexp_opcode_names[j], profile2[i][j]);
|
||||
return SEXP_VOID;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -897,7 +944,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
if (sexp_context_tracep(ctx)) {
|
||||
sexp_print_stack(ctx, stack, top, fp, SEXP_FALSE);
|
||||
fprintf(stderr, "****** VM %s %s ip: %p stack: %p top: %ld fp: %ld (%ld)\n",
|
||||
(*ip<=SEXP_OP_NUM_OPCODES) ? reverse_opcode_names[*ip] : "UNKNOWN",
|
||||
(*ip<=SEXP_OP_NUM_OPCODES) ? sexp_opcode_names[*ip] : "UNKNOWN",
|
||||
(SEXP_OP_FCALL0 <= *ip && *ip <= SEXP_OP_FCALL4
|
||||
? sexp_string_data(sexp_opcode_name(((sexp*)(ip+1))[0])) : ""),
|
||||
ip, stack, top, fp, (fp<1024 ? sexp_unbox_fixnum(stack[fp+3]) : -1));
|
||||
|
|
@ -914,6 +961,10 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
|||
call_error_handler:
|
||||
if (! sexp_exception_procedure(_ARG1))
|
||||
sexp_exception_procedure(_ARG1) = self;
|
||||
#if SEXP_USE_FULL_SOURCE_INFO
|
||||
if (sexp_not(sexp_exception_source(_ARG1)) && sexp_procedure_source(sexp_exception_procedure(_ARG1)))
|
||||
sexp_exception_source(_ARG1) = sexp_lookup_source_info(sexp_procedure_source(sexp_exception_procedure(_ARG1)), (ip-sexp_bytecode_data(bc)));
|
||||
#endif
|
||||
case SEXP_OP_RAISE:
|
||||
sexp_context_top(ctx) = top;
|
||||
if (sexp_trampolinep(_ARG1)) {
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue