Experimental integration with Vincent's custom profiling tools
This commit is contained in:
parent
a2e51dc9be
commit
6e3b8be397
|
@ -2,10 +2,12 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(spawn-vm
|
||||
#:debug-name 'listener-vm
|
||||
(at-meta-level
|
||||
(observe-publishers (tcp-channel ? (tcp-listener 5999) ?)
|
||||
(match-conversation (tcp-channel them us _)
|
||||
(on-presence (spawn (chat-session them us)))))))
|
||||
(on-presence (name-process `(,them --> ,us)
|
||||
(spawn (chat-session them us))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (chat-session them us)
|
||||
|
|
16
ground.rkt
16
ground.rkt
|
@ -19,8 +19,24 @@
|
|||
|
||||
(provide run-ground-vm)
|
||||
|
||||
(require/typed profile
|
||||
[profile-thunk ((-> Void) #:custom-key (Pairof
|
||||
(Continuation-Mark-Keyof Any)
|
||||
(-> (Listof Any) (Listof Any)))
|
||||
-> Void)])
|
||||
|
||||
(: run-ground-vm : process-spec -> Void)
|
||||
(define (run-ground-vm boot)
|
||||
(profile-thunk (lambda () (run-ground-vm* boot))
|
||||
#:custom-key (cons marketplace-continuation-mark-key
|
||||
(lambda: ([vs : (Listof Any)])
|
||||
(let: loop : (Listof Any) ((vs : (Listof Any) vs))
|
||||
(if (null? vs)
|
||||
'()
|
||||
(cons vs (loop (cdr vs)))))))))
|
||||
|
||||
(: run-ground-vm* : process-spec -> Void)
|
||||
(define (run-ground-vm* boot)
|
||||
(let loop ((state (make-vm boot)))
|
||||
(match (run-vm state)
|
||||
[(transition state actions)
|
||||
|
|
|
@ -12,7 +12,10 @@
|
|||
action-tree->quasiqueue
|
||||
quit-interruptk
|
||||
run-ready
|
||||
notify-route-change-vm)
|
||||
notify-route-change-vm
|
||||
marketplace-continuation-mark-key)
|
||||
|
||||
(define marketplace-continuation-mark-key (make-continuation-mark-key 'marketplace))
|
||||
|
||||
(define-syntax-rule (send-to-user p (e) failure-result enclosed-expr)
|
||||
(send-to-user* (process-debug-name p) (process-pid p) (e) failure-result enclosed-expr))
|
||||
|
@ -26,7 +29,9 @@
|
|||
debug-name pid e))
|
||||
failure-result)])
|
||||
(marketplace-log 'debug "Entering process ~v(~v)" debug-name pid)
|
||||
(define result enclosed-expr)
|
||||
(define result (with-continuation-mark marketplace-continuation-mark-key
|
||||
(or debug-name pid)
|
||||
enclosed-expr))
|
||||
(marketplace-log 'debug "Leaving process ~v(~v)" debug-name pid)
|
||||
result))
|
||||
|
||||
|
|
Loading…
Reference in New Issue