Re: [Chicken-users] fix for multiple entries in ##sys#timeout-list

[F. Wittenberger]

Am Samstag, den 27.09.2008, 15:14 +0200 schrieb felix winkelmann:
> On Fri, Sep 26, 2008 at 2:37 PM, Jörg F. Wittenberger
> <address@hidden> wrote:
> > The current trunk still leaves threads in the ##sys#timeout-list when a
> > thread-join! joins successfully and the timeout is not reached.
> >
> > No test case, take my word for it please.  I've seen them in the thread
> > listing and I've seen the joining thread getting unblocked by the left
> > over timeout when it did not expect to be unblocked at all.
> >
> 
> I'll check this - please give a moment. Are you sure you are not
> mixing up threads in "thread-join!"? You remove the current thread
> from the timeout-list, which should already be removed by having
> status dead/terminated. What am I missing here? (I obviously am,
> as I fully believe you, when you say threads are left on the timeout
> list. I just want to understand why)

To my understanding, something else is going on.

(define thread-join!
  (lambda (thread . timeout)
    (##sys#check-structure thread 'thread 'thread-join!)
    (let* ((limit (and (pair? timeout) (##sys#compute-time-limit (##sys#slot 
timeout 0))))
           (rest (and (pair? timeout) (##sys#slot timeout 1)))
           (tosupplied (and rest (pair? rest)))
           (toval (and tosupplied (##sys#slot rest 0))) )
      (##sys#call-with-current-continuation
       (lambda (return)
         (let ([ct ##sys#current-thread])
           (when limit (##sys#thread-block-for-timeout! ct limit))
           (##sys#setslot
            ct 1
            (lambda ()
              (case (##sys#slot thread 3)

Tested to be 'dead or 'terminated is "thread", "thread" was already removed by 
thread-kill!

                [(dead)

Now I remove "ct" too, which is the thread, which called thread-join! with 
timeout "limit".
since the thread terminated either way, the timeout limit is probably
not reached and the thread "ct" needs to be removed from the timeout
queue.

                 (if (not (##sys#slot thread 13) ) ; not unblocked by timeout
                     (##sys#remove-from-timeout-list ct))
                 (apply return (##sys#slot thread 2))]
                [(terminated)
                 (if (not (##sys#slot thread 13) ) ; not unblocked by timeout
                     (##sys#remove-from-timeout-list ct))
                 (return 
                  (##sys#signal
                   (##sys#make-structure 
                    'condition '(uncaught-exception)
                    (list '(uncaught-exception . reason) (##sys#slot thread 7)) 
) ) ) ]
                [else
                 (return
                  (if tosupplied
                      toval
                      (##sys#signal
                       (##sys#make-structure 'condition 
'(join-timeout-exception) '())) ) ) ] ) ) )
           (##sys#thread-block-for-termination! ct thread) 
           (##sys#schedule) ) ) ) ) ) )