From a8d024796d69b3c0d547033c477bc584a89408c3 Mon Sep 17 00:00:00 2001
From: Max Rottenkolber <max@mr.gy>
Date: Tue, 27 Jun 2017 16:59:25 +0200
Subject: [PATCH 1/3] conditional-store: handle type annotated structure slots

---
 lib/macros.lisp | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/lib/macros.lisp b/lib/macros.lisp
index 7e135d35a..c5713a334 100644
--- a/lib/macros.lisp
+++ b/lib/macros.lisp
@@ -3617,6 +3617,9 @@ element-type is numeric."
       (if struct-transform
         (setq place (defstruct-ref-transform struct-transform (cdr place) env)
               sym (car place)))
+      (if (eq (car place) 'the)
+        (setq place (caddr place)
+              sym (car place)))
       (if (member  sym '(svref ccl::%svref ccl::struct-ref))
         (let* ((v (gensym)))
           `(let* ((,v ,(cadr place)))

From b3ddbd2910f6faff0591bdc2ab823803fa61e6d6 Mon Sep 17 00:00:00 2001
From: Max Rottenkolber <max@mr.gy>
Date: Tue, 27 Jun 2017 17:00:13 +0200
Subject: [PATCH 2/3] conditional-store: handle CAR/CDR place forms

---
 lib/macros.lisp | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/lib/macros.lisp b/lib/macros.lisp
index c5713a334..b66fe8acb 100644
--- a/lib/macros.lisp
+++ b/lib/macros.lisp
@@ -3620,12 +3620,18 @@ element-type is numeric."
       (if (eq (car place) 'the)
         (setq place (caddr place)
               sym (car place)))
-      (if (member  sym '(svref ccl::%svref ccl::struct-ref))
-        (let* ((v (gensym)))
-          `(let* ((,v ,(cadr place)))
-            (ccl::store-gvector-conditional ,(caddr place)
-             ,v ,old-value ,new-value)))
-        (signal-program-error "Don't know how to do conditional store to ~s" place)))))
+      (case sym
+        ((svref ccl::%svref ccl::struct-ref)
+         (let* ((v (gensym)))
+           `(let* ((,v ,(cadr place)))
+              (ccl::store-gvector-conditional
+               ,(caddr place) ,v ,old-value ,new-value))))
+        (car
+         `(%rplaca-conditional ,(cadr place) ,old-value ,new-value))
+        (cdr
+         `(%rplacd-conditional ,(cadr place) ,old-value ,new-value))
+        (otherwise
+         (signal-program-error "Don't know how to do conditional store to ~s" place))))))
 
 (defmacro step (form)
   "The form is evaluated with single stepping enabled. Function calls

From 410b3ccea5212a3c1fd8c6ab481d87a23a48f9f8 Mon Sep 17 00:00:00 2001
From: Max Rottenkolber <max@mr.gy>
Date: Tue, 27 Jun 2017 18:07:08 +0200
Subject: [PATCH 3/3] Document and export CCL:CONDITIONAL-STORE

---
 doc/manual/threads.ccldoc | 24 ++++++++++++++++++++++++
 lib/ccl-export-syms.lisp  |  2 ++
 2 files changed, 26 insertions(+)

diff --git a/doc/manual/threads.ccldoc b/doc/manual/threads.ccldoc
index 8d5e14941..de2d65ed3 100644
--- a/doc/manual/threads.ccldoc
+++ b/doc/manual/threads.ccldoc
@@ -1515,6 +1515,30 @@ A process cannot meaningfully attempt to enable itself.")
         (ref (definition :function make-lock)) ", " (ref (definition :function make-read-write-lock)) ", "
         (ref (definition :function make-semaphore)) ", " (ref (definition :function process-input-wait)) ", "
         (ref (definition :function process-output-wait)))))
+    (definition (:macro conditional-store) "conditional-store place old-value new-value"
+     "Attempts to atomically replace {param old-value} in {param place} with {param new-value}."
+     (defsection "Arguments and Values"
+       (listing :definition
+         (item "{param place}" ccldoc::=> "a {emphasis place}.")
+         (item "{param old-value}" ccldoc::=> "an {emphasis object}.")
+         (item "{param new-value}" ccldoc::=> "an {emphasis object}.")
+         (item "{param result}" ccldoc::=> "a {emphasis boolean} indicating whether the operation succeeded.")))
+     (defsection "Description"
+       (para "Attempts to atomically replace {param old-value} in {param place} with {param new-value},
+              and returns as its {param result} a {emphasis boolean} that indicates
+              whether the operation was successful.")
+       (para "If {param result} is {emphasis true},
+              the value of {param place} was replaced with the {param new-value}.
+              If {param result} is {emphasis false},
+              the value of {param place} was not {code eq} to {param old-value} and left unchanged.")
+       (para "{param Place} can be one of:")
+       (listing :bullet
+         (item "a {emphasis special variable},")
+         (item "a {emphasis car} or a {emphasis cdr} (i.e. {code (car …)} or {code (cdr …)}),")
+         (item "a {emphasis structure slot} referenced by its accessor (i.e. not via {code with-slots}).")))
+     (defsection "Notes"
+       (para "This operations is known as Compare and Swap (CAS),
+              and can be used to implement lock-free synchronization in multithreaded programs.")))
     (definition (:toplevel-command ":Y") "( :y p)" "Yields control of terminal input to a specified
 	      lisp process (thread)."
      (defsection "Arguments and Values"
diff --git a/lib/ccl-export-syms.lisp b/lib/ccl-export-syms.lisp
index a4bc55226..12b70a5aa 100644
--- a/lib/ccl-export-syms.lisp
+++ b/lib/ccl-export-syms.lisp
@@ -575,6 +575,8 @@
      process-input-wait
      process-output-wait
      wait-for-signal
+
+     conditional-store
                                         ; termination
      terminate-when-unreachable
      terminate