Update of /cvsroot/scsh/scsh-0.6/scheme/rts
In directory usw-pr-cvs1:/tmp/cvs-serv3639
Modified Files:
sleep.scm
Log Message:
Really fixed the bug in sleep. The previous fix was totally broken.
Index: sleep.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/rts/sleep.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** sleep.scm 2001/05/30 15:55:55 1.2
--- sleep.scm 2001/06/07 16:14:29 1.3
***************
*** 3,17 ****
; Sleeping for N milliseconds.
! (define (sleep n)
! (let ((queue (make-thread-queue))) ; only one entry, but it must be a queue
! (disable-interrupts!)
! (enqueue-thread! queue (current-thread))
! (set! *dozers*
! (insert (cons (+ (real-time) (inexact->exact (round n)))
! queue)
! *dozers*
! (lambda (frob1 frob2)
! (< (car frob1) (car frob2)))))
! (block)))
(define *dozers* '()) ; List of (wakeup-time . queue)
--- 3,32 ----
; Sleeping for N milliseconds.
! (define (sleep user-n)
! (let ((n (coerce-to-nonnegative-integer user-n)))
! (cond ((not n)
! (call-error "wrong type argument" sleep user-n))
! ((< 0 n)
! (let ((queue (make-thread-queue))) ; only one entry, but it must be
a queue
! (disable-interrupts!)
! (enqueue-thread! queue (current-thread))
! (set! *dozers*
! (insert (cons (+ (real-time) n)
! queue)
! *dozers*
! (lambda (frob1 frob2)
! (< (car frob1) (car frob2)))))
! (block))))))
!
! (define (coerce-to-nonnegative-integer n)
! (if (real? n)
! (let* ((n (round n))
! (n (if (exact? n)
! n
! (inexact->exact n))))
! (if (<= 0 n)
! n
! #f))
! #f))
(define *dozers* '()) ; List of (wakeup-time . queue)
|