- ;; ATOMIC-INCF is restricted to signed-word, but delta can be bigger: first
- ;; count the number of full overflows...
- (loop while (>= delta +most-positive-word+)
- do (sb-thread::with-spinlock ((counter-overflow-lock counter))
- (incf (counter-overflow counter) 1))
- (decf delta +most-positive-word+))
- (flet ((%incf (d)
- (let ((prev (atomic-incf (counter-count counter) d)))
- (when (< (logand +most-positive-word+ (+ prev d)) prev)
- (sb-thread::with-spinlock ((counter-overflow-lock counter))
- (incf (counter-overflow counter)))))))
- (if (typep delta '(signed-byte 32))
+ (labels ((%incf-overflow (&optional (n 1))
+ ;; Overflow-counter can run into bignums... so we need to loop
+ ;; around CAS till the increment succeeds.
+ (loop for old = (counter-overflow counter)
+ until (eq old (compare-and-swap (counter-overflow counter)
+ old (+ old n)))))
+ (%incf (d)
+ ;; Increment the word-sized counter. If it overflows, record the
+ ;; overflow.
+ (let ((prev (atomic-incf (counter-word counter) d)))
+ (when (< (logand most-positive-word (+ prev d)) prev)
+ (%incf-overflow)))))
+ ;; DELTA can potentially be a bignum -- cut it down to word-size.
+ (unless (typep delta 'sb-vm:word)
+ (multiple-value-bind (n r) (truncate delta (1+ most-positive-word))
+ (%incf-overflow n)
+ (setf delta r)))
+ ;; ATOMIC-INCF can at most handle SIGNED-WORD: if DELTA doesn't fit that,
+ ;; DELTA/2 will.
+ (if (typep delta 'sb-vm:signed-word)