interface for internal use. Asynchronous delivery of interrupts to multiple clients

scsh/low-interrupt.scm

@@ -0,0 +1,111 @@
+(define-enumeration low-interrupt
+  (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
+   ))
+
+;;; TODO: don't make this a thunk
+(define (number-of-interrupts)
+  low-interrupt-count)
+
+(define low-interrupt-handlers-vector 
+  (make-vector (number-of-interrupts) '()))
+
+
+(define (low-interrupt-handler-ref interrupt)
+  (if (or (< interrupt 0) (>= interrupt (number-of-interrupts)))
+      (error "ill signum in low-interrupt-handler-ref" interrupt)
+      (vector-ref low-interrupt-handlers-vector interrupt)))
+
+
+(define (set-low-interrupt-handler! int handler)
+  (if (or (< int 0) (>= int (number-of-interrupts)))
+      (error "ill signum in set-low-interrupt-handler!" int)
+      (vector-set! low-interrupt-handlers-vector int handler)))
+
+;;; register a handler for interrupt
+;;; the handler is called whenever interrupt occurs among all others,
+;;; which registered for this interrupt
+;;; return value is a function which allows to change the handler
+
+(define (low-interrupt-register interrupt handler)
+   (let* ((old (low-interrupt-handler-ref interrupt))
+	  (the-lock (make-lock))
+	 (new-cell (cons handler the-lock)))  
+     (set-low-interrupt-handler! interrupt (cons new-cell old))
+     (lambda (new-handler)
+       (obtain-lock the-lock)
+       (set-car! new-cell new-handler)
+       (release-lock the-lock))))
+
+  
+
+(define (init-low-interrupt)
+  (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-after-gc!
+   (lambda ()
+     (let ((enabled-interrupts  "JMG: enabled interrupts not yet impl"))
+     (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)
+
+
+(define interrupt/alarm         (enum low-interrupt alarm))
+(define interrupt/keyboard	(enum low-interrupt keyboard))
+;(define interrupt/memory-shortage	(enum low-interrupt memory-shortage))
+(define interrupt/post-gc       (enum low-interrupt post-gc))
+(define interrupt/i/o-completion        (enum low-interrupt i/o-completion))
+(define interrupt/chld		(enum low-interrupt chld))
+(define interrupt/cont		(enum low-interrupt cont))
+(define interrupt/hup		(enum low-interrupt hup))
+(define interrupt/quit		(enum low-interrupt quit))
+(define interrupt/term		(enum low-interrupt term))
+(define interrupt/tstp		(enum low-interrupt tstp))
+(define interrupt/usr1		(enum low-interrupt usr1))
+(define interrupt/usr2		(enum low-interrupt usr2))
+(define interrupt/info		(enum low-interrupt info))
+(define interrupt/io		(enum low-interrupt io))
+(define interrupt/poll		(enum low-interrupt poll))
+(define interrupt/prof		(enum low-interrupt prof))
+(define interrupt/pwr		(enum low-interrupt pwr))
+(define interrupt/urg		(enum low-interrupt urg))
+(define interrupt/vtalrm	(enum low-interrupt vtalrm))
+(define interrupt/winch		(enum low-interrupt winch))
+(define interrupt/xcpu		(enum low-interrupt xcpu))
+(define interrupt/xfsz		(enum low-interrupt xfsz))
+
+(define interrupt/int	interrupt/keyboard)
+(define interrupt/alrm	interrupt/alarm)