Really fixed the bug in sleep. The previous fix was totally broken.
This commit is contained in:
parent
f91b93f16a
commit
8b44999d55
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in New Issue