Skip to content
Snippets Groups Projects
Commit d5d98cb6 authored by wlott's avatar wlott
Browse files

Added ext: in front of truly-the. Changed plusp to minusp in

multiply-fixnums so that it will not negate 0.
parent d7f2ab92
Branches
Tags
No related merge requests found
...@@ -548,22 +548,22 @@ ...@@ -548,22 +548,22 @@
(defun multiply-fixnums (a b) (defun multiply-fixnums (a b)
(declare (fixnum a b)) (declare (fixnum a b))
(let* ((a-plusp (plusp a)) (let* ((a-minusp (minusp a))
(b-plusp (plusp b))) (b-minusp (minusp b)))
(multiple-value-bind (high low) (multiple-value-bind (high low)
(%multiply (%fixnum-to-digit (if a-plusp a (- a))) (%multiply (%fixnum-to-digit (if a-minusp (- a) a))
(%fixnum-to-digit (if b-plusp b (- b)))) (%fixnum-to-digit (if b-minusp (- b) b)))
(if (and (zerop high) (if (and (zerop high)
(%digit-0-or-plusp low)) (%digit-0-or-plusp low))
(let ((low (truly-the (unsigned-byte 31) (let ((low (ext:truly-the (unsigned-byte 31)
(%fixnum-digit-with-correct-sign low)))) (%fixnum-digit-with-correct-sign low))))
(if (eq a-plusp b-plusp) (if (eq a-minusp b-minusp)
low low
(- low))) (- low)))
(let ((res (%allocate-bignum 2))) (let ((res (%allocate-bignum 2)))
(%bignum-set res 0 low) (%bignum-set res 0 low)
(%bignum-set res 1 high) (%bignum-set res 1 high)
(unless (eq a-plusp b-plusp) (negate-bignum-in-place res)) (unless (eq a-minusp b-minusp) (negate-bignum-in-place res))
(%normalize-bignum res 2)))))) (%normalize-bignum res 2))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment