chicken-users
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Chicken-users] Is there a way to get tcp-accept to time-out?


From: felix winkelmann
Subject: Re: [Chicken-users] Is there a way to get tcp-accept to time-out?
Date: Sun, 27 Feb 2005 09:44:28 +0100

Well, this works of course only with a correct implementation of 
##sys#thread-unblock!.

Here it is (replace the old definition in scheduler.scm):


(define (##sys#thread-unblock! t)
  (when (eq? 'blocked (##sys#slot t 3))
    (set! ##sys#timeout-list (##sys#delq t ##sys#timeout-list))
    (set! ##sys#fd-list 
      (let loop ([fdl ##sys#fd-list])
        (if (null? fdl)
            '()
            (let ([a (##sys#slot fdl 0)])
              (cons
               (cons (##sys#slot a 0)
                     (##sys#delq t (##sys#slot a 1)) )
               (loop (##sys#slot fdl 1)) ) ) ) ) )
    (##sys#setislot t 12 '())
    (##sys#thread-basic-unblock! t) ) )

(Sorry, that should have been mentioned in my previous mail...)


cheers,
felix


On Sat, 26 Feb 2005 17:14:27 +0100, felix winkelmann <address@hidden> wrote:
> On Fri, 25 Feb 2005 10:40:03 -0500, Ed Watkeys <address@hidden> wrote:
> >
> > I'm going to investigate using a signal handler to deal with my
> > problem. After all, I don't care about returning from TCP-ACCEPT every
> > x seconds. The point of timing-out is to check if someone has requested
> > a server shutdown. I just need to make sure the appropriate
> > (TCP-ACCEPT-ing) thread is interrupted by the signal.
> 
> Here is a solution that might work (sorry for the low-level hacks):
> 
> (use srfi-18 tcp)
> 
> (define l (tcp-listen 6502))
> 
> (define (wait t s)
>   (thread-start!
>    (lambda ()
>      (print "sleeping...")
>      (thread-sleep! s)
>      (print "unblocking")
>      (when (eq? 'blocked (thread-state t))
>        (##sys#thread-unblock! t) ) ) ) )
> 
> (define (run)
>   (thread-wait-for-i/o (tcp-listener-fileno l))
>   (if (tcp-accept-ready? l)
>       (begin
>         (print "accepting...")
>         (let-values ([(i o) (tcp-accept l)])
>           (print (list i o)) ) )
>       (print "timeout") ) )
> 
> (define (tcp-listener-fileno l)
>   (##sys#check-structure l 'tcp-listener 'tcp-listener-fileno)
>   (##sys#slot l 1) )
> 
> (define (thread-wait-for-i/o fd #!optional (input #t))
>   (##sys#thread-block-for-i/o! (current-thread) fd input)
>   (thread-yield!) )
> 
> (wait (current-thread) 2)
> (run)
> (wait (current-thread) 2)
> (run)
> (wait (current-thread) 2)
> (run)
> 
> cheers,
> felix
>




reply via email to

[Prev in Thread] Current Thread [Next in Thread]