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

A thread may life in multiple queues.

This commit is contained in:
mainzelm 2001-10-04 11:16:15 +00:00
parent 2fbc2b159e
commit 9552e7900a
3 changed files with 25 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/env/command-level.scm vendored
View File

@ -299,7 +299,7 @@
(for-each (lambda (thread)
(if (thread-continuation thread)
(begin
(remove-thread-from-queue! thread)
(remove-thread-from-queues! thread)
(interrupt-thread thread
(lambda ignore
(terminate-current-thread)))

3
scheme/interfaces.scm
View File

@ -564,8 +564,9 @@
make-thread-queue
thread-queue-empty?
enqueue-thread!
multiple-enqueue-thread!
dequeue-thread!
remove-thread-from-queue!
remove-thread-from-queues!
event-pending?
get-next-event!

34
scheme/rts/thread.scm
View File

@ -42,7 +42,7 @@
(really-make-thread dynamic-env dynamic-point
cell-values own-cell-values?
continuation scheduler
queue arguments
queues arguments
events current-task uid name)
thread?
(dynamic-env thread-dynamic-env) ;Must be first! (See fluid.scm)
@ -54,7 +54,7 @@
;Must be fourth! (See thread-cell.scm)
(own-cell-values? thread-own-cell-values? set-thread-own-values?!)
(continuation thread-continuation set-thread-continuation!)
(queue thread-queue set-thread-queue!)
(queues thread-queues set-thread-queues!)
(arguments thread-arguments set-thread-arguments!)
(time thread-time set-thread-time!)
(scheduler thread-scheduler set-thread-scheduler!)
@ -173,22 +173,28 @@
(define thread-queue-empty? queue-empty?)
(define (enqueue-thread! queue thread)
(if (thread-queue thread)
(if (thread-queues thread)
(error "enqueued thread being added to another queue" thread queue))
(set-thread-queue! thread queue)
(set-thread-queues! thread (list queue))
(enqueue! queue thread))
(define (multiple-enqueue-thread! queues thread)
(if (thread-queues thread)
(error "enqueued thread being added to another queue" thread queues))
(set-thread-queues! thread queues)
(for-each (lambda (q) (enqueue! q thread)) queues))
(define (dequeue-thread! queue)
(let ((thread (dequeue! queue)))
(set-thread-queue! thread #f)
(for-each (lambda (q) (delete-from-queue! q thread)) (thread-queues thread))
(set-thread-queues! thread #f)
thread))
(define (remove-thread-from-queue! thread)
(if (thread-queue thread)
(define (remove-thread-from-queues! thread)
(if (thread-queues thread)
(begin
(delete-from-queue! (thread-queue thread) thread)
(set-thread-queue! thread #f))))
(for-each (lambda (q) (delete-from-queue! q thread)) (thread-queues thread))
(set-thread-queues! thread #f))))
;----------------
(define current-thread (structure-ref primitives current-thread))
@ -239,8 +245,12 @@
((not (eq? (thread-scheduler thread) scheduler))
(enable-interrupts!)
(error "thread run by wrong scheduler" thread scheduler))
((thread-queue thread)
((thread-queues thread)
(enable-interrupts!)
(apply debug-message (list "thread run while still on a queue "
(thread-uid thread)
(thread-name thread)
(thread-queues thread)))
(error "thread run while still on a queue" thread))
((and (thread-current-task thread)
(not (null? (thread-arguments thread))))
@ -577,7 +587,7 @@
; Enqueue a RUNNABLE for THREAD's scheduler.
(define (make-ready thread . args)
(if (thread-queue thread)
(if (thread-queues thread)
(error "trying to schedule a queued thread" thread))
; (if (not (null? (thread-arguments thread)))
; (error "trying to replace thread arguments"))