SELECT: More tweaking. This is clearly wrong and won't work. Mining f…

…or ideas.

src/channels.lisp

@@ -9,6 +9,8 @@
 
 (defvar *select-cond-var* nil
   "Used by select, signaled by channels.x")
+(defvar *select-can-continue* nil)
+
 ;;;
 ;;; Abstract channel interface
 ;;;
@@ -87,8 +89,9 @@ blocking (if it would block)"))
            do (bt:condition-wait (channel-send-ok channel) lock)
            else do (return-from send nil)))
       (bt:condition-notify recv-ok)
-      (when *select-cond-var*
-        (bt:condition-notify *select-cond-var*))
+      (when (and *select-cond-var* (boundp *select-can-continue*))
+        (bt:condition-notify *select-cond-var*)
+        (setf *select-can-continue* t))
       (let ((block-status (channel-being-read-p channel)))
         (channel-insert-value channel value)
         (when block-status
@@ -118,8 +121,9 @@ interactive/debugging purposes."))
     (bt:with-recursive-lock-held (lock)
       (with-read-state channel
         (bt:condition-notify send-ok)
-        (when *select-cond-var*
-          (bt:condition-notify *select-cond-var*))
+        (when (and *select-cond-var* (boundp *select-can-continue*))
+          (bt:condition-notify *select-cond-var*)
+          (setf *select-can-continue* t))
         (loop while (recv-blocks-p channel)
            do (if (or blockp (channel-being-written-p channel))
                   (bt:condition-wait (channel-recv-ok channel) lock)

src/select.lisp

@@ -44,6 +44,7 @@ reserved for individual SELECT clauses."
         `(block nil
            ;; todo - make SELECT pause for *select-cond-var*
            (let ((*select-cond-var* (bt:make-condition-variable))
+                 *select-can-continue*
                  (,lock (bt:make-lock)))
              (bt:with-lock-held (,lock)
               ,(if (null main-clauses)
@@ -69,7 +70,8 @@ reserved for individual SELECT clauses."
                               (wrap-select-clause else-clause)
                               `(progn
                                  (setf ,repeat-counter ,num-clauses)
-                                 (bt:condition-wait *select-cond-var* ,lock)
+                                 (loop until *select-can-continue*
+                                    do (bt:condition-wait *select-cond-var* ,lock))
                                  (go ,pick-clause)))))))))))))
 
 (defun clause-type (clause)