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

Reduce DISPATCH-RATIO expansion size
Some checks are pending
CL-host / ecl (push) Waiting to run
Details
CL-host / clisp (push) Waiting to run
Details
CL-host / ccl (push) Waiting to run
Details
CL-host / cmucl (push) Waiting to run
Details
CL-host / sbcl (push) Waiting to run
Details
CL-host / compare-xc-host-fasls (ccl, false) (push) Blocked by required conditions
Details
CL-host / compare-xc-host-fasls (clisp, false) (push) Blocked by required conditions
Details
CL-host / compare-xc-host-fasls (cmucl, false) (push) Blocked by required conditions
Details
CL-host / compare-xc-host-fasls (self, false) (push) Blocked by required conditions
Details
Linux arm / build (push) Waiting to run
Details
Linux arm64 / build () (push) Waiting to run
Details
Linux qemu / build (ppc64le) (push) Waiting to run
Details
Linux qemu / build (riscv64) (push) Waiting to run
Details
Linux / build (x86, --with-sb-thread, ) (push) Waiting to run
Details
Linux / build (x86, --without-sb-thread, ) (push) Waiting to run
Details
Linux / build (x86, --without-sb-unicode, ) (push) Waiting to run
Details
Linux / build (x86-64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Details
Linux / build (x86-64, --with-sb-fasteval --without-sb-eval --with-nonstop-foreign-call, fasteval) (push) Waiting to run
Details
Linux / build (x86-64, --with-sb-thread --with-nonstop-foreign-call, sse4) (push) Waiting to run
Details
Linux / build (x86-64, --with-sb-thread, ) (push) Waiting to run
Details
Linux / build (x86-64, --without-sb-thread, ) (push) Waiting to run
Details
Linux / build (x86-64, --without-sb-unicode, ) (push) Waiting to run
Details
Mac / build (arm64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Details
Mac / build (arm64, --with-sb-thread --with-nonstop-foreign-call) (push) Waiting to run
Details
Mac / build (x86-64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Details
Mac / build (x86-64, --with-sb-thread --with-nonstop-foreign-call) (push) Waiting to run
Details
Windows arm64 / build (arm64, clang-aarch64, clangarm64) (push) Waiting to run
Details
Windows / build (x86-64, ucrt-x86_64, ucrt64) (push) Waiting to run
Details

Browse source 
Don't check for fixnum ratio components if the integer it'll be added
to is a bignum.
This commit is contained in:
Stas Boukarev 2026-08-31 01:00:58 +03:00
parent 8b499bda00
commit 565e932d70
1 changed files with 5 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/code/numbers.lisp
View file

@ -454,7 +454,7 @@ The second returned value is the remainder."
(bignum-truncate-single-digit (make-small-bignum number) divisor)
(bignum-truncate (make-small-bignum number) divisor)))
((ratio (foreach (eql 1) fixnum bignum))
(dispatch-ratio (number numerator denominator)
(dispatch-ratio (number numerator denominator (dispatch-type divisor))
(multiple-value-bind (q rem) (truncate numerator
(* denominator divisor))
(values q (%make-ratio rem denominator)))))
@ -527,7 +527,7 @@ The second returned value is the remainder."
(bignum-truncate-single-digit (make-small-bignum number) divisor)
(bignum-truncate (make-small-bignum number) divisor))))
((ratio (foreach (eql 1) fixnum bignum))
(dispatch-ratio (number numerator denominator)
(dispatch-ratio (number numerator denominator (dispatch-type divisor))
(let* ((q-num numerator)
(q-den (* denominator divisor))
(rem-den denominator))
@ -608,7 +608,7 @@ The second returned value is the remainder."
(bignum-truncate-single-digit (make-small-bignum number) divisor)
(bignum-truncate (make-small-bignum number) divisor))))
((ratio (foreach (eql 1) fixnum bignum))
(dispatch-ratio (number numerator denominator)
(dispatch-ratio (number numerator denominator (dispatch-type divisor))
(let* ((q-num numerator)
(q-den (* denominator divisor))
(rem-den denominator))
@ -1216,7 +1216,7 @@ the first."
:infinite-y-finite-x
(,op (coerce 0 '(dispatch-type y)) y))
(((foreach fixnum bignum) ratio)
(dispatch-ratio (y numerator denominator)
(dispatch-ratio (y numerator denominator (dispatch-type x))
(,(case op
(<= '<)
(>= '>)
@ -1224,7 +1224,7 @@ the first."
x (,ratio-arg2 numerator
denominator))))
((ratio (foreach fixnum bignum))
(dispatch-ratio (x numerator denominator)
(dispatch-ratio (x numerator denominator (dispatch-type x))
(,(case op
(<= '<)
(>= '>)