Changeset 11980 in project


Ignore:
Timestamp:
09/23/08 00:33:15 (13 years ago)
Author:
felix winkelmann
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/scheduler.scm

    r11979 r11980  
    421421
    422422;;; Get list of all threads that are ready or waiting for timeout or waiting for I/O:
    423 
    424 (define (##sys#all-threads)
    425   (append ##sys#ready-queue-head
    426           (apply append (map cdr ##sys#fd-list))
    427           (map cdr ##sys#timeout-list)))
     423;
     424; (contributed by Joerg Wittenberger)
     425
     426(define (##sys#all-threads #!optional
     427                           (cns (lambda (queue arg val init)
     428                                  (cons val init)))
     429                           (init '()))
     430  (let loop ((l ##sys#ready-queue-head) (i init))
     431    (if (pair? l)
     432        (loop (cdr l) (cns 'ready #f (car l) i))
     433        (let loop ((l ##sys#fd-list) (i i))
     434          (if (pair? l)
     435              (loop (cdr l)
     436                    (let ((fd (caar l)))
     437                      (let loop ((l (cdar l)))
     438                        (if (null? l) i
     439                            (cns 'i/o fd (car l) (loop (cdr l)))))))
     440              (let loop ((l ##sys#timeout-list) (i i))
     441                (if (pair? l)
     442                    (loop (cdr l) (cns 'timeout (caar l) (cdar l) i))
     443                    i)))))))
    428444
    429445
Note: See TracChangeset for help on using the changeset viewer.