signal: Fix signal-sample.

signal-sample had a nasty nondeterministic bug where the newly created
signal might actually be GC'd before it could be returned to the caller.
This was able to happen because no reference to the signal was help
between creating the signal and returning it.

Reported-By: David Hashe <david.hashe@dhashe.com>

* sly/signal.scm (signal-sample): Ensure that the garbage collector
cannot reclaim the new signal before it is returned.

1 files changed, 9 insertions, 5 deletions

diff --git a/sly/signal.scm b/sly/signal.scm
index fc58b25..70c00ca 100644
--- a/sly/signal.scm
+++ b/sly/signal.scm
@@ -392,9 +392,9 @@ of SIGNAL was received."
   "Create a new signal that takes on the value of SIGNAL every STEP
 ticks."
   ;; To prevent memory leaks, the new signal is stored within a weak
-  ;; value hash table and never bound to a variable within the main
-  ;; body of the procedure.  When this signal is GC'd, the sampling
-  ;; will stop.
+  ;; value hash table and never bound to a variable within the
+  ;; coroutine.  When this signal is GC'd, the coroutine will halt,
+  ;; and no more samples will be taken.
   (let ((container (make-weak-value-hash-table 1)))
     (define (get)
       (hash-ref container 'signal))
@@ -405,13 +405,17 @@ ticks."
                (signal-set! sampler (signal-ref signal))
                #t)))
 
-    (hash-set! container 'signal (make-signal (signal-ref signal)))
     (coroutine
      (let loop ()
        (wait step)
        (when (sample!)
          (loop))))
-    (get)))
+
+    ;; We maintain a reference to the new signal here so that the GC
+    ;; cannot collect it before it has been returned to the caller.
+    (let ((sampler (make-signal (signal-ref signal))))
+      (hash-set! container 'signal sampler)
+      sampler)))
 
 (define (signal-every step)
   "Create a new signal that emits STEP every STEP ticks."