;; Engines
;; ,open queues signals

(define call/cc call-with-current-continuation)

(define active? #f)

(define do-return #f)

(define do-expire #f)

(define (timer-handler)
  (start-timer (call/cc do-expire)
	       timer-handler))

(define (new-engine resume)
  (lambda (ticks return expire)
    (if active?
	(error "attempt to nest engines")
	(set! active? #t))
    ((call/cc
      (lambda (escape)
	(set! do-return
	      (lambda (value ticks)
		(set! active? #f)
		(escape
		 (lambda ()
		   (return value ticks)))))

	(set! do-expire
	      (lambda (resume)
		(set! active? #f)
		(escape
		 (lambda ()
		   (expire (new-engine resume))))))
	(resume ticks))))))

(define (make-engine proc)
  (new-engine
   (lambda (ticks)
     (start-timer ticks timer-handler)
     (proc)
     (error "engine returned"))))

(define (engine-return value)
  (if active?
      (let ((ticks (stop-timer)))
	(do-return value ticks))
      (error "no engine running")))

;; Timer

(define clock 0)

(define handler #f)

(define (start-timer ticks new-handler)
  (set! handler new-handler)
  (set! clock ticks))

(define (stop-timer)
  (let ((time-left clock))
    (set! clock 0)
    time-left))

(define (decrement-timer)
  (if (> clock 0)
      (begin
	(set! clock (- clock 1))
	(if (zero? clock)
	    (handler)))))

;; Round-Robin-Scheduler

(define (round-robin-scheduler proc)

  (define ready-queue (make-queue))

  (define (start proc)
    (enqueue! ready-queue
	      (make-engine
	       (lambda ()
		 (proc trap)))))

  (define (restart k v)
    (enqueue! ready-queue
	      (make-engine
	       (lambda ()
		 (k v)))))

  (define (trap message arg)
    (call/cc
     (lambda (k)
       (engine-return
	(lambda ()
	  (case message
	    ((uninterruptible)
	     (restart k (arg)))
	    ((start-process)
	     (start arg)
	     (restart k #f))
	    ((stop-process)
	     #f)))))))

  (define (dispatch)
    (if (queue-empty? ready-queue)
	'finished
	((dequeue! ready-queue)
	 (time-slice)
	 (lambda (trap-handler ticks)
	   (trap-handler)
	   (dispatch))
	 (lambda (engine)
	   (enqueue! ready-queue engine)
	   (dispatch)))))

  (start proc)
  (dispatch))

;; Beispiel zur Verwendung des Mini-Betriebsystems

(define (time-slice) 2)

(define (print-thread thread-id)
  (lambda (trap)
    (let lp ((n 10))
      (if (zero? n)
	  (trap 'stop-process n)
	  (begin 
	    (display (string-append 
		      "Thread "(number->string thread-id)))
	    (newline)
	    (decrement-timer)
	    (lp (- n 1)))))))
	    
(define (two-threads)
  (round-robin-scheduler
   (lambda (trap)
     (trap 'start-process (print-thread 1))
     (trap 'start-process (print-thread 2))
     (trap 'stop-process #f))))