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

async:listen: handle sigint using handler-bind or handler-case

Browse source
This commit is contained in:
Helmut Merz 2025-03-18 07:53:37 +01:00
parent 7d612bf823
commit 05cb9908dd
1 changed files with 26 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
util/async.lisp
View file

@ -28,20 +28,32 @@
(defun noop (&rest params)) (defun noop (&rest params))
(defun standard-job (tsk &key (startup #'noop) (teardown #'noop) handle-message) (defun standard-job (tsk &key (startup #'noop) (teardown #'noop) handle-message)
(let ((mb (mailbox tsk))) (unwind-protect
(unwind-protect (progn
(progn (funcall startup tsk)
(funcall startup tsk) (when (mailbox tsk)
(when mb (do-listen-hc tsk handle-message))
(handler-case (data tsk))
(loop for msg = (lpq:pop-queue mb) (setf (status tsk) :done)
until (eq msg +quit-message+) (funcall teardown tsk)))
do (funcall handle-message tsk msg))
(sb-sys:interactive-interrupt (condition) (defun do-listen (tsk handle-message)
(util:lgi condition))) (handler-bind
(data tsk))) ((sb-sys:interactive-interrupt
(setf (status tsk) :done) (lambda (condition)
(funcall teardown tsk)))) (util:lgi condition)
(return-from do-listen))))
(loop for msg = (lpq:pop-queue (mailbox tsk))
until (eq msg +quit-message+)
do (funcall handle-message tsk msg))))
(defun do-listen-hc (tsk handle-message)
(handler-case
(loop for msg = (lpq:pop-queue (mailbox tsk))
until (eq msg +quit-message+)
do (funcall handle-message tsk msg))
(sb-sys:interactive-interrupt (condition)
(util:lgi condition))))
;;;; task class and related functions / methods ;;;; task class and related functions / methods