util/async basically working

test/test-core.lisp

@@ -89,7 +89,8 @@
     (== (async:status tsk) :new)
     (async:start tsk) 
     (== (async:status tsk) :running)
-    (sleep 0.1)
+    (async:stop tsk)
+    ;(sleep 0.1)
     (== (async:status tsk) :finished)
     ))
 

util/async.lisp

@@ -23,13 +23,16 @@
 
 (defun standard-job (tsk &key (startup #'noop) (teardown #'noop) handle-message)
   (let ((mb (mailbox tsk)))
+    (unwind-protect
+      (progn
         (funcall startup tsk)
-    (if mb
+        (when mb
           (loop for msg = (lpq:pop-queue mb)
                 until (eq msg +quit-message+)
                 do (funcall handle-message tsk msg)))
-    (funcall teardown tsk)
-    (setf (status tsk) :finished)))
+        (funcall teardown tsk))
+      (setf (status tsk) :finished)
+      "done")))
 
 ;;;; task class and related functions / methods
 
@@ -51,5 +54,19 @@
     tsk))
 
 (defun start (tsk)
-  (lp:submit-task (channel tsk) (job tsk))
-  (setf (status tsk) :running))
+  (when (eq (status tsk) :running)
+    (util:lgw "task already running" (taskid tsk))
+    (return-from start))
+  (setf (status tsk) :running)
+  (lp:submit-task (channel tsk) (job tsk)))
+
+(defun stop (tsk &key (wait t))
+  (when (mailbox tsk)
+    (send tsk +quit-message+))
+  (when wait
+    (lp:receive-result (channel tsk))))
+
+(defun send (tsk msg)
+  (if (mailbox tsk)
+    (lpq:push-queue msg (mailbox tsk))
+    (util:lgw "task has no mailbox" (taskid tsk))))