Fix mailbox-empty-p for sbcl, add simple.lisp example

mpcompat/mp-compat-sbcl.lisp

@@ -188,7 +188,10 @@ A null timeout means wait forever."
 (defun mailbox-empty? (mbox)
   "Check if the Lisp mailbox is empty. Return generalized T/F."
   (sb-concurrency:mailbox-empty-p mbox))
-
+
+(defun mailbox-empty-p (mbox)
+  (mailbox-empty? mbox))
+
 
 ;; --------------------------------------------------------------------------
 

useful-macros/com.ral.useful-macros.asd

@@ -116,7 +116,7 @@ THE SOFTWARE.
                 #+:LISPWORKS (:file "safe-streams")
                 #+:LISPWORKS (:file "safe-read-patch")
                 (:file "safe-read-from-string")
-		#+:LISPWORKS (:file "objc")
+		#+(AND :LISPWORKS :MACOSX) (:file "objc")
 
                 #+:LISPWORKS (:file "my-complete-symbol") ;; fix problem in LW for hierarchical package support
 

useful-macros/packages.lisp

@@ -739,8 +739,8 @@ THE SOFTWARE.
    #:merge-plist
    #:string-interp
 
-   #:st-to-objc
-   #:objc-invoke-st
+   #+(AND :LISPWORKS :MACOSX) #:st-to-objc
+   #+(AND :LISPWORKS :MACOSX) #:objc-invoke-st
 
    #:with-unique-names
    #:rebinding

xTActors/Examples/simple.lisp

@@ -0,0 +1,26 @@
+;; Very simple example on how to use actors
+
+(defpackage #:simple
+  (:use :common-lisp)
+  (:export
+   #:echo
+   #:receiver
+   #:run
+   ))
+
+(in-package #:simple)
+
+
+(defparameter receiver
+  (actors:create
+   (lambda (msg)
+     (print (format nil "~a: ~a~%" :receiver msg)))))
+
+(defparameter echo
+  (actors:create
+   (lambda (msg)
+     (print (format nil "~a: ~a~%" :echo msg))
+     (actors:send receiver msg))))
+
+(defun run ()
+  (actors:send echo :hello))

xTActors/Examples/stresstest.lisp

@@ -0,0 +1,34 @@
+;; Computationally heavy usage of actors. All CPUs are used.
+
+(defpackage #:stresstest
+  (:use :common-lisp)
+  (:export
+   #:echo
+   #:receiver
+   #:run
+   ))
+
+(in-package #:stresstest)
+
+(defparameter *large-number* 1000000000)
+
+(defparameter receiver
+  (actors:create
+   (lambda (idx msg)
+     (format t "idx: ~a, msg: ~a~%" idx msg))))
+
+(defun create-worker ()
+  (actors:create
+   (lambda (idx cnt)
+     (let ((answer (loop for i from 1 to cnt count (oddp i))))
+       (actors:send receiver idx answer)))))
+
+(defparameter main
+  (actors:create
+   (lambda (idx cnt)
+     (let ((worker (create-worker)))
+       (actors:send worker idx cnt)))))
+
+(defun run ()
+  (dotimes (n 20)
+    (actors:send main n *large-number*)))

xTActors/actors-base/macros.lisp

@@ -232,3 +232,11 @@
   (editor:setup-indent "α" 1)
   (editor:indent-like "β" 'destructuring-bind))
 
+;; --------------------------------------------------
+
+(defmacro yield (&body body)
+  ;; exit Actor to allow concurrent actions, then resume
+  ;; forces our continuation to the back of the event queue.
+  `(β _
+       (send β)
+     ,@body))

xTActors/actors-base/packages.lisp

@@ -264,6 +264,7 @@ THE SOFTWARE.
    #:splay
    #:watchdog-timer
    #:safe-serializer
+   #:yield
    ))
 
 #+(OR :ALLEGRO :CCL)

xTActors/actors-extra/transactional-db.lisp

@@ -93,13 +93,6 @@
 
 (defpackage com.ral.actors.kv-database
   (:use #:cl :com.ral.actors)
-  (:local-nicknames
-   (#:um        #:com.ral.useful-macros)
-   (#:uuid      #:com.ral.uuid)
-   (#:loenc     #:com.ral.lisp-object-encoder)
-   (#:self-sync #:com.ral.self-sync)
-   (#:sets      #:com.ral.rb-trees.sets)
-   (#:maps      #:com.ral.rb-trees.maps))
   (:export
    #:kvdb
   ))
@@ -116,7 +109,7 @@
 
   ;; -------------------
   ;; commit after update
-  ((cust :commit old-db new-db retry)
+  (( (cust . retry) :commit old-db new-db)
    (cond ((eql old-db db) ;; make sure we have correct version
           (cond ((eql new-db db)
                  ;; no real change
@@ -303,7 +296,7 @@
 (defun add-rec (cust key val)
   (loenc:encode (list key val)) ;; this will barf if either key or val is non-externalizable
   (with-db db
-    (send dbmgr cust :commit db (maps:add db key val) self)
+    (send dbmgr `(,cust . ,self) :commit db (maps:add db key val))
     ))
 
 (defun remove-rec (cust key)
@@ -312,7 +305,7 @@
            (new-db (if (eql val self)
                        db
                      (maps:remove db key))))
-      (send dbmgr cust :commit db new-db self)
+      (send dbmgr `(,cust . ,self) :commit db new-db)
       )))
 
 (defun lookup (cust key &optional default)
@@ -345,7 +338,7 @@
     ((cust :req)
      (repeat-send dbmgr))
 
-    ((cust :commit old-db new-db retry)
+    (( (cust . retry) :commit old-db new-db)
      (repeat-send dbmgr))
     )))