made os-signal base of the interrupt system.
There is now a enumeration scsh-os-signal, that lists all signals. The function set-interrupt now acts on scsh-os-signal-handlers-vector, not any longer on the vm-vector. The with-enabled-interrupts etc stuff does NOT work at the moment.
This commit is contained in:
marting
parent
3b635bbeec
commit
d3638eec28
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue