306 - 'sleep' now watches for changes to a location

This simplifies things a lot and eliminates the race condition.

I think it's practical too, as long as you save a single location and
don't permit sleeping on compound structures. I'm resigned to needing a
lock in the native setting.

Should I be concerned that I fixed a failing test by getting rid of hit?

If I had alternatives, how would I save the old sleep implementation?

2 files changed, 22 insertions, 97 deletions

diff --git a/mu.arc b/mu.arc
index f0698761..37bfdcf9 100644
--- a/mu.arc
+++ b/mu.arc
@@ -61,7 +61,7 @@
               list-address (obj size 1  address t  elem 'list)
               list-address-address (obj size 1  address t  elem 'list-address)
               ; parallel routines use channels to synchronize
-              channel (obj size 5  record t  elems '(boolean boolean integer integer tagged-value-array-address)  fields '(write-watch read-watch first-full first-free circular-buffer))
+              channel (obj size 3  record t  elems '(integer integer tagged-value-array-address)  fields '(first-full first-free circular-buffer))
               channel-address (obj size 1  address t  elem 'channel)
               ; editor
               line (obj array t  elem 'character)
@@ -182,7 +182,7 @@
   (assert no.routine*)
   (if (is 'literal rep.routine!sleep.1)
     (> curr-cycle* rep.routine!sleep.0)
-    (~in (memory* rep.routine!sleep.0) 0 nil)))
+    (~is rep.routine!sleep.1 (memory* rep.routine!sleep.0))))
 
 (on-init
   (= running-routines* (queue))  ; simple round-robin scheduler
@@ -558,13 +558,14 @@
                   (assert (m arg.0))
                 sleep
                   (let operand arg.0
+                    ; store sleep as either (<cycle number> literal) or (<location> <current value>)
                     (if (is ty.operand 'literal)
                       (let delay v.operand
                         (trace "run" "sleeping until " (+ curr-cycle* delay))
                         (= rep.routine*!sleep `(,(+ curr-cycle* delay) literal)))
                       (do
 ;?                         (tr "blocking on " operand " -> " (addr operand))
-                        (= rep.routine*!sleep `(,addr.operand location))))
+                        (= rep.routine*!sleep `(,addr.operand ,m.operand))))
                     ((abort-routine*)))
 
                 ; text interaction
@@ -949,14 +950,9 @@
   { begin
     ; block if chan is full
     ((full boolean) <- full? (chan channel-address deref))
-    ; race condition: might unnecessarily sleep if consumer routine reads from
-    ; channel between previous check and the set to watch below
     (break-unless (full boolean))
-    wipe-read
-    ((watch boolean-address) <- get-address (chan channel-address deref) (read-watch offset))
-    ((watch boolean-address deref) <- copy (nil literal))
-    start-sleep
-    (sleep (watch boolean-address deref))
+    ((full-address integer-address) <- get-address (chan channel-address deref) (first-full offset))
+    (sleep (full-address integer-address deref))
   }
   ; store val
   ((q tagged-value-array-address) <- get (chan channel-address deref) (circular-buffer offset))
@@ -972,9 +968,6 @@
     (break-if (remaining? boolean))
     ((free integer-address deref) <- copy (0 literal))
   }
-  ; set 'write-watch' in case the reader was blocked on it
-  ((watch boolean-address) <- get-address (chan channel-address deref) (write-watch offset))
-  ((watch boolean-address deref) <- copy (t literal))
   (reply (chan channel-address deref)))
 
 (init-fn read
@@ -983,12 +976,9 @@
   { begin
     ; block if chan is empty
     ((empty boolean) <- empty? (chan channel-address deref))
-    ; race condition: might unnecessarily sleep if consumer routine writes to
-    ; channel between previous check and the set to watch below
     (break-unless (empty boolean))
-    ((watch boolean-address) <- get-address (chan channel-address deref) (write-watch offset))
-    ((watch boolean-address deref) <- copy (nil literal))
-    (sleep (watch boolean-address deref))
+    ((free-address integer-address) <- get-address (chan channel-address deref) (first-free offset))
+    (sleep (free-address integer-address deref))
   }
   ; read result
   ((full integer-address) <- get-address (chan channel-address deref) (first-full offset))
@@ -1003,9 +993,6 @@
     (break-if (remaining? boolean))
     ((full integer-address deref) <- copy (0 literal))
   }
-  ; set 'read-watch' in case the writer was blocked on it
-  ((watch boolean-address) <- get-address (chan channel-address deref) (read-watch offset))
-  ((watch boolean-address deref) <- copy (t literal))
   (reply (result tagged-value) (chan channel-address deref)))
 
 ; An empty channel has first-empty and first-full both at the same value.
diff --git a/mu.arc.t b/mu.arc.t
index 66d2f3ee..e2ebf513 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -1863,11 +1863,11 @@
 ; add one baseline routine to run (empty running-routines* handled below)
 (enq make-routine!f1 running-routines*)
 (assert (is 1 len.running-routines*))
-; blocked routine
+; blocked routine waiting for location 23 to change
 (let routine make-routine!f2
-  (= rep.routine!sleep '(23 integer))
+  (= rep.routine!sleep '(23 0))
   (set sleeping-routines*.routine))
-; 'empty' memory location
+; leave memory location 23 unchanged
 (= memory*.23 0)
 ;? (prn memory*)
 ;? (prn running-routines*)
@@ -1877,6 +1877,7 @@
 (update-scheduler-state)
 ;? (prn running-routines*)
 ;? (prn sleeping-routines*)
+; routine remains blocked
 (if (~is 1 len.running-routines*)
   (prn "F - scheduler lets routines block on locations"))
 ;? (quit)
@@ -1891,13 +1892,14 @@
 ; add one baseline routine to run (empty running-routines* handled below)
 (enq make-routine!f1 running-routines*)
 (assert (is 1 len.running-routines*))
-; blocked routine
+; blocked routine waiting for location 23 to change
 (let routine make-routine!f2
-  (= rep.routine!sleep '(23 integer))
+  (= rep.routine!sleep '(23 0))
   (set sleeping-routines*.routine))
-; set memory location and unblock routine
+; change memory location 23
 (= memory*.23 1)
 (update-scheduler-state)
+; routine unblocked
 (if (~is 2 len.running-routines*)
   (prn "F - scheduler unblocks routines blocked on locations"))
 
@@ -1928,9 +1930,9 @@
 (assert (empty completed-routines*))
 ; blocked routine
 (let routine make-routine!f1
-  (= rep.routine!sleep '(23 integer))
+  (= rep.routine!sleep '(23 0))
   (set sleeping-routines*.routine))
-; location it's waiting on is 'empty'
+; location it's waiting on is 'unchanged'
 (= memory*.23 0)
 (update-scheduler-state)
 (assert (~empty completed-routines*))
@@ -1949,7 +1951,7 @@
 (assert (empty running-routines*))
 ; blocked routine
 (let routine make-routine!f1
-  (= rep.routine!sleep '(23 integer))
+  (= rep.routine!sleep '(23 0))
   (set sleeping-routines*.routine))
 ; but is about to become ready
 (= memory*.23 1)
@@ -2028,10 +2030,10 @@
 (new-trace "sleep-scoped-location")
 (add-fns
   '((f1
-      ; waits for memory location 1 to be set, before computing its successor
-      ((10 integer) <- copy (5 literal))
+      ; waits for memory location 1 to be changed, before computing its successor
+      ((10 integer) <- copy (5 literal))  ; array of locals
       ((default-scope scope-address) <- copy (10 literal))
-      ((1 integer) <- copy (0 literal))  ; really location 11
+      ((1 integer) <- copy (23 literal))  ; really location 11
       (sleep (1 integer))
       ((2 integer) <- add (1 integer) (1 literal)))
     (f2
@@ -2370,44 +2372,6 @@
     (prn "F - 'write' on full channel blocks (puts the routine to sleep until the channel gets data)")))
 ;? (quit)
 
-; But how will the sleeping routines wake up? Our scheduler can't watch for
-; changes to arbitrary values, just tell us if a specific raw location becomes
-; non-zero (see the sleep-location test above). So both reader and writer set
-; 'read-watch' and 'write-watch' respectively at the end of a successful call.
-
-(reset)
-(new-trace "channel-write-watch")
-(add-fns
-  '((main
-      ((1 channel-address) <- new-channel (3 literal))
-      ((2 integer-address) <- new (integer literal))
-      ((2 integer-address deref) <- copy (34 literal))
-      ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address))
-      ((4 boolean) <- get (1 channel-address deref) (read-watch offset))
-      ((1 channel-address deref) <- write (1 channel-address) (3 tagged-value-address deref))
-      ((5 boolean) <- get (1 channel-address deref) (write-watch offset)))))
-(run 'main)
-(if (or (~is nil memory*.4)
-        (~is t memory*.5))
-  (prn "F - 'write' sets channel watch"))
-
-(reset)
-(new-trace "channel-read-watch")
-(add-fns
-  '((main
-      ((1 channel-address) <- new-channel (3 literal))
-      ((2 integer-address) <- new (integer literal))
-      ((2 integer-address deref) <- copy (34 literal))
-      ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address))
-      ((1 channel-address deref) <- write (1 channel-address) (3 tagged-value-address deref))
-      ((4 boolean) <- get (1 channel-address deref) (read-watch offset))
-      (_ (1 channel-address deref) <- read (1 channel-address))
-      ((5 integer) <- get (1 channel-address deref) (read-watch offset)))))
-(run 'main)
-(if (or (~is nil memory*.4)
-        (~is t memory*.5))
-  (prn "F - 'read' sets channel watch"))
-
 (reset)
 (new-trace "channel-handoff")
 (add-fns
@@ -2434,32 +2398,6 @@
   (prn "F - channels are meant to be shared between routines"))
 ;? (quit)
 
-(reset)
-(new-trace "channel-race")
-(add-fns
-  '((main
-      ; create a channel with capacity 1
-      ((1 channel-address) <- new-channel (1 literal))
-      ((2 integer-address) <- new (integer literal))
-      ((2 integer-address deref) <- copy (34 literal))
-      ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address))
-      ; write a value
-      ((1 channel-address deref) <- write (1 channel-address) (3 tagged-value-address deref))
-      ; write a second value
-      ((1 channel-address deref) <- write (1 channel-address) (3 tagged-value-address deref)))
-    (reader
-      (_ (1 channel-address deref) <- read (1 channel-address)))))
-; switch context at just the wrong time
-(= scheduler-switch-table*
-   '((wipe-read  reader)))
-;? (= dump-trace* (obj whitelist '("schedule" "run")))
-(run 'main 'reader)
-; second write should not cause deadlock
-(each routine completed-routines*
-  (when (posmatch "deadlock" rep.routine!error)
-    (prn "F - 'write' race condition 1")))
-;? (quit)
-
 ;; Separating concerns
 ;
 ; Lightweight tools can also operate on quoted lists of statements surrounded