X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcas.lisp;h=72e5800803fa983974c9235723a66427c8e0752d;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=9fcb00674bf32de395b79cb3127ed427335737b9;hpb=b71b8da241791687e7752f917ca032d937ba2bbf;p=sbcl.git

diff --git a/src/code/cas.lisp b/src/code/cas.lisp
index 9fcb006..72e5800 100644
--- a/src/code/cas.lisp
+++ b/src/code/cas.lisp
@@ -8,7 +8,9 @@
 ;;;; DEFCAS, and #'(CAS ...) functions -- making things mostly isomorphic with
 ;;;; SETF.
 
-(defglobal **cas-expanders** (make-hash-table :test #'eq :synchronized t))
+(defglobal **cas-expanders** (make-hash-table :test #'eq
+                                              #-sb-xc-host #-sb-xc-host
+                                              :synchronized t))
 
 (define-function-name-syntax cas (list)
   (destructuring-bind (cas symbol) list
@@ -42,12 +44,21 @@ EXPERIMENTAL: Interface subject to change."
 
 (defun get-cas-expansion (place &optional environment)
   #!+sb-doc
-  "Analogous to GET-SETF-EXPANSION. Return six values needed by the CAS
-machinary: a list of temporary variables, a list of values to which they must
-be bound, a temporary variable for the old value of PLACE, a temporary value
-for the new value of PLACE, a form using the aforementioned temporaries
-which performs the compare-and-swap operation, and a form using the aforementioned
-temporaries with which to perform a volatile read of the place.
+  "Analogous to GET-SETF-EXPANSION. Returns the following six values:
+
+ * list of temporary variables
+
+ * list of value-forms whose results those variable must be bound
+
+ * temporary variable for the old value of PLACE
+
+ * temporary variable for the new value of PLACE
+
+ * form using the aforementioned temporaries which performs the
+   compare-and-swap operation on PLACE
+
+ * form using the aforementioned temporaries with which to perform a volatile
+   read of PLACE
 
 Example:
 
@@ -69,9 +80,9 @@ Example:
           ,new))))
 
 EXPERIMENTAL: Interface subject to change."
-  (flet ((invalid-place ()
-           (error "Invalid place to CAS: ~S" place)))
     (let ((expanded (sb!xc:macroexpand place environment)))
+      (flet ((invalid-place ()
+           (error "Invalid place to CAS: ~S -> ~S" place expanded)))
       (unless (consp expanded)
         ;; FIXME: Allow (CAS *FOO* <OLD> <NEW>), maybe?
         (invalid-place))
@@ -82,7 +93,7 @@ EXPERIMENTAL: Interface subject to change."
           (cond
             ;; CAS expander.
             (info
-             (funcall info place environment))
+             (funcall info expanded environment))
 
             ;; Structure accessor
             ((setf info (info :function :structure-accessor name))
@@ -196,7 +207,8 @@ EXPERIMENTAL: Interface subject to change."
 Two values are considered to match if they are EQ. Returns the previous value
 of PLACE: if the returned value is EQ to OLD, the swap was carried out.
 
-PLACE must be an accessor form whose CAR is one of the following:
+PLACE must be an CAS-able place. Built-in CAS-able places are accessor forms
+whose CAR is one of the following:
 
  CAR, CDR, FIRST, REST, SVREF, SYMBOL-PLIST, SYMBOL-VALUE, SVREF, SLOT-VALUE
  SB-MOP:STANDARD-INSTANCE-ACCESS, SB-MOP:FUNCALLABLE-STANDARD-INSTANCE-ACCESS,
@@ -207,13 +219,15 @@ other then FIXNUM or T.
 
 In case of SLOT-VALUE, if the slot is unbound, SLOT-UNBOUND is called unless
 OLD is EQ to SB-PCL:+SLOT-UNBOUND+ in which case SB-PCL:+SLOT-UNBOUND+ is
-returned and NEW is assigned to the slot.
-
-Additionally, the results are unspecified if there is an applicable method on
-either SB-MOP:SLOT-VALUE-USING-CLASS, (SETF SB-MOP:SLOT-VALUE-USING-CLASS), or
+returned and NEW is assigned to the slot. Additionally, the results are
+unspecified if there is an applicable method on either
+SB-MOP:SLOT-VALUE-USING-CLASS, (SETF SB-MOP:SLOT-VALUE-USING-CLASS), or
 SB-MOP:SLOT-BOUNDP-USING-CLASS.
 
-EXPERIMENTAL: Interface subject to change."
+Additionally, the PLACE can be a anything for which a CAS-expansion has been
+specified using DEFCAS, DEFINE-CAS-EXPANDER, or for which a CAS-function has
+been defined. (See SB-EXT:CAS for more information.)
+"
   `(cas ,place ,old ,new))
 
 ;;; Out-of-line definitions for various primitive cas functions.