Queue os-signal events.

c/scheme48vm.h

@@ -23,7 +23,7 @@ extern char		s48_Spending_eventsPS;
 extern char		s48_Spending_interruptPS;
 extern void		s48_disable_interruptsB(void);
 extern void		s48_enable_interruptsB(void);
-extern void		s48_set_os_signal(s48_value type, s48_value argument);
+extern void		s48_set_os_signals(s48_value list);
 
 /* imported and exported bindings */	  
 extern void		s48_define_exported_binding(char *, s48_value);

c/unix/event.c

@@ -30,7 +30,10 @@ static void     when_sigpipe_interrupt();
 /* JMG:*/
 static void     when_scsh_interrupt();
 /* JMG: for scsh */
-static long interrupt_count[32];
+#define INTERRUPT_QUEUE_LENGTH 32
+
+static int      interrupt_queue [INTERRUPT_QUEUE_LENGTH];
+static int	next_interrupt = 0;
 static int s48_os_signal_pending(void);
 static bool s48_os_signal_happend(void);
 
@@ -51,8 +54,6 @@ s48_sysdep_init(void)
 	    errno);
     exit(1);
   }
-  for (i = 0; i < max_sig; i++)
-    interrupt_count[i] = 0;
 
   sigfillset (&full_sigset);
       
@@ -671,11 +672,25 @@ queue_ready_ports(bool wait, long seconds, long ticks)
   }
 }
 
+/*
+ * Adds `signum' to the queue of received signals.
+ */
+
+static void
+queue_interrupt(int signum)
+{
+  if (next_interrupt == INTERRUPT_QUEUE_LENGTH){
+    perror("Interrupt queue overflow -- report to Scheme 48 maintainers.");
+    exit(-1); 
+  }
+  interrupt_queue[next_interrupt] = signum;
+  next_interrupt++;
+}
 
 /* JMG: for scsh */
 static void when_scsh_interrupt(int signo)
 {
-  interrupt_count[sig2int[signo]] +=1;
+  queue_interrupt(sig2int[signo]);
   NOTE_EVENT;
   return;
 }
@@ -703,31 +718,34 @@ static void when_scsh_interrupt(int signo)
  * reenabled when the handler returns (or if done by hand).
  */
 
-/* needs no be called with interrupts blocked */
+/*
+ * Returns TRUE if there is a signal to be delivered up to Scheme.
+ * Needs no be called with interrupts blocked.
+ */
+
 int
 s48_os_signal_pending(void) {
   int i;
+  s48_value interrupt_list = S48_NULL;
+  block_interrupts();
 
-  for (i = 0; i < max_sig; i++){
-    if (interrupt_count[i] > 0){
-      --interrupt_count[i];
-      allow_interrupts();
-      s48_set_os_signal(S48_UNSAFE_ENTER_FIXNUM(i),
-			S48_UNSAFE_ENTER_FIXNUM(0));
-      return TRUE;
-    }
-  }
-  return FALSE;
+  if (next_interrupt == 0) {
+    allow_interrupts();
+    return FALSE; }
+  else {
+    /* turn the queue into a scheme list and preserve the order */
+    for (i = next_interrupt; i > 0 ; i--)
+      interrupt_list = s48_cons (s48_enter_fixnum (interrupt_queue  [i - 1]),
+				 interrupt_list);
+    s48_set_os_signals(interrupt_list);
+		      
+    next_interrupt = 0;
+    allow_interrupts();
+    return TRUE; }
 }
 
 bool 
 s48_os_signal_happend(void) {
-  int i;
-  for (i = 0; i < max_sig; i++){
-    if (interrupt_count[i] > 0){
-      return TRUE;
-    }
-  }
-  return FALSE;
+  return (next_interrupt != 0);
 }
 

scheme/rts/sigevents.scm

@@ -66,7 +66,7 @@
 (define (initialize-sigevents!)
   (set! sigevent-thread-queue (make-thread-queue))
   (set-interrupt-handler! (enum interrupt os-signal) 
-			  (lambda (type arg enabled-interrupts)
+			  (lambda (type enabled-interrupts)
                             ; type is already set in the unix signal handler
 			    (register-interrupt type)))
   (set-interrupt-handler! (enum interrupt keyboard) 

scheme/vm/interfaces.scm

@@ -446,7 +446,7 @@
 	  current-thread
 	  disable-interrupts!
 	  enable-interrupts!
-	  s48-set-os-signal
+	  s48-set-os-signals
 
 	  s48-*callback-return-stack-block*
 	  ))
@@ -479,7 +479,7 @@
 	  s48-*pending-interrupt?*
           s48-disable-interrupts!
           s48-enable-interrupts!
-	  s48-set-os-signal
+	  s48-set-os-signals
 	  
           s48-define-exported-binding
 	  s48-get-imported-binding

scheme/vm/interp.scm

@@ -81,8 +81,7 @@
     (set! *interrupt-template*   (s48-trace-value *interrupt-template*))
     (set! *interrupted-template* (s48-trace-value *interrupted-template*))
     (set! *finalize-these*       (s48-trace-value *finalize-these*))
-    (set! *os-signal-type*       (s48-trace-value *os-signal-type*))
-    (set! *os-signal-argument*   (s48-trace-value *os-signal-argument*))
+    (set! *os-signal-list*       (s48-trace-value *os-signal-list*))
     (trace-finalizer-alist!)
     
     ; These could be moved to the appropriate modules.

scheme/vm/interrupt.scm

@@ -67,24 +67,22 @@
 	   (push (enter-fixnum *enabled-interrupts*))
 	   3))
 	((eq? pending-interrupt (enum interrupt os-signal))
-	 (push *os-signal-type*)
-	 (push *os-signal-argument*)
-	 (set! *os-signal-type* false)
-	 (set! *os-signal-argument* false)
+	 (push (vm-car *os-signal-list*))
+	 (set! *os-signal-list* (vm-cdr *os-signal-list*))
+	 (if (not (vm-eq? *os-signal-list* null))
+	     (note-interrupt! (enum interrupt os-signal)))
 	 (push (enter-fixnum *enabled-interrupts*))
-	 3)
+	 2)
 	(else
 	 (push (enter-fixnum *enabled-interrupts*))
 	 1)))
 
 ; Called from outside when an os-signal event is returned.
 
-(define (s48-set-os-signal type argument)
-  (set! *os-signal-type* type)
-  (set! *os-signal-argument* argument))
+(define (s48-set-os-signals signal-list)
+  (set! *os-signal-list* (vm-append! *os-signal-list* signal-list)))
 
-(define *os-signal-type* false)
-(define *os-signal-argument* false)
+(define *os-signal-list* null)
 
 ; Return from a call to an interrupt handler.