diff --git a/scsh/sighandlers.scm b/scsh/sighandlers.scm index 8e8a7b4..addbc33 100644 --- a/scsh/sighandlers.scm +++ b/scsh/sighandlers.scm @@ -30,6 +30,8 @@ ;;; ENABLED-INTERRUPTS ;;; Must define WITH-INTERRUPTS* and WITH-INTERRUPTS. +(foreign-init-name "sighandlers") + (foreign-source "extern int errno;" "" @@ -57,36 +59,104 @@ ;;; 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!) +;(define set-enabled-interrupts set-enabled-interrupts!) +;(define-simple-syntax (with-enabled-interrupts mask body ...) +; (with-interrupts mask (lambda () body ...))) (define-simple-syntax (with-enabled-interrupts mask body ...) - (with-interrupts mask (lambda () body ...))) + (begin body ...)) +;(define with-enabled-interrupts* with-interrupts) -(define with-enabled-interrupts* with-interrupts) +(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/alarm (enum interrupt alarm)) -(define interrupt/keyboard (enum interrupt keyboard)) -;(define interrupt/memory-shortage (enum interrupt memory-shortage)) -(define interrupt/post-gc (enum interrupt post-gc)) -(define interrupt/i/o-completion (enum interrupt i/o-completion)) -(define interrupt/chld (enum interrupt chld)) -(define interrupt/cont (enum interrupt cont)) -(define interrupt/hup (enum interrupt hup)) -(define interrupt/quit (enum interrupt quit)) -(define interrupt/term (enum interrupt term)) -(define interrupt/tstp (enum interrupt tstp)) -(define interrupt/usr1 (enum interrupt usr1)) -(define interrupt/usr2 (enum interrupt usr2)) -(define interrupt/info (enum interrupt info)) -(define interrupt/io (enum interrupt io)) -(define interrupt/poll (enum interrupt poll)) -(define interrupt/prof (enum interrupt prof)) -(define interrupt/pwr (enum interrupt pwr)) -(define interrupt/urg (enum interrupt urg)) -(define interrupt/vtalrm (enum interrupt vtalrm)) -(define interrupt/winch (enum interrupt winch)) -(define interrupt/xcpu (enum interrupt xcpu)) -(define interrupt/xfsz (enum interrupt xfsz)) +(define scsh-os-signal-handlers-vector (make-vector 33)) + +(define (scsh-os-signal-handler-ref signal) + (if (or (< signal 0) (> signal 32)) + (begin + (display "ill signum" in ref) + (display signal)) + (vector-ref scsh-os-signal-handlers-vector signal))) + +(define (set-scsh-os-signal-handler! int handler) + (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) + +(define procobj-handler (lambda (enabled-interrupts) #f)) + +(define (init-scsh-signal) + (begin + (set-interrupt-handler! + (enum interrupt os-signal) + (lambda (type arg enabled-interrupts) + (display type) + + (newline) + (display arg) + (newline) + (display enabled-interrupts) + (newline) + (if (= type (enum scsh-os-signal chld)) + (begin + (display "will call proc") + (procobj-handler enabled-interrupts))) + ((scsh-os-signal-handler-ref type) enabled-interrupts) + )) + (display "sighandler installed") + #t)) + + +(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) @@ -111,7 +181,7 @@ (define default-int-handler-vec ;; Non-Unix-signal interrupts just get their default values from ;; the current value of I-H. - (let ((v (copy-vector (interrupt-handlers-vector)))) + (let ((v (make-vector 32))) (do ((sig 31 (- sig 1))) ; For each Unix signal ((< sig 0)) ; make & install a default (let ((i (%signal->interrupt sig))) ; signal handler. @@ -147,21 +217,22 @@ (define (set-interrupt-handler int handler) (let ((ohandler (interrupt-handler int))) - (set-interrupt-handler! int - (case handler - ((#t) (vector-ref default-int-handler-vec int)) - ((#f) noop-sig-handler) - (else handler))) - - (cond ((and (not handler) ohandler ; Toggling from something - (int->signal int)) => ; to ignored. - (lambda (sig) - (%set-unix-signal-handler sig 0))) + (set-scsh-os-signal-handler! + int + (case handler + ((#t) (vector-ref default-int-handler-vec int)) + ((#f) noop-sig-handler) + (else handler))) + + (cond ((and (not handler) ohandler ; Toggling from something + (int->signal int)) => ; to ignored. + (lambda (sig) + (%set-unix-signal-handler sig 0))) ((and handler (not ohandler) ; Toggling from ignored (int->signal int)) => ; to something. - (lambda (sig) - (%set-unix-signal-handler sig 2)))) - + (lambda (sig) + (%set-unix-signal-handler sig 2)))) + ohandler)) (define (interrupt-handler int) @@ -223,8 +294,9 @@ (if (not (or (= i -1) (= sig signal/int) ; Leave ^c and (= sig signal/alrm))) ; alarm handlers alone. - (set-interrupt-handler! i - (vector-ref default-int-handler-vec i)))))) + (set-scsh-os-signal-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.