~ chicken-core (chicken-5) f9c40d5cd167ed97130ef76a49b1d9cb26636831

commit f9c40d5cd167ed97130ef76a49b1d9cb26636831
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Aug 12 03:24:26 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Aug 12 03:24:26 2010 -0400

    use correct comparison routine in timeout-check of scheduler (thanks to zbigniew); setup-download prints dots for downloaded chunks

diff --git a/scheduler.scm b/scheduler.scm
index 52149bd5..15d100be 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -110,12 +110,12 @@ EOF
 	  (let loop ((lst ##sys#timeout-list))
 	    (if (null? lst)
 		(set! ##sys#timeout-list '())
-		(let* ([tmo1 (caar lst)]
-		       [tto (cdar lst)]
-		       [tmo2 (##sys#slot tto 4)] )
+		(let* ([tmo1 (caar lst)] ; timeout of thread on list
+		       [tto (cdar lst)]	 ; thread on list
+		       [tmo2 (##sys#slot tto 4)] ) ; timeout value stored in thread
 		  (dbg "  " tto " -> " tmo2)
-		  (if (= tmo1 tmo2)
-		      (if (fp>= now tmo1)
+		  (if (equal? tmo1 tmo2)  ;XXX why do we check this?
+		      (if (fp>= now tmo1) ; timeout reached?
 			  (begin
 			    (##sys#setislot tto 13 #t) ; mark as being unblocked by timeout
 			    (##sys#clear-i/o-state-for-thread! tto)
diff --git a/setup-download.scm b/setup-download.scm
index 02a687ad..5a94ab99 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -261,7 +261,7 @@
 		(d "~a~%" ln)
 		(loop) ) ) ) )
 	(when chunked
-	  (d "reading chunks ...~%")
+	  (d "reading chunks ")
 	  (let ([data (read-chunks in)])
 	    (close-input-port in)
 	    (set! in (open-input-string data))) ) )
@@ -301,11 +301,14 @@
   (define (read-chunks in)
     (let get-chunks ([data '()])
       (let ([size (string->number (read-line in) 16)])
-	(if (zero? size)
-	    (string-concatenate-reverse data)
-	    (let ([chunk (read-string size in)])
-	      (read-line in)
-	      (get-chunks (cons chunk data)) ) ) ) ) )
+	(cond ((zero? size)
+	       (d "~%")
+	       (string-concatenate-reverse data))
+	      (else
+	       (let ([chunk (read-string size in)])
+		 (d ".")
+		 (read-line in)
+		 (get-chunks (cons chunk data)) ) ) ) ) ))
 
   (define (retrieve-extension name transport location
                               #!key version quiet destination username password tests