suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more bytecode-parsing checks

Browse Source 
svn: r13997
This commit is contained in:
Matthew Flatt 2009-03-06 23:26:44 +00:00
parent 4d4d2f54e2
commit cdfb6e5f67
2 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/mzscheme/src/eval.c
View File

@ -1592,7 +1592,11 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
return scheme_compiled_void(); return scheme_compiled_void();
if (count == 1) { if (count == 1) {
if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL)) { if (opt < -1) {
/* can't optimize away a begin0 at read time; it's too late, since the
return is combined with EXPD_BEGIN0 */
addconst = 1;
} else if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL)) {
/* We can't optimize (begin0 expr cont) to expr because /* We can't optimize (begin0 expr cont) to expr because
exp is not in tail position in the original (so we'd mess exp is not in tail position in the original (so we'd mess
up continuation marks). */ up continuation marks). */
@ -10879,7 +10883,7 @@ static Scheme_Object *read_sequence(Scheme_Object *obj)
static Scheme_Object *read_sequence_save_first(Scheme_Object *obj) static Scheme_Object *read_sequence_save_first(Scheme_Object *obj)
{ {
return scheme_make_sequence_compilation(obj, -1); return scheme_make_sequence_compilation(obj, -2);
} }
static Scheme_Object *write_branch(Scheme_Object *obj) static Scheme_Object *write_branch(Scheme_Object *obj)

29
src/mzscheme/src/syntax.c
View File

@ -2326,6 +2326,9 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
Scheme_Object *e; Scheme_Object *e;
int i; int i;
if (!SAME_TYPE(SCHEME_TYPE(data), scheme_case_lambda_sequence_type))
scheme_ill_formed_code(port);
for (i = 0; i < seq->count; i++) { for (i = 0; i < seq->count; i++) {
e = seq->array[i]; e = seq->array[i];
if (!SAME_TYPE(SCHEME_TYPE(e), scheme_unclosed_procedure_type) if (!SAME_TYPE(SCHEME_TYPE(e), scheme_unclosed_procedure_type)
@ -2468,7 +2471,7 @@ Scheme_Object *scheme_unclose_case_lambda(Scheme_Object *expr, int mode)
if (mode == 2) { if (mode == 2) {
/* sfs */ /* sfs */
return scheme_make_syntax_resolved(CASE_LAMBDA_EXPD, expr); return scheme_make_syntax_resolved(CASE_LAMBDA_EXPD, (Scheme_Object *)cl2);
} else if (mode == 1) { } else if (mode == 1) {
/* JIT */ /* JIT */
return case_lambda_jit((Scheme_Object *)cl2); return case_lambda_jit((Scheme_Object *)cl2);
@ -5002,14 +5005,19 @@ static Scheme_Object *splice_one_expr(void *expr, int argc, Scheme_Object **argv
static Scheme_Object *splice_execute(Scheme_Object *data) static Scheme_Object *splice_execute(Scheme_Object *data)
{ {
Scheme_Sequence *seq = (Scheme_Sequence *)data; if (SAME_TYPE(SCHEME_TYPE(data), scheme_sequence_type)) {
int i, cnt = seq->count - 1; Scheme_Sequence *seq = (Scheme_Sequence *)data;
int i, cnt = seq->count - 1;
for (i = 0; i < cnt; i++) {
(void)_scheme_call_with_prompt_multi(splice_one_expr, seq->array[i]); for (i = 0; i < cnt; i++) {
(void)_scheme_call_with_prompt_multi(splice_one_expr, seq->array[i]);
}
return _scheme_eval_linked_expr_multi(seq->array[cnt]);
} else {
/* sequence was optimized on read? */
return _scheme_eval_linked_expr_multi(data);
} }
return _scheme_eval_linked_expr_multi(seq->array[cnt]);
} }
static Scheme_Object *splice_jit(Scheme_Object *data) static Scheme_Object *splice_jit(Scheme_Object *data)
@ -6323,8 +6331,11 @@ static Scheme_Object *read_case_lambda(Scheme_Object *obj)
for (i = 0; i < count; i++, s = SCHEME_CDR(s)) { for (i = 0; i < count; i++, s = SCHEME_CDR(s)) {
a = SCHEME_CAR(s); a = SCHEME_CAR(s);
cl->array[i] = a; cl->array[i] = a;
if (!SCHEME_PROCP(a)) if (!SCHEME_PROCP(a)) {
if (!SAME_TYPE(SCHEME_TYPE(a), scheme_unclosed_procedure_type))
return NULL;
all_closed = 0; all_closed = 0;
}
} }
if (all_closed) { if (all_closed) {