Actor names; debug tracing of actors
This commit is contained in:
parent
2fa1b033eb
commit
defb65cd30
|
|
@ -77,6 +77,7 @@
|
|||
(struct outbound-assertion (handle peer [established? #:mutable]))
|
||||
|
||||
(struct actor (id
|
||||
name
|
||||
engine
|
||||
[daemon? #:mutable]
|
||||
dataflow
|
||||
|
|
@ -85,7 +86,7 @@
|
|||
[exit-hooks #:mutable])
|
||||
#:methods gen:custom-write
|
||||
[(define (write-proc a port mode)
|
||||
(fprintf port "#<actor:~a>" (actor-id a)))])
|
||||
(fprintf port "#<actor:~a:~a>" (actor-id a) (actor-name a)))])
|
||||
|
||||
(struct facet (id
|
||||
actor
|
||||
|
|
@ -98,8 +99,9 @@
|
|||
#:methods gen:custom-write
|
||||
[(define (write-proc f port mode)
|
||||
(local-require (only-in racket/string string-join))
|
||||
(fprintf port "#<facet:~a:~a>"
|
||||
(fprintf port "#<facet:~a:~a:~a>"
|
||||
(actor-id (facet-actor f))
|
||||
(actor-name (facet-actor f))
|
||||
(string-join (let loop ((f f))
|
||||
(if (facet-parent f)
|
||||
(cons (number->string (facet-id f)) (loop (facet-parent f)))
|
||||
|
|
@ -121,14 +123,15 @@
|
|||
|
||||
;;--------------------------------------------------------------------------
|
||||
|
||||
(define (actor-system boot-proc)
|
||||
(define (actor-system boot-proc #:name [name 'actor-system])
|
||||
(define e (make-engine 1))
|
||||
(make-actor e #t boot-proc (make-hash))
|
||||
(make-actor name e #t boot-proc (make-hash))
|
||||
(adjust-inhabitant-count! e -1)
|
||||
(thread-wait (engine-thread e)))
|
||||
|
||||
(define (make-actor engine daemon? boot-proc initial-assertions)
|
||||
(define (make-actor name engine daemon? boot-proc initial-assertions)
|
||||
(define ac (actor (generate-actor-id)
|
||||
name
|
||||
engine
|
||||
daemon?
|
||||
(make-dataflow-graph)
|
||||
|
|
@ -138,9 +141,9 @@
|
|||
(when (not daemon?)
|
||||
(adjust-inhabitant-count! engine +1))
|
||||
(set-actor-root! ac (make-facet ac #f initial-assertions))
|
||||
(log-syndicate/actor-info "~a booting" ac)
|
||||
(turn! (make-facet ac (actor-root ac))
|
||||
(stop-if-inert-after boot-proc))
|
||||
(log-syndicate/actor-info "~a created" ac)
|
||||
ac)
|
||||
|
||||
(define (actor-add-exit-hook! ac hook)
|
||||
|
|
@ -201,7 +204,7 @@
|
|||
|
||||
(define (facet-terminate! turn f orderly?)
|
||||
(when (facet-live? f)
|
||||
(log-syndicate/actor-debug "~a stopping (~a)" f (if orderly? "orderly" "disorderly"))
|
||||
(log-syndicate/actor-debug " ~a stopping (~a)" f (if orderly? "orderly" "disorderly"))
|
||||
(set-facet-live?! f #f)
|
||||
|
||||
(define parent (facet-parent f))
|
||||
|
|
@ -227,6 +230,11 @@
|
|||
|
||||
(define (turn! f action [zombie-turn? #f])
|
||||
(define ac (facet-actor f))
|
||||
(log-syndicate/actor-debug "start turn ~v~a~a~a"
|
||||
f
|
||||
(if zombie-turn? ", zombie" "")
|
||||
(let ((r (actor-exit-reason ac))) (if r (format ", exit-reason ~v" r) ""))
|
||||
(if (facet-live? f) "" ", dead facet"))
|
||||
(when (or zombie-turn? (and (not (actor-exit-reason ac)) (facet-live? f)))
|
||||
(let ((turn (turn (generate-turn-id) f (make-hasheq))))
|
||||
(with-handlers ([exn? (lambda (e)
|
||||
|
|
@ -240,7 +248,8 @@
|
|||
(lambda ()
|
||||
(turn! ff (lambda (turn)
|
||||
(for [(a (in-list (reverse qq)))] (a turn)))))))
|
||||
(set-turn-queues! turn #f)))))
|
||||
(set-turn-queues! turn #f)))
|
||||
(log-syndicate/actor-debug "end turn ~v\n" f)))
|
||||
|
||||
(define (with-active-facet outer-turn f action)
|
||||
(let ((inner-turn (turn (generate-turn-id) f (turn-queues outer-turn))))
|
||||
|
|
@ -260,35 +269,57 @@
|
|||
(with-active-facet turn new-facet (stop-if-inert-after boot-proc))
|
||||
new-facet))
|
||||
|
||||
(define (turn-stop! turn [f (turn-active-facet turn)] [continuation void])
|
||||
(turn-enqueue! turn
|
||||
(facet-parent f)
|
||||
(lambda (turn)
|
||||
(facet-terminate! turn f #t)
|
||||
(continuation turn))))
|
||||
|
||||
(define (turn-spawn! turn boot-proc [initial-assertions (make-hash)] #:daemon? [daemon? #f])
|
||||
(define f (turn-active-facet turn))
|
||||
(define o (facet-outbound f))
|
||||
(define (turn-stop! turn [f (turn-active-facet turn)] [continuation #f])
|
||||
(log-syndicate/actor-debug " ENQ stop-facet ~v" f)
|
||||
(turn-enqueue! turn
|
||||
f
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ stop-facet ~v" f)
|
||||
(facet-terminate! turn f #t)
|
||||
(when continuation
|
||||
(log-syndicate/actor-debug " ENQ stop-facet ~v continuation" f)
|
||||
(turn-enqueue!
|
||||
turn
|
||||
(facet-parent f)
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ stop-facet ~v continuation" f)
|
||||
(continuation turn)))))))
|
||||
|
||||
(define (turn-spawn! turn boot-proc [initial-assertions (make-hash)]
|
||||
#:name [name '?]
|
||||
#:daemon? [daemon? #f])
|
||||
(define f (turn-active-facet turn))
|
||||
(define o (facet-outbound f))
|
||||
(log-syndicate/actor-debug " ENQ spawn ~a" name)
|
||||
(turn-enqueue! turn
|
||||
f
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ spawn ~a" name)
|
||||
(define new-outbound (make-hash))
|
||||
(for [(handle (in-hash-keys initial-assertions))]
|
||||
(hash-set! new-outbound handle (hash-ref o handle))
|
||||
(hash-remove! o handle))
|
||||
(define engine (actor-engine (facet-actor f)))
|
||||
(queue-task! engine (lambda () (make-actor engine daemon? boot-proc new-outbound))))))
|
||||
(queue-task! engine
|
||||
(lambda ()
|
||||
(make-actor name engine daemon? boot-proc new-outbound))))))
|
||||
|
||||
(define (turn-stop-actor! turn)
|
||||
(define ac (facet-actor (turn-active-facet turn)))
|
||||
(turn-enqueue! turn (actor-root ac) (lambda (turn) (actor-terminate! turn ac #t))))
|
||||
(log-syndicate/actor-debug " ENQ stop-actor ~v" ac)
|
||||
(turn-enqueue! turn (actor-root ac) (lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ stop-actor ~v" ac)
|
||||
(actor-terminate! turn ac #t))))
|
||||
|
||||
(define (turn-crash! turn exn)
|
||||
(define ac (facet-actor (turn-active-facet turn)))
|
||||
(turn-enqueue! turn (actor-root ac) (lambda (turn) (actor-terminate! turn ac exn))))
|
||||
(log-syndicate/actor-debug " ENQ crash ~v" ac)
|
||||
(turn-enqueue! turn (actor-root ac) (lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ crash ~v" ac)
|
||||
(actor-terminate! turn ac exn))))
|
||||
|
||||
(define (turn-field! turn name initial-value)
|
||||
(log-syndicate/actor-debug " field ~v created: ~v" name initial-value)
|
||||
(field (actor-dataflow (facet-actor (turn-active-facet turn))) name initial-value))
|
||||
|
||||
(define (turn-dataflow! turn action)
|
||||
|
|
@ -312,13 +343,17 @@
|
|||
|
||||
(define (turn-assert!* turn peer assertion handle)
|
||||
(match (run-rewrites (entity-ref-attenuation peer) assertion)
|
||||
[(? void?) (void)]
|
||||
[(? void?)
|
||||
(log-syndicate/actor-debug " blocked assert of ~v at ~v" assertion peer)
|
||||
(void)]
|
||||
[rewritten
|
||||
(define a (outbound-assertion handle peer #f))
|
||||
(hash-set! (facet-outbound (turn-active-facet turn)) handle a)
|
||||
(log-syndicate/actor-debug " ENQ at ~v assert ~v handle ~v" peer rewritten handle)
|
||||
(turn-enqueue! turn
|
||||
(entity-ref-relay peer)
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ at ~v assert ~v handle ~v" peer rewritten handle)
|
||||
(set-outbound-assertion-established?! a #t)
|
||||
(deliver (entity-assert (entity-ref-target peer)) turn rewritten handle)))]))
|
||||
|
||||
|
|
@ -334,9 +369,18 @@
|
|||
|
||||
(define (turn-retract!* turn a)
|
||||
(hash-remove! (facet-outbound (turn-active-facet turn)) (outbound-assertion-handle a))
|
||||
(log-syndicate/actor-debug " ENQ at ~v retract handle ~v"
|
||||
(outbound-assertion-peer a)
|
||||
(outbound-assertion-handle a))
|
||||
(turn-enqueue! turn
|
||||
(entity-ref-relay (outbound-assertion-peer a))
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ at ~v retract handle ~v (~a)"
|
||||
(outbound-assertion-peer a)
|
||||
(outbound-assertion-handle a)
|
||||
(if (outbound-assertion-established? a)
|
||||
"established"
|
||||
"not established"))
|
||||
(when (outbound-assertion-established? a)
|
||||
(set-outbound-assertion-established?! a #f)
|
||||
(deliver (entity-retract (entity-ref-target (outbound-assertion-peer a)))
|
||||
|
|
@ -347,9 +391,11 @@
|
|||
(turn-sync!* turn peer (turn-ref turn (make-entity #:message k))))
|
||||
|
||||
(define (turn-sync!* turn peer-to-sync-with peer-k)
|
||||
(log-syndicate/actor-debug " ENQ sync ~v" peer-to-sync-with)
|
||||
(turn-enqueue! turn
|
||||
(entity-ref-relay peer-to-sync-with)
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ sync ~v" peer-to-sync-with)
|
||||
(deliver (or (entity-sync (entity-ref-target peer-to-sync-with))
|
||||
(lambda (turn peer-k) (turn-message! turn peer-k #t)))
|
||||
turn
|
||||
|
|
@ -357,11 +403,15 @@
|
|||
|
||||
(define (turn-message! turn peer assertion)
|
||||
(match (run-rewrites (entity-ref-attenuation peer) assertion)
|
||||
[(? void?) (void)]
|
||||
[(? void?)
|
||||
(log-syndicate/actor-debug " blocked message ~v to ~v" assertion peer)
|
||||
(void)]
|
||||
[rewritten
|
||||
(log-syndicate/actor-debug " ENQ message ~v to ~v" assertion peer)
|
||||
(turn-enqueue! turn
|
||||
(entity-ref-relay peer)
|
||||
(lambda (turn)
|
||||
(log-syndicate/actor-debug " DEQ message ~v to ~v" assertion peer)
|
||||
(deliver (entity-message (entity-ref-target peer)) turn rewritten)))]))
|
||||
|
||||
(define (turn-freshen turn action)
|
||||
|
|
|
|||
|
|
@ -61,8 +61,12 @@
|
|||
(lambda (turn . formals)
|
||||
(with-this-turn turn expr ...)))
|
||||
|
||||
(define-syntax-rule (actor-system expr ...)
|
||||
(actor:actor-system (action () expr ...)))
|
||||
(define-syntax actor-system
|
||||
(syntax-rules ()
|
||||
[(_ #:name name expr ...)
|
||||
(actor:actor-system #:name name (action () expr ...))]
|
||||
[(_ expr ...)
|
||||
(actor:actor-system (action () expr ...))]))
|
||||
|
||||
(define-syntax-rule (with-fresh-turn expr ...)
|
||||
(turn-freshen this-turn (action () expr ...)))
|
||||
|
|
@ -97,8 +101,12 @@
|
|||
(define-syntax-rule (send! peer assertion)
|
||||
(turn-message! this-turn peer (:template assertion)))
|
||||
|
||||
(define-syntax-rule (spawn setup-expr ...)
|
||||
(turn-spawn! this-turn (action () setup-expr ...)))
|
||||
(define-syntax spawn
|
||||
(syntax-rules ()
|
||||
[(_ #:name name setup-expr ...)
|
||||
(turn-spawn! #:name name this-turn (action () setup-expr ...))]
|
||||
[(_ setup-expr ...)
|
||||
(turn-spawn! this-turn (action () setup-expr ...))]))
|
||||
|
||||
(define-syntax-rule (begin/dataflow expr ...)
|
||||
(turn-dataflow! this-turn (action () expr ...)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue