From: Rutger van Beusekom Date: Thu, 19 Nov 2020 06:52:16 +0000 (+0100) Subject: actors: Introduce non-reentrant actors by default. X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=7429578ca2d8511dca2e5ba1b2b79b11a9368f90;p=8sync.git actors: Introduce non-reentrant actors by default. * 8sync/actors.scm (actor-reentrant-message-handler): Rename from actor-inheritable-message-handler. (actor-non-reentrant-message-handler): New function that queues messages. (): Change message-handler to that function and add message-q. (): New class for the old behaviour. (initialize): Use the orignal message-handler for this new class. --- diff --git a/8sync/actors.scm b/8sync/actors.scm index ceb2980..80d59af 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -32,6 +32,7 @@ simple-message-id-generator + actor-id actor-message-handler @@ -293,7 +294,7 @@ raise an exception if an error." ;;; Main actor implementation ;;; ========================= -(define (actor-inheritable-message-handler actor message) +(define (actor-reentrant-message-handler actor message) (define action (message-action message)) (define method (class-rmeta-ref (class-of actor) 'actions action @@ -307,6 +308,19 @@ raise an exception if an error." #:message message)) (apply method actor message (message-body message))) +(define (actor-non-reentrant-message-handler actor message) + (let* ((queue (actor-message-q actor)) + (messages? (pair? queue))) + (warn 'queue-size: (length queue)) + (set! queue (append queue (list message))) + (unless messages? + (let loop () + (warn 'handle-message: (message-action message)) + (actor-reentrant-message-handler actor (car queue)) + (set! queue (cdr queue)) + (unless (null? queue) + (loop)))))) + (define-syntax-rule (build-actions (symbol method) ...) "Construct an alist of (symbol . method), where the method is wrapped with wrap-apply to facilitate live hacking and allow the method definition @@ -324,7 +338,7 @@ to come after class definition." (hive #:init-keyword #:hive #:accessor actor-hive) ;; How we receive and process new messages - (message-handler #:init-value actor-inheritable-message-handler + (message-handler #:init-value actor-non-reentrant-message-handler ;; @@: There's no reason not to use #:class instead of ;; #:each-subclass anywhere in this file, except for ;; Guile bug #25211 (#:class is broken in Guile 2.2) @@ -344,7 +358,15 @@ to come after class definition." (*init* (const #f)) ;; Default cleanup method is to do nothing. (*cleanup* (const #f))) - #:allocation #:each-subclass)) + #:allocation #:each-subclass) + + (message-q #:init-value '() #:accessor actor-message-q)) + +(define-class ()) + +(define-method (initialize (o ) args) + (next-method) + (slot-set! o 'message-handler actor-reentrant-message-handler)) ;;; Addresses are vectors where the first part is the actor-id and ;;; the second part is the hive-id. This works well enough... they