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) (for-each (lambda (thread)
(if (thread-continuation thread) (if (thread-continuation thread)
(begin (begin
(remove-thread-from-queue! thread) (remove-thread-from-queues! thread)
(interrupt-thread thread (interrupt-thread thread
(lambda ignore (lambda ignore
(terminate-current-thread))) (terminate-current-thread)))

3
scheme/interfaces.scm
View File

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

34
scheme/rts/thread.scm
View File

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