syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Always pick the highest-priority script to run next. 

This means that `*gc-priority*` scripts will now reliably run last.
Prior to this change, if some higher-priority script X ran while a
`*gc-priority*` script Y was queued, and it enqueued a high-priority
script Z, then Y would run before Z.
This commit is contained in:
Tony Garnock-Jones 2016-07-31 12:02:11 -04:00
parent dd246ddcae
commit 463dd48577
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
racket/syndicate/actor.rkt
View File

@ -88,6 +88,7 @@
(require "store.rkt") (require "store.rkt")
(require "support/hash.rkt") (require "support/hash.rkt")
(require "pretty.rkt") (require "pretty.rkt")
(require "functional-queue.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Definitions and Structures ;; Data Definitions and Structures
@ -234,7 +235,7 @@
;; Storeof (Constreeof Action) ;; Storeof (Constreeof Action)
(define current-pending-actions (make-store)) (define current-pending-actions (make-store))
;; Storeof (Vector (List Script) (List Script)) ;; Storeof (Vector (Queue Script) ...)
;; Mutates the vector! ;; Mutates the vector!
(define current-pending-scripts (make-store)) (define current-pending-scripts (make-store))
@ -853,7 +854,7 @@
(define (push-script! priority thunk-with-context) (define (push-script! priority thunk-with-context)
(define v (current-pending-scripts)) (define v (current-pending-scripts))
(vector-set! v priority (cons thunk-with-context (vector-ref v priority)))) (vector-set! v priority (enqueue (vector-ref v priority) thunk-with-context)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Action Queue Management ;; Action Queue Management
@ -991,7 +992,7 @@
[stop-scripts (cons script-proc (facet-stop-scripts f))]))))) [stop-scripts (cons script-proc (facet-stop-scripts f))])))))
(define (make-empty-pending-scripts) (define (make-empty-pending-scripts)
(make-vector priority-count '())) (make-vector priority-count (make-queue)))
(define (boot-actor script-proc) (define (boot-actor script-proc)
(with-store [(current-actor-state (with-store [(current-actor-state
@ -1008,17 +1009,21 @@
(schedule-script! #f script-proc) (schedule-script! #f script-proc)
(run-scripts!)))) (run-scripts!))))
(define (scripts-pending?) (define (pop-next-script!)
(for/or [(scripts (in-vector (current-pending-scripts)))] (define priority-levels (current-pending-scripts))
(not (null? scripts)))) (let loop ((level 0))
(and (< level (vector-length priority-levels))
(let ((q (vector-ref priority-levels level)))
(if (queue-empty? q)
(loop (+ level 1))
(let-values (((script q) (dequeue q)))
(vector-set! priority-levels level q)
script))))))
(define (run-all-pending-scripts!) (define (run-all-pending-scripts!)
(when (scripts-pending?) (define script (pop-next-script!))
(define pending-scripts (current-pending-scripts)) (when script
(current-pending-scripts (make-empty-pending-scripts)) (script)
(for* [(scripts (in-vector pending-scripts))
(script (in-list (reverse scripts)))]
(script))
(refresh-facet-assertions!) (refresh-facet-assertions!)
(run-all-pending-scripts!))) (run-all-pending-scripts!)))