diff --git a/code/bignum.lisp b/code/bignum.lisp index c4c5e924f27030dcdcd8f84547e246ebffdff84c..a35d708b93acd183de87443577b0a8a3090d7f00 100644 --- a/code/bignum.lisp +++ b/code/bignum.lisp @@ -148,7 +148,7 @@ ;;; (defun %digit-0-or-plusp (digit) (declare (type bignum-element-type digit)) - (logbitp (1- digit-size) digit)) + (not (logbitp (1- digit-size) digit))) (proclaim '(inline %bignum-0-or-plusp)) (defun %bignum-0-or-plusp (bignum len) @@ -545,22 +545,26 @@ (negate-bignum-in-place result)) (%normalize-bignum result (1+ bignum-len)))) + (defun multiply-fixnums (a b) (declare (fixnum a b)) - (let ((result (%allocate-bignum 2)) - (a-neg-p (minusp a)) - (b-neg-p (minusp b))) - (declare (type bignum-type result)) + (let* ((a-plusp (plusp a)) + (b-plusp (plusp b))) (multiple-value-bind (high low) - (%multiply (%fixnum-to-digit (if a-neg-p (- a) a)) - (%fixnum-to-digit (if b-neg-p (- b) b))) - (declare (type bignum-element-type high low)) - (setf (%bignum-ref result 0) low) - (setf (%bignum-ref result 1) high)) - (unless (eq a-neg-p b-neg-p) - (negate-bignum-in-place result)) - (%normalize-bignum result 2))) - + (%multiply (%fixnum-to-digit (if a-plusp a (- a))) + (%fixnum-to-digit (if b-plusp b (- b)))) + (if (and (zerop high) + (%digit-0-or-plusp low)) + (let ((low (truly-the (unsigned-byte 31) + (%fixnum-digit-with-correct-sign low)))) + (if (eq a-plusp b-plusp) + low + (- low))) + (let ((res (%allocate-bignum 2))) + (%bignum-set res 0 low) + (%bignum-set res 1 high) + (unless (eq a-plusp b-plusp) (negate-bignum-in-place res)) + (%normalize-bignum res 2)))))) ;;;; GCD.