X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Factors.scm;h=0c50446d8c1a4ac9b8aaec5328247edd9ef8f4da;hp=8e1b504b9378e3f5ff5ab4e239018459cb2ced3f;hb=04cb3218619e5fd734dd0644e734b3fe506caf00;hpb=2785c244a09fc008488385b10053ef854fb27c34 diff --git a/8sync/actors.scm b/8sync/actors.scm index 8e1b504..0c50446 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -51,7 +51,7 @@ build-actions - define-simple-actor + define-actor make-hive @@ -395,10 +395,13 @@ to come after class definition." ;;; Actor utilities ;;; =============== -(define-syntax-rule (define-simple-actor class action ...) - (define-class class () +(define-syntax-rule (define-actor class inherits + (action ...) + slots ...) + (define-class class inherits (actions #:init-value (build-actions action ...) - #:allocation #:each-subclass))) + #:allocation #:each-subclass) + slots ...)) ;;; The Hive @@ -776,17 +779,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