; Copyright (c) 1999-2001 by Martin Gasbichler. See file COPYING.

;;; Functional event system.
;;; System by Olin Shivers, implementation by Martin Gasbichler

(define-record-type event :event
  (really-make-event type next)
  event?
  (type event-type set-event-type!)
  (next next-event set-next-event!))

(define (make-event type)
  (really-make-event type #f))

(define empty-event (make-event #f))

(define *most-recent-event* empty-event)

(define (most-recent-event) *most-recent-event*)

(define event-thread-queue #f)

;Wait for an event of a certain type.
(define (rts-wait-interrupt set pre-event type-in-set?)
  (with-interrupts-inhibited
   (lambda ()
     (let lp ((event (next-event pre-event)))
       (if event
	   (if (type-in-set? (event-type event) set)
	       event
	       (lp (next-event event)))
	   (begin (enqueue-thread! event-thread-queue (current-thread))
		  (block)
		  (lp (next-event pre-event))))))))

; same as above, but don't block 
(define (rts-maybe-wait-interrupt set pre-event type-in-set?)
  (let ((event (next-event pre-event)))
    (if event
	(if (type-in-set? (event-type event) set)
	    event
	    (rts-maybe-wait-interrupt set (next-event event) type-in-set?))
	#f)))


;Called when the interrupt actually happened.
;;; TODO w-i-i is problaly not necessary since they're off already
(define (register-interrupt type)
  (let ((waiters (with-interrupts-inhibited
		  (lambda ()
		    (set-next-event! *most-recent-event* (make-event type))
		    (set! *most-recent-event* (next-event *most-recent-event*))
		    (do ((waiters '() (cons (dequeue-thread! event-thread-queue)
					    waiters)))
			((thread-queue-empty? event-thread-queue)
			 waiters))))))
    (for-each make-ready waiters)))

;;; has to be called with interrupts disabled
(define (waiting-for-os-event?)
  (not (thread-queue-empty? event-thread-queue)))
  
(define (initialize-events!)
  (set! event-thread-queue (make-thread-queue))
  (set-interrupt-handler! (enum interrupt os-signal) 
			  (lambda (type arg enabled-interrupts)
                            ; type is already set in the unix signal handler
			    (register-interrupt type)))
  (set-interrupt-handler! (enum interrupt keyboard) 
			  (lambda (enabled-interrupts)
			    (register-interrupt (enum interrupt keyboard))))
;  (call-after-gc! (lambda () (register-interrupt (enum interrupt post-gc))))
)
;;; the vm uses the timer for the scheduler
(define (schedule-timer-interrupt! msec)
  (spawn (lambda ()
	   (sleep msec)
	   (register-interrupt (enum interrupt alarm)))))