diff --git a/mu.arc b/mu.arc index e96a500d..bd55a79f 100644 --- a/mu.arc +++ b/mu.arc @@ -231,13 +231,16 @@ `((((rep ,routine) 'call-stack) 0) 'results)) (def waiting-for-exact-cycle? (routine) - (is 'literal rep.routine!sleep.1)) + (is 'for-some-cycles rep.routine!sleep.0)) (def ready-to-wake-up (routine) (assert no.routine*) - (if (is 'literal rep.routine!sleep.1) - (> curr-cycle* rep.routine!sleep.0) - (~is rep.routine!sleep.1 (memory* rep.routine!sleep.0)))) + (case rep.routine!sleep.0 + for-some-cycles + (> curr-cycle* rep.routine!sleep.1) + until-location-changes + (~is rep.routine!sleep.2 (memory* rep.routine!sleep.1)) + )) (on-init (= running-routines* (queue)) ; simple round-robin scheduler @@ -311,7 +314,7 @@ ;? (tr 112) (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 0] exact-sleeping-routines)) + (let next-wakeup-cycle (apply min (map [rep._!sleep 1] exact-sleeping-routines)) (= curr-cycle* (+ 1 next-wakeup-cycle)) (trace "schedule" "skipping to cycle " curr-cycle*) (update-scheduler-state)))) @@ -560,16 +563,15 @@ (unless (m arg.0) (die (v arg.1))) sleep - (let operand arg.0 -;? (tr "sleep " operand) - ; store sleep as either ( literal) or ( ) - (if (is ty.operand.0 '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 ,m.operand)))) + (do + (case (v arg.0) + for-some-cycles + (let wakeup-time (+ curr-cycle* (v arg.1)) + (trace "run" "sleeping until " wakeup-time) + (= rep.routine*!sleep `(for-some-cycles ,wakeup-time))) + until-location-changes + (= rep.routine*!sleep `(until-location-changes ,(addr arg.1) ,(m arg.1))) + ) ((abort-routine*))) ; cursor-based (text mode) interaction @@ -1502,7 +1504,7 @@ (full:boolean <- full? chan:channel-address/deref) (break-unless full:boolean) (full-address:integer-address <- get-address chan:channel-address/deref first-full:offset) - (sleep full-address:integer-address/deref) + (sleep until-location-changes:literal full-address:integer-address/deref) } ; store val (q:tagged-value-array-address <- get chan:channel-address/deref circular-buffer:offset) @@ -1528,7 +1530,7 @@ (empty:boolean <- empty? chan:channel-address/deref) (break-unless empty:boolean) (free-address:integer-address <- get-address chan:channel-address/deref first-free:offset) - (sleep free-address:integer-address/deref) + (sleep until-location-changes:literal free-address:integer-address/deref) } ; read result (full:integer-address <- get-address chan:channel-address/deref first-full:offset) diff --git a/mu.arc.t b/mu.arc.t index f5cdbe89..6661f06d 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -2403,7 +2403,7 @@ (assert (is 1 len.running-routines*)) ; sleeping routine (let routine make-routine!f2 - (= rep.routine!sleep '(23 literal)) + (= rep.routine!sleep '(for-some-cycles 23)) (set sleeping-routines*.routine)) ; not yet time for it to wake up (= curr-cycle* 23) @@ -2428,7 +2428,7 @@ (assert (is 1 len.running-routines*)) ; sleeping routine (let routine make-routine!f2 - (= rep.routine!sleep '(23 literal)) + (= rep.routine!sleep '(for-some-cycles 23)) (set sleeping-routines*.routine)) ; time for it to wake up (= curr-cycle* 24) @@ -2451,7 +2451,7 @@ (assert (is 1 len.running-routines*)) ; blocked routine waiting for location 23 to change (let routine make-routine!f2 - (= rep.routine!sleep '(23 0)) + (= rep.routine!sleep '(until-location-changes 23 0)) (set sleeping-routines*.routine)) ; leave memory location 23 unchanged (= memory*.23 0) @@ -2483,7 +2483,7 @@ (assert (is 1 len.running-routines*)) ; blocked routine waiting for location 23 to change (let routine make-routine!f2 - (= rep.routine!sleep '(23 0)) + (= rep.routine!sleep '(until-location-changes 23 0)) (set sleeping-routines*.routine)) ; change memory location 23 (= memory*.23 1) @@ -2503,7 +2503,7 @@ (assert (empty running-routines*)) ; sleeping routine (let routine make-routine!f1 - (= rep.routine!sleep '(34 literal)) + (= rep.routine!sleep '(for-some-cycles 34)) (set sleeping-routines*.routine)) ; long time left for it to wake up (= curr-cycle* 0) @@ -2523,7 +2523,7 @@ (assert (empty completed-routines*)) ; blocked routine (let routine make-routine!f1 - (= rep.routine!sleep '(23 0)) + (= rep.routine!sleep '(until-location-changes 23 0)) (set sleeping-routines*.routine)) ; location it's waiting on is 'unchanged' (= memory*.23 0) @@ -2546,7 +2546,7 @@ (assert (empty running-routines*)) ; blocked routine (let routine make-routine!f1 - (= rep.routine!sleep '(23 0)) + (= rep.routine!sleep '(until-location-changes 23 0)) (set sleeping-routines*.routine)) ; but is about to become ready (= memory*.23 1) @@ -2558,7 +2558,7 @@ (new-trace "sleep") (add-code '((function f1 [ - (sleep 1:literal) + (sleep for-some-cycles:literal 1:literal) (1:integer <- copy 0:literal) (1:integer <- copy 0:literal) ]) @@ -2583,7 +2583,7 @@ (new-trace "sleep-long") (add-code '((function f1 [ - (sleep 20:literal) + (sleep for-some-cycles:literal 20:literal) (1:integer <- copy 0:literal) (1:integer <- copy 0:literal) ]) @@ -2610,11 +2610,11 @@ '((function f1 [ ; waits for memory location 1 to be set, before computing its successor (1:integer <- copy 0:literal) - (sleep 1:integer) + (sleep until-location-changes:literal 1:integer) (2:integer <- add 1:integer 1:literal) ]) (function f2 [ - (sleep 30:literal) + (sleep for-some-cycles:literal 30:literal) (1:integer <- copy 3:literal) ; set to value ]))) ;? (= dump-trace* (obj whitelist '("run" "schedule"))) @@ -2635,11 +2635,11 @@ (10:integer <- copy 5:literal) ; array of locals (default-space:space-address <- copy 10:literal) (1:integer <- copy 23:literal) ; really location 12 - (sleep 1:integer) + (sleep until-location-changes:literal 1:integer) (2:integer <- add 1:integer 1:literal) ]) (function f2 [ - (sleep 30:literal) + (sleep for-some-cycles:literal 30:literal) (12:integer <- copy 3:literal) ; set to value ]))) ;? (= dump-trace* (obj whitelist '("run" "schedule")))