fix space-safety of JIT-generated apply

In a non-tail position, a JIT-generated application of `apply`
retained the argument list until the called function returned.
Fix it to drop the reference to the list before the function
is called.
This commit is contained in:
Matthew Flatt 2017-08-04 07:23:50 -06:00
parent cbfcc904ab
commit 05c5c4fa3e
2 changed files with 34 additions and 3 deletions

View File

@ -420,6 +420,36 @@
(and (attempts . > . 1)
(loop (sub1 attempts)))))))
;; ----------------------------------------
;; Check that `apply` doesn't retain its argument
(when (eq? '3m (system-type 'gc))
(define retained 0)
(define (f ignored b k)
(collect-garbage)
(when (weak-box-value b)
(set! retained (add1 retained)))
(k))
(set! f f)
(define (mk . args) args)
(set! mk mk)
;; Tail version:
(let loop ([i 5])
(unless (zero? i)
(define val (gensym))
(apply f (mk val (make-weak-box val) (lambda () (loop (sub1 i)))))))
;; Non-tail version:
(for ([i 5])
(define val (gensym))
(apply f (mk val (make-weak-box val) void)))
(test #t < retained 3))
;; ----------------------------------------
(report-errs)

View File

@ -4008,9 +4008,10 @@ static int more_common1(mz_jit_state *jitter, void *_data)
is still argv, but R1 doesn't have the count any more;
we re-compute R1 as we traverse the list again. */
jit_subi_l(JIT_R0, JIT_V1, 1);
jit_lshi_ul(JIT_R0, JIT_R0, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R0, JIT_RUNSTACK, JIT_R0);
jit_subi_l(JIT_R1, JIT_V1, 1);
jit_lshi_ul(JIT_R1, JIT_R1, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R0, JIT_RUNSTACK, JIT_R1);
jit_stxr_p(JIT_R1, JIT_RUNSTACK, JIT_RUNSTACK); /* clear list from runstack */
CHECK_LIMIT();
jit_subi_l(JIT_R1, JIT_V1, 2); /* drop first and last original arg */