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:
parent
dd246ddcae
commit
463dd48577
|
@ -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!)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue