From 30b32c7ff676ed961b55358740e329158a466701 Mon Sep 17 00:00:00 2001 From: marting Date: Fri, 15 Oct 1999 18:57:29 +0000 Subject: [PATCH] made interrupt handler a client to low-interrupt. Added blocking via disableing. Not yet thread-save nor interrupt-save in itself --- scsh/sighandlers.scm | 250 ++++++++++++++++++++++++++----------------- 1 file changed, 154 insertions(+), 96 deletions(-) diff --git a/scsh/sighandlers.scm b/scsh/sighandlers.scm index 203351b..4a994fd 100644 --- a/scsh/sighandlers.scm +++ b/scsh/sighandlers.scm @@ -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))) - - - (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)) +(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 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 (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 + ((cdr old) handler) ; set it with setter + (set-car! (vector-ref *interrupt-handlers-vector* int) + handler)))))) + + + + +;(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) + -(define interrupt/int interrupt/keyboard) -(define interrupt/alrm interrupt/alarm) ;;; 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,15 +351,22 @@ (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.