Prove GC is cooperating w/blocked thread

This commit is contained in:
Justin Ethier 2015-12-21 22:30:25 -05:00
parent ac9b197803
commit c41e80a6ae
2 changed files with 33 additions and 6 deletions

View file

@ -2795,6 +2795,9 @@ to look at the lock-free structures provided by ck?
*/
void Cyc_end_thread(gc_thread_data *thd)
{
// TODO: should we consider passing the current continuation (and args)
// as an argument? if we don't, will objects be collected that are still
// being used by active threads??
mclosure0(clo, Cyc_exit_thread);
GC(thd, &clo, thd->gc_args, 0);
}

View file

@ -1,13 +1,37 @@
(import (scheme base)
(scheme read)
(scheme write))
;; Spawn off a thread
(let ((t (thread-start! (make-thread (lambda () (write 'a))))))
;; Busy wait
(letrec ((foo (lambda () (bar)))
(bar (lambda () (foo))))
(foo))
)
;(let ((t (thread-start! (make-thread (lambda () (write 'a))))))
; ;; Busy wait
; (letrec ((foo (lambda () (bar)))
; (bar (lambda () (foo))))
; (foo))
;)
;; A program to prove if cooperation is working, or if it
;; is blocked by another thread. The (read) causes the main
;; thread to block. The collector should be notified prior
;; to the blocking call being made, and the collector should
;; be able to cooperate on the main thread's behalf:
(define tmp '())
(thread-start!
(make-thread
(lambda ()
;(write 'a)
(letrec ((loop (lambda ()
(set! tmp (cons "cons" tmp))
;(write tmp)
(cond
((> (length tmp) 1000)
(write "resetting tmp")
(set! tmp '()))
(else #f))
(loop))))
(loop))
)))
(read)
;;;; A temporary file to attempt to repro crashing / data corruption
;;(import (scheme base) (scheme write))