;		       Copyright (C) 1992 by Marc Feeley -- all rights reserved

;; "_multi.scm"

(##include "header.scm")

(##declare (not intr-checks))

;------------------------------------------------------------------------------

; Procedures to support multitasking

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

; (##read-not-ready ind) is called when there is an attempt to read from a
; port that does not yet contain chars (i.e. the read would normally block).
; ##read-not-ready should always return -1.

(define ##read-not-ready #f)

(set! ##read-not-ready
  (lambda (ind)
    (if (not (##switch-task)) ; block only if no other tasks to run
      (##os-file-block-read ind))
    -1))

; (##write-not-ready ind) is called when there is an attempt to write to a
; port that is not ready to accept characters (i.e. the write would normally
; block).  ##write-not-ready should always return -1.

(define ##write-not-ready #f)

(define ##write-not-ready
  (lambda (ind)
    (if (not (##switch-task)) ; block only if no other tasks to run
      (##os-file-block-write ind))
    -1))

; (##switch-task) is called when control is to be passed to another task
; (usually at the end of the quantum, but possibly before).

(define ##quantum 0)

(define (##set-quantum x)
  (set! ##quantum x)
  (##os-set-timer-interval x))

(define (##switch-task)
  (###_kernel.switch-task))

; (##timer-interrupt) is called periodically, based on VIRTUAL (cpu) time.
; The interval is set by a call to (##os-set-timer-interval x), where 'x'
; is the time expressed in milliseconds.

(define ##timer-interrupt-enabled #t)

(define (##disable-timer-interrupt) (set! ##timer-interrupt-enabled #f))
(define (##enable-timer-interrupt)  (set! ##timer-interrupt-enabled #t))

(define ##timer-interrupt #f)

(define ##timer-interrupt
  (lambda ()
    (if (##eq? ##timer-interrupt-enabled #t)
      (begin
        (let loop ()
          (let ((proc ##intercept-os-event))
            (if (##procedure? proc)
              (let ((event (##os-get-next-event))) ; get event from OS
                (and event (proc event) (loop))))))
        (##switch-task)))))

(##set-quantum 100) ; 10 task switches per second

; (##intercept-os-event event) is called when the OS has received an event.
; The meaning of 'event' is OS dependent.  Events that can't be handled
; by the application should be passed back to the OS by a call to
; ##os-handle-event for further processing.  ##intercept-os-event should
; return #t to go on to the next event immediately or #f to wait until
; the next timer interrupt (this is because ##os-get-next-event tail calls
; ##intercept-os-event).

(define ##intercept-os-event #f)

(set! ##intercept-os-event
  (lambda (event)
    (##os-handle-event event)))

;------------------------------------------------------------------------------