Update of /cvsroot/scsh/scsh-0.6/scheme/rts
In directory usw-pr-cvs1:/tmp/cvs-serv13500
Modified Files:
thread.scm
Log Message:
Let thread-uid->thread invoke the GC if it encounters multiple threads with the
same uid.
Index: thread.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/rts/thread.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** thread.scm 2001/10/04 11:16:15 1.4
--- thread.scm 2001/11/08 10:24:41 1.5
***************
*** 109,120 ****
(define (thread-uid->thread uid)
(let ((threads (all-threads)))
(let loop ((i 0))
(cond ((= i (vector-length threads))
! #f)
((= uid (thread-uid (vector-ref threads i)))
! (vector-ref threads i))
! (else
! (loop (+ i 1)))))))
(define (all-threads)
--- 109,137 ----
(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 loop ((i 0))
(cond ((= i (vector-length threads))
! '())
((= uid (thread-uid (vector-ref threads i)))
! (cons (vector-ref threads i) (loop (+ i 1))))
! (else
! (loop (+ i 1)))))))
!
!
(define (all-threads)
|