((1+ most-positive-fixnum) (1+ most-positive-fixnum) nil)
((1+ most-positive-fixnum) (1- most-negative-fixnum) t)
(1 (ash most-negative-fixnum 1) nil)
- (#.(- sb-vm:n-word-bits sb-vm:n-lowtag-bits) most-negative-fixnum t)
- (#.(1+ (- sb-vm:n-word-bits sb-vm:n-lowtag-bits)) (ash most-negative-fixnum 1) t)
- (#.(+ 2 (- sb-vm:n-word-bits sb-vm:n-lowtag-bits)) (ash most-negative-fixnum 1) t)
- (#.(+ sb-vm:n-word-bits 32) (ash most-negative-fixnum #.(+ 32 sb-vm:n-lowtag-bits 1)) nil)
- (#.(+ sb-vm:n-word-bits 33) (ash most-negative-fixnum #.(+ 32 sb-vm:n-lowtag-bits 1)) t)))
+ (#.(- sb-vm:n-word-bits sb-vm:n-fixnum-tag-bits 1) most-negative-fixnum t)
+ (#.(1+ (- sb-vm:n-word-bits sb-vm:n-fixnum-tag-bits 1)) (ash most-negative-fixnum 1) t)
+ (#.(+ 2 (- sb-vm:n-word-bits sb-vm:n-fixnum-tag-bits 1)) (ash most-negative-fixnum 1) t)
+ (#.(+ sb-vm:n-word-bits 32) (ash most-negative-fixnum #.(+ 32 sb-vm:n-fixnum-tag-bits 2)) nil)
+ (#.(+ sb-vm:n-word-bits 33) (ash most-negative-fixnum #.(+ 32 sb-vm:n-fixnum-tag-bits 2)) t)))
(destructuring-bind (index int result) x
(assert (eq (eval `(logbitp ,index ,int)) result))))
(apply fast call-args)
(division-by-zero () :div0)))
(slow-result (handler-case
- (apply fast call-args)
+ (apply slow call-args)
(division-by-zero () :div0))))
(if (eql fast-result slow-result)
(print (list :ok `(,op ,@args) :=> fast-result))
(error "oops: ~S, ~S" args call-args)))))))))))
+
+;;; (TRUNCATE <unsigned-word> <constant unsigned-word>) is optimized
+;;; to use multiplication instead of division. This propagates to FLOOR,
+;;; MOD and REM. Test that the transform is indeed triggered and test
+;;; several cases for correct results.
+(with-test (:name (:integer-division-using-multiplication :used)
+ :skipped-on '(not (or :x86-64 :x86)))
+ (dolist (fun '(truncate floor ceiling mod rem))
+ (let* ((foo (compile nil `(lambda (x)
+ (declare (optimize (speed 3)
+ (space 1)
+ (compilation-speed 0))
+ (type (unsigned-byte
+ ,sb-vm:n-word-bits) x))
+ (,fun x 9))))
+ (disassembly (with-output-to-string (s)
+ (disassemble foo :stream s))))
+ ;; KLUDGE copied from test :float-division-using-exact-reciprocal
+ ;; in compiler.pure.lisp.
+ (assert (and (not (search "DIV" disassembly))
+ (search "MUL" disassembly))))))
+
+(with-test (:name (:integer-division-using-multiplication :correctness))
+ (let ((*random-state* (make-random-state t)))
+ (dolist (dividend-type `((unsigned-byte ,sb-vm:n-word-bits)
+ (and fixnum unsigned-byte)
+ (integer 10000 10100)))
+ (dolist (divisor `(;; Some special cases from the paper
+ 7 10 14 641 274177
+ ;; Range extremes
+ 3
+ ,most-positive-fixnum
+ ,(1- (expt 2 sb-vm:n-word-bits))
+ ;; Some random values
+ ,@(loop for i from 8 to sb-vm:n-word-bits
+ for r = (random (expt 2 i))
+ ;; We don't want 0, 1 and powers of 2.
+ when (not (zerop (logand r (1- r))))
+ collect r)))
+ (dolist (fun '(truncate ceiling floor mod rem))
+ (let ((foo (compile nil `(lambda (x)
+ (declare (optimize (speed 3)
+ (space 1)
+ (compilation-speed 0))
+ (type ,dividend-type x))
+ (,fun x ,divisor)))))
+ (dolist (dividend `(0 1 ,most-positive-fixnum
+ ,(1- divisor) ,divisor
+ ,(1- (* divisor 2)) ,(* divisor 2)
+ ,@(loop repeat 4
+ collect (+ 10000 (random 101)))
+ ,@(loop for i from 4 to sb-vm:n-word-bits
+ for pow = (expt 2 (1- i))
+ for r = (+ pow (random pow))
+ collect r)))
+ (when (typep dividend dividend-type)
+ (multiple-value-bind (q1 r1)
+ (funcall foo dividend)
+ (multiple-value-bind (q2 r2)
+ (funcall fun dividend divisor)
+ (unless (and (= q1 q2)
+ (eql r1 r2))
+ (error "bad results for ~s with dividend type ~s"
+ (list fun dividend divisor)
+ dividend-type))))))))))))
+
+;; The fast path for logbitp underestimated sb!vm:n-positive-fixnum-bits
+;; for > 61 bit fixnums.
+(with-test (:name :logbitp-wide-fixnum)
+ (assert (not (logbitp (1- (integer-length most-positive-fixnum))
+ most-negative-fixnum))))