You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
23 lines
749 B
Scheme
23 lines
749 B
Scheme
(define $threads (foreign-procedure "(cs)threads" () scheme-object))
|
|
(define $nthreads 1)
|
|
(define $yield
|
|
(let ([t (make-time 'time-duration 1000000 0)])
|
|
(lambda () (sleep t))))
|
|
(define $thread-check
|
|
(lambda ()
|
|
(let loop ([n 100] [nt (length ($threads))])
|
|
(cond
|
|
[(<= nt $nthreads)
|
|
(set! $nthreads nt)
|
|
(collect)]
|
|
[else
|
|
($yield)
|
|
(let* ([ls ($threads)] [nnt (length ls)])
|
|
(cond
|
|
[(< nnt nt) (loop n nnt)]
|
|
[(= n 0)
|
|
(set! $nthreads nnt)
|
|
(errorf #f "extra threads running ~s" ls)]
|
|
[else (loop (- n 1) nnt)]))]))
|
|
#t))
|