diff --git a/syndicate/actor.rkt b/syndicate/actor.rkt index 1f6d865..72fd1c0 100644 --- a/syndicate/actor.rkt +++ b/syndicate/actor.rkt @@ -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-id a)))]) + (fprintf port "#" (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 "#" + (fprintf port "#" (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) diff --git a/syndicate/syntax.rkt b/syndicate/syntax.rkt index bf5dc33..8e018dd 100644 --- a/syndicate/syntax.rkt +++ b/syndicate/syntax.rkt @@ -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 ...)))