[gambit-list] Thread scheduling
Christian Jaeger
christian at pflanze.mine.nu
Sun May 20 13:47:52 EDT 2007
Hello
The priorities in the threading system seem to behave somewhat strange
(in beta21).
1. the default priority of the primordial thread is -1e10; is this
on purpose and reasonable?
2. a thread with higher priority doesn't let other threads run at
all, and this even if it calls yield. In the examples below,
the lower-priority threads are only really started after higher
priority ones have finished. Is this a feature or a bug?
Christian.
> (prio 20000000 0 2 2e100)
baseprio cur before: #<thread #1 primordial> -1e10
baseprio cur after: #<thread #1 primordial> 0.
baseprio before: #<thread #2> 0.
baseprio before: #<thread #3> 0.
baseprio after: #<thread #2> 2.
baseprio after: #<thread #3> 2e100
started: #<thread #2>
finished: #<thread #2>
started: #<thread #3>
finished: #<thread #3>
> (prio 20000000 3 2 2e100)
baseprio cur before: #<thread #1 primordial> 0.
baseprio cur after: #<thread #1 primordial> 3.
baseprio before: #<thread #4> 3.
baseprio before: #<thread #5> 3.
baseprio after: #<thread #4> 2.
baseprio after: #<thread #5> 2e100
started: #<thread #5>
finished: #<thread #5>
started: #<thread #4>
finished: #<thread #4>
;; library function (supposed to format values like |error| does):
(define warn
(lambda l
(if (pair? l)
(let ((p (current-error-port)))
(display (car l) p)
(let loop ((l (cdr l)))
(if (pair? l)
(begin
(write-char #\space p)
(write (car l) p)
(loop (cdr l)))
(newline p))))
(error "warn called without arguments"))))
;; / library
(define (prio n cur p1 p2)
(warn "baseprio cur before:" (current-thread) (thread-base-priority (current-thread)))
(thread-base-priority-set! (current-thread) cur)
(warn "baseprio cur after:" (current-thread) (thread-base-priority (current-thread)))
(let ((proc (lambda ()
(warn "started: " (current-thread))
(let lp ((i n))
(if (positive? i)
(begin
(if (zero? (modulo i 1000))
(begin
;;(warn "thread-yield of:" (current-thread))
(thread-yield!)))
(lp (- i 1)))))
(warn "finished: " (current-thread)))))
(let ((th1 (make-thread proc))
(th2 (make-thread proc)))
(warn "baseprio before:" th1 (thread-base-priority th1))
(warn "baseprio before:" th2 (thread-base-priority th2))
(thread-base-priority-set! th1 p1)
(thread-base-priority-set! th2 p2)
(warn "baseprio after:" th1 (thread-base-priority th1))
(warn "baseprio after:" th2 (thread-base-priority th2))
(thread-start! th1)
(thread-start! th2)
(thread-sleep! 3);;(to make sure the thread-join!'s don't have an influence)
(values (thread-join! th1)
(thread-join! th2)))))
More information about the Gambit-list
mailing list