Really fixed the bug in sleep. The previous fix was totally broken.

This commit is contained in:
mainzelm 2001-06-07 16:14:29 +00:00
parent f91b93f16a
commit 8b44999d55
1 changed files with 26 additions and 11 deletions

View File

@ -2,17 +2,32 @@
; 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 (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)