diff --git a/core/actor.lisp b/core/actor.lisp index 50bad32..99276de 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -35,10 +35,6 @@ ;;;; actor loop (listener) -(eval-when (:compile-toplevel :load-toplevel :execute) - (when (not (boundp '+quit-message+)) - (defconstant +quit-message+ (gensym "QUIT")))) - (defun start (tsk bhv &key foreground) (setf (async:behavior tsk) bhv) (if foreground @@ -46,28 +42,24 @@ (async:submit-task tsk #'ac-loop tsk bhv))) (defun stop (mb) - (send mb +quit-message+)) + (send mb async:+quit-message+)) (defvar *self* nil) (defgeneric ac-loop (tsk bhv) (:method ((tsk async:task) bhv) (let ((msg (async:rcv tsk))) - (unless (eq (ac-step tsk bhv msg) +quit-message+) + (unless (eq (content msg) async:+quit-message+) + (ac-step tsk bhv msg) (ac-loop tsk (async:behavior tsk)))))) (defun ac-step (tsk bhv msg) - (when (eq (content msg) +quit-message+) - (return-from ac-step +quit-message+)) (let ((*self* tsk)) (handler-case (funcall bhv msg) - (condition (err) - (util:lg :error "behavior" msg err) - +quit-message+) (error (err) - (invoke-debugger err) - ;(util:lg :error "behavior" msg err) - )))) + (util:lg :error "behavior" msg err)) + ;(invoke-debugger err)) + ))) ;;;; the core (classical, i.e. Hewitt) actor API diff --git a/util/async.lisp b/util/async.lisp index c163744..fe161e9 100644 --- a/util/async.lisp +++ b/util/async.lisp @@ -3,13 +3,16 @@ (defpackage :scopes/util/async (:use :common-lisp) (:local-nicknames (:lp :lparallel) - (:lpq :lparallel.queue)) - (:export #:init #:finish #:make-mb #:make-task #:rcv #:try-rcv #:snd + (:lpq :lparallel.queue) + (:util :scopes/util)) + (:export #:+quit-message+ #:init #:finish #:make-mb #:make-task #:rcv #:try-rcv #:snd #:mailbox #:task #:restartable-task #:behavior #:get-status #:set-status #:submit-task #:receive-result #:try-receive-result)) (in-package :scopes/util/async) +(defconstant +quit-message+ :quit) + ;;;; general definitions (lparallel wrappers) (defun init () @@ -31,7 +34,11 @@ (make-instance 'mailbox)) (defun rcv (mb) - (lpq:pop-queue (queue mb))) + (handler-case + (lpq:pop-queue (queue mb)) + (condition (cnd) + (util:lg :info "condition on pop-queue" cnd) + +quit-message+))) (defun try-rcv (mb) (lpq:try-pop-queue (queue mb)))