scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Let thread-uid->thread invoke the GC if it encounters multiple threads with the same uid.

This commit is contained in:
mainzelm 2001-11-08 10:24:41 +00:00
parent 143d96954b
commit 1ed75d8531
1 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
scheme/rts/thread.scm
View File

@ -108,15 +108,32 @@
; by rts/channel-port.scm to when forcibly unlocking one of the REPL's ports. ; by rts/channel-port.scm to when forcibly unlocking one of the REPL's ports.
(define (thread-uid->thread uid) (define (thread-uid->thread uid)
(let ((matching-threads (threads-with-uid uid)))
(cond ((null? matching-threads) #f)
((null? (cdr matching-threads))
(car matching-threads))
(else (set! matching-threads #f)
((structure-ref primitives collect))
(let ((new-matching-threads (threads-with-uid uid)))
(cond ((null? new-matching-threads) #f)
((null? (cdr new-matching-threads))
(car new-matching-threads))
(else (debug-message "duplicate thread uid"
new-matching-threads)
(car new-matching-threads))))))))
(define (threads-with-uid uid)
(let ((threads (all-threads))) (let ((threads (all-threads)))
(let loop ((i 0)) (let loop ((i 0))
(cond ((= i (vector-length threads)) (cond ((= i (vector-length threads))
#f) '())
((= uid (thread-uid (vector-ref threads i))) ((= uid (thread-uid (vector-ref threads i)))
(vector-ref threads i)) (cons (vector-ref threads i) (loop (+ i 1))))
(else (else
(loop (+ i 1))))))) (loop (+ i 1)))))))
(define (all-threads) (define (all-threads)
((structure-ref primitives find-all-records) :thread)) ((structure-ref primitives find-all-records) :thread))