Changeset 11980 in project

Timestamp:

09/23/08 00:33:15 (12 years ago)

Author:

felix winkelmann

Message:

added new version of ##sys#all-threads (contributed by Joerg Wittenberger)

File:

• chicken/trunk/scheduler.scm (modified) (1 diff)

chicken/trunk/scheduler.scm

@@ -421 +421 @@
 
 ;;; Get list of all threads that are ready or waiting for timeout or waiting for I/O:
-
-(define (##sys#all-threads)
-  (append ##sys#ready-queue-head
-          (apply append (map cdr ##sys#fd-list))
-          (map cdr ##sys#timeout-list)))
+;
+; (contributed by Joerg Wittenberger)
+
+(define (##sys#all-threads #!optional
+                           (cns (lambda (queue arg val init)
+                                  (cons val init)))
+                           (init '()))
+  (let loop ((l ##sys#ready-queue-head) (i init))
+    (if (pair? l)
+        (loop (cdr l) (cns 'ready #f (car l) i))
+        (let loop ((l ##sys#fd-list) (i i))
+          (if (pair? l)
+              (loop (cdr l)
+                    (let ((fd (caar l)))
+                      (let loop ((l (cdar l)))
+                        (if (null? l) i
+                            (cns 'i/o fd (car l) (loop (cdr l)))))))
+              (let loop ((l ##sys#timeout-list) (i i))
+                (if (pair? l)
+                    (loop (cdr l) (cns 'timeout (caar l) (cdar l) i))
+                    i)))))))