515 - support time limits for threads

Disquieting that I can't make each of these five tests fail in
isolation. We have to fix them all at once.

2 files changed, 164 insertions, 4 deletions

diff --git a/mu.arc b/mu.arc
index a0e4db2f..e7d50c02 100644
--- a/mu.arc
+++ b/mu.arc
@@ -189,8 +189,14 @@
 ; routine = runtime state for a serial thread of execution
 (def make-routine (fn-name . args)
   (do1
-    (annotate 'routine (obj alloc Memory-allocated-until call-stack (list
-        (obj fn-name fn-name  pc 0  args args  caller-arg-idx 0))))
+    (annotate 'routine (obj alloc Memory-allocated-until
+        call-stack
+          (list (obj fn-name fn-name  pc 0  args args  caller-arg-idx 0))))
+        ; other fields we use in routine:
+        ;   sleep: conditions
+        ;   limit: number of cycles this routine can use
+        ;   running-since: start of the clock for counting cycles this routine has used
+
     ; todo: allow routines to expand past initial allocation
     ; todo: do memory management in mu
     (++ Memory-allocated-until 1000)))
@@ -271,6 +277,9 @@
     (enq make-routine.it running-routines*))
   (while (~empty running-routines*)
     (= routine* deq.running-routines*)
+    (when rep.routine*!limit
+      ; start the clock if it wasn't already running
+      (or= rep.routine*!running-since curr-cycle*))
     (trace "schedule" top.routine*!fn-name)
     (routine-mark
       (run-for-time-slice scheduling-interval*))
@@ -290,21 +299,39 @@
 ;     particular time or for a particular memory location to change)
 ;   detect deadlock: kill all sleeping routines when none can be woken
 (def update-scheduler-state ()
-;?   (trace "schedule" curr-cycle*)
+;?   (tr curr-cycle*)
   (when routine*
     (if
         rep.routine*!sleep
           (do (trace "schedule" "pushing " top.routine*!fn-name " to sleep queue")
+              ; keep the clock ticking at rep.routine*!running-since
               (set sleeping-routines*.routine*))
-        (~empty routine*)
+        (and (~empty routine*) (no rep.routine*!limit))
           (do (trace "schedule" "scheduling " top.routine*!fn-name " for further processing")
               (enq routine* running-routines*))
+        (and (~empty routine*) (> rep.routine*!limit 0))
+          (do (trace "schedule" "scheduling " top.routine*!fn-name " for further processing (limit)")
+              ; stop the clock and debit the time on it from the routine
+              (-- rep.routine*!limit (- curr-cycle* rep.routine*!running-since))
+              (wipe rep.routine*!running-since)
+              (if (<= rep.routine*!limit 0)
+                (do (trace "schedule" "routine ran out of time")
+                    (push routine* completed-routines*))
+                (enq routine* running-routines*)))
         :else
           (do (trace "schedule" "done with routine")
               (push routine* completed-routines*)))
     (= routine* nil))
 ;?   (tr 111)
   (each (routine _) canon.sleeping-routines*
+;?     (tr routine)
+    (when (aand rep.routine!limit (<= it (- curr-cycle* rep.routine!running-since)))
+      (trace "schedule" "routine timed out")
+      (wipe sleeping-routines*.routine)
+      (push routine completed-routines*)
+;?       (tr completed-routines*)
+      ))
+  (each (routine _) canon.sleeping-routines*
     (when (ready-to-wake-up routine)
       (trace "schedule" "waking up " top.routine!fn-name)
       (wipe sleeping-routines*.routine)  ; do this before modifying routine
@@ -312,6 +339,7 @@
       (++ pc.routine)
       (enq routine running-routines*)))
 ;?   (tr 112)
+  ; optimization for simulated time
   (when (empty running-routines*)
     (whenlet exact-sleeping-routines (keep waiting-for-exact-cycle? keys.sleeping-routines*)
       (let next-wakeup-cycle (apply min (map [rep._!sleep 1] exact-sleeping-routines))
@@ -1353,6 +1381,14 @@
              :else
                (recur (+ addr 1) (+ idx 1))))))
 
+(def ran-to-completion (f)
+  ; if a routine calling f ran to completion there'll be no sign of it in any
+  ; completed call-stacks.
+  ; hack: only checks top call in each call stack
+  (no (find [aand stack._
+                  (is f top._!fn-name)]
+            completed-routines*)))
+
 ;; system software
 ; create once, load before every test
 
diff --git a/mu.arc.t b/mu.arc.t
index 4a422881..73c91693 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -2381,6 +2381,7 @@
       (2:integer <- copy 0:literal)
       (2:integer <- copy 0:literal)
      ])))
+;? (= dump-trace* (obj whitelist '("schedule")))
 (= scheduling-interval* 1)
 (run 'f1 'f2)
 (check-trace-contents "scheduler alternates between routines"
@@ -2557,6 +2558,129 @@
   (prn "F - scheduler ignores sleeping but ready threads when detecting deadlock"))
 
 (reset)
+(new-trace "scheduler-account-slice")
+; function running an infinite loop
+(add-code
+  '((function f1 [
+      { begin
+        (1:integer <- copy 0:literal)
+        (loop)
+      }
+     ])))
+(let routine make-routine!f1
+  (= rep.routine!limit 10)
+  (enq routine running-routines*))
+(= scheduling-interval* 20)
+(run)
+(when (or (empty completed-routines*)
+          (~is -10 ((rep completed-routines*.0) 'limit)))
+  (prn "F - when given a low cycle limit, a routine runs to end of time slice"))
+
+(reset)
+(new-trace "scheduler-account-slice-multiple")
+; function running an infinite loop
+(add-code
+  '((function f1 [
+      { begin
+        (1:integer <- copy 0:literal)
+        (loop)
+      }
+     ])))
+(let routine make-routine!f1
+  (= rep.routine!limit 100)
+  (enq routine running-routines*))
+(= scheduling-interval* 20)
+(run)
+(when (or (empty completed-routines*)
+          (~is -0 ((rep completed-routines*.0) 'limit)))
+  (prn "F - when given a high limit, a routine successfully stops after multiple time slices"))
+
+(reset)
+(new-trace "scheduler-account-run-while-asleep")
+(add-code
+    ; f1 needs 4 cycles of sleep time, 4 cycles of work
+  '((function f1 [
+      (sleep for-some-cycles:literal 4:literal)
+      (i:integer <- copy 0:literal)
+      (i:integer <- copy 0:literal)
+      (i:integer <- copy 0:literal)
+      (i:integer <- copy 0:literal)
+     ])))
+(let routine make-routine!f1
+  (= rep.routine!limit 6)  ; enough time excluding sleep
+  (enq routine running-routines*))
+(= scheduling-interval* 1)
+;? (= dump-trace* (obj whitelist '("schedule")))
+(run)
+; if time slept counts against limit, routine doesn't have time to complete
+(when (ran-to-completion 'f1)
+  (prn "F - time slept counts against a routine's cycle limit"))
+;? (quit)
+
+(reset)
+(new-trace "scheduler-account-stop-on-preempt")
+(add-code
+  '((function baseline [
+      (i:integer <- copy 0:literal)
+      { begin
+        (done?:boolean <- greater-or-equal i:integer 10:literal)
+        (break-if done?:boolean)
+        (1:integer <- add i:integer 1:literal)
+        (loop)
+      }
+     ])
+    (function f1 [
+      (i:integer <- copy 0:literal)
+      { begin
+        (done?:boolean <- greater-or-equal i:integer 6:literal)
+        (break-if done?:boolean)
+        (1:integer <- add i:integer 1:literal)
+        (loop)
+      }
+     ])))
+(let routine make-routine!baseline
+  (enq routine running-routines*))
+; now add the routine we care about
+(let routine make-routine!f1
+  (= rep.routine!limit 40)  ; less than 2x time f1 needs to complete
+  (enq routine running-routines*))
+(= scheduling-interval* 1)
+; if baseline's time were to count against f1's limit, it wouldn't be able to
+; complete.
+(when (~ran-to-completion 'f1)
+  (prn "F - preempted time doesn't count against a routine's limit"))
+;? (quit)
+
+(reset)
+(new-trace "scheduler-sleep-timeout")
+(add-code
+  '((function baseline [
+      (i:integer <- copy 0:literal)
+      { begin
+        (done?:boolean <- greater-or-equal i:integer 10:literal)
+        (break-if done?:boolean)
+        (1:integer <- add i:integer 1:literal)
+        (loop)
+      }
+     ])
+    (function f1 [
+      (sleep for-some-cycles:literal 10:literal)  ; less time than baseline would take to run
+     ])))
+; add baseline routine to prevent cycle-skipping
+(let routine make-routine!baseline
+  (enq routine running-routines*))
+; now add the routine we care about
+(let routine make-routine!f1
+  (= rep.routine!limit 4)  ; less time than f1 would take to run
+  (enq routine running-routines*))
+(= scheduling-interval* 1)
+;? (= dump-trace* (obj whitelist '("schedule")))
+(run)
+(when (ran-to-completion 'f1)
+  (prn "F - sleeping routines can time out"))
+;? (quit)
+
+(reset)
 (new-trace "sleep")
 (add-code
   '((function f1 [