[Chicken-users] ##sys#schedule

[Joerg F. Wittenberger]

Hi,

(sorry, just found this mail I forgot to send yesterday)
my "improvements" to ##sys#schedule had one 'dbg' statement too much, so
it works _only_ with debugging - or take this one:

(define (##sys#schedule)
  (define (switch thread)
    (dbg "switching to " thread)
    (set! ##sys#current-thread thread)
    (##sys#setslot thread 3 'running)
    (##sys#restore-thread-state-buffer thread)
    (##core#inline "C_set_initial_timer_interrupt_period" (##sys#slot thread 9))
    ((##sys#slot thread 1)) )
  (let* ([ct ##sys#current-thread]
         [cts (##sys#slot ct 3)] )
    (dbg "scheduling, current: " ct ", ready: " ##sys#ready-queue-head)
    (##sys#update-thread-state-buffer ct)
    ;; Put current thread on ready-queue:
    (when (or (eq? cts 'running) (eq? cts 'ready)) ; should ct really be 
'ready? - normally not.
      (##sys#add-to-ready-queue ct) )
    (let loop1 ()
      ;; Unblock threads waiting for timeout:
      (unless (null? ##sys#timeout-list)
        (let ([now (##sys#fudge 16)])
          (dbg "timeout (" tm ") list: " ##sys#timeout-list)
          (let loop ([lst ##sys#timeout-list])
            (if (null? lst)
                (set! ##sys#timeout-list '())
                (let* ([tmo1 (caar lst)]
                       [tto (cdar lst)]
                       [tmo2 (##sys#slot tto 4)] )
                  (dbg "  " tto " -> " tmo2)
                  (if (eq? tmo1 tmo2)
                      (if (>= now tmo1)
                          (begin
                            (##sys#thread-unblock! tto)
                            (loop (cdr lst)) )
                          (set! ##sys#timeout-list lst) )
                      (loop (cdr lst)) ) ) ) ) ) )
      ;; Unblock threads blocked by I/O:
      (unless (null? ##sys#fd-list)
        (##sys#unblock-threads-for-i/o
         (or (and (null? ##sys#ready-queue-head)
                  ;; FIXME 20ms seems "reasonable", it's by no means
                  ;; justified.
                  20000)
             0)) )
      ;; Fetch and activate next ready thread:
      (let loop2 ()
        (let ([nt (##sys#remove-from-ready-queue)])
          (cond [(not nt) 
                 (if (and (null? ##sys#timeout-list) (null? ##sys#fd-list))
                     (##sys#signal-hook #:runtime-error "deadlock")
                     (loop1)) ]
                [(eq? (##sys#slot nt 3) 'ready) (switch nt)]
                [else (loop2)] ) ) ) ) ) )

/Jörg

BTW: concerning nursery size: at my PIII laptop with 192MB RAM I have
128k and 256k close by.  Most of the time 128k but often enough 256k.
I wonder whether I might experience even better results with 192k.
Next compile we'll know.

-- 
The worst of harm may often result from the best of intentions.