made interrupt handler a client to low-interrupt. Added blocking via disableing. Not yet thread-save nor interrupt-save in itself

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.