common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Speed up gmp-intexp

Browse source 
Faster dispatch to orig-intexp.
Faster (expt ratio -power)
This commit is contained in:
Stas Boukarev 2026-09-01 02:59:03 +03:00
parent c998d48297
commit 774ad4de28
1 changed files with 14 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
contrib/sb-gmp/gmp.lisp
View file

@ -62,6 +62,7 @@
(setf (sb-int:system-package-p *package*) t)) (setf (sb-int:system-package-p *package*) t))
(defvar *gmp-disabled* nil) (defvar *gmp-disabled* nil)
(declaim (sb-ext:always-bound *gmp-disabled*))
(defconstant +bignum-raw-area-offset+ (defconstant +bignum-raw-area-offset+
(- (* sb-vm:bignum-digits-offset sb-vm:n-word-bytes) (- (* sb-vm:bignum-digits-offset sb-vm:n-word-bytes)
@ -960,24 +961,26 @@ pre-allocated bignum. The allocated bignum-length must be (1+ COUNT)."
(declare (inline mpz-mul-2exp mpz-pow) (declare (inline mpz-mul-2exp mpz-pow)
(optimize (sb-c:verify-arg-count 0))) (optimize (sb-c:verify-arg-count 0)))
(cond (cond
((or (and (integerp base) ((or (not (typep power '(integer #.(1+ most-negative-fixnum) #.most-positive-fixnum)))
(< (abs power) 1000) (if (integerp base)
(< (blength base) 4)) (and
(< (blength base) 4)
(typep power '(signed-byte 10)))
;; EXPT dispatches to INTEXP for a (COMPLEX RATIONAL) base as well, ;; EXPT dispatches to INTEXP for a (COMPLEX RATIONAL) base as well,
;; and MPZ-POW below only takes an integer. ;; and MPZ-POW below only takes an integer.
(not (rationalp base)) (not (typep base 'ratio)))
(member base '(0 1 -1))
*gmp-disabled*) *gmp-disabled*)
(orig-intexp base power)) (orig-intexp base power))
(t (t
(check-type power (integer #.(1+ most-negative-fixnum) #.most-positive-fixnum))
(cond ((minusp power) (cond ((minusp power)
(/ (gmp-intexp base (- power)))) (let ((abs-power (- power)))
(sb-kernel:build-ratio (sb-ext:truly-the integer (gmp-intexp (denominator base) abs-power))
(sb-ext:truly-the integer (gmp-intexp (numerator base) abs-power)))))
((eql base 2) ((eql base 2)
(mpz-mul-2exp 1 power)) (mpz-mul-2exp 1 power))
((typep base 'ratio) ((typep base 'ratio)
(sb-kernel::%make-ratio (gmp-intexp (numerator base) power) (sb-kernel::%make-ratio (sb-ext:truly-the integer (gmp-intexp (numerator base) power))
(gmp-intexp (denominator base) power))) (sb-ext:truly-the integer (gmp-intexp (denominator base) power))))
(t (t
(mpz-pow base power)))))) (mpz-pow base power))))))