scsh-0.6/scsh/low-interrupt.scm

112 lines
3.5 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)
(set-interrupt-handler!
(enum interrupt os-signal)
(lambda (type arg enabled-interrupts)
(for-each (lambda (handler-none-pair)
((car handler-none-pair) enabled-interrupts))
(low-interrupt-handler-ref type))))
; (set-interrupt-handler!
; (enum interrupt keyboard)
; (lambda args
; (let ((enabled-interrupts "JMG: enabled interrupts not yet impl"))
; (for-each (lambda (handler-none-pair)
; ((car handler-none-pair) enabled-interrupts))
; (low-interrupt-handler-ref (enum low-interrupt keyboard))))))
(call-after-gc!
(lambda ()
(let ((enabled-interrupts "JMG: enabled interrupts not yet impl"))
(for-each (lambda (handler-lock-pair)
((car handler-lock-pair) enabled-interrupts))
(low-interrupt-handler-ref (enum low-interrupt post-gc))))))
(display "sighandler installed")
#t)
(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)