[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Re : [Chicken-users] thread-sleep! for less than a second
From: |
felix winkelmann |
Subject: |
Re: Re : [Chicken-users] thread-sleep! for less than a second |
Date: |
Wed, 17 Jan 2007 11:41:18 +0100 |
On 1/16/07, Daishi Kato <address@hidden> wrote:
Or, since timeout for these procedures including thread-sleep! can be
a time object,
introducing time->milliseconds and milliseconds->time would be sufficient.
It's now checked into the darcs repo, here the patch:
--- old-chicken/srfi-18.scm 2007-01-17 11:38:01.609268408 +0100
+++ new-chicken/srfi-18.scm 2007-01-17 11:38:01.613267800 +0100
@@ -1,4 +1,4 @@
-;;; srfi-18.scm - Simple thread unit - felix
+;;;; srfi-18.scm - Simple thread unit - felix
;
; Copyright (c) 2000-2007, Felix L. Winkelmann
; All rights reserved.
@@ -121,6 +121,11 @@
(##sys#check-structure tm 'time 'time->seconds)
(+ (##sys#slot tm 2) (/ (##sys#slot tm 3) 1000)) )
+(define (time->milliseconds tm)
+ (##sys#check-structure tm 'time 'time->milliseconds)
+ (+ (inexact->exact (* (- (##sys#slot tm 2) C_startup_time_seconds) 1000))
+ (##sys#slot tm 3) ) )
+
(define (seconds->time n)
(##sys#check-number n 'seconds->time)
(let* ([n2 (max 0 (- n C_startup_time_seconds))] ; seconds since startup
@@ -128,6 +133,11 @@
[n3 (inexact->exact (truncate (+ (* n2 1000) ms)))] ) ;
milliseconds since startup
(##sys#make-structure 'time n3 (truncate n) (inexact->exact ms)) ) )
+(define (milliseconds->time nms)
+ (##sys#check-exact nms 'milliseconds->time)
+ (let ((s (+ C_startup_time_seconds (/ nms 1000))))
+ (##sys#make-structure 'time nms s 0) ) )
+
(define (time? x) (##sys#structure? x 'time))
(define srfi-18:time? time?)
@@ -281,16 +291,16 @@
(##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! tm)
+ (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) ) ) ) )
+ (unless tm (##sys#signal-hook #:type-error 'thread-sleep! "invalid
timeout argument" tm))
+ (sleep (##sys#compute-time-limit tm) 'thread-sleep!) )
;;; Mutexes:
cheers,
felix
- [Chicken-users] thread-sleep! for less than a second, minh thu, 2007/01/12
- Re: [Chicken-users] thread-sleep! for less than a second, Kon Lovett, 2007/01/12
- Re : [Chicken-users] thread-sleep! for less than a second, minh thu, 2007/01/12
- Re: Re : [Chicken-users] thread-sleep! for less than a second, Daishi Kato, 2007/01/12
- Re: Re : [Chicken-users] thread-sleep! for less than a second, felix winkelmann, 2007/01/15
- Message not available
- Fwd: Re : [Chicken-users] thread-sleep! for less than a second, Daishi Kato, 2007/01/15
- Re: Re : [Chicken-users] thread-sleep! for less than a second, felix winkelmann, 2007/01/16
- Re: Re : [Chicken-users] thread-sleep! for less than a second, Daishi Kato, 2007/01/16
- Re: Re : [Chicken-users] thread-sleep! for less than a second, felix winkelmann, 2007/01/16
- Re : Re : [Chicken-users] thread-sleep! for less than a second, minh thu, 2007/01/16
- Message not available
- Re: Re : [Chicken-users] thread-sleep! for less than a second,
felix winkelmann <=