149 lines
4.4 KiB
Scheme
149 lines
4.4 KiB
Scheme
(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)
|