scsh-0.6/scsh/low-interrupt.scm

(define-enumeration low-interrupt
  (i/o-completion
   post-gc
   keyboard
   alarm
   chld 
   cont
   hup
   quit
   term
   tstp
   usr1
   usr2
   info
   io
   poll
   prof
   pwr
   urg
   vtalrm
   winch
   xcpu
   xfsz
   ))


(define number-of-interrupts
  low-interrupt-count)

(define low-interrupt-handlers-vector 
  (make-vector number-of-interrupts '()))


(define (low-interrupt-handler-ref interrupt)
  (if (or (< interrupt 0) (>= interrupt number-of-interrupts))
      (error "ill signum in low-interrupt-handler-ref" interrupt)
      (vector-ref low-interrupt-handlers-vector interrupt)))


(define (set-low-interrupt-handler! int handler)
  (if (or (< int 0) (>= int number-of-interrupts))
      (error "ill signum in set-low-interrupt-handler!" int)
      (vector-set! low-interrupt-handlers-vector int handler)))

;;; register a handler for interrupt
;;; the handler is called whenever interrupt occurs among all others,
;;; which registered for this interrupt
;;; return value is a function which allows to change the handler

(define (low-interrupt-register interrupt handler)
   (let* ((old (low-interrupt-handler-ref interrupt))
	  (the-lock (make-lock))
	 (new-cell (cons handler the-lock)))  
     (set-low-interrupt-handler! interrupt (cons new-cell old))
     (lambda (new-handler)
       (obtain-lock the-lock)
       (set-car! new-cell new-handler)
       (release-lock the-lock))))

  


(define (init-low-interrupt)
  (spawn 
   (lambda ()
     (let ((I (current-thread)))
       (set-interrupt-handler! 
	(enum interrupt os-signal)
	(lambda (type arg enabled-interrupts)
	  (schedule-event I
			  (enum event-type interrupt)
			  (enum interrupt os-signal)
			  type
			  enabled-interrupts)))
       (set-interrupt-handler! 
	(enum interrupt keyboard)
	(lambda (enabled-interrupts)
	  (schedule-event I
			  (enum event-type interrupt)
			  (enum interrupt keyboard)
			  enabled-interrupts)))
       (let loop ()
	 (wait)
	 (call-with-values 
	  get-next-event!
	  (lambda (event . data)
	    (if (eq? event (enum event-type interrupt))
		(let ((i-nr (car data)))
		  (if (eq? i-nr (enum interrupt os-signal))
		      (call-handlers (cadr data) (caddr data))
		      (if (eq? i-nr (enum interrupt keyboard))
			  (call-handlers (enum low-interrupt keyboard) 
					 (cadr data))))))))
	 (loop))))
   'low-interrupt-deliver-thread)
  
  (call-after-gc!
   (lambda ()
     (let ((enabled-interrupts  "JMG: enabled interrupts not yet impl"))
       (call-handlers (enum low-interrupt post-gc) enabled-interrupts))))

 #t)

;;; the vm-interrupts should be called with interrupts disabled, but 
;;; the self generated are not and a lock provides the same functionality

(define interrupt-deliver-lock (make-lock))

(define (call-handlers low-interrupt enabled-interrupts)
  (for-each (lambda (handler-lock-pair)
	      ((car handler-lock-pair) enabled-interrupts))
	    (low-interrupt-handler-ref low-interrupt)))


;;; the vm uses the timer for the scheduler
(define (itimer sec)
  (spawn (lambda ()
	   (sleep (* sec 1000))
	   (let ((enabled-interrupts  "JMG: enabled interrupts not yet impl"))
	     (call-handlers (enum low-interrupt alarm) enabled-interrupts)))))


(define interrupt/alarm         (enum low-interrupt alarm))
(define interrupt/keyboard	(enum low-interrupt keyboard))
;(define interrupt/memory-shortage	(enum low-interrupt memory-shortage))
(define interrupt/post-gc       (enum low-interrupt post-gc))
(define interrupt/i/o-completion        (enum low-interrupt i/o-completion))
(define interrupt/chld		(enum low-interrupt chld))
(define interrupt/cont		(enum low-interrupt cont))
(define interrupt/hup		(enum low-interrupt hup))
(define interrupt/quit		(enum low-interrupt quit))
(define interrupt/term		(enum low-interrupt term))
(define interrupt/tstp		(enum low-interrupt tstp))
(define interrupt/usr1		(enum low-interrupt usr1))
(define interrupt/usr2		(enum low-interrupt usr2))
(define interrupt/info		(enum low-interrupt info))
(define interrupt/io		(enum low-interrupt io))
(define interrupt/poll		(enum low-interrupt poll))
(define interrupt/prof		(enum low-interrupt prof))
(define interrupt/pwr		(enum low-interrupt pwr))
(define interrupt/urg		(enum low-interrupt urg))
(define interrupt/vtalrm	(enum low-interrupt vtalrm))
(define interrupt/winch		(enum low-interrupt winch))
(define interrupt/xcpu		(enum low-interrupt xcpu))
(define interrupt/xfsz		(enum low-interrupt xfsz))

(define interrupt/int	interrupt/keyboard)
(define interrupt/alrm	interrupt/alarm)