diff --git a/c/scheme48vm.h b/c/scheme48vm.h index a045f19..6068ecf 100644 --- a/c/scheme48vm.h +++ b/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); diff --git a/c/unix/event.c b/c/unix/event.c index 8591fc6..99379a9 100644 --- a/c/unix/event.c +++ b/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); } diff --git a/scheme/rts/sigevents.scm b/scheme/rts/sigevents.scm index 848606c..0f3f47c 100644 --- a/scheme/rts/sigevents.scm +++ b/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) diff --git a/scheme/vm/interfaces.scm b/scheme/vm/interfaces.scm index 3887c01..bb8c5c1 100644 --- a/scheme/vm/interfaces.scm +++ b/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 diff --git a/scheme/vm/interp.scm b/scheme/vm/interp.scm index c2bf5fb..bfd65aa 100644 --- a/scheme/vm/interp.scm +++ b/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. diff --git a/scheme/vm/interrupt.scm b/scheme/vm/interrupt.scm index a13507f..4bf1856 100644 --- a/scheme/vm/interrupt.scm +++ b/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.