From 56d549e3dfb56a4ecf29e779221600d3bd999c76 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 5 Mar 2012 18:29:49 -0500 Subject: [PATCH] Crude window into VM state via a "debug register" of sorts --- os.rkt | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/os.rkt b/os.rkt index e265757..fae4e2d 100644 --- a/os.rkt +++ b/os.rkt @@ -23,6 +23,7 @@ (struct-out ground-event-pattern) (struct-out ground-event-value) ground-vm + current-ground-transition ;; DEBUG ) ;; Each VM hosts 0 or more *multiplexed* processes. Each process has @@ -360,6 +361,7 @@ (let loop ((transition (run-vm (make-vm boot #:pattern-predicate pattern-predicate #:meta-pattern-predicate match-ground-event)))) + (set! current-ground-transition transition) (for-each (lambda (thunk) (thunk)) (kernel-mode-transition-messages transition)) (when (not (nested-vm-inert? (kernel-mode-transition-suspension transition))) (match transition @@ -384,3 +386,6 @@ [_ (error 'ground-vm "Outermost VM may not spawn new siblings or send or receive metamessages")])))) + +;; For debugging +(define current-ground-transition #f)