1.0.47.6: marginally faster ISQRT
Thanks to Robert Smith, lp#713343.
Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1895
diff -u -r1.1895 NEWS
--- NEWS 30 Mar 2011 16:48:49 -0000 1.1895
+++ NEWS 30 Mar 2011 17:56:47 -0000
@@ -3,6 +3,7 @@
* enhancement: read() and write() have been added to SB-POSIX.
* enhancement: types of DEFSTRUCT constructors are proclaimed more
accurately, allowing better typechecking of call-sites.
+ * optimization: slightly faster ISQRT. (lp#713343)
* bug fix: TRACE behaves better when attempting to trace undefined
functions. (lp#740717)
Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.5235
diff -u -r1.5235 version.lisp-expr
--- version.lisp-expr 30 Mar 2011 16:48:49 -0000 1.5235
+++ version.lisp-expr 30 Mar 2011 17:56:48 -0000
@@ -20,4 +20,4 @@
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.47.5"
+"1.0.47.6"
Index: src/code/numbers.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v
retrieving revision 1.58
diff -u -r1.58 numbers.lisp
--- src/code/numbers.lisp 18 Nov 2010 13:52:06 -0000 1.58
+++ src/code/numbers.lisp 30 Mar 2011 17:56:48 -0000
@@ -1384,29 +1384,31 @@
((fixnum bignum)
(bignum-gcd (make-small-bignum u) v))))))
-;;; From discussion on comp.lang.lisp and Akira Kurihara.
+;;;; from Robert Smith
(defun isqrt (n)
#!+sb-doc
"Return the root of the nearest integer less than n which is a perfect
square."
- (declare (type unsigned-byte n) (values unsigned-byte))
- ;; Theoretically (> n 7), i.e., n-len-quarter > 0.
- (if (and (fixnump n) (<= n 24))
- (cond ((> n 15) 4)
- ((> n 8) 3)
- ((> n 3) 2)
- ((> n 0) 1)
- (t 0))
- (let* ((n-len-quarter (ash (integer-length n) -2))
- (n-half (ash n (- (ash n-len-quarter 1))))
- (n-half-isqrt (isqrt n-half))
- (init-value (ash (1+ n-half-isqrt) n-len-quarter)))
- (loop
- (let ((iterated-value
- (ash (+ init-value (truncate n init-value)) -1)))
- (unless (< iterated-value init-value)
- (return init-value))
- (setq init-value iterated-value))))))
+ (declare (type unsigned-byte n))
+ (cond
+ ((> n 24)
+ (let* ((n-fourth-size (ash (1- (integer-length n)) -2))
+ (n-significant-half (ash n (- (ash n-fourth-size 1))))
+ (n-significant-half-isqrt (isqrt-fast n-significant-half))
+ (zeroth-iteration (ash n-significant-half-isqrt n-fourth-size))
+ (qr (multiple-value-list (floor n zeroth-iteration)))
+ (first-iteration (ash (+ zeroth-iteration (first qr)) -1)))
+ (cond ((oddp (first qr))
+ first-iteration)
+ ((> (expt (- first-iteration zeroth-iteration) 2) (second qr))
+ (1- first-iteration))
+ (t
+ first-iteration))))
+ ((> n 15) 4)
+ ((> n 8) 3)
+ ((> n 3) 2)
+ ((> n 0) 1)
+ ((= n 0) 0)))
;;;; miscellaneous number predicates
|