Tentative repair to startup/shutdown ordering problems
This commit is contained in:
parent
990ad4ca72
commit
76c1a5b347
|
@ -408,9 +408,10 @@
|
||||||
(let ((fid fid-expr))
|
(let ((fid fid-expr))
|
||||||
(when (not (fid-ancestor? (current-facet-id) fid))
|
(when (not (fid-ancestor? (current-facet-id) fid))
|
||||||
(error 'stop-facet "Attempt to stop non-ancestor facet ~a" fid))
|
(error 'stop-facet "Attempt to stop non-ancestor facet ~a" fid))
|
||||||
(terminate-facet! fid)
|
|
||||||
(parameterize ((current-facet-id (cdr fid))) ;; run in parent context wrt terminating facet
|
(parameterize ((current-facet-id (cdr fid))) ;; run in parent context wrt terminating facet
|
||||||
(schedule-script! (lambda () (begin/void-default script ...))))))]))
|
(schedule-script! (lambda ()
|
||||||
|
(terminate-facet! fid)
|
||||||
|
(begin/void-default script ...))))))]))
|
||||||
|
|
||||||
(define-syntax-rule (stop-current-facet)
|
(define-syntax-rule (stop-current-facet)
|
||||||
(stop-facet (current-facet-id)))
|
(stop-facet (current-facet-id)))
|
||||||
|
@ -996,14 +997,6 @@
|
||||||
(define (terminate-facet! fid)
|
(define (terminate-facet! fid)
|
||||||
(define f (lookup-facet fid))
|
(define f (lookup-facet fid))
|
||||||
(when f
|
(when f
|
||||||
(for [((eid ep) (in-hash (facet-endpoints f)))]
|
|
||||||
(define a (current-actor-state))
|
|
||||||
(dataflow-forget-subject! (actor-state-field-dataflow a) (list fid eid))
|
|
||||||
(define-values (new-mux _eid _delta delta-aggregate)
|
|
||||||
(mux-remove-stream (actor-state-mux a) eid))
|
|
||||||
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
|
||||||
(schedule-action! delta-aggregate))
|
|
||||||
|
|
||||||
(let ((parent-fid (cdr fid)))
|
(let ((parent-fid (cdr fid)))
|
||||||
(when (pair? parent-fid)
|
(when (pair? parent-fid)
|
||||||
(update-facet! parent-fid
|
(update-facet! parent-fid
|
||||||
|
@ -1020,8 +1013,17 @@
|
||||||
;; Run stop-scripts after terminating children. This means that
|
;; Run stop-scripts after terminating children. This means that
|
||||||
;; children's stop-scripts run before ours.
|
;; children's stop-scripts run before ours.
|
||||||
(with-current-facet fid #t
|
(with-current-facet fid #t
|
||||||
(for [(script (in-list (reverse (facet-stop-scripts f))))]
|
(map schedule-script! (reverse (facet-stop-scripts f))))
|
||||||
(call-with-syndicate-effects script)))))
|
|
||||||
|
(schedule-script!
|
||||||
|
(lambda ()
|
||||||
|
(for [((eid ep) (in-hash (facet-endpoints f)))]
|
||||||
|
(define a (current-actor-state))
|
||||||
|
(dataflow-forget-subject! (actor-state-field-dataflow a) (list fid eid))
|
||||||
|
(define-values (new-mux _eid _delta delta-aggregate)
|
||||||
|
(mux-remove-stream (actor-state-mux a) eid))
|
||||||
|
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
||||||
|
(schedule-action! delta-aggregate))))))
|
||||||
|
|
||||||
(define (add-stop-script! script-proc)
|
(define (add-stop-script! script-proc)
|
||||||
(update-facet! (current-facet-id)
|
(update-facet! (current-facet-id)
|
||||||
|
|
Loading…
Reference in New Issue