282 - scheduler skips ahead when all routines are asleep

2 files changed, 50 insertions, 30 deletions

diff --git a/mu.arc b/mu.arc
index b2c44be4..e3bce664 100644
--- a/mu.arc
+++ b/mu.arc
@@ -215,26 +215,38 @@
 (def update-scheduler-state ()
 ;?   (tr "00 " routine*)
 ;?   (tr "01 " empty.routine*)
-  (if
-      rep.routine*!sleep
-        (do (trace "schedule" "pushing " top.routine*!fn-name " to sleep queue")
-            (set sleeping-routines*.routine*))
-      (~empty routine*)
-        (do ;(trace "schedule" "scheduling " top.routine*!fn-name " for further processing")
-            (enq routine* running-routines*))
-      :else
-        (do ;(trace "schedule" "done with " routine*)
-            (push routine* completed-routines*)))
-  (= routine* nil)
-;?   (tr "bb " sleeping-routines*)
-  (each (routine _) canon.sleeping-routines*
-;?     (tr "cc " sleeping-routines*)
-    (when (> curr-cycle* rep.routine!sleep.0)
-      (trace "schedule" "waking up " top.routine!fn-name)
-      (wipe sleeping-routines*.routine)  ; do this before modifying routine
-      (wipe rep.routine!sleep)
-      (++ pc.routine)
-      (enq routine running-routines*)))
+  (when routine*
+    (if
+        rep.routine*!sleep
+          (do (trace "schedule" "pushing " top.routine*!fn-name " to sleep queue")
+              (set sleeping-routines*.routine*))
+        (~empty routine*)
+          (do ;(trace "schedule" "scheduling " top.routine*!fn-name " for further processing")
+              (enq routine* running-routines*))
+        :else
+          (do ;(trace "schedule" "done with " routine*)
+              (push routine* completed-routines*)))
+    (= routine* nil))
+  (let earliest-waking-up-routine nil
+    (each (routine _) canon.sleeping-routines*
+      (if (> curr-cycle* rep.routine!sleep.0)
+        (do
+          (trace "schedule" "waking up " top.routine!fn-name)
+          (wipe sleeping-routines*.routine)  ; do this before modifying routine
+          (wipe rep.routine!sleep)
+          (++ pc.routine)
+          (enq routine running-routines*))
+        (when (or no.earliest-waking-up-routine
+                  (> rep.earliest-waking-up-routine!sleep.0
+                     rep.routine!sleep.0))
+          (= earliest-waking-up-routine routine))))
+    ; try to line up at least one routine for next cycle
+    (when (and (empty running-routines*)
+               earliest-waking-up-routine)
+      (= curr-cycle* (+ 1 rep.earliest-waking-up-routine!sleep.0))
+      (trace "schedule" "skipping to cycle " curr-cycle*)
+      (update-scheduler-state)
+      ))
 ;?   (tr "zz")
   )
 
@@ -245,12 +257,6 @@
 ;?                 ;else
 ;?                   (aand (m rep.routine!sleep)
 ;?                         (~is it 0)))
-;?     (when (empty running-routines*)
-;?       ; ensure forward progress
-;?       (trace "schedule" "skipping cycle " curr-cycle*)
-;?       (++ curr-cycle*)
-;?       (continue))
-;?     )))
 
 (def detect-deadlock ()
   (when (and empty.running-routines*
diff --git a/mu.arc.t b/mu.arc.t
index 58ac2d3a..74ecd224 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -1737,8 +1737,6 @@
   (set sleeping-routines*.routine))
 ; not yet time for it to wake up
 (= curr-cycle* 23)
-; pretend we just finished a routine
-(= routine* (annotate 'routine (table)))
 ;? (set dump-trace*)
 ;? (= dump-trace* (obj whitelist '("run" "schedule")))
 (update-scheduler-state)
@@ -1761,13 +1759,29 @@
   (set sleeping-routines*.routine))
 ; time for it to wake up
 (= curr-cycle* 24)
-; pretend we just finished a routine
-(= routine* (annotate 'routine (table)))
 (update-scheduler-state)
 (if (~is 2 len.running-routines*)
   (prn "F - scheduler wakes up sleeping routines at the right time"))
 
 (reset)
+(new-trace "scheduler-skip")
+(add-fns
+  '((f1
+      ((1 integer) <- copy (3 literal)))))
+; running-routines* is empty
+(assert (empty running-routines*))
+; sleeping routine
+(let routine make-routine!f1
+  (= rep.routine!sleep '(23 literal))
+  (set sleeping-routines*.routine))
+; long time left for it to wake up
+(= curr-cycle* 0)
+(update-scheduler-state)
+(assert (is curr-cycle* 24))
+(if (~is 1 len.running-routines*)
+  (prn "F - scheduler skips ahead to earliest sleeping routines when nothing to run"))
+
+(reset)
 (new-trace "sleep")
 (add-fns
   '((f1