- (destructuring-bind (op &rest args) place
- (when (cdr args)
- (invalid-place))
- (let ((dd (info :function :structure-accessor op)))
- (if dd
- (let* ((structure (dd-name dd))
- (slotd (find op (dd-slots dd) :key #'dsd-accessor-name))
- (index (dsd-index slotd))
- (type (dsd-type slotd)))
- (declare (ignorable index))
- (unless (and (eq 'sb!vm:word (dsd-raw-type slotd))
- (type= (specifier-type type) (specifier-type 'sb!vm:word)))
- (error "ATOMIC-INCF requires a slot of type (UNSIGNED-BYTE ~S), not ~S: ~S"
- sb!vm:n-word-bits type place))
- (when (dsd-read-only slotd)
- (error "Cannot use ATOMIC-INCF with structure accessor for a read-only slot: ~S"
- place))
- #!+(or x86 x86-64)
- `(truly-the sb!vm:word
- (%raw-instance-atomic-incf/word (the ,structure ,@args)
- ,index
- (the sb!vm:signed-word ,diff)))
- ;; No threads outside x86 and x86-64 for now, so this is easy...
- #!-(or x86 x86-64)
- (with-unique-names (structure old)
- `(sb!sys:without-interrupts
- (let* ((,structure ,@args)
- (,old (,op ,structure)))
- (setf (,op ,structure) (logand #.(1- (ash 1 sb!vm:n-word-bits))
- (+ ,old (the sb!vm:signed-word ,diff))))
- ,old))))
- (invalid-place)))))))
+ (let ((dd (info :function :structure-accessor op)))
+ (if dd
+ (let* ((structure (dd-name dd))
+ (slotd (find op (dd-slots dd) :key #'dsd-accessor-name))
+ (index (dsd-index slotd))
+ (type (dsd-type slotd)))
+ (declare (ignorable structure index))
+ (unless (and (eq 'sb!vm:word (dsd-raw-type slotd))
+ (type= (specifier-type type) (specifier-type 'sb!vm:word)))
+ (error "ATOMIC-INCF requires a slot of type (UNSIGNED-BYTE ~S), not ~S: ~S"
+ sb!vm:n-word-bits type place))
+ (when (dsd-read-only slotd)
+ (error "Cannot use ATOMIC-INCF with structure accessor for a read-only slot: ~S"
+ place))
+ #!+(or x86 x86-64)
+ `(truly-the sb!vm:word
+ (%raw-instance-atomic-incf/word (the ,structure ,@args)
+ ,index
+ (the sb!vm:signed-word ,diff)))
+ ;; No threads outside x86 and x86-64 for now, so this is easy...
+ #!-(or x86 x86-64)
+ (with-unique-names (structure old)
+ `(sb!sys:without-interrupts
+ (let* ((,structure ,@args)
+ (,old (,op ,structure)))
+ (setf (,op ,structure) (logand #.(1- (ash 1 sb!vm:n-word-bits))
+ (+ ,old (the sb!vm:signed-word ,diff))))
+ ,old))))
+ (invalid-place))))))