[Openmcl-cvs-notifications] r10730 - /trunk/source/lib/macros.lisp

[gz at clozure.com]

Author: gz
Date: Sun Sep 14 13:57:44 2008
New Revision: 10730

Log:
Make atomic-incf-decf handle let/let*/locally, needed so it can handle %svr=
ef (and hence def-accessors)

Modified:
    trunk/source/lib/macros.lisp

Modified: trunk/source/lib/macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/macros.lisp (original)
+++ trunk/source/lib/macros.lisp Sun Sep 14 13:57:44 2008
@@ -3162,9 +3162,19 @@
               sym (car place)))
       (ecase sym
 	(the `(the ,(cadr place) (atomic-incf-decf ,(caddr place) ,delta)))
+         ;; Needed so can handle %svref (which macroexpands into a LET*)
+         ((let let*) (multiple-value-bind (body decls) (parse-body (cddr p=
lace) env t)
+                       (unless (eql (length body) 1)
+                         (error "~S is not a valid atomic-incf/decf place"=
 place))
+                       `(,sym ,(cadr place) , at decls (atomic-incf-decf , at bo=
dy ,delta))))
+         ;; Ditto
+         (locally (multiple-value-bind (body decls) (parse-body (cdr place=
) env t)
+                    (unless (eql (length body) 1)
+                      (error "~S is not a valid atomic-incf/decf place" pl=
ace))
+                    `(,sym , at decls (atomic-incf-decf , at body ,delta))))
 	(car `(%atomic-incf-car ,(cadr place) ,delta))
 	(cdr `(%atomic-incf-cdr ,(cadr place) ,delta))
-	((svref %svref) `(%atomic-incf-gvector ,@(cdr place) ,delta))))
+	(svref `(%atomic-incf-gvector ,@(cdr place) ,delta))))
     (if (and (symbolp place) (eq :special (variable-information place env)=
))
       (let* ((base (gensym))
              (offset (gensym)))