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

scheme/env/command-level.scm

@@ -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

scsh/low-interrupt.scm

@@ -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"))
-     (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)
+       (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 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))

scsh/scsh-interfaces.scm

@@ -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
@@ -1144,4 +1147,4 @@
 	  interrupt/vtalrm
 	  interrupt/winch
 	  interrupt/xcpu	
-	  interrupt/xfsz))
+	  interrupt/xfsz))

scsh/scsh-package.scm

@@ -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)
@@ -436,4 +438,4 @@
   (access scsh-level-0
 	  threads
 	  threads-internal)
-  (files threads))
+  (files threads))

scsh/sighandlers.scm

@@ -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.