42 lines
1.3 KiB
Common Lisp
42 lines
1.3 KiB
Common Lisp
;;;; cl-scopes/util/async - utilities for asynchronous (concurrent / parallel) operations
|
|
|
|
(defpackage :scopes/util/async
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:util :scopes/util)
|
|
(:lp :lparallel)
|
|
(:lpq :lparallel.queue))
|
|
(:export #:startup #:shutdown
|
|
#:task #:make-task #:start #:restart #:stop #:kill #:status #:logdata
|
|
#:mailbox #:send #:receive))
|
|
|
|
(in-package :scopes/util/async)
|
|
|
|
(when (not (boundp '+quit-message+))
|
|
(defconstant +quit-message+ (gensym "QUIT")))
|
|
|
|
(when (null lp:*kernel*)
|
|
(setf lp:*kernel* (lp:make-kernel 2)))
|
|
|
|
(defclass task ()
|
|
((job :accessor job :initform nil)
|
|
(taskid :reader taskid :initform (gensym "TSK"))
|
|
(channel :reader channel :initform (lp:make-channel))
|
|
(mailbox :reader mailbox :initarg :mailbox)
|
|
(status :accessor status :initform :new)
|
|
(logdata :accessor logdata :initform nil)))
|
|
|
|
(defun make-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))
|