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

fixing some stack pointer management bugs

Browse source
This commit is contained in:
Alex Shinn 2009-06-12 17:35:57 +09:00
parent cce116bc0a
commit b636225da7
3 changed files with 83 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile
View file

@ -71,6 +71,5 @@ dist: cleaner
rm -f chibi-scheme-`cat VERSION`.tgz rm -f chibi-scheme-`cat VERSION`.tgz
mkdir chibi-scheme-`cat VERSION` mkdir chibi-scheme-`cat VERSION`
for f in `hg manifest`; do mkdir -p chibi-scheme-`cat VERSION`/`dirname $$f`; ln -s `pwd`/$$f chibi-scheme-`cat VERSION`/$$f; done for f in `hg manifest`; do mkdir -p chibi-scheme-`cat VERSION`/`dirname $$f`; ln -s `pwd`/$$f chibi-scheme-`cat VERSION`/$$f; done
cd chibi-scheme-`cat VERSION`; tar xzvf ../gc.tar.gz; mv gc[0-9].[0-9] gc
tar cphzvf chibi-scheme-`cat VERSION`.tgz chibi-scheme-`cat VERSION` tar cphzvf chibi-scheme-`cat VERSION`.tgz chibi-scheme-`cat VERSION`
rm -rf chibi-scheme-`cat VERSION` rm -rf chibi-scheme-`cat VERSION`

36
eval.c
View file

@ -446,11 +446,13 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
sexp_gc_var(ctx, tmp, s_tmp); sexp_gc_var(ctx, tmp, s_tmp);
sexp_gc_var(ctx, value, s_value); sexp_gc_var(ctx, value, s_value);
sexp_gc_var(ctx, defs, s_defs); sexp_gc_var(ctx, defs, s_defs);
sexp_gc_var(ctx, ctx2, s_ctx2);
sexp_gc_preserve(ctx, res, s_res); sexp_gc_preserve(ctx, res, s_res);
sexp_gc_preserve(ctx, body, s_body); sexp_gc_preserve(ctx, body, s_body);
sexp_gc_preserve(ctx, tmp, s_tmp); sexp_gc_preserve(ctx, tmp, s_tmp);
sexp_gc_preserve(ctx, value, s_value); sexp_gc_preserve(ctx, value, s_value);
sexp_gc_preserve(ctx, defs, s_defs); sexp_gc_preserve(ctx, defs, s_defs);
sexp_gc_preserve(ctx, ctx2, s_ctx2);
/* verify syntax - XXXX release! */ /* verify syntax - XXXX release! */
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x))))
return sexp_compile_error(ctx, "bad lambda syntax", x); return sexp_compile_error(ctx, "bad lambda syntax", x);
@ -461,11 +463,11 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
return sexp_compile_error(ctx, "duplicate parameter", x); return sexp_compile_error(ctx, "duplicate parameter", x);
/* build lambda and analyze body */ /* build lambda and analyze body */
res = sexp_make_lambda(ctx, sexp_cadr(x)); res = sexp_make_lambda(ctx, sexp_cadr(x));
ctx = sexp_make_child_context(ctx, res); ctx2 = sexp_make_child_context(ctx, res);
tmp = sexp_flatten_dot(ctx, sexp_lambda_params(res)); tmp = sexp_flatten_dot(ctx2, sexp_lambda_params(res));
sexp_context_env(ctx) = extend_env(ctx, sexp_context_env(ctx), tmp, res); sexp_context_env(ctx2) = extend_env(ctx2, sexp_context_env(ctx2), tmp, res);
sexp_env_lambda(sexp_context_env(ctx)) = res; sexp_env_lambda(sexp_context_env(ctx2)) = res;
body = analyze_seq(ctx, sexp_cddr(x)); body = analyze_seq(ctx2, sexp_cddr(x));
analyze_check_exception(body); analyze_check_exception(body);
/* delayed analyze internal defines */ /* delayed analyze internal defines */
defs = SEXP_NULL; defs = SEXP_NULL;
@ -473,22 +475,23 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
tmp = sexp_car(ls); tmp = sexp_car(ls);
if (sexp_pairp(sexp_cadr(tmp))) { if (sexp_pairp(sexp_cadr(tmp))) {
name = sexp_caadr(tmp); name = sexp_caadr(tmp);
tmp = sexp_cons(ctx, sexp_cdadr(tmp), sexp_cddr(tmp)); tmp = sexp_cons(ctx2, sexp_cdadr(tmp), sexp_cddr(tmp));
value = analyze_lambda(ctx, sexp_cons(ctx, SEXP_VOID, tmp)); value = analyze_lambda(ctx2, sexp_cons(ctx2, SEXP_VOID, tmp));
} else { } else {
name = sexp_cadr(tmp); name = sexp_cadr(tmp);
value = analyze(ctx, sexp_caddr(tmp)); value = analyze(ctx2, sexp_caddr(tmp));
} }
analyze_check_exception(value); analyze_check_exception(value);
sexp_push(ctx, defs, sexp_make_set(ctx, analyze_var_ref(ctx, name), value)); sexp_push(ctx2, defs,
sexp_make_set(ctx2, analyze_var_ref(ctx, name), value));
} }
if (sexp_pairp(defs)) { if (sexp_pairp(defs)) {
if (! sexp_seqp(body)) { if (! sexp_seqp(body)) {
tmp = sexp_alloc_type(ctx, seq, SEXP_SEQ); tmp = sexp_alloc_type(ctx2, seq, SEXP_SEQ);
sexp_seq_ls(tmp) = sexp_list1(ctx, body); sexp_seq_ls(tmp) = sexp_list1(ctx2, body);
body = tmp; body = tmp;
} }
sexp_seq_ls(body) = sexp_append2(ctx, defs, sexp_seq_ls(body)); sexp_seq_ls(body) = sexp_append2(ctx2, defs, sexp_seq_ls(body));
} }
sexp_lambda_body(res) = body; sexp_lambda_body(res) = body;
sexp_gc_release(ctx, res, s_res); sexp_gc_release(ctx, res, s_res);
@ -527,10 +530,9 @@ 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);
sexp_push(ctx, sexp_lambda_defs(sexp_env_lambda(env)), x); sexp_push(ctx, sexp_lambda_defs(sexp_env_lambda(env)), x);
return SEXP_VOID; res = SEXP_VOID;
} else { } else {
env_cell_create(ctx, env, name, SEXP_VOID); env_cell_create(ctx, env, name, SEXP_VOID);
}
if (sexp_pairp(sexp_cadr(x))) { if (sexp_pairp(sexp_cadr(x))) {
tmp = sexp_cons(ctx, sexp_cdadr(x), sexp_cddr(x)); tmp = sexp_cons(ctx, sexp_cdadr(x), sexp_cddr(x));
tmp = sexp_cons(ctx, SEXP_VOID, tmp); tmp = sexp_cons(ctx, SEXP_VOID, tmp);
@ -544,6 +546,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
res = value; res = value;
else else
res = sexp_make_set(ctx, ref, value); res = sexp_make_set(ctx, ref, value);
}
sexp_gc_release(ctx, ref, s_ref); sexp_gc_release(ctx, ref, s_ref);
return res; return res;
} }
@ -626,7 +629,9 @@ static sexp analyze (sexp ctx, sexp object) {
if (! cell && sexp_synclop(sexp_car(x))) if (! cell && sexp_synclop(sexp_car(x)))
cell = env_cell(sexp_synclo_env(sexp_car(x)), cell = env_cell(sexp_synclo_env(sexp_car(x)),
sexp_synclo_expr(sexp_car(x))); sexp_synclo_expr(sexp_car(x)));
if (! cell) return analyze_app(ctx, x); if (! cell) {
res = analyze_app(ctx, x);
} else {
op = sexp_cdr(cell); op = sexp_cdr(cell);
if (sexp_corep(op)) { if (sexp_corep(op)) {
switch (sexp_core_code(op)) { switch (sexp_core_code(op)) {
@ -677,6 +682,7 @@ static sexp analyze (sexp ctx, sexp object) {
} else { } else {
res = analyze_app(ctx, x); res = analyze_app(ctx, x);
} }
}
} else { } else {
res = analyze_app(ctx, x); res = analyze_app(ctx, x);
} }

2
sexp.h
View file

@ -90,6 +90,7 @@ typedef struct sexp_struct *sexp;
struct sexp_gc_var_t { struct sexp_gc_var_t {
sexp *var; sexp *var;
char *name;
struct sexp_gc_var_t *next; struct sexp_gc_var_t *next;
}; };
@ -231,6 +232,7 @@ struct sexp_struct {
#define sexp_gc_preserve(ctx, x, y) \ #define sexp_gc_preserve(ctx, x, y) \
do { \ do { \
(y).var = &(x); \ (y).var = &(x); \
(y).name = #x; \
(y).next = sexp_context_saves(ctx); \ (y).next = sexp_context_saves(ctx); \
sexp_context_saves(ctx) = &(y); \ sexp_context_saves(ctx) = &(y); \
} while (0) } while (0)