more bytecode-parsing checks

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

View File

@ -1592,7 +1592,11 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
return scheme_compiled_void();
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
exp is not in tail position in the original (so we'd mess
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)
{
return scheme_make_sequence_compilation(obj, -1);
return scheme_make_sequence_compilation(obj, -2);
}
static Scheme_Object *write_branch(Scheme_Object *obj)

View File

@ -2326,6 +2326,9 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
Scheme_Object *e;
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++) {
e = seq->array[i];
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) {
/* 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) {
/* JIT */
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)
{
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]);
if (SAME_TYPE(SCHEME_TYPE(data), scheme_sequence_type)) {
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]);
}
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)
@ -6323,8 +6331,11 @@ static Scheme_Object *read_case_lambda(Scheme_Object *obj)
for (i = 0; i < count; i++, s = SCHEME_CDR(s)) {
a = SCHEME_CAR(s);
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;
}
}
if (all_closed) {