June 2018 Update

Task/Atomic-updates/Common-Lisp/atomic-updates-1.lisp

@@ -0,0 +1,37 @@
+(ql:quickload '(:alexandria :stmx :bordeaux-threads))
+
+(defpackage :atomic-updates
+  (:use :cl))
+
+(in-package :atomic-updates)
+
+(defvar *buckets* nil)
+(defvar *running* nil)
+
+(defun distribute (ratio a b)
+  "Atomically redistribute the values of buckets A and B by RATIO."
+  (stmx:atomic
+   (let* ((sum (+ (stmx:$ a) (stmx:$ b)))
+          (a2 (truncate (* ratio sum))))
+     (setf (stmx:$ a) a2)
+     (setf (stmx:$ b) (- sum a2)))))
+
+(defun runner (ratio-func)
+  "Continously distribute to two different elements in *BUCKETS* with the
+value returned from RATIO-FUNC."
+  (loop while *running*
+     do (let ((a (alexandria:random-elt *buckets*))
+              (b (alexandria:random-elt *buckets*)))
+          (unless (eq a b)
+            (distribute (funcall ratio-func) a b)))))
+
+(defun print-buckets ()
+  "Atomically get the bucket values and print out their metrics."
+  (let ((buckets (stmx:atomic (map 'vector 'stmx:$ *buckets*))))
+    (format t "Buckets: ~a~%Sum: ~a~%" buckets (reduce '+ buckets))))
+
+(defun scenario ()
+  (setf *buckets* (coerce (loop repeat 20 collect (stmx:tvar 10)) 'vector))
+  (setf *running* t)
+  (bt:make-thread (lambda () (runner (constantly 0.5))))
+  (bt:make-thread (lambda () (runner (lambda () (random 1.0))))))

Task/Atomic-updates/Common-Lisp/atomic-updates-2.lisp

@@ -0,0 +1,10 @@
+ATOMIC-UPDATES> (scenario)
+#<SB-THREAD:THREAD "Anonymous thread" RUNNING {10058441D3}>
+ATOMIC-UPDATES> (loop repeat 3 do (print-buckets) (sleep 1))
+Buckets: #(8 4 12 17 12 10 5 10 9 10 4 11 4 15 16 20 11 8 4 10)
+Sum: 200
+Buckets: #(2 12 24 7 8 3 13 6 8 31 0 9 7 11 12 8 8 12 15 4)
+Sum: 200
+Buckets: #(1 2 3 3 2 8 33 23 0 8 4 11 24 2 3 5 32 8 2 26)
+Sum: 200
+NIL