made interrupt handler a client to low-interrupt. Added blocking via disableing. Not yet thread-save nor interrupt-save in itself
This commit is contained in:
marting
parent
6f86fd8400
commit
30b32c7ff6
|
|
@ -53,13 +53,109 @@
|
|||
(define (interrupt-set . interrupts)
|
||||
(let lp ((ints interrupts) (ans 0))
|
||||
(if (pair? ints)
|
||||
(lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (- (car ints) 1))))
|
||||
(lp (cdr ints) (bitwise-ior ans (arithmetic-shift 1 (car ints) )))
|
||||
ans)))
|
||||
|
||||
(define (interrupt-enabled? int mask)
|
||||
(not (zero? (bitwise-and (arithmetic-shift 1 int) mask))))
|
||||
|
||||
(define (interrupt-enable int mask)
|
||||
(bitwise-ior (arithmetic-shift 1 int) mask))
|
||||
|
||||
(define *enabled-interrupts*
|
||||
(let lp ((i 0) (mask 0))
|
||||
(if (= i (number-of-interrupts))
|
||||
mask
|
||||
(lp (+ i 1) (interrupt-enable i mask)))))
|
||||
|
||||
(define (enabled-interrupts) *enabled-interrupts*)
|
||||
|
||||
|
||||
;;; I'm trying to be consistent about the ! suffix -- I don't use it
|
||||
;;; when frobbing process state. This is not a great rule; perhaps I
|
||||
;;; should change it.
|
||||
;(define set-enabled-interrupts set-enabled-interrupts!)
|
||||
;;;
|
||||
;;; I think you should...
|
||||
(define (set-enabled-interrupts new-enabled-interrupts)
|
||||
(let ((number-of-interrupts (number-of-interrupts)))
|
||||
(do ((int 0 (+ int 1)))
|
||||
((= int number-of-interrupts) new-enabled-interrupts)
|
||||
(let ((old-state (interrupt-enabled? int *enabled-interrupts*))
|
||||
(new-state (interrupt-enabled? int new-enabled-interrupts)))
|
||||
(cond ((and old-state (not new-state))
|
||||
(vector-set! blockade-vector int (block-interrupt int)))
|
||||
((and (not old-state) new-state)
|
||||
(let ((blockade (vector-ref blockade-vector int)))
|
||||
(if (not blockade)
|
||||
(error "there was no blockade" int))
|
||||
(unblock-interrupt blockade)
|
||||
(vector-set! blockade-vector int #f)))
|
||||
(else 'unchanged)))))
|
||||
(set! *enabled-interrupts* new-enabled-interrupts))
|
||||
|
||||
;;; Enableing/Disableing = Unblocking/Blocking
|
||||
;;;
|
||||
;;; issues:
|
||||
;;; + prevent delivery of the interrupt => install fake handler in
|
||||
;;; low-interrupt
|
||||
;;; + support setting of handler during blocking => install fake
|
||||
;;; set-proc in interrupt-handler-vector
|
||||
;;; + record if an interrupt occures while interupt blocked => pending?
|
||||
;;; + restore everything after interrupt unublocked => reinstall handler
|
||||
;;; in low-interrupt, set-proc in interrupt-handler-vector
|
||||
;;; + if pending? interrupt: call handler
|
||||
|
||||
;(define-record-type blockade :blockade
|
||||
; (really-make-blockade interrupt-vector-cell pending? low-int-set!)
|
||||
; blockade?
|
||||
; (interrupt-vector-cell blockade:interrupt-vector-cell)
|
||||
; (pending? blockade:pending? set-blockade:pending?)
|
||||
; (low-int-set! blockade:low-int-set!))
|
||||
|
||||
(define-record blockade
|
||||
interrupt-vector-cell
|
||||
low-int-set! ; proc to set interrupt in low-interrupt
|
||||
(pending? #f))
|
||||
|
||||
|
||||
(define blockade-vector (make-vector (number-of-interrupts) #f))
|
||||
|
||||
;;; do nothing in low-interrupt, the new handler will be recorded in the
|
||||
;;; interrupt-handler-vector however
|
||||
(define (fake-set-interrupt blockade)
|
||||
(lambda (new-handler)
|
||||
#f))
|
||||
|
||||
;;; to be installed in low-interrupt
|
||||
(define (fake-handler blockade)
|
||||
(lambda a
|
||||
(if (not (blockade:pending? blockade))
|
||||
(set-blockade:pending? blockade a))))
|
||||
|
||||
;;; generate blockade and install fake handler and set-proc
|
||||
(define (block-interrupt int)
|
||||
(let* ((handler-setter-cell (vector-ref *interrupt-handlers-vector* int))
|
||||
(low-int-set! (cdr handler-setter-cell))
|
||||
(blockade (make-blockade handler-setter-cell
|
||||
low-int-set!)))
|
||||
; fade out the low-interupt-set
|
||||
(set-cdr! handler-setter-cell (fake-set-interrupt blockade))
|
||||
; set the fake handler in low-interupt:
|
||||
((blockade:low-int-set! blockade) (fake-handler blockade))
|
||||
blockade))
|
||||
|
||||
|
||||
(define (unblock-interrupt blockade)
|
||||
(let ((handler (car (blockade:interrupt-vector-cell blockade))))
|
||||
; install the handler that resides in the vector
|
||||
(let ((low-int-set! (blockade:low-int-set! blockade)))
|
||||
(low-int-set! handler)
|
||||
; resinstall the low-interrupt-setter
|
||||
(set-cdr! (blockade:interrupt-vector-cell blockade)
|
||||
low-int-set!)
|
||||
(if (blockade:pending? blockade)
|
||||
(apply handler (blockade:pending? blockade))))))
|
||||
|
||||
|
||||
;(define-simple-syntax (with-enabled-interrupts mask body ...)
|
||||
; (with-interrupts mask (lambda () body ...)))
|
||||
|
|
@ -72,105 +168,60 @@
|
|||
(warn "JMG: use of with-enabled-interrupts*")
|
||||
(thunk))
|
||||
|
||||
(define (set-enabled-interrupts . args)
|
||||
(warn "JMG: use of set-enabled-interrupts")
|
||||
#f)
|
||||
|
||||
; Fakes vm vector
|
||||
;;; car is the actual handler, cdr is a proc to set handler in low-interrupt system
|
||||
|
||||
(define-enumeration scsh-os-signal
|
||||
(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 *interrupt-handlers-vector*
|
||||
(make-vector (number-of-interrupts) (cons #f #f)))
|
||||
|
||||
(define scsh-os-signal-handlers-vector (make-vector 33))
|
||||
|
||||
(define (scsh-os-signal-handler-ref signal)
|
||||
(if (or (< signal 0) (> signal 32))
|
||||
(error "ill signum in scsh-os-signal-handler-ref" signal)
|
||||
(vector-ref scsh-os-signal-handlers-vector signal)))
|
||||
|
||||
|
||||
;; why is this called "int" ???
|
||||
(define (set-scsh-os-signal-handler! int handler)
|
||||
(if (or (< int 0) (> int 32))
|
||||
(error "ill signum in set-scsh-os-signal-handler!" int)
|
||||
(vector-set! scsh-os-signal-handlers-vector int handler)))
|
||||
|
||||
|
||||
|
||||
; JMG: not any more exported from the vm
|
||||
(define (interrupt-handlers-vector)
|
||||
scsh-os-signal-handlers-vector)
|
||||
*interrupt-handlers-vector*)
|
||||
|
||||
(define procobj-handler (lambda (enabled-interrupts) #f))
|
||||
|
||||
(define (init-scsh-signal)
|
||||
(do ((sig 32 (- sig 1)))
|
||||
((< sig 0))
|
||||
(set-scsh-os-signal-handler!
|
||||
sig
|
||||
(lambda (x) #t)))
|
||||
(define (interrupt-handler-ref int)
|
||||
(if (or (< int 0) (>= int (number-of-interrupts)))
|
||||
(error "ill signum in interrupt-handler-ref" int)
|
||||
(car (vector-ref *interrupt-handlers-vector* int))))
|
||||
|
||||
|
||||
(define (set-interrupt-handler! int handler)
|
||||
(if (or (< int 0) (>= int (number-of-interrupts)))
|
||||
(error "ill signum in set-interrupt-handler!" int)
|
||||
(let ((old (vector-ref *interrupt-handlers-vector* int)))
|
||||
(if (not (cdr old)) ; not yet registered?
|
||||
(let ((setter (low-interrupt-register
|
||||
int handler)))
|
||||
(vector-set! *interrupt-handlers-vector*
|
||||
int
|
||||
(cons handler setter)))
|
||||
(begin
|
||||
(set-interrupt-handler!
|
||||
(enum interrupt os-signal)
|
||||
(lambda (type arg enabled-interrupts)
|
||||
(if (= type (enum scsh-os-signal chld))
|
||||
(begin
|
||||
(procobj-handler enabled-interrupts)))
|
||||
((scsh-os-signal-handler-ref type) enabled-interrupts)
|
||||
))
|
||||
(display "sighandler installed")
|
||||
#t))
|
||||
((cdr old) handler) ; set it with setter
|
||||
(set-car! (vector-ref *interrupt-handlers-vector* int)
|
||||
handler))))))
|
||||
|
||||
|
||||
(define interrupt/alarm (enum scsh-os-signal alarm))
|
||||
(define interrupt/keyboard (enum scsh-os-signal keyboard))
|
||||
;(define interrupt/memory-shortage (enum scsh-os-signal memory-shortage))
|
||||
(define interrupt/post-gc (enum scsh-os-signal post-gc))
|
||||
(define interrupt/i/o-completion (enum scsh-os-signal i/o-completion))
|
||||
(define interrupt/chld (enum scsh-os-signal chld))
|
||||
(define interrupt/cont (enum scsh-os-signal cont))
|
||||
(define interrupt/hup (enum scsh-os-signal hup))
|
||||
(define interrupt/quit (enum scsh-os-signal quit))
|
||||
(define interrupt/term (enum scsh-os-signal term))
|
||||
(define interrupt/tstp (enum scsh-os-signal tstp))
|
||||
(define interrupt/usr1 (enum scsh-os-signal usr1))
|
||||
(define interrupt/usr2 (enum scsh-os-signal usr2))
|
||||
(define interrupt/info (enum scsh-os-signal info))
|
||||
(define interrupt/io (enum scsh-os-signal io))
|
||||
(define interrupt/poll (enum scsh-os-signal poll))
|
||||
(define interrupt/prof (enum scsh-os-signal prof))
|
||||
(define interrupt/pwr (enum scsh-os-signal pwr))
|
||||
(define interrupt/urg (enum scsh-os-signal urg))
|
||||
(define interrupt/vtalrm (enum scsh-os-signal vtalrm))
|
||||
(define interrupt/winch (enum scsh-os-signal winch))
|
||||
(define interrupt/xcpu (enum scsh-os-signal xcpu))
|
||||
(define interrupt/xfsz (enum scsh-os-signal xfsz))
|
||||
|
||||
(define interrupt/int interrupt/keyboard)
|
||||
(define interrupt/alrm interrupt/alarm)
|
||||
|
||||
;(define (init-interrupt)
|
||||
; (do ((sig 32 (- sig 1)))
|
||||
; ((< sig 0))
|
||||
|
||||
|
||||
; (set-scsh-low-interrupt-handler!
|
||||
; sig
|
||||
; (lambda (x) #t)))
|
||||
; (set-interrupt-handler!
|
||||
; (enum interrupt os-signal)
|
||||
; (lambda (type arg enabled-interrupts)
|
||||
; (if (= type (enum scsh-os-signal chld))
|
||||
; (begin
|
||||
; (procobj-handler enabled-interrupts)))
|
||||
; ((scsh-os-signal-handler-ref type) enabled-interrupts)
|
||||
; ))
|
||||
; (display "sighandler installed")
|
||||
; #t)
|
||||
|
||||
|
||||
|
||||
|
||||
;;; Get/Set signal handlers
|
||||
|
|
@ -228,7 +279,7 @@
|
|||
|
||||
(define (set-interrupt-handler int handler)
|
||||
(let ((ohandler (interrupt-handler int)))
|
||||
(set-scsh-os-signal-handler!
|
||||
(set-interrupt-handler!
|
||||
int
|
||||
(case handler
|
||||
((#t) (vector-ref default-int-handler-vec int))
|
||||
|
|
@ -248,7 +299,7 @@
|
|||
; ohandler))
|
||||
|
||||
(define (interrupt-handler int)
|
||||
(let ((handler (vector-ref (interrupt-handlers-vector) int)))
|
||||
(let ((handler (interrupt-handler-ref int)))
|
||||
(cond ((eq? handler (vector-ref default-int-handler-vec int)) #t)
|
||||
((eq? handler noop-sig-handler) #f)
|
||||
(else handler))))
|
||||
|
|
@ -300,16 +351,23 @@
|
|||
(define-foreign %%get-int-handlers (get_int_handlers) desc)
|
||||
|
||||
(define (%install-scsh-handlers)
|
||||
(do ((int 0 (+ int 1)))
|
||||
((= int (number-of-interrupts)))
|
||||
(set-interrupt-handler
|
||||
int
|
||||
(lambda a #f)))
|
||||
(do ((sig 32 (- sig 1)))
|
||||
((< sig 0))
|
||||
(let ((i (%signal->interrupt sig)))
|
||||
(if (not (or (= i -1)
|
||||
(= sig signal/int) ; Leave ^c and
|
||||
(= sig signal/alrm))) ; alarm handlers alone.
|
||||
(set-scsh-os-signal-handler!
|
||||
(set-interrupt-handler
|
||||
i
|
||||
(vector-ref default-int-handler-vec i))))))
|
||||
|
||||
|
||||
|
||||
;;; I am ashamed to say the 33 below is completely bogus.
|
||||
;;; What we want is a value that is 1 + max interrupt value.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue