Commit 13a42249 authored by Daniel Kochmański's avatar Daniel Kochmański

cas: add remcas operation for an expansion removal

It is a (fmakunbound (setf foo)) counterpart.
parent 9096514c
......@@ -1637,6 +1637,7 @@ cl_symbols[] = {
{MP_ "ATOMIC-INCF-INSTANCE", MP_ORDINARY, IF_MP(mp_atomic_incf_instance), 3, OBJNULL},
{MP_ "DEFINE-CAS-EXPANDER", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "DEFCAS", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "REMCAS", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "GET-CAS-EXPANSION", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "COMPARE-AND-SWAP", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-UPDATE", MP_CONSTANT, NULL, -1, OBJNULL},
......
......@@ -1637,6 +1637,7 @@ cl_symbols[] = {
{MP_ "ATOMIC-INCF-INSTANCE",IF_MP("mp_atomic_incf_instance")},
{MP_ "DEFINE-CAS-EXPANDER",NULL},
{MP_ "DEFCAS",NULL},
{MP_ "REMCAS",NULL},
{MP_ "GET-CAS-EXPANSION",NULL},
{MP_ "COMPARE-AND-SWAP",NULL},
{MP_ "ATOMIC-UPDATE",NULL},
......
......@@ -778,6 +778,7 @@
#+threads (proclamation mp:atomic-incf-car (cons fixnum) fixnum)
#+threads (proclamation mp:compare-and-swap-cdr (cons t t) t)
#+threads (proclamation mp:atomic-incf-cdr (cons fixnum) fixnum)
#+threads (proclamation mp:remcas (symbol) boolean)
;;;
;;; 15. ARRAYS
......
......@@ -227,6 +227,13 @@ Note that it is up to the user of this macro to ensure atomicity for
the resulting compare-and-swap expansions.
@end defmac
@lspindex mp:remcas
@defun mp:remcas symbol
Remove a compare-and-swap expansion. It is an equivalent of
@code{fmakeunbound (setf symbol)} for cas expansions.
@end defun
@lspindex mp:get-cas-expansion
@defun mp:get-cas-expansion place &optional environment
......
......@@ -223,6 +223,12 @@ the resulting COMPARE-AND-SWAP expansions."
`(,',cas-fun ,@args ,old ,new)
`(,',accessor ,@args)))))
#+threads
(defun remcas (symbol)
"Remove a COMPARE-AND-SWAP expansion. It is a CAS operation equivalent of
(FMAKUNBOUND (SETF SYMBOL))"
(si:rem-sysprop symbol 'cas-expander))
#+threads
(defun get-cas-expansion (place &optional environment &aux f)
"Returns the COMPARE-AND-SWAP expansion forms and variables as defined
......
......@@ -704,3 +704,22 @@ creating stray processes."
(is (svref vector 1) 0)
(is *x* 0)
(is (slot-value object 'slot1) 0)))))
;;; Date: 2019-02-05
;;; From: Daniel Kochmański
;;; Description:
;;;
;;; Verifies that CAS expansion may be removed.
;;;
(ext:with-clean-symbols (*obj* foo)
(test defcas/remcas
(mp:defcas foo (lambda (object old new)
(assert (consp object))
(setf (car object) old
(cdr object) new)))
(defparameter *obj* (cons nil nil))
(eval `(mp:compare-and-swap (foo *obj*) :car :cdr))
(is (eql (car *obj*) :car))
(is (eql (cdr *obj*) :cdr))
(mp:remcas 'foo)
(signals error (eval `(mp:compare-and-swap (foo *obj*) :car :cdr)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment