interrupt/alarm is now generated by itimer in low-interupt. command-level set no longer a handler for interrupt/keyboard. sighandler now generates the event for Interrupt: keyboard

This commit is contained in:
marting 1999-11-15 00:23:11 +00:00
parent 9938c1a710
commit c2ccd7c924
5 changed files with 59 additions and 28 deletions

View File

@ -238,11 +238,13 @@
(user-context-accessor 'push-command-levels (lambda () #t)))
(define (notify-on-interrupts thread)
(set-interrupt-handler! (enum interrupt keyboard)
(lambda stuff
(schedule-event thread
(enum event-type interrupt)
(enum interrupt keyboard))))
;;; low-interrupt registers for this interrupt
;;; sighandler will throw this event as default
; (set-interrupt-handler (enum interrupt keyboard)
; (lambda stuff
; (schedule-event thread
; (enum event-type interrupt)
; (enum interrupt keyboard))))
(call-before-heap-overflow!
(lambda stuff
(schedule-event thread

View File

@ -63,24 +63,39 @@
(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-handlers type enabled-interrupts)))
(set-interrupt-handler!
(enum interrupt keyboard)
(lambda (enabled-interrupts)
(call-handlers (enum low-interrupt keyboard) enabled-interrupts)))
(call-after-gc!
(lambda ()
(let ((enabled-interrupts "JMG: enabled interrupts not yet impl"))
(call-handlers (enum low-interrupt post-gc) enabled-interrupts))))
#t)
;;; the vm-interrupts should be called with interrupts disabled, but
;;; the self generated are not and a lock provides the same functionality
(define interrupt-deliver-lock (make-lock))
(define (call-handlers low-interrupt enabled-interrupts)
(obtain-lock interrupt-deliver-lock)
(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)
(low-interrupt-handler-ref low-interrupt))
(release-lock interrupt-deliver-lock))
;;; the vm uses the timer for the scheduler
(define (itimer sec)
(spawn (lambda ()
(sleep (* sec 1000))
(let ((enabled-interrupts "JMG: enabled interrupts not yet impl"))
(call-handlers (enum low-interrupt alarm) enabled-interrupts)))))
(define interrupt/alarm (enum low-interrupt alarm))

View File

@ -401,8 +401,10 @@
(define-interface scsh-signals-interface
(export signal-process
signal-process-group
pause-until-interrupt
itimer))
;; JMG: this syscalls doesn't cooperate with the thread-system
;; pause-until-interrupt
itimer ;; now defined in low-interrupt as a artificial interrupt
))
(define-interface scsh-environment-interface
@ -1122,6 +1124,7 @@
(export low-interrupt-register
init-low-interrupt
number-of-interrupts
itimer
interrupt/alrm interrupt/alarm
interrupt/int interrupt/keyboard
; interrupt/memory-shortage

View File

@ -415,7 +415,9 @@
locks
error-package
interrupts ; signal handler code
scheme)
scheme
threads-internal
threads)
(files low-interrupt))
;(define-structure test-package (export test-proc)

View File

@ -346,9 +346,18 @@
(= sig signal/alrm))) ; alarm handlers alone.
(set-interrupt-handler
i
(vector-ref default-int-handler-vec i))))))
(vector-ref default-int-handler-vec i)))))
(let ((scheduler-initial-thread (current-thread)))
(if (not (eq? (thread-name scheduler-initial-thread)
'scheduler-initial-thread))
(error "sighandler did not find scheduler-initial-thread, but"
scheduler-initial-thread))
(set-interrupt-handler interrupt/keyboard
(lambda stuff
(schedule-event scheduler-initial-thread
(enum event-type interrupt)
(enum interrupt keyboard))))))
;;; I am ashamed to say the 33 below is completely bogus.
;;; What we want is a value that is 1 + max interrupt value.