Crude window into VM state via a "debug register" of sorts
This commit is contained in:
parent
ab03a26026
commit
56d549e3df
5
os.rkt
5
os.rkt
|
@ -23,6 +23,7 @@
|
||||||
(struct-out ground-event-pattern)
|
(struct-out ground-event-pattern)
|
||||||
(struct-out ground-event-value)
|
(struct-out ground-event-value)
|
||||||
ground-vm
|
ground-vm
|
||||||
|
current-ground-transition ;; DEBUG
|
||||||
)
|
)
|
||||||
|
|
||||||
;; Each VM hosts 0 or more *multiplexed* processes. Each process has
|
;; Each VM hosts 0 or more *multiplexed* processes. Each process has
|
||||||
|
@ -360,6 +361,7 @@
|
||||||
(let loop ((transition (run-vm (make-vm boot
|
(let loop ((transition (run-vm (make-vm boot
|
||||||
#:pattern-predicate pattern-predicate
|
#:pattern-predicate pattern-predicate
|
||||||
#:meta-pattern-predicate match-ground-event))))
|
#:meta-pattern-predicate match-ground-event))))
|
||||||
|
(set! current-ground-transition transition)
|
||||||
(for-each (lambda (thunk) (thunk)) (kernel-mode-transition-messages transition))
|
(for-each (lambda (thunk) (thunk)) (kernel-mode-transition-messages transition))
|
||||||
(when (not (nested-vm-inert? (kernel-mode-transition-suspension transition)))
|
(when (not (nested-vm-inert? (kernel-mode-transition-suspension transition)))
|
||||||
(match transition
|
(match transition
|
||||||
|
@ -384,3 +386,6 @@
|
||||||
[_
|
[_
|
||||||
(error 'ground-vm
|
(error 'ground-vm
|
||||||
"Outermost VM may not spawn new siblings or send or receive metamessages")]))))
|
"Outermost VM may not spawn new siblings or send or receive metamessages")]))))
|
||||||
|
|
||||||
|
;; For debugging
|
||||||
|
(define current-ground-transition #f)
|
||||||
|
|
Loading…
Reference in New Issue