91 lines
3 KiB
Scheme
91 lines
3 KiB
Scheme
|
;;; rabbit
|
||
|
|
|
||
|
|
;;; The rabbit program highlights the use of continuations and
|
||
|
|
;;; timer interrupts to perform thread scheduling. The scheduler
|
||
|
|
;;; maintains a thread queue and operating system primitives for
|
||
|
|
;;; dispatching and thread creation. The queue is only visible
|
||
|
|
;;; to the operating system kernel and all accesses are performed
|
||
|
|
;;; with the timer off to prevent corruption.
|
||
|
|
|
||
|
|
;;; (thread exp) will create a thread out of exp and place it in
|
||
|
|
;;; the thread queue. you may do this for as many threads as
|
||
|
|
;;; you like. (dispatch) starts the threads going. If the
|
||
|
|
;;; thread queue ever becomes empty, dispatch exits. Threads
|
||
|
|
;;; may create other threads.
|
||
|
|
|
||
|
|
;;; The rabbit function creates a thread that spawns two offspring
|
||
|
|
;;; and dies. Each thread has a generation number associated with
|
||
|
|
;;; it. The generation number of each rabbit is one lower than that
|
||
|
|
;;; of it's parent; rabbits in generation 0 are sterile.
|
||
|
|
|
||
|
|
;;; load the queue datatype -- might need a fuller pathname
|
||
|
|
(load "queue.ss")
|
||
|
|
|
||
|
|
;;; swap-time determines the number of timer ticks in a time slice
|
||
|
|
(define swap-time
|
||
|
|
(make-parameter
|
||
|
|
100
|
||
|
|
(lambda (x)
|
||
|
|
(unless (and (integer? x) (positive? x))
|
||
|
|
(error 'swap-time "~s is not a positive integer" x))
|
||
|
|
x)))
|
||
|
|
|
||
|
|
(define dispatch #f)
|
||
|
|
(define thread #f)
|
||
|
|
|
||
|
|
(let ([pq (queue)])
|
||
|
|
(set! dispatch
|
||
|
|
(lambda ()
|
||
|
|
(unless (pq 'empty?)
|
||
|
|
; the thread queue holds continuations---grab one and invoke it
|
||
|
|
(let ([next (pq 'get)])
|
||
|
|
(set-timer (swap-time))
|
||
|
|
(next #f)))))
|
||
|
|
(set! thread
|
||
|
|
(lambda (thunk)
|
||
|
|
(call/cc
|
||
|
|
(lambda (return)
|
||
|
|
(call/cc
|
||
|
|
(lambda (k)
|
||
|
|
; turn off the timer while accessing the queue
|
||
|
|
(let ([time-left (set-timer 0)])
|
||
|
|
; put the thread on the queue
|
||
|
|
(pq 'put k)
|
||
|
|
(set-timer time-left)
|
||
|
|
; get out of here
|
||
|
|
(return #f))))
|
||
|
|
; the first time through we will return before getting
|
||
|
|
; here. the second time is when a thread is first
|
||
|
|
; dispatched from the thread queue.
|
||
|
|
(thunk)
|
||
|
|
(set-timer 0)
|
||
|
|
(dispatch)))))
|
||
|
|
(timer-interrupt-handler
|
||
|
|
(lambda ()
|
||
|
|
(printf "swapping~%")
|
||
|
|
(call/cc
|
||
|
|
(lambda (l)
|
||
|
|
; place the continuation of the interrupt on the queue
|
||
|
|
(pq 'put l)
|
||
|
|
(dispatch))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; *delay-max* gives the maximum random delay before a rabbit
|
||
|
|
;;; reaches child-bearing age.
|
||
|
|
(define *delay-max* 10000)
|
||
|
|
|
||
|
|
(define rabbit
|
||
|
|
(lambda (n)
|
||
|
|
(thread
|
||
|
|
(lambda ()
|
||
|
|
(printf "~s~%" n)
|
||
|
|
(unless (zero? n)
|
||
|
|
(do ([i (random *delay-max*) (1- i)]) ((zero? i)))
|
||
|
|
(rabbit (1- n))
|
||
|
|
(rabbit (1- n)))))))
|
||
|
|
|
||
|
|
;;; try:
|
||
|
|
;;; (rabbit 3)
|
||
|
|
;;; (rabbit 5)
|
||
|
|
;;; (dispatch)
|