suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

thread: small simplification in scheduler

Browse Source
This commit is contained in:
Matthew Flatt 2019-12-29 11:33:32 -06:00
parent 38b789d056
commit b8a4e0535f
2 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/src/cs/rumble/control.ss
View File

@ -108,7 +108,7 @@
mark-chain ; #f or a cached list of mark-chain-frame or elem+cache
traces ; #f or a cached list of traces
cc-guard ; for impersonated tag, initially #f
avail-cache)) ; cache for `continuation-pompt-available?`
avail-cache)) ; cache for `continuation-prompt-available?`
;; Messages to `resume-k[/no-wind]`:
(define-record aborting (args))

9
racket/src/thread/schedule.rkt
View File

@ -119,8 +119,7 @@
(current-thread/in-atomic t)
(set-place-current-thread! current-place t)
(set! thread-swap-count (add1 thread-swap-count))
(run-callbacks-in-engine e callbacks t leftover-ticks
swap-in-engine))
(run-callbacks-in-engine e callbacks t leftover-ticks))
(define (swap-in-engine e t leftover-ticks)
(let loop ([e e])
@ -212,9 +211,9 @@
;; Run callbacks within the thread for `e`, and don't give up until
;; the callbacks are done
(define (run-callbacks-in-engine e callbacks t leftover-ticks k)
(define (run-callbacks-in-engine e callbacks t leftover-ticks)
(cond
[(null? callbacks) (k e t leftover-ticks)]
[(null? callbacks) (swap-in-engine e t leftover-ticks)]
[else
(define done? #f)
(let loop ([e e])
@ -230,7 +229,7 @@
(unless e
(internal-error "thread ended while it should run callbacks atomically"))
(if done?
(k e t leftover-ticks)
(swap-in-engine e t leftover-ticks)
(loop e)))))]))
;; Run foreign "async-apply" callbacks, now that we're in some thread