Fwd: Re : [Chicken-users] thread-sleep! for less than a second

[Daishi Kato]

This is supposed to go the chicken ML.

---------- Forwarded message ----------
From: Daishi Kato <address@hidden>
Date: Jan 16, 2007 10:43 AM
Subject: Re: Re : [Chicken-users] thread-sleep! for less than a second
To: felix winkelmann <address@hidden>


Thanks a lot!

BTW, timeout is also used for thread-join!, mutex-lock! and
mutex-unlock! in srfi-18.
It'd be more consistent to have */ms procedures for these above.
Or, since timeout for these procedures including thread-sleep! can be
a time object,
introducing time->milliseconds and milliseconds->time would be sufficient.

Comments are welcome.
Daishi

On 1/16/07, felix winkelmann <address@hidden> wrote:
> On 1/13/07, Daishi Kato <address@hidden> wrote:
> > Hi,
> >
> > That was something that I could not notice either at first.
> > Another issue for me is that I want to declare fixnum
> > when all other procedures are fixnum arithmetic.
> > So, I wished thread-sleep-millis!
> > Any workaround for this? Maybe making a tiny egg for this?
> >
>
> I have added it (called `thread-sleep!/ms') to srfi-18. Here is the patch:
>
> diff -rN -u old-chicken/srfi-18.scm new-chicken/srfi-18.scm
> --- old-chicken/srfi-18.scm     2007-01-15 20:18:45.000000000 +0100
> +++ new-chicken/srfi-18.scm     2007-01-15 20:18:45.000000000 +0100
> @@ -281,16 +281,25 @@
>      (##sys#setslot thread 3 'ready)
>      (##sys#add-to-ready-queue thread) ) )
>
> -(define thread-sleep!
> -  (lambda (tm)
> -    (unless tm (##sys#signal-hook #:type-error 'thread-sleep!
> "invalid timeout argument" tm))
> +(define thread-sleep!)
> +(define thread-sleep!/ms)
> +
> +(let ()
> +  (define (sleep limit loc)
>      (##sys#call-with-current-continuation
>       (lambda (return)
> -       (let ([limit (##sys#compute-time-limit tm)]
> -            [ct ##sys#current-thread] )
> +       (let ((ct ##sys#current-thread))
>          (##sys#setslot ct 1 (lambda () (return (##core#undefined))))
>          (##sys#thread-block-for-timeout! ct limit)
> -        (##sys#schedule) ) ) ) ) )
> +        (##sys#schedule) ) ) ) )
> +  (set! thread-sleep!
> +    (lambda (tm)
> +      (unless tm (##sys#signal-hook #:type-error 'thread-sleep!
> "invalid timeout argument" tm))
> +      (sleep (##sys#compute-time-limit tm)) ) )
> +  (set! thread-sleep!/ms
> +    (lambda (ms)
> +      (##sys#check-exact ms 'thread-sleep!/ms)
> +      (sleep (fx+ (##sys#fudge 16) ms)) ) ) )
>
>
> cheers,
> felix