cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

more on util/async: task, standard-job

Browse source
This commit is contained in:
Helmut Merz 2025-02-16 22:36:07 +01:00
parent 2e6966276c
commit 8267ed8b38
2 changed files with 19 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
test/test-core.lisp
View file

@ -85,7 +85,7 @@
(== pl '(:b 1 :a 0)))) (== pl '(:b 1 :a 0))))
(deftest test-util-async () (deftest test-util-async ()
(let ((tsk (async:task))) (let ((tsk (async:make-task)))
(format t "~%~a~%" (async::taskid tsk)))) (format t "~%~a~%" (async::taskid tsk))))
(deftest test-util-crypt () (deftest test-util-crypt ()

23
util/async.lisp
View file

@ -1,4 +1,4 @@
;;;; cl-scopes/util/async - utilities for asynchronous (concurrent or parallel) operations ;;;; cl-scopes/util/async - utilities for asynchronous (concurrent / parallel) operations
(defpackage :scopes/util/async (defpackage :scopes/util/async
(:use :common-lisp) (:use :common-lisp)
@ -6,7 +6,7 @@
(:lp :lparallel) (:lp :lparallel)
(:lpq :lparallel.queue)) (:lpq :lparallel.queue))
(:export #:startup #:shutdown (:export #:startup #:shutdown
#:task #:start #:restart #:stop #:kill #:status #:task #:make-task #:start #:restart #:stop #:kill #:status #:logdata
#:mailbox #:send #:receive)) #:mailbox #:send #:receive))
(in-package :scopes/util/async) (in-package :scopes/util/async)
@ -18,12 +18,25 @@
(setf lp:*kernel* (lp:make-kernel 2))) (setf lp:*kernel* (lp:make-kernel 2)))
(defclass task () (defclass task ()
((job :reader job :initarg :job) ((job :accessor job :initform nil)
(taskid :reader taskid :initform (gensym "TSK")) (taskid :reader taskid :initform (gensym "TSK"))
(channel :reader channel :initform (lp:make-channel)) (channel :reader channel :initform (lp:make-channel))
(mailbox :reader mailbox :initarg :mailbox :initform nil) (mailbox :reader mailbox :initarg :mailbox)
(status :accessor status :initform :new) (status :accessor status :initform :new)
(logdata :accessor logdata :initform nil))) (logdata :accessor logdata :initform nil)))
(defun task () (defun make-task ()
(make-instance 'task)) (make-instance 'task))
(defun standard-job (tsk &key (startup #'noop) (teardown #'noop) handle-message)
(let ((mb (mailbox tsk)))
(startup tsk)
(if mb
(loop
(let ((msg (lpq:pop-queue mb)))
(if (eq msg +quit-message+)
(return-from nil)
(handle-message tsk msg)))))
(teardown tsk)))
(defun noop (&rest params))