[Chicken-users] more on thread performance

[F. Wittenberger]

Hi all,

I just tried the code below (compiled with disable-interrupts).  Effect
on my server

httperf --hog --server 127.0.0.1 --port 2009 --num-conn 1000 --ra 100
--max-piped-calls 20 --timeout 1000 

from ~8 request/second up to almost 12.

What's changed?  a) remove a variable of no use b) avoid allocating an
unused lambda c) most important: no penalty (forced scheduling) for the
unlocking thread.

Best regards

/Jörg

BTW: >600 threads on the ready queue make me wondering... ;-)

(global-set!
 'mutex-unlock!
 (lambda (mutex . cvar-and-to)
   (##sys#check-structure mutex 'mutex 'mutex-unlock!)
   (let ([ct ##sys#current-thread]
         [cvar (and (pair? cvar-and-to) (car cvar-and-to))]
         [timeout (and (fx> (length cvar-and-to) 1) (cadr cvar-and-to))] )
     (dbg ct ": unlocking " mutex)
     (when cvar (##sys#check-structure cvar 'condition-variable
'mutex-unlock!))
     (##sys#call-with-current-continuation
      (lambda (return)
        (let ([waiting (##sys#slot mutex 3)]
              [limit (and timeout (##sys#compute-time-limit timeout))] )
          (##sys#setislot mutex 4 #f)
          (##sys#setislot mutex 5 #f)
          (##sys#setslot ct 8 (##sys#delq mutex (##sys#slot ct 8)))
          (when cvar
                (##sys#setslot cvar 2 (##sys#append (##sys#slot cvar 2) 
(##sys#list
ct)))
                (cond [limit
                       (##sys#setslot 
                        ct 1
                        (lambda () 
                          (##sys#setslot cvar 2 (##sys#delq ct (##sys#slot cvar 
2)))
                          (unless (##sys#slot ct 13)  ; not unblocked by timeout
                                  (##sys#remove-from-timeout-list ct))
                          (return #f) ) )
                       (##sys#thread-block-for-timeout! ct limit) ]
                      [else
                       (##sys#setslot ct 1 (lambda () (return #t)))
                       (##sys#setslot ct 3 'sleeping)] ) )
          (unless (null? waiting)
                  (let* ([wt (##sys#slot waiting 0)]
                         [wts (##sys#slot wt 3)] )
                    (##sys#setslot mutex 3 (##sys#slot waiting 1))
                    (##sys#setislot mutex 5 #t)
                    (when (or (eq? wts 'blocked) (eq? wts 'sleeping))
                          (##sys#setslot mutex 2 wt)
                          (##sys#setslot wt 8 (cons mutex (##sys#slot wt 8)))
                          (when (eq? wts 'sleeping) (##sys#add-to-ready-queue 
wt) ) ) ) )
          (if (eq? (##sys#slot ct 3) 'running)
              (begin
                (##sys#setslot ct 1 (lambda () (return (##core#undefined))))
                #t))
          (##sys#schedule) ) ) ) ) ))