Re: dequeue-signal! starts returning signals only after the second is sent

Robert Ransom <[email protected]> Fri, 27 Nov 2009 15:22:57 -0800
Newsgroups gmane.lisp.scheme.scheme48
Message-ID <20091127152257.7d7ca8c0@neutron>
On Fri, 27 Nov 2009 09:16:26 +0100
Roderic Morris <[email protected]> wrote:

> (dequeue-signal! (make-signal-queue (list (signal chld)))) will return
> signals reliably only after scheme48 recieves the second sigchld. The
> first seems to be ignored, or returned when the second arrives.
> 
> -Roderic
> 

I think I've fixed it; try the attached bundle or patch.

Thanks for the bug report.

Robert Ransom
s48-fix-os-signal-ring.bundle (application/octet-stream, 665 B) - not displayed
s48-fix-os-signal-ring.patch (text/x-patch, 1.5 KB)
# HG changeset patch
# User Robert Ransom <[email protected]>
# Date 1259363477 28800
# Node ID b6d7b3c0ad4b02a1463fe7181b3fe2eced493c2e
# Parent  e817d82c0cc725b1a60babb691d69a6a0197736a
Fix OS signal ring code.

Bug reported by Roderic Morris.

diff --git a/scheme/vm/interp/interrupt.scm b/scheme/vm/interp/interrupt.scm
--- a/scheme/vm/interp/interrupt.scm
+++ b/scheme/vm/interp/interrupt.scm
@@ -171,11 +171,12 @@
           *os-signal-ring-start*)))
 
 (define (os-signal-ring-add! sig)
-  (os-signal-ring-inc! *os-signal-ring-end*)
-  (if (= *os-signal-ring-start*
-         *os-signal-ring-end*)
-      (error "OS signal ring too small, report to Scheme 48 maintainers"))
-  (vector-set! *os-signal-ring* *os-signal-ring-end* sig))
+  (let ((sig-pos *os-signal-ring-end*))
+    (os-signal-ring-inc! *os-signal-ring-end*)
+    (if (= *os-signal-ring-start*
+           *os-signal-ring-end*)
+        (error "OS signal ring too small, report to Scheme 48 maintainers"))
+    (vector-set! *os-signal-ring* sig-pos sig)))
 
 (define (os-signal-ring-empty?)
   (= *os-signal-ring-start*
@@ -185,11 +186,7 @@
   (if (os-signal-ring-empty?)
       (error "This cannot happen: OS signal ring empty"))
   (let ((sig (vector-ref *os-signal-ring* *os-signal-ring-start*)))
-    (set! *os-signal-ring-start* 
-          (if (= *os-signal-ring-start*
-                 (- *os-signal-ring-length* 1))
-              0
-              (+ *os-signal-ring-start* 1)))
+    (os-signal-ring-inc! *os-signal-ring-start*)
     sig))