fix JITted multi-valued `begin0' in a single-value context

and generate simpler code for constrained cases, including
 single-value contexts and ignored results

 Closes PR 11979
This commit is contained in:
Matthew Flatt 2011-06-16 17:33:16 -06:00
parent 26541ffbbd
commit 523cec90c6
2 changed files with 78 additions and 52 deletions

View File

@ -1371,6 +1371,23 @@
(test 10 dynamic-require ''set-local-dfs 'ten)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test single-result checking in `begin0':
(let ()
(define (twice x) (printf "ouch\n") (values x x))
(define (pipeline2 . rfuns)
(let ([x (begin0 ((car rfuns) 1) 123)])
x))
(define (try f)
(call-with-values
(lambda () (with-handlers ([void values]) (f twice)))
(lambda xs xs)))
(test #t exn? (caar (map try (list pipeline2)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -1899,16 +1899,17 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
seq = (Scheme_Sequence *)obj;
/* Evaluate first expression, and for consistency with bytecode
evaluation, allow multiple values. */
scheme_generate_non_tail(seq->array[0], jitter, 1, 1, 0);
/* Evaluate first expression: */
scheme_generate_non_tail(seq->array[0], jitter, multi_ok, 1, result_ignored);
CHECK_LIMIT();
/* Save value(s) */
jit_movr_p(JIT_V1, JIT_R0);
mz_pushr_p(JIT_V1);
mz_pushr_p(JIT_V1);
mz_pushr_p(JIT_V1);
if (!result_ignored) {
mz_pushr_p(JIT_R0);
if (multi_ok) {
mz_pushr_p(JIT_R0);
mz_pushr_p(JIT_R0);
mz_pushr_p(JIT_R0);
mz_rs_sync();
__START_SHORT_JUMPS__(1);
ref = jit_bnei_p(jit_forward(), JIT_R0, SCHEME_MULTIPLE_VALUES);
@ -1935,17 +1936,22 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
jit_stxi_p(&((Scheme_Thread *)0x0)->values_buffer, JIT_R0, JIT_R1);
CHECK_LIMIT();
/* evaluate remaining expressions */
mz_patch_branch(ref);
mz_patch_branch(ref2);
__END_SHORT_JUMPS__(1);
}
}
/* evaluate remaining expressions */
for (i = 1; i < seq->count; i++) {
scheme_generate_non_tail(seq->array[i], jitter, 1, 1, 1); /* sync's below */
CHECK_LIMIT();
}
/* Restore values, if necessary */
if (!result_ignored) {
mz_popr_p(JIT_R0);
if (multi_ok) {
mz_popr_p(JIT_R1);
mz_popr_p(JIT_R2);
mz_rs_sync();
@ -1960,9 +1966,12 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
(void)jit_movi_p(JIT_R0, SCHEME_MULTIPLE_VALUES);
mz_patch_branch(ref);
__END_TINY_JUMPS__(1);
}
if (target != JIT_R0)
jit_movr_p(target, JIT_R0);
__END_TINY_JUMPS__(1);
}
if (for_branch) finish_branch(jitter, target, for_branch);