csys: now without dispatcher loop - send is directly submitting the selected action

This commit is contained in:
Helmut Merz 2025-06-11 20:03:42 +02:00
parent 6cef655707
commit 5ff08dcde6
3 changed files with 13 additions and 24 deletions

View file

@ -10,42 +10,32 @@
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:*dispatcher* #:setup #:start #:shutdown (:export #:*dispatcher* #:setup #:send
#:printer #:printer
)) ))
(in-package :scopes/csys) (in-package :scopes/csys)
(defun send (msg)
(handle-message msg))
(defvar *dispatcher* nil) (defvar *dispatcher* nil)
(defun setup (&optional (cfg config:*root*)) (defun setup (&optional (cfg config:*root*))
(setf *dispatcher* (make-instance 'core:context :config cfg)) (setf *dispatcher* (make-instance 'core:context :config cfg))
(setf (core:mailbox *dispatcher*) (async:make-mb))
(dolist (a (config:actions cfg)) (dolist (a (config:actions cfg))
(core:add-action *dispatcher* (car a) (cadr a)))) (core:add-action *dispatcher* (car a) (cadr a))))
(defun start ()
(async:init)
(actor:start (core:mailbox *dispatcher*)
(lambda (msg) (funcall #'handle-message msg))
:foreground t))
(defun handle-message (msg) (defun handle-message (msg)
(let ((hdlrs (core:select msg (core:actions *dispatcher*)))) (let ((hdlrs (core:select msg (core:actions *dispatcher*))))
(if hdlrs (if hdlrs
(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs) (mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
(util:lgw "no action selected" msg))) (util:lgw "no action selected" msg))))
nil)
(defun run-action (job msg) (defun run-action (job msg)
(let ((ch (async:make-ch))) (let ((ch (async:make-ch)))
(async:submit-task ch (lambda () (funcall job msg))))) (async:submit-task ch (lambda () (funcall job msg)))))
(defun shutdown (msg &optional (delay 0.1))
(sleep delay)
(format t "~&*** shutdown ~a~%" msg)
(actor:stop (core:mailbox *dispatcher*)))
;;;; example behaviors / actions ;;;; example behaviors / actions
(defun printer (msg) (defun printer (msg)

View file

@ -5,7 +5,6 @@
(config:root) (config:root)
(config:add-action '(:test) #'csys:printer) (config:add-action '(:test) #'csys:printer)
(config:add-action '(:stop) #'csys:shutdown)
(config:add :logger :class 'logging:config (config:add :logger :class 'logging:config
:loglevel (config:from-env :loglevel :info) :loglevel (config:from-env :loglevel :info)

View file

@ -21,19 +21,19 @@
;;;; test runner ;;;; test runner
(defun run () (defun run ()
(async:init)
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))) (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")))
(load (t:test-path "config-csys" "etc")) (load (t:test-path "config-csys" "etc"))
(unwind-protect (unwind-protect
(progn (progn
(test-basic)) (test-nodispatch))
(async:finish) (async:finish)
(t:show-result)))) (t:show-result))))
(deftest test-basic () (deftest test-nodispatch ()
(csys:setup) (csys:setup)
(!= csys:*dispatcher* nil) (csys:send (message:create '(:test 1)))
(actor:send (core:mailbox csys:*dispatcher*) (message:create '(:test))) (csys:send (message:create '(:test 2)))
(actor:send (core:mailbox csys:*dispatcher*) (message:create '(:stop))) (csys:send (message:create '(:test 3)))
;(actor:stop (core:mailbox csys:*dispatcher*)) (csys:send (message:create '(:test 4)))
(csys:start) )
)