X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=8sync%2Factors.scm;h=869d4ad699a52f7b70ce5319352760dcd925c2b4;hb=f3569fb835395ee0df67663bd187663102a3c985;hp=1d8e6023aa3b19bcb8350e4ee35d759cc3f59021;hpb=84a19e7d4cb97e00a64191e1ecfcf984ffae52d1;p=8sync.git
diff --git a/8sync/actors.scm b/8sync/actors.scm
index 1d8e602..869d4ad 100644
--- a/8sync/actors.scm
+++ b/8sync/actors.scm
@@ -342,22 +342,9 @@ to come after class definition."
(*cleanup* (const #f)))
#:allocation #:each-subclass))
-;;; So these are the nicer representations of addresses.
-;;; However, they don't serialize so easily with scheme read/write, so we're
-;;; using the simpler cons cell version below for now.
-
-;; (define-record-type
-;; (make-address actor-id hive-id) ; @@: Do we want the trailing -id?
-;; address?
-;; (actor-id address-actor-id)
-;; (hive-id address-hive-id))
-;;
-;; (set-record-type-printer!
-;;
-;; (lambda (record port)
-;; (format port ""
-;; (address-actor-id record) (address-hive-id record))))
-;;
+;;; Addresses are vectors where the first part is the actor-id and
+;;; the second part is the hive-id. This works well enough... they
+;;; look decent being pretty-printed.
(define (make-address actor-id hive-id)
(vector actor-id hive-id))
@@ -779,17 +766,32 @@ its '*cleanup* action handler."
;;; =========================
(define* (run-hive hive initial-tasks
- #:key (cleanup #t))
- "Start up an agenda and run HIVE in it with INITIAL-TASKS."
+ #:key (cleanup #t)
+ (handle-signals (list SIGINT SIGTERM)))
+ "Start up an agenda and run HIVE in it with INITIAL-TASKS.
+
+Keyword arguments:
+ - #:cleanup: Whether to run *cleanup* on all actors.
+ - #:handle-sigactions: a list of signals to set up interrupt
+ handlers for, so cleanup sill still happen as expected.
+ Defaults to a list of SIGINT and SIGTERM."
(dynamic-wind
(const #f)
(lambda ()
- (let* ((queue (list->q
- (cons (bootstrap-message hive (actor-id hive) '*init-all*)
- initial-tasks)))
- (agenda (make-agenda #:pre-unwind-handler print-error-and-continue
- #:queue queue)))
- (run-agenda agenda)))
+ (define (run-it escape)
+ (define (handle-signal signum)
+ (restore-signals)
+ (escape signum))
+ (for-each (lambda (signum)
+ (sigaction signum handle-signal))
+ handle-signals)
+ (let* ((queue (list->q
+ (cons (bootstrap-message hive (actor-id hive) '*init-all*)
+ initial-tasks)))
+ (agenda (make-agenda #:pre-unwind-handler print-error-and-continue
+ #:queue queue)))
+ (run-agenda agenda)))
+ (call/ec run-it))
;; Run cleanup
(lambda ()
(when cleanup