[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