suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 314d99f90aaa541dad8b67b7add0ede20357dcd9
This commit is contained in:
Matthew Flatt 1998-10-28 00:27:31 +00:00
parent c3170d6181
commit 8c25972909
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/mred/mem.ss
View File

@ -3,8 +3,8 @@
(define source-dir (current-load-relative-directory)) (define source-dir (current-load-relative-directory))
(define num-times 8) (define num-times 10)
(define num-threads 3) (define num-threads 6)
(define dump-stats? #f) (define dump-stats? #f)
@ -196,16 +196,27 @@
(define (stw t n) (define (stw t n)
(thread-weight t (floor (/ (thread-weight t) n)))) (thread-weight t (floor (/ (thread-weight t) n))))
(define (breakable t)
(if #t
(thread (lambda ()
(read)
(printf "breaking~n")
(break-thread t)
(thread-wait t)
(printf "done~n")))
(void)))
(define (do-test) (define (do-test)
(let ([sema (make-semaphore)]) (let ([sema (make-semaphore)])
(let loop ([n num-threads]) (let loop ([n num-threads])
(unless (zero? n) (unless (zero? n)
(thread (lambda () (breakable
(stw (current-thread) n) (thread (lambda ()
(dynamic-wind (stw (current-thread) n)
void (dynamic-wind
(lambda () (maker n num-times)) void
(lambda () (semaphore-post sema))))) (lambda () (maker n num-times))
(lambda () (semaphore-post sema))))))
(loop (sub1 n)))) (loop (sub1 n))))
(let loop ([n num-threads]) (let loop ([n num-threads])
(unless (zero? n) (unless (zero? n)