fix interpreted begin0
to for a 0-result case
In some cases, 0 results will be represented by a NULL results-array pointer. Fix the interpreter to detect a single result completion through a count of 1 instead of a NULL result-array pointer. Also, remove a bug extra push operation in the JIT-generated code for `begin0`. (Other features of the JIT-generated code compensated for the extra push in cases where the bytecode compiler did't optimize away the `begin0`, so it turns out not to have caused a problem, but that's a surprising and fragile set of coincidences.) Closes #2571
This commit is contained in:
parent
e7456d3e9e
commit
cbd565a3fd
|
@ -2223,6 +2223,27 @@
|
||||||
(define x (param))))
|
(define x (param))))
|
||||||
x))
|
x))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; check interpreted `begin0`, 0 results, and
|
||||||
|
;; non-0 results along the way
|
||||||
|
|
||||||
|
;; This is a regression test for a bug that caused a crash
|
||||||
|
(let ()
|
||||||
|
(define f
|
||||||
|
(impersonate-procedure
|
||||||
|
(λ (x) #f)
|
||||||
|
(λ (x) (values (λ (x) x) x))))
|
||||||
|
|
||||||
|
(call-with-values
|
||||||
|
(λ ()
|
||||||
|
(begin0
|
||||||
|
((lambda (pos)
|
||||||
|
(set! pos pos)
|
||||||
|
(values))
|
||||||
|
0)
|
||||||
|
(f #f)))
|
||||||
|
(λ args (void))))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -15,7 +15,8 @@
|
||||||
"../expand/missing-module.rkt"
|
"../expand/missing-module.rkt"
|
||||||
"../read/api.rkt"
|
"../read/api.rkt"
|
||||||
"../read/primitive-parameter.rkt"
|
"../read/primitive-parameter.rkt"
|
||||||
"load-handler.rkt")
|
"load-handler.rkt"
|
||||||
|
"../common/performance.rkt")
|
||||||
|
|
||||||
(provide boot
|
(provide boot
|
||||||
seal
|
seal
|
||||||
|
@ -459,12 +460,16 @@
|
||||||
(cond
|
(cond
|
||||||
[(symbol? s)
|
[(symbol? s)
|
||||||
(or (path-cache-get (cons s (get-reg)))
|
(or (path-cache-get (cons s (get-reg)))
|
||||||
|
(performance-region
|
||||||
|
['eval 'resolve-symbol]
|
||||||
(let-values ([(cols file) (split-relative-string (symbol->string s) #f)])
|
(let-values ([(cols file) (split-relative-string (symbol->string s) #f)])
|
||||||
(let* ([f-file (if (null? cols)
|
(let* ([f-file (if (null? cols)
|
||||||
"main.rkt"
|
"main.rkt"
|
||||||
(string-append file ".rkt"))]
|
(string-append file ".rkt"))]
|
||||||
[col (if (null? cols) file (car cols))]
|
[col (if (null? cols) file (car cols))]
|
||||||
[col-path (if (null? cols) null (cdr cols))])
|
[col-path (if (null? cols) null (cdr cols))])
|
||||||
|
(performance-region
|
||||||
|
['eval 'resolve-find]
|
||||||
(find-col-file (if (not subm-path)
|
(find-col-file (if (not subm-path)
|
||||||
show-collection-err
|
show-collection-err
|
||||||
;; Invent a fictional collection directory, if necessary,
|
;; Invent a fictional collection directory, if necessary,
|
||||||
|
@ -474,7 +479,7 @@
|
||||||
col
|
col
|
||||||
col-path
|
col-path
|
||||||
f-file
|
f-file
|
||||||
#t))))]
|
#t))))))]
|
||||||
[(string? s)
|
[(string? s)
|
||||||
(let* ([dir (get-dir)])
|
(let* ([dir (get-dir)])
|
||||||
(or (path-cache-get (cons s dir))
|
(or (path-cache-get (cons s dir))
|
||||||
|
|
|
@ -1917,7 +1917,7 @@ static Scheme_Object *begin0_execute(Scheme_Object *obj)
|
||||||
p->values_buffer = NULL;
|
p->values_buffer = NULL;
|
||||||
} else {
|
} else {
|
||||||
mv = NULL;
|
mv = NULL;
|
||||||
mc = 0; /* makes compilers happy */
|
mc = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
apos = 1;
|
apos = 1;
|
||||||
|
@ -1925,7 +1925,7 @@ static Scheme_Object *begin0_execute(Scheme_Object *obj)
|
||||||
ignore_result(_scheme_eval_linked_expr_multi(((Scheme_Sequence *)obj)->array[apos++]));
|
ignore_result(_scheme_eval_linked_expr_multi(((Scheme_Sequence *)obj)->array[apos++]));
|
||||||
}
|
}
|
||||||
|
|
||||||
if (mv) {
|
if (mc != 1) {
|
||||||
Scheme_Thread *p = scheme_current_thread;
|
Scheme_Thread *p = scheme_current_thread;
|
||||||
p->ku.multiple.array = mv;
|
p->ku.multiple.array = mv;
|
||||||
p->ku.multiple.count = mc;
|
p->ku.multiple.count = mc;
|
||||||
|
|
|
@ -2330,7 +2330,6 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
|
||||||
if (!result_ignored && (count > 1)) {
|
if (!result_ignored && (count > 1)) {
|
||||||
mz_pushr_p(JIT_R0);
|
mz_pushr_p(JIT_R0);
|
||||||
if (multi_ok) {
|
if (multi_ok) {
|
||||||
mz_pushr_p(JIT_R0);
|
|
||||||
mz_pushr_p(JIT_R0);
|
mz_pushr_p(JIT_R0);
|
||||||
mz_pushr_p(JIT_R0);
|
mz_pushr_p(JIT_R0);
|
||||||
mz_rs_sync();
|
mz_rs_sync();
|
||||||
|
|
Loading…
Reference in New Issue
Block a user