From 8b44999d55beb96607f34f38562d0ff194cd9195 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 7 Jun 2001 16:14:29 +0000
Subject: [PATCH] Really fixed the bug in sleep. The previous fix was totally
 broken.

---
 scheme/rts/sleep.scm | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/scheme/rts/sleep.scm b/scheme/rts/sleep.scm
index f7ea628..dc5728f 100644
--- a/scheme/rts/sleep.scm
+++ b/scheme/rts/sleep.scm
@@ -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)