(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)