62 lines
1.7 KiB
Scheme
62 lines
1.7 KiB
Scheme
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
|
|
|
|
; 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)
|
|
|
|
(define (insert x l <)
|
|
(cond ((null? l) (list x))
|
|
((< x (car l)) (cons x l))
|
|
(else (cons (car l) (insert x (cdr l) <)))))
|
|
|
|
; Called by root scheduler, so won't be interrupted.
|
|
; This returns two values, a boolean that indicates if any threads were
|
|
; woken and the time until the next sleeper wakes. We have to check for
|
|
; threads that have been started for some other reason.
|
|
|
|
(define (wake-some-threads)
|
|
(if (null? *dozers*)
|
|
(values #f #f)
|
|
(let ((time (real-time)))
|
|
(let loop ((dozers *dozers*) (woke? #f))
|
|
(if (null? dozers)
|
|
(begin
|
|
(set! *dozers* '())
|
|
(values woke? #f))
|
|
(let ((next (car dozers)))
|
|
(cond ((thread-queue-empty? (cdr next))
|
|
(loop (cdr dozers) woke?))
|
|
((< time (car next))
|
|
(set! *dozers* dozers)
|
|
(values woke? (- (car next) time)))
|
|
(else
|
|
(make-ready (dequeue-thread! (cdr next)))
|
|
(loop (cdr dozers) #t)))))))))
|