Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 13:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing runtime error reporting

Browse source
This commit is contained in:
Alex Shinn 2010-06-26 11:28:42 +09:00
parent 0aa20e30b2
commit 2c8c2a8c23
4 changed files with 37 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
eval.c
View file

@ -204,7 +204,7 @@ static void expand_bcode (sexp ctx, sexp_uint_t size) {
if (sexp_bytecode_length(sexp_context_bc(ctx)) if (sexp_bytecode_length(sexp_context_bc(ctx))
< (sexp_context_pos(ctx))+size) { < (sexp_context_pos(ctx))+size) {
tmp=sexp_alloc_bytecode(ctx, sexp_bytecode_length(sexp_context_bc(ctx))*2); tmp=sexp_alloc_bytecode(ctx, sexp_bytecode_length(sexp_context_bc(ctx))*2);
sexp_bytecode_name(tmp) = SEXP_FALSE; sexp_bytecode_name(tmp) = sexp_bytecode_name(sexp_context_bc(ctx));
sexp_bytecode_length(tmp) sexp_bytecode_length(tmp)
= sexp_bytecode_length(sexp_context_bc(ctx))*2; = sexp_bytecode_length(sexp_context_bc(ctx))*2;
sexp_bytecode_literals(tmp) sexp_bytecode_literals(tmp)
@ -551,6 +551,7 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
sexp_return(res, sexp_compile_error(ctx, "duplicate parameter", x)); sexp_return(res, sexp_compile_error(ctx, "duplicate parameter", x));
/* build lambda and analyze body */ /* build lambda and analyze body */
res = sexp_make_lambda(ctx, tmp=sexp_copy_list(ctx, sexp_cadr(x))); res = sexp_make_lambda(ctx, tmp=sexp_copy_list(ctx, sexp_cadr(x)));
sexp_lambda_source(res) = sexp_pair_source(x);
ctx2 = sexp_make_child_context(ctx, res); ctx2 = sexp_make_child_context(ctx, res);
tmp = sexp_flatten_dot(ctx2, sexp_lambda_params(res)); tmp = sexp_flatten_dot(ctx2, sexp_lambda_params(res));
sexp_context_env(ctx2) = sexp_extend_env(ctx2, sexp_context_env(ctx2), tmp, res); sexp_context_env(ctx2) = sexp_extend_env(ctx2, sexp_context_env(ctx2), tmp, res);
@ -624,6 +625,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
sexp_push(ctx, sexp_lambda_sv(sexp_env_lambda(env)), name); sexp_push(ctx, sexp_lambda_sv(sexp_env_lambda(env)), name);
sexp_push(ctx, sexp_lambda_locals(sexp_env_lambda(env)), name); sexp_push(ctx, sexp_lambda_locals(sexp_env_lambda(env)), name);
tmp = sexp_cons(ctx, sexp_cdr(x), ctx); tmp = sexp_cons(ctx, sexp_cdr(x), ctx);
sexp_pair_source(tmp) = sexp_pair_source(x);
sexp_push(ctx, sexp_lambda_defs(sexp_env_lambda(env)), tmp); sexp_push(ctx, sexp_lambda_defs(sexp_env_lambda(env)), tmp);
res = SEXP_VOID; res = SEXP_VOID;
} else { } else {

25
include/chibi/sexp.h
View file

@ -183,6 +183,7 @@ struct sexp_struct {
char gc_mark; char gc_mark;
unsigned int immutablep:1; unsigned int immutablep:1;
unsigned int freep:1; unsigned int freep:1;
unsigned int syntacticp:1;
#if SEXP_USE_HEADER_MAGIC #if SEXP_USE_HEADER_MAGIC
unsigned int magic; unsigned int magic;
#endif #endif
@ -239,12 +240,11 @@ struct sexp_struct {
} cpointer; } cpointer;
/* runtime types */ /* runtime types */
struct { struct {
unsigned int syntacticp:1;
sexp parent, lambda, bindings; sexp parent, lambda, bindings;
} env; } env;
struct { struct {
sexp_uint_t length; sexp_uint_t length;
sexp name, literals; sexp name, literals, source;
unsigned char data[]; unsigned char data[];
} bytecode; } bytecode;
struct { struct {
@ -271,22 +271,22 @@ struct sexp_struct {
} core; } core;
/* ast types */ /* ast types */
struct { struct {
sexp name, params, body, defs, locals, flags, fv, sv; sexp name, params, body, defs, locals, flags, fv, sv, source;
} lambda; } lambda;
struct { struct {
sexp test, pass, fail; sexp test, pass, fail, source;
} cnd; } cnd;
struct { struct {
sexp var, value; sexp var, value, source;
} set; } set;
struct { struct {
sexp name, cell; sexp name, cell, source;
} ref; } ref;
struct { struct {
sexp ls; sexp ls, source;
} seq; } seq;
struct { struct {
sexp value; sexp value, source;
} lit; } lit;
/* compiler state */ /* compiler state */
struct { struct {
@ -604,9 +604,10 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_bytecode_length(x) ((x)->value.bytecode.length) #define sexp_bytecode_length(x) ((x)->value.bytecode.length)
#define sexp_bytecode_name(x) ((x)->value.bytecode.name) #define sexp_bytecode_name(x) ((x)->value.bytecode.name)
#define sexp_bytecode_literals(x) ((x)->value.bytecode.literals) #define sexp_bytecode_literals(x) ((x)->value.bytecode.literals)
#define sexp_bytecode_source(x) ((x)->value.bytecode.source)
#define sexp_bytecode_data(x) ((x)->value.bytecode.data) #define sexp_bytecode_data(x) ((x)->value.bytecode.data)
#define sexp_env_syntactic_p(x) ((x)->value.env.syntacticp) #define sexp_env_syntactic_p(x) ((x)->syntacticp)
#define sexp_env_parent(x) ((x)->value.env.parent) #define sexp_env_parent(x) ((x)->value.env.parent)
#define sexp_env_bindings(x) ((x)->value.env.bindings) #define sexp_env_bindings(x) ((x)->value.env.bindings)
#define sexp_env_local_p(x) (sexp_env_parent(x)) #define sexp_env_local_p(x) (sexp_env_parent(x))
@ -648,21 +649,27 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_lambda_body(x) ((x)->value.lambda.body) #define sexp_lambda_body(x) ((x)->value.lambda.body)
#define sexp_lambda_fv(x) ((x)->value.lambda.fv) #define sexp_lambda_fv(x) ((x)->value.lambda.fv)
#define sexp_lambda_sv(x) ((x)->value.lambda.sv) #define sexp_lambda_sv(x) ((x)->value.lambda.sv)
#define sexp_lambda_source(x) ((x)->value.lambda.source)
#define sexp_cnd_test(x) ((x)->value.cnd.test) #define sexp_cnd_test(x) ((x)->value.cnd.test)
#define sexp_cnd_pass(x) ((x)->value.cnd.pass) #define sexp_cnd_pass(x) ((x)->value.cnd.pass)
#define sexp_cnd_fail(x) ((x)->value.cnd.fail) #define sexp_cnd_fail(x) ((x)->value.cnd.fail)
#define sexp_cnd_source(x) ((x)->value.cnd.source)
#define sexp_set_var(x) ((x)->value.set.var) #define sexp_set_var(x) ((x)->value.set.var)
#define sexp_set_value(x) ((x)->value.set.value) #define sexp_set_value(x) ((x)->value.set.value)
#define sexp_set_source(x) ((x)->value.set.source)
#define sexp_ref_name(x) ((x)->value.ref.name) #define sexp_ref_name(x) ((x)->value.ref.name)
#define sexp_ref_cell(x) ((x)->value.ref.cell) #define sexp_ref_cell(x) ((x)->value.ref.cell)
#define sexp_ref_loc(x) (sexp_cdr(sexp_ref_cell(x))) #define sexp_ref_loc(x) (sexp_cdr(sexp_ref_cell(x)))
#define sexp_ref_source(x) ((x)->value.ref.source)
#define sexp_seq_ls(x) ((x)->value.seq.ls) #define sexp_seq_ls(x) ((x)->value.seq.ls)
#define sexp_seq_source(x) ((x)->value.seq.source)
#define sexp_lit_value(x) ((x)->value.lit.value) #define sexp_lit_value(x) ((x)->value.lit.value)
#define sexp_lit_source(x) ((x)->value.lit.source)
#define sexp_stack_length(x) ((x)->value.stack.length) #define sexp_stack_length(x) ((x)->value.stack.length)
#define sexp_stack_top(x) ((x)->value.stack.top) #define sexp_stack_top(x) ((x)->value.stack.top)

20
sexp.c
View file

@ -100,15 +100,15 @@ static struct sexp_struct _sexp_type_specs[] = {
_DEF_TYPE(SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, "macro", NULL), _DEF_TYPE(SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, "macro", NULL),
_DEF_TYPE(SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, "syntactic-closure", NULL), _DEF_TYPE(SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, "syntactic-closure", NULL),
_DEF_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, "environment", NULL), _DEF_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, "environment", NULL),
_DEF_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 2, 2, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode", NULL), _DEF_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode", NULL),
_DEF_TYPE(SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form", NULL), _DEF_TYPE(SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form", NULL),
_DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, data), 3, 3, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode", NULL), _DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, data), 3, 3, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode", NULL),
_DEF_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 8, 8, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda", NULL), _DEF_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 9, 9, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda", NULL),
_DEF_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 3, 3, 0, 0, sexp_sizeof(cnd), 0, 0, "conditional", NULL), _DEF_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, "conditional", NULL),
_DEF_TYPE(SEXP_REF, sexp_offsetof(ref, name), 2, 2, 0, 0, sexp_sizeof(ref), 0, 0, "reference", NULL), _DEF_TYPE(SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, "reference", NULL),
_DEF_TYPE(SEXP_SET, sexp_offsetof(set, var), 2, 2, 0, 0, sexp_sizeof(set), 0, 0, "set!", NULL), _DEF_TYPE(SEXP_SET, sexp_offsetof(set, var), 3, 3, 0, 0, sexp_sizeof(set), 0, 0, "set!", NULL),
_DEF_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 1, 1, 0, 0, sexp_sizeof(seq), 0, 0, "sequence", NULL), _DEF_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, "sequence", NULL),
_DEF_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 1, 1, 0, 0, sexp_sizeof(lit), 0, 0, "literal", NULL), _DEF_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, "literal", NULL),
_DEF_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), "stack", NULL), _DEF_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), "stack", NULL),
_DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 7, 7, 0, 0, sexp_sizeof(context), 0, 0, "context", NULL), _DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 7, 7, 0, 0, sexp_sizeof(context), 0, 0, "context", NULL),
}; };
@ -417,8 +417,10 @@ sexp sexp_print_exception_op (sexp ctx sexp_api_params(self, n), sexp exn, sexp
sexp_write_string(ctx, sexp_opcode_name(sexp_exception_procedure(exn)), out); sexp_write_string(ctx, sexp_opcode_name(sexp_exception_procedure(exn)), out);
} }
} }
if (sexp_pairp(sexp_exception_source(exn))) { ls = sexp_exception_source(exn);
ls = sexp_exception_source(exn); if ((! (ls && sexp_pairp(ls))) && sexp_exception_procedure(exn))
ls = sexp_bytecode_source(sexp_procedure_code(sexp_exception_procedure(exn)));
if (ls && sexp_pairp(ls)) {
if (sexp_fixnump(sexp_cdr(ls)) && (sexp_cdr(ls) >= SEXP_ZERO)) { if (sexp_fixnump(sexp_cdr(ls)) && (sexp_cdr(ls) >= SEXP_ZERO)) {
sexp_write_string(ctx, " on line ", out); sexp_write_string(ctx, " on line ", out);
sexp_write(ctx, sexp_cdr(ls), out); sexp_write(ctx, sexp_cdr(ls), out);

10
vm.c
View file

@ -301,6 +301,7 @@ static void generate_lambda (sexp ctx, sexp lambda) {
len = sexp_length(ctx2, sexp_lambda_params(lambda)); len = sexp_length(ctx2, sexp_lambda_params(lambda));
bc = finalize_bytecode(ctx2); bc = finalize_bytecode(ctx2);
sexp_bytecode_name(bc) = sexp_lambda_name(lambda); sexp_bytecode_name(bc) = sexp_lambda_name(lambda);
sexp_bytecode_source(bc) = sexp_lambda_source(lambda);
if (sexp_nullp(fv)) { if (sexp_nullp(fv)) {
/* shortcut, no free vars */ /* shortcut, no free vars */
tmp = sexp_make_vector(ctx2, SEXP_ZERO, SEXP_VOID); tmp = sexp_make_vector(ctx2, SEXP_ZERO, SEXP_VOID);
@ -441,9 +442,12 @@ static sexp_uint_t sexp_restore_stack (sexp saved, sexp *current) {
goto call_error_handler;} \ goto call_error_handler;} \
while (0) while (0)
#define sexp_check_exception() do {if (sexp_exceptionp(_ARG1)) \ #define sexp_check_exception() \
goto call_error_handler;} \ do {if (sexp_exceptionp(_ARG1)) { \
while (0) if (! sexp_exception_procedure(_ARG1)) \
sexp_exception_procedure(_ARG1) = self; \
goto call_error_handler;}} \
while (0)
sexp sexp_vm (sexp ctx, sexp proc) { sexp sexp_vm (sexp ctx, sexp proc) {
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc); sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);